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