kolibrios/programs/develop/oberon07/source/STATEMENTS.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018-2023, Anton Krotov
    All rights reserved.
*)

MODULE STATEMENTS;

IMPORT

    PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVMxI,
    ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;


CONST

    eCONST   =  PARS.eCONST;   eTYPE     =  PARS.eTYPE;     eVAR      =  PARS.eVAR;
    eEXPR    =  PARS.eEXPR;    eVREC     =  PARS.eVREC;     ePROC     =  PARS.ePROC;
    eVPAR    =  PARS.eVPAR;    ePARAM    =  PARS.ePARAM;    eSTPROC   =  PARS.eSTPROC;
    eSTFUNC  =  PARS.eSTFUNC;  eSYSFUNC  =  PARS.eSYSFUNC;  eSYSPROC  =  PARS.eSYSPROC;
    eIMP     =  PARS.eIMP;

    errASSERT = 1;  errPTR  =  2;  errDIV  =  3;  errPROC =  4;
    errGUARD  = 5;  errIDX  =  6;  errCASE =  7;  errCOPY =  8;
    errCHR    = 9;  errWCHR = 10;  errBYTE = 11;

    chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
    chkSTK* = MSP430.chkSTK; (* 6 *)

    chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE, chkSTK};


TYPE

    isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;

    RANGE = RECORD

        a, b: INTEGER

    END;

    CASE_LABEL = POINTER TO rCASE_LABEL;

    rCASE_LABEL = RECORD (AVL.DATA)

        range: RANGE;

        variant, self: INTEGER;

        _type: PROG._TYPE;

        prev: CASE_LABEL

    END;

    CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)

        label:     INTEGER;
        cmd:       IL.COMMAND;
        processed: BOOLEAN

    END;


VAR

    Options: PROG.OPTIONS;

    begcall, endcall: IL.COMMAND;

    CaseLabels, CaseVar: C.COLLECTION;

    CaseVariants: LISTS.LIST;

    CPU: INTEGER;

    tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE;


PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
    RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
END isExpr;


PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
    RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
END isVar;


PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tBOOLEAN)
END isBoolean;


PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tINTEGER)
END isInteger;


PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tBYTE)
END isByte;


PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
    RETURN isByte(e) OR isInteger(e)
END isInt;


PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tREAL)
END isReal;


PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tSET)
END isSet;


PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
    RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR})
END isString;


PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
    RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
END isStringW;


PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tCHAR)
END isChar;


PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type = tWCHAR)
END isCharW;


PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER)
END isPtr;


PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type.typ = PROG.tRECORD)
END isRec;


PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
    RETURN isRec(e) OR isPtr(e)
END isRecPtr;


PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type.typ = PROG.tARRAY)
END isArr;


PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
END isProc;


PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
    RETURN e._type.typ = PROG.tNIL
END isNil;


PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
    RETURN isArr(e) & (e._type.base = tCHAR)
END isCharArray;


PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
    RETURN isArr(e) & (e._type.base = tWCHAR)
END isCharArrayW;


PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
    RETURN isCharArray(e) OR isCharArrayW(e)
END isCharArrayX;


PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
BEGIN
    pos.line   := parser.lex.pos.line;
    pos.col    := parser.lex.pos.col;
    pos.parser := parser
END getpos;


PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
BEGIN
    PARS.Next(parser);
    getpos(parser, pos)
END NextPos;


PROCEDURE strlen (e: PARS.EXPR): INTEGER;
VAR
    res: INTEGER;

BEGIN
    ASSERT(isString(e));
    IF e._type = tCHAR THEN
        res := 1
    ELSE
        res := LENGTH(e.value.string(SCAN.STRING).s)
    END
    RETURN res
END strlen;


PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
VAR
    i, res: INTEGER;

BEGIN
    i := 0;
    res := 0;
    WHILE (i < LEN(s)) & (s[i] # 0X) DO
        IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
            INC(res)
        END;
        INC(i)
    END

    RETURN res
END _length;


PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
VAR
    res: INTEGER;

BEGIN
    ASSERT(isStringW(e));
    IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
        res := 1
    ELSE
        res := _length(e.value.string(SCAN.STRING).s)
    END
    RETURN res
END utf8strlen;


PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
VAR
    res: ARRAY 2 OF WCHAR;

BEGIN
    ASSERT(STRINGS.Utf8To16(s, res) = 1)
    RETURN ORD(res[0])
END StrToWChar;


PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
    RETURN isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
END isStringW1;


PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN;
VAR
    res: BOOLEAN;

BEGIN
    IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN

        IF t = e._type THEN
            res := TRUE
        ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
            IF (e.obj = eCONST) & (t = tBYTE) THEN
                res := ARITH.range(e.value, 0, 255)
            ELSE
                res := TRUE
            END
        ELSIF
            (e.obj = eCONST) & isChar(e) & (t = tWCHAR)
            OR isStringW1(e) & (t = tWCHAR)
            OR PROG.isBaseOf(t, e._type)
            OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(t, e._type)
            OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
            OR PROG.arrcomp(e._type, t)
            OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
            OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
        THEN
            res := TRUE
        ELSE
            res := FALSE
        END
    ELSE
        res := FALSE
    END

    RETURN res
END assigncomp;


PROCEDURE String (e: PARS.EXPR): INTEGER;
VAR
    offset: INTEGER;
    string: SCAN.STRING;

BEGIN
    IF strlen(e) # 1 THEN
        string := e.value.string(SCAN.STRING);
        IF string.offset = -1 THEN
            string.offset := IL.putstr(string.s);
        END;
        offset := string.offset
    ELSE
        offset := IL.putstr1(ARITH.Int(e.value))
    END

    RETURN offset
END String;


PROCEDURE StringW (e: PARS.EXPR): INTEGER;
VAR
    offset: INTEGER;
    string: SCAN.STRING;

BEGIN
    IF utf8strlen(e) # 1 THEN
        string := e.value.string(SCAN.STRING);
        IF string.offsetW = -1 THEN
            string.offsetW := IL.putstrW(string.s);
        END;
        offset := string.offsetW
    ELSE
        IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
            offset := IL.putstrW1(ARITH.Int(e.value))
        ELSE (* e._type.typ = PROG.tSTRING *)
            string := e.value.string(SCAN.STRING);
            IF string.offsetW = -1 THEN
                string.offsetW := IL.putstrW(string.s);
            END;
            offset := string.offsetW
        END
    END

    RETURN offset
END StringW;


PROCEDURE CheckRange (range, line, errno: INTEGER);
VAR
    label: INTEGER;

BEGIN
    label := IL.NewLabel();
    IL.AddCmd2(IL.opCHKIDX, label, range);
    IL.OnError(line, errno);
    IL.SetLabel(label)
END CheckRange;


PROCEDURE Float (parser: PARS.PARSER; e: PARS.EXPR);
VAR
    pos: PARS.POSITION;

BEGIN
    getpos(parser, pos);
    IL.Float(ARITH.Float(e.value), pos.line, pos.col)
END Float;


PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN;
VAR
    res:   BOOLEAN;
    label: INTEGER;

BEGIN
    IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
        res := TRUE;
        IF PROG.arrcomp(e._type, VarType) THEN

            IF ~PROG.isOpenArray(VarType) THEN
                IL.Const(VarType.length)
            END;
            IL.AddCmd(IL.opCOPYA, VarType.base.size);
            label := IL.NewLabel();
            IL.Jmp(IL.opJNZ, label);
            IL.OnError(line, errCOPY);
            IL.SetLabel(label)

        ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
            IF VarType = tINTEGER THEN
                IF e.obj = eCONST THEN
                    IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
                ELSE
                    IL.AddCmd0(IL.opSAVE)
                END
            ELSE
                IF e.obj = eCONST THEN
                    res := ARITH.range(e.value, 0, 255);
                    IF res THEN
                        IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
                    END
                ELSE
                    IL.AddCmd0(IL.opSAVE8)
                END
            END
        ELSIF isSet(e) & (VarType = tSET) THEN
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opSAVE)
            END
        ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opSBOOL)
            END
        ELSIF isReal(e) & (VarType = tREAL) THEN
            IF e.obj = eCONST THEN
                Float(parser, e)
            END;
            IL.savef(e.obj = eCONST)
        ELSIF isChar(e) & (VarType = tCHAR) THEN
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opSAVE8)
            END
        ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
            IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
        ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
            IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
        ELSIF isCharW(e) & (VarType = tWCHAR) THEN
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opSAVE16)
            END
        ELSIF PROG.isBaseOf(VarType, e._type) THEN
            IF VarType.typ = PROG.tPOINTER THEN
                IL.AddCmd0(IL.opSAVE)
            ELSE
                IL.AddCmd(IL.opCOPY, VarType.size)
            END
        ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
            IL.AddCmd0(IL.opSAVE32)
        ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN
            IF e.obj = ePROC THEN
                IL.AssignProc(e.ident.proc.label)
            ELSIF e.obj = eIMP THEN
                IL.AssignImpProc(e.ident._import)
            ELSE
                IF VarType.typ = PROG.tPROCEDURE THEN
                    IL.AddCmd0(IL.opSAVE)
                ELSE
                    IL.AddCmd(IL.opCOPY, VarType.size)
                END
            END
        ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
            IL.AddCmd(IL.opSAVEC, 0)
        ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
            IL.saves(String(e), strlen(e) + 1)
        ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
            IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
        ELSE
            res := FALSE
        END
    ELSE
        res := FALSE
    END
    RETURN res
END assign;


PROCEDURE LoadConst (e: PARS.EXPR);
BEGIN
    IL.Const(ARITH.Int(e.value))
END LoadConst;


PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
VAR
    stroffs: INTEGER;

    PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
    VAR
        t1, t2: PROG._TYPE;

    BEGIN
        t1 := p._type;
        t2 := e._type;
        WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
            t1 := t1.base;
            t2 := t2.base
        END

        RETURN PROG.isTypeEq(t1, t2)
    END arrcomp;


    PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        REPEAT
            res := t.length;
            t := t.base;
            DEC(n)
        UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
        ASSERT(n < 0)
        RETURN res
    END ArrLen;


    PROCEDURE OpenArray (t, t2: PROG._TYPE);
    VAR
        n, d1, d2: INTEGER;

    BEGIN
        IF t.length # 0 THEN
            IL.Param1;
            n := PROG.Dim(t2) - 1;
            WHILE n >= 0 DO
                IL.Const(ArrLen(t, n));
                IL.Param1;
                DEC(n)
            END
        ELSE
            d1 := PROG.Dim(t);
            d2 := PROG.Dim(t2);
            IF d1 # d2 THEN
                n := d2 - d1;
                WHILE d2 > d1 DO
                    IL.Const(ArrLen(t, d2 - 1));
                    DEC(d2)
                END;
                d2 := PROG.Dim(t2);
                WHILE n > 0 DO
                    IL.AddCmd(IL.opROT, d2);
                    DEC(n)
                END
            END;
            IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
        END
    END OpenArray;


