Rev 7693 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
7696 | akron1 | 1 | (* |
7597 | akron1 | 2 | BSD 2-Clause License |
3 | |||
7696 | akron1 | 4 | Copyright (c) 2018-2019, Anton Krotov |
7597 | akron1 | 5 | All rights reserved. |
6 | *) |
||
7 | |||
8 | MODULE BIN; |
||
9 | |||
7693 | akron1 | 10 | IMPORT LISTS, CHL := CHUNKLISTS, ARITH, UTILS; |
7597 | akron1 | 11 | |
12 | |||
13 | CONST |
||
14 | |||
15 | RCODE* = 1; |
||
16 | RDATA* = 2; |
||
17 | RBSS* = 3; |
||
18 | RIMP* = 4; |
||
19 | |||
20 | PICCODE* = 5; |
||
21 | PICDATA* = 6; |
||
22 | PICBSS* = 7; |
||
23 | PICIMP* = 8; |
||
24 | |||
25 | IMPTAB* = 9; |
||
26 | |||
27 | |||
28 | TYPE |
||
29 | |||
30 | RELOC* = POINTER TO RECORD (LISTS.ITEM) |
||
31 | |||
32 | opcode*: INTEGER; |
||
33 | offset*: INTEGER |
||
34 | |||
35 | END; |
||
36 | |||
37 | IMPRT* = POINTER TO RECORD (LISTS.ITEM) |
||
38 | |||
39 | nameoffs*: INTEGER; |
||
40 | label*: INTEGER; |
||
41 | |||
42 | OriginalFirstThunk*, |
||
43 | FirstThunk*: INTEGER |
||
44 | |||
45 | END; |
||
46 | |||
47 | EXPRT* = POINTER TO RECORD (LISTS.ITEM) |
||
48 | |||
49 | nameoffs*: INTEGER; |
||
50 | label*: INTEGER |
||
51 | |||
52 | END; |
||
53 | |||
54 | PROGRAM* = POINTER TO RECORD |
||
55 | |||
56 | code*: CHL.BYTELIST; |
||
57 | data*: CHL.BYTELIST; |
||
58 | labels: CHL.INTLIST; |
||
59 | bss*: INTEGER; |
||
60 | stack*: INTEGER; |
||
61 | vmajor*, |
||
62 | vminor*: WCHAR; |
||
63 | modname*: INTEGER; |
||
64 | import*: CHL.BYTELIST; |
||
65 | export*: CHL.BYTELIST; |
||
66 | rel_list*: LISTS.LIST; |
||
67 | imp_list*: LISTS.LIST; |
||
68 | exp_list*: LISTS.LIST |
||
69 | |||
70 | END; |
||
71 | |||
72 | |||
73 | PROCEDURE create* (NumberOfLabels: INTEGER): PROGRAM; |
||
74 | VAR |
||
75 | program: PROGRAM; |
||
76 | i: INTEGER; |
||
77 | |||
78 | BEGIN |
||
79 | NEW(program); |
||
80 | |||
81 | program.bss := 0; |
||
82 | |||
83 | program.labels := CHL.CreateIntList(); |
||
84 | FOR i := 0 TO NumberOfLabels - 1 DO |
||
85 | CHL.PushInt(program.labels, 0) |
||
86 | END; |
||
87 | |||
88 | program.rel_list := LISTS.create(NIL); |
||
89 | program.imp_list := LISTS.create(NIL); |
||
90 | program.exp_list := LISTS.create(NIL); |
||
91 | |||
92 | program.data := CHL.CreateByteList(); |
||
93 | program.code := CHL.CreateByteList(); |
||
94 | program.import := CHL.CreateByteList(); |
||
95 | program.export := CHL.CreateByteList() |
||
96 | |||
97 | RETURN program |
||
98 | END create; |
||
99 | |||
100 | |||
101 | PROCEDURE SetParams* (program: PROGRAM; bss, stack: INTEGER; vmajor, vminor: WCHAR); |
||
102 | BEGIN |
||
103 | program.bss := bss; |
||
104 | program.stack := stack; |
||
105 | program.vmajor := vmajor; |
||
106 | program.vminor := vminor |
||
107 | END SetParams; |
||
108 | |||
109 | |||
110 | PROCEDURE PutReloc* (program: PROGRAM; opcode: INTEGER); |
||
111 | VAR |
||
112 | cmd: RELOC; |
||
113 | |||
114 | BEGIN |
||
115 | NEW(cmd); |
||
116 | cmd.opcode := opcode; |
||
117 | cmd.offset := CHL.Length(program.code); |
||
118 | LISTS.push(program.rel_list, cmd) |
||
119 | END PutReloc; |
||
120 | |||
121 | |||
122 | PROCEDURE PutData* (program: PROGRAM; b: BYTE); |
||
123 | BEGIN |
||
124 | CHL.PushByte(program.data, b) |
||
125 | END PutData; |
||
126 | |||
127 | |||
128 | PROCEDURE get32le* (array: CHL.BYTELIST; idx: INTEGER): INTEGER; |
||
129 | VAR |
||
130 | i: INTEGER; |
||
131 | x: INTEGER; |
||
132 | |||
133 | BEGIN |
||
134 | x := 0; |
||
135 | |||
136 | FOR i := 3 TO 0 BY -1 DO |
||
137 | x := LSL(x, 8) + CHL.GetByte(array, idx + i) |
||
138 | END; |
||
139 | |||
140 | IF UTILS.bit_depth = 64 THEN |
||
7693 | akron1 | 141 | x := LSL(x, 16); |
142 | x := LSL(x, 16); |
||
143 | x := ASR(x, 16); |
||
144 | x := ASR(x, 16) |
||
7597 | akron1 | 145 | END |
146 | |||
147 | RETURN x |
||
148 | END get32le; |
||
149 | |||
150 | |||
151 | PROCEDURE put32le* (array: CHL.BYTELIST; idx: INTEGER; x: INTEGER); |
||
152 | VAR |
||
153 | i: INTEGER; |
||
154 | |||
155 | BEGIN |
||
156 | FOR i := 0 TO 3 DO |
||
7693 | akron1 | 157 | CHL.SetByte(array, idx + i, UTILS.Byte(x, i)) |
7597 | akron1 | 158 | END |
159 | END put32le; |
||
160 | |||
161 | |||
162 | PROCEDURE PutData32LE* (program: PROGRAM; x: INTEGER); |
||
163 | VAR |
||
164 | i: INTEGER; |
||
165 | |||
166 | BEGIN |
||
167 | FOR i := 0 TO 3 DO |
||
7693 | akron1 | 168 | CHL.PushByte(program.data, UTILS.Byte(x, i)) |
7597 | akron1 | 169 | END |
170 | END PutData32LE; |
||
171 | |||
172 | |||
173 | PROCEDURE PutData64LE* (program: PROGRAM; x: INTEGER); |
||
174 | VAR |
||
175 | i: INTEGER; |
||
176 | |||
177 | BEGIN |
||
178 | FOR i := 0 TO 7 DO |
||
7693 | akron1 | 179 | CHL.PushByte(program.data, UTILS.Byte(x, i)) |
7597 | akron1 | 180 | END |
181 | END PutData64LE; |
||
182 | |||
183 | |||
184 | PROCEDURE PutDataStr* (program: PROGRAM; s: ARRAY OF CHAR); |
||
185 | VAR |
||
186 | i: INTEGER; |
||
187 | |||
188 | BEGIN |
||
189 | i := 0; |
||
190 | WHILE s[i] # 0X DO |
||
191 | PutData(program, ORD(s[i])); |
||
192 | INC(i) |
||
193 | END |
||
194 | END PutDataStr; |
||
195 | |||
196 | |||
197 | PROCEDURE PutCode* (program: PROGRAM; b: BYTE); |
||
198 | BEGIN |
||
199 | CHL.PushByte(program.code, b) |
||
200 | END PutCode; |
||
201 | |||
202 | |||
203 | PROCEDURE PutCode32LE* (program: PROGRAM; x: INTEGER); |
||
204 | VAR |
||
205 | i: INTEGER; |
||
206 | |||
207 | BEGIN |
||
208 | FOR i := 0 TO 3 DO |
||
7693 | akron1 | 209 | CHL.PushByte(program.code, UTILS.Byte(x, i)) |
7597 | akron1 | 210 | END |
211 | END PutCode32LE; |
||
212 | |||
213 | |||
214 | PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER); |
||
215 | BEGIN |
||
216 | CHL.SetInt(program.labels, label, offset) |
||
217 | END SetLabel; |
||
218 | |||
219 | |||
220 | PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); |
||
221 | VAR |
||
222 | imp: IMPRT; |
||
223 | |||
224 | BEGIN |
||
225 | CHL.PushByte(program.import, 0); |
||
226 | CHL.PushByte(program.import, 0); |
||
227 | |||
228 | IF ODD(CHL.Length(program.import)) THEN |
||
229 | CHL.PushByte(program.import, 0) |
||
230 | END; |
||
231 | |||
232 | NEW(imp); |
||
7693 | akron1 | 233 | imp.nameoffs := CHL.PushStr(program.import, name); |
7597 | akron1 | 234 | imp.label := label; |
7693 | akron1 | 235 | LISTS.push(program.imp_list, imp) |
7597 | akron1 | 236 | END Import; |
237 | |||
238 | |||
239 | PROCEDURE less (bytes: CHL.BYTELIST; a, b: EXPRT): BOOLEAN; |
||
240 | VAR |
||
241 | i, j: INTEGER; |
||
242 | |||
243 | BEGIN |
||
244 | i := a.nameoffs; |
||
245 | j := b.nameoffs; |
||
246 | |||
247 | WHILE (CHL.GetByte(bytes, i) # 0) & (CHL.GetByte(bytes, j) # 0) & |
||
248 | (CHL.GetByte(bytes, i) = CHL.GetByte(bytes, j)) DO |
||
249 | INC(i); |
||
250 | INC(j) |
||
251 | END |
||
252 | |||
253 | RETURN CHL.GetByte(bytes, i) < CHL.GetByte(bytes, j) |
||
254 | END less; |
||
255 | |||
256 | |||
257 | PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); |
||
258 | VAR |
||
259 | exp, cur: EXPRT; |
||
260 | |||
261 | BEGIN |
||
262 | NEW(exp); |
||
263 | exp.label := CHL.GetInt(program.labels, label); |
||
7693 | akron1 | 264 | exp.nameoffs := CHL.PushStr(program.export, name); |
7597 | akron1 | 265 | |
266 | cur := program.exp_list.first(EXPRT); |
||
267 | WHILE (cur # NIL) & less(program.export, cur, exp) DO |
||
268 | cur := cur.next(EXPRT) |
||
269 | END; |
||
270 | |||
271 | IF cur # NIL THEN |
||
272 | IF cur.prev # NIL THEN |
||
273 | LISTS.insert(program.exp_list, cur.prev, exp) |
||
274 | ELSE |
||
275 | LISTS.insertL(program.exp_list, cur, exp) |
||
276 | END |
||
277 | ELSE |
||
278 | LISTS.push(program.exp_list, exp) |
||
279 | END |
||
280 | |||
281 | END Export; |
||
282 | |||
283 | |||
284 | PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT; |
||
285 | VAR |
||
286 | import: IMPRT; |
||
287 | res: IMPRT; |
||
288 | |||
289 | BEGIN |
||
290 | import := program.imp_list.first(IMPRT); |
||
291 | |||
292 | res := NIL; |
||
293 | WHILE (import # NIL) & (n >= 0) DO |
||
294 | IF import.label # 0 THEN |
||
295 | res := import; |
||
296 | DEC(n) |
||
297 | END; |
||
298 | import := import.next(IMPRT) |
||
299 | END; |
||
300 | |||
301 | ASSERT(n = -1) |
||
302 | RETURN res |
||
303 | END GetIProc; |
||
304 | |||
305 | |||
306 | PROCEDURE GetLabel* (program: PROGRAM; label: INTEGER): INTEGER; |
||
307 | RETURN CHL.GetInt(program.labels, label) |
||
308 | END GetLabel; |
||
309 | |||
310 | |||
311 | PROCEDURE NewLabel* (program: PROGRAM); |
||
312 | BEGIN |
||
313 | CHL.PushInt(program.labels, 0) |
||
314 | END NewLabel; |
||
315 | |||
316 | |||
317 | PROCEDURE fixup* (program: PROGRAM); |
||
318 | VAR |
||
319 | rel: RELOC; |
||
320 | imp: IMPRT; |
||
321 | nproc: INTEGER; |
||
322 | L: INTEGER; |
||
323 | |||
324 | BEGIN |
||
325 | |||
326 | nproc := 0; |
||
327 | imp := program.imp_list.first(IMPRT); |
||
328 | WHILE imp # NIL DO |
||
329 | IF imp.label # 0 THEN |
||
330 | CHL.SetInt(program.labels, imp.label, nproc); |
||
331 | INC(nproc) |
||
332 | END; |
||
333 | imp := imp.next(IMPRT) |
||
334 | END; |
||
335 | |||
336 | rel := program.rel_list.first(RELOC); |
||
337 | WHILE rel # NIL DO |
||
338 | |||
339 | IF rel.opcode IN {RIMP, PICIMP} THEN |
||
340 | L := get32le(program.code, rel.offset); |
||
341 | put32le(program.code, rel.offset, GetLabel(program, L)) |
||
342 | END; |
||
343 | |||
344 | rel := rel.next(RELOC) |
||
345 | END |
||
346 | |||
347 | END fixup; |
||
348 | |||
349 | |||
350 | PROCEDURE InitArray* (VAR array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR); |
||
351 | VAR |
||
352 | i, k: INTEGER; |
||
353 | |||
354 | |||
355 | PROCEDURE hexdgt (dgt: CHAR): INTEGER; |
||
356 | VAR |
||
357 | res: INTEGER; |
||
358 | |||
359 | BEGIN |
||
360 | IF dgt < "A" THEN |
||
361 | res := ORD(dgt) - ORD("0") |
||
362 | ELSE |
||
363 | res := ORD(dgt) - ORD("A") + 10 |
||
364 | END |
||
365 | |||
366 | RETURN res |
||
367 | END hexdgt; |
||
368 | |||
369 | |||
370 | BEGIN |
||
371 | k := LENGTH(hex); |
||
372 | ASSERT(~ODD(k)); |
||
373 | k := k DIV 2; |
||
374 | |||
375 | FOR i := 0 TO k - 1 DO |
||
376 | array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) |
||
377 | END; |
||
378 | |||
7693 | akron1 | 379 | INC(idx, k) |
7597 | akron1 | 380 | END InitArray; |
381 | |||
382 | |||
7696 | akron1 | 383 | END BIN.>> |