(*
    BSD 2-Clause License

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

MODULE STATEMENTS;

IMPORT

    PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64,
    ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;


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;

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


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:        CODE.COMMAND;
        processed:  BOOLEAN

    END;


VAR

    begcall, endcall: CODE.COMMAND;

    checking: SET;

    CaseLabels, CaseVar: C.COLLECTION;

    CaseVariants: LISTS.LIST;


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.typ = PROG.tBOOLEAN)
END isBoolean;


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


PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e.type.typ = PROG.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.typ = PROG.tREAL)
END isReal;


PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e.type.typ = PROG.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.typ = PROG.tCHAR)
END isChar;


PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR)
END isCharArray;


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


PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR)
END isCharArrayW;


PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
    RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR})
END isCharArrayX;


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 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 getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION);
BEGIN
    pos := parser.lex.pos
END getpos;


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


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

BEGIN
    ASSERT(isString(e));
    IF e.type.typ = PROG.tCHAR THEN
        res := 1
    ELSE
        res := LENGTH(e.value.string(SCAN.IDENT).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.IDENT).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 (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
END isStringW1;


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


    PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
        RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
                ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
                PROG.isTypeEq(src.base, dst.base)
    END arrcomp;


BEGIN
    IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
        IF arrcomp(e.type, t) THEN
            res := TRUE
        ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
            IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN
                res := ARITH.range(e.value, 0, 255)
            ELSE
                res := TRUE
            END
        ELSIF isSet(e) & (t.typ = PROG.tSET) THEN
            res := TRUE
        ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN
            res := TRUE
        ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN
            res := TRUE
        ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN
            res := TRUE
        ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN
            res := TRUE
        ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN
            res := TRUE
        ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN
            res := TRUE
        ELSIF PROG.isBaseOf(t, e.type) THEN
            res := TRUE
        ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN
            res := TRUE
        ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
            res := TRUE
        ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN
            res := TRUE
        ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.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.IDENT;

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

    RETURN offset
END String;


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

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

    RETURN offset
END StringW;


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

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


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


    PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN;
        RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) &
                ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) &
                PROG.isTypeEq(src.base, dst.base)
    END arrcomp;


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

            IF ~PROG.isOpenArray(VarType) THEN
                CODE.AddCmd(CODE.opCONST, VarType.length)
            END;
            CODE.AddCmd(CODE.opCOPYA, VarType.base.size);
            label := CODE.NewLabel();
            CODE.AddJmpCmd(CODE.opJE, label);
            CODE.OnError(line, errCOPY);
            CODE.SetLabel(label)

        ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
            IF VarType.typ = PROG.tINTEGER THEN
                IF e.obj = eCONST THEN
                    CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
                ELSE
                    CODE.AddCmd0(CODE.opSAVE)
                END
            ELSE
                IF e.obj = eCONST THEN
                    res := ARITH.range(e.value, 0, 255);
                    IF res THEN
                        CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
                    END
                ELSE
                    IF chkBYTE IN checking THEN
                        label := CODE.NewLabel();
                        CODE.AddCmd2(CODE.opCHKBYTE, label, 0);
                        CODE.OnError(line, errBYTE);
                        CODE.SetLabel(label)
                    END;
                    CODE.AddCmd0(CODE.opSAVE8)
                END
            END
        ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN
            IF e.obj = eCONST THEN
                CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value))
            ELSE
                CODE.AddCmd0(CODE.opSAVE)
            END
        ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN
            IF e.obj = eCONST THEN
                CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value))
            ELSE
                CODE.AddCmd0(CODE.opSBOOL)
            END
        ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN
            IF e.obj = eCONST THEN
                CODE.Float(ARITH.Float(e.value))
            END;
            CODE.savef
        ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN
            IF e.obj = eCONST THEN
                CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value))
            ELSE
                CODE.AddCmd0(CODE.opSAVE8)
            END
        ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN
            CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
        ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN
            CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s))
        ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN
            IF e.obj = eCONST THEN
                CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value))
            ELSE
                CODE.AddCmd0(CODE.opSAVE16)
            END
        ELSIF PROG.isBaseOf(VarType, e.type) THEN
            IF VarType.typ = PROG.tPOINTER THEN
                CODE.AddCmd0(CODE.opSAVE)
            ELSE
                CODE.AddCmd(CODE.opCOPY, VarType.size)
            END
        ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
            CODE.AddCmd0(CODE.opSAVE32)
        ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN
            CODE.AddCmd0(CODE.opSAVE16)
        ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN
            IF e.obj = ePROC THEN
                CODE.AssignProc(e.ident.proc.label)
            ELSIF e.obj = eIMP THEN
                CODE.AssignImpProc(e.ident.import)
            ELSE
                IF VarType.typ = PROG.tPROCEDURE THEN
                    CODE.AddCmd0(CODE.opSAVE)
                ELSE
                    CODE.AddCmd(CODE.opCOPY, VarType.size)
                END
            END
        ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
            CODE.AddCmd(CODE.opSAVEC, 0)
        ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN
            CODE.saves(String(e), strlen(e) + 1)
        ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN
            CODE.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
    CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value))
END LoadConst;


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

    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: INTEGER;
        d1, d2: INTEGER;
    BEGIN
        IF t.length # 0 THEN
            CODE.AddCmd(CODE.opPARAM, 1);
            n := PROG.Dim(t2) - 1;
            WHILE n >= 0 DO
                CODE.AddCmd(CODE.opCONST, ArrLen(t, n));
                CODE.AddCmd(CODE.opPARAM, 1);
                DEC(n)
            END
        ELSE
            d1 := PROG.Dim(t);
            d2 := PROG.Dim(t2);
            IF d1 # d2 THEN
                n := d2 - d1;
                WHILE d2 > d1 DO
                    CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1));
                    DEC(d2)
                END;
                d2 := PROG.Dim(t2);
                WHILE n > 0 DO
                    CODE.AddCmd(CODE.opROT, d2);
                    DEC(n)
                END
            END;
            CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1)
        END
    END OpenArray;