BEGIN
    IF p.vPar THEN

        PARS.check(isVar(e), pos, 93);
        IF p._type.typ = PROG.tRECORD THEN
            PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66);
            IF e.obj = eVREC THEN
                IF e.ident # NIL THEN
                    IL.AddCmd(IL.opVADR, e.ident.offset - 1)
                ELSE
                    IL.AddCmd0(IL.opPUSHT)
                END
            ELSE
                IL.Const(e._type.num)
            END;
            IL.AddCmd(IL.opPARAM, 2)
        ELSIF PROG.isOpenArray(p._type) THEN
            PARS.check(arrcomp(e, p), pos, 66);
            OpenArray(e._type, p._type)
        ELSE
            PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66);
            IL.Param1
        END;
        PARS.check(~e.readOnly, pos, 94)

    ELSE
        PARS.check(isExpr(e) OR isProc(e), pos, 66);
        IF PROG.isOpenArray(p._type) THEN
            IF e._type.typ = PROG.tARRAY THEN
                PARS.check(arrcomp(e, p), pos, 66);
                OpenArray(e._type, p._type)
            ELSIF isString(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tCHAR) THEN
                IL.StrAdr(String(e));
                IL.Param1;
                IL.Const(strlen(e) + 1);
                IL.Param1
            ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN
                IL.StrAdr(StringW(e));
                IL.Param1;
                IL.Const(utf8strlen(e) + 1);
                IL.Param1
            ELSE
                PARS.error(pos, 66)
            END
        ELSE
            PARS.check(~PROG.isOpenArray(e._type), pos, 66);
            PARS.check(assigncomp(e, p._type), pos, 66);
            IF e.obj = eCONST THEN
                IF e._type = tREAL THEN
                    Float(parser, e);
                    IL.AddCmd0(IL.opPUSHF)
                ELSIF e._type.typ = PROG.tNIL THEN
                    IL.Const(0);
                    IL.Param1
                ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
                    IL.Const(StrToWChar(e.value.string(SCAN.STRING).s));
                    IL.Param1
                ELSIF (e._type.typ = PROG.tSTRING) OR
                      (e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
                    IF p._type.base = tCHAR THEN
                        stroffs := String(e);
                        IL.StrAdr(stroffs);
                        IF (CPU = TARGETS.cpuMSP430) & (p._type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
                            ERRORS.WarningMsg(pos.line, pos.col, 0)
                        END
                    ELSE (* WCHAR *)
                        stroffs := StringW(e);
                        IL.StrAdr(stroffs)
                    END;
                    IL.set_dmin(stroffs + p._type.size);
                    IL.Param1
                ELSE
                    LoadConst(e);
                    IL.Param1
                END
            ELSIF e.obj = ePROC THEN
                PARS.check(e.ident.global, pos, 85);
                IL.PushProc(e.ident.proc.label);
                IL.Param1
            ELSIF e.obj = eIMP THEN
                IL.PushImpProc(e.ident._import);
                IL.Param1
            ELSIF isExpr(e) & (e._type = tREAL) THEN
                IL.AddCmd0(IL.opPUSHF)
            ELSE
                IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN
                    CheckRange(256, pos.line, errBYTE)
                END;
                IL.Param1
            END
        END

    END
END paramcomp;


PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
BEGIN
    parser.expression(parser, e)
END PExpression;


PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    e1, e2: PARS.EXPR;
    pos:    PARS.POSITION;
    proc,
    label,
    size,
    n, i:   INTEGER;
    code:   ARITH.VALUE;
    wchar,
    comma:  BOOLEAN;
    cmd1,
    cmd2:   IL.COMMAND;


    PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
    BEGIN
        parser.designator(parser, e);
        PARS.check(isVar(e), pos, 93);
        PARS.check(isfunc(e), pos, 66);
        IF readOnly THEN
            PARS.check(~e.readOnly, pos, 94)
        END
    END varparam;


    PROCEDURE shift_minmax (proc: INTEGER): CHAR;
    VAR
        res: CHAR;

    BEGIN
        CASE proc OF
        |PROG.stASR: res := "A"
        |PROG.stLSL: res := "L"
        |PROG.stROR: res := "O"
        |PROG.stLSR: res := "R"
        |PROG.stMIN: res := "m"
        |PROG.stMAX: res := "x"
        END
        RETURN res
    END shift_minmax;


BEGIN
    ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
    proc := e.stproc;

(*    IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
        PARS.checklex(parser, SCAN.lxLROUND);
        PARS.Next(parser);
(*    END; *)

    getpos(parser, pos);

    IF e.obj IN {eSTPROC, eSYSPROC} THEN

        CASE proc OF
        |PROG.stASSERT:
            PExpression(parser, e);
            PARS.check(isBoolean(e), pos, 66);
            IF e.obj = eCONST THEN
                IF ~ARITH.getBool(e.value) THEN
                    IL.OnError(pos.line, errASSERT)
                END
            ELSE
                label := IL.NewLabel();
                IL.not;
                IL.AndOrOpt(label);
                IL.OnError(pos.line, errASSERT);
                IL.SetLabel(label)
            END

        |PROG.stINC, PROG.stDEC:
            IL.pushBegEnd(begcall, endcall);
            varparam(parser, pos, isInt, TRUE, e);
            IF e._type = tINTEGER THEN
                IF parser.sym = SCAN.lxCOMMA THEN
                    NextPos(parser, pos);
                    IL.setlast(begcall);
                    PExpression(parser, e2);
                    IL.setlast(endcall.prev(IL.COMMAND));
                    PARS.check(isInt(e2), pos, 66);
                    IF e2.obj = eCONST THEN
                        IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
                    ELSE
                        IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
                    END
                ELSE
                    IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
                END
            ELSE  (* e._type = tBYTE *)
                IF parser.sym = SCAN.lxCOMMA THEN
                    NextPos(parser, pos);
                    IL.setlast(begcall);
                    PExpression(parser, e2);
                    IL.setlast(endcall.prev(IL.COMMAND));
                    PARS.check(isInt(e2), pos, 66);
                    IF e2.obj = eCONST THEN
                        IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
                    ELSE
                        IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
                    END
                ELSE
                    IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
                END
            END;
            IL.popBegEnd(begcall, endcall)

        |PROG.stINCL, PROG.stEXCL:
            IL.pushBegEnd(begcall, endcall);
            varparam(parser, pos, isSet, TRUE, e);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            IL.setlast(begcall);
            PExpression(parser, e2);
            IL.setlast(endcall.prev(IL.COMMAND));
            PARS.check(isInt(e2), pos, 66);
            IF e2.obj = eCONST THEN
                PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
                IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
            ELSE
                IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
            END;
            IL.popBegEnd(begcall, endcall)

        |PROG.stNEW:
            varparam(parser, pos, isPtr, TRUE, e);
            IF CPU = TARGETS.cpuMSP430 THEN
                PARS.check(e._type.base.size + 16 < Options.ram, pos, 63)
            END;
            IL.New(e._type.base.size, e._type.base.num)

        |PROG.stDISPOSE:
            varparam(parser, pos, isPtr, TRUE, e);
            IL.AddCmd0(IL.opDISP)

        |PROG.stPACK:
            varparam(parser, pos, isReal, TRUE, e);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            PExpression(parser, e2);
            PARS.check(isInt(e2), pos, 66);
            IF e2.obj = eCONST THEN
                IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
            ELSE
                IL.AddCmd0(IL.opPACK)
            END

        |PROG.stUNPK:
            varparam(parser, pos, isReal, TRUE, e);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            varparam(parser, pos, isInteger, TRUE, e2);
            IL.AddCmd0(IL.opUNPK)

        |PROG.stCOPY:
            IL.pushBegEnd(begcall, endcall);
            PExpression(parser, e);
            IF isString(e) OR isCharArray(e) THEN
                wchar := FALSE
            ELSIF isStringW(e) OR isCharArrayW(e) THEN
                wchar := TRUE
            ELSE
                PARS.error(pos, 66)
            END;

            IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN
                IL.Const(e._type.length)
            END;

            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            IL.setlast(begcall);

            IF wchar THEN
                varparam(parser, pos, isCharArrayW, TRUE, e1)
            ELSE
                IF e.obj = eCONST THEN
                    varparam(parser, pos, isCharArrayX, TRUE, e1)
                ELSE
                    varparam(parser, pos, isCharArray, TRUE, e1)
                END;

                wchar := e1._type.base = tWCHAR
            END;

            IF ~PROG.isOpenArray(e1._type) THEN
                IL.Const(e1._type.length)
            END;

            IL.setlast(endcall.prev(IL.COMMAND));

            IF e.obj = eCONST THEN
                IF wchar THEN
                    IL.StrAdr(StringW(e));
                    IL.Const(utf8strlen(e) + 1)
                ELSE
                    IL.StrAdr(String(e));
                    IL.Const(strlen(e) + 1)
                END
            END;
            IL.AddCmd(IL.opCOPYS, e1._type.base.size);
            IL.popBegEnd(begcall, endcall)

        |PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            parser.designator(parser, e2);
            PARS.check(isVar(e2), pos, 93);
            IF proc = PROG.sysGET THEN
                PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66)
            ELSE
                PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66)
            END;

            CASE proc OF
            |PROG.sysGET:   size := e2._type.size
            |PROG.sysGET8:  size := 1
            |PROG.sysGET16: size := 2
            |PROG.sysGET32: size := 4
            END;

            PARS.check(size <= e2._type.size, pos, 66);

            IF e.obj = eCONST THEN
                IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size)
            ELSE
                IL.AddCmd(IL.opGET, size)
            END

        |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
            IL.pushBegEnd(begcall, endcall);
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            IF e.obj = eCONST THEN
                LoadConst(e)
            END;
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            IL.setlast(begcall);
            PExpression(parser, e2);
            PARS.check(isExpr(e2), pos, 66);

            IF proc = PROG.sysPUT THEN
                PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
                IF e2.obj = eCONST THEN
                    IF e2._type = tREAL THEN
                        Float(parser, e2);
                        IL.setlast(endcall.prev(IL.COMMAND));
                        IL.savef(FALSE)
                    ELSE
                        LoadConst(e2);
                        IL.setlast(endcall.prev(IL.COMMAND));
                        IL.SysPut(e2._type.size)
                    END
                ELSE
                    IL.setlast(endcall.prev(IL.COMMAND));
                    IF e2._type = tREAL THEN
                        IL.savef(FALSE)
                    ELSIF e2._type = tBYTE THEN
                        IL.SysPut(tINTEGER.size)
                    ELSE
                        IL.SysPut(e2._type.size)
                    END
                END

            ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
                PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
                IF e2.obj = eCONST THEN
                    LoadConst(e2)
                END;
                IL.setlast(endcall.prev(IL.COMMAND));
                CASE proc OF
                |PROG.sysPUT8:  size := 1
                |PROG.sysPUT16: size := 2
                |PROG.sysPUT32: size := 4
                END;
                IL.SysPut(size)

            END;
            IL.popBegEnd(begcall, endcall)

        |PROG.sysMOVE:
            FOR i := 1 TO 2 DO
                PExpression(parser, e);
                PARS.check(isInt(e), pos, 66);
                IF e.obj = eCONST THEN
                    LoadConst(e)
                END;
                PARS.checklex(parser, SCAN.lxCOMMA);
                NextPos(parser, pos)
            END;

            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opMOVE)
            END

        |PROG.sysCOPY:
            FOR i := 1 TO 2 DO
                parser.designator(parser, e);
                PARS.check(isVar(e), pos, 93);
                n := PROG.Dim(e._type);
                WHILE n > 0 DO
                    IL.drop;
                    DEC(n)
                END;
                PARS.checklex(parser, SCAN.lxCOMMA);
                NextPos(parser, pos)
            END;

            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            IF e.obj = eCONST THEN
                IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
            ELSE
                IL.AddCmd0(IL.opMOVE)
            END

        |PROG.sysCODE:
            REPEAT
                getpos(parser, pos);
                PARS.ConstExpression(parser, code);
                PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
                IF TARGETS.WordSize > TARGETS.InstrSize THEN
                    CASE TARGETS.InstrSize OF
                    |1: PARS.check(ARITH.range(code, 0, 255), pos, 42)
                    |2: PARS.check(ARITH.range(code, 0, 65535), pos, 110)
                    END
                END;
                IL.AddCmd(IL.opCODE, ARITH.getInt(code));
                comma := parser.sym = SCAN.lxCOMMA;
                IF comma THEN
                    PARS.Next(parser)
                ELSE
                    PARS.checklex(parser, SCAN.lxRROUND)
                END
            UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
          (*
        |PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
            IF parser.sym = SCAN.lxLROUND THEN
                PARS.Next(parser);
                PARS.checklex(parser, SCAN.lxRROUND);
                PARS.Next(parser)
            END;
            ASSERT(CPU = cpuMSP430);
            CASE proc OF
            |PROG.sysNOP:  IL.AddCmd(IL.opCODE, 4303H)
            |PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
            |PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
            END
            *)
        END;

        e.obj := eEXPR;
        e._type := NIL

    ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN

        CASE e.stproc OF
        |PROG.stABS:
            PExpression(parser, e);
            PARS.check(isInt(e) OR isReal(e), pos, 66);
            IF e.obj = eCONST THEN
                PARS.check(ARITH.abs(e.value), pos, 39)
            ELSE
                IL.abs(isReal(e))
            END

        |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            PExpression(parser, e2);
            PARS.check(isInt(e2), pos, 66);
            e._type := tINTEGER;
            IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
                ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
            ELSE
                IF e.obj = eCONST THEN
                    IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
                ELSIF e2.obj = eCONST THEN
                    IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
                ELSE
                    IL.shift_minmax(shift_minmax(proc))
                END;
                e.obj := eEXPR
            END

        |PROG.stCHR:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            e._type := tCHAR;
            IF e.obj = eCONST THEN
                ARITH.setChar(e.value, ARITH.getInt(e.value));
                PARS.check(ARITH.check(e.value), pos, 107)
            ELSE
                IF chkCHR IN Options.checking THEN
                    CheckRange(256, pos.line, errCHR)
                ELSE
                    IL.AddCmd(IL.opMODR, 256)
                END
            END

        |PROG.stWCHR:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            e._type := tWCHAR;
            IF e.obj = eCONST THEN
                ARITH.setWChar(e.value, ARITH.getInt(e.value));
                PARS.check(ARITH.check(e.value), pos, 101)
            ELSE
                IF chkWCHR IN Options.checking THEN
                    CheckRange(65536, pos.line, errWCHR)
                ELSE
                    IL.AddCmd(IL.opMODR, 65536)
                END
            END

        |PROG.stFLOOR:
            PExpression(parser, e);
            PARS.check(isReal(e), pos, 66);
            e._type := tINTEGER;
            IF e.obj = eCONST THEN
                PARS.check(ARITH.floor(e.value), pos, 39)
            ELSE
                IL.AddCmd0(IL.opFLOOR)
            END

        |PROG.stFLT:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            e._type := tREAL;
            IF e.obj = eCONST THEN
                ARITH.flt(e.value)
            ELSE
                IL.AddCmd2(IL.opFLT, pos.line, pos.col)
            END

        |PROG.stLEN:
            cmd1 := IL.getlast();
            varparam(parser, pos, isArr, FALSE, e);
            IF e._type.length > 0 THEN
                cmd2 := IL.getlast();
                IL.delete2(cmd1.next, cmd2);
                IL.setlast(cmd1);
                ASSERT(ARITH.setInt(e.value, e._type.length));
                e.obj := eCONST
            ELSE
                IL.len(PROG.Dim(e._type))
            END;
            e._type := tINTEGER

        |PROG.stLENGTH:
            PExpression(parser, e);
            IF isCharArray(e) THEN
                IF e._type.length > 0 THEN
                    IL.Const(e._type.length)
                END;
                IL.AddCmd0(IL.opLENGTH)
            ELSIF isCharArrayW(e) THEN
                IF e._type.length > 0 THEN
                    IL.Const(e._type.length)
                END;
                IL.AddCmd0(IL.opLENGTHW)
            ELSE
                PARS.error(pos, 66);
            END;
            e._type := tINTEGER

        |PROG.stODD:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            e._type := tBOOLEAN;
            IF e.obj = eCONST THEN
                ARITH.odd(e.value)
            ELSE
                IL.AddCmd(IL.opMODR, 2)
            END

        |PROG.stORD:
            cmd1 := IL.getlast();
            PExpression(parser, e);
            PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
            IF e.obj = eCONST THEN
                IF isStringW1(e) THEN
                    ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
                ELSE
                    ARITH.ord(e.value)
                END
            ELSE
                IF isBoolean(e) THEN
                    cmd2 := IL.getlast();
                    IL.setlast(cmd1);
                    IL.AddCmd(IL.opPRECALL, 0);
                    IL.AddCmd0(IL.opRES);
                    IL.drop;
                    IL.setlast(cmd2);
                    IL._ord
                END
            END;
            e._type := tINTEGER

        |PROG.stBITS:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            IF e.obj = eCONST THEN
                ARITH.bits(e.value)
            END;
            e._type := tSET

        |PROG.sysADR:
            parser.designator(parser, e);
            IF isVar(e) THEN
                n := PROG.Dim(e._type);
                WHILE n > 0 DO
                    IL.drop;
                    DEC(n)
                END
            ELSIF e.obj = ePROC THEN
                IL.PushProc(e.ident.proc.label)
            ELSIF e.obj = eIMP THEN
                IL.PushImpProc(e.ident._import)
            ELSE
                PARS.error(pos, 108)
            END;
            e._type := tINTEGER

        |PROG.sysSADR:
            PExpression(parser, e);
            PARS.check(isString(e), pos, 66);
            IL.StrAdr(String(e));
            e._type := tINTEGER;
            e.obj := eEXPR

        |PROG.sysWSADR:
            PExpression(parser, e);
            PARS.check(isStringW(e), pos, 66);
            IL.StrAdr(StringW(e));
            e._type := tINTEGER;
            e.obj := eEXPR

        |PROG.sysTYPEID:
            PExpression(parser, e);
            PARS.check(e.obj = eTYPE, pos, 68);
            IF e._type.typ = PROG.tRECORD THEN
                ASSERT(ARITH.setInt(e.value, e._type.num))
            ELSIF  e._type.typ = PROG.tPOINTER THEN
                ASSERT(ARITH.setInt(e.value, e._type.base.num))
            ELSE
                PARS.error(pos, 52)
            END;
            e.obj := eCONST;
            e._type := tINTEGER

        |PROG.sysINF:
            IL.AddCmd2(IL.opINF, pos.line, pos.col);
            e.obj := eEXPR;
            e._type := tREAL

        |PROG.sysSIZE:
            PExpression(parser, e);
            PARS.check(e.obj = eTYPE, pos, 68);
            ASSERT(ARITH.setInt(e.value, e._type.size));
            e.obj := eCONST;
            e._type := tINTEGER

        END

    END;

