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 PROG; |
||
9 | |||
7693 | akron1 | 10 | IMPORT SCAN, LISTS, ARITH, ERRORS, C := COLLECTIONS, mConst := CONSTANTS, IL, UTILS; |
7597 | akron1 | 11 | |
12 | |||
13 | CONST |
||
14 | |||
15 | MAXARRDIM* = 5; |
||
16 | MAXSCOPE = 16; |
||
17 | MAXSYSVPARAM* = 26; |
||
18 | |||
19 | idNONE* = 0; idGUARD = 1; idMODULE* = 2; idCONST* = 3; |
||
20 | idTYPE* = 4; idSTFUNC* = 5; idSTPROC* = 6; idVAR* = 7; |
||
21 | idPROC* = 8; idVPAR* = 9; idPARAM* = 10; idSYSFUNC* = 11; |
||
22 | idSYSPROC* = 12; idIMP* = 13; |
||
23 | |||
24 | tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4; |
||
25 | tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8; |
||
26 | tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12; |
||
7696 | akron1 | 27 | tCARD32* = 13; tANYREC* = 14; tWCHAR* = 15; |
7597 | akron1 | 28 | |
7696 | akron1 | 29 | BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD32, tWCHAR}; |
7597 | akron1 | 30 | |
31 | stABS* = 1; stASR* = 2; stCHR* = 3; stFLOOR* = 4; |
||
32 | stFLT* = 5; stLEN* = 6; stLSL* = 7; stODD* = 8; |
||
33 | stORD* = 9; stROR* = 10; stASSERT* = 11; stDEC* = 12; |
||
34 | stEXCL* = 13; stINC* = 14; stINCL* = 15; stNEW* = 16; |
||
35 | stPACK* = 17; stUNPK* = 18; sysADR* = 19; sysSIZE* = 20; |
||
36 | sysGET* = 21; sysPUT* = 22; |
||
37 | |||
38 | stDISPOSE* = 23; stLSR* = 24; stBITS* = 25; sysCODE* = 26; |
||
39 | sysMOVE* = 27; stLENGTH* = 28; stMIN* = 29; stMAX* = 30; |
||
40 | sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34; |
||
41 | sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38; |
||
7693 | akron1 | 42 | sysWSADR* = 39; sysPUT32* = 40; (*sysNOP* = 41; sysEINT* = 42; |
43 | sysDINT* = 43;*) |
||
7597 | akron1 | 44 | |
7693 | akron1 | 45 | default32* = 2; |
7597 | akron1 | 46 | stdcall* = 4; _stdcall* = stdcall + 1; |
47 | ccall* = 6; _ccall* = ccall + 1; |
||
48 | ccall16* = 8; _ccall16* = ccall16 + 1; |
||
49 | win64* = 10; _win64* = win64 + 1; |
||
50 | stdcall64* = 12; _stdcall64* = stdcall64 + 1; |
||
51 | default64* = 14; |
||
52 | systemv* = 16; _systemv* = systemv + 1; |
||
7693 | akron1 | 53 | default16* = 18; |
54 | code* = 20; _code* = code + 1; |
||
7597 | akron1 | 55 | |
7693 | akron1 | 56 | noalign* = 22; |
7597 | akron1 | 57 | |
7693 | akron1 | 58 | callee_clean_up* = {default32, stdcall, _stdcall, default64, stdcall64, _stdcall64}; |
7597 | akron1 | 59 | |
7693 | akron1 | 60 | sf_stdcall* = 0; sf_stdcall64* = 1; sf_ccall* = 2; sf_ccall16* = 3; |
61 | sf_win64* = 4; sf_systemv* = 5; sf_windows* = 6; sf_linux* = 7; |
||
62 | sf_code* = 8; |
||
63 | sf_noalign* = 9; |
||
64 | |||
65 | proc_flags* = {sf_stdcall, sf_stdcall64, sf_ccall, sf_ccall16, sf_win64, sf_systemv, sf_windows, sf_linux, sf_code}; |
||
66 | rec_flags* = {sf_noalign}; |
||
67 | |||
7597 | akron1 | 68 | STACK_FRAME = 2; |
69 | |||
70 | |||
71 | TYPE |
||
72 | |||
7693 | akron1 | 73 | OPTIONS* = RECORD |
74 | |||
7696 | akron1 | 75 | version*, stack*, ram*, rom*: INTEGER; |
7693 | akron1 | 76 | pic*: BOOLEAN; |
77 | checking*: SET |
||
78 | |||
79 | END; |
||
80 | |||
7597 | akron1 | 81 | IDENT* = POINTER TO rIDENT; |
82 | |||
83 | UNIT* = POINTER TO rUNIT; |
||
84 | |||
85 | PROGRAM* = POINTER TO rPROGRAM; |
||
86 | |||
87 | TYPE_* = POINTER TO rTYPE_; |
||
88 | |||
89 | FRWPTR* = POINTER TO RECORD (LISTS.ITEM) |
||
90 | |||
91 | type: TYPE_; |
||
92 | baseIdent: SCAN.IDENT; |
||
93 | linked: BOOLEAN; |
||
94 | |||
95 | pos*: SCAN.POSITION; |
||
96 | notRecord*: BOOLEAN |
||
97 | |||
98 | END; |
||
99 | |||
100 | PROC* = POINTER TO RECORD (LISTS.ITEM) |
||
101 | |||
102 | label*: INTEGER; |
||
103 | used*: BOOLEAN; |
||
104 | processed*: BOOLEAN; |
||
105 | import*: LISTS.ITEM; |
||
106 | using*: LISTS.LIST; |
||
107 | enter*, |
||
108 | leave*: LISTS.ITEM |
||
109 | |||
110 | END; |
||
111 | |||
112 | USED_PROC = POINTER TO RECORD (LISTS.ITEM) |
||
113 | |||
114 | proc: PROC |
||
115 | |||
116 | END; |
||
117 | |||
118 | rUNIT = RECORD (LISTS.ITEM) |
||
119 | |||
120 | program*: PROGRAM; |
||
121 | name*: SCAN.IDENT; |
||
7693 | akron1 | 122 | idents*: LISTS.LIST; |
7597 | akron1 | 123 | frwPointers: LISTS.LIST; |
124 | gscope: IDENT; |
||
125 | closed*: BOOLEAN; |
||
126 | scopeLvl*: INTEGER; |
||
127 | sysimport*: BOOLEAN; |
||
7693 | akron1 | 128 | scopes*: ARRAY MAXSCOPE OF PROC |
7597 | akron1 | 129 | |
130 | END; |
||
131 | |||
132 | FIELD* = POINTER TO rFIELD; |
||
133 | |||
134 | PARAM* = POINTER TO rPARAM; |
||
135 | |||
136 | rTYPE_ = RECORD (LISTS.ITEM) |
||
137 | |||
138 | typ*: INTEGER; |
||
139 | size*: INTEGER; |
||
7693 | akron1 | 140 | parSize*: INTEGER; |
7597 | akron1 | 141 | length*: INTEGER; |
142 | align*: INTEGER; |
||
143 | base*: TYPE_; |
||
7693 | akron1 | 144 | fields*: LISTS.LIST; |
145 | params*: LISTS.LIST; |
||
7597 | akron1 | 146 | unit*: UNIT; |
147 | closed*: BOOLEAN; |
||
148 | num*: INTEGER; |
||
149 | call*: INTEGER; |
||
150 | import*: BOOLEAN; |
||
151 | noalign*: BOOLEAN |
||
152 | |||
153 | END; |
||
154 | |||
155 | rFIELD = RECORD (LISTS.ITEM) |
||
156 | |||
157 | type*: TYPE_; |
||
158 | name*: SCAN.IDENT; |
||
159 | export*: BOOLEAN; |
||
160 | offset*: INTEGER |
||
161 | |||
162 | END; |
||
163 | |||
164 | rPARAM = RECORD (LISTS.ITEM) |
||
165 | |||
166 | name*: SCAN.IDENT; |
||
167 | type*: TYPE_; |
||
168 | vPar*: BOOLEAN; |
||
169 | offset*: INTEGER |
||
170 | |||
171 | END; |
||
172 | |||
173 | rIDENT = RECORD (LISTS.ITEM) |
||
174 | |||
175 | name*: SCAN.IDENT; |
||
176 | typ*: INTEGER; |
||
177 | export*: BOOLEAN; |
||
178 | import*: LISTS.ITEM; |
||
179 | unit*: UNIT; |
||
180 | value*: ARITH.VALUE; |
||
181 | type*: TYPE_; |
||
182 | stproc*: INTEGER; |
||
183 | global*: BOOLEAN; |
||
184 | scopeLvl*: INTEGER; |
||
185 | offset*: INTEGER; |
||
186 | proc*: PROC; |
||
187 | pos*: SCAN.POSITION |
||
188 | |||
189 | END; |
||
190 | |||
191 | rPROGRAM = RECORD |
||
192 | |||
193 | recCount: INTEGER; |
||
7693 | akron1 | 194 | units*: LISTS.LIST; |
7597 | akron1 | 195 | types*: LISTS.LIST; |
196 | sysunit*: UNIT; |
||
197 | rtl*: UNIT; |
||
198 | bss*: INTEGER; |
||
199 | locsize*: INTEGER; |
||
200 | |||
201 | procs*: LISTS.LIST; |
||
202 | dll*: BOOLEAN; |
||
203 | obj*: BOOLEAN; |
||
204 | |||
7693 | akron1 | 205 | stTypes*: RECORD |
7597 | akron1 | 206 | |
7693 | akron1 | 207 | tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, |
7696 | akron1 | 208 | tSTRING*, tNIL*, tCARD32*, tANYREC*: TYPE_ |
7597 | akron1 | 209 | |
210 | END; |
||
211 | |||
212 | target*: RECORD |
||
213 | |||
214 | bit_depth*: INTEGER; |
||
215 | word*: INTEGER; |
||
216 | adr*: INTEGER; |
||
7693 | akron1 | 217 | sys*: INTEGER; |
218 | sysflags*: SET; |
||
219 | options*: OPTIONS |
||
7597 | akron1 | 220 | |
7693 | akron1 | 221 | END |
7597 | akron1 | 222 | |
223 | END; |
||
224 | |||
225 | DELIMPORT = PROCEDURE (import: LISTS.ITEM); |
||
226 | |||
227 | |||
228 | VAR |
||
229 | |||
230 | idents: C.COLLECTION; |
||
231 | |||
232 | |||
233 | PROCEDURE NewIdent (): IDENT; |
||
234 | VAR |
||
235 | ident: IDENT; |
||
236 | citem: C.ITEM; |
||
237 | |||
238 | BEGIN |
||
239 | citem := C.pop(idents); |
||
240 | IF citem = NIL THEN |
||
241 | NEW(ident) |
||
242 | ELSE |
||
243 | ident := citem(IDENT) |
||
244 | END |
||
245 | |||
246 | RETURN ident |
||
247 | END NewIdent; |
||
248 | |||
249 | |||
250 | PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER; |
||
251 | VAR |
||
252 | word: INTEGER; |
||
253 | size: INTEGER; |
||
254 | |||
255 | BEGIN |
||
256 | IF varIdent.offset = -1 THEN |
||
7696 | akron1 | 257 | size := varIdent.type.size; |
7597 | akron1 | 258 | IF varIdent.global THEN |
7693 | akron1 | 259 | IF UTILS.Align(program.bss, varIdent.type.align) THEN |
7696 | akron1 | 260 | IF UTILS.maxint - program.bss >= size THEN |
7597 | akron1 | 261 | varIdent.offset := program.bss; |
7696 | akron1 | 262 | INC(program.bss, size) |
7597 | akron1 | 263 | END |
264 | END |
||
265 | ELSE |
||
266 | word := program.target.word; |
||
7693 | akron1 | 267 | IF UTILS.Align(size, word) THEN |
7597 | akron1 | 268 | size := size DIV word; |
269 | IF UTILS.maxint - program.locsize >= size THEN |
||
270 | INC(program.locsize, size); |
||
7696 | akron1 | 271 | varIdent.offset := program.locsize |
7597 | akron1 | 272 | END |
273 | END |
||
7696 | akron1 | 274 | END; |
275 | |||
276 | IF varIdent.offset = -1 THEN |
||
277 | ERRORS.Error(204) |
||
7597 | akron1 | 278 | END |
279 | END |
||
280 | |||
281 | RETURN varIdent.offset |
||
282 | END getOffset; |
||
283 | |||
284 | |||
7693 | akron1 | 285 | PROCEDURE closeUnit* (unit: UNIT); |
7597 | akron1 | 286 | VAR |
287 | ident, prev: IDENT; |
||
288 | offset: INTEGER; |
||
289 | |||
290 | BEGIN |
||
291 | ident := unit.idents.last(IDENT); |
||
292 | WHILE (ident # NIL) & (ident.typ # idGUARD) DO |
||
293 | IF (ident.typ = idVAR) & (ident.offset = -1) THEN |
||
7693 | akron1 | 294 | ERRORS.HintMsg(ident.name.s, ident.pos.line, ident.pos.col, 0); |
7597 | akron1 | 295 | IF ident.export THEN |
296 | offset := getOffset(unit.program, ident) |
||
297 | END |
||
298 | END; |
||
299 | ident := ident.prev(IDENT) |
||
300 | END; |
||
301 | |||
302 | ident := unit.idents.last(IDENT); |
||
303 | WHILE ident # NIL DO |
||
304 | prev := ident.prev(IDENT); |
||
305 | IF ~ident.export THEN |
||
306 | LISTS.delete(unit.idents, ident); |
||
307 | C.push(idents, ident) |
||
308 | END; |
||
309 | ident := prev |
||
310 | END; |
||
311 | |||
312 | unit.closed := TRUE |
||
7693 | akron1 | 313 | END closeUnit; |
7597 | akron1 | 314 | |
315 | |||
316 | PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN; |
||
317 | VAR |
||
318 | item: IDENT; |
||
319 | |||
320 | BEGIN |
||
321 | ASSERT(ident # NIL); |
||
322 | |||
323 | item := unit.idents.last(IDENT); |
||
324 | WHILE (item.typ # idGUARD) & (item.name # ident) DO |
||
325 | item := item.prev(IDENT) |
||
326 | END |
||
327 | |||
328 | RETURN item.typ = idGUARD |
||
329 | END unique; |
||
330 | |||
331 | |||
7693 | akron1 | 332 | PROCEDURE addIdent* (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; |
7597 | akron1 | 333 | VAR |
7693 | akron1 | 334 | item: IDENT; |
335 | res: BOOLEAN; |
||
336 | proc: PROC; |
||
337 | procs: LISTS.LIST; |
||
7597 | akron1 | 338 | |
339 | BEGIN |
||
340 | ASSERT(unit # NIL); |
||
341 | ASSERT(ident # NIL); |
||
342 | |||
343 | res := unique(unit, ident); |
||
344 | |||
345 | IF res THEN |
||
346 | item := NewIdent(); |
||
347 | |||
348 | item.name := ident; |
||
349 | item.typ := typ; |
||
350 | item.unit := NIL; |
||
351 | item.export := FALSE; |
||
352 | item.import := NIL; |
||
353 | item.type := NIL; |
||
354 | item.value.typ := 0; |
||
355 | item.stproc := 0; |
||
356 | |||
357 | item.global := unit.scopeLvl = 0; |
||
358 | item.scopeLvl := unit.scopeLvl; |
||
359 | item.offset := -1; |
||
360 | |||
361 | IF item.typ IN {idPROC, idIMP} THEN |
||
362 | NEW(proc); |
||
363 | proc.import := NIL; |
||
364 | proc.label := 0; |
||
365 | proc.used := FALSE; |
||
366 | proc.processed := FALSE; |
||
367 | proc.using := LISTS.create(NIL); |
||
368 | procs := unit.program.procs; |
||
369 | LISTS.push(procs, proc); |
||
370 | item.proc := proc |
||
371 | END; |
||
372 | |||
373 | LISTS.push(unit.idents, item) |
||
374 | ELSE |
||
375 | item := NIL |
||
376 | END |
||
377 | |||
378 | RETURN item |
||
379 | END addIdent; |
||
380 | |||
381 | |||
382 | PROCEDURE UseProc* (unit: UNIT; call_proc: PROC); |
||
383 | VAR |
||
7693 | akron1 | 384 | procs: LISTS.LIST; |
385 | cur: LISTS.ITEM; |
||
386 | proc: USED_PROC; |
||
7597 | akron1 | 387 | |
388 | BEGIN |
||
389 | IF unit.scopeLvl = 0 THEN |
||
390 | call_proc.used := TRUE |
||
391 | ELSE |
||
392 | procs := unit.scopes[unit.scopeLvl].using; |
||
393 | |||
394 | cur := procs.first; |
||
395 | WHILE (cur # NIL) & (cur(USED_PROC).proc # call_proc) DO |
||
396 | cur := cur.next |
||
397 | END; |
||
398 | |||
399 | IF cur = NIL THEN |
||
400 | NEW(proc); |
||
401 | proc.proc := call_proc; |
||
402 | LISTS.push(procs, proc) |
||
403 | END |
||
404 | END |
||
405 | END UseProc; |
||
406 | |||
407 | |||
7693 | akron1 | 408 | PROCEDURE setVarsType* (unit: UNIT; type: TYPE_); |
7597 | akron1 | 409 | VAR |
410 | item: IDENT; |
||
411 | |||
412 | BEGIN |
||
413 | ASSERT(type # NIL); |
||
414 | |||
415 | item := unit.idents.last(IDENT); |
||
416 | WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO |
||
417 | item.type := type; |
||
418 | item := item.prev(IDENT) |
||
419 | END |
||
7693 | akron1 | 420 | END setVarsType; |
7597 | akron1 | 421 | |
422 | |||
7693 | akron1 | 423 | PROCEDURE getIdent* (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT; |
7597 | akron1 | 424 | VAR |
425 | item: IDENT; |
||
426 | |||
427 | BEGIN |
||
428 | ASSERT(ident # NIL); |
||
429 | |||
430 | item := unit.idents.last(IDENT); |
||
431 | |||
7693 | akron1 | 432 | IF item # NIL THEN |
7597 | akron1 | 433 | |
7693 | akron1 | 434 | IF currentScope THEN |
435 | WHILE (item.name # ident) & (item.typ # idGUARD) DO |
||
436 | item := item.prev(IDENT) |
||
437 | END; |
||
438 | IF item.name # ident THEN |
||
439 | item := NIL |
||
440 | END |
||
441 | ELSE |
||
442 | WHILE (item # NIL) & (item.name # ident) DO |
||
443 | item := item.prev(IDENT) |
||
444 | END |
||
7597 | akron1 | 445 | END |
7693 | akron1 | 446 | |
7597 | akron1 | 447 | END |
448 | |||
449 | RETURN item |
||
450 | END getIdent; |
||
451 | |||
452 | |||
7693 | akron1 | 453 | PROCEDURE openScope* (unit: UNIT; proc: PROC): BOOLEAN; |
7597 | akron1 | 454 | VAR |
455 | item: IDENT; |
||
456 | res: BOOLEAN; |
||
457 | |||
458 | BEGIN |
||
459 | INC(unit.scopeLvl); |
||
460 | |||
461 | res := unit.scopeLvl < MAXSCOPE; |
||
462 | |||
463 | IF res THEN |
||
464 | |||
465 | unit.scopes[unit.scopeLvl] := proc; |
||
466 | |||
467 | NEW(item); |
||
468 | item := NewIdent(); |
||
469 | |||
470 | item.name := NIL; |
||
471 | item.typ := idGUARD; |
||
472 | |||
473 | LISTS.push(unit.idents, item) |
||
474 | END |
||
475 | |||
476 | RETURN res |
||
477 | END openScope; |
||
478 | |||
479 | |||
7693 | akron1 | 480 | PROCEDURE closeScope* (unit: UNIT; variables: LISTS.LIST); |
7597 | akron1 | 481 | VAR |
482 | item: IDENT; |
||
483 | del: IDENT; |
||
7693 | akron1 | 484 | lvar: IL.LOCALVAR; |
7597 | akron1 | 485 | |
486 | BEGIN |
||
487 | item := unit.idents.last(IDENT); |
||
488 | |||
489 | WHILE (item # NIL) & (item.typ # idGUARD) DO |
||
490 | del := item; |
||
491 | item := item.prev(IDENT); |
||
492 | IF (del.typ = idVAR) & (del.offset = -1) THEN |
||
7693 | akron1 | 493 | ERRORS.HintMsg(del.name.s, del.pos.line, del.pos.col, 0) |
7597 | akron1 | 494 | END; |
495 | IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN |
||
496 | IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN |
||
7693 | akron1 | 497 | lvar := IL.NewVar(); |
7597 | akron1 | 498 | lvar.offset := del.offset; |
499 | lvar.size := del.type.size; |
||
500 | IF del.typ = idVAR THEN |
||
501 | lvar.offset := -lvar.offset |
||
502 | END; |
||
503 | LISTS.push(variables, lvar) |
||
504 | END |
||
505 | END; |
||
506 | LISTS.delete(unit.idents, del); |
||
507 | C.push(idents, del) |
||
508 | END; |
||
509 | |||
510 | IF (item # NIL) & (item.typ = idGUARD) THEN |
||
511 | LISTS.delete(unit.idents, item); |
||
512 | C.push(idents, item) |
||
513 | END; |
||
514 | |||
515 | DEC(unit.scopeLvl) |
||
516 | END closeScope; |
||
517 | |||
518 | |||
7693 | akron1 | 519 | PROCEDURE frwPtr* (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); |
7597 | akron1 | 520 | VAR |
521 | newptr: FRWPTR; |
||
522 | |||
523 | BEGIN |
||
524 | ASSERT(unit # NIL); |
||
525 | ASSERT(type # NIL); |
||
526 | ASSERT(baseIdent # NIL); |
||
527 | |||
528 | NEW(newptr); |
||
529 | |||
7693 | akron1 | 530 | newptr.type := type; |
531 | newptr.baseIdent := baseIdent; |
||
532 | newptr.pos := pos; |
||
533 | newptr.linked := FALSE; |
||
534 | newptr.notRecord := FALSE; |
||
7597 | akron1 | 535 | |
536 | LISTS.push(unit.frwPointers, newptr) |
||
7693 | akron1 | 537 | END frwPtr; |
7597 | akron1 | 538 | |
539 | |||
7693 | akron1 | 540 | PROCEDURE linkPtr* (unit: UNIT): FRWPTR; |
7597 | akron1 | 541 | VAR |
542 | item: FRWPTR; |
||
543 | ident: IDENT; |
||
544 | res: FRWPTR; |
||
545 | |||
546 | BEGIN |
||
547 | res := NIL; |
||
548 | item := unit.frwPointers.last(FRWPTR); |
||
549 | |||
550 | WHILE (item # NIL) & ~item.linked & (res = NIL) DO |
||
7693 | akron1 | 551 | ident := getIdent(unit, item.baseIdent, TRUE); |
7597 | akron1 | 552 | |
553 | IF (ident # NIL) THEN |
||
554 | IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN |
||
555 | item.type.base := ident.type; |
||
556 | item.linked := TRUE |
||
557 | ELSE |
||
558 | item.notRecord := TRUE; |
||
559 | res := item |
||
560 | END |
||
561 | ELSE |
||
562 | item.notRecord := FALSE; |
||
563 | res := item |
||
564 | END; |
||
565 | |||
566 | item := item.prev(FRWPTR) |
||
567 | END |
||
568 | |||
569 | RETURN res |
||
7693 | akron1 | 570 | END linkPtr; |
7597 | akron1 | 571 | |
572 | |||
573 | PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN; |
||
574 | VAR |
||
575 | res: BOOLEAN; |
||
576 | param1, param2: LISTS.ITEM; |
||
577 | |||
578 | BEGIN |
||
579 | IF t1 = t2 THEN |
||
580 | res := TRUE |
||
581 | ELSIF (t1 = NIL) OR (t2 = NIL) THEN |
||
582 | res := FALSE |
||
583 | ELSIF (t1.typ = tPROCEDURE) & (t2.typ = tPROCEDURE) THEN |
||
584 | |||
585 | param1 := t1.params.first; |
||
586 | param2 := t2.params.first; |
||
587 | |||
7693 | akron1 | 588 | res := ((t1.call = t2.call) OR (t1.call IN {code, _code}) OR (t2.call IN {code, _code})) & ((param1 # NIL) = (param2 # NIL)); |
7597 | akron1 | 589 | |
590 | WHILE res & (param1 # NIL) & (param2 # NIL) DO |
||
591 | res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type); |
||
592 | param1 := param1.next; |
||
593 | param2 := param2.next; |
||
594 | res := res & ((param1 # NIL) = (param2 # NIL)) |
||
595 | END; |
||
596 | |||
597 | res := res & isTypeEq(t1.base, t2.base) |
||
598 | |||
599 | ELSIF (t1.typ = tARRAY) & (t2.typ = tARRAY) THEN |
||
600 | res := (t1.length = 0) & (t2.length = 0) & isTypeEq(t1.base, t2.base) |
||
601 | ELSE |
||
602 | res := FALSE |
||
603 | END |
||
604 | |||
605 | RETURN res |
||
606 | END isTypeEq; |
||
607 | |||
608 | |||
609 | PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN; |
||
610 | VAR |
||
611 | res: BOOLEAN; |
||
612 | |||
613 | BEGIN |
||
7693 | akron1 | 614 | res := (t0.typ = t1.typ) & (t0.typ IN {tPOINTER, tRECORD}); |
7597 | akron1 | 615 | |
7693 | akron1 | 616 | IF res & (t0.typ = tPOINTER) THEN |
7597 | akron1 | 617 | t0 := t0.base; |
618 | t1 := t1.base |
||
619 | END; |
||
620 | |||
7693 | akron1 | 621 | IF res THEN |
622 | WHILE (t1 # NIL) & (t1 # t0) DO |
||
623 | t1 := t1.base |
||
624 | END; |
||
625 | res := t1 # NIL |
||
7597 | akron1 | 626 | END |
627 | |||
7693 | akron1 | 628 | RETURN res |
7597 | akron1 | 629 | END isBaseOf; |
630 | |||
631 | |||
632 | PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN; |
||
633 | RETURN (t.typ = tARRAY) & (t.length = 0) |
||
634 | END isOpenArray; |
||
635 | |||
636 | |||
7696 | akron1 | 637 | PROCEDURE arrcomp* (src, dst: TYPE_): BOOLEAN; |
638 | RETURN (dst.typ = tARRAY) & isOpenArray(src) & |
||
639 | ~isOpenArray(src.base) & ~isOpenArray(dst.base) & |
||
640 | isTypeEq(src.base, dst.base) |
||
641 | END arrcomp; |
||
642 | |||
643 | |||
7693 | akron1 | 644 | PROCEDURE getUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
7597 | akron1 | 645 | VAR |
646 | item: UNIT; |
||
647 | |||
648 | BEGIN |
||
649 | ASSERT(name # NIL); |
||
650 | |||
7693 | akron1 | 651 | item := program.units.first(UNIT); |
7597 | akron1 | 652 | |
653 | WHILE (item # NIL) & (item.name # name) DO |
||
654 | item := item.next(UNIT) |
||
655 | END; |
||
656 | |||
657 | IF (item = NIL) & (name.s = "SYSTEM") THEN |
||
7693 | akron1 | 658 | item := program.sysunit |
7597 | akron1 | 659 | END |
660 | |||
661 | RETURN item |
||
7693 | akron1 | 662 | END getUnit; |
7597 | akron1 | 663 | |
664 | |||
665 | PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM); |
||
666 | VAR |
||
7693 | akron1 | 667 | ident: IDENT; |
7597 | akron1 | 668 | |
669 | BEGIN |
||
7693 | akron1 | 670 | ident := addIdent(unit, SCAN.enterid("INTEGER"), idTYPE); |
7597 | akron1 | 671 | ident.type := program.stTypes.tINTEGER; |
672 | |||
7693 | akron1 | 673 | ident := addIdent(unit, SCAN.enterid("BYTE"), idTYPE); |
7597 | akron1 | 674 | ident.type := program.stTypes.tBYTE; |
675 | |||
7693 | akron1 | 676 | ident := addIdent(unit, SCAN.enterid("CHAR"), idTYPE); |
7597 | akron1 | 677 | ident.type := program.stTypes.tCHAR; |
678 | |||
7693 | akron1 | 679 | ident := addIdent(unit, SCAN.enterid("SET"), idTYPE); |
7597 | akron1 | 680 | ident.type := program.stTypes.tSET; |
681 | |||
7693 | akron1 | 682 | ident := addIdent(unit, SCAN.enterid("BOOLEAN"), idTYPE); |
7597 | akron1 | 683 | ident.type := program.stTypes.tBOOLEAN; |
684 | |||
7693 | akron1 | 685 | IF program.target.sys # mConst.Target_iMSP430 THEN |
686 | ident := addIdent(unit, SCAN.enterid("REAL"), idTYPE); |
||
687 | ident.type := program.stTypes.tREAL; |
||
7597 | akron1 | 688 | |
7693 | akron1 | 689 | ident := addIdent(unit, SCAN.enterid("WCHAR"), idTYPE); |
690 | ident.type := program.stTypes.tWCHAR |
||
691 | END |
||
692 | |||
7597 | akron1 | 693 | END enterStTypes; |
694 | |||
695 | |||
696 | PROCEDURE enterStProcs (unit: UNIT); |
||
697 | |||
698 | |||
7693 | akron1 | 699 | PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; proc: INTEGER); |
7597 | akron1 | 700 | VAR |
701 | ident: IDENT; |
||
702 | BEGIN |
||
7693 | akron1 | 703 | ident := addIdent(unit, SCAN.enterid(name), idSTPROC); |
7597 | akron1 | 704 | ident.stproc := proc |
705 | END EnterProc; |
||
706 | |||
707 | |||
7693 | akron1 | 708 | PROCEDURE EnterFunc (unit: UNIT; name: SCAN.LEXSTR; func: INTEGER); |
709 | VAR |
||
710 | ident: IDENT; |
||
711 | BEGIN |
||
712 | ident := addIdent(unit, SCAN.enterid(name), idSTFUNC); |
||
713 | ident.stproc := func |
||
714 | END EnterFunc; |
||
715 | |||
716 | |||
7597 | akron1 | 717 | BEGIN |
7693 | akron1 | 718 | EnterProc(unit, "ASSERT", stASSERT); |
719 | EnterProc(unit, "DEC", stDEC); |
||
720 | EnterProc(unit, "EXCL", stEXCL); |
||
721 | EnterProc(unit, "INC", stINC); |
||
722 | EnterProc(unit, "INCL", stINCL); |
||
723 | EnterProc(unit, "NEW", stNEW); |
||
724 | EnterProc(unit, "COPY", stCOPY); |
||
7597 | akron1 | 725 | |
7693 | akron1 | 726 | EnterFunc(unit, "ABS", stABS); |
727 | EnterFunc(unit, "ASR", stASR); |
||
728 | EnterFunc(unit, "CHR", stCHR); |
||
729 | EnterFunc(unit, "LEN", stLEN); |
||
730 | EnterFunc(unit, "LSL", stLSL); |
||
731 | EnterFunc(unit, "ODD", stODD); |
||
732 | EnterFunc(unit, "ORD", stORD); |
||
733 | EnterFunc(unit, "ROR", stROR); |
||
734 | EnterFunc(unit, "BITS", stBITS); |
||
735 | EnterFunc(unit, "LSR", stLSR); |
||
736 | EnterFunc(unit, "LENGTH", stLENGTH); |
||
737 | EnterFunc(unit, "MIN", stMIN); |
||
738 | EnterFunc(unit, "MAX", stMAX); |
||
739 | |||
740 | IF unit.program.target.sys # mConst.Target_iMSP430 THEN |
||
741 | EnterProc(unit, "PACK", stPACK); |
||
742 | EnterProc(unit, "UNPK", stUNPK); |
||
743 | EnterProc(unit, "DISPOSE", stDISPOSE); |
||
744 | |||
745 | EnterFunc(unit, "WCHR", stWCHR); |
||
746 | EnterFunc(unit, "FLOOR", stFLOOR); |
||
747 | EnterFunc(unit, "FLT", stFLT) |
||
748 | END |
||
749 | |||
7597 | akron1 | 750 | END enterStProcs; |
751 | |||
752 | |||
7693 | akron1 | 753 | PROCEDURE newUnit* (program: PROGRAM; name: SCAN.IDENT): UNIT; |
7597 | akron1 | 754 | VAR |
7693 | akron1 | 755 | unit: UNIT; |
7597 | akron1 | 756 | |
757 | BEGIN |
||
7693 | akron1 | 758 | ASSERT(program # NIL); |
7597 | akron1 | 759 | ASSERT(name # NIL); |
760 | |||
761 | NEW(unit); |
||
762 | |||
7693 | akron1 | 763 | unit.program := program; |
7597 | akron1 | 764 | unit.name := name; |
765 | unit.closed := FALSE; |
||
7693 | akron1 | 766 | unit.idents := LISTS.create(NIL); |
7597 | akron1 | 767 | unit.frwPointers := LISTS.create(NIL); |
768 | |||
7693 | akron1 | 769 | ASSERT(openScope(unit, NIL)); |
7597 | akron1 | 770 | |
7693 | akron1 | 771 | enterStTypes(unit, program); |
7597 | akron1 | 772 | enterStProcs(unit); |
773 | |||
7693 | akron1 | 774 | ASSERT(openScope(unit, NIL)); |
7597 | akron1 | 775 | |
776 | unit.gscope := unit.idents.last(IDENT); |
||
777 | |||
7693 | akron1 | 778 | LISTS.push(program.units, unit); |
7597 | akron1 | 779 | |
780 | unit.scopeLvl := 0; |
||
781 | unit.scopes[0] := NIL; |
||
782 | |||
783 | unit.sysimport := FALSE; |
||
784 | |||
785 | IF unit.name.s = mConst.RTL_NAME THEN |
||
7693 | akron1 | 786 | program.rtl := unit |
7597 | akron1 | 787 | END |
788 | |||
789 | RETURN unit |
||
7693 | akron1 | 790 | END newUnit; |
7597 | akron1 | 791 | |
792 | |||
7693 | akron1 | 793 | PROCEDURE getField* (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; |
7597 | akron1 | 794 | VAR |
7693 | akron1 | 795 | field: FIELD; |
7597 | akron1 | 796 | |
797 | BEGIN |
||
798 | ASSERT(self # NIL); |
||
799 | ASSERT(name # NIL); |
||
800 | ASSERT(unit # NIL); |
||
801 | |||
802 | field := NIL; |
||
803 | WHILE (self # NIL) & (field = NIL) DO |
||
804 | |||
805 | field := self.fields.first(FIELD); |
||
806 | |||
807 | WHILE (field # NIL) & (field.name # name) DO |
||
808 | field := field.next(FIELD) |
||
809 | END; |
||
810 | |||
811 | IF field = NIL THEN |
||
812 | self := self.base |
||
813 | END |
||
814 | |||
815 | END; |
||
816 | |||
817 | IF (field # NIL) & (self.unit # unit) & ~field.export THEN |
||
818 | field := NIL |
||
819 | END |
||
820 | |||
821 | RETURN field |
||
822 | END getField; |
||
823 | |||
824 | |||
7693 | akron1 | 825 | PROCEDURE addField* (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; |
7597 | akron1 | 826 | VAR |
7693 | akron1 | 827 | field: FIELD; |
828 | res: BOOLEAN; |
||
7597 | akron1 | 829 | |
830 | BEGIN |
||
831 | ASSERT(name # NIL); |
||
832 | |||
833 | res := getField(self, name, self.unit) = NIL; |
||
834 | |||
835 | IF res THEN |
||
836 | NEW(field); |
||
837 | |||
838 | field.name := name; |
||
839 | field.export := export; |
||
840 | field.type := NIL; |
||
841 | field.offset := self.size; |
||
842 | |||
843 | LISTS.push(self.fields, field) |
||
844 | END |
||
845 | |||
846 | RETURN res |
||
847 | END addField; |
||
848 | |||
849 | |||
7693 | akron1 | 850 | PROCEDURE setFields* (self: TYPE_; type: TYPE_): BOOLEAN; |
7597 | akron1 | 851 | VAR |
852 | item: FIELD; |
||
853 | res: BOOLEAN; |
||
854 | |||
855 | BEGIN |
||
856 | ASSERT(type # NIL); |
||
857 | |||
858 | item := self.fields.first(FIELD); |
||
859 | |||
860 | WHILE (item # NIL) & (item.type # NIL) DO |
||
861 | item := item.next(FIELD) |
||
862 | END; |
||
863 | |||
864 | res := TRUE; |
||
865 | |||
866 | WHILE res & (item # NIL) & (item.type = NIL) DO |
||
867 | item.type := type; |
||
868 | IF ~self.noalign THEN |
||
7693 | akron1 | 869 | res := UTILS.Align(self.size, type.align) |
7597 | akron1 | 870 | ELSE |
871 | res := TRUE |
||
872 | END; |
||
873 | item.offset := self.size; |
||
874 | res := res & (UTILS.maxint - self.size >= type.size); |
||
875 | IF res THEN |
||
876 | INC(self.size, type.size) |
||
877 | END; |
||
878 | item := item.next(FIELD) |
||
879 | END |
||
880 | |||
881 | RETURN res |
||
882 | END setFields; |
||
883 | |||
884 | |||
7693 | akron1 | 885 | PROCEDURE getParam* (self: TYPE_; name: SCAN.IDENT): PARAM; |
7597 | akron1 | 886 | VAR |
7693 | akron1 | 887 | item: PARAM; |
7597 | akron1 | 888 | |
889 | BEGIN |
||
890 | ASSERT(name # NIL); |
||
891 | |||
892 | item := self.params.first(PARAM); |
||
893 | |||
894 | WHILE (item # NIL) & (item.name # name) DO |
||
895 | item := item.next(PARAM) |
||
896 | END |
||
897 | |||
898 | RETURN item |
||
899 | END getParam; |
||
900 | |||
901 | |||
7693 | akron1 | 902 | PROCEDURE addParam* (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; |
7597 | akron1 | 903 | VAR |
7693 | akron1 | 904 | param: PARAM; |
905 | res: BOOLEAN; |
||
7597 | akron1 | 906 | |
907 | BEGIN |
||
908 | ASSERT(name # NIL); |
||
909 | |||
7693 | akron1 | 910 | res := getParam(self, name) = NIL; |
7597 | akron1 | 911 | |
912 | IF res THEN |
||
913 | NEW(param); |
||
914 | |||
915 | param.name := name; |
||
916 | param.type := NIL; |
||
917 | param.vPar := vPar; |
||
918 | |||
919 | LISTS.push(self.params, param) |
||
920 | END |
||
921 | |||
922 | RETURN res |
||
923 | END addParam; |
||
924 | |||
925 | |||
926 | PROCEDURE Dim* (t: TYPE_): INTEGER; |
||
927 | VAR |
||
928 | res: INTEGER; |
||
929 | |||
930 | BEGIN |
||
931 | res := 0; |
||
932 | WHILE isOpenArray(t) DO |
||
933 | t := t.base; |
||
934 | INC(res) |
||
935 | END |
||
936 | RETURN res |
||
937 | END Dim; |
||
938 | |||
939 | |||
940 | PROCEDURE OpenBase* (t: TYPE_): TYPE_; |
||
941 | BEGIN |
||
942 | WHILE isOpenArray(t) DO t := t.base END |
||
943 | RETURN t |
||
944 | END OpenBase; |
||
945 | |||
946 | |||
7693 | akron1 | 947 | PROCEDURE getFloatParamsPos* (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET; |
7597 | akron1 | 948 | VAR |
949 | res: SET; |
||
950 | param: PARAM; |
||
951 | |||
952 | BEGIN |
||
953 | res := {}; |
||
954 | int := 0; |
||
955 | flt := 0; |
||
956 | param := self.params.first(PARAM); |
||
957 | WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO |
||
958 | IF ~param.vPar & (param.type.typ = tREAL) THEN |
||
959 | INCL(res, param.offset - STACK_FRAME); |
||
960 | INC(flt) |
||
961 | END; |
||
962 | param := param.next(PARAM) |
||
963 | END; |
||
964 | |||
7693 | akron1 | 965 | int := self.parSize - flt |
7597 | akron1 | 966 | |
967 | RETURN res |
||
968 | END getFloatParamsPos; |
||
969 | |||
970 | |||
7693 | akron1 | 971 | PROCEDURE setParams* (self: TYPE_; type: TYPE_); |
7597 | akron1 | 972 | VAR |
973 | item: LISTS.ITEM; |
||
974 | param: PARAM; |
||
975 | word, size: INTEGER; |
||
976 | |||
977 | BEGIN |
||
978 | ASSERT(type # NIL); |
||
979 | |||
7693 | akron1 | 980 | word := UTILS.target.bit_depth DIV 8; |
7597 | akron1 | 981 | |
982 | item := self.params.first; |
||
983 | |||
984 | WHILE (item # NIL) & (item(PARAM).type # NIL) DO |
||
985 | item := item.next |
||
986 | END; |
||
987 | |||
988 | WHILE (item # NIL) & (item(PARAM).type = NIL) DO |
||
989 | param := item(PARAM); |
||
990 | param.type := type; |
||
991 | IF param.vPar THEN |
||
992 | IF type.typ = tRECORD THEN |
||
993 | size := 2 |
||
994 | ELSIF isOpenArray(type) THEN |
||
995 | size := Dim(type) + 1 |
||
996 | ELSE |
||
997 | size := 1 |
||
998 | END; |
||
7693 | akron1 | 999 | param.offset := self.parSize + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; |
1000 | INC(self.parSize, size) |
||
7597 | akron1 | 1001 | ELSE |
1002 | IF type.typ IN {tRECORD, tARRAY} THEN |
||
1003 | IF isOpenArray(type) THEN |
||
1004 | size := Dim(type) + 1 |
||
1005 | ELSE |
||
1006 | size := 1 |
||
1007 | END |
||
1008 | ELSE |
||
1009 | size := type.size; |
||
7693 | akron1 | 1010 | ASSERT(UTILS.Align(size, word)); |
7597 | akron1 | 1011 | size := size DIV word |
1012 | END; |
||
7693 | akron1 | 1013 | param.offset := self.parSize + Dim(type) + STACK_FRAME; |
1014 | INC(self.parSize, size) |
||
7597 | akron1 | 1015 | END; |
1016 | |||
1017 | item := item.next |
||
1018 | END |
||
1019 | |||
1020 | END setParams; |
||
1021 | |||
1022 | |||
7693 | akron1 | 1023 | PROCEDURE enterType* (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; |
7597 | akron1 | 1024 | VAR |
7693 | akron1 | 1025 | t: TYPE_; |
7597 | akron1 | 1026 | |
1027 | BEGIN |
||
1028 | NEW(t); |
||
1029 | |||
1030 | t.typ := typ; |
||
1031 | t.size := size; |
||
1032 | t.length := length; |
||
1033 | t.align := 0; |
||
1034 | t.base := NIL; |
||
7693 | akron1 | 1035 | t.fields := LISTS.create(NIL); |
1036 | t.params := LISTS.create(NIL); |
||
7597 | akron1 | 1037 | t.unit := unit; |
1038 | t.num := 0; |
||
7693 | akron1 | 1039 | |
1040 | CASE program.target.bit_depth OF |
||
1041 | |16: t.call := default16 |
||
1042 | |32: t.call := default32 |
||
1043 | |64: t.call := default64 |
||
7597 | akron1 | 1044 | END; |
7693 | akron1 | 1045 | |
7597 | akron1 | 1046 | t.import := FALSE; |
1047 | t.noalign := FALSE; |
||
7693 | akron1 | 1048 | t.parSize := 0; |
7597 | akron1 | 1049 | |
1050 | IF typ IN {tARRAY, tRECORD} THEN |
||
1051 | t.closed := FALSE; |
||
1052 | IF typ = tRECORD THEN |
||
1053 | INC(program.recCount); |
||
1054 | t.num := program.recCount |
||
1055 | END |
||
1056 | ELSE |
||
1057 | t.closed := TRUE |
||
1058 | END; |
||
1059 | |||
1060 | LISTS.push(program.types, t) |
||
1061 | |||
1062 | RETURN t |
||
1063 | END enterType; |
||
1064 | |||
1065 | |||
7693 | akron1 | 1066 | PROCEDURE getType* (program: PROGRAM; typ: INTEGER): TYPE_; |
7597 | akron1 | 1067 | VAR |
1068 | res: TYPE_; |
||
1069 | |||
1070 | BEGIN |
||
1071 | |||
7696 | akron1 | 1072 | CASE typ OF |
1073 | |ARITH.tINTEGER: res := program.stTypes.tINTEGER |
||
1074 | |ARITH.tREAL: res := program.stTypes.tREAL |
||
1075 | |ARITH.tSET: res := program.stTypes.tSET |
||
1076 | |ARITH.tBOOLEAN: res := program.stTypes.tBOOLEAN |
||
1077 | |ARITH.tCHAR: res := program.stTypes.tCHAR |
||
1078 | |ARITH.tWCHAR: res := program.stTypes.tWCHAR |
||
1079 | |ARITH.tSTRING: res := program.stTypes.tSTRING |
||
1080 | END |
||
7597 | akron1 | 1081 | |
1082 | RETURN res |
||
1083 | END getType; |
||
1084 | |||
1085 | |||
1086 | PROCEDURE createSysUnit (program: PROGRAM); |
||
1087 | VAR |
||
1088 | ident: IDENT; |
||
1089 | unit: UNIT; |
||
1090 | |||
1091 | |||
1092 | PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); |
||
1093 | VAR |
||
1094 | ident: IDENT; |
||
1095 | BEGIN |
||
1096 | ident := addIdent(sys, SCAN.enterid(name), idtyp); |
||
1097 | ident.stproc := proc; |
||
1098 | ident.export := TRUE |
||
1099 | END EnterProc; |
||
1100 | |||
1101 | |||
1102 | BEGIN |
||
7693 | akron1 | 1103 | unit := newUnit(program, SCAN.enterid("$SYSTEM")); |
7597 | akron1 | 1104 | |
1105 | EnterProc(unit, "ADR", idSYSFUNC, sysADR); |
||
1106 | EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE); |
||
1107 | EnterProc(unit, "SADR", idSYSFUNC, sysSADR); |
||
1108 | EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID); |
||
1109 | |||
1110 | EnterProc(unit, "GET", idSYSPROC, sysGET); |
||
7693 | akron1 | 1111 | EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); |
7597 | akron1 | 1112 | EnterProc(unit, "PUT", idSYSPROC, sysPUT); |
1113 | EnterProc(unit, "CODE", idSYSPROC, sysCODE); |
||
1114 | EnterProc(unit, "MOVE", idSYSPROC, sysMOVE); |
||
7693 | akron1 | 1115 | (* |
1116 | IF program.target.sys = mConst.Target_iMSP430 THEN |
||
1117 | EnterProc(unit, "NOP", idSYSPROC, sysNOP); |
||
1118 | EnterProc(unit, "EINT", idSYSPROC, sysEINT); |
||
1119 | EnterProc(unit, "DINT", idSYSPROC, sysDINT) |
||
1120 | END; |
||
1121 | *) |
||
1122 | IF program.target.sys # mConst.Target_iMSP430 THEN |
||
1123 | EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); |
||
1124 | EnterProc(unit, "INF", idSYSFUNC, sysINF); |
||
1125 | EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); |
||
1126 | EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); |
||
1127 | EnterProc(unit, "COPY", idSYSPROC, sysCOPY); |
||
7597 | akron1 | 1128 | |
7693 | akron1 | 1129 | ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); |
1130 | ident.type := program.stTypes.tCARD32; |
||
1131 | ident.export := TRUE |
||
1132 | END; |
||
7597 | akron1 | 1133 | |
7693 | akron1 | 1134 | closeUnit(unit); |
7597 | akron1 | 1135 | |
1136 | program.sysunit := unit |
||
1137 | END createSysUnit; |
||
1138 | |||
1139 | |||
1140 | PROCEDURE DelUnused* (program: PROGRAM; DelImport: DELIMPORT); |
||
1141 | VAR |
||
7693 | akron1 | 1142 | proc: PROC; |
1143 | flag: BOOLEAN; |
||
7597 | akron1 | 1144 | |
1145 | |||
1146 | PROCEDURE process (proc: PROC); |
||
1147 | VAR |
||
1148 | used_proc: LISTS.ITEM; |
||
1149 | |||
1150 | BEGIN |
||
1151 | proc.processed := TRUE; |
||
1152 | |||
1153 | used_proc := proc.using.first; |
||
1154 | WHILE used_proc # NIL DO |
||
1155 | used_proc(USED_PROC).proc.used := TRUE; |
||
1156 | used_proc := used_proc.next |
||
1157 | END |
||
1158 | |||
1159 | END process; |
||
1160 | |||
1161 | |||
1162 | BEGIN |
||
1163 | |||
1164 | REPEAT |
||
1165 | flag := FALSE; |
||
1166 | proc := program.procs.first(PROC); |
||
1167 | |||
1168 | WHILE proc # NIL DO |
||
1169 | IF proc.used & ~proc.processed THEN |
||
1170 | process(proc); |
||
1171 | flag := TRUE |
||
1172 | END; |
||
1173 | proc := proc.next(PROC) |
||
1174 | END |
||
1175 | |||
1176 | UNTIL ~flag; |
||
1177 | |||
1178 | proc := program.procs.first(PROC); |
||
1179 | |||
1180 | WHILE proc # NIL DO |
||
1181 | IF ~proc.used THEN |
||
1182 | IF proc.import = NIL THEN |
||
7693 | akron1 | 1183 | IL.delete2(proc.enter, proc.leave) |
7597 | akron1 | 1184 | ELSE |
1185 | DelImport(proc.import) |
||
1186 | END |
||
1187 | END; |
||
1188 | proc := proc.next(PROC) |
||
1189 | END |
||
1190 | |||
1191 | END DelUnused; |
||
1192 | |||
1193 | |||
7693 | akron1 | 1194 | PROCEDURE create* (bit_depth, target: INTEGER; options: OPTIONS): PROGRAM; |
7597 | akron1 | 1195 | VAR |
1196 | program: PROGRAM; |
||
1197 | |||
1198 | BEGIN |
||
1199 | idents := C.create(); |
||
1200 | |||
7693 | akron1 | 1201 | UTILS.SetBitDepth(bit_depth); |
7597 | akron1 | 1202 | NEW(program); |
1203 | |||
1204 | program.target.bit_depth := bit_depth; |
||
1205 | program.target.word := bit_depth DIV 8; |
||
1206 | program.target.adr := bit_depth DIV 8; |
||
7693 | akron1 | 1207 | program.target.sys := target; |
1208 | program.target.options := options; |
||
7597 | akron1 | 1209 | |
7693 | akron1 | 1210 | CASE target OF |
1211 | |mConst.Target_iConsole, |
||
1212 | mConst.Target_iGUI, |
||
1213 | mConst.Target_iDLL: program.target.sysflags := {sf_windows, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
||
1214 | |||
1215 | |mConst.Target_iELF32, |
||
1216 | mConst.Target_iELFSO32: program.target.sysflags := {sf_linux, sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
||
1217 | |||
1218 | |mConst.Target_iKolibri, |
||
1219 | mConst.Target_iObject: program.target.sysflags := {sf_stdcall, sf_ccall, sf_ccall16, sf_noalign} |
||
1220 | |||
1221 | |mConst.Target_iConsole64, |
||
1222 | mConst.Target_iGUI64, |
||
1223 | mConst.Target_iDLL64: program.target.sysflags := {sf_windows, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
||
1224 | |||
1225 | |mConst.Target_iELF64, |
||
1226 | mConst.Target_iELFSO64: program.target.sysflags := {sf_linux, sf_stdcall64, sf_win64, sf_systemv, sf_noalign} |
||
1227 | |||
1228 | |mConst.Target_iMSP430: program.target.sysflags := {sf_code} |
||
1229 | END; |
||
1230 | |||
7597 | akron1 | 1231 | program.recCount := -1; |
1232 | program.bss := 0; |
||
1233 | |||
7693 | akron1 | 1234 | program.units := LISTS.create(NIL); |
7597 | akron1 | 1235 | program.types := LISTS.create(NIL); |
1236 | program.procs := LISTS.create(NIL); |
||
1237 | |||
1238 | program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL); |
||
1239 | program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); |
||
1240 | program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); |
||
1241 | program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL); |
||
1242 | program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); |
||
7693 | akron1 | 1243 | |
1244 | IF target # mConst.Target_iMSP430 THEN |
||
1245 | program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); |
||
1246 | program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); |
||
1247 | program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL) |
||
1248 | END; |
||
1249 | |||
1250 | program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL); |
||
1251 | program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL); |
||
1252 | |||
1253 | program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); |
||
7597 | akron1 | 1254 | program.stTypes.tANYREC.closed := TRUE; |
1255 | |||
1256 | program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; |
||
1257 | program.stTypes.tBYTE.align := 1; |
||
1258 | program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; |
||
1259 | program.stTypes.tSET.align := program.stTypes.tSET.size; |
||
1260 | program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; |
||
1261 | |||
7693 | akron1 | 1262 | IF target # mConst.Target_iMSP430 THEN |
1263 | program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; |
||
1264 | program.stTypes.tREAL.align := program.stTypes.tREAL.size; |
||
1265 | program.stTypes.tCARD32.align := program.stTypes.tCARD32.size |
||
1266 | END; |
||
7597 | akron1 | 1267 | |
1268 | program.dll := FALSE; |
||
1269 | program.obj := FALSE; |
||
1270 | |||
1271 | createSysUnit(program) |
||
1272 | |||
1273 | RETURN program |
||
1274 | END create; |
||
1275 | |||
1276 | |||
7696 | akron1 | 1277 | END PROG.=>> |