BEGIN
    IF p.vPar THEN

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

    ELSE
        PARS.check(isExpr(e) OR isProc(e), parser, pos, 66);
        IF PROG.isOpenArray(p.type) THEN
            IF e.type.typ = PROG.tARRAY THEN
                PARS.check(arrcomp(e, p), parser, pos, 66);
                OpenArray(e.type, p.type)
            ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN
                CODE.AddCmd(CODE.opSADR, String(e));
                CODE.AddCmd(CODE.opPARAM, 1);
                CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
                CODE.AddCmd(CODE.opPARAM, 1)
            ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN
                CODE.AddCmd(CODE.opSADR, StringW(e));
                CODE.AddCmd(CODE.opPARAM, 1);
                CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
                CODE.AddCmd(CODE.opPARAM, 1)
            ELSE
                PARS.error(parser, pos, 66)
            END
        ELSE
            PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66);
            PARS.check(assigncomp(e, p.type), parser, pos, 66);
            IF e.obj = eCONST THEN
                IF e.type.typ = PROG.tREAL THEN
                    CODE.Float(ARITH.Float(e.value));
                    CODE.pushf
                ELSIF e.type.typ = PROG.tNIL THEN
                    CODE.AddCmd(CODE.opCONST, 0);
                    CODE.AddCmd(CODE.opPARAM, 1)
                ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN
                    CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s));
                    CODE.AddCmd(CODE.opPARAM, 1)
                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
                    CODE.SetMinDataSize(p.type.size);
                    IF p.type.base.typ = PROG.tCHAR THEN
                        CODE.AddCmd(CODE.opSADR, String(e))
                    ELSE (* WCHAR *)
                        CODE.AddCmd(CODE.opSADR, StringW(e))
                    END;
                    CODE.AddCmd(CODE.opPARAM, 1)
                ELSE
                    LoadConst(e);
                    CODE.AddCmd(CODE.opPARAM, 1)
                END
            ELSIF e.obj = ePROC THEN
                PARS.check(e.ident.global, parser, pos, 85);
                CODE.PushProc(e.ident.proc.label);
                CODE.AddCmd(CODE.opPARAM, 1)
            ELSIF e.obj = eIMP THEN
                CODE.PushImpProc(e.ident.import);
                CODE.AddCmd(CODE.opPARAM, 1)
            ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN
                CODE.pushf
            ELSE
                IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN
                    CheckRange(256, pos.line, errBYTE)
                END;
                CODE.AddCmd(CODE.opPARAM, 1)
            END
        END

    END