(*    IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
        PARS.checklex(parser, SCAN.lxRROUND);
        PARS.Next(parser);
(*    END; *)

    IF e.obj # eCONST THEN
        e.obj := eEXPR
    END

END stProc;


PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    proc:  PROG._TYPE;
    param: LISTS.ITEM;
    e1:    PARS.EXPR;
    pos:   PARS.POSITION;

BEGIN
    ASSERT(parser.sym = SCAN.lxLROUND);

    IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
        proc := e._type;
        PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
        PARS.Next(parser);

        param := proc.params.first;
        WHILE param # NIL DO
            getpos(parser, pos);

            IL.setlast(begcall);

            IF param(PROG.PARAM).vPar THEN
                parser.designator(parser, e1)
            ELSE
                PExpression(parser, e1)
            END;
            paramcomp(parser, pos, e1, param(PROG.PARAM));
            param := param.next;
            IF param # NIL THEN
                PARS.checklex(parser, SCAN.lxCOMMA);
                PARS.Next(parser)
            END
        END;

        PARS.checklex(parser, SCAN.lxRROUND);
        PARS.Next(parser);

        e.obj := eEXPR;
        e._type := proc.base

    ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
        stProc(parser, e)
    ELSE
        PARS.check1(FALSE, parser, 86)
    END

END ActualParameters;


PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    ident: PROG.IDENT;
    imp:   BOOLEAN;
    pos:   PARS.POSITION;

BEGIN
    PARS.checklex(parser, SCAN.lxIDENT);
    getpos(parser, pos);
    imp := FALSE;
    ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
    PARS.check1(ident # NIL, parser, 48);
    IF ident.typ = PROG.idMODULE THEN
        PARS.ExpectSym(parser, SCAN.lxPOINT);
        PARS.ExpectSym(parser, SCAN.lxIDENT);
        ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
        PARS.check1((ident # NIL) & ident.export, parser, 48);
        imp := TRUE
    END;
    PARS.Next(parser);

    e.readOnly := FALSE;
    e.ident := ident;

    CASE ident.typ OF
    |PROG.idCONST:
        e.obj   := eCONST;
        e._type := ident._type;
        e.value := ident.value
    |PROG.idTYPE:
        e.obj   := eTYPE;
        e._type := ident._type
    |PROG.idVAR:
        e.obj   := eVAR;
        e._type := ident._type;
        e.readOnly := imp
    |PROG.idPROC:
        e.obj   := ePROC;
        e._type := ident._type
    |PROG.idIMP:
        e.obj   := eIMP;
        e._type := ident._type
    |PROG.idVPAR:
        e._type := ident._type;
        IF e._type.typ = PROG.tRECORD THEN
            e.obj := eVREC
        ELSE
            e.obj := eVPAR
        END
    |PROG.idPARAM:
        e.obj := ePARAM;
        e._type := ident._type;
        e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY})
    |PROG.idSTPROC:
        e.obj    := eSTPROC;
        e._type  := ident._type;
        e.stproc := ident.stproc
    |PROG.idSTFUNC:
        e.obj    := eSTFUNC;
        e._type  := ident._type;
        e.stproc := ident.stproc
    |PROG.idSYSPROC:
        e.obj    := eSYSPROC;
        e._type  := ident._type;
        e.stproc := ident.stproc
    |PROG.idSYSFUNC:
        PARS.check(~parser.constexp, pos, 109);
        e.obj    := eSYSFUNC;
        e._type  := ident._type;
        e.stproc := ident.stproc
    |PROG.idNONE:
        PARS.error(pos, 115)
    END;

    IF isVar(e) THEN
        PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
    END

END qualident;


PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
VAR
    label: INTEGER;

BEGIN
    IF load THEN
        IL.load(e._type.size)
    END;

    IF chkPTR IN Options.checking THEN
        label := IL.NewLabel();
        IL.Jmp(IL.opJNZ1, label);
        IL.OnError(pos.line, error);
        IL.SetLabel(label)
    END
END deref;


PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    field:  PROG.FIELD;
    pos:    PARS.POSITION;
    t, idx: PARS.EXPR;
    sysVal: BOOLEAN;
    n:      INTEGER;


    PROCEDURE LoadAdr (e: PARS.EXPR);
    VAR
        offset: INTEGER;

        PROCEDURE OpenArray (e: PARS.EXPR);
        VAR
            offset, n: INTEGER;
        BEGIN
            offset := e.ident.offset;
            n := PROG.Dim(e._type);
            WHILE n >= 0 DO
                IL.AddCmd(IL.opVADR, offset);
                DEC(offset);
                DEC(n)
            END
        END OpenArray;


    BEGIN
        IF e.obj = eVAR THEN
            offset := PROG.getOffset(e.ident);
            IF e.ident.global THEN
                IL.AddCmd(IL.opGADR, offset)
            ELSE
                IL.AddCmd(IL.opLADR, -offset)
            END
        ELSIF e.obj = ePARAM THEN
            IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN
                IL.AddCmd(IL.opVADR, e.ident.offset)
            ELSIF PROG.isOpenArray(e._type) THEN
                OpenArray(e)
            ELSE
                IL.AddCmd(IL.opLADR, e.ident.offset)
            END
        ELSIF e.obj IN {eVPAR, eVREC} THEN
            IF PROG.isOpenArray(e._type) THEN
                OpenArray(e)
            ELSE
                IL.AddCmd(IL.opVADR, e.ident.offset)
            END
        END
    END LoadAdr;


    PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
    VAR
        label, offset, n, k: INTEGER;
        _type: PROG._TYPE;

    BEGIN
        IF chkIDX IN Options.checking THEN
            label := IL.NewLabel();
            IL.AddCmd2(IL.opCHKIDX2, label, 0);
            IL.OnError(pos.line, errIDX);
            IL.SetLabel(label)
        ELSE
            IL.AddCmd(IL.opCHKIDX2, -1)
        END;

        _type := PROG.OpenBase(e._type);
        IF _type.size # 1 THEN
            IL.AddCmd(IL.opMULC, _type.size)
        END;
        n := PROG.Dim(e._type) - 1;
        k := n;
        WHILE n > 0 DO
            IL.AddCmd0(IL.opMUL);
            DEC(n)
        END;
        IL.AddCmd0(IL.opADD);
        offset := e.ident.offset - 1;
        n := k;
        WHILE n > 0 DO
            IL.AddCmd(IL.opVADR, offset);
            DEC(offset);
            DEC(n)
        END
    END OpenIdx;


BEGIN
    qualident(parser, e);
    sysVal := (e.obj = eSYSPROC) & (e.stproc = PROG.sysVAL);
    IF sysVal THEN
        PARS.checklex(parser, SCAN.lxLROUND);
        PARS.Next(parser);
        getpos(parser, pos);
        designator(parser, e);
        PARS.check(isVar(e), pos, 93);
        IF PROG.isOpenArray(e._type) THEN
            n := PROG.Dim(e._type);
            WHILE n > 0 DO
                IL.drop;
                DEC(n)
            END
        END;
        PARS.checklex(parser, SCAN.lxCOMMA);
        PARS.Next(parser);
        getpos(parser, pos);
        qualident(parser, t);
        PARS.check(t.obj = eTYPE, pos, 79);
        e._type := t._type;
        PARS.checklex(parser, SCAN.lxRROUND);
        PARS.Next(parser)
    END;

    IF e.obj IN {ePROC, eIMP} THEN
        PROG.UseProc(parser.unit, e.ident.proc)
    END;

    IF isVar(e) & ~sysVal THEN
        LoadAdr(e)
    END;

    WHILE parser.sym = SCAN.lxPOINT DO
        getpos(parser, pos);
        PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
        IF e._type.typ = PROG.tPOINTER THEN
            deref(pos, e, TRUE, errPTR)
        END;
        PARS.ExpectSym(parser, SCAN.lxIDENT);
        IF e._type.typ = PROG.tPOINTER THEN
            e._type := e._type.base;
            e.readOnly := FALSE
        END;
        field := PROG.getField(e._type, parser.lex.ident, parser.unit);
        PARS.check1(field # NIL, parser, 74);
        e._type := field._type;
        IF e.obj = eVREC THEN
            e.obj := eVPAR
        END;
        IF field.offset # 0 THEN
            IL.AddCmd(IL.opADDC, field.offset)
        END;
        PARS.Next(parser);
        e.ident := NIL

    ELSIF parser.sym = SCAN.lxLSQUARE DO

        REPEAT

            PARS.check1(isArr(e), parser, 75);
            NextPos(parser, pos);
            PExpression(parser, idx);
            PARS.check(isInt(idx), pos, 76);

            IF idx.obj = eCONST THEN
                IF e._type.length > 0 THEN
                    PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83);
                    IF ARITH.Int(idx.value) > 0 THEN
                        IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size)
                    END
                ELSE
                    PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
                    LoadConst(idx);
                    OpenIdx(parser, pos, e)
                END
            ELSE
                IF e._type.length > 0 THEN
                    IF chkIDX IN Options.checking THEN
                        CheckRange(e._type.length, pos.line, errIDX)
                    END;
                    IF e._type.base.size # 1 THEN
                        IL.AddCmd(IL.opMULC, e._type.base.size)
                    END;
                    IL.AddCmd0(IL.opADD)
                ELSE
                    OpenIdx(parser, pos, e)
                END
            END;

            e._type := e._type.base

        UNTIL parser.sym # SCAN.lxCOMMA;

        PARS.checklex(parser, SCAN.lxRSQUARE);
        PARS.Next(parser);
        IF ~(isArr(e) & (e._type.length = 0) & (parser.sym = SCAN.lxLSQUARE)) THEN
            e.ident := NIL
        END

    ELSIF parser.sym = SCAN.lxCARET DO
        getpos(parser, pos);
        PARS.check1(isPtr(e), parser, 77);
        deref(pos, e, TRUE, errPTR);
        e._type := e._type.base;
        e.readOnly := FALSE;
        PARS.Next(parser);
        e.ident := NIL;
        e.obj := eVREC

    ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO

        IF e._type.typ = PROG.tRECORD THEN
            PARS.check1(e.obj = eVREC, parser, 78)
        END;
        NextPos(parser, pos);
        qualident(parser, t);
        PARS.check(t.obj = eTYPE, pos, 79);

        IF e._type.typ = PROG.tRECORD THEN
            PARS.check(t._type.typ = PROG.tRECORD, pos, 80);
            IF chkGUARD IN Options.checking THEN
                IF e.ident = NIL THEN
                    IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD)
                ELSE
                    IL.AddCmd(IL.opVADR, e.ident.offset - 1);
                    IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD)
                END
            END;
        ELSE
            PARS.check(t._type.typ = PROG.tPOINTER, pos, 81);
            IF chkGUARD IN Options.checking THEN
                IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD)
            END
        END;

        PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82);

        e._type := t._type;

        PARS.checklex(parser, SCAN.lxRROUND);
        PARS.Next(parser)

    END

