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