END paramcomp;


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


    PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
    BEGIN
        parser.designator(parser, e);
        PARS.check(isVar(e), parser, pos, 93);
        PARS.check(isfunc(e), parser, pos, 66);
        IF readOnly THEN
            PARS.check(~e.readOnly, parser, 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});

    getpos(parser, pos);
    proc := e.stproc;

    IF e.obj IN {eSYSPROC, eSYSFUNC} THEN
        IF parser.unit.scopeLvl > 0 THEN
            parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE
        END
    END;

    IF e.obj IN {eSTPROC, eSYSPROC} THEN

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

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

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

        |PROG.stNEW:
            varparam(parser, pos, isPtr, TRUE, e);
            CODE.New(e.type.base.size, e.type.base.num)

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

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

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

        |PROG.stCOPY:
            parser.expression(parser, e);
            IF isString(e) OR isCharArray(e) THEN
                wchar := FALSE
            ELSIF isStringW(e) OR isCharArrayW(e) THEN
                wchar := TRUE
            ELSE
                PARS.check(FALSE, parser, pos, 66)
            END;

            IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN
                CODE.AddCmd(CODE.opCONST, e.type.length)
            END;

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

            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.typ = PROG.tWCHAR
            END;

            IF ~PROG.isOpenArray(e1.type) THEN
                CODE.AddCmd(CODE.opCONST, e1.type.length)
            END;

            IF e.obj = eCONST THEN
                IF wchar THEN
                    CODE.AddCmd(CODE.opSADR, StringW(e));
                    CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1)
                ELSE
                    CODE.AddCmd(CODE.opSADR, String(e));
                    CODE.AddCmd(CODE.opCONST, strlen(e) + 1)
                END;
                CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size)
            ELSE
                CODE.AddCmd(CODE.opCOPYS, e1.type.base.size)
            END

        |PROG.sysGET:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            IF e.obj = eCONST THEN
                LoadConst(e)
            END;
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            parser.designator(parser, e2);
            PARS.check(isVar(e2), parser, pos, 93);
            PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
            CODE.SysGet(e2.type.size)

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

            IF proc = PROG.sysPUT THEN
                PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66);
                IF e2.obj = eCONST THEN
                    IF e2.type.typ = PROG.tREAL THEN
                        CODE.setlast(endcall.prev(CODE.COMMAND));
                        CODE.Float(ARITH.Float(e2.value));
                        CODE.savef
                    ELSE
                        LoadConst(e2);
                        CODE.setlast(endcall.prev(CODE.COMMAND));
                        CODE.SysPut(e2.type.size)
                    END
                ELSE
                    CODE.setlast(endcall.prev(CODE.COMMAND));
                    IF e2.type.typ = PROG.tREAL THEN
                        CODE.savef
                    ELSIF e2.type.typ = PROG.tBYTE THEN
                        CODE.SysPut(PARS.program.stTypes.tINTEGER.size)
                    ELSE
                        CODE.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.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66);
                IF e2.obj = eCONST THEN
                    LoadConst(e2)
                END;
                CODE.setlast(endcall.prev(CODE.COMMAND));
                IF proc = PROG.sysPUT8 THEN
                    CODE.SysPut(1)
                ELSIF proc = PROG.sysPUT16 THEN
                    CODE.SysPut(2)
                ELSIF proc = PROG.sysPUT32 THEN
                    CODE.SysPut(4)
                END

            END;
            CODE.popBegEnd(begcall, endcall)

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

            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            IF e.obj = eCONST THEN
                LoadConst(e)
            END;
            CODE.AddCmd0(CODE.opMOVE)

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

            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            IF e.obj = eCONST THEN
                LoadConst(e)
            END;
            CODE.AddCmd0(CODE.opMOVE)

        |PROG.sysCODE:
            REPEAT
                getpos(parser, pos);
                PARS.ConstExpression(parser, code);
                PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43);
                PARS.check(ARITH.range(code, 0, 255), parser, pos, 42);
                IF parser.sym = SCAN.lxCOMMA THEN
                    PARS.Next(parser)
                ELSE
                    PARS.checklex(parser, SCAN.lxRROUND)
                END;
                CODE.AddCmd(CODE.opCODE, ARITH.getInt(code))
            UNTIL parser.sym = SCAN.lxRROUND

        END;

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

    ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN

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

        |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            parser.expression(parser, e2);
            PARS.check(isInt(e2), parser, pos, 66);
            e.type := PARS.program.stTypes.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
                    CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
                ELSIF e2.obj = eCONST THEN
                    CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
                ELSE
                    CODE.shift_minmax(shift_minmax(proc))
                END;
                e.obj := eEXPR
            END

        |PROG.stCHR:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            e.type := PARS.program.stTypes.tCHAR;
            IF e.obj = eCONST THEN
                ARITH.setChar(e.value, ARITH.getInt(e.value));
                PARS.check(ARITH.check(e.value), parser, pos, 107)
            ELSE
                IF chkCHR IN checking THEN
                    CheckRange(256, pos.line, errCHR)
                ELSE
                    CODE.AddCmd0(CODE.opCHR)
                END
            END

        |PROG.stWCHR:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            e.type := PARS.program.stTypes.tWCHAR;
            IF e.obj = eCONST THEN
                ARITH.setWChar(e.value, ARITH.getInt(e.value));
                PARS.check(ARITH.check(e.value), parser, pos, 101)
            ELSE
                IF chkWCHR IN checking THEN
                    CheckRange(65536, pos.line, errWCHR)
                ELSE
                    CODE.AddCmd0(CODE.opWCHR)
                END
            END

        |PROG.stFLOOR:
            parser.expression(parser, e);
            PARS.check(isReal(e), parser, pos, 66);
            e.type := PARS.program.stTypes.tINTEGER;
            IF e.obj = eCONST THEN
                PARS.check(ARITH.floor(e.value), parser, pos, 39)
            ELSE
                CODE.floor
            END

        |PROG.stFLT:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            e.type := PARS.program.stTypes.tREAL;
            IF e.obj = eCONST THEN
                ARITH.flt(e.value)
            ELSE
                PARS.check(CODE.flt(), parser, pos, 41)
            END

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

        |PROG.stLENGTH:
            parser.expression(parser, e);
            IF isCharArray(e) THEN
                IF e.type.length > 0 THEN
                    CODE.AddCmd(CODE.opCONST, e.type.length)
                END;
                CODE.AddCmd0(CODE.opLENGTH)
            ELSIF isCharArrayW(e) THEN
                IF e.type.length > 0 THEN
                    CODE.AddCmd(CODE.opCONST, e.type.length)
                END;
                CODE.AddCmd0(CODE.opLENGTHW)
            ELSE
                PARS.check(FALSE, parser, pos, 66);
            END;
            e.type := PARS.program.stTypes.tINTEGER

        |PROG.stODD:
            parser.expression(parser, e);
            PARS.check(isInt(e), parser, pos, 66);
            e.type := PARS.program.stTypes.tBOOLEAN;
            IF e.obj = eCONST THEN
                ARITH.odd(e.value)
            ELSE
                CODE.odd
            END

        |PROG.stORD:
            parser.expression(parser, e);
            PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66);
            IF e.obj = eCONST THEN
                IF isStringW1(e) THEN
                    ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s)))
                ELSE
                    ARITH.ord(e.value)
                END
            ELSE
                IF isBoolean(e) THEN
                    CODE.ord
                END
            END;
            e.type := PARS.program.stTypes.tINTEGER

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

        |PROG.sysADR:
            parser.designator(parser, e);
            IF isVar(e) THEN
               n := PROG.Dim(e.type);
               WHILE n > 0 DO
                    CODE.drop;
                    DEC(n)
               END
            ELSIF e.obj = ePROC THEN
                CODE.PushProc(e.ident.proc.label)
            ELSIF e.obj = eIMP THEN
                CODE.PushImpProc(e.ident.import)
            ELSE
                PARS.check(FALSE, parser, pos, 108)
            END;
            e.type := PARS.program.stTypes.tINTEGER

        |PROG.sysSADR:
            parser.expression(parser, e);
            PARS.check(isString(e), parser, pos, 66);
            CODE.AddCmd(CODE.opSADR, String(e));
            e.type := PARS.program.stTypes.tINTEGER;
            e.obj := eEXPR

        |PROG.sysWSADR:
            parser.expression(parser, e);
            PARS.check(isStringW(e), parser, pos, 66);
            CODE.AddCmd(CODE.opSADR, StringW(e));
            e.type := PARS.program.stTypes.tINTEGER;
            e.obj := eEXPR

        |PROG.sysTYPEID:
            parser.expression(parser, e);
            PARS.check(e.obj = eTYPE, parser, 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.check(FALSE, parser, pos, 52)
            END;
            e.obj := eCONST;
            e.type := PARS.program.stTypes.tINTEGER

        |PROG.sysINF:
            PARS.check(CODE.inf(), parser, pos, 41);
            e.obj := eEXPR;
            e.type := PARS.program.stTypes.tREAL

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

        END

    END;

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

    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:   SCAN.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);

            CODE.setlast(begcall);

            IF param(PROG.PARAM).vPar THEN
                parser.designator(parser, e1)
            ELSE
                parser.expression(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
        PARS.Next(parser);
        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;
    import: BOOLEAN;
    pos:    SCAN.POSITION;

BEGIN
    PARS.checklex(parser, SCAN.lxIDENT);
    getpos(parser, pos);
    import := FALSE;
    ident := parser.unit.idents.get(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 := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE);
        PARS.check1((ident # NIL) & ident.export, parser, 48);
        import := 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 := import
    |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.stproc := ident.stproc
    |PROG.idSTFUNC:
        e.obj    := eSTFUNC;
        e.stproc := ident.stproc
    |PROG.idSYSPROC:
        e.obj    := eSYSPROC;
        e.stproc := ident.stproc
    |PROG.idSYSFUNC:
        PARS.check(~parser.constexp, parser, pos, 109);
        e.obj    := eSYSFUNC;
        e.stproc := ident.stproc
    |PROG.idNONE:
        PARS.check(FALSE, parser, pos, 115)
    END;

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

END qualident;


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

BEGIN
    IF load THEN
        CODE.load(e.type.size)
    END;

    IF chkPTR IN checking THEN
        label := CODE.NewLabel();
        CODE.AddJmpCmd(CODE.opJNZ, label);
        CODE.OnError(pos.line, error);
        CODE.SetLabel(label)
    END
END deref;


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


    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
                CODE.AddCmd(CODE.opVADR, offset);
                DEC(offset);
                DEC(n)
            END
        END OpenArray;


    BEGIN
        IF e.obj = eVAR THEN
            offset := PROG.getOffset(PARS.program, e.ident);
            IF e.ident.global THEN
                CODE.AddCmd(CODE.opGADR, offset)
            ELSE
                CODE.AddCmd(CODE.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
                CODE.AddCmd(CODE.opVADR, e.ident.offset)
            ELSIF PROG.isOpenArray(e.type) THEN
                OpenArray(e)
            ELSE
                CODE.AddCmd(CODE.opLADR, e.ident.offset)
            END
        ELSIF e.obj IN {eVPAR, eVREC} THEN
            IF PROG.isOpenArray(e.type) THEN
                OpenArray(e)
            ELSE
                CODE.AddCmd(CODE.opVADR, e.ident.offset)
            END
        END
    END LoadAdr;


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

    BEGIN

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

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


BEGIN
    qualident(parser, e);

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

    IF isVar(e) 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 := e.type.fields.get(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
            CODE.AddCmd(CODE.opADDR, 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);
            parser.expression(parser, idx);
            PARS.check(isInt(idx), parser, pos, 76);

            IF idx.obj = eCONST THEN
                IF e.type.length > 0 THEN
                    PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83);
                    IF ARITH.Int(idx.value) > 0 THEN
                        CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size)
                    END
                ELSE
                    PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83);
                    LoadConst(idx);
                    OpenIdx(parser, pos, e)
                END
            ELSE
                IF e.type.length > 0 THEN
                    IF chkIDX IN checking THEN
                        CheckRange(e.type.length, pos.line, errIDX)
                    END;
                    IF e.type.base.size # 1 THEN
                        CODE.AddCmd(CODE.opMULC, e.type.base.size)
                    END;
                    CODE.AddCmd0(CODE.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);
        e.ident := NIL

    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, parser, pos, 79);

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

        PARS.check(PROG.isBaseOf(e.type, t.type), parser, 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; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.POSITION; CallStat: BOOLEAN);
VAR
    cconv:    INTEGER;
    params:   INTEGER;
    callconv: INTEGER;
    fparams:  INTEGER;
    int, flt: INTEGER;
    stk_par:  INTEGER;

BEGIN
    cconv := procType.call;
    params := procType.params.size;

    IF cconv IN {PROG._win64, PROG.win64} THEN
        callconv := CODE.call_win64;
        fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        callconv := CODE.call_sysv;
        fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params;
        stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
    ELSE
        callconv := CODE.call_stack;
        fparams := 0
    END;
    CODE.setlast(begcall);
    fregs := CODE.precall(isfloat);

    IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
        CODE.AddCmd(CODE.opALIGN16, params)
    ELSIF cconv IN {PROG._win64, PROG.win64} THEN
        CODE.AddCmd(CODE.opWIN64ALIGN16, params)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par)
    END;
    CODE.setlast(endcall.prev(CODE.COMMAND));

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

    IF cconv IN {PROG._ccall16, PROG.ccall16} THEN
        CODE.AddCmd(CODE.opCLEANUP, params);
        CODE.AddCmd0(CODE.opPOPSP)
    ELSIF cconv IN {PROG._win64, PROG.win64} THEN
        CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1);
        CODE.AddCmd0(CODE.opPOPSP)
    ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
        CODE.AddCmd(CODE.opCLEANUP, params + stk_par);
        CODE.AddCmd0(CODE.opPOPSP)
    ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN
        CODE.AddCmd(CODE.opCLEANUP, params)
    END;

    IF ~CallStat THEN
        IF isfloat THEN
            PARS.check(CODE.resf(fregs), parser, pos, 41)
        ELSE
            CODE.res(fregs)
        END
    END