END designator;


PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
VAR
    cconv,
    parSize,
    callconv,
    fparSize,
    int, flt,
    stk_par:  INTEGER;

BEGIN
    cconv := procType.call;
    parSize := procType.parSize;

    IF cconv IN {PROG._win64, PROG.win64} THEN
        callconv := IL.call_win64;
        fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        callconv := IL.call_sysv;
        fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
        stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
    ELSIF cconv IN {PROG.fastcall, PROG._fastcall} THEN
        IF parSize = 0 THEN
            callconv := IL.call_stack
        ELSIF parSize = 1 THEN
            callconv := IL.call_fast1
        ELSIF parSize >= 2 THEN
            callconv := IL.call_fast2
        END;
        fparSize := 0
    ELSE
        callconv := IL.call_stack;
        fparSize := 0
    END;
    IL.setlast(begcall);
    IL.AddCmd(IL.opPRECALL, ORD(isfloat));

    IF cconv IN {PROG._ccall, PROG.ccall} THEN
        IL.AddCmd(IL.opALIGN16, parSize)
    ELSIF cconv IN {PROG._win64, PROG.win64} THEN
        IL.AddCmd(IL.opWIN64ALIGN16, parSize)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
    END;
    IL.setlast(endcall.prev(IL.COMMAND));

    IF e.obj = eIMP THEN
        IL.CallImp(e.ident._import, callconv, fparSize)
    ELSIF e.obj = ePROC THEN
        IL.Call(e.ident.proc.label, callconv, fparSize)
    ELSIF isExpr(e) THEN
        deref(pos, e, CallStat, errPROC);
        IL.CallP(callconv, fparSize)
    END;

    IF cconv IN {PROG._ccall, PROG.ccall} THEN
        IL.AddCmd(IL.opCLEANUP, parSize);
        IL.AddCmd0(IL.opPOPSP)
    ELSIF cconv IN {PROG._win64, PROG.win64} THEN
        IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
        IL.AddCmd0(IL.opPOPSP)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
        IL.AddCmd0(IL.opPOPSP)
    ELSIF cconv IN {PROG._cdecl, PROG.cdecl, PROG.default16, PROG.code, PROG._code} THEN
        IL.AddCmd(IL.opCLEANUP, parSize)
    END;

    IF CallStat THEN
        IL.AddCmd0(IL.opRES);
        IL.drop
    ELSE
        IF isfloat THEN
            IL.AddCmd2(IL.opRESF, pos.line, pos.col)
        ELSE
            IL.AddCmd0(IL.opRES)
        END
    END
END ProcCall;


PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    pos, pos0, pos1: PARS.POSITION;
    e1: PARS.EXPR;
    op, cmp, error: INTEGER;
    constant, eq: BOOLEAN;


    PROCEDURE relation (sym: INTEGER): BOOLEAN;
        RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
               (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
               (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
               (sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
    END relation;


    PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
        RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
               (sym = SCAN.lxOR)
    END AddOperator;


    PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
        RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
               (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
               (sym = SCAN.lxAND)
    END MulOperator;


    PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        e1, e2: PARS.EXPR;
        pos:    PARS.POSITION;
        range:  BOOLEAN;

    BEGIN
        range := FALSE;
        getpos(parser, pos);
        expression(parser, e1);
        PARS.check(isInt(e1), pos, 76);

        IF e1.obj = eCONST THEN
            PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
        END;

        range := parser.sym = SCAN.lxRANGE;

        IF range THEN
            NextPos(parser, pos);
            expression(parser, e2);
            PARS.check(isInt(e2), pos, 76);

            IF e2.obj = eCONST THEN
                PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
            END
        ELSE
            IF e1.obj = eCONST THEN
                e2 := e1
            END
        END;

        e._type := tSET;

        IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
            ARITH.constrSet(e.value, e1.value, e2.value);
            e.obj := eCONST
        ELSE
            IF range THEN
                IF e1.obj = eCONST THEN
                    IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
                ELSIF e2.obj = eCONST THEN
                    IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
                ELSE
                    IL.AddCmd0(IL.opRSET)
                END
            ELSE
                IL.AddCmd0(IL.opRSET1)
            END;
            e.obj := eEXPR
        END

    END element;


    PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        e1: PARS.EXPR;

    BEGIN
        ASSERT(parser.sym = SCAN.lxLCURLY);

        e.obj := eCONST;
        e._type := tSET;
        ARITH.emptySet(e.value);

        PARS.Next(parser);
        IF parser.sym # SCAN.lxRCURLY THEN
            element(parser, e1);

            IF e1.obj = eCONST THEN
                ARITH.opSet(e.value, e1.value, "+")
            ELSE
                e.obj := eEXPR
            END;

            WHILE parser.sym = SCAN.lxCOMMA DO
                PARS.Next(parser);
                element(parser, e1);
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
                    ARITH.opSet(e.value, e1.value, "+")
                ELSE
                    IF e.obj = eCONST THEN
                        IL.AddCmd(IL.opADDSC, ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opADDSC, ARITH.Int(e1.value))
                    ELSE
                        IL.AddCmd0(IL.opADDS)
                    END;
                    e.obj := eEXPR
                END
            END;
            PARS.checklex(parser, SCAN.lxRCURLY)
        END;
        PARS.Next(parser);
    END set;


    PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        sym:      INTEGER;
        pos:      PARS.POSITION;
        e1:       PARS.EXPR;
        isfloat:  BOOLEAN;


        PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
        BEGIN
            IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
                IF e._type = tREAL THEN
                    IL.AddCmd2(IL.opLOADF, pos.line, pos.col)
                ELSE
                    IL.load(e._type.size)
                END
            END
        END LoadVar;


    BEGIN
        sym := parser.sym;

        IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
            e.obj := eCONST;
            e.value := parser.lex.value;
            e._type := PROG.getType(e.value.typ);
            PARS.Next(parser)

        ELSIF sym = SCAN.lxNIL THEN
            e.obj  := eCONST;
            e._type := PROG.program.stTypes.tNIL;
            PARS.Next(parser)

        ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
            e.obj := eCONST;
            ARITH.setbool(e.value, sym = SCAN.lxTRUE);
            e._type := tBOOLEAN;
            PARS.Next(parser)

        ELSIF sym = SCAN.lxLCURLY THEN
            set(parser, e)

        ELSIF sym = SCAN.lxIDENT THEN
            getpos(parser, pos);

            IL.pushBegEnd(begcall, endcall);

            designator(parser, e);
            IF isVar(e) THEN
                LoadVar(e, parser, pos)
            END;
            IF parser.sym = SCAN.lxLROUND THEN
                e1 := e;
                ActualParameters(parser, e);
                PARS.check(e._type # NIL, pos, 59);
                isfloat := e._type = tREAL;
                IF e1.obj IN {ePROC, eIMP} THEN
                    ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE)
                ELSIF isExpr(e1) THEN
                    ProcCall(e1, e1._type, isfloat, parser, pos, FALSE)
                END
            END;
            IL.popBegEnd(begcall, endcall)

        ELSIF sym = SCAN.lxLROUND THEN
            PARS.Next(parser);
            expression(parser, e);
            PARS.checklex(parser, SCAN.lxRROUND);
            PARS.Next(parser);
            IF isExpr(e) & (e.obj # eCONST) THEN
                e.obj := eEXPR
            END

        ELSIF sym = SCAN.lxNOT THEN
            NextPos(parser, pos);
            factor(parser, e);
            PARS.check(isBoolean(e), pos, 72);
            IF e.obj # eCONST THEN
                IL.not;
                e.obj := eEXPR
            ELSE
                ASSERT(ARITH.neg(e.value))
            END

        ELSE
            PARS.check1(FALSE, parser, 34)
        END
    END factor;


    PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        pos: PARS.POSITION;
        e1:  PARS.EXPR;
        op, label, label1: INTEGER;

    BEGIN
        factor(parser, e);
        label := -1;

        WHILE MulOperator(parser.sym) DO
            op  := parser.sym;
            getpos(parser, pos);
            PARS.Next(parser);

            IF op = SCAN.lxAND THEN
                IF ~parser.constexp THEN

                    IF label = -1 THEN
                        label := IL.NewLabel()
                    END;

                    IF (e.obj = eCONST) & isBoolean(e) THEN
                        IL.Const(ORD(ARITH.getBool(e.value)))
                    END;
                    IL.Jmp(IL.opJZ, label)
                END
            END;

            factor(parser, e1);

            CASE op OF
            |SCAN.lxMUL:
                PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

                   CASE e.value.typ OF
                   |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"),   pos, 39)
                   |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
                   |ARITH.tSET:     ARITH.opSet(e.value, e1.value, "*")
                   END

                ELSE
                    IF isInt(e) THEN
                        IF e.obj = eCONST THEN
                            IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
                        ELSE
                            IL.AddCmd0(IL.opMUL)
                        END
                    ELSIF isReal(e) THEN
                        IF e.obj = eCONST THEN
                            Float(parser, e)
                        ELSIF e1.obj = eCONST THEN
                            Float(parser, e1)
                        END;
                        IL.AddCmd0(IL.opMULF)
                    ELSIF isSet(e) THEN
                        IF e.obj = eCONST THEN
                            IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
                        ELSE
                            IL.AddCmd0(IL.opMULS)
                        END
                    END;
                    e.obj := eEXPR
                END

            |SCAN.lxSLASH:
                PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
                IF (e1.obj = eCONST) & isReal(e1) THEN
                    PARS.check(~ARITH.isZero(e1.value), pos, 45)
                END;
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

                    CASE e.value.typ OF
                    |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
                    |ARITH.tSET:  ARITH.opSet(e.value, e1.value, "/")
                    END

                ELSE
                    IF isReal(e) THEN
                        IF e.obj = eCONST THEN
                            Float(parser, e);
                            IL.AddCmd0(IL.opDIVFI)
                        ELSIF e1.obj = eCONST THEN
                            Float(parser, e1);
                            IL.AddCmd0(IL.opDIVF)
                        ELSE
                            IL.AddCmd0(IL.opDIVF)
                        END
                    ELSIF isSet(e) THEN
                        IF e.obj = eCONST THEN
                            IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
                        ELSE
                            IL.AddCmd0(IL.opDIVS)
                        END
                    END;
                    e.obj := eEXPR
                END

            |SCAN.lxDIV, SCAN.lxMOD:
                PARS.check(isInt(e) & isInt(e1), pos, 37);
                IF e1.obj = eCONST THEN
                    PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
                END;
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

                    IF op = SCAN.lxDIV THEN
                        PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
                    ELSE
                        ASSERT(ARITH.opInt(e.value, e1.value, "M"))
                    END

                ELSE
                    IF e1.obj # eCONST THEN
                        label1 := IL.NewLabel();
                        IL.Jmp(IL.opJG, label1)
                    END;
                    IF e.obj = eCONST THEN
                        IL.OnError(pos.line, errDIV);
                        IL.SetLabel(label1);
                        IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
                    ELSE
                        IL.OnError(pos.line, errDIV);
                        IL.SetLabel(label1);
                        IL.AddCmd0(IL.opDIV  + ORD(op = SCAN.lxMOD))
                    END;
                    e.obj := eEXPR
                END

            |SCAN.lxAND:
                PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);

                IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
                    ARITH.opBoolean(e.value, e1.value, "&")
                ELSE
                    e.obj := eEXPR;
                    IF e1.obj = eCONST THEN
                        IL.Const(ORD(ARITH.getBool(e1.value)))
                    END
                END

            END
        END;

        IF label # -1 THEN
            label1 := IL.NewLabel();
            IL.Jmp(IL.opJNZ, label1);
            IL.SetLabel(label);
            IL.Const(0);
            IL.drop;
            label := IL.NewLabel();
            IL.Jmp(IL.opJMP, label);
            IL.SetLabel(label1);
            IL.Const(1);
            IL.SetLabel(label);
            IL.AddCmd0(IL.opAND)
        END
    END term;


    PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        pos: PARS.POSITION;
        op:  INTEGER;
        e1:  PARS.EXPR;
        s, s1: SCAN.TEXTSTR;

        plus, minus: BOOLEAN;

        label, label1: INTEGER;

    BEGIN
        plus  := parser.sym = SCAN.lxPLUS;
        minus := parser.sym = SCAN.lxMINUS;

        IF plus OR minus THEN
            getpos(parser, pos);
            PARS.Next(parser)
        END;

        term(parser, e);

        IF plus OR minus THEN
            PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);

            IF minus & (e.obj = eCONST) THEN
                PARS.check(ARITH.neg(e.value), pos, 39)
            END;

            IF e.obj # eCONST THEN
                IF minus THEN
                    IF isInt(e) THEN
                        IL.AddCmd0(IL.opUMINUS)
                    ELSIF isReal(e) THEN
                        IL.AddCmd0(IL.opUMINF)
                    ELSIF isSet(e) THEN
                        IL.AddCmd0(IL.opUMINS)
                    END
                END;
                e.obj := eEXPR
            END
        END;

        label := -1;

        WHILE AddOperator(parser.sym) DO

            op := parser.sym;
            getpos(parser, pos);
            PARS.Next(parser);

            IF op = SCAN.lxOR THEN

                IF ~parser.constexp THEN

                    IF label = -1 THEN
                        label := IL.NewLabel()
                    END;

                    IF (e.obj = eCONST) & isBoolean(e) THEN
                        IL.Const(ORD(ARITH.getBool(e.value)))
                    END;
                    IL.Jmp(IL.opJNZ, label)
                END

            END;

            term(parser, e1);

            CASE op OF
            |SCAN.lxPLUS, SCAN.lxMINUS:

                minus := op = SCAN.lxMINUS;
                IF minus THEN
                    op := ORD("-")
                ELSE
                    op := ORD("+")
                END;

                PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37);
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

                    CASE e.value.typ OF
                    |ARITH.tINTEGER:
                        PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)),   pos, 39)

                    |ARITH.tREAL:
                        PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)

                    |ARITH.tSET:
                        ARITH.opSet(e.value, e1.value, CHR(op))

                    |ARITH.tCHAR, ARITH.tSTRING:
                        IF e.value.typ = ARITH.tCHAR THEN
                            ARITH.charToStr(e.value, s)
                        ELSE
                            s := e.value.string(SCAN.STRING).s
                        END;
                        IF e1.value.typ = ARITH.tCHAR THEN
                            ARITH.charToStr(e1.value, s1)
                        ELSE
                            s1 := e1.value.string(SCAN.STRING).s
                        END;
                        PARS.check(ARITH.concat(s, s1), pos, 5);
                        e.value.string := SCAN.enterStr(s);
                        e.value.typ := ARITH.tSTRING;
                        e._type := PROG.program.stTypes.tSTRING
                   END

                ELSE
                    IF isInt(e) THEN
                        IF e.obj = eCONST THEN
                            IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value))
                        ELSE
                            IL.AddCmd0(IL.opADD + ORD(minus))
                        END
                    ELSIF isReal(e) THEN
                        IF e.obj = eCONST THEN
                            Float(parser, e);
                            IL.AddCmd0(IL.opADDF - ORD(minus))
                        ELSIF e1.obj = eCONST THEN
                            Float(parser, e1);
                            IL.AddCmd0(IL.opADDF + ORD(minus))
                        ELSE
                            IL.AddCmd0(IL.opADDF + ORD(minus))
                        END
                    ELSIF isSet(e) THEN
                        IF e.obj = eCONST THEN
                            IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value))
                        ELSE
                            IL.AddCmd0(IL.opADDS + ORD(minus))
                        END
                    END;
                    e.obj := eEXPR
                END

            |SCAN.lxOR:
                PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);

                IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
                    ARITH.opBoolean(e.value, e1.value, "|")
                ELSE
                    e.obj := eEXPR;
                    IF e1.obj = eCONST THEN
                        IL.Const(ORD(ARITH.getBool(e1.value)))
                    END
                END

            END
        END;

        IF label # -1 THEN
            label1 := IL.NewLabel();
            IL.Jmp(IL.opJZ, label1);
            IL.SetLabel(label);
            IL.Const(1);
            IL.drop;
            label := IL.NewLabel();
            IL.Jmp(IL.opJMP, label);
            IL.SetLabel(label1);
            IL.Const(0);
            IL.SetLabel(label);
            IL.AddCmd0(IL.opOR)
        END

    END SimpleExpression;


    PROCEDURE cmpcode (op: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        CASE op OF
        |SCAN.lxEQ: res := ARITH.opEQ
        |SCAN.lxNE: res := ARITH.opNE
        |SCAN.lxLT: res := ARITH.opLT
        |SCAN.lxLE: res := ARITH.opLE
        |SCAN.lxGT: res := ARITH.opGT
        |SCAN.lxGE: res := ARITH.opGE
        |SCAN.lxIN: res := ARITH.opIN
        |SCAN.lxIS: res := ARITH.opIS
        END

        RETURN res
    END cmpcode;


    PROCEDURE invcmpcode (op: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        CASE op OF
        |SCAN.lxEQ: res := ARITH.opEQ
        |SCAN.lxNE: res := ARITH.opNE
        |SCAN.lxLT: res := ARITH.opGT
        |SCAN.lxLE: res := ARITH.opGE
        |SCAN.lxGT: res := ARITH.opLT
        |SCAN.lxGE: res := ARITH.opLE
        |SCAN.lxIN: res := ARITH.opIN
        |SCAN.lxIS: res := ARITH.opIS
        END

        RETURN res
    END invcmpcode;


    PROCEDURE BoolCmp (eq, val: BOOLEAN);
    BEGIN
       IF eq = val THEN
           IL.AddCmd0(IL.opNEC)
       ELSE
           IL.AddCmd0(IL.opEQC)
       END
    END BoolCmp;


    PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
    VAR
        res: BOOLEAN;
        cmp: INTEGER;

    BEGIN
        res := TRUE;
        cmp := cmpcode(op);

        IF isString(e) & isCharArray(e1) THEN
            IL.StrAdr(String(e));
            IL.Const(strlen(e) + 1);
            IL.AddCmd0(IL.opEQS + invcmpcode(op))

        ELSIF (isString(e) OR isStringW(e)) & isCharArrayW(e1) THEN
            IL.StrAdr(StringW(e));
            IL.Const(utf8strlen(e) + 1);
            IL.AddCmd0(IL.opEQSW + invcmpcode(op))

        ELSIF isCharArray(e) & isString(e1) THEN
            IL.StrAdr(String(e1));
            IL.Const(strlen(e1) + 1);
            IL.AddCmd0(IL.opEQS + cmp)

        ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN
            IL.StrAdr(StringW(e1));
            IL.Const(utf8strlen(e1) + 1);
            IL.AddCmd0(IL.opEQSW + cmp)

        ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
            IL.AddCmd0(IL.opEQSW + cmp)

        ELSIF isCharArray(e) & isCharArray(e1) THEN
            IL.AddCmd0(IL.opEQS + cmp)

        ELSIF isString(e) & isString(e1) THEN
            PARS.strcmp(e.value, e1.value, op)

        ELSE
            res := FALSE

        END

        RETURN res
    END strcmp;


BEGIN
    getpos(parser, pos0);
    SimpleExpression(parser, e);
    IF relation(parser.sym) THEN
        IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN
            IL.Const(e._type.length)
        END;
        op := parser.sym;
        getpos(parser, pos);
        PARS.Next(parser);

        getpos(parser, pos1);
        SimpleExpression(parser, e1);

        IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN
            IL.Const(e1._type.length)
        END;

        constant := (e.obj = eCONST) & (e1.obj = eCONST);
        error := 0;
        cmp := cmpcode(op);

        CASE op OF
        |SCAN.lxEQ, SCAN.lxNE:
            eq := op = SCAN.lxEQ;
            IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
            isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
            isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
            isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
            isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, cmp, error)
                ELSE
                    IF e.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
                    ELSE
                        IL.AddCmd0(IL.opEQ + cmp)
                    END
                END

            ELSIF isStringW1(e) & isCharW(e1) THEN
                IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))

            ELSIF isStringW1(e1) & isCharW(e) THEN
                IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))

            ELSIF isBoolean(e) & isBoolean(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, cmp, error)
                ELSE
                    IF e.obj = eCONST THEN
                        BoolCmp(eq, ARITH.Int(e.value) # 0)
                    ELSIF e1.obj = eCONST THEN
                        BoolCmp(eq, ARITH.Int(e1.value) # 0)
                    ELSE
                        IF eq THEN
                            IL.AddCmd0(IL.opEQB)
                        ELSE
                            IL.AddCmd0(IL.opNEB)
                        END
                    END
                END

            ELSIF isReal(e) & isReal(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, cmp, error)
                ELSE
                    IF e.obj = eCONST THEN
                        Float(parser, e)
                    ELSIF e1.obj = eCONST THEN
                        Float(parser, e1)
                    END;
                    IL.AddCmd0(IL.opEQF + cmp)
                END

            ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
                IF ~strcmp(e, e1, op) THEN
                    PARS.error(pos, 37)
                END

            ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
                IL.AddCmd0(IL.opEQC + cmp)

            ELSIF isProc(e) & isNil(e1) THEN
                IF e.obj IN {ePROC, eIMP} THEN
                    PARS.check(e.ident.global, pos0, 85);
                    constant := TRUE;
                    e.obj := eCONST;
                    ARITH.setbool(e.value, ~eq)
                ELSE
                    IL.AddCmd0(IL.opEQC + cmp)
                END

            ELSIF isNil(e) & isProc(e1) THEN
                IF e1.obj IN {ePROC, eIMP} THEN
                    PARS.check(e1.ident.global, pos1, 85);
                    constant := TRUE;
                    e.obj := eCONST;
                    ARITH.setbool(e.value, ~eq)
                ELSE
                    IL.AddCmd0(IL.opEQC + cmp)
                END

            ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN
                IF e.obj = ePROC THEN
                    PARS.check(e.ident.global, pos0, 85)
                END;
                IF e1.obj = ePROC THEN
                    PARS.check(e1.ident.global, pos1, 85)
                END;
                IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
                    constant := TRUE;
                    e.obj := eCONST;
                    IF eq THEN
                        ARITH.setbool(e.value, e.ident = e1.ident)
                    ELSE
                        ARITH.setbool(e.value, e.ident # e1.ident)
                    END
                ELSIF e.obj = ePROC THEN
                    IL.ProcCmp(e.ident.proc.label, eq)
                ELSIF e1.obj = ePROC THEN
                    IL.ProcCmp(e1.ident.proc.label, eq)
                ELSIF e.obj = eIMP THEN
                    IL.ProcImpCmp(e.ident._import, eq)
                ELSIF e1.obj = eIMP THEN
                    IL.ProcImpCmp(e1.ident._import, eq)
                ELSE
                    IL.AddCmd0(IL.opEQ + cmp)
                END

            ELSIF isNil(e) & isNil(e1) THEN
                constant := TRUE;
                e.obj := eCONST;
                ARITH.setbool(e.value, eq)

            ELSE
                PARS.error(pos, 37)
            END

        |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
            IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
                isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
                isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
                isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN

                IF constant THEN
                    ARITH.relation(e.value, e1.value, cmp, error)
                ELSE
                    IF e.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
                    ELSE
                        IL.AddCmd0(IL.opEQ + cmp)
                    END
                END

            ELSIF isStringW1(e) & isCharW(e1) THEN
                IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))

            ELSIF isStringW1(e1) & isCharW(e) THEN
                IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))

            ELSIF isReal(e) & isReal(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, cmp, error)
                ELSE
                    IF e.obj = eCONST THEN
                        Float(parser, e);
                        IL.AddCmd0(IL.opEQF + invcmpcode(op))
                    ELSIF e1.obj = eCONST THEN
                        Float(parser, e1);
                        IL.AddCmd0(IL.opEQF + cmp)
                    ELSE
                        IL.AddCmd0(IL.opEQF + cmp)
                    END
                END

            ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
                IF ~strcmp(e, e1, op) THEN
                    PARS.error(pos, 37)
                END

            ELSE
                PARS.error(pos, 37)
            END

        |SCAN.lxIN:
            PARS.check(isInt(e) & isSet(e1), pos, 37);
            IF e.obj = eCONST THEN
                PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
            END;
            IF constant THEN
                ARITH.relation(e.value, e1.value, ARITH.opIN, error)
            ELSE
                IF e.obj = eCONST THEN
                    IL.AddCmd(IL.opINL, ARITH.Int(e.value))
                ELSIF e1.obj = eCONST THEN
                    IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
                ELSE
                    IL.AddCmd0(IL.opIN)
                END
            END

        |SCAN.lxIS:
            PARS.check(isRecPtr(e), pos, 73);
            PARS.check(e1.obj = eTYPE, pos1, 79);

            IF isRec(e) THEN
                PARS.check(e.obj = eVREC, pos0, 78);
                PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80);
                IF e.ident = NIL THEN
                    IL.TypeCheck(e1._type.num)
                ELSE
                    IL.AddCmd(IL.opVADR, e.ident.offset - 1);
                    IL.TypeCheckRec(e1._type.num)
                END
            ELSE
                PARS.check(e1._type.typ = PROG.tPOINTER, pos1, 81);
                IL.TypeCheck(e1._type.base.num)
            END;

            PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82)

        END;

        ASSERT(error = 0);

        e._type := tBOOLEAN;

        IF ~constant THEN
            e.obj := eEXPR
        END

    END
