Rev 7696 | Rev 8097 | 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 | |||
7983 | leency | 4 | Copyright (c) 2018-2020, Anton Krotov |
7597 | akron1 | 5 | All rights reserved. |
6 | *) |
||
7 | |||
8 | MODULE STATEMENTS; |
||
9 | |||
10 | IMPORT |
||
11 | |||
7983 | leency | 12 | PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, |
13 | ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS; |
||
7597 | akron1 | 14 | |
15 | |||
16 | CONST |
||
17 | |||
18 | eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR; |
||
19 | eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC; |
||
20 | eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC; |
||
21 | eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC; |
||
22 | eIMP = PARS.eIMP; |
||
23 | |||
7693 | akron1 | 24 | errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4; |
25 | errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8; |
||
7597 | akron1 | 26 | errCHR = 9; errWCHR = 10; errBYTE = 11; |
27 | |||
28 | chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5; |
||
29 | |||
30 | chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; |
||
31 | |||
32 | |||
33 | TYPE |
||
34 | |||
35 | isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN; |
||
36 | |||
37 | RANGE = RECORD |
||
38 | |||
39 | a, b: INTEGER |
||
40 | |||
41 | END; |
||
42 | |||
43 | CASE_LABEL = POINTER TO rCASE_LABEL; |
||
44 | |||
45 | rCASE_LABEL = RECORD (AVL.DATA) |
||
46 | |||
47 | range: RANGE; |
||
48 | |||
49 | variant, self: INTEGER; |
||
50 | |||
51 | type: PROG.TYPE_; |
||
52 | |||
53 | prev: CASE_LABEL |
||
54 | |||
55 | END; |
||
56 | |||
57 | CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM) |
||
58 | |||
7693 | akron1 | 59 | label: INTEGER; |
60 | cmd: IL.COMMAND; |
||
61 | processed: BOOLEAN |
||
7597 | akron1 | 62 | |
63 | END; |
||
64 | |||
65 | |||
66 | VAR |
||
67 | |||
7693 | akron1 | 68 | Options: PROG.OPTIONS; |
7597 | akron1 | 69 | |
7693 | akron1 | 70 | begcall, endcall: IL.COMMAND; |
7597 | akron1 | 71 | |
72 | CaseLabels, CaseVar: C.COLLECTION; |
||
73 | |||
74 | CaseVariants: LISTS.LIST; |
||
75 | |||
7693 | akron1 | 76 | CPU: INTEGER; |
7597 | akron1 | 77 | |
7693 | akron1 | 78 | tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_; |
79 | |||
80 | |||
7597 | akron1 | 81 | PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; |
82 | RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC} |
||
83 | END isExpr; |
||
84 | |||
85 | |||
86 | PROCEDURE isVar (e: PARS.EXPR): BOOLEAN; |
||
87 | RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC} |
||
88 | END isVar; |
||
89 | |||
90 | |||
91 | PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 92 | RETURN isExpr(e) & (e.type = tBOOLEAN) |
7597 | akron1 | 93 | END isBoolean; |
94 | |||
95 | |||
96 | PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 97 | RETURN isExpr(e) & (e.type = tINTEGER) |
7597 | akron1 | 98 | END isInteger; |
99 | |||
100 | |||
101 | PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 102 | RETURN isExpr(e) & (e.type = tBYTE) |
7597 | akron1 | 103 | END isByte; |
104 | |||
105 | |||
106 | PROCEDURE isInt (e: PARS.EXPR): BOOLEAN; |
||
107 | RETURN isByte(e) OR isInteger(e) |
||
108 | END isInt; |
||
109 | |||
110 | |||
111 | PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 112 | RETURN isExpr(e) & (e.type = tREAL) |
7597 | akron1 | 113 | END isReal; |
114 | |||
115 | |||
116 | PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 117 | RETURN isExpr(e) & (e.type = tSET) |
7597 | akron1 | 118 | END isSet; |
119 | |||
120 | |||
121 | PROCEDURE isString (e: PARS.EXPR): BOOLEAN; |
||
122 | RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR}) |
||
123 | END isString; |
||
124 | |||
125 | |||
126 | PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN; |
||
127 | RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) |
||
128 | END isStringW; |
||
129 | |||
130 | |||
131 | PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 132 | RETURN isExpr(e) & (e.type = tCHAR) |
7597 | akron1 | 133 | END isChar; |
134 | |||
135 | |||
136 | PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; |
||
7693 | akron1 | 137 | RETURN isExpr(e) & (e.type = tWCHAR) |
7597 | akron1 | 138 | END isCharW; |
139 | |||
140 | |||
141 | PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; |
||
142 | RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) |
||
143 | END isPtr; |
||
144 | |||
145 | |||
146 | PROCEDURE isRec (e: PARS.EXPR): BOOLEAN; |
||
147 | RETURN isExpr(e) & (e.type.typ = PROG.tRECORD) |
||
148 | END isRec; |
||
149 | |||
150 | |||
7693 | akron1 | 151 | PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN; |
152 | RETURN isRec(e) OR isPtr(e) |
||
153 | END isRecPtr; |
||
154 | |||
155 | |||
7597 | akron1 | 156 | PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; |
157 | RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) |
||
158 | END isArr; |
||
159 | |||
160 | |||
161 | PROCEDURE isProc (e: PARS.EXPR): BOOLEAN; |
||
162 | RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) |
||
163 | END isProc; |
||
164 | |||
165 | |||
166 | PROCEDURE isNil (e: PARS.EXPR): BOOLEAN; |
||
167 | RETURN e.type.typ = PROG.tNIL |
||
168 | END isNil; |
||
169 | |||
170 | |||
7693 | akron1 | 171 | PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; |
172 | RETURN isArr(e) & (e.type.base = tCHAR) |
||
173 | END isCharArray; |
||
174 | |||
175 | |||
176 | PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; |
||
177 | RETURN isArr(e) & (e.type.base = tWCHAR) |
||
178 | END isCharArrayW; |
||
179 | |||
180 | |||
181 | PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; |
||
182 | RETURN isCharArray(e) OR isCharArrayW(e) |
||
183 | END isCharArrayX; |
||
184 | |||
185 | |||
186 | PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION); |
||
7597 | akron1 | 187 | BEGIN |
7693 | akron1 | 188 | pos.line := parser.lex.pos.line; |
189 | pos.col := parser.lex.pos.col; |
||
190 | pos.parser := parser |
||
7597 | akron1 | 191 | END getpos; |
192 | |||
193 | |||
7693 | akron1 | 194 | PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION); |
7597 | akron1 | 195 | BEGIN |
7693 | akron1 | 196 | PARS.Next(parser); |
197 | getpos(parser, pos) |
||
7597 | akron1 | 198 | END NextPos; |
199 | |||
200 | |||
201 | PROCEDURE strlen (e: PARS.EXPR): INTEGER; |
||
202 | VAR |
||
203 | res: INTEGER; |
||
204 | |||
205 | BEGIN |
||
206 | ASSERT(isString(e)); |
||
7693 | akron1 | 207 | IF e.type = tCHAR THEN |
7597 | akron1 | 208 | res := 1 |
209 | ELSE |
||
210 | res := LENGTH(e.value.string(SCAN.IDENT).s) |
||
211 | END |
||
212 | RETURN res |
||
213 | END strlen; |
||
214 | |||
215 | |||
216 | PROCEDURE _length (s: ARRAY OF CHAR): INTEGER; |
||
217 | VAR |
||
218 | i, res: INTEGER; |
||
219 | |||
220 | BEGIN |
||
221 | i := 0; |
||
222 | res := 0; |
||
223 | WHILE (i < LEN(s)) & (s[i] # 0X) DO |
||
224 | IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN |
||
225 | INC(res) |
||
226 | END; |
||
227 | INC(i) |
||
228 | END |
||
229 | |||
230 | RETURN res |
||
231 | END _length; |
||
232 | |||
233 | |||
234 | PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER; |
||
235 | VAR |
||
236 | res: INTEGER; |
||
237 | |||
238 | BEGIN |
||
239 | ASSERT(isStringW(e)); |
||
240 | IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN |
||
241 | res := 1 |
||
242 | ELSE |
||
243 | res := _length(e.value.string(SCAN.IDENT).s) |
||
244 | END |
||
245 | RETURN res |
||
246 | END utf8strlen; |
||
247 | |||
248 | |||
249 | PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER; |
||
250 | VAR |
||
251 | res: ARRAY 2 OF WCHAR; |
||
252 | |||
253 | BEGIN |
||
254 | ASSERT(STRINGS.Utf8To16(s, res) = 1) |
||
255 | RETURN ORD(res[0]) |
||
256 | END StrToWChar; |
||
257 | |||
258 | |||
259 | PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN; |
||
260 | RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1) |
||
261 | END isStringW1; |
||
262 | |||
263 | |||
264 | PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN; |
||
265 | VAR |
||
266 | res: BOOLEAN; |
||
267 | |||
268 | BEGIN |
||
269 | IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
||
7696 | akron1 | 270 | |
271 | IF t = e.type THEN |
||
7597 | akron1 | 272 | res := TRUE |
273 | ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
||
7693 | akron1 | 274 | IF (e.obj = eCONST) & (t = tBYTE) THEN |
7597 | akron1 | 275 | res := ARITH.range(e.value, 0, 255) |
276 | ELSE |
||
277 | res := TRUE |
||
278 | END |
||
7696 | akron1 | 279 | ELSIF |
280 | (e.obj = eCONST) & isChar(e) & (t = tWCHAR) |
||
281 | OR isStringW1(e) & (t = tWCHAR) |
||
282 | OR PROG.isBaseOf(t, e.type) |
||
283 | OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) |
||
284 | OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) |
||
285 | OR PROG.arrcomp(e.type, t) |
||
286 | OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e)) |
||
287 | OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e)) |
||
288 | THEN |
||
7597 | akron1 | 289 | res := TRUE |
290 | ELSE |
||
291 | res := FALSE |
||
292 | END |
||
293 | ELSE |
||
294 | res := FALSE |
||
295 | END |
||
7696 | akron1 | 296 | |
7597 | akron1 | 297 | RETURN res |
298 | END assigncomp; |
||
299 | |||
300 | |||
301 | PROCEDURE String (e: PARS.EXPR): INTEGER; |
||
302 | VAR |
||
303 | offset: INTEGER; |
||
304 | string: SCAN.IDENT; |
||
305 | |||
306 | BEGIN |
||
307 | IF strlen(e) # 1 THEN |
||
308 | string := e.value.string(SCAN.IDENT); |
||
309 | IF string.offset = -1 THEN |
||
7693 | akron1 | 310 | string.offset := IL.putstr(string.s); |
7597 | akron1 | 311 | END; |
312 | offset := string.offset |
||
313 | ELSE |
||
7693 | akron1 | 314 | offset := IL.putstr1(ARITH.Int(e.value)) |
7597 | akron1 | 315 | END |
316 | |||
317 | RETURN offset |
||
318 | END String; |
||
319 | |||
320 | |||
321 | PROCEDURE StringW (e: PARS.EXPR): INTEGER; |
||
322 | VAR |
||
323 | offset: INTEGER; |
||
324 | string: SCAN.IDENT; |
||
325 | |||
326 | BEGIN |
||
327 | IF utf8strlen(e) # 1 THEN |
||
328 | string := e.value.string(SCAN.IDENT); |
||
329 | IF string.offsetW = -1 THEN |
||
7693 | akron1 | 330 | string.offsetW := IL.putstrW(string.s); |
7597 | akron1 | 331 | END; |
332 | offset := string.offsetW |
||
333 | ELSE |
||
334 | IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN |
||
7693 | akron1 | 335 | offset := IL.putstrW1(ARITH.Int(e.value)) |
7597 | akron1 | 336 | ELSE (* e.type.typ = PROG.tSTRING *) |
337 | string := e.value.string(SCAN.IDENT); |
||
338 | IF string.offsetW = -1 THEN |
||
7693 | akron1 | 339 | string.offsetW := IL.putstrW(string.s); |
7597 | akron1 | 340 | END; |
341 | offset := string.offsetW |
||
342 | END |
||
343 | END |
||
344 | |||
345 | RETURN offset |
||
346 | END StringW; |
||
347 | |||
348 | |||
349 | PROCEDURE CheckRange (range, line, errno: INTEGER); |
||
350 | VAR |
||
351 | label: INTEGER; |
||
352 | |||
353 | BEGIN |
||
7693 | akron1 | 354 | label := IL.NewLabel(); |
355 | IL.AddCmd2(IL.opCHKIDX, label, range); |
||
356 | IL.OnError(line, errno); |
||
357 | IL.SetLabel(label) |
||
7597 | akron1 | 358 | END CheckRange; |
359 | |||
360 | |||
361 | PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; |
||
362 | VAR |
||
7983 | leency | 363 | res: BOOLEAN; |
364 | label: INTEGER; |
||
7597 | akron1 | 365 | |
366 | BEGIN |
||
367 | IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN |
||
368 | res := TRUE; |
||
7696 | akron1 | 369 | IF PROG.arrcomp(e.type, VarType) THEN |
7597 | akron1 | 370 | |
371 | IF ~PROG.isOpenArray(VarType) THEN |
||
7693 | akron1 | 372 | IL.Const(VarType.length) |
7597 | akron1 | 373 | END; |
7693 | akron1 | 374 | IL.AddCmd(IL.opCOPYA, VarType.base.size); |
375 | label := IL.NewLabel(); |
||
376 | IL.AddJmpCmd(IL.opJE, label); |
||
377 | IL.OnError(line, errCOPY); |
||
378 | IL.SetLabel(label) |
||
7597 | akron1 | 379 | |
380 | ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN |
||
7693 | akron1 | 381 | IF VarType = tINTEGER THEN |
7597 | akron1 | 382 | IF e.obj = eCONST THEN |
7693 | akron1 | 383 | IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
7597 | akron1 | 384 | ELSE |
7693 | akron1 | 385 | IL.AddCmd0(IL.opSAVE) |
7597 | akron1 | 386 | END |
387 | ELSE |
||
388 | IF e.obj = eCONST THEN |
||
389 | res := ARITH.range(e.value, 0, 255); |
||
390 | IF res THEN |
||
7693 | akron1 | 391 | IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) |
7597 | akron1 | 392 | END |
393 | ELSE |
||
7693 | akron1 | 394 | IF chkBYTE IN Options.checking THEN |
395 | label := IL.NewLabel(); |
||
396 | IL.AddCmd2(IL.opCHKBYTE, label, 0); |
||
397 | IL.OnError(line, errBYTE); |
||
398 | IL.SetLabel(label) |
||
7597 | akron1 | 399 | END; |
7693 | akron1 | 400 | IL.AddCmd0(IL.opSAVE8) |
7597 | akron1 | 401 | END |
402 | END |
||
7693 | akron1 | 403 | ELSIF isSet(e) & (VarType = tSET) THEN |
7597 | akron1 | 404 | IF e.obj = eCONST THEN |
7693 | akron1 | 405 | IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
7597 | akron1 | 406 | ELSE |
7693 | akron1 | 407 | IL.AddCmd0(IL.opSAVE) |
7597 | akron1 | 408 | END |
7693 | akron1 | 409 | ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN |
7597 | akron1 | 410 | IF e.obj = eCONST THEN |
7693 | akron1 | 411 | IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value)) |
7597 | akron1 | 412 | ELSE |
7693 | akron1 | 413 | IL.AddCmd0(IL.opSBOOL) |
7597 | akron1 | 414 | END |
7693 | akron1 | 415 | ELSIF isReal(e) & (VarType = tREAL) THEN |
7597 | akron1 | 416 | IF e.obj = eCONST THEN |
7693 | akron1 | 417 | IL.Float(ARITH.Float(e.value)) |
7597 | akron1 | 418 | END; |
7983 | leency | 419 | IL.savef(e.obj = eCONST) |
7693 | akron1 | 420 | ELSIF isChar(e) & (VarType = tCHAR) THEN |
7597 | akron1 | 421 | IF e.obj = eCONST THEN |
7693 | akron1 | 422 | IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value)) |
7597 | akron1 | 423 | ELSE |
7693 | akron1 | 424 | IL.AddCmd0(IL.opSAVE8) |
7597 | akron1 | 425 | END |
7693 | akron1 | 426 | ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN |
427 | IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) |
||
428 | ELSIF isStringW1(e) & (VarType = tWCHAR) THEN |
||
429 | IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) |
||
430 | ELSIF isCharW(e) & (VarType = tWCHAR) THEN |
||
7597 | akron1 | 431 | IF e.obj = eCONST THEN |
7693 | akron1 | 432 | IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value)) |
7597 | akron1 | 433 | ELSE |
7693 | akron1 | 434 | IL.AddCmd0(IL.opSAVE16) |
7597 | akron1 | 435 | END |
436 | ELSIF PROG.isBaseOf(VarType, e.type) THEN |
||
437 | IF VarType.typ = PROG.tPOINTER THEN |
||
7693 | akron1 | 438 | IL.AddCmd0(IL.opSAVE) |
7597 | akron1 | 439 | ELSE |
7693 | akron1 | 440 | IL.AddCmd(IL.opCOPY, VarType.size) |
7597 | akron1 | 441 | END |
442 | ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN |
||
7693 | akron1 | 443 | IL.AddCmd0(IL.opSAVE32) |
7597 | akron1 | 444 | ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN |
445 | IF e.obj = ePROC THEN |
||
7693 | akron1 | 446 | IL.AssignProc(e.ident.proc.label) |
7597 | akron1 | 447 | ELSIF e.obj = eIMP THEN |
7693 | akron1 | 448 | IL.AssignImpProc(e.ident.import) |
7597 | akron1 | 449 | ELSE |
450 | IF VarType.typ = PROG.tPROCEDURE THEN |
||
7693 | akron1 | 451 | IL.AddCmd0(IL.opSAVE) |
7597 | akron1 | 452 | ELSE |
7693 | akron1 | 453 | IL.AddCmd(IL.opCOPY, VarType.size) |
7597 | akron1 | 454 | END |
455 | END |
||
456 | ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN |
||
7693 | akron1 | 457 | IL.AddCmd(IL.opSAVEC, 0) |
458 | ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN |
||
459 | IL.saves(String(e), strlen(e) + 1) |
||
460 | ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN |
||
461 | IL.saves(StringW(e), (utf8strlen(e) + 1) * 2) |
||
7597 | akron1 | 462 | ELSE |
463 | res := FALSE |
||
464 | END |
||
465 | ELSE |
||
466 | res := FALSE |
||
467 | END |
||
468 | RETURN res |
||
469 | END assign; |
||
470 | |||
471 | |||
472 | PROCEDURE LoadConst (e: PARS.EXPR); |
||
473 | BEGIN |
||
7693 | akron1 | 474 | IL.Const(ARITH.Int(e.value)) |
7597 | akron1 | 475 | END LoadConst; |
476 | |||
477 | |||
7693 | akron1 | 478 | PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM); |
479 | VAR |
||
480 | stroffs: INTEGER; |
||
7597 | akron1 | 481 | |
482 | PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; |
||
483 | VAR |
||
484 | t1, t2: PROG.TYPE_; |
||
485 | |||
486 | BEGIN |
||
487 | t1 := p.type; |
||
488 | t2 := e.type; |
||
489 | WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO |
||
490 | t1 := t1.base; |
||
491 | t2 := t2.base |
||
492 | END |
||
493 | |||
494 | RETURN PROG.isTypeEq(t1, t2) |
||
495 | END arrcomp; |
||
496 | |||
497 | |||
498 | PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; |
||
499 | VAR |
||
500 | res: INTEGER; |
||
7983 | leency | 501 | |
7597 | akron1 | 502 | BEGIN |
503 | REPEAT |
||
504 | res := t.length; |
||
505 | t := t.base; |
||
506 | DEC(n) |
||
507 | UNTIL (n < 0) OR (t.typ # PROG.tARRAY); |
||
508 | ASSERT(n < 0) |
||
509 | RETURN res |
||
510 | END ArrLen; |
||
511 | |||
512 | |||
513 | PROCEDURE OpenArray (t, t2: PROG.TYPE_); |
||
514 | VAR |
||
7983 | leency | 515 | n, d1, d2: INTEGER; |
516 | |||
7597 | akron1 | 517 | BEGIN |
518 | IF t.length # 0 THEN |
||
7693 | akron1 | 519 | IL.Param1; |
7597 | akron1 | 520 | n := PROG.Dim(t2) - 1; |
521 | WHILE n >= 0 DO |
||
7693 | akron1 | 522 | IL.Const(ArrLen(t, n)); |
523 | IL.Param1; |
||
7597 | akron1 | 524 | DEC(n) |
525 | END |
||
526 | ELSE |
||
527 | d1 := PROG.Dim(t); |
||
528 | d2 := PROG.Dim(t2); |
||
529 | IF d1 # d2 THEN |
||
530 | n := d2 - d1; |
||
531 | WHILE d2 > d1 DO |
||
7693 | akron1 | 532 | IL.Const(ArrLen(t, d2 - 1)); |
7597 | akron1 | 533 | DEC(d2) |
534 | END; |
||
535 | d2 := PROG.Dim(t2); |
||
536 | WHILE n > 0 DO |
||
7693 | akron1 | 537 | IL.AddCmd(IL.opROT, d2); |
7597 | akron1 | 538 | DEC(n) |
539 | END |
||
540 | END; |
||
7693 | akron1 | 541 | IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1) |
7597 | akron1 | 542 | END |
543 | END OpenArray; |
||
544 | |||
545 | |||
546 | BEGIN |
||
547 | IF p.vPar THEN |
||
548 | |||
7693 | akron1 | 549 | PARS.check(isVar(e), pos, 93); |
7597 | akron1 | 550 | IF p.type.typ = PROG.tRECORD THEN |
7693 | akron1 | 551 | PARS.check(PROG.isBaseOf(p.type, e.type), pos, 66); |
7597 | akron1 | 552 | IF e.obj = eVREC THEN |
553 | IF e.ident # NIL THEN |
||
7693 | akron1 | 554 | IL.AddCmd(IL.opVADR, e.ident.offset - 1) |
7597 | akron1 | 555 | ELSE |
7693 | akron1 | 556 | IL.AddCmd0(IL.opPUSHT) |
7597 | akron1 | 557 | END |
558 | ELSE |
||
7693 | akron1 | 559 | IL.Const(e.type.num) |
7597 | akron1 | 560 | END; |
7693 | akron1 | 561 | IL.AddCmd(IL.opPARAM, 2) |
7597 | akron1 | 562 | ELSIF PROG.isOpenArray(p.type) THEN |
7693 | akron1 | 563 | PARS.check(arrcomp(e, p), pos, 66); |
7597 | akron1 | 564 | OpenArray(e.type, p.type) |
565 | ELSE |
||
7693 | akron1 | 566 | PARS.check(PROG.isTypeEq(e.type, p.type), pos, 66); |
567 | IL.Param1 |
||
7597 | akron1 | 568 | END; |
7693 | akron1 | 569 | PARS.check(~e.readOnly, pos, 94) |
7597 | akron1 | 570 | |
571 | ELSE |
||
7693 | akron1 | 572 | PARS.check(isExpr(e) OR isProc(e), pos, 66); |
7597 | akron1 | 573 | IF PROG.isOpenArray(p.type) THEN |
574 | IF e.type.typ = PROG.tARRAY THEN |
||
7693 | akron1 | 575 | PARS.check(arrcomp(e, p), pos, 66); |
7597 | akron1 | 576 | OpenArray(e.type, p.type) |
7693 | akron1 | 577 | ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tCHAR) THEN |
578 | IL.StrAdr(String(e)); |
||
579 | IL.Param1; |
||
580 | IL.Const(strlen(e) + 1); |
||
581 | IL.Param1 |
||
582 | ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base = tWCHAR) THEN |
||
583 | IL.StrAdr(StringW(e)); |
||
584 | IL.Param1; |
||
585 | IL.Const(utf8strlen(e) + 1); |
||
586 | IL.Param1 |
||
7597 | akron1 | 587 | ELSE |
7693 | akron1 | 588 | PARS.error(pos, 66) |
7597 | akron1 | 589 | END |
590 | ELSE |
||
7693 | akron1 | 591 | PARS.check(~PROG.isOpenArray(e.type), pos, 66); |
592 | PARS.check(assigncomp(e, p.type), pos, 66); |
||
7597 | akron1 | 593 | IF e.obj = eCONST THEN |
7693 | akron1 | 594 | IF e.type = tREAL THEN |
595 | IL.Float(ARITH.Float(e.value)); |
||
596 | IL.pushf |
||
7597 | akron1 | 597 | ELSIF e.type.typ = PROG.tNIL THEN |
7693 | akron1 | 598 | IL.Const(0); |
599 | IL.Param1 |
||
600 | ELSIF isStringW1(e) & (p.type = tWCHAR) THEN |
||
601 | IL.Const(StrToWChar(e.value.string(SCAN.IDENT).s)); |
||
602 | IL.Param1 |
||
7597 | akron1 | 603 | ELSIF (e.type.typ = PROG.tSTRING) OR |
604 | (e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN |
||
7693 | akron1 | 605 | IF p.type.base = tCHAR THEN |
606 | stroffs := String(e); |
||
607 | IL.StrAdr(stroffs); |
||
7983 | leency | 608 | IF (CPU = TARGETS.cpuMSP430) & (p.type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN |
7693 | akron1 | 609 | ERRORS.WarningMsg(pos.line, pos.col, 0) |
610 | END |
||
7597 | akron1 | 611 | ELSE (* WCHAR *) |
7693 | akron1 | 612 | stroffs := StringW(e); |
613 | IL.StrAdr(stroffs) |
||
7597 | akron1 | 614 | END; |
7696 | akron1 | 615 | IL.set_dmin(stroffs + p.type.size); |
7693 | akron1 | 616 | IL.Param1 |
7597 | akron1 | 617 | ELSE |
618 | LoadConst(e); |
||
7693 | akron1 | 619 | IL.Param1 |
7597 | akron1 | 620 | END |
621 | ELSIF e.obj = ePROC THEN |
||
7693 | akron1 | 622 | PARS.check(e.ident.global, pos, 85); |
623 | IL.PushProc(e.ident.proc.label); |
||
624 | IL.Param1 |
||
7597 | akron1 | 625 | ELSIF e.obj = eIMP THEN |
7693 | akron1 | 626 | IL.PushImpProc(e.ident.import); |
627 | IL.Param1 |
||
628 | ELSIF isExpr(e) & (e.type = tREAL) THEN |
||
629 | IL.pushf |
||
7597 | akron1 | 630 | ELSE |
7693 | akron1 | 631 | IF (p.type = tBYTE) & (e.type = tINTEGER) & (chkBYTE IN Options.checking) THEN |
7597 | akron1 | 632 | CheckRange(256, pos.line, errBYTE) |
633 | END; |
||
7693 | akron1 | 634 | IL.Param1 |
7597 | akron1 | 635 | END |
636 | END |
||
637 | |||
638 | END |
||
639 | END paramcomp; |
||
640 | |||
641 | |||
7693 | akron1 | 642 | PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
643 | BEGIN |
||
644 | parser.expression(parser, e) |
||
645 | END PExpression; |
||
646 | |||
647 | |||
7597 | akron1 | 648 | PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); |
649 | VAR |
||
7983 | leency | 650 | e1, e2: PARS.EXPR; |
651 | pos: PARS.POSITION; |
||
652 | proc, |
||
653 | label, |
||
654 | n, i: INTEGER; |
||
655 | code: ARITH.VALUE; |
||
656 | wchar, |
||
657 | comma: BOOLEAN; |
||
7597 | akron1 | 658 | cmd1, |
7983 | leency | 659 | cmd2: IL.COMMAND; |
7597 | akron1 | 660 | |
661 | |||
7693 | akron1 | 662 | PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); |
7597 | akron1 | 663 | BEGIN |
664 | parser.designator(parser, e); |
||
7693 | akron1 | 665 | PARS.check(isVar(e), pos, 93); |
666 | PARS.check(isfunc(e), pos, 66); |
||
7597 | akron1 | 667 | IF readOnly THEN |
7693 | akron1 | 668 | PARS.check(~e.readOnly, pos, 94) |
7597 | akron1 | 669 | END |
670 | END varparam; |
||
671 | |||
672 | |||
673 | PROCEDURE shift_minmax (proc: INTEGER): CHAR; |
||
674 | VAR |
||
675 | res: CHAR; |
||
7983 | leency | 676 | |
7597 | akron1 | 677 | BEGIN |
678 | CASE proc OF |
||
679 | |PROG.stASR: res := "A" |
||
680 | |PROG.stLSL: res := "L" |
||
681 | |PROG.stROR: res := "O" |
||
682 | |PROG.stLSR: res := "R" |
||
683 | |PROG.stMIN: res := "m" |
||
684 | |PROG.stMAX: res := "x" |
||
685 | END |
||
686 | RETURN res |
||
687 | END shift_minmax; |
||
688 | |||
689 | |||
690 | BEGIN |
||
691 | ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC}); |
||
7693 | akron1 | 692 | proc := e.stproc; |
7597 | akron1 | 693 | |
7693 | akron1 | 694 | (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) |
695 | PARS.checklex(parser, SCAN.lxLROUND); |
||
696 | PARS.Next(parser); |
||
697 | (* END; *) |
||
698 | |||
7597 | akron1 | 699 | getpos(parser, pos); |
700 | |||
701 | IF e.obj IN {eSYSPROC, eSYSFUNC} THEN |
||
702 | IF parser.unit.scopeLvl > 0 THEN |
||
7693 | akron1 | 703 | parser.unit.scopes[parser.unit.scopeLvl].enter(IL.COMMAND).allocReg := FALSE |
7597 | akron1 | 704 | END |
705 | END; |
||
706 | |||
707 | IF e.obj IN {eSTPROC, eSYSPROC} THEN |
||
708 | |||
709 | CASE proc OF |
||
710 | |PROG.stASSERT: |
||
7693 | akron1 | 711 | PExpression(parser, e); |
712 | PARS.check(isBoolean(e), pos, 66); |
||
7597 | akron1 | 713 | IF e.obj = eCONST THEN |
714 | IF ~ARITH.getBool(e.value) THEN |
||
7693 | akron1 | 715 | IL.OnError(pos.line, errASSERT) |
7597 | akron1 | 716 | END |
717 | ELSE |
||
7693 | akron1 | 718 | label := IL.NewLabel(); |
719 | IL.AddJmpCmd(IL.opJE, label); |
||
720 | IL.OnError(pos.line, errASSERT); |
||
721 | IL.SetLabel(label) |
||
7597 | akron1 | 722 | END |
723 | |||
724 | |PROG.stINC, PROG.stDEC: |
||
7693 | akron1 | 725 | IL.pushBegEnd(begcall, endcall); |
7597 | akron1 | 726 | varparam(parser, pos, isInt, TRUE, e); |
7693 | akron1 | 727 | IF e.type = tINTEGER THEN |
7597 | akron1 | 728 | IF parser.sym = SCAN.lxCOMMA THEN |
729 | NextPos(parser, pos); |
||
7693 | akron1 | 730 | IL.setlast(begcall); |
731 | PExpression(parser, e2); |
||
732 | IL.setlast(endcall.prev(IL.COMMAND)); |
||
733 | PARS.check(isInt(e2), pos, 66); |
||
7597 | akron1 | 734 | IF e2.obj = eCONST THEN |
7693 | akron1 | 735 | IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1)) |
7597 | akron1 | 736 | ELSE |
7693 | akron1 | 737 | IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC)) |
7597 | akron1 | 738 | END |
739 | ELSE |
||
7693 | akron1 | 740 | IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1) |
7597 | akron1 | 741 | END |
7693 | akron1 | 742 | ELSE (* e.type = tBYTE *) |
7597 | akron1 | 743 | IF parser.sym = SCAN.lxCOMMA THEN |
744 | NextPos(parser, pos); |
||
7693 | akron1 | 745 | IL.setlast(begcall); |
746 | PExpression(parser, e2); |
||
747 | IL.setlast(endcall.prev(IL.COMMAND)); |
||
748 | PARS.check(isInt(e2), pos, 66); |
||
7597 | akron1 | 749 | IF e2.obj = eCONST THEN |
7693 | akron1 | 750 | IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) |
7597 | akron1 | 751 | ELSE |
7693 | akron1 | 752 | IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC)) |
7597 | akron1 | 753 | END |
754 | ELSE |
||
7693 | akron1 | 755 | IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1) |
7597 | akron1 | 756 | END |
757 | END; |
||
7693 | akron1 | 758 | IL.popBegEnd(begcall, endcall) |
7597 | akron1 | 759 | |
760 | |PROG.stINCL, PROG.stEXCL: |
||
7693 | akron1 | 761 | IL.pushBegEnd(begcall, endcall); |
7597 | akron1 | 762 | varparam(parser, pos, isSet, TRUE, e); |
763 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
764 | NextPos(parser, pos); |
||
7693 | akron1 | 765 | IL.setlast(begcall); |
766 | PExpression(parser, e2); |
||
767 | IL.setlast(endcall.prev(IL.COMMAND)); |
||
768 | PARS.check(isInt(e2), pos, 66); |
||
7597 | akron1 | 769 | IF e2.obj = eCONST THEN |
7693 | akron1 | 770 | PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56); |
771 | IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) |
||
7597 | akron1 | 772 | ELSE |
7693 | akron1 | 773 | IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL)) |
7597 | akron1 | 774 | END; |
7693 | akron1 | 775 | IL.popBegEnd(begcall, endcall) |
7597 | akron1 | 776 | |
777 | |PROG.stNEW: |
||
778 | varparam(parser, pos, isPtr, TRUE, e); |
||
7983 | leency | 779 | IF CPU = TARGETS.cpuMSP430 THEN |
7693 | akron1 | 780 | PARS.check(e.type.base.size + 16 < Options.ram, pos, 63) |
781 | END; |
||
782 | IL.New(e.type.base.size, e.type.base.num) |
||
7597 | akron1 | 783 | |
784 | |PROG.stDISPOSE: |
||
785 | varparam(parser, pos, isPtr, TRUE, e); |
||
7693 | akron1 | 786 | IL.AddCmd0(IL.opDISP) |
7597 | akron1 | 787 | |
788 | |PROG.stPACK: |
||
789 | varparam(parser, pos, isReal, TRUE, e); |
||
790 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
791 | NextPos(parser, pos); |
||
7693 | akron1 | 792 | PExpression(parser, e2); |
793 | PARS.check(isInt(e2), pos, 66); |
||
7597 | akron1 | 794 | IF e2.obj = eCONST THEN |
7693 | akron1 | 795 | IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value)) |
7597 | akron1 | 796 | ELSE |
7693 | akron1 | 797 | IL.AddCmd0(IL.opPACK) |
7597 | akron1 | 798 | END |
799 | |||
800 | |PROG.stUNPK: |
||
801 | varparam(parser, pos, isReal, TRUE, e); |
||
802 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
803 | NextPos(parser, pos); |
||
804 | varparam(parser, pos, isInteger, TRUE, e2); |
||
7693 | akron1 | 805 | IL.AddCmd0(IL.opUNPK) |
7597 | akron1 | 806 | |
807 | |PROG.stCOPY: |
||
7693 | akron1 | 808 | IL.pushBegEnd(begcall, endcall); |
809 | PExpression(parser, e); |
||
7597 | akron1 | 810 | IF isString(e) OR isCharArray(e) THEN |
811 | wchar := FALSE |
||
812 | ELSIF isStringW(e) OR isCharArrayW(e) THEN |
||
813 | wchar := TRUE |
||
814 | ELSE |
||
7693 | akron1 | 815 | PARS.error(pos, 66) |
7597 | akron1 | 816 | END; |
817 | |||
818 | IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN |
||
7693 | akron1 | 819 | IL.Const(e.type.length) |
7597 | akron1 | 820 | END; |
821 | |||
822 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
823 | NextPos(parser, pos); |
||
7693 | akron1 | 824 | IL.setlast(begcall); |
7597 | akron1 | 825 | |
826 | IF wchar THEN |
||
827 | varparam(parser, pos, isCharArrayW, TRUE, e1) |
||
828 | ELSE |
||
829 | IF e.obj = eCONST THEN |
||
830 | varparam(parser, pos, isCharArrayX, TRUE, e1) |
||
831 | ELSE |
||
832 | varparam(parser, pos, isCharArray, TRUE, e1) |
||
833 | END; |
||
834 | |||
7693 | akron1 | 835 | wchar := e1.type.base = tWCHAR |
7597 | akron1 | 836 | END; |
837 | |||
838 | IF ~PROG.isOpenArray(e1.type) THEN |
||
7693 | akron1 | 839 | IL.Const(e1.type.length) |
7597 | akron1 | 840 | END; |
841 | |||
7693 | akron1 | 842 | IL.setlast(endcall.prev(IL.COMMAND)); |
843 | |||
7597 | akron1 | 844 | IF e.obj = eCONST THEN |
845 | IF wchar THEN |
||
7693 | akron1 | 846 | IL.StrAdr(StringW(e)); |
847 | IL.Const(utf8strlen(e) + 1) |
||
7597 | akron1 | 848 | ELSE |
7693 | akron1 | 849 | IL.StrAdr(String(e)); |
850 | IL.Const(strlen(e) + 1) |
||
851 | END |
||
852 | END; |
||
853 | IL.AddCmd(IL.opCOPYS, e1.type.base.size); |
||
854 | IL.popBegEnd(begcall, endcall) |
||
7597 | akron1 | 855 | |
856 | |PROG.sysGET: |
||
7693 | akron1 | 857 | PExpression(parser, e); |
858 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 859 | PARS.checklex(parser, SCAN.lxCOMMA); |
860 | NextPos(parser, pos); |
||
861 | parser.designator(parser, e2); |
||
7693 | akron1 | 862 | PARS.check(isVar(e2), pos, 93); |
863 | PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
||
864 | IF e.obj = eCONST THEN |
||
865 | IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size) |
||
866 | ELSE |
||
867 | IL.AddCmd(IL.opGET, e2.type.size) |
||
868 | END |
||
7597 | akron1 | 869 | |
870 | |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: |
||
7693 | akron1 | 871 | IL.pushBegEnd(begcall, endcall); |
872 | PExpression(parser, e); |
||
873 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 874 | IF e.obj = eCONST THEN |
875 | LoadConst(e) |
||
876 | END; |
||
877 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
878 | NextPos(parser, pos); |
||
7693 | akron1 | 879 | IL.setlast(begcall); |
880 | PExpression(parser, e2); |
||
881 | PARS.check(isExpr(e2), pos, 66); |
||
7597 | akron1 | 882 | |
883 | IF proc = PROG.sysPUT THEN |
||
7693 | akron1 | 884 | PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66); |
7597 | akron1 | 885 | IF e2.obj = eCONST THEN |
7693 | akron1 | 886 | IF e2.type = tREAL THEN |
7983 | leency | 887 | IL.Float(ARITH.Float(e2.value)); |
7693 | akron1 | 888 | IL.setlast(endcall.prev(IL.COMMAND)); |
7983 | leency | 889 | IL.savef(FALSE) |
7597 | akron1 | 890 | ELSE |
891 | LoadConst(e2); |
||
7693 | akron1 | 892 | IL.setlast(endcall.prev(IL.COMMAND)); |
893 | IL.SysPut(e2.type.size) |
||
7597 | akron1 | 894 | END |
895 | ELSE |
||
7693 | akron1 | 896 | IL.setlast(endcall.prev(IL.COMMAND)); |
897 | IF e2.type = tREAL THEN |
||
7983 | leency | 898 | IL.savef(FALSE) |
7693 | akron1 | 899 | ELSIF e2.type = tBYTE THEN |
900 | IL.SysPut(tINTEGER.size) |
||
7597 | akron1 | 901 | ELSE |
7693 | akron1 | 902 | IL.SysPut(e2.type.size) |
7597 | akron1 | 903 | END |
904 | END |
||
905 | |||
906 | ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN |
||
7696 | akron1 | 907 | PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66); |
7597 | akron1 | 908 | IF e2.obj = eCONST THEN |
909 | LoadConst(e2) |
||
910 | END; |
||
7693 | akron1 | 911 | IL.setlast(endcall.prev(IL.COMMAND)); |
912 | CASE proc OF |
||
913 | |PROG.sysPUT8: IL.SysPut(1) |
||
914 | |PROG.sysPUT16: IL.SysPut(2) |
||
915 | |PROG.sysPUT32: IL.SysPut(4) |
||
7597 | akron1 | 916 | END |
917 | |||
918 | END; |
||
7693 | akron1 | 919 | IL.popBegEnd(begcall, endcall) |
7597 | akron1 | 920 | |
921 | |PROG.sysMOVE: |
||
922 | FOR i := 1 TO 2 DO |
||
7693 | akron1 | 923 | PExpression(parser, e); |
924 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 925 | IF e.obj = eCONST THEN |
926 | LoadConst(e) |
||
927 | END; |
||
928 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
929 | NextPos(parser, pos) |
||
930 | END; |
||
931 | |||
7693 | akron1 | 932 | PExpression(parser, e); |
933 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 934 | IF e.obj = eCONST THEN |
935 | LoadConst(e) |
||
936 | END; |
||
7693 | akron1 | 937 | IL.AddCmd0(IL.opMOVE) |
7597 | akron1 | 938 | |
939 | |PROG.sysCOPY: |
||
940 | FOR i := 1 TO 2 DO |
||
941 | parser.designator(parser, e); |
||
7693 | akron1 | 942 | PARS.check(isVar(e), pos, 93); |
7597 | akron1 | 943 | n := PROG.Dim(e.type); |
944 | WHILE n > 0 DO |
||
7693 | akron1 | 945 | IL.drop; |
7597 | akron1 | 946 | DEC(n) |
947 | END; |
||
948 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
949 | NextPos(parser, pos) |
||
950 | END; |
||
951 | |||
7693 | akron1 | 952 | PExpression(parser, e); |
953 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 954 | IF e.obj = eCONST THEN |
955 | LoadConst(e) |
||
956 | END; |
||
7693 | akron1 | 957 | IL.AddCmd0(IL.opMOVE) |
7597 | akron1 | 958 | |
959 | |PROG.sysCODE: |
||
960 | REPEAT |
||
961 | getpos(parser, pos); |
||
962 | PARS.ConstExpression(parser, code); |
||
7693 | akron1 | 963 | PARS.check(code.typ = ARITH.tINTEGER, pos, 43); |
7983 | leency | 964 | IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
7693 | akron1 | 965 | PARS.check(ARITH.range(code, 0, 255), pos, 42) |
7983 | leency | 966 | ELSIF CPU = TARGETS.cpuTHUMB THEN |
967 | PARS.check(ARITH.range(code, 0, 65535), pos, 110) |
||
7693 | akron1 | 968 | END; |
969 | IL.AddCmd(IL.opCODE, ARITH.getInt(code)); |
||
970 | comma := parser.sym = SCAN.lxCOMMA; |
||
971 | IF comma THEN |
||
7597 | akron1 | 972 | PARS.Next(parser) |
973 | ELSE |
||
974 | PARS.checklex(parser, SCAN.lxRROUND) |
||
7693 | akron1 | 975 | END |
976 | UNTIL (parser.sym = SCAN.lxRROUND) & ~comma |
||
977 | (* |
||
978 | |PROG.sysNOP, PROG.sysDINT, PROG.sysEINT: |
||
979 | IF parser.sym = SCAN.lxLROUND THEN |
||
980 | PARS.Next(parser); |
||
981 | PARS.checklex(parser, SCAN.lxRROUND); |
||
982 | PARS.Next(parser) |
||
983 | END; |
||
984 | ASSERT(CPU = cpuMSP430); |
||
985 | CASE proc OF |
||
986 | |PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H) |
||
987 | |PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H) |
||
988 | |PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H) |
||
989 | END |
||
990 | *) |
||
7597 | akron1 | 991 | END; |
992 | |||
993 | e.obj := eEXPR; |
||
994 | e.type := NIL |
||
995 | |||
996 | ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN |
||
997 | |||
998 | CASE e.stproc OF |
||
999 | |PROG.stABS: |
||
7693 | akron1 | 1000 | PExpression(parser, e); |
1001 | PARS.check(isInt(e) OR isReal(e), pos, 66); |
||
7597 | akron1 | 1002 | IF e.obj = eCONST THEN |
7693 | akron1 | 1003 | PARS.check(ARITH.abs(e.value), pos, 39) |
7597 | akron1 | 1004 | ELSE |
7693 | akron1 | 1005 | IL.abs(isReal(e)) |
7597 | akron1 | 1006 | END |
1007 | |||
1008 | |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX: |
||
7693 | akron1 | 1009 | PExpression(parser, e); |
1010 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 1011 | PARS.checklex(parser, SCAN.lxCOMMA); |
1012 | NextPos(parser, pos); |
||
7693 | akron1 | 1013 | PExpression(parser, e2); |
1014 | PARS.check(isInt(e2), pos, 66); |
||
1015 | e.type := tINTEGER; |
||
7597 | akron1 | 1016 | IF (e.obj = eCONST) & (e2.obj = eCONST) THEN |
1017 | ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) |
||
1018 | ELSE |
||
1019 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1020 | IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) |
7597 | akron1 | 1021 | ELSIF e2.obj = eCONST THEN |
7693 | akron1 | 1022 | IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) |
7597 | akron1 | 1023 | ELSE |
7693 | akron1 | 1024 | IL.shift_minmax(shift_minmax(proc)) |
7597 | akron1 | 1025 | END; |
1026 | e.obj := eEXPR |
||
1027 | END |
||
1028 | |||
1029 | |PROG.stCHR: |
||
7693 | akron1 | 1030 | PExpression(parser, e); |
1031 | PARS.check(isInt(e), pos, 66); |
||
1032 | e.type := tCHAR; |
||
7597 | akron1 | 1033 | IF e.obj = eCONST THEN |
1034 | ARITH.setChar(e.value, ARITH.getInt(e.value)); |
||
7693 | akron1 | 1035 | PARS.check(ARITH.check(e.value), pos, 107) |
7597 | akron1 | 1036 | ELSE |
7693 | akron1 | 1037 | IF chkCHR IN Options.checking THEN |
7597 | akron1 | 1038 | CheckRange(256, pos.line, errCHR) |
1039 | ELSE |
||
7693 | akron1 | 1040 | IL.AddCmd0(IL.opCHR) |
7597 | akron1 | 1041 | END |
1042 | END |
||
1043 | |||
1044 | |PROG.stWCHR: |
||
7693 | akron1 | 1045 | PExpression(parser, e); |
1046 | PARS.check(isInt(e), pos, 66); |
||
1047 | e.type := tWCHAR; |
||
7597 | akron1 | 1048 | IF e.obj = eCONST THEN |
1049 | ARITH.setWChar(e.value, ARITH.getInt(e.value)); |
||
7693 | akron1 | 1050 | PARS.check(ARITH.check(e.value), pos, 101) |
7597 | akron1 | 1051 | ELSE |
7693 | akron1 | 1052 | IF chkWCHR IN Options.checking THEN |
7597 | akron1 | 1053 | CheckRange(65536, pos.line, errWCHR) |
1054 | ELSE |
||
7693 | akron1 | 1055 | IL.AddCmd0(IL.opWCHR) |
7597 | akron1 | 1056 | END |
1057 | END |
||
1058 | |||
1059 | |PROG.stFLOOR: |
||
7693 | akron1 | 1060 | PExpression(parser, e); |
1061 | PARS.check(isReal(e), pos, 66); |
||
1062 | e.type := tINTEGER; |
||
7597 | akron1 | 1063 | IF e.obj = eCONST THEN |
7693 | akron1 | 1064 | PARS.check(ARITH.floor(e.value), pos, 39) |
7597 | akron1 | 1065 | ELSE |
7693 | akron1 | 1066 | IL.floor |
7597 | akron1 | 1067 | END |
1068 | |||
1069 | |PROG.stFLT: |
||
7693 | akron1 | 1070 | PExpression(parser, e); |
1071 | PARS.check(isInt(e), pos, 66); |
||
1072 | e.type := tREAL; |
||
7597 | akron1 | 1073 | IF e.obj = eCONST THEN |
1074 | ARITH.flt(e.value) |
||
1075 | ELSE |
||
7693 | akron1 | 1076 | PARS.check(IL.flt(), pos, 41) |
7597 | akron1 | 1077 | END |
1078 | |||
1079 | |PROG.stLEN: |
||
7693 | akron1 | 1080 | cmd1 := IL.getlast(); |
7597 | akron1 | 1081 | varparam(parser, pos, isArr, FALSE, e); |
1082 | IF e.type.length > 0 THEN |
||
7693 | akron1 | 1083 | cmd2 := IL.getlast(); |
1084 | IL.delete2(cmd1.next, cmd2); |
||
1085 | IL.setlast(cmd1); |
||
7597 | akron1 | 1086 | ASSERT(ARITH.setInt(e.value, e.type.length)); |
1087 | e.obj := eCONST |
||
1088 | ELSE |
||
7693 | akron1 | 1089 | IL.len(PROG.Dim(e.type)) |
7597 | akron1 | 1090 | END; |
7693 | akron1 | 1091 | e.type := tINTEGER |
7597 | akron1 | 1092 | |
1093 | |PROG.stLENGTH: |
||
7693 | akron1 | 1094 | PExpression(parser, e); |
7597 | akron1 | 1095 | IF isCharArray(e) THEN |
1096 | IF e.type.length > 0 THEN |
||
7693 | akron1 | 1097 | IL.Const(e.type.length) |
7597 | akron1 | 1098 | END; |
7693 | akron1 | 1099 | IL.AddCmd0(IL.opLENGTH) |
7597 | akron1 | 1100 | ELSIF isCharArrayW(e) THEN |
1101 | IF e.type.length > 0 THEN |
||
7693 | akron1 | 1102 | IL.Const(e.type.length) |
7597 | akron1 | 1103 | END; |
7693 | akron1 | 1104 | IL.AddCmd0(IL.opLENGTHW) |
7597 | akron1 | 1105 | ELSE |
7693 | akron1 | 1106 | PARS.error(pos, 66); |
7597 | akron1 | 1107 | END; |
7693 | akron1 | 1108 | e.type := tINTEGER |
7597 | akron1 | 1109 | |
1110 | |PROG.stODD: |
||
7693 | akron1 | 1111 | PExpression(parser, e); |
1112 | PARS.check(isInt(e), pos, 66); |
||
1113 | e.type := tBOOLEAN; |
||
7597 | akron1 | 1114 | IF e.obj = eCONST THEN |
1115 | ARITH.odd(e.value) |
||
1116 | ELSE |
||
7983 | leency | 1117 | IL.AddCmd(IL.opMODR, 2) |
7597 | akron1 | 1118 | END |
1119 | |||
1120 | |PROG.stORD: |
||
7693 | akron1 | 1121 | PExpression(parser, e); |
1122 | PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66); |
||
7597 | akron1 | 1123 | IF e.obj = eCONST THEN |
1124 | IF isStringW1(e) THEN |
||
1125 | ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s))) |
||
1126 | ELSE |
||
1127 | ARITH.ord(e.value) |
||
1128 | END |
||
1129 | ELSE |
||
1130 | IF isBoolean(e) THEN |
||
7696 | akron1 | 1131 | IL.AddCmd0(IL.opORD) |
7597 | akron1 | 1132 | END |
1133 | END; |
||
7693 | akron1 | 1134 | e.type := tINTEGER |
7597 | akron1 | 1135 | |
1136 | |PROG.stBITS: |
||
7693 | akron1 | 1137 | PExpression(parser, e); |
1138 | PARS.check(isInt(e), pos, 66); |
||
7597 | akron1 | 1139 | IF e.obj = eCONST THEN |
1140 | ARITH.bits(e.value) |
||
1141 | END; |
||
7693 | akron1 | 1142 | e.type := tSET |
7597 | akron1 | 1143 | |
1144 | |PROG.sysADR: |
||
1145 | parser.designator(parser, e); |
||
1146 | IF isVar(e) THEN |
||
1147 | n := PROG.Dim(e.type); |
||
1148 | WHILE n > 0 DO |
||
7693 | akron1 | 1149 | IL.drop; |
7597 | akron1 | 1150 | DEC(n) |
1151 | END |
||
1152 | ELSIF e.obj = ePROC THEN |
||
7693 | akron1 | 1153 | IL.PushProc(e.ident.proc.label) |
7597 | akron1 | 1154 | ELSIF e.obj = eIMP THEN |
7693 | akron1 | 1155 | IL.PushImpProc(e.ident.import) |
7597 | akron1 | 1156 | ELSE |
7693 | akron1 | 1157 | PARS.error(pos, 108) |
7597 | akron1 | 1158 | END; |
7693 | akron1 | 1159 | e.type := tINTEGER |
7597 | akron1 | 1160 | |
1161 | |PROG.sysSADR: |
||
7693 | akron1 | 1162 | PExpression(parser, e); |
1163 | PARS.check(isString(e), pos, 66); |
||
1164 | IL.StrAdr(String(e)); |
||
1165 | e.type := tINTEGER; |
||
7597 | akron1 | 1166 | e.obj := eEXPR |
1167 | |||
1168 | |PROG.sysWSADR: |
||
7693 | akron1 | 1169 | PExpression(parser, e); |
1170 | PARS.check(isStringW(e), pos, 66); |
||
1171 | IL.StrAdr(StringW(e)); |
||
1172 | e.type := tINTEGER; |
||
7597 | akron1 | 1173 | e.obj := eEXPR |
1174 | |||
1175 | |PROG.sysTYPEID: |
||
7693 | akron1 | 1176 | PExpression(parser, e); |
1177 | PARS.check(e.obj = eTYPE, pos, 68); |
||
7597 | akron1 | 1178 | IF e.type.typ = PROG.tRECORD THEN |
1179 | ASSERT(ARITH.setInt(e.value, e.type.num)) |
||
7693 | akron1 | 1180 | ELSIF e.type.typ = PROG.tPOINTER THEN |
7597 | akron1 | 1181 | ASSERT(ARITH.setInt(e.value, e.type.base.num)) |
1182 | ELSE |
||
7693 | akron1 | 1183 | PARS.error(pos, 52) |
7597 | akron1 | 1184 | END; |
1185 | e.obj := eCONST; |
||
7693 | akron1 | 1186 | e.type := tINTEGER |
7597 | akron1 | 1187 | |
1188 | |PROG.sysINF: |
||
7693 | akron1 | 1189 | PARS.check(IL.inf(), pos, 41); |
7597 | akron1 | 1190 | e.obj := eEXPR; |
7693 | akron1 | 1191 | e.type := tREAL |
7597 | akron1 | 1192 | |
1193 | |PROG.sysSIZE: |
||
7693 | akron1 | 1194 | PExpression(parser, e); |
1195 | PARS.check(e.obj = eTYPE, pos, 68); |
||
7597 | akron1 | 1196 | ASSERT(ARITH.setInt(e.value, e.type.size)); |
1197 | e.obj := eCONST; |
||
7693 | akron1 | 1198 | e.type := tINTEGER |
7597 | akron1 | 1199 | |
1200 | END |
||
1201 | |||
1202 | END; |
||
1203 | |||
7693 | akron1 | 1204 | (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *) |
1205 | PARS.checklex(parser, SCAN.lxRROUND); |
||
1206 | PARS.Next(parser); |
||
1207 | (* END; *) |
||
7597 | akron1 | 1208 | |
1209 | IF e.obj # eCONST THEN |
||
1210 | e.obj := eEXPR |
||
1211 | END |
||
1212 | |||
1213 | END stProc; |
||
1214 | |||
1215 | |||
1216 | PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1217 | VAR |
||
1218 | proc: PROG.TYPE_; |
||
1219 | param: LISTS.ITEM; |
||
1220 | e1: PARS.EXPR; |
||
7693 | akron1 | 1221 | pos: PARS.POSITION; |
7597 | akron1 | 1222 | |
1223 | BEGIN |
||
1224 | ASSERT(parser.sym = SCAN.lxLROUND); |
||
1225 | |||
1226 | IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN |
||
1227 | proc := e.type; |
||
1228 | PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86); |
||
1229 | PARS.Next(parser); |
||
1230 | |||
1231 | param := proc.params.first; |
||
1232 | WHILE param # NIL DO |
||
1233 | getpos(parser, pos); |
||
1234 | |||
7693 | akron1 | 1235 | IL.setlast(begcall); |
7597 | akron1 | 1236 | |
1237 | IF param(PROG.PARAM).vPar THEN |
||
1238 | parser.designator(parser, e1) |
||
1239 | ELSE |
||
7693 | akron1 | 1240 | PExpression(parser, e1) |
7597 | akron1 | 1241 | END; |
1242 | paramcomp(parser, pos, e1, param(PROG.PARAM)); |
||
1243 | param := param.next; |
||
1244 | IF param # NIL THEN |
||
1245 | PARS.checklex(parser, SCAN.lxCOMMA); |
||
1246 | PARS.Next(parser) |
||
1247 | END |
||
1248 | END; |
||
1249 | |||
1250 | PARS.checklex(parser, SCAN.lxRROUND); |
||
1251 | PARS.Next(parser); |
||
1252 | |||
1253 | e.obj := eEXPR; |
||
1254 | e.type := proc.base |
||
1255 | |||
1256 | ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN |
||
1257 | stProc(parser, e) |
||
1258 | ELSE |
||
1259 | PARS.check1(FALSE, parser, 86) |
||
1260 | END |
||
1261 | |||
1262 | END ActualParameters; |
||
1263 | |||
1264 | |||
1265 | PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1266 | VAR |
||
1267 | ident: PROG.IDENT; |
||
1268 | import: BOOLEAN; |
||
7693 | akron1 | 1269 | pos: PARS.POSITION; |
7597 | akron1 | 1270 | |
1271 | BEGIN |
||
1272 | PARS.checklex(parser, SCAN.lxIDENT); |
||
1273 | getpos(parser, pos); |
||
1274 | import := FALSE; |
||
7693 | akron1 | 1275 | ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE); |
7597 | akron1 | 1276 | PARS.check1(ident # NIL, parser, 48); |
1277 | IF ident.typ = PROG.idMODULE THEN |
||
1278 | PARS.ExpectSym(parser, SCAN.lxPOINT); |
||
1279 | PARS.ExpectSym(parser, SCAN.lxIDENT); |
||
7693 | akron1 | 1280 | ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE); |
7597 | akron1 | 1281 | PARS.check1((ident # NIL) & ident.export, parser, 48); |
1282 | import := TRUE |
||
1283 | END; |
||
1284 | PARS.Next(parser); |
||
1285 | |||
1286 | e.readOnly := FALSE; |
||
1287 | e.ident := ident; |
||
1288 | |||
1289 | CASE ident.typ OF |
||
1290 | |PROG.idCONST: |
||
1291 | e.obj := eCONST; |
||
1292 | e.type := ident.type; |
||
1293 | e.value := ident.value |
||
1294 | |PROG.idTYPE: |
||
1295 | e.obj := eTYPE; |
||
1296 | e.type := ident.type |
||
1297 | |PROG.idVAR: |
||
1298 | e.obj := eVAR; |
||
1299 | e.type := ident.type; |
||
1300 | e.readOnly := import |
||
1301 | |PROG.idPROC: |
||
1302 | e.obj := ePROC; |
||
1303 | e.type := ident.type |
||
1304 | |PROG.idIMP: |
||
1305 | e.obj := eIMP; |
||
1306 | e.type := ident.type |
||
1307 | |PROG.idVPAR: |
||
1308 | e.type := ident.type; |
||
1309 | IF e.type.typ = PROG.tRECORD THEN |
||
1310 | e.obj := eVREC |
||
1311 | ELSE |
||
1312 | e.obj := eVPAR |
||
1313 | END |
||
1314 | |PROG.idPARAM: |
||
1315 | e.obj := ePARAM; |
||
1316 | e.type := ident.type; |
||
1317 | e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) |
||
1318 | |PROG.idSTPROC: |
||
1319 | e.obj := eSTPROC; |
||
1320 | e.stproc := ident.stproc |
||
1321 | |PROG.idSTFUNC: |
||
1322 | e.obj := eSTFUNC; |
||
1323 | e.stproc := ident.stproc |
||
1324 | |PROG.idSYSPROC: |
||
1325 | e.obj := eSYSPROC; |
||
1326 | e.stproc := ident.stproc |
||
1327 | |PROG.idSYSFUNC: |
||
7693 | akron1 | 1328 | PARS.check(~parser.constexp, pos, 109); |
7597 | akron1 | 1329 | e.obj := eSYSFUNC; |
1330 | e.stproc := ident.stproc |
||
1331 | |PROG.idNONE: |
||
7693 | akron1 | 1332 | PARS.error(pos, 115) |
7597 | akron1 | 1333 | END; |
1334 | |||
1335 | IF isVar(e) THEN |
||
7693 | akron1 | 1336 | PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105) |
7597 | akron1 | 1337 | END |
1338 | |||
1339 | END qualident; |
||
1340 | |||
1341 | |||
7693 | akron1 | 1342 | PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); |
7597 | akron1 | 1343 | VAR |
7983 | leency | 1344 | label: INTEGER; |
7597 | akron1 | 1345 | |
1346 | BEGIN |
||
1347 | IF load THEN |
||
7693 | akron1 | 1348 | IL.load(e.type.size) |
7597 | akron1 | 1349 | END; |
1350 | |||
7693 | akron1 | 1351 | IF chkPTR IN Options.checking THEN |
1352 | label := IL.NewLabel(); |
||
1353 | IL.AddJmpCmd(IL.opJNZ, label); |
||
1354 | IL.OnError(pos.line, error); |
||
1355 | IL.SetLabel(label) |
||
7597 | akron1 | 1356 | END |
1357 | END deref; |
||
1358 | |||
1359 | |||
1360 | PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1361 | VAR |
||
1362 | field: PROG.FIELD; |
||
7693 | akron1 | 1363 | pos: PARS.POSITION; |
7597 | akron1 | 1364 | t, idx: PARS.EXPR; |
1365 | |||
1366 | |||
1367 | PROCEDURE LoadAdr (e: PARS.EXPR); |
||
1368 | VAR |
||
1369 | offset: INTEGER; |
||
1370 | |||
1371 | PROCEDURE OpenArray (e: PARS.EXPR); |
||
1372 | VAR |
||
1373 | offset, n: INTEGER; |
||
1374 | BEGIN |
||
1375 | offset := e.ident.offset; |
||
1376 | n := PROG.Dim(e.type); |
||
1377 | WHILE n >= 0 DO |
||
7693 | akron1 | 1378 | IL.AddCmd(IL.opVADR, offset); |
7597 | akron1 | 1379 | DEC(offset); |
1380 | DEC(n) |
||
1381 | END |
||
1382 | END OpenArray; |
||
1383 | |||
1384 | |||
1385 | BEGIN |
||
1386 | IF e.obj = eVAR THEN |
||
1387 | offset := PROG.getOffset(PARS.program, e.ident); |
||
1388 | IF e.ident.global THEN |
||
7693 | akron1 | 1389 | IL.AddCmd(IL.opGADR, offset) |
7597 | akron1 | 1390 | ELSE |
7693 | akron1 | 1391 | IL.AddCmd(IL.opLADR, -offset) |
7597 | akron1 | 1392 | END |
1393 | ELSIF e.obj = ePARAM THEN |
||
1394 | IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN |
||
7693 | akron1 | 1395 | IL.AddCmd(IL.opVADR, e.ident.offset) |
7597 | akron1 | 1396 | ELSIF PROG.isOpenArray(e.type) THEN |
1397 | OpenArray(e) |
||
1398 | ELSE |
||
7693 | akron1 | 1399 | IL.AddCmd(IL.opLADR, e.ident.offset) |
7597 | akron1 | 1400 | END |
1401 | ELSIF e.obj IN {eVPAR, eVREC} THEN |
||
1402 | IF PROG.isOpenArray(e.type) THEN |
||
1403 | OpenArray(e) |
||
1404 | ELSE |
||
7693 | akron1 | 1405 | IL.AddCmd(IL.opVADR, e.ident.offset) |
7597 | akron1 | 1406 | END |
1407 | END |
||
1408 | END LoadAdr; |
||
1409 | |||
1410 | |||
7693 | akron1 | 1411 | PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR); |
7597 | akron1 | 1412 | VAR |
7983 | leency | 1413 | label, offset, n, k: INTEGER; |
1414 | type: PROG.TYPE_; |
||
7597 | akron1 | 1415 | |
1416 | BEGIN |
||
1417 | |||
7693 | akron1 | 1418 | IF chkIDX IN Options.checking THEN |
1419 | label := IL.NewLabel(); |
||
1420 | IL.AddCmd2(IL.opCHKIDX2, label, 0); |
||
1421 | IL.OnError(pos.line, errIDX); |
||
1422 | IL.SetLabel(label) |
||
7597 | akron1 | 1423 | ELSE |
7693 | akron1 | 1424 | IL.AddCmd(IL.opCHKIDX2, -1) |
7597 | akron1 | 1425 | END; |
1426 | |||
1427 | type := PROG.OpenBase(e.type); |
||
1428 | IF type.size # 1 THEN |
||
7693 | akron1 | 1429 | IL.AddCmd(IL.opMULC, type.size) |
7597 | akron1 | 1430 | END; |
1431 | n := PROG.Dim(e.type) - 1; |
||
1432 | k := n; |
||
1433 | WHILE n > 0 DO |
||
7693 | akron1 | 1434 | IL.AddCmd0(IL.opMUL); |
7597 | akron1 | 1435 | DEC(n) |
1436 | END; |
||
7693 | akron1 | 1437 | IL.AddCmd0(IL.opADD); |
7597 | akron1 | 1438 | offset := e.ident.offset - 1; |
1439 | n := k; |
||
1440 | WHILE n > 0 DO |
||
7693 | akron1 | 1441 | IL.AddCmd(IL.opVADR, offset); |
7597 | akron1 | 1442 | DEC(offset); |
1443 | DEC(n) |
||
1444 | END |
||
1445 | END OpenIdx; |
||
1446 | |||
1447 | |||
1448 | BEGIN |
||
1449 | qualident(parser, e); |
||
1450 | |||
1451 | IF e.obj IN {ePROC, eIMP} THEN |
||
1452 | PROG.UseProc(parser.unit, e.ident.proc) |
||
1453 | END; |
||
1454 | |||
1455 | IF isVar(e) THEN |
||
1456 | LoadAdr(e) |
||
1457 | END; |
||
1458 | |||
1459 | WHILE parser.sym = SCAN.lxPOINT DO |
||
1460 | getpos(parser, pos); |
||
1461 | PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); |
||
1462 | IF e.type.typ = PROG.tPOINTER THEN |
||
1463 | deref(pos, e, TRUE, errPTR) |
||
1464 | END; |
||
1465 | PARS.ExpectSym(parser, SCAN.lxIDENT); |
||
1466 | IF e.type.typ = PROG.tPOINTER THEN |
||
1467 | e.type := e.type.base; |
||
1468 | e.readOnly := FALSE |
||
1469 | END; |
||
7693 | akron1 | 1470 | field := PROG.getField(e.type, parser.lex.ident, parser.unit); |
7597 | akron1 | 1471 | PARS.check1(field # NIL, parser, 74); |
1472 | e.type := field.type; |
||
1473 | IF e.obj = eVREC THEN |
||
1474 | e.obj := eVPAR |
||
1475 | END; |
||
1476 | IF field.offset # 0 THEN |
||
7693 | akron1 | 1477 | IL.AddCmd(IL.opADDR, field.offset) |
7597 | akron1 | 1478 | END; |
1479 | PARS.Next(parser); |
||
1480 | e.ident := NIL |
||
1481 | |||
1482 | ELSIF parser.sym = SCAN.lxLSQUARE DO |
||
1483 | |||
1484 | REPEAT |
||
1485 | |||
1486 | PARS.check1(isArr(e), parser, 75); |
||
1487 | NextPos(parser, pos); |
||
7693 | akron1 | 1488 | PExpression(parser, idx); |
1489 | PARS.check(isInt(idx), pos, 76); |
||
7597 | akron1 | 1490 | |
1491 | IF idx.obj = eCONST THEN |
||
1492 | IF e.type.length > 0 THEN |
||
7693 | akron1 | 1493 | PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), pos, 83); |
7597 | akron1 | 1494 | IF ARITH.Int(idx.value) > 0 THEN |
7693 | akron1 | 1495 | IL.AddCmd(IL.opADDR, ARITH.Int(idx.value) * e.type.base.size) |
7597 | akron1 | 1496 | END |
1497 | ELSE |
||
7693 | akron1 | 1498 | PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83); |
7597 | akron1 | 1499 | LoadConst(idx); |
1500 | OpenIdx(parser, pos, e) |
||
1501 | END |
||
1502 | ELSE |
||
1503 | IF e.type.length > 0 THEN |
||
7693 | akron1 | 1504 | IF chkIDX IN Options.checking THEN |
7597 | akron1 | 1505 | CheckRange(e.type.length, pos.line, errIDX) |
1506 | END; |
||
1507 | IF e.type.base.size # 1 THEN |
||
7693 | akron1 | 1508 | IL.AddCmd(IL.opMULC, e.type.base.size) |
7597 | akron1 | 1509 | END; |
7693 | akron1 | 1510 | IL.AddCmd0(IL.opADD) |
7597 | akron1 | 1511 | ELSE |
1512 | OpenIdx(parser, pos, e) |
||
1513 | END |
||
1514 | END; |
||
1515 | |||
1516 | e.type := e.type.base |
||
1517 | |||
1518 | UNTIL parser.sym # SCAN.lxCOMMA; |
||
1519 | |||
1520 | PARS.checklex(parser, SCAN.lxRSQUARE); |
||
1521 | PARS.Next(parser); |
||
1522 | e.ident := NIL |
||
1523 | |||
1524 | ELSIF parser.sym = SCAN.lxCARET DO |
||
1525 | getpos(parser, pos); |
||
1526 | PARS.check1(isPtr(e), parser, 77); |
||
1527 | deref(pos, e, TRUE, errPTR); |
||
1528 | e.type := e.type.base; |
||
1529 | e.readOnly := FALSE; |
||
1530 | PARS.Next(parser); |
||
1531 | e.ident := NIL; |
||
1532 | e.obj := eVREC |
||
1533 | |||
1534 | ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO |
||
1535 | |||
1536 | IF e.type.typ = PROG.tRECORD THEN |
||
1537 | PARS.check1(e.obj = eVREC, parser, 78) |
||
1538 | END; |
||
1539 | NextPos(parser, pos); |
||
1540 | qualident(parser, t); |
||
7693 | akron1 | 1541 | PARS.check(t.obj = eTYPE, pos, 79); |
7597 | akron1 | 1542 | |
1543 | IF e.type.typ = PROG.tRECORD THEN |
||
7693 | akron1 | 1544 | PARS.check(t.type.typ = PROG.tRECORD, pos, 80); |
1545 | IF chkGUARD IN Options.checking THEN |
||
7597 | akron1 | 1546 | IF e.ident = NIL THEN |
7693 | akron1 | 1547 | IL.TypeGuard(IL.opTYPEGD, t.type.num, pos.line, errGUARD) |
7597 | akron1 | 1548 | ELSE |
7693 | akron1 | 1549 | IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
1550 | IL.TypeGuard(IL.opTYPEGR, t.type.num, pos.line, errGUARD) |
||
7597 | akron1 | 1551 | END |
1552 | END; |
||
1553 | ELSE |
||
7693 | akron1 | 1554 | PARS.check(t.type.typ = PROG.tPOINTER, pos, 81); |
1555 | IF chkGUARD IN Options.checking THEN |
||
1556 | IL.TypeGuard(IL.opTYPEGP, t.type.base.num, pos.line, errGUARD) |
||
7597 | akron1 | 1557 | END |
1558 | END; |
||
1559 | |||
7693 | akron1 | 1560 | PARS.check(PROG.isBaseOf(e.type, t.type), pos, 82); |
7597 | akron1 | 1561 | |
1562 | e.type := t.type; |
||
1563 | |||
1564 | PARS.checklex(parser, SCAN.lxRROUND); |
||
1565 | PARS.Next(parser) |
||
1566 | |||
1567 | END |
||
1568 | |||
1569 | END designator; |
||
1570 | |||
1571 | |||
7693 | akron1 | 1572 | PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN); |
7597 | akron1 | 1573 | VAR |
7983 | leency | 1574 | cconv, |
1575 | parSize, |
||
1576 | callconv, |
||
1577 | fparSize, |
||
1578 | int, flt, |
||
1579 | stk_par: INTEGER; |
||
7597 | akron1 | 1580 | |
1581 | BEGIN |
||
1582 | cconv := procType.call; |
||
7693 | akron1 | 1583 | parSize := procType.parSize; |
7597 | akron1 | 1584 | |
1585 | IF cconv IN {PROG._win64, PROG.win64} THEN |
||
7693 | akron1 | 1586 | callconv := IL.call_win64; |
1587 | fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4) |
||
7597 | akron1 | 1588 | ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
7693 | akron1 | 1589 | callconv := IL.call_sysv; |
1590 | fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize; |
||
7597 | akron1 | 1591 | stk_par := MAX(0, int - 6) + MAX(0, flt - 8) |
1592 | ELSE |
||
7693 | akron1 | 1593 | callconv := IL.call_stack; |
1594 | fparSize := 0 |
||
7597 | akron1 | 1595 | END; |
7693 | akron1 | 1596 | IL.setlast(begcall); |
1597 | fregs := IL.precall(isfloat); |
||
7597 | akron1 | 1598 | |
1599 | IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
||
7693 | akron1 | 1600 | IL.AddCmd(IL.opALIGN16, parSize) |
7597 | akron1 | 1601 | ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
7693 | akron1 | 1602 | IL.AddCmd(IL.opWIN64ALIGN16, parSize) |
7597 | akron1 | 1603 | ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
7693 | akron1 | 1604 | IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par) |
7597 | akron1 | 1605 | END; |
7693 | akron1 | 1606 | IL.setlast(endcall.prev(IL.COMMAND)); |
7597 | akron1 | 1607 | |
1608 | IF e.obj = eIMP THEN |
||
7693 | akron1 | 1609 | IL.CallImp(e.ident.import, callconv, fparSize) |
7597 | akron1 | 1610 | ELSIF e.obj = ePROC THEN |
7693 | akron1 | 1611 | IL.Call(e.ident.proc.label, callconv, fparSize) |
7597 | akron1 | 1612 | ELSIF isExpr(e) THEN |
1613 | deref(pos, e, CallStat, errPROC); |
||
7693 | akron1 | 1614 | IL.CallP(callconv, fparSize) |
7597 | akron1 | 1615 | END; |
1616 | |||
1617 | IF cconv IN {PROG._ccall16, PROG.ccall16} THEN |
||
7693 | akron1 | 1618 | IL.AddCmd(IL.opCLEANUP, parSize); |
1619 | IL.AddCmd0(IL.opPOPSP) |
||
7597 | akron1 | 1620 | ELSIF cconv IN {PROG._win64, PROG.win64} THEN |
7693 | akron1 | 1621 | IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1); |
1622 | IL.AddCmd0(IL.opPOPSP) |
||
7597 | akron1 | 1623 | ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN |
7693 | akron1 | 1624 | IL.AddCmd(IL.opCLEANUP, parSize + stk_par); |
1625 | IL.AddCmd0(IL.opPOPSP) |
||
1626 | ELSIF cconv IN {PROG._ccall, PROG.ccall, PROG.default16, PROG.code, PROG._code} THEN |
||
1627 | IL.AddCmd(IL.opCLEANUP, parSize) |
||
7597 | akron1 | 1628 | END; |
1629 | |||
1630 | IF ~CallStat THEN |
||
1631 | IF isfloat THEN |
||
7693 | akron1 | 1632 | PARS.check(IL.resf(fregs), pos, 41) |
7597 | akron1 | 1633 | ELSE |
7693 | akron1 | 1634 | IL.res(fregs) |
7597 | akron1 | 1635 | END |
1636 | END |
||
1637 | END ProcCall; |
||
1638 | |||
1639 | |||
1640 | PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1641 | VAR |
||
7693 | akron1 | 1642 | pos, pos0, pos1: PARS.POSITION; |
7597 | akron1 | 1643 | |
1644 | op: INTEGER; |
||
1645 | e1: PARS.EXPR; |
||
1646 | constant: BOOLEAN; |
||
1647 | operator: ARITH.RELATION; |
||
1648 | error: INTEGER; |
||
1649 | |||
1650 | |||
1651 | PROCEDURE relation (sym: INTEGER): BOOLEAN; |
||
1652 | RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR |
||
1653 | (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR |
||
1654 | (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR |
||
1655 | (sym = SCAN.lxIN) OR (sym = SCAN.lxIS) |
||
1656 | END relation; |
||
1657 | |||
1658 | |||
1659 | PROCEDURE AddOperator (sym: INTEGER): BOOLEAN; |
||
1660 | RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR |
||
1661 | (sym = SCAN.lxOR) |
||
1662 | END AddOperator; |
||
1663 | |||
1664 | |||
1665 | PROCEDURE MulOperator (sym: INTEGER): BOOLEAN; |
||
1666 | RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR |
||
1667 | (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR |
||
1668 | (sym = SCAN.lxAND) |
||
1669 | END MulOperator; |
||
1670 | |||
1671 | |||
1672 | PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1673 | VAR |
||
1674 | e1, e2: PARS.EXPR; |
||
7693 | akron1 | 1675 | pos: PARS.POSITION; |
7597 | akron1 | 1676 | range: BOOLEAN; |
1677 | |||
1678 | BEGIN |
||
1679 | range := FALSE; |
||
1680 | getpos(parser, pos); |
||
1681 | expression(parser, e1); |
||
7693 | akron1 | 1682 | PARS.check(isInt(e1), pos, 76); |
7597 | akron1 | 1683 | |
1684 | IF e1.obj = eCONST THEN |
||
7693 | akron1 | 1685 | PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44) |
7597 | akron1 | 1686 | END; |
1687 | |||
1688 | range := parser.sym = SCAN.lxRANGE; |
||
1689 | |||
1690 | IF range THEN |
||
1691 | NextPos(parser, pos); |
||
1692 | expression(parser, e2); |
||
7693 | akron1 | 1693 | PARS.check(isInt(e2), pos, 76); |
7597 | akron1 | 1694 | |
1695 | IF e2.obj = eCONST THEN |
||
7693 | akron1 | 1696 | PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44) |
7597 | akron1 | 1697 | END |
1698 | ELSE |
||
1699 | IF e1.obj = eCONST THEN |
||
1700 | e2 := e1 |
||
1701 | END |
||
1702 | END; |
||
1703 | |||
7693 | akron1 | 1704 | e.type := tSET; |
7597 | akron1 | 1705 | |
1706 | IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN |
||
1707 | ARITH.constrSet(e.value, e1.value, e2.value); |
||
1708 | e.obj := eCONST |
||
1709 | ELSE |
||
1710 | IF range THEN |
||
1711 | IF e1.obj = eCONST THEN |
||
7693 | akron1 | 1712 | IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value)) |
7597 | akron1 | 1713 | ELSIF e2.obj = eCONST THEN |
7693 | akron1 | 1714 | IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value)) |
7597 | akron1 | 1715 | ELSE |
7693 | akron1 | 1716 | IL.AddCmd0(IL.opRSET) |
7597 | akron1 | 1717 | END |
1718 | ELSE |
||
7693 | akron1 | 1719 | IL.AddCmd0(IL.opRSET1) |
7597 | akron1 | 1720 | END; |
1721 | e.obj := eEXPR |
||
1722 | END |
||
1723 | |||
1724 | END element; |
||
1725 | |||
1726 | |||
1727 | PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1728 | VAR |
||
1729 | e1: PARS.EXPR; |
||
1730 | |||
1731 | BEGIN |
||
1732 | ASSERT(parser.sym = SCAN.lxLCURLY); |
||
1733 | |||
1734 | e.obj := eCONST; |
||
7693 | akron1 | 1735 | e.type := tSET; |
7597 | akron1 | 1736 | ARITH.emptySet(e.value); |
1737 | |||
1738 | PARS.Next(parser); |
||
1739 | IF parser.sym # SCAN.lxRCURLY THEN |
||
1740 | element(parser, e1); |
||
1741 | |||
1742 | IF e1.obj = eCONST THEN |
||
1743 | ARITH.opSet(e.value, e1.value, "+") |
||
1744 | ELSE |
||
1745 | e.obj := eEXPR |
||
1746 | END; |
||
1747 | |||
1748 | WHILE parser.sym = SCAN.lxCOMMA DO |
||
1749 | PARS.Next(parser); |
||
1750 | element(parser, e1); |
||
1751 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
||
1752 | ARITH.opSet(e.value, e1.value, "+") |
||
1753 | ELSE |
||
1754 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1755 | IL.AddCmd(IL.opADDSL, ARITH.Int(e.value)) |
7597 | akron1 | 1756 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1757 | IL.AddCmd(IL.opADDSR, ARITH.Int(e1.value)) |
7597 | akron1 | 1758 | ELSE |
7693 | akron1 | 1759 | IL.AddCmd0(IL.opADDS) |
7597 | akron1 | 1760 | END; |
1761 | e.obj := eEXPR |
||
1762 | END |
||
1763 | END; |
||
1764 | PARS.checklex(parser, SCAN.lxRCURLY) |
||
1765 | END; |
||
1766 | PARS.Next(parser); |
||
1767 | END set; |
||
1768 | |||
1769 | |||
1770 | PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1771 | VAR |
||
1772 | sym: INTEGER; |
||
7693 | akron1 | 1773 | pos: PARS.POSITION; |
7597 | akron1 | 1774 | e1: PARS.EXPR; |
1775 | isfloat: BOOLEAN; |
||
1776 | fregs: INTEGER; |
||
1777 | |||
1778 | |||
7693 | akron1 | 1779 | PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION); |
7597 | akron1 | 1780 | BEGIN |
1781 | IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN |
||
7693 | akron1 | 1782 | IF e.type = tREAL THEN |
1783 | PARS.check(IL.loadf(), pos, 41) |
||
7597 | akron1 | 1784 | ELSE |
7693 | akron1 | 1785 | IL.load(e.type.size) |
7597 | akron1 | 1786 | END |
1787 | END |
||
1788 | END LoadVar; |
||
1789 | |||
1790 | |||
1791 | BEGIN |
||
1792 | sym := parser.sym; |
||
1793 | |||
1794 | IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN |
||
1795 | e.obj := eCONST; |
||
1796 | e.value := parser.lex.value; |
||
7693 | akron1 | 1797 | e.type := PROG.getType(PARS.program, e.value.typ); |
7597 | akron1 | 1798 | PARS.Next(parser) |
1799 | |||
1800 | ELSIF sym = SCAN.lxNIL THEN |
||
7693 | akron1 | 1801 | e.obj := eCONST; |
1802 | e.type := PARS.program.stTypes.tNIL; |
||
7597 | akron1 | 1803 | PARS.Next(parser) |
1804 | |||
1805 | ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN |
||
7693 | akron1 | 1806 | e.obj := eCONST; |
7597 | akron1 | 1807 | ARITH.setbool(e.value, sym = SCAN.lxTRUE); |
7693 | akron1 | 1808 | e.type := tBOOLEAN; |
7597 | akron1 | 1809 | PARS.Next(parser) |
1810 | |||
1811 | ELSIF sym = SCAN.lxLCURLY THEN |
||
1812 | set(parser, e) |
||
1813 | |||
1814 | ELSIF sym = SCAN.lxIDENT THEN |
||
1815 | getpos(parser, pos); |
||
1816 | |||
7693 | akron1 | 1817 | IL.pushBegEnd(begcall, endcall); |
7597 | akron1 | 1818 | |
1819 | designator(parser, e); |
||
1820 | IF isVar(e) THEN |
||
1821 | LoadVar(e, parser, pos) |
||
1822 | END; |
||
1823 | IF parser.sym = SCAN.lxLROUND THEN |
||
1824 | e1 := e; |
||
1825 | ActualParameters(parser, e); |
||
7693 | akron1 | 1826 | PARS.check(e.type # NIL, pos, 59); |
1827 | isfloat := e.type = tREAL; |
||
7597 | akron1 | 1828 | IF e1.obj IN {ePROC, eIMP} THEN |
1829 | ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE) |
||
1830 | ELSIF isExpr(e1) THEN |
||
1831 | ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE) |
||
1832 | END |
||
1833 | END; |
||
7693 | akron1 | 1834 | IL.popBegEnd(begcall, endcall) |
7597 | akron1 | 1835 | |
1836 | ELSIF sym = SCAN.lxLROUND THEN |
||
1837 | PARS.Next(parser); |
||
1838 | expression(parser, e); |
||
1839 | PARS.checklex(parser, SCAN.lxRROUND); |
||
1840 | PARS.Next(parser); |
||
1841 | IF isExpr(e) & (e.obj # eCONST) THEN |
||
1842 | e.obj := eEXPR |
||
1843 | END |
||
1844 | |||
1845 | ELSIF sym = SCAN.lxNOT THEN |
||
1846 | NextPos(parser, pos); |
||
1847 | factor(parser, e); |
||
7693 | akron1 | 1848 | PARS.check(isBoolean(e), pos, 72); |
7597 | akron1 | 1849 | IF e.obj # eCONST THEN |
7693 | akron1 | 1850 | IL.not; |
7597 | akron1 | 1851 | e.obj := eEXPR |
1852 | ELSE |
||
1853 | ASSERT(ARITH.neg(e.value)) |
||
1854 | END |
||
1855 | |||
1856 | ELSE |
||
1857 | PARS.check1(FALSE, parser, 34) |
||
1858 | END |
||
1859 | END factor; |
||
1860 | |||
1861 | |||
1862 | PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
1863 | VAR |
||
7693 | akron1 | 1864 | pos: PARS.POSITION; |
7597 | akron1 | 1865 | e1: PARS.EXPR; |
7983 | leency | 1866 | op, label, label1: INTEGER; |
7597 | akron1 | 1867 | |
1868 | BEGIN |
||
1869 | factor(parser, e); |
||
1870 | label := -1; |
||
1871 | |||
1872 | WHILE MulOperator(parser.sym) DO |
||
1873 | op := parser.sym; |
||
1874 | getpos(parser, pos); |
||
1875 | PARS.Next(parser); |
||
1876 | |||
1877 | IF op = SCAN.lxAND THEN |
||
1878 | IF ~parser.constexp THEN |
||
1879 | |||
1880 | IF label = -1 THEN |
||
7693 | akron1 | 1881 | label := IL.NewLabel() |
7597 | akron1 | 1882 | END; |
1883 | |||
1884 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1885 | IL.Const(ORD(ARITH.getBool(e.value))) |
1886 | END; |
||
1887 | IL.AddCmd0(IL.opACC); |
||
1888 | IL.AddJmpCmd(IL.opJZ, label); |
||
1889 | IL.drop |
||
7597 | akron1 | 1890 | END |
1891 | END; |
||
1892 | |||
1893 | factor(parser, e1); |
||
1894 | |||
1895 | CASE op OF |
||
1896 | |SCAN.lxMUL: |
||
7693 | akron1 | 1897 | PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
7597 | akron1 | 1898 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
1899 | |||
1900 | CASE e.value.typ OF |
||
7693 | akron1 | 1901 | |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39) |
1902 | |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40) |
||
7597 | akron1 | 1903 | |ARITH.tSET: ARITH.opSet(e.value, e1.value, "*") |
1904 | END |
||
1905 | |||
1906 | ELSE |
||
1907 | IF isInt(e) THEN |
||
1908 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1909 | IL.AddCmd(IL.opMULC, ARITH.Int(e.value)) |
7597 | akron1 | 1910 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1911 | IL.AddCmd(IL.opMULC, ARITH.Int(e1.value)) |
7597 | akron1 | 1912 | ELSE |
7693 | akron1 | 1913 | IL.AddCmd0(IL.opMUL) |
7597 | akron1 | 1914 | END |
1915 | ELSIF isReal(e) THEN |
||
1916 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1917 | IL.Float(ARITH.Float(e.value)) |
7597 | akron1 | 1918 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1919 | IL.Float(ARITH.Float(e1.value)) |
7597 | akron1 | 1920 | END; |
7693 | akron1 | 1921 | IL.fbinop(IL.opMULF) |
7597 | akron1 | 1922 | ELSIF isSet(e) THEN |
1923 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1924 | IL.AddCmd(IL.opMULSC, ARITH.Int(e.value)) |
7597 | akron1 | 1925 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1926 | IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value)) |
7597 | akron1 | 1927 | ELSE |
7693 | akron1 | 1928 | IL.AddCmd0(IL.opMULS) |
7597 | akron1 | 1929 | END |
1930 | END; |
||
1931 | e.obj := eEXPR |
||
1932 | END |
||
1933 | |||
1934 | |SCAN.lxSLASH: |
||
7693 | akron1 | 1935 | PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
7597 | akron1 | 1936 | IF (e1.obj = eCONST) & isReal(e1) THEN |
7693 | akron1 | 1937 | PARS.check(~ARITH.isZero(e1.value), pos, 45) |
7597 | akron1 | 1938 | END; |
1939 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
||
1940 | |||
1941 | CASE e.value.typ OF |
||
7693 | akron1 | 1942 | |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40) |
7597 | akron1 | 1943 | |ARITH.tSET: ARITH.opSet(e.value, e1.value, "/") |
1944 | END |
||
1945 | |||
1946 | ELSE |
||
1947 | IF isReal(e) THEN |
||
1948 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1949 | IL.Float(ARITH.Float(e.value)); |
1950 | IL.fbinop(IL.opDIVFI) |
||
7597 | akron1 | 1951 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1952 | IL.Float(ARITH.Float(e1.value)); |
1953 | IL.fbinop(IL.opDIVF) |
||
7597 | akron1 | 1954 | ELSE |
7693 | akron1 | 1955 | IL.fbinop(IL.opDIVF) |
7597 | akron1 | 1956 | END |
1957 | ELSIF isSet(e) THEN |
||
1958 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1959 | IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value)) |
7597 | akron1 | 1960 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1961 | IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value)) |
7597 | akron1 | 1962 | ELSE |
7693 | akron1 | 1963 | IL.AddCmd0(IL.opDIVS) |
7597 | akron1 | 1964 | END |
1965 | END; |
||
1966 | e.obj := eEXPR |
||
1967 | END |
||
1968 | |||
1969 | |SCAN.lxDIV, SCAN.lxMOD: |
||
7693 | akron1 | 1970 | PARS.check(isInt(e) & isInt(e1), pos, 37); |
7597 | akron1 | 1971 | IF e1.obj = eCONST THEN |
7983 | leency | 1972 | PARS.check(ARITH.Int(e1.value) > 0, pos, 122) |
7597 | akron1 | 1973 | END; |
1974 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
||
1975 | |||
1976 | IF op = SCAN.lxDIV THEN |
||
7693 | akron1 | 1977 | PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39) |
7597 | akron1 | 1978 | ELSE |
1979 | ASSERT(ARITH.opInt(e.value, e1.value, "M")) |
||
1980 | END |
||
1981 | |||
1982 | ELSE |
||
1983 | IF e1.obj # eCONST THEN |
||
7693 | akron1 | 1984 | label1 := IL.NewLabel(); |
7983 | leency | 1985 | IL.AddJmpCmd(IL.opJG, label1) |
7597 | akron1 | 1986 | END; |
1987 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 1988 | IL.OnError(pos.line, errDIV); |
1989 | IL.SetLabel(label1); |
||
1990 | IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) |
||
7597 | akron1 | 1991 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 1992 | IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) |
7597 | akron1 | 1993 | ELSE |
7693 | akron1 | 1994 | IL.OnError(pos.line, errDIV); |
1995 | IL.SetLabel(label1); |
||
1996 | IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD)) |
||
7597 | akron1 | 1997 | END; |
1998 | e.obj := eEXPR |
||
1999 | END |
||
2000 | |||
2001 | |SCAN.lxAND: |
||
7693 | akron1 | 2002 | PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); |
7597 | akron1 | 2003 | |
2004 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
||
2005 | ARITH.opBoolean(e.value, e1.value, "&") |
||
2006 | ELSE |
||
2007 | e.obj := eEXPR; |
||
2008 | IF e1.obj = eCONST THEN |
||
7693 | akron1 | 2009 | IL.Const(ORD(ARITH.getBool(e1.value))) |
7667 | akron1 | 2010 | END; |
7693 | akron1 | 2011 | IL.AddCmd0(IL.opACC) |
7597 | akron1 | 2012 | END |
2013 | |||
2014 | END |
||
2015 | END; |
||
2016 | |||
2017 | IF label # -1 THEN |
||
7693 | akron1 | 2018 | IL.SetLabel(label) |
7597 | akron1 | 2019 | END |
2020 | END term; |
||
2021 | |||
2022 | |||
2023 | PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); |
||
2024 | VAR |
||
7693 | akron1 | 2025 | pos: PARS.POSITION; |
7597 | akron1 | 2026 | op: INTEGER; |
2027 | e1: PARS.EXPR; |
||
2028 | |||
2029 | plus, minus: BOOLEAN; |
||
2030 | |||
2031 | label: INTEGER; |
||
2032 | |||
2033 | BEGIN |
||
2034 | plus := parser.sym = SCAN.lxPLUS; |
||
2035 | minus := parser.sym = SCAN.lxMINUS; |
||
2036 | |||
2037 | IF plus OR minus THEN |
||
2038 | getpos(parser, pos); |
||
2039 | PARS.Next(parser) |
||
2040 | END; |
||
2041 | |||
2042 | term(parser, e); |
||
2043 | |||
2044 | IF plus OR minus THEN |
||
7693 | akron1 | 2045 | PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36); |
7597 | akron1 | 2046 | |
2047 | IF minus & (e.obj = eCONST) THEN |
||
7693 | akron1 | 2048 | PARS.check(ARITH.neg(e.value), pos, 39) |
7597 | akron1 | 2049 | END; |
2050 | |||
2051 | IF e.obj # eCONST THEN |
||
2052 | IF minus THEN |
||
2053 | IF isInt(e) THEN |
||
7693 | akron1 | 2054 | IL.AddCmd0(IL.opUMINUS) |
7597 | akron1 | 2055 | ELSIF isReal(e) THEN |
7693 | akron1 | 2056 | IL.AddCmd0(IL.opUMINF) |
7597 | akron1 | 2057 | ELSIF isSet(e) THEN |
7693 | akron1 | 2058 | IL.AddCmd0(IL.opUMINS) |
7597 | akron1 | 2059 | END |
2060 | END; |
||
2061 | e.obj := eEXPR |
||
2062 | END |
||
2063 | END; |
||
2064 | |||
2065 | label := -1; |
||
2066 | |||
2067 | WHILE AddOperator(parser.sym) DO |
||
2068 | |||
2069 | op := parser.sym; |
||
2070 | getpos(parser, pos); |
||
2071 | PARS.Next(parser); |
||
2072 | |||
2073 | IF op = SCAN.lxOR THEN |
||
2074 | |||
2075 | IF ~parser.constexp THEN |
||
2076 | |||
2077 | IF label = -1 THEN |
||
7693 | akron1 | 2078 | label := IL.NewLabel() |
7597 | akron1 | 2079 | END; |
2080 | |||
2081 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2082 | IL.Const(ORD(ARITH.getBool(e.value))) |
2083 | END; |
||
2084 | IL.AddCmd0(IL.opACC); |
||
2085 | IL.AddJmpCmd(IL.opJNZ, label); |
||
2086 | IL.drop |
||
7597 | akron1 | 2087 | END |
2088 | |||
2089 | END; |
||
2090 | |||
2091 | term(parser, e1); |
||
2092 | |||
2093 | CASE op OF |
||
2094 | |SCAN.lxPLUS, SCAN.lxMINUS: |
||
2095 | |||
2096 | IF op = SCAN.lxPLUS THEN |
||
2097 | op := ORD("+") |
||
2098 | ELSE |
||
2099 | op := ORD("-") |
||
2100 | END; |
||
2101 | |||
7693 | akron1 | 2102 | PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37); |
7597 | akron1 | 2103 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
2104 | |||
2105 | CASE e.value.typ OF |
||
7693 | akron1 | 2106 | |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39) |
2107 | |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40) |
||
7597 | akron1 | 2108 | |ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op)) |
2109 | END |
||
2110 | |||
2111 | ELSE |
||
2112 | IF isInt(e) THEN |
||
2113 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2114 | IL.AddCmd(IL.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
7597 | akron1 | 2115 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2116 | IL.AddCmd(IL.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
7597 | akron1 | 2117 | ELSE |
7693 | akron1 | 2118 | IL.AddCmd0(IL.opADD + ORD(op = ORD("-"))) |
7597 | akron1 | 2119 | END |
2120 | ELSIF isReal(e) THEN |
||
2121 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2122 | IL.Float(ARITH.Float(e.value)); |
2123 | IL.fbinop(IL.opADDFI + ORD(op = ORD("-"))) |
||
7597 | akron1 | 2124 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2125 | IL.Float(ARITH.Float(e1.value)); |
2126 | IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
||
7597 | akron1 | 2127 | ELSE |
7693 | akron1 | 2128 | IL.fbinop(IL.opADDF + ORD(op = ORD("-"))) |
7597 | akron1 | 2129 | END |
2130 | ELSIF isSet(e) THEN |
||
2131 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2132 | IL.AddCmd(IL.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) |
7597 | akron1 | 2133 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2134 | IL.AddCmd(IL.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) |
7597 | akron1 | 2135 | ELSE |
7693 | akron1 | 2136 | IL.AddCmd0(IL.opADDS + ORD(op = ORD("-"))) |
7597 | akron1 | 2137 | END |
2138 | END; |
||
2139 | e.obj := eEXPR |
||
2140 | END |
||
2141 | |||
2142 | |SCAN.lxOR: |
||
7693 | akron1 | 2143 | PARS.check(isBoolean(e) & isBoolean(e1), pos, 37); |
7597 | akron1 | 2144 | |
2145 | IF (e.obj = eCONST) & (e1.obj = eCONST) THEN |
||
2146 | ARITH.opBoolean(e.value, e1.value, "|") |
||
2147 | ELSE |
||
2148 | e.obj := eEXPR; |
||
2149 | IF e1.obj = eCONST THEN |
||
7693 | akron1 | 2150 | IL.Const(ORD(ARITH.getBool(e1.value))) |
7667 | akron1 | 2151 | END; |
7693 | akron1 | 2152 | IL.AddCmd0(IL.opACC) |
7597 | akron1 | 2153 | END |
2154 | |||
2155 | END |
||
2156 | END; |
||
2157 | |||
2158 | IF label # -1 THEN |
||
7693 | akron1 | 2159 | IL.SetLabel(label) |
7597 | akron1 | 2160 | END |
2161 | |||
2162 | END SimpleExpression; |
||
2163 | |||
2164 | |||
2165 | PROCEDURE cmpcode (op: INTEGER): INTEGER; |
||
2166 | VAR |
||
2167 | res: INTEGER; |
||
7693 | akron1 | 2168 | |
7597 | akron1 | 2169 | BEGIN |
2170 | CASE op OF |
||
2171 | |SCAN.lxEQ: res := 0 |
||
2172 | |SCAN.lxNE: res := 1 |
||
2173 | |SCAN.lxLT: res := 2 |
||
2174 | |SCAN.lxLE: res := 3 |
||
2175 | |SCAN.lxGT: res := 4 |
||
2176 | |SCAN.lxGE: res := 5 |
||
2177 | END |
||
2178 | |||
2179 | RETURN res |
||
2180 | END cmpcode; |
||
2181 | |||
2182 | |||
7693 | akron1 | 2183 | PROCEDURE invcmpcode (op: INTEGER): INTEGER; |
2184 | VAR |
||
2185 | res: INTEGER; |
||
2186 | |||
2187 | BEGIN |
||
2188 | CASE op OF |
||
2189 | |SCAN.lxEQ: res := 0 |
||
2190 | |SCAN.lxNE: res := 1 |
||
2191 | |SCAN.lxLT: res := 4 |
||
2192 | |SCAN.lxLE: res := 5 |
||
2193 | |SCAN.lxGT: res := 2 |
||
2194 | |SCAN.lxGE: res := 3 |
||
2195 | END |
||
2196 | |||
2197 | RETURN res |
||
2198 | END invcmpcode; |
||
2199 | |||
2200 | |||
7597 | akron1 | 2201 | PROCEDURE BoolCmp (eq, val: BOOLEAN); |
2202 | BEGIN |
||
2203 | IF eq = val THEN |
||
7693 | akron1 | 2204 | IL.AddCmd0(IL.opNEC) |
7597 | akron1 | 2205 | ELSE |
7693 | akron1 | 2206 | IL.AddCmd0(IL.opEQC) |
7597 | akron1 | 2207 | END |
2208 | END BoolCmp; |
||
2209 | |||
2210 | |||
2211 | PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN; |
||
2212 | VAR |
||
2213 | res: BOOLEAN; |
||
2214 | |||
2215 | BEGIN |
||
2216 | res := TRUE; |
||
2217 | |||
2218 | IF isString(e) & isCharArray(e1) THEN |
||
7693 | akron1 | 2219 | IL.StrAdr(String(e)); |
2220 | IL.Const(strlen(e) + 1); |
||
2221 | IL.AddCmd0(IL.opEQS + invcmpcode(op)) |
||
7597 | akron1 | 2222 | |
2223 | ELSIF isString(e) & isCharArrayW(e1) THEN |
||
7693 | akron1 | 2224 | IL.StrAdr(StringW(e)); |
2225 | IL.Const(utf8strlen(e) + 1); |
||
2226 | IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
||
7597 | akron1 | 2227 | |
2228 | ELSIF isStringW(e) & isCharArrayW(e1) THEN |
||
7693 | akron1 | 2229 | IL.StrAdr(StringW(e)); |
2230 | IL.Const(utf8strlen(e) + 1); |
||
2231 | IL.AddCmd0(IL.opEQSW + invcmpcode(op)) |
||
7597 | akron1 | 2232 | |
2233 | ELSIF isCharArray(e) & isString(e1) THEN |
||
7693 | akron1 | 2234 | IL.StrAdr(String(e1)); |
2235 | IL.Const(strlen(e1) + 1); |
||
2236 | IL.AddCmd0(IL.opEQS + cmpcode(op)) |
||
7597 | akron1 | 2237 | |
2238 | ELSIF isCharArrayW(e) & isString(e1) THEN |
||
7693 | akron1 | 2239 | IL.StrAdr(StringW(e1)); |
2240 | IL.Const(utf8strlen(e1) + 1); |
||
2241 | IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
||
7597 | akron1 | 2242 | |
2243 | ELSIF isCharArrayW(e) & isStringW(e1) THEN |
||
7693 | akron1 | 2244 | IL.StrAdr(StringW(e1)); |
2245 | IL.Const(utf8strlen(e1) + 1); |
||
2246 | IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
||
7597 | akron1 | 2247 | |
2248 | ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN |
||
7693 | akron1 | 2249 | IL.AddCmd0(IL.opEQSW + cmpcode(op)) |
7597 | akron1 | 2250 | |
2251 | ELSIF isCharArray(e) & isCharArray(e1) THEN |
||
7693 | akron1 | 2252 | IL.AddCmd0(IL.opEQS + cmpcode(op)) |
7597 | akron1 | 2253 | |
2254 | ELSIF isString(e) & isString(e1) THEN |
||
2255 | PARS.strcmp(e.value, e1.value, op) |
||
2256 | |||
2257 | ELSE |
||
2258 | res := FALSE |
||
2259 | |||
2260 | END |
||
2261 | |||
2262 | RETURN res |
||
2263 | END strcmp; |
||
2264 | |||
2265 | |||
2266 | BEGIN |
||
2267 | getpos(parser, pos0); |
||
2268 | SimpleExpression(parser, e); |
||
2269 | IF relation(parser.sym) THEN |
||
2270 | IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN |
||
7693 | akron1 | 2271 | IL.Const(e.type.length) |
7597 | akron1 | 2272 | END; |
2273 | op := parser.sym; |
||
2274 | getpos(parser, pos); |
||
2275 | PARS.Next(parser); |
||
2276 | |||
7693 | akron1 | 2277 | getpos(parser, pos1); |
7597 | akron1 | 2278 | SimpleExpression(parser, e1); |
2279 | |||
2280 | IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN |
||
7693 | akron1 | 2281 | IL.Const(e1.type.length) |
7597 | akron1 | 2282 | END; |
2283 | |||
2284 | constant := (e.obj = eCONST) & (e1.obj = eCONST); |
||
2285 | |||
2286 | CASE op OF |
||
2287 | |SCAN.lxEQ: operator := "=" |
||
2288 | |SCAN.lxNE: operator := "#" |
||
2289 | |SCAN.lxLT: operator := "<" |
||
2290 | |SCAN.lxLE: operator := "<=" |
||
2291 | |SCAN.lxGT: operator := ">" |
||
2292 | |SCAN.lxGE: operator := ">=" |
||
2293 | |SCAN.lxIN: operator := "IN" |
||
2294 | |SCAN.lxIS: operator := "" |
||
2295 | END; |
||
2296 | |||
2297 | error := 0; |
||
2298 | |||
2299 | CASE op OF |
||
2300 | |SCAN.lxEQ, SCAN.lxNE: |
||
2301 | |||
2302 | IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR |
||
2303 | isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR |
||
2304 | isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR |
||
2305 | isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR |
||
2306 | isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN |
||
2307 | IF constant THEN |
||
2308 | ARITH.relation(e.value, e1.value, operator, error) |
||
2309 | ELSE |
||
2310 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2311 | IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value)) |
7597 | akron1 | 2312 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2313 | IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
7597 | akron1 | 2314 | ELSE |
7693 | akron1 | 2315 | IL.AddCmd0(IL.opEQ + cmpcode(op)) |
7597 | akron1 | 2316 | END |
2317 | END |
||
2318 | |||
2319 | ELSIF isStringW1(e) & isCharW(e1) THEN |
||
7693 | akron1 | 2320 | IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
7597 | akron1 | 2321 | |
2322 | ELSIF isStringW1(e1) & isCharW(e) THEN |
||
7693 | akron1 | 2323 | IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
7597 | akron1 | 2324 | |
2325 | ELSIF isBoolean(e) & isBoolean(e1) THEN |
||
2326 | IF constant THEN |
||
2327 | ARITH.relation(e.value, e1.value, operator, error) |
||
2328 | ELSE |
||
2329 | IF e.obj = eCONST THEN |
||
2330 | BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0) |
||
2331 | ELSIF e1.obj = eCONST THEN |
||
2332 | BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0) |
||
2333 | ELSE |
||
2334 | IF op = SCAN.lxEQ THEN |
||
7693 | akron1 | 2335 | IL.AddCmd0(IL.opEQB) |
7597 | akron1 | 2336 | ELSE |
7693 | akron1 | 2337 | IL.AddCmd0(IL.opNEB) |
7597 | akron1 | 2338 | END |
2339 | END |
||
2340 | END |
||
2341 | |||
2342 | ELSIF isReal(e) & isReal(e1) THEN |
||
2343 | IF constant THEN |
||
2344 | ARITH.relation(e.value, e1.value, operator, error) |
||
2345 | ELSE |
||
2346 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2347 | IL.Float(ARITH.Float(e.value)) |
7597 | akron1 | 2348 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2349 | IL.Float(ARITH.Float(e1.value)) |
2350 | END; |
||
2351 | IL.fcmp(IL.opEQF + cmpcode(op)) |
||
7597 | akron1 | 2352 | END |
2353 | |||
2354 | ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN |
||
2355 | IF ~strcmp(e, e1, op) THEN |
||
7693 | akron1 | 2356 | PARS.error(pos, 37) |
7597 | akron1 | 2357 | END |
2358 | |||
2359 | ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN |
||
7693 | akron1 | 2360 | IL.AddCmd0(IL.opEQC + cmpcode(op)) |
7597 | akron1 | 2361 | |
2362 | ELSIF isProc(e) & isNil(e1) THEN |
||
2363 | IF e.obj IN {ePROC, eIMP} THEN |
||
7693 | akron1 | 2364 | PARS.check(e.ident.global, pos0, 85); |
7597 | akron1 | 2365 | constant := TRUE; |
2366 | e.obj := eCONST; |
||
2367 | ARITH.setbool(e.value, op = SCAN.lxNE) |
||
2368 | ELSE |
||
7693 | akron1 | 2369 | IL.AddCmd0(IL.opEQC + cmpcode(op)) |
7597 | akron1 | 2370 | END |
2371 | |||
2372 | ELSIF isNil(e) & isProc(e1) THEN |
||
2373 | IF e1.obj IN {ePROC, eIMP} THEN |
||
7693 | akron1 | 2374 | PARS.check(e1.ident.global, pos1, 85); |
7597 | akron1 | 2375 | constant := TRUE; |
2376 | e.obj := eCONST; |
||
2377 | ARITH.setbool(e.value, op = SCAN.lxNE) |
||
2378 | ELSE |
||
7693 | akron1 | 2379 | IL.AddCmd0(IL.opEQC + cmpcode(op)) |
7597 | akron1 | 2380 | END |
2381 | |||
2382 | ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN |
||
2383 | IF e.obj = ePROC THEN |
||
7693 | akron1 | 2384 | PARS.check(e.ident.global, pos0, 85) |
7597 | akron1 | 2385 | END; |
2386 | IF e1.obj = ePROC THEN |
||
7693 | akron1 | 2387 | PARS.check(e1.ident.global, pos1, 85) |
7597 | akron1 | 2388 | END; |
2389 | IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN |
||
2390 | constant := TRUE; |
||
2391 | e.obj := eCONST; |
||
2392 | IF op = SCAN.lxEQ THEN |
||
2393 | ARITH.setbool(e.value, e.ident = e1.ident) |
||
2394 | ELSE |
||
2395 | ARITH.setbool(e.value, e.ident # e1.ident) |
||
2396 | END |
||
2397 | ELSIF e.obj = ePROC THEN |
||
7693 | akron1 | 2398 | IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ) |
7597 | akron1 | 2399 | ELSIF e1.obj = ePROC THEN |
7693 | akron1 | 2400 | IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ) |
7597 | akron1 | 2401 | ELSIF e.obj = eIMP THEN |
7693 | akron1 | 2402 | IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ) |
7597 | akron1 | 2403 | ELSIF e1.obj = eIMP THEN |
7693 | akron1 | 2404 | IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ) |
7597 | akron1 | 2405 | ELSE |
7693 | akron1 | 2406 | IL.AddCmd0(IL.opEQ + cmpcode(op)) |
7597 | akron1 | 2407 | END |
2408 | |||
2409 | ELSIF isNil(e) & isNil(e1) THEN |
||
2410 | constant := TRUE; |
||
2411 | e.obj := eCONST; |
||
2412 | ARITH.setbool(e.value, op = SCAN.lxEQ) |
||
2413 | |||
2414 | ELSE |
||
7693 | akron1 | 2415 | PARS.error(pos, 37) |
7597 | akron1 | 2416 | END |
2417 | |||
2418 | |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE: |
||
2419 | IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR |
||
2420 | isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR |
||
2421 | isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR |
||
2422 | isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN |
||
2423 | |||
2424 | IF constant THEN |
||
2425 | ARITH.relation(e.value, e1.value, operator, error) |
||
2426 | ELSE |
||
2427 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2428 | IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value)) |
7597 | akron1 | 2429 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2430 | IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value)) |
7597 | akron1 | 2431 | ELSE |
7693 | akron1 | 2432 | IL.AddCmd0(IL.opEQ + cmpcode(op)) |
7597 | akron1 | 2433 | END |
2434 | END |
||
2435 | |||
2436 | ELSIF isStringW1(e) & isCharW(e1) THEN |
||
7693 | akron1 | 2437 | IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.IDENT).s)) |
7597 | akron1 | 2438 | |
2439 | ELSIF isStringW1(e1) & isCharW(e) THEN |
||
7693 | akron1 | 2440 | IL.AddCmd(IL.opEQC + cmpcode(op), StrToWChar(e1.value.string(SCAN.IDENT).s)) |
7597 | akron1 | 2441 | |
2442 | ELSIF isReal(e) & isReal(e1) THEN |
||
2443 | IF constant THEN |
||
2444 | ARITH.relation(e.value, e1.value, operator, error) |
||
2445 | ELSE |
||
2446 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2447 | IL.Float(ARITH.Float(e.value)); |
2448 | IL.fcmp(IL.opEQF + invcmpcode(op)) |
||
7597 | akron1 | 2449 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2450 | IL.Float(ARITH.Float(e1.value)); |
2451 | IL.fcmp(IL.opEQF + cmpcode(op)) |
||
7597 | akron1 | 2452 | ELSE |
7693 | akron1 | 2453 | IL.fcmp(IL.opEQF + cmpcode(op)) |
7597 | akron1 | 2454 | END |
2455 | END |
||
2456 | |||
2457 | ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN |
||
2458 | IF ~strcmp(e, e1, op) THEN |
||
7693 | akron1 | 2459 | PARS.error(pos, 37) |
7597 | akron1 | 2460 | END |
2461 | |||
2462 | ELSE |
||
7693 | akron1 | 2463 | PARS.error(pos, 37) |
7597 | akron1 | 2464 | END |
2465 | |||
2466 | |SCAN.lxIN: |
||
7693 | akron1 | 2467 | PARS.check(isInt(e) & isSet(e1), pos, 37); |
7597 | akron1 | 2468 | IF e.obj = eCONST THEN |
7693 | akron1 | 2469 | PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56) |
7597 | akron1 | 2470 | END; |
2471 | IF constant THEN |
||
2472 | ARITH.relation(e.value, e1.value, operator, error) |
||
2473 | ELSE |
||
2474 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 2475 | IL.AddCmd(IL.opINL, ARITH.Int(e.value)) |
7597 | akron1 | 2476 | ELSIF e1.obj = eCONST THEN |
7693 | akron1 | 2477 | IL.AddCmd(IL.opINR, ARITH.Int(e1.value)) |
7597 | akron1 | 2478 | ELSE |
7693 | akron1 | 2479 | IL.AddCmd0(IL.opIN) |
7597 | akron1 | 2480 | END |
2481 | END |
||
2482 | |||
2483 | |SCAN.lxIS: |
||
7693 | akron1 | 2484 | PARS.check(isRecPtr(e), pos, 73); |
2485 | PARS.check(e1.obj = eTYPE, pos1, 79); |
||
7597 | akron1 | 2486 | |
7693 | akron1 | 2487 | IF isRec(e) THEN |
2488 | PARS.check(e.obj = eVREC, pos0, 78); |
||
2489 | PARS.check(e1.type.typ = PROG.tRECORD, pos1, 80); |
||
7597 | akron1 | 2490 | IF e.ident = NIL THEN |
7693 | akron1 | 2491 | IL.TypeCheck(e1.type.num) |
7597 | akron1 | 2492 | ELSE |
7693 | akron1 | 2493 | IL.AddCmd(IL.opVADR, e.ident.offset - 1); |
2494 | IL.TypeCheckRec(e1.type.num) |
||
7597 | akron1 | 2495 | END |
2496 | ELSE |
||
7693 | akron1 | 2497 | PARS.check(e1.type.typ = PROG.tPOINTER, pos1, 81); |
2498 | IL.TypeCheck(e1.type.base.num) |
||
7597 | akron1 | 2499 | END; |
2500 | |||
7693 | akron1 | 2501 | PARS.check(PROG.isBaseOf(e.type, e1.type), pos1, 82) |
7597 | akron1 | 2502 | |
2503 | END; |
||
2504 | |||
2505 | ASSERT(error = 0); |
||
2506 | |||
7693 | akron1 | 2507 | e.type := tBOOLEAN; |
7597 | akron1 | 2508 | |
2509 | IF ~constant THEN |
||
2510 | e.obj := eEXPR |
||
2511 | END |
||
2512 | |||
2513 | END |
||
2514 | END expression; |
||
2515 | |||
2516 | |||
2517 | PROCEDURE ElementaryStatement (parser: PARS.PARSER); |
||
2518 | VAR |
||
7983 | leency | 2519 | e, e1: PARS.EXPR; |
2520 | pos: PARS.POSITION; |
||
2521 | line: INTEGER; |
||
2522 | call: BOOLEAN; |
||
2523 | fregs: INTEGER; |
||
7597 | akron1 | 2524 | |
2525 | BEGIN |
||
2526 | getpos(parser, pos); |
||
2527 | |||
7693 | akron1 | 2528 | IL.pushBegEnd(begcall, endcall); |
7597 | akron1 | 2529 | |
2530 | designator(parser, e); |
||
2531 | |||
2532 | IF parser.sym = SCAN.lxASSIGN THEN |
||
2533 | line := parser.lex.pos.line; |
||
7693 | akron1 | 2534 | PARS.check(isVar(e), pos, 93); |
2535 | PARS.check(~e.readOnly, pos, 94); |
||
7597 | akron1 | 2536 | |
7693 | akron1 | 2537 | IL.setlast(begcall); |
7597 | akron1 | 2538 | |
2539 | NextPos(parser, pos); |
||
2540 | expression(parser, e1); |
||
2541 | |||
7693 | akron1 | 2542 | IL.setlast(endcall.prev(IL.COMMAND)); |
7597 | akron1 | 2543 | |
7693 | akron1 | 2544 | PARS.check(assign(e1, e.type, line), pos, 91); |
7597 | akron1 | 2545 | IF e1.obj = ePROC THEN |
7693 | akron1 | 2546 | PARS.check(e1.ident.global, pos, 85) |
7597 | akron1 | 2547 | END; |
2548 | call := FALSE |
||
2549 | ELSIF parser.sym = SCAN.lxEQ THEN |
||
2550 | PARS.check1(FALSE, parser, 96) |
||
2551 | ELSIF parser.sym = SCAN.lxLROUND THEN |
||
2552 | e1 := e; |
||
2553 | ActualParameters(parser, e1); |
||
7693 | akron1 | 2554 | PARS.check((e1.type = NIL) OR ODD(e.type.call), pos, 92); |
7597 | akron1 | 2555 | call := TRUE |
2556 | ELSE |
||
7693 | akron1 | 2557 | IF e.obj IN {eSYSPROC, eSTPROC} THEN |
2558 | stProc(parser, e); |
||
2559 | call := FALSE |
||
2560 | ELSE |
||
2561 | PARS.check(isProc(e), pos, 86); |
||
2562 | PARS.check((e.type.base = NIL) OR ODD(e.type.call), pos, 92); |
||
2563 | PARS.check1(e.type.params.first = NIL, parser, 64); |
||
2564 | call := TRUE |
||
2565 | END |
||
7597 | akron1 | 2566 | END; |
2567 | |||
2568 | IF call THEN |
||
2569 | IF e.obj IN {ePROC, eIMP} THEN |
||
2570 | ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE) |
||
2571 | ELSIF isExpr(e) THEN |
||
2572 | ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE) |
||
2573 | END |
||
2574 | END; |
||
2575 | |||
7693 | akron1 | 2576 | IL.popBegEnd(begcall, endcall) |
7597 | akron1 | 2577 | END ElementaryStatement; |
2578 | |||
2579 | |||
2580 | PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); |
||
2581 | VAR |
||
7983 | leency | 2582 | e: PARS.EXPR; |
2583 | pos: PARS.POSITION; |
||
7597 | akron1 | 2584 | |
2585 | label, L: INTEGER; |
||
2586 | |||
2587 | BEGIN |
||
7693 | akron1 | 2588 | L := IL.NewLabel(); |
7597 | akron1 | 2589 | |
2590 | IF ~if THEN |
||
7693 | akron1 | 2591 | IL.AddCmd0(IL.opLOOP); |
2592 | IL.SetLabel(L) |
||
7597 | akron1 | 2593 | END; |
2594 | |||
2595 | REPEAT |
||
2596 | NextPos(parser, pos); |
||
2597 | |||
7693 | akron1 | 2598 | label := IL.NewLabel(); |
7597 | akron1 | 2599 | |
2600 | expression(parser, e); |
||
7693 | akron1 | 2601 | PARS.check(isBoolean(e), pos, 72); |
7597 | akron1 | 2602 | |
2603 | IF e.obj = eCONST THEN |
||
2604 | IF ~ARITH.getBool(e.value) THEN |
||
7693 | akron1 | 2605 | IL.AddJmpCmd(IL.opJMP, label) |
7597 | akron1 | 2606 | END |
2607 | ELSE |
||
7693 | akron1 | 2608 | IL.AddJmpCmd(IL.opJNE, label) |
7597 | akron1 | 2609 | END; |
2610 | |||
2611 | IF if THEN |
||
2612 | PARS.checklex(parser, SCAN.lxTHEN) |
||
2613 | ELSE |
||
2614 | PARS.checklex(parser, SCAN.lxDO) |
||
2615 | END; |
||
2616 | |||
2617 | PARS.Next(parser); |
||
2618 | parser.StatSeq(parser); |
||
2619 | |||
7693 | akron1 | 2620 | IL.AddJmpCmd(IL.opJMP, L); |
2621 | IL.SetLabel(label) |
||
7597 | akron1 | 2622 | |
2623 | UNTIL parser.sym # SCAN.lxELSIF; |
||
2624 | |||
2625 | IF if THEN |
||
2626 | IF parser.sym = SCAN.lxELSE THEN |
||
2627 | PARS.Next(parser); |
||
2628 | parser.StatSeq(parser) |
||
2629 | END; |
||
7693 | akron1 | 2630 | IL.SetLabel(L) |
7597 | akron1 | 2631 | END; |
2632 | |||
2633 | PARS.checklex(parser, SCAN.lxEND); |
||
2634 | |||
2635 | IF ~if THEN |
||
7693 | akron1 | 2636 | IL.AddCmd0(IL.opENDLOOP) |
7597 | akron1 | 2637 | END; |
2638 | |||
2639 | PARS.Next(parser) |
||
2640 | END IfStatement; |
||
2641 | |||
2642 | |||
2643 | PROCEDURE RepeatStatement (parser: PARS.PARSER); |
||
2644 | VAR |
||
2645 | e: PARS.EXPR; |
||
7693 | akron1 | 2646 | pos: PARS.POSITION; |
7597 | akron1 | 2647 | label: INTEGER; |
2648 | |||
2649 | BEGIN |
||
7693 | akron1 | 2650 | IL.AddCmd0(IL.opLOOP); |
7597 | akron1 | 2651 | |
7693 | akron1 | 2652 | label := IL.NewLabel(); |
2653 | IL.SetLabel(label); |
||
7597 | akron1 | 2654 | |
2655 | PARS.Next(parser); |
||
2656 | parser.StatSeq(parser); |
||
2657 | PARS.checklex(parser, SCAN.lxUNTIL); |
||
2658 | NextPos(parser, pos); |
||
2659 | expression(parser, e); |
||
7693 | akron1 | 2660 | PARS.check(isBoolean(e), pos, 72); |
7597 | akron1 | 2661 | |
2662 | IF e.obj = eCONST THEN |
||
2663 | IF ~ARITH.getBool(e.value) THEN |
||
7693 | akron1 | 2664 | IL.AddJmpCmd(IL.opJMP, label) |
7597 | akron1 | 2665 | END |
2666 | ELSE |
||
7693 | akron1 | 2667 | IL.AddJmpCmd(IL.opJNE, label) |
7597 | akron1 | 2668 | END; |
2669 | |||
7693 | akron1 | 2670 | IL.AddCmd0(IL.opENDLOOP) |
7597 | akron1 | 2671 | END RepeatStatement; |
2672 | |||
2673 | |||
2674 | PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER; |
||
2675 | VAR |
||
2676 | La, Ra, Lb, Rb, res: INTEGER; |
||
2677 | |||
2678 | BEGIN |
||
2679 | La := a(CASE_LABEL).range.a; |
||
2680 | Ra := a(CASE_LABEL).range.b; |
||
2681 | Lb := b(CASE_LABEL).range.a; |
||
2682 | Rb := b(CASE_LABEL).range.b; |
||
2683 | IF (Ra < Lb) OR (La > Rb) THEN |
||
2684 | res := ORD(La > Lb) - ORD(La < Lb) |
||
2685 | ELSE |
||
2686 | res := 0 |
||
2687 | END |
||
2688 | |||
2689 | RETURN res |
||
2690 | END LabelCmp; |
||
2691 | |||
2692 | |||
2693 | PROCEDURE DestroyLabel (VAR label: AVL.DATA); |
||
2694 | BEGIN |
||
2695 | C.push(CaseLabels, label); |
||
2696 | label := NIL |
||
2697 | END DestroyLabel; |
||
2698 | |||
2699 | |||
7693 | akron1 | 2700 | PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT; |
7597 | akron1 | 2701 | VAR |
2702 | res: CASE_VARIANT; |
||
2703 | citem: C.ITEM; |
||
2704 | |||
2705 | BEGIN |
||
2706 | citem := C.pop(CaseVar); |
||
2707 | IF citem = NIL THEN |
||
2708 | NEW(res) |
||
2709 | ELSE |
||
2710 | res := citem(CASE_VARIANT) |
||
2711 | END; |
||
2712 | |||
2713 | res.label := label; |
||
2714 | res.cmd := cmd; |
||
2715 | res.processed := FALSE |
||
2716 | |||
2717 | RETURN res |
||
2718 | END NewVariant; |
||
2719 | |||
2720 | |||
2721 | PROCEDURE CaseStatement (parser: PARS.PARSER); |
||
2722 | VAR |
||
7983 | leency | 2723 | e: PARS.EXPR; |
2724 | pos: PARS.POSITION; |
||
7597 | akron1 | 2725 | |
2726 | |||
2727 | PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; |
||
2728 | VAR |
||
7983 | leency | 2729 | a: INTEGER; |
2730 | label: PARS.EXPR; |
||
2731 | pos: PARS.POSITION; |
||
2732 | value: ARITH.VALUE; |
||
7597 | akron1 | 2733 | |
2734 | BEGIN |
||
2735 | getpos(parser, pos); |
||
2736 | type := NIL; |
||
2737 | |||
2738 | IF isChar(caseExpr) THEN |
||
2739 | PARS.ConstExpression(parser, value); |
||
7693 | akron1 | 2740 | PARS.check(value.typ = ARITH.tCHAR, pos, 99); |
7597 | akron1 | 2741 | a := ARITH.getInt(value) |
2742 | ELSIF isCharW(caseExpr) THEN |
||
2743 | PARS.ConstExpression(parser, value); |
||
2744 | IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN |
||
2745 | ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s))) |
||
2746 | ELSE |
||
7693 | akron1 | 2747 | PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99) |
7597 | akron1 | 2748 | END; |
2749 | a := ARITH.getInt(value) |
||
2750 | ELSIF isInt(caseExpr) THEN |
||
2751 | PARS.ConstExpression(parser, value); |
||
7693 | akron1 | 2752 | PARS.check(value.typ = ARITH.tINTEGER, pos, 99); |
7597 | akron1 | 2753 | a := ARITH.getInt(value) |
2754 | ELSIF isRecPtr(caseExpr) THEN |
||
2755 | qualident(parser, label); |
||
7693 | akron1 | 2756 | PARS.check(label.obj = eTYPE, pos, 79); |
2757 | PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99); |
||
7597 | akron1 | 2758 | IF isRec(caseExpr) THEN |
2759 | a := label.type.num |
||
2760 | ELSE |
||
2761 | a := label.type.base.num |
||
2762 | END; |
||
2763 | type := label.type |
||
2764 | END |
||
2765 | |||
2766 | RETURN a |
||
2767 | END Label; |
||
2768 | |||
2769 | |||
7693 | akron1 | 2770 | PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: PARS.POSITION); |
7597 | akron1 | 2771 | BEGIN |
2772 | IF node # NIL THEN |
||
7693 | akron1 | 2773 | PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), pos, 100); |
7597 | akron1 | 2774 | CheckType(node.left, type, parser, pos); |
2775 | CheckType(node.right, type, parser, pos) |
||
2776 | END |
||
2777 | END CheckType; |
||
2778 | |||
2779 | |||
2780 | PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE; |
||
2781 | VAR |
||
2782 | label: CASE_LABEL; |
||
2783 | citem: C.ITEM; |
||
7693 | akron1 | 2784 | pos, pos1: PARS.POSITION; |
7597 | akron1 | 2785 | node: AVL.NODE; |
2786 | newnode: BOOLEAN; |
||
2787 | range: RANGE; |
||
2788 | |||
2789 | BEGIN |
||
2790 | citem := C.pop(CaseLabels); |
||
2791 | IF citem = NIL THEN |
||
2792 | NEW(label) |
||
2793 | ELSE |
||
2794 | label := citem(CASE_LABEL) |
||
2795 | END; |
||
2796 | |||
2797 | label.variant := variant; |
||
7693 | akron1 | 2798 | label.self := IL.NewLabel(); |
7597 | akron1 | 2799 | |
2800 | getpos(parser, pos1); |
||
2801 | range.a := Label(parser, caseExpr, label.type); |
||
2802 | |||
2803 | IF parser.sym = SCAN.lxRANGE THEN |
||
2804 | PARS.check1(~isRecPtr(caseExpr), parser, 53); |
||
2805 | NextPos(parser, pos); |
||
2806 | range.b := Label(parser, caseExpr, label.type); |
||
7693 | akron1 | 2807 | PARS.check(range.a <= range.b, pos, 103) |
7597 | akron1 | 2808 | ELSE |
2809 | range.b := range.a |
||
2810 | END; |
||
2811 | |||
2812 | label.range := range; |
||
2813 | |||
2814 | IF isRecPtr(caseExpr) THEN |
||
2815 | CheckType(tree, label.type, parser, pos1) |
||
2816 | END; |
||
2817 | tree := AVL.insert(tree, label, LabelCmp, newnode, node); |
||
7693 | akron1 | 2818 | PARS.check(newnode, pos1, 100) |
7597 | akron1 | 2819 | |
2820 | RETURN node |
||
2821 | |||
2822 | END LabelRange; |
||
2823 | |||
2824 | |||
2825 | PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE; |
||
2826 | VAR |
||
2827 | exit: BOOLEAN; |
||
2828 | res: AVL.NODE; |
||
2829 | |||
2830 | BEGIN |
||
2831 | exit := FALSE; |
||
2832 | REPEAT |
||
2833 | res := LabelRange(parser, caseExpr, tree, variant); |
||
2834 | IF parser.sym = SCAN.lxCOMMA THEN |
||
2835 | PARS.check1(~isRecPtr(caseExpr), parser, 53); |
||
2836 | PARS.Next(parser) |
||
2837 | ELSE |
||
2838 | exit := TRUE |
||
2839 | END |
||
2840 | UNTIL exit |
||
2841 | |||
2842 | RETURN res |
||
2843 | END CaseLabelList; |
||
2844 | |||
2845 | |||
2846 | PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER); |
||
2847 | VAR |
||
7983 | leency | 2848 | sym: INTEGER; |
2849 | t: PROG.TYPE_; |
||
2850 | variant: INTEGER; |
||
2851 | node: AVL.NODE; |
||
2852 | last: IL.COMMAND; |
||
7597 | akron1 | 2853 | |
2854 | BEGIN |
||
2855 | sym := parser.sym; |
||
2856 | IF sym # SCAN.lxBAR THEN |
||
7693 | akron1 | 2857 | variant := IL.NewLabel(); |
7597 | akron1 | 2858 | node := CaseLabelList(parser, caseExpr, tree, variant); |
2859 | PARS.checklex(parser, SCAN.lxCOLON); |
||
2860 | PARS.Next(parser); |
||
2861 | IF isRecPtr(caseExpr) THEN |
||
2862 | t := caseExpr.type; |
||
2863 | caseExpr.ident.type := node.data(CASE_LABEL).type |
||
2864 | END; |
||
2865 | |||
7693 | akron1 | 2866 | last := IL.getlast(); |
2867 | IL.SetLabel(variant); |
||
7597 | akron1 | 2868 | |
2869 | IF ~isRecPtr(caseExpr) THEN |
||
2870 | LISTS.push(CaseVariants, NewVariant(variant, last)) |
||
2871 | END; |
||
2872 | |||
2873 | parser.StatSeq(parser); |
||
7693 | akron1 | 2874 | IL.AddJmpCmd(IL.opJMP, end); |
7597 | akron1 | 2875 | |
2876 | IF isRecPtr(caseExpr) THEN |
||
2877 | caseExpr.ident.type := t |
||
2878 | END |
||
2879 | END |
||
2880 | END case; |
||
2881 | |||
2882 | |||
2883 | PROCEDURE Table (node: AVL.NODE; else: INTEGER); |
||
2884 | VAR |
||
2885 | L, R: INTEGER; |
||
2886 | range: RANGE; |
||
2887 | left, right: AVL.NODE; |
||
7693 | akron1 | 2888 | last: IL.COMMAND; |
7597 | akron1 | 2889 | v: CASE_VARIANT; |
2890 | |||
2891 | BEGIN |
||
2892 | IF node # NIL THEN |
||
2893 | |||
2894 | range := node.data(CASE_LABEL).range; |
||
2895 | |||
2896 | left := node.left; |
||
2897 | IF left # NIL THEN |
||
2898 | L := left.data(CASE_LABEL).self |
||
2899 | ELSE |
||
2900 | L := else |
||
2901 | END; |
||
2902 | |||
2903 | right := node.right; |
||
2904 | IF right # NIL THEN |
||
2905 | R := right.data(CASE_LABEL).self |
||
2906 | ELSE |
||
2907 | R := else |
||
2908 | END; |
||
2909 | |||
7693 | akron1 | 2910 | last := IL.getlast(); |
7597 | akron1 | 2911 | |
2912 | v := CaseVariants.last(CASE_VARIANT); |
||
2913 | WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO |
||
2914 | v := v.prev(CASE_VARIANT) |
||
2915 | END; |
||
2916 | |||
2917 | ASSERT((v # NIL) & (v.label # 0)); |
||
7693 | akron1 | 2918 | IL.setlast(v.cmd); |
7597 | akron1 | 2919 | |
7693 | akron1 | 2920 | IL.SetLabel(node.data(CASE_LABEL).self); |
2921 | IL.case(range.a, range.b, L, R); |
||
7597 | akron1 | 2922 | IF v.processed THEN |
7693 | akron1 | 2923 | IL.AddJmpCmd(IL.opJMP, node.data(CASE_LABEL).variant) |
7597 | akron1 | 2924 | END; |
2925 | v.processed := TRUE; |
||
2926 | |||
7693 | akron1 | 2927 | IL.setlast(last); |
7597 | akron1 | 2928 | |
2929 | Table(left, else); |
||
2930 | Table(right, else) |
||
2931 | END |
||
2932 | END Table; |
||
2933 | |||
2934 | |||
2935 | PROCEDURE TableT (node: AVL.NODE); |
||
2936 | BEGIN |
||
2937 | IF node # NIL THEN |
||
7693 | akron1 | 2938 | IL.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); |
7597 | akron1 | 2939 | |
2940 | TableT(node.left); |
||
2941 | TableT(node.right) |
||
2942 | END |
||
2943 | END TableT; |
||
2944 | |||
2945 | |||
7693 | akron1 | 2946 | PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION); |
7597 | akron1 | 2947 | VAR |
2948 | table, end, else: INTEGER; |
||
2949 | tree: AVL.NODE; |
||
7983 | leency | 2950 | item: LISTS.ITEM; |
7597 | akron1 | 2951 | |
2952 | BEGIN |
||
2953 | LISTS.push(CaseVariants, NewVariant(0, NIL)); |
||
7693 | akron1 | 2954 | end := IL.NewLabel(); |
2955 | else := IL.NewLabel(); |
||
2956 | table := IL.NewLabel(); |
||
2957 | IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e))); |
||
2958 | IL.AddJmpCmd(IL.opJMP, table); |
||
7597 | akron1 | 2959 | |
2960 | tree := NIL; |
||
2961 | |||
2962 | case(parser, e, tree, end); |
||
2963 | WHILE parser.sym = SCAN.lxBAR DO |
||
2964 | PARS.Next(parser); |
||
2965 | case(parser, e, tree, end) |
||
2966 | END; |
||
2967 | |||
7693 | akron1 | 2968 | IL.SetLabel(else); |
7597 | akron1 | 2969 | IF parser.sym = SCAN.lxELSE THEN |
2970 | PARS.Next(parser); |
||
2971 | parser.StatSeq(parser); |
||
7693 | akron1 | 2972 | IL.AddJmpCmd(IL.opJMP, end) |
7597 | akron1 | 2973 | ELSE |
7693 | akron1 | 2974 | IL.OnError(pos.line, errCASE) |
7597 | akron1 | 2975 | END; |
2976 | |||
2977 | PARS.checklex(parser, SCAN.lxEND); |
||
2978 | PARS.Next(parser); |
||
2979 | |||
2980 | IF isRecPtr(e) THEN |
||
7693 | akron1 | 2981 | IL.SetLabel(table); |
7597 | akron1 | 2982 | TableT(tree); |
7693 | akron1 | 2983 | IL.AddJmpCmd(IL.opJMP, else) |
7597 | akron1 | 2984 | ELSE |
2985 | tree.data(CASE_LABEL).self := table; |
||
2986 | Table(tree, else) |
||
2987 | END; |
||
2988 | |||
2989 | AVL.destroy(tree, DestroyLabel); |
||
7693 | akron1 | 2990 | IL.SetLabel(end); |
2991 | IL.AddCmd0(IL.opENDSW); |
||
7597 | akron1 | 2992 | |
2993 | REPEAT |
||
2994 | item := LISTS.pop(CaseVariants); |
||
2995 | C.push(CaseVar, item) |
||
2996 | UNTIL item(CASE_VARIANT).cmd = NIL |
||
2997 | |||
2998 | END ParseCase; |
||
2999 | |||
3000 | |||
3001 | BEGIN |
||
3002 | NextPos(parser, pos); |
||
3003 | expression(parser, e); |
||
7693 | akron1 | 3004 | PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95); |
7597 | akron1 | 3005 | IF isRecPtr(e) THEN |
7693 | akron1 | 3006 | PARS.check(isVar(e), pos, 93); |
3007 | PARS.check(e.ident # NIL, pos, 106) |
||
7597 | akron1 | 3008 | END; |
3009 | IF isRec(e) THEN |
||
7693 | akron1 | 3010 | PARS.check(e.obj = eVREC, pos, 78) |
7597 | akron1 | 3011 | END; |
3012 | |||
3013 | IF e.obj = eCONST THEN |
||
3014 | LoadConst(e) |
||
3015 | ELSIF isRec(e) THEN |
||
7693 | akron1 | 3016 | IL.drop; |
3017 | IL.AddCmd(IL.opLADR, e.ident.offset - 1); |
||
7983 | leency | 3018 | IL.load(TARGETS.WordSize) |
7597 | akron1 | 3019 | ELSIF isPtr(e) THEN |
3020 | deref(pos, e, FALSE, errPTR); |
||
7983 | leency | 3021 | IL.AddCmd(IL.opSUBR, TARGETS.WordSize); |
3022 | IL.load(TARGETS.WordSize) |
||
7597 | akron1 | 3023 | END; |
3024 | |||
3025 | PARS.checklex(parser, SCAN.lxOF); |
||
3026 | PARS.Next(parser); |
||
3027 | ParseCase(parser, e, pos) |
||
3028 | END CaseStatement; |
||
3029 | |||
3030 | |||
3031 | PROCEDURE ForStatement (parser: PARS.PARSER); |
||
3032 | VAR |
||
7693 | akron1 | 3033 | e: PARS.EXPR; |
3034 | pos, pos2: PARS.POSITION; |
||
3035 | step: ARITH.VALUE; |
||
3036 | st: INTEGER; |
||
3037 | ident: PROG.IDENT; |
||
3038 | offset: INTEGER; |
||
3039 | L1, L2: INTEGER; |
||
7597 | akron1 | 3040 | |
3041 | BEGIN |
||
7693 | akron1 | 3042 | IL.AddCmd0(IL.opLOOP); |
7597 | akron1 | 3043 | |
7693 | akron1 | 3044 | L1 := IL.NewLabel(); |
3045 | L2 := IL.NewLabel(); |
||
7597 | akron1 | 3046 | |
3047 | PARS.ExpectSym(parser, SCAN.lxIDENT); |
||
7693 | akron1 | 3048 | ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE); |
7597 | akron1 | 3049 | PARS.check1(ident # NIL, parser, 48); |
3050 | PARS.check1(ident.typ = PROG.idVAR, parser, 93); |
||
7693 | akron1 | 3051 | PARS.check1(ident.type = tINTEGER, parser, 97); |
7597 | akron1 | 3052 | PARS.ExpectSym(parser, SCAN.lxASSIGN); |
3053 | NextPos(parser, pos); |
||
3054 | expression(parser, e); |
||
7693 | akron1 | 3055 | PARS.check(isInt(e), pos, 76); |
7597 | akron1 | 3056 | |
3057 | offset := PROG.getOffset(PARS.program, ident); |
||
3058 | |||
3059 | IF ident.global THEN |
||
7693 | akron1 | 3060 | IL.AddCmd(IL.opGADR, offset) |
7597 | akron1 | 3061 | ELSE |
7693 | akron1 | 3062 | IL.AddCmd(IL.opLADR, -offset) |
7597 | akron1 | 3063 | END; |
3064 | |||
3065 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 3066 | IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value)) |
7597 | akron1 | 3067 | ELSE |
7693 | akron1 | 3068 | IL.AddCmd0(IL.opSAVE) |
7597 | akron1 | 3069 | END; |
3070 | |||
7693 | akron1 | 3071 | IL.SetLabel(L1); |
7597 | akron1 | 3072 | |
3073 | IF ident.global THEN |
||
7693 | akron1 | 3074 | IL.AddCmd(IL.opGADR, offset) |
7597 | akron1 | 3075 | ELSE |
7693 | akron1 | 3076 | IL.AddCmd(IL.opLADR, -offset) |
7597 | akron1 | 3077 | END; |
7693 | akron1 | 3078 | IL.load(ident.type.size); |
7597 | akron1 | 3079 | |
3080 | PARS.checklex(parser, SCAN.lxTO); |
||
7693 | akron1 | 3081 | NextPos(parser, pos2); |
7597 | akron1 | 3082 | expression(parser, e); |
7693 | akron1 | 3083 | PARS.check(isInt(e), pos2, 76); |
7597 | akron1 | 3084 | |
3085 | IF parser.sym = SCAN.lxBY THEN |
||
3086 | NextPos(parser, pos); |
||
3087 | PARS.ConstExpression(parser, step); |
||
7693 | akron1 | 3088 | PARS.check(step.typ = ARITH.tINTEGER, pos, 76); |
7597 | akron1 | 3089 | st := ARITH.getInt(step); |
7693 | akron1 | 3090 | PARS.check(st # 0, pos, 98) |
7597 | akron1 | 3091 | ELSE |
3092 | st := 1 |
||
3093 | END; |
||
3094 | |||
3095 | IF e.obj = eCONST THEN |
||
3096 | IF st > 0 THEN |
||
7693 | akron1 | 3097 | IL.AddCmd(IL.opLEC, ARITH.Int(e.value)); |
3098 | IF ARITH.Int(e.value) = UTILS.target.maxInt THEN |
||
3099 | ERRORS.WarningMsg(pos2.line, pos2.col, 1) |
||
3100 | END |
||
7597 | akron1 | 3101 | ELSE |
7693 | akron1 | 3102 | IL.AddCmd(IL.opGEC, ARITH.Int(e.value)); |
3103 | IF ARITH.Int(e.value) = UTILS.target.minInt THEN |
||
3104 | ERRORS.WarningMsg(pos2.line, pos2.col, 1) |
||
3105 | END |
||
7597 | akron1 | 3106 | END |
3107 | ELSE |
||
3108 | IF st > 0 THEN |
||
7693 | akron1 | 3109 | IL.AddCmd0(IL.opLE) |
7597 | akron1 | 3110 | ELSE |
7693 | akron1 | 3111 | IL.AddCmd0(IL.opGE) |
7597 | akron1 | 3112 | END |
3113 | END; |
||
3114 | |||
7693 | akron1 | 3115 | IL.AddJmpCmd(IL.opJNE, L2); |
7597 | akron1 | 3116 | |
3117 | PARS.checklex(parser, SCAN.lxDO); |
||
3118 | PARS.Next(parser); |
||
3119 | parser.StatSeq(parser); |
||
3120 | |||
3121 | IF ident.global THEN |
||
7693 | akron1 | 3122 | IL.AddCmd(IL.opGADR, offset) |
7597 | akron1 | 3123 | ELSE |
7693 | akron1 | 3124 | IL.AddCmd(IL.opLADR, -offset) |
7597 | akron1 | 3125 | END; |
3126 | |||
7693 | akron1 | 3127 | IL.AddCmd(IL.opINCC, st); |
7597 | akron1 | 3128 | |
7693 | akron1 | 3129 | IL.AddJmpCmd(IL.opJMP, L1); |
7597 | akron1 | 3130 | |
3131 | PARS.checklex(parser, SCAN.lxEND); |
||
3132 | PARS.Next(parser); |
||
3133 | |||
7693 | akron1 | 3134 | IL.SetLabel(L2); |
7597 | akron1 | 3135 | |
7693 | akron1 | 3136 | IL.AddCmd0(IL.opENDLOOP) |
7597 | akron1 | 3137 | |
3138 | END ForStatement; |
||
3139 | |||
3140 | |||
3141 | PROCEDURE statement (parser: PARS.PARSER); |
||
3142 | VAR |
||
3143 | sym: INTEGER; |
||
3144 | |||
3145 | BEGIN |
||
3146 | sym := parser.sym; |
||
3147 | |||
3148 | IF sym = SCAN.lxIDENT THEN |
||
3149 | ElementaryStatement(parser) |
||
3150 | ELSIF sym = SCAN.lxIF THEN |
||
3151 | IfStatement(parser, TRUE) |
||
3152 | ELSIF sym = SCAN.lxWHILE THEN |
||
3153 | IfStatement(parser, FALSE) |
||
3154 | ELSIF sym = SCAN.lxREPEAT THEN |
||
3155 | RepeatStatement(parser) |
||
3156 | ELSIF sym = SCAN.lxCASE THEN |
||
3157 | CaseStatement(parser) |
||
3158 | ELSIF sym = SCAN.lxFOR THEN |
||
3159 | ForStatement(parser) |
||
3160 | END |
||
3161 | END statement; |
||
3162 | |||
3163 | |||
3164 | PROCEDURE StatSeq (parser: PARS.PARSER); |
||
3165 | BEGIN |
||
3166 | statement(parser); |
||
3167 | WHILE parser.sym = SCAN.lxSEMI DO |
||
3168 | PARS.Next(parser); |
||
3169 | statement(parser) |
||
3170 | END |
||
3171 | END StatSeq; |
||
3172 | |||
3173 | |||
7693 | akron1 | 3174 | PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: PARS.POSITION): BOOLEAN; |
7597 | akron1 | 3175 | VAR |
3176 | res: BOOLEAN; |
||
3177 | |||
3178 | BEGIN |
||
3179 | res := assigncomp(e, t); |
||
3180 | IF res THEN |
||
3181 | IF e.obj = eCONST THEN |
||
7693 | akron1 | 3182 | IF e.type = tREAL THEN |
3183 | IL.Float(ARITH.Float(e.value)) |
||
7597 | akron1 | 3184 | ELSIF e.type.typ = PROG.tNIL THEN |
7693 | akron1 | 3185 | IL.Const(0) |
7597 | akron1 | 3186 | ELSE |
3187 | LoadConst(e) |
||
3188 | END |
||
7693 | akron1 | 3189 | ELSIF (e.type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN |
7597 | akron1 | 3190 | CheckRange(256, pos.line, errBYTE) |
3191 | ELSIF e.obj = ePROC THEN |
||
7693 | akron1 | 3192 | PARS.check(e.ident.global, pos, 85); |
3193 | IL.PushProc(e.ident.proc.label) |
||
7597 | akron1 | 3194 | ELSIF e.obj = eIMP THEN |
7693 | akron1 | 3195 | IL.PushImpProc(e.ident.import) |
7597 | akron1 | 3196 | END; |
3197 | |||
7693 | akron1 | 3198 | IF e.type = tREAL THEN |
3199 | IL.retf |
||
7597 | akron1 | 3200 | END |
3201 | END |
||
3202 | |||
3203 | RETURN res |
||
3204 | END chkreturn; |
||
3205 | |||
3206 | |||
3207 | PROCEDURE setrtl; |
||
3208 | VAR |
||
3209 | rtl: PROG.UNIT; |
||
3210 | |||
3211 | |||
3212 | PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER); |
||
3213 | VAR |
||
7983 | leency | 3214 | id: PROG.IDENT; |
7597 | akron1 | 3215 | |
3216 | BEGIN |
||
7693 | akron1 | 3217 | id := PROG.getIdent(rtl, SCAN.enterid(name), FALSE); |
7597 | akron1 | 3218 | |
3219 | IF (id # NIL) & (id.import # NIL) THEN |
||
7696 | akron1 | 3220 | IL.set_rtl(idx, -id.import(IL.IMPORT_PROC).label); |
7597 | akron1 | 3221 | id.proc.used := TRUE |
3222 | ELSIF (id # NIL) & (id.proc # NIL) THEN |
||
7696 | akron1 | 3223 | IL.set_rtl(idx, id.proc.label); |
7597 | akron1 | 3224 | id.proc.used := TRUE |
3225 | ELSE |
||
7693 | akron1 | 3226 | ERRORS.WrongRTL(name) |
7597 | akron1 | 3227 | END |
3228 | END getproc; |
||
3229 | |||
3230 | |||
3231 | BEGIN |
||
3232 | rtl := PARS.program.rtl; |
||
3233 | ASSERT(rtl # NIL); |
||
3234 | |||
7983 | leency | 3235 | getproc(rtl, "_strcmp", IL._strcmp); |
3236 | getproc(rtl, "_length", IL._length); |
||
3237 | getproc(rtl, "_arrcpy", IL._arrcpy); |
||
3238 | getproc(rtl, "_is", IL._is); |
||
3239 | getproc(rtl, "_guard", IL._guard); |
||
3240 | getproc(rtl, "_guardrec", IL._guardrec); |
||
3241 | getproc(rtl, "_new", IL._new); |
||
3242 | getproc(rtl, "_rot", IL._rot); |
||
3243 | getproc(rtl, "_strcpy", IL._strcpy); |
||
3244 | getproc(rtl, "_move", IL._move); |
||
3245 | getproc(rtl, "_set", IL._set); |
||
3246 | getproc(rtl, "_set1", IL._set1); |
||
3247 | getproc(rtl, "_lengthw", IL._lengthw); |
||
3248 | getproc(rtl, "_strcmpw", IL._strcmpw); |
||
3249 | getproc(rtl, "_init", IL._init); |
||
3250 | |||
3251 | IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN |
||
3252 | getproc(rtl, "_error", IL._error); |
||
3253 | getproc(rtl, "_divmod", IL._divmod); |
||
3254 | getproc(rtl, "_exit", IL._exit); |
||
3255 | getproc(rtl, "_dispose", IL._dispose); |
||
3256 | getproc(rtl, "_isrec", IL._isrec); |
||
3257 | getproc(rtl, "_dllentry", IL._dllentry); |
||
3258 | getproc(rtl, "_sofinit", IL._sofinit) |
||
3259 | ELSIF CPU = TARGETS.cpuTHUMB THEN |
||
3260 | getproc(rtl, "_fmul", IL._fmul); |
||
3261 | getproc(rtl, "_fdiv", IL._fdiv); |
||
3262 | getproc(rtl, "_fdivi", IL._fdivi); |
||
3263 | getproc(rtl, "_fadd", IL._fadd); |
||
3264 | getproc(rtl, "_fsub", IL._fsub); |
||
3265 | getproc(rtl, "_fsubi", IL._fsubi); |
||
3266 | getproc(rtl, "_fcmp", IL._fcmp); |
||
3267 | getproc(rtl, "_floor", IL._floor); |
||
3268 | getproc(rtl, "_flt", IL._flt); |
||
3269 | getproc(rtl, "_pack", IL._pack); |
||
3270 | getproc(rtl, "_unpk", IL._unpk) |
||
7693 | akron1 | 3271 | END |
7597 | akron1 | 3272 | |
3273 | END setrtl; |
||
3274 | |||
3275 | |||
7693 | akron1 | 3276 | PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS); |
7597 | akron1 | 3277 | VAR |
7693 | akron1 | 3278 | parser: PARS.PARSER; |
7597 | akron1 | 3279 | ext: PARS.PATH; |
3280 | |||
3281 | BEGIN |
||
7693 | akron1 | 3282 | tINTEGER := PARS.program.stTypes.tINTEGER; |
3283 | tBYTE := PARS.program.stTypes.tBYTE; |
||
3284 | tCHAR := PARS.program.stTypes.tCHAR; |
||
3285 | tSET := PARS.program.stTypes.tSET; |
||
3286 | tBOOLEAN := PARS.program.stTypes.tBOOLEAN; |
||
3287 | tWCHAR := PARS.program.stTypes.tWCHAR; |
||
3288 | tREAL := PARS.program.stTypes.tREAL; |
||
3289 | |||
3290 | Options := options; |
||
7983 | leency | 3291 | CPU := TARGETS.CPU; |
7693 | akron1 | 3292 | |
7983 | leency | 3293 | ext := UTILS.FILE_EXT; |
7597 | akron1 | 3294 | CaseLabels := C.create(); |
3295 | CaseVar := C.create(); |
||
3296 | |||
3297 | CaseVariants := LISTS.create(NIL); |
||
3298 | LISTS.push(CaseVariants, NewVariant(0, NIL)); |
||
3299 | |||
7983 | leency | 3300 | IL.init(CPU); |
7597 | akron1 | 3301 | |
7983 | leency | 3302 | IF CPU # TARGETS.cpuMSP430 THEN |
7693 | akron1 | 3303 | parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
7983 | leency | 3304 | IF parser.open(parser, UTILS.RTL_NAME) THEN |
7597 | akron1 | 3305 | parser.parse(parser); |
3306 | PARS.destroy(parser) |
||
3307 | ELSE |
||
7693 | akron1 | 3308 | PARS.destroy(parser); |
3309 | parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); |
||
7983 | leency | 3310 | IF parser.open(parser, UTILS.RTL_NAME) THEN |
7693 | akron1 | 3311 | parser.parse(parser); |
3312 | PARS.destroy(parser) |
||
3313 | ELSE |
||
7983 | leency | 3314 | ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT) |
7693 | akron1 | 3315 | END |
7597 | akron1 | 3316 | END |
3317 | END; |
||
3318 | |||
3319 | parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); |
||
3320 | parser.main := TRUE; |
||
3321 | |||
3322 | IF parser.open(parser, modname) THEN |
||
3323 | parser.parse(parser) |
||
3324 | ELSE |
||
7983 | leency | 3325 | ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT) |
7597 | akron1 | 3326 | END; |
3327 | |||
3328 | PARS.destroy(parser); |
||
3329 | |||
7983 | leency | 3330 | IF PARS.program.bss > UTILS.MAX_GLOBAL_SIZE THEN |
7693 | akron1 | 3331 | ERRORS.Error(204) |
7597 | akron1 | 3332 | END; |
3333 | |||
7983 | leency | 3334 | IF CPU # TARGETS.cpuMSP430 THEN |
7693 | akron1 | 3335 | setrtl |
3336 | END; |
||
7597 | akron1 | 3337 | |
7693 | akron1 | 3338 | PROG.DelUnused(PARS.program, IL.DelImport); |
7597 | akron1 | 3339 | |
7696 | akron1 | 3340 | IL.set_bss(PARS.program.bss); |
7693 | akron1 | 3341 | |
3342 | CASE CPU OF |
||
7983 | leency | 3343 | |TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options) |
3344 | |TARGETS.cpuX86: X86.CodeGen(outname, target, options) |
||
3345 | |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options) |
||
3346 | |TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options) |
||
7597 | akron1 | 3347 | END |
7693 | akron1 | 3348 | |
7597 | akron1 | 3349 | END compile; |
3350 | |||
3351 | |||
7983 | leency | 3352 | END STATEMENTS.=>>>=" |