END ProcCall;


PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    pos, pos0, pos1: SCAN.POSITION;

    op:        INTEGER;
    e1:        PARS.EXPR;
    constant:  BOOLEAN;
    operator:  ARITH.RELATION;
    error:     INTEGER;


    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:    SCAN.POSITION;
        range:  BOOLEAN;

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

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

        range := parser.sym = SCAN.lxRANGE;

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

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

        e.type := PARS.program.stTypes.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
                    CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value))
                ELSIF e2.obj = eCONST THEN
                    CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value))
                ELSE
                    CODE.AddCmd0(CODE.opRSET)
                END
            ELSE
                CODE.AddCmd0(CODE.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 := PARS.program.stTypes.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
                        CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value))
                    ELSE
                        CODE.AddCmd0(CODE.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:      SCAN.POSITION;
        e1:       PARS.EXPR;
        isfloat:  BOOLEAN;
        fregs:    INTEGER;


        PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION);
        BEGIN
            IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
                IF e.type.typ = PROG.tREAL THEN
                    PARS.check(CODE.loadf(), parser, pos, 41)
                ELSE
                    CODE.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 := PARS.program.getType(PARS.program, e.value.typ);
            PARS.Next(parser)

        ELSIF sym = SCAN.lxNIL THEN
            e.obj   := eCONST;
            e.type  := PARS.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  := PARS.program.stTypes.tBOOLEAN;
            PARS.Next(parser)

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

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

            CODE.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, parser, pos, 59);
                isfloat := e.type.typ = PROG.tREAL;
                IF e1.obj IN {ePROC, eIMP} THEN
                    ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE)
                ELSIF isExpr(e1) THEN
                    ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE)
                END
            END;
            CODE.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), parser, pos, 72);
            IF e.obj # eCONST THEN
                CODE.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: SCAN.POSITION;
        op:  INTEGER;
        e1:  PARS.EXPR;

        label:  INTEGER;
        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 := CODE.NewLabel()
                    END;

                    IF e.obj = eCONST THEN
                        CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
                    END;
                    CODE.AddJmpCmd(CODE.opJZ, label);
                    CODE.drop
                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), parser, 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, "*"),   parser, pos, 39)
                   |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40)
                   |ARITH.tSET:     ARITH.opSet(e.value, e1.value, "*")
                   END

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

            |SCAN.lxSLASH:
                PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37);
                IF (e1.obj = eCONST) & isReal(e1) THEN
                    PARS.check(~ARITH.isZero(e1.value), parser, 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, "/"), parser, pos, 40)
                    |ARITH.tSET:  ARITH.opSet(e.value, e1.value, "/")
                    END

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

            |SCAN.lxDIV, SCAN.lxMOD:
                PARS.check(isInt(e) & isInt(e1), parser, pos, 37);
                IF e1.obj = eCONST THEN
                    PARS.check(~ARITH.isZero(e1.value), parser, pos, 46)
                END;
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

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

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

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

                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
                    ARITH.opBoolean(e.value, e1.value, "&")
                ELSE
                    e.obj := eEXPR;
                    IF e1.obj = eCONST THEN
                        CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
                    END
                END

            END
        END;

        IF label # -1 THEN
            CODE.SetLabel(label)
        END
    END term;


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

        plus, minus: BOOLEAN;

        label: 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), parser, pos, 36);

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

            IF e.obj # eCONST THEN
                IF minus THEN
                    IF isInt(e) THEN
                        CODE.AddCmd0(CODE.opUMINUS)
                    ELSIF isReal(e) THEN
                        CODE.AddCmd0(CODE.opUMINF)
                    ELSIF isSet(e) THEN
                        CODE.AddCmd0(CODE.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 := CODE.NewLabel()
                    END;

                    IF e.obj = eCONST THEN
                        CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value)))
                    END;
                    CODE.AddJmpCmd(CODE.opJNZ, label);
                    CODE.drop
                END

            END;

            term(parser, e1);

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

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

                PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, 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)),   parser, pos, 39)
                   |ARITH.tREAL:    PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40)
                   |ARITH.tSET:     ARITH.opSet(e.value, e1.value, CHR(op))
                   END

                ELSE
                    IF isInt(e) THEN
                        IF e.obj = eCONST THEN
                            CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value))
                        ELSE
                            CODE.AddCmd0(CODE.opADD  + ORD(op = ORD("-")))
                        END
                    ELSIF isReal(e) THEN
                        IF e.obj = eCONST THEN
                            CODE.Float(ARITH.Float(e.value));
                            CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-")))
                        ELSIF e1.obj = eCONST THEN
                            CODE.Float(ARITH.Float(e1.value));
                            CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
                        ELSE
                            CODE.fbinop(CODE.opADDF  + ORD(op = ORD("-")))
                        END
                    ELSIF isSet(e) THEN
                        IF e.obj = eCONST THEN
                            CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value))
                        ELSIF e1.obj = eCONST THEN
                            CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value))
                        ELSE
                            CODE.AddCmd0(CODE.opADDS  + ORD(op = ORD("-")))
                        END
                    END;
                    e.obj := eEXPR
                END

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

                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
                    ARITH.opBoolean(e.value, e1.value, "|")
                ELSE
                    e.obj := eEXPR;
                    IF e1.obj = eCONST THEN
                        CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value)))
                    END
                END

            END
        END;

        IF label # -1 THEN
            CODE.SetLabel(label)
        END

    END SimpleExpression;


    PROCEDURE cmpcode (op: INTEGER): INTEGER;
    VAR
        res: INTEGER;
    BEGIN
        CASE op OF
        |SCAN.lxEQ: res := 0
        |SCAN.lxNE: res := 1
        |SCAN.lxLT: res := 2
        |SCAN.lxLE: res := 3
        |SCAN.lxGT: res := 4
        |SCAN.lxGE: res := 5
        END

        RETURN res
    END cmpcode;


    PROCEDURE BoolCmp (eq, val: BOOLEAN);
    BEGIN
       IF eq = val THEN
           CODE.AddCmd0(CODE.opNER)
       ELSE
           CODE.AddCmd0(CODE.opEQR)
       END
    END BoolCmp;


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

    BEGIN

        res := TRUE;

        IF isString(e) & isCharArray(e1) THEN
            CODE.AddCmd(CODE.opSADR, String(e));
            CODE.AddCmd(CODE.opCONST, strlen(e) + 1);
            CODE.AddCmd0(CODE.opEQS2 + cmpcode(op))

        ELSIF isString(e) & isCharArrayW(e1) THEN
            CODE.AddCmd(CODE.opSADR, StringW(e));
            CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
            CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))

        ELSIF isStringW(e) & isCharArrayW(e1) THEN
            CODE.AddCmd(CODE.opSADR, StringW(e));
            CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1);
            CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op))

        ELSIF isCharArray(e) & isString(e1) THEN
            CODE.AddCmd(CODE.opSADR, String(e1));
            CODE.AddCmd(CODE.opCONST, strlen(e1) + 1);
            CODE.AddCmd0(CODE.opEQS + cmpcode(op))

        ELSIF isCharArrayW(e) & isString(e1) THEN
            CODE.AddCmd(CODE.opSADR, StringW(e1));
            CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
            CODE.AddCmd0(CODE.opEQSW + cmpcode(op))

        ELSIF isCharArrayW(e) & isStringW(e1) THEN
            CODE.AddCmd(CODE.opSADR, StringW(e1));
            CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1);
            CODE.AddCmd0(CODE.opEQSW + cmpcode(op))

        ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
            CODE.AddCmd0(CODE.opEQSW + cmpcode(op))

        ELSIF isCharArray(e) & isCharArray(e1) THEN
            CODE.AddCmd0(CODE.opEQS + cmpcode(op))

        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
            CODE.AddCmd(CODE.opCONST, e.type.length)
        END;
        op  := parser.sym;
        getpos(parser, pos);
        PARS.Next(parser);

        pos1 := parser.lex.pos;
        SimpleExpression(parser, e1);

        IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN
            CODE.AddCmd(CODE.opCONST, e1.type.length)
        END;

        constant := (e.obj = eCONST) & (e1.obj = eCONST);

        CASE op OF
        |SCAN.lxEQ: operator := "="
        |SCAN.lxNE: operator := "#"
        |SCAN.lxLT: operator := "<"
        |SCAN.lxLE: operator := "<="
        |SCAN.lxGT: operator := ">"
        |SCAN.lxGE: operator := ">="
        |SCAN.lxIN: operator := "IN"
        |SCAN.lxIS: operator := ""
        END;

        error := 0;

        CASE op OF
        |SCAN.lxEQ, SCAN.lxNE:

            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, operator, error)
                ELSE
                    IF e.obj = eCONST THEN
                        CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6,  ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
                    ELSE
                        CODE.AddCmd0(CODE.opEQ + cmpcode(op))
                    END
                END

            ELSIF isStringW1(e) & isCharW(e1) THEN
                CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))

            ELSIF isStringW1(e1) & isCharW(e) THEN
                CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))

            ELSIF isBoolean(e) & isBoolean(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, operator, error)
                ELSE
                    IF e.obj = eCONST THEN
                        BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0)
                    ELSIF e1.obj = eCONST THEN
                        BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0)
                    ELSE
                        IF op = SCAN.lxEQ THEN
                            CODE.AddCmd0(CODE.opEQB)
                        ELSE
                            CODE.AddCmd0(CODE.opNEB)
                        END
                    END
                END

            ELSIF isReal(e) & isReal(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, operator, error)
                ELSE
                    IF e.obj = eCONST THEN
                        CODE.Float(ARITH.Float(e.value));
                        CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
                    ELSIF e1.obj = eCONST THEN
                        CODE.Float(ARITH.Float(e1.value));
                        CODE.fcmp(CODE.opEQF + cmpcode(op))
                    ELSE
                        CODE.fcmp(CODE.opEQF + cmpcode(op))
                    END
                END

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

            ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
                CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)

            ELSIF isProc(e) & isNil(e1) THEN
                IF e.obj IN {ePROC, eIMP} THEN
                    PARS.check(e.ident.global, parser, pos0, 85);
                    constant := TRUE;
                    e.obj := eCONST;
                    ARITH.setbool(e.value, op = SCAN.lxNE)
                ELSE
                    CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
                END

            ELSIF isNil(e) & isProc(e1) THEN
                IF e1.obj IN {ePROC, eIMP} THEN
                    PARS.check(e1.ident.global, parser, pos1, 85);
                    constant := TRUE;
                    e.obj := eCONST;
                    ARITH.setbool(e.value, op = SCAN.lxNE)
                ELSE
                    CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6)
                END

            ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
                IF e.obj = ePROC THEN
                    PARS.check(e.ident.global, parser, pos0, 85)
                END;
                IF e1.obj = ePROC THEN
                    PARS.check(e1.ident.global, parser, pos1, 85)
                END;
                IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
                    constant := TRUE;
                    e.obj := eCONST;
                    IF op = SCAN.lxEQ THEN
                        ARITH.setbool(e.value, e.ident = e1.ident)
                    ELSE
                        ARITH.setbool(e.value, e.ident # e1.ident)
                    END
                ELSIF e.obj = ePROC THEN
                    CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0)
                ELSIF e1.obj = ePROC THEN
                    CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0)
                ELSIF e.obj = eIMP THEN
                    CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0)
                ELSIF e1.obj = eIMP THEN
                    CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0)
                ELSE
                    CODE.AddCmd0(CODE.opEQ + cmpcode(op))
                END

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

            ELSE
                PARS.error(parser, 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, operator, error)
                ELSE
                    IF e.obj = eCONST THEN
                        CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value))
                    ELSE
                        CODE.AddCmd0(CODE.opEQ + cmpcode(op))
                    END
                END

            ELSIF isStringW1(e) & isCharW(e1) THEN
                CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s))

            ELSIF isStringW1(e1) & isCharW(e) THEN
                CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s))

            ELSIF isReal(e) & isReal(e1) THEN
                IF constant THEN
                    ARITH.relation(e.value, e1.value, operator, error)
                ELSE
                    IF e.obj = eCONST THEN
                        CODE.Float(ARITH.Float(e.value));
                        CODE.fcmp(CODE.opEQF + cmpcode(op) + 6)
                    ELSIF e1.obj = eCONST THEN
                        CODE.Float(ARITH.Float(e1.value));
                        CODE.fcmp(CODE.opEQF + cmpcode(op))
                    ELSE
                        CODE.fcmp(CODE.opEQF + cmpcode(op))
                    END
                END

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

            ELSE
                PARS.error(parser, pos, 37)
            END

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

        |SCAN.lxIS:
            PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73);
            IF e.type.typ = PROG.tRECORD THEN
                PARS.check(e.obj = eVREC, parser, pos0, 78)
            END;
            PARS.check(e1.obj = eTYPE, parser, pos1, 79);

            IF e.type.typ = PROG.tRECORD THEN
                PARS.check(e1.type.typ = PROG.tRECORD,  parser, pos1, 80);
                IF e.ident = NIL THEN
                    CODE.TypeCheck(e1.type.num)
                ELSE
                    CODE.AddCmd(CODE.opVADR, e.ident.offset - 1);
                    CODE.TypeCheckRec(e1.type.num)
                END
            ELSE
                PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81);
                CODE.TypeCheck(e1.type.base.num)
            END;

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

        END;

        ASSERT(error = 0);

        e.type := PARS.program.stTypes.tBOOLEAN;

        IF ~constant THEN
            e.obj := eEXPR
        END

    END