END expression;


PROCEDURE ElementaryStatement (parser: PARS.PARSER);
VAR
    e, e1: PARS.EXPR;
    pos:   PARS.POSITION;
    line:  INTEGER;
    call:  BOOLEAN;

BEGIN
    getpos(parser, pos);

    IL.pushBegEnd(begcall, endcall);

    designator(parser, e);

    IF parser.sym = SCAN.lxASSIGN THEN
        line := parser.lex.pos.line;
        PARS.check(isVar(e), pos, 93);
        PARS.check(~e.readOnly, pos, 94);

        IL.setlast(begcall);

        NextPos(parser, pos);
        expression(parser, e1);
        IF (e._type.typ = PROG.tBYTE) & (e1.obj # eCONST) & (e1._type.typ = PROG.tINTEGER) & (chkBYTE IN Options.checking) THEN
            CheckRange(256, pos.line, errBYTE)
        END;

        IL.setlast(endcall.prev(IL.COMMAND));

        PARS.check(assign(parser, e1, e._type, line), pos, 91);
        IF e1.obj = ePROC THEN
            PARS.check(e1.ident.global, pos, 85)
        END;
        call := FALSE
    ELSIF parser.sym = SCAN.lxEQ THEN
        PARS.check1(FALSE, parser, 96)
    ELSIF parser.sym = SCAN.lxLROUND THEN
        e1 := e;
        ActualParameters(parser, e1);
        PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92);
        call := TRUE
    ELSE
        IF e.obj IN {eSYSPROC, eSTPROC} THEN
            stProc(parser, e);
            call := FALSE
        ELSE
            PARS.check(isProc(e), pos, 86);
            PARS.check((e._type.base = NIL) OR ODD(e._type.call), pos, 92);
            PARS.check1(e._type.params.first = NIL, parser, 64);
            call := TRUE
        END
    END;

    IF call THEN
        IF e.obj IN {ePROC, eIMP} THEN
            ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE)
        ELSIF isExpr(e) THEN
            ProcCall(e, e._type, FALSE, parser, pos, TRUE)
        END
    END;

    IL.popBegEnd(begcall, endcall)
