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