END expression;


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

BEGIN
    getpos(parser, pos);

    CODE.pushBegEnd(begcall, endcall);

    designator(parser, e);

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

        CODE.setlast(begcall);

        NextPos(parser, pos);
        expression(parser, e1);

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

        PARS.check(assign(e1, e.type, line), parser, pos, 91);
        IF e1.obj = ePROC THEN
            PARS.check(e1.ident.global, parser, 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), parser, pos, 92);
        call := TRUE
    ELSE
        PARS.check(isProc(e), parser, pos, 86);
        PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92);
        PARS.check1(e.type.params.first = NIL, parser, 64);
        call := TRUE
    END;

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

    CODE.popBegEnd(begcall, endcall)
END ElementaryStatement;


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

    label, L: INTEGER;

BEGIN
    L := CODE.NewLabel();

    IF ~if THEN
        CODE.AddCmd0(CODE.opLOOP);
        CODE.SetLabel(L)
    END;

    REPEAT
        NextPos(parser, pos);

        label := CODE.NewLabel();

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

        IF e.obj = eCONST THEN
            IF ~ARITH.getBool(e.value) THEN
                CODE.AddJmpCmd(CODE.opJMP, label)
            END
        ELSE
            CODE.AddJmpCmd(CODE.opJNE, label)
        END;

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

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

        CODE.AddJmpCmd(CODE.opJMP, L);
        CODE.SetLabel(label)

    UNTIL parser.sym # SCAN.lxELSIF;

    IF if THEN
        IF parser.sym = SCAN.lxELSE THEN
            PARS.Next(parser);
            parser.StatSeq(parser)
        END;
        CODE.SetLabel(L)
    END;

    PARS.checklex(parser, SCAN.lxEND);

    IF ~if THEN
        CODE.AddCmd0(CODE.opENDLOOP)
    END;

    PARS.Next(parser)