END ElementaryStatement;


PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN);
VAR
    e:   PARS.EXPR;
    pos: PARS.POSITION;

    label, L: INTEGER;

BEGIN
    L := IL.NewLabel();

    IF ~_if THEN
        IL.AddCmd(IL.opNOP, IL.begin_loop);
        IL.SetLabel(L)
    END;

    REPEAT
        NextPos(parser, pos);

        label := IL.NewLabel();

        expression(parser, e);
        PARS.check(isBoolean(e), pos, 72);

        IF e.obj = eCONST THEN
            IF ~ARITH.getBool(e.value) THEN
                IL.Jmp(IL.opJMP, label)
            END
        ELSE
            IL.AndOrOpt(label)
        END;

        IF _if THEN
            PARS.checklex(parser, SCAN.lxTHEN)
        ELSE
            PARS.checklex(parser, SCAN.lxDO)
        END;

        PARS.Next(parser);
        parser.StatSeq(parser);

        IF ~_if OR (parser.sym # SCAN.lxEND) THEN
            IL.Jmp(IL.opJMP, L)
        END;
        IL.SetLabel(label)

    UNTIL parser.sym # SCAN.lxELSIF;

    IF _if THEN
        IF parser.sym = SCAN.lxELSE THEN
            PARS.Next(parser);
            parser.StatSeq(parser)
        END;
        IL.SetLabel(L)
    ELSE
        IL.AddCmd(IL.opNOP, IL.end_loop)
    END;

    PARS.checklex(parser, SCAN.lxEND);

    PARS.Next(parser)
END IfStatement;


PROCEDURE RepeatStatement (parser: PARS.PARSER);
VAR
    e:     PARS.EXPR;
    pos:   PARS.POSITION;
    label: INTEGER;
    L:     IL.COMMAND;

BEGIN
    IL.AddCmd(IL.opNOP, IL.begin_loop);

    label := IL.NewLabel();
    IL.SetLabel(label);
    L := IL.getlast();

    PARS.Next(parser);
    parser.StatSeq(parser);
    PARS.checklex(parser, SCAN.lxUNTIL);
    NextPos(parser, pos);
    expression(parser, e);
    PARS.check(isBoolean(e), pos, 72);

    IF e.obj = eCONST THEN
        IF ~ARITH.getBool(e.value) THEN
            IL.Jmp(IL.opJMP, label)
        END
    ELSE
        IL.AndOrOpt(label);
        L.param1 := label
    END;

    IL.AddCmd(IL.opNOP, IL.end_loop)
END RepeatStatement;


PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
VAR
   La, Ra, Lb, Rb, res: INTEGER;

BEGIN
    La := a(CASE_LABEL).range.a;
    Ra := a(CASE_LABEL).range.b;
    Lb := b(CASE_LABEL).range.a;
    Rb := b(CASE_LABEL).range.b;
    IF (Ra < Lb) OR (La > Rb) THEN
        res := ORD(La > Lb) - ORD(La < Lb)
    ELSE
        res := 0
    END

    RETURN res
END LabelCmp;


PROCEDURE DestroyLabel (VAR label: AVL.DATA);
BEGIN
    C.push(CaseLabels, label);
    label := NIL
END DestroyLabel;


PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
VAR
    res:   CASE_VARIANT;
    citem: C.ITEM;

BEGIN
    citem := C.pop(CaseVar);
    IF citem = NIL THEN
        NEW(res)
    ELSE
        res := citem(CASE_VARIANT)
    END;

    res.label := label;
    res.cmd := cmd;
    res.processed := FALSE

    RETURN res
END NewVariant;


PROCEDURE CaseStatement (parser: PARS.PARSER);
VAR
    e:   PARS.EXPR;
    pos: PARS.POSITION;


    PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER;
    VAR
        a:     INTEGER;
        label: PARS.EXPR;
        pos:   PARS.POSITION;
        value: ARITH.VALUE;

    BEGIN
        getpos(parser, pos);
        _type := NIL;

        IF isChar(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tCHAR, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isCharW(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
                ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
            ELSE
                PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
            END;
            a := ARITH.getInt(value)
        ELSIF isInt(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isRecPtr(caseExpr) THEN
            qualident(parser, label);
            PARS.check(label.obj = eTYPE, pos, 79);
            PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99);
            IF isRec(caseExpr) THEN
                a := label._type.num
            ELSE
                a := label._type.base.num
            END;
            _type := label._type
        END

        RETURN a
    END Label;


    PROCEDURE CheckType (node: AVL.NODE; _type: PROG._TYPE; parser: PARS.PARSER; pos: PARS.POSITION);
    BEGIN
        IF node # NIL THEN
            PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL)._type, _type) OR PROG.isBaseOf(_type, node.data(CASE_LABEL)._type)), pos, 100);
            CheckType(node.left, _type, parser, pos);
            CheckType(node.right, _type, parser, pos)
        END
    END CheckType;


    PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
    VAR
        label:     CASE_LABEL;
        citem:     C.ITEM;
        pos, pos1: PARS.POSITION;
        node:      AVL.NODE;
        newnode:   BOOLEAN;
        range:     RANGE;

    BEGIN
        citem := C.pop(CaseLabels);
        IF citem = NIL THEN
            NEW(label)
        ELSE
            label := citem(CASE_LABEL)
        END;

        label.variant := variant;
        label.self := IL.NewLabel();

        getpos(parser, pos1);
        range.a := Label(parser, caseExpr, label._type);

        IF parser.sym = SCAN.lxRANGE THEN
            PARS.check1(~isRecPtr(caseExpr), parser, 53);
            NextPos(parser, pos);
            range.b := Label(parser, caseExpr, label._type);
            PARS.check(range.a <= range.b, pos, 103)
        ELSE
            range.b := range.a
        END;

        label.range := range;

        IF isRecPtr(caseExpr) THEN
            CheckType(tree, label._type, parser, pos1)
        END;
        tree := AVL.insert(tree, label, LabelCmp, newnode, node);
        PARS.check(newnode, pos1, 100)

        RETURN node

    END LabelRange;


    PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
    VAR
        exit: BOOLEAN;
        res:  AVL.NODE;

    BEGIN
        exit := FALSE;
        REPEAT
            res := LabelRange(parser, caseExpr, tree, variant);
            IF parser.sym = SCAN.lxCOMMA THEN
                PARS.check1(~isRecPtr(caseExpr), parser, 53);
                PARS.Next(parser)
            ELSE
                exit := TRUE
            END
        UNTIL exit

        RETURN res
    END CaseLabelList;


    PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER);
    VAR
        sym:     INTEGER;
        t:       PROG._TYPE;
        variant: INTEGER;
        node:    AVL.NODE;
        last:    IL.COMMAND;

    BEGIN
        sym := parser.sym;
        IF sym # SCAN.lxBAR THEN
            variant := IL.NewLabel();
            node := CaseLabelList(parser, caseExpr, tree, variant);
            PARS.checklex(parser, SCAN.lxCOLON);
            PARS.Next(parser);
            IF isRecPtr(caseExpr) THEN
                t := caseExpr._type;
                caseExpr.ident._type := node.data(CASE_LABEL)._type
            END;

            last := IL.getlast();
            IL.SetLabel(variant);

            IF ~isRecPtr(caseExpr) THEN
                LISTS.push(CaseVariants, NewVariant(variant, last))
            END;

            parser.StatSeq(parser);
            IL.Jmp(IL.opJMP, _end);

            IF isRecPtr(caseExpr) THEN
                caseExpr.ident._type := t
            END
        END
    END _case;


    PROCEDURE Table (node: AVL.NODE; _else: INTEGER);
    VAR
        L, R: INTEGER;
        range: RANGE;
        left, right: AVL.NODE;
        last: IL.COMMAND;
        v: CASE_VARIANT;

    BEGIN
        IF node # NIL THEN

            range := node.data(CASE_LABEL).range;

            left := node.left;
            IF left # NIL THEN
                L := left.data(CASE_LABEL).self
            ELSE
                L := _else
            END;

            right := node.right;
            IF right # NIL THEN
                R := right.data(CASE_LABEL).self
            ELSE
                R := _else
            END;

            last := IL.getlast();

            v := CaseVariants.last(CASE_VARIANT);
            WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
                v := v.prev(CASE_VARIANT)
            END;

            ASSERT((v # NIL) & (v.label # 0));
            IL.setlast(v.cmd);

            IL.SetLabel(node.data(CASE_LABEL).self);
            IL._case(range.a, range.b, L, R);
            IF v.processed THEN
                IL.Jmp(IL.opJMP, node.data(CASE_LABEL).variant)
            END;
            v.processed := TRUE;

            IL.setlast(last);

            Table(left, _else);
            Table(right, _else)
        END
    END Table;


    PROCEDURE TableT (node: AVL.NODE);
    BEGIN
        IF node # NIL THEN
            IL.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a);
            TableT(node.left);
            TableT(node.right)
        END
    END TableT;


    PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
    VAR
        table, _end, _else: INTEGER;
        tree: AVL.NODE;
        item: LISTS.ITEM;

    BEGIN
        LISTS.push(CaseVariants, NewVariant(0, NIL));
        _end  := IL.NewLabel();
        _else := IL.NewLabel();
        table := IL.NewLabel();
        IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
        IL.Jmp(IL.opJMP, table);

        tree := NIL;

        _case(parser, e, tree, _end);
        WHILE parser.sym = SCAN.lxBAR DO
            PARS.Next(parser);
            _case(parser, e, tree, _end)
        END;

        IL.SetLabel(_else);
        IF parser.sym = SCAN.lxELSE THEN
            PARS.Next(parser);
            parser.StatSeq(parser);
            IL.Jmp(IL.opJMP, _end)
        ELSE
            IL.OnError(pos.line, errCASE)
        END;

        PARS.checklex(parser, SCAN.lxEND);
        PARS.Next(parser);

        IF isRecPtr(e) THEN
            IL.SetLabel(table);
            TableT(tree);
            IL.Jmp(IL.opJMP, _else)
        ELSE
            tree.data(CASE_LABEL).self := table;
            Table(tree, _else)
        END;

        AVL.destroy(tree, DestroyLabel);
        IL.SetLabel(_end);
        IL.AddCmd0(IL.opENDSW);

        REPEAT
            item := LISTS.pop(CaseVariants);
            C.push(CaseVar, item)
        UNTIL item(CASE_VARIANT).cmd = NIL

    END ParseCase;


BEGIN
    NextPos(parser, pos);
    expression(parser, e);
    PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
    IF isRecPtr(e) THEN
        PARS.check(isVar(e), pos, 93);
        PARS.check(e.ident # NIL, pos, 106)
    END;
    IF isRec(e) THEN
        PARS.check(e.obj = eVREC, pos, 78)
    END;

    IF e.obj = eCONST THEN
        LoadConst(e)
    ELSIF isRec(e) THEN
        IL.drop;
        IL.AddCmd(IL.opLADR, e.ident.offset - 1);
        IL.load(TARGETS.WordSize)
    ELSIF isPtr(e) THEN
        deref(pos, e, FALSE, errPTR);
        IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
        IL.load(TARGETS.WordSize)
    END;

    PARS.checklex(parser, SCAN.lxOF);
    PARS.Next(parser);
    ParseCase(parser, e, pos)
END CaseStatement;


PROCEDURE ForStatement (parser: PARS.PARSER);
VAR
    e:         PARS.EXPR;
    pos, pos2: PARS.POSITION;
    step:      ARITH.VALUE;
    st:        INTEGER;
    ident:     PROG.IDENT;
    offset:    INTEGER;
    L1, L2:    INTEGER;

BEGIN
    IL.AddCmd(IL.opNOP, IL.begin_loop);

    L1 := IL.NewLabel();
    L2 := IL.NewLabel();

    PARS.ExpectSym(parser, SCAN.lxIDENT);
    ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
    PARS.check1(ident # NIL, parser, 48);
    PARS.check1(ident.typ = PROG.idVAR, parser, 93);
    PARS.check1(ident._type = tINTEGER, parser, 97);
    PARS.ExpectSym(parser, SCAN.lxASSIGN);
    NextPos(parser, pos);
    expression(parser, e);
    PARS.check(isInt(e), pos, 76);

    offset := PROG.getOffset(ident);

    IF ident.global THEN
        IL.AddCmd(IL.opGADR, offset)
    ELSE
        IL.AddCmd(IL.opLADR, -offset)
    END;

    IF e.obj = eCONST THEN
        IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
    ELSE
        IL.AddCmd0(IL.opSAVE)
    END;

    IL.SetLabel(L1);

    IF ident.global THEN
        IL.AddCmd(IL.opGADR, offset)
    ELSE
        IL.AddCmd(IL.opLADR, -offset)
    END;
    IL.load(ident._type.size);

    PARS.checklex(parser, SCAN.lxTO);
    NextPos(parser, pos2);
    expression(parser, e);
    PARS.check(isInt(e), pos2, 76);

    IF parser.sym = SCAN.lxBY THEN
        NextPos(parser, pos);
        PARS.ConstExpression(parser, step);
        PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
        st := ARITH.getInt(step);
        PARS.check(st # 0, pos, 98)
    ELSE
        st := 1
    END;

    IF e.obj = eCONST THEN
        IF st > 0 THEN
            IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
            IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
                ERRORS.WarningMsg(pos2.line, pos2.col, 1)
            END
        ELSE
            IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
            IF ARITH.Int(e.value) = UTILS.target.minInt THEN
                ERRORS.WarningMsg(pos2.line, pos2.col, 1)
            END
        END
    ELSE
        IF st > 0 THEN
            IL.AddCmd0(IL.opLE)
        ELSE
            IL.AddCmd0(IL.opGE)
        END
    END;

    IL.Jmp(IL.opJZ, L2);

    PARS.checklex(parser, SCAN.lxDO);
    PARS.Next(parser);
    parser.StatSeq(parser);

    IF ident.global THEN
        IL.AddCmd(IL.opGADR, offset)
    ELSE
        IL.AddCmd(IL.opLADR, -offset)
    END;

    IL.AddCmd(IL.opINCC, st);

    IL.Jmp(IL.opJMP, L1);

    PARS.checklex(parser, SCAN.lxEND);
    PARS.Next(parser);

    IL.SetLabel(L2);

    IL.AddCmd(IL.opNOP, IL.end_loop)
END ForStatement;


PROCEDURE statement (parser: PARS.PARSER);
VAR
    sym: INTEGER;

BEGIN
    sym := parser.sym;

    IF sym = SCAN.lxIDENT THEN
        ElementaryStatement(parser)
    ELSIF sym = SCAN.lxIF THEN
        IfStatement(parser, TRUE)
    ELSIF sym = SCAN.lxWHILE THEN
        IfStatement(parser, FALSE)
    ELSIF sym = SCAN.lxREPEAT THEN
        RepeatStatement(parser)
    ELSIF sym = SCAN.lxCASE THEN
        CaseStatement(parser)
    ELSIF sym = SCAN.lxFOR THEN
        ForStatement(parser)
    END
END statement;


PROCEDURE StatSeq (parser: PARS.PARSER);
BEGIN
    statement(parser);
    WHILE parser.sym = SCAN.lxSEMI DO
        PARS.Next(parser);
        statement(parser)
    END
END StatSeq;


PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN;
VAR
    res: BOOLEAN;

BEGIN
    res := assigncomp(e, t);
    IF res THEN
        IF e.obj = eCONST THEN
            IF e._type = tREAL THEN
                Float(parser, e)
            ELSIF e._type.typ = PROG.tNIL THEN
                IL.Const(0)
            ELSE
                LoadConst(e)
            END
        ELSIF (e._type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
            CheckRange(256, pos.line, errBYTE)
        ELSIF e.obj = ePROC THEN
            PARS.check(e.ident.global, pos, 85);
            IL.PushProc(e.ident.proc.label)
        ELSIF e.obj = eIMP THEN
            IL.PushImpProc(e.ident._import)
        END
    END

    RETURN res
END chkreturn;


PROCEDURE setrtl;
VAR
    rtl: PROG.UNIT;


    PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.IDSTR; idx: INTEGER);
    VAR
        id: PROG.IDENT;
        ident: SCAN.IDENT;

    BEGIN
        SCAN.setIdent(ident, name);
        id := PROG.getIdent(rtl, ident, FALSE);

        IF (id # NIL) & (id._import # NIL) THEN
            IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
            id.proc.used := TRUE
        ELSIF (id # NIL) & (id.proc # NIL) THEN
            IL.set_rtl(idx, id.proc.label);
            id.proc.used := TRUE
        ELSE
            ERRORS.WrongRTL(name)
        END
    END getproc;


BEGIN
    rtl := PROG.program.rtl;
    ASSERT(rtl # NIL);

    getproc(rtl, "_strcmp",   IL._strcmp);
    getproc(rtl, "_length",   IL._length);
    getproc(rtl, "_arrcpy",   IL._arrcpy);
    getproc(rtl, "_is",       IL._is);
    getproc(rtl, "_guard",    IL._guard);
    getproc(rtl, "_guardrec", IL._guardrec);
    getproc(rtl, "_new",      IL._new);
    getproc(rtl, "_rot",      IL._rot);
    getproc(rtl, "_strcpy",   IL._strcpy);
    getproc(rtl, "_move",     IL._move);
    getproc(rtl, "_set",      IL._set);
    getproc(rtl, "_set1",     IL._set1);
    getproc(rtl, "_lengthw",  IL._lengthw);
    getproc(rtl, "_strcmpw",  IL._strcmpw);
    getproc(rtl, "_init",     IL._init);

    IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
        getproc(rtl, "_error",    IL._error);
        getproc(rtl, "_divmod",   IL._divmod);
        getproc(rtl, "_exit",     IL._exit);
        getproc(rtl, "_dispose",  IL._dispose);
        getproc(rtl, "_isrec",    IL._isrec);
        getproc(rtl, "_dllentry", IL._dllentry);
        getproc(rtl, "_sofinit",  IL._sofinit)
    ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
        getproc(rtl, "_fmul",  IL._fmul);
        getproc(rtl, "_fdiv",  IL._fdiv);
        getproc(rtl, "_fdivi", IL._fdivi);
        getproc(rtl, "_fadd",  IL._fadd);
        getproc(rtl, "_fsub",  IL._fsub);
        getproc(rtl, "_fsubi", IL._fsubi);
        getproc(rtl, "_fcmp",  IL._fcmp);
        getproc(rtl, "_floor", IL._floor);
        getproc(rtl, "_flt",   IL._flt);
        getproc(rtl, "_pack",  IL._pack);
        getproc(rtl, "_unpk",  IL._unpk);
        IF CPU IN {TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
            getproc(rtl, "_error", IL._error)
        END
    END

END setrtl;


PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
VAR
    parser: PARS.PARSER;
    ext: PARS.PATH;

BEGIN
    tINTEGER := PROG.program.stTypes.tINTEGER;
    tBYTE    := PROG.program.stTypes.tBYTE;
    tCHAR    := PROG.program.stTypes.tCHAR;
    tSET     := PROG.program.stTypes.tSET;
    tBOOLEAN := PROG.program.stTypes.tBOOLEAN;
    tWCHAR   := PROG.program.stTypes.tWCHAR;
    tREAL    := PROG.program.stTypes.tREAL;

    Options := options;
    CPU := TARGETS.CPU;

    ext := UTILS.FILE_EXT;
    CaseLabels := C.create();
    CaseVar := C.create();

    CaseVariants := LISTS.create(NIL);
    LISTS.push(CaseVariants, NewVariant(0, NIL));

    IL.init(CPU);

    IF TARGETS.RTL THEN
        parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
        IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
            parser.parse(parser);
            PARS.destroy(parser)
        ELSE
            PARS.destroy(parser);
            parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
            IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
                parser.parse(parser);
                PARS.destroy(parser)
            ELSE
                ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
            END
        END
    END;

    parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
    parser.main := TRUE;

    IF parser.open(parser, modname, UTILS.FILE_EXT) THEN
        parser.parse(parser)
    ELSE
        ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
    END;

    PARS.destroy(parser);

    IF PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
        ERRORS.Error(204)
    END;

    IF TARGETS.RTL THEN
        setrtl
    END;

    PROG.DelUnused(IL.DelImport);

    IL.set_bss(PROG.program.bss);

    CASE CPU OF
    |TARGETS.cpuAMD64:   AMD64.CodeGen(outname, target, options)
    |TARGETS.cpuX86:       X86.CodeGen(outname, target, options)
    |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
    |TARGETS.cpuTHUMB:   THUMB.CodeGen(outname, target, options)
    |TARGETS.cpuRVM32I,
     TARGETS.cpuRVM64I:  RVMxI.CodeGen(outname, target, options)
    END

END compile;


END STATEMENTS.