Subversion Repositories Kolibri OS

Rev

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.