END IfStatement;


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

BEGIN
    CODE.AddCmd0(CODE.opLOOP);

    label := CODE.NewLabel();
    CODE.SetLabel(label);

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

    IF e.obj = eCONST THEN
        IF ~ARITH.getBool(e.value) THEN
            CODE.AddJmpCmd(CODE.opJMP, label)
        END
    ELSE
        CODE.AddJmpCmd(CODE.opJNE, label)
    END;

    CODE.AddCmd0(CODE.opENDLOOP)
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: CODE.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:    SCAN.POSITION;


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


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

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

        IF isChar(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isCharW(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN
                ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s)))
            ELSE
                PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99)
            END;
            a := ARITH.getInt(value)
        ELSIF isInt(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isRecPtr(caseExpr) THEN
            qualident(parser, label);
            PARS.check(label.obj = eTYPE, parser, pos, 79);
            PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, 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: SCAN.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)), parser, 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: SCAN.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 := CODE.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, parser, 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, parser, 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:     CODE.COMMAND;

    BEGIN
        sym := parser.sym;
        IF sym # SCAN.lxBAR THEN
            variant := CODE.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 := CODE.getlast();
            CODE.SetLabel(variant);

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

            parser.StatSeq(parser);
            CODE.AddJmpCmd(CODE.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: CODE.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 := CODE.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));
            CODE.setlast(v.cmd);

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

            CODE.setlast(last);

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


    PROCEDURE TableT (node: AVL.NODE);
    BEGIN
        IF node # NIL THEN
            CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant);

            TableT(node.left);
            TableT(node.right)
        END
    END TableT;


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

    BEGIN
        LISTS.push(CaseVariants, NewVariant(0, NIL));
        end   := CODE.NewLabel();
        else  := CODE.NewLabel();
        table := CODE.NewLabel();
        CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e)));
        CODE.AddJmpCmd(CODE.opJMP, table);

        tree := NIL;

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

        CODE.SetLabel(else);
        IF parser.sym = SCAN.lxELSE THEN
            PARS.Next(parser);
            parser.StatSeq(parser);
            CODE.AddJmpCmd(CODE.opJMP, end)
        ELSE
            CODE.OnError(pos.line, errCASE)
        END;

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

        IF isRecPtr(e) THEN
            CODE.SetLabel(table);
            TableT(tree);
            CODE.AddJmpCmd(CODE.opJMP, else)
        ELSE
            tree.data(CASE_LABEL).self := table;
            Table(tree, else)
        END;

        AVL.destroy(tree, DestroyLabel);
        CODE.SetLabel(end);
        CODE.AddCmd0(CODE.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), parser, pos, 95);
    IF isRecPtr(e) THEN
        PARS.check(isVar(e), parser, pos, 93);
        PARS.check(e.ident # NIL, parser, pos, 106)
    END;
    IF isRec(e) THEN
        PARS.check(e.obj = eVREC, parser, pos, 78)
    END;

    IF e.obj = eCONST THEN
        LoadConst(e)
    ELSIF isRec(e) THEN
        CODE.drop;
        CODE.AddCmd(CODE.opLADR, e.ident.offset - 1);
        CODE.load(PARS.program.target.word)
    ELSIF isPtr(e) THEN
        deref(pos, e, FALSE, errPTR);
        CODE.AddCmd(CODE.opSUBR, PARS.program.target.word);
        CODE.load(PARS.program.target.word)
    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:     SCAN.POSITION;
    step:    ARITH.VALUE;
    st:      INTEGER;
    ident:   PROG.IDENT;
    offset:  INTEGER;
    L1, L2:  INTEGER;

BEGIN
    CODE.AddCmd0(CODE.opLOOP);

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

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

    offset := PROG.getOffset(PARS.program, ident);

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

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

    CODE.SetLabel(L1);

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

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

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

    IF e.obj = eCONST THEN
        IF st > 0 THEN
            CODE.AddCmd(CODE.opLER, ARITH.Int(e.value))
        ELSE
            CODE.AddCmd(CODE.opGER, ARITH.Int(e.value))
        END
    ELSE
        IF st > 0 THEN
            CODE.AddCmd0(CODE.opLE)
        ELSE
            CODE.AddCmd0(CODE.opGE)
        END
    END;

    CODE.AddJmpCmd(CODE.opJNE, L2);

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

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

    IF st = 1 THEN
        CODE.AddCmd0(CODE.opINC1)
    ELSIF st = -1 THEN
        CODE.AddCmd0(CODE.opDEC1)
    ELSE
        IF st > 0 THEN
            CODE.AddCmd(CODE.opINCC, st)
        ELSE
            CODE.AddCmd(CODE.opDECC, -st)
        END
    END;

    CODE.AddJmpCmd(CODE.opJMP, L1);

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

    CODE.SetLabel(L2);

    CODE.AddCmd0(CODE.opENDLOOP)

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: SCAN.POSITION): BOOLEAN;
VAR
    res: BOOLEAN;

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

        IF e.type.typ = PROG.tREAL THEN
            CODE.retf
        END
    END

    RETURN res
END chkreturn;


PROCEDURE setrtl;
VAR
    rtl: PROG.UNIT;


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

    BEGIN
        id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE);

        IF (id # NIL) & (id.import # NIL) THEN
            CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label;
            id.proc.used := TRUE
        ELSIF (id # NIL) & (id.proc # NIL) THEN
            CODE.codes.rtl[idx] := id.proc.label;
            id.proc.used := TRUE
        ELSE
            ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found")
        END
    END getproc;


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

    getproc(rtl,  "_move",      CODE._move);
    getproc(rtl,  "_move2",     CODE._move2);
    getproc(rtl,  "_set",       CODE._set);
    getproc(rtl,  "_set2",      CODE._set2);
    getproc(rtl,  "_div",       CODE._div);
    getproc(rtl,  "_mod",       CODE._mod);
    getproc(rtl,  "_div2",      CODE._div2);
    getproc(rtl,  "_mod2",      CODE._mod2);
    getproc(rtl,  "_arrcpy",    CODE._arrcpy);
    getproc(rtl,  "_rot",       CODE._rot);
    getproc(rtl,  "_new",       CODE._new);
    getproc(rtl,  "_dispose",   CODE._dispose);
    getproc(rtl,  "_strcmp",    CODE._strcmp);
    getproc(rtl,  "_error",     CODE._error);
    getproc(rtl,  "_is",        CODE._is);
    getproc(rtl,  "_isrec",     CODE._isrec);
    getproc(rtl,  "_guard",     CODE._guard);
    getproc(rtl,  "_guardrec",  CODE._guardrec);
    getproc(rtl,  "_length",    CODE._length);
    getproc(rtl,  "_init",      CODE._init);
    getproc(rtl,  "_dllentry",  CODE._dllentry);
    getproc(rtl,  "_strcpy",    CODE._strcpy);
    getproc(rtl,  "_exit",      CODE._exit);
    getproc(rtl,  "_strcpy2",   CODE._strcpy2);
    getproc(rtl,  "_lengthw",   CODE._lengthw);
    getproc(rtl,  "_strcmp2",   CODE._strcmp2);
    getproc(rtl,  "_strcmpw",   CODE._strcmpw);
    getproc(rtl,  "_strcmpw2",  CODE._strcmpw2);

END setrtl;


PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET);
VAR
    parser:  PARS.PARSER;
    ext: PARS.PATH;
    amd64: BOOLEAN;

BEGIN
    amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64};
    ext := mConst.FILE_EXT;
    CaseLabels := C.create();
    CaseVar := C.create();

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

    checking := chk;

    IF amd64 THEN
        CODE.init(6, CODE.little_endian)
    ELSE
        CODE.init(8, CODE.little_endian)
    END;

    parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
    IF parser.open(parser, mConst.RTL_NAME) 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, mConst.RTL_NAME) THEN
            parser.parse(parser);
            PARS.destroy(parser)
        ELSE
            ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found")
        END
    END;

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

    IF parser.open(parser, modname) THEN
        parser.parse(parser)
    ELSE
        ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found")
    END;

    PARS.destroy(parser);

    IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN
        ERRORS.error1("size of global variables is too large")
    END;

    setrtl;

    PROG.DelUnused(PARS.program, CODE.DelImport);

    CODE.codes.bss := PARS.program.bss;
    IF amd64 THEN
        AMD64.CodeGen(CODE.codes, outname, target, stack, base)
    ELSE
        X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic)
    END
END compile;


END STATEMENTS.