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

(*
    BSD 2-Clause License

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

MODULE STATEMENTS;

IMPORT

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


CONST

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

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

    chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;

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

    END;


VAR

    Options: PROG.OPTIONS;

    begcall, endcall: IL.COMMAND;

    CaseLabels, CaseVar: C.COLLECTION;

    CaseVariants: LISTS.LIST;

    CPU: INTEGER;

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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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

BEGIN
    ASSERT(isString(e));
    IF e.type = tCHAR THEN
        res := 1
    ELSE
        res := LENGTH(e.value.string(SCAN.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;

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

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

    RETURN res
END assigncomp;


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

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

    RETURN offset
END String;


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

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

    RETURN offset
END StringW;


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

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


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

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

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

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


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


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

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

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

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


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

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


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

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


BEGIN
    IF p.vPar THEN

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

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

    END
END paramcomp;


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


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


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


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

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


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

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

    getpos(parser, pos);

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

    IF e.obj IN {eSTPROC, eSYSPROC} THEN

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        |PROG.sysGET:
            PExpression(parser, e);
            PARS.check(isInt(e), pos, 66);
            PARS.checklex(parser, SCAN.lxCOMMA);
            NextPos(parser, pos);
            parser.designator(parser, e2);
            PARS.check(isVar(e2), pos, 93);
            PARS.check(e2.type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
            IF e.obj = eCONST THEN
                IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), e2.type.size)
            ELSE
                IL.AddCmd(IL.opGET, e2.type.size)
            END

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

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

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

            END;
            IL.popBegEnd(begcall, endcall)

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

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

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

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

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

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

    ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        END

    END;

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

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

END stProc;


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

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

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

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

            IL.setlast(begcall);

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

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

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

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

END ActualParameters;


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

BEGIN
    PARS.checklex(parser, SCAN.lxIDENT);
    getpos(parser, pos);
    import := FALSE;
    ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
    PARS.check1(ident # NIL, parser, 48);
    IF ident.typ = PROG.idMODULE THEN
        PARS.ExpectSym(parser, SCAN.lxPOINT);
        PARS.ExpectSym(parser, SCAN.lxIDENT);
        ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
        PARS.check1((ident # NIL) & ident.export, parser, 48);
        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, pos, 109);
        e.obj    := eSYSFUNC;
        e.stproc := ident.stproc
    |PROG.idNONE:
        PARS.error(pos, 115)
    END;

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

END qualident;


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

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

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


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


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

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


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


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

    BEGIN

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

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


BEGIN
    qualident(parser, e);

    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 := PROG.getField(e.type, parser.lex.ident, parser.unit);
        PARS.check1(field # NIL, parser, 74);
        e.type := field.type;
        IF e.obj = eVREC THEN
            e.obj := eVPAR
        END;
        IF field.offset # 0 THEN
            IL.AddCmd(IL.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);
            PExpression(parser, idx);
            PARS.check(isInt(idx), pos, 76);

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

            e.type := e.type.base

        UNTIL parser.sym # SCAN.lxCOMMA;

        PARS.checklex(parser, SCAN.lxRSQUARE);
        PARS.Next(parser);
        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, pos, 79);

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

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

        e.type := t.type;

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

    END

END designator;


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

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

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

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

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

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

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


PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
VAR
    pos, pos0, pos1: PARS.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:    PARS.POSITION;
        range:  BOOLEAN;

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

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

        range := parser.sym = SCAN.lxRANGE;

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

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

        e.type := tSET;

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

    END element;


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

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

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

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

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

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


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


        PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
        BEGIN
            IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
                IF e.type = tREAL THEN
                    PARS.check(IL.loadf(), pos, 41)
                ELSE
                    IL.load(e.type.size)
                END
            END
        END LoadVar;


    BEGIN
        sym := parser.sym;

        IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
            e.obj := eCONST;
            e.value := parser.lex.value;
            e.type := PROG.getType(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 := tBOOLEAN;
            PARS.Next(parser)

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

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

            IL.pushBegEnd(begcall, endcall);

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

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

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

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


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

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

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

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

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

                    IF e.obj = eCONST THEN
                        IL.Const(ORD(ARITH.getBool(e.value)))
                    END;
                    IL.AddCmd0(IL.opACC);
                    IL.AddJmpCmd(IL.opJZ, label);
                    IL.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), pos, 37);
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

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

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

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

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

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

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

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

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

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

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

            END
        END;

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


    PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
    VAR
        pos: PARS.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), pos, 36);

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

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

        label := -1;

        WHILE AddOperator(parser.sym) DO

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

            IF op = SCAN.lxOR THEN

                IF ~parser.constexp THEN

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

                    IF e.obj = eCONST THEN
                        IL.Const(ORD(ARITH.getBool(e.value)))
                    END;
                    IL.AddCmd0(IL.opACC);
                    IL.AddJmpCmd(IL.opJNZ, label);
                    IL.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), pos, 37);
                IF (e.obj = eCONST) & (e1.obj = eCONST) THEN

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

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

            |SCAN.lxOR:
                PARS.check(isBoolean(e) & isBoolean(e1), 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
                        IL.Const(ORD(ARITH.getBool(e1.value)))
                    END;
                    IL.AddCmd0(IL.opACC)
                END

            END
        END;

        IF label # -1 THEN
            IL.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 invcmpcode (op: INTEGER): INTEGER;
    VAR
        res: INTEGER;

    BEGIN
        CASE op OF
        |SCAN.lxEQ: res := 0
        |SCAN.lxNE: res := 1
        |SCAN.lxLT: res := 4
        |SCAN.lxLE: res := 5
        |SCAN.lxGT: res := 2
        |SCAN.lxGE: res := 3
        END

        RETURN res
    END invcmpcode;


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


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

    BEGIN
        res := TRUE;

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

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

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

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

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

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

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

        ELSIF isCharArray(e) & isCharArray(e1) THEN
            IL.AddCmd0(IL.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
            IL.Const(e.type.length)
        END;
        op  := parser.sym;
        getpos(parser, pos);
        PARS.Next(parser);

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

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

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

        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
                        IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
                    ELSE
                        IL.AddCmd0(IL.opEQ + cmpcode(op))
                    END
                END

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

            ELSIF isStringW1(e1) & isCharW(e) THEN
                IL.AddCmd(IL.opEQC + cmpcode(op), 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
                            IL.AddCmd0(IL.opEQB)
                        ELSE
                            IL.AddCmd0(IL.opNEB)
                        END
                    END
                END

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

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

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

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

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

            ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN
                IF e.obj = ePROC THEN
                    PARS.check(e.ident.global, pos0, 85)
                END;
                IF e1.obj = ePROC THEN
                    PARS.check(e1.ident.global, pos1, 85)
                END;
                IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
                    constant := TRUE;
                    e.obj := eCONST;
                    IF 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
                    IL.ProcCmp(e.ident.proc.label, op = SCAN.lxEQ)
                ELSIF e1.obj = ePROC THEN
                    IL.ProcCmp(e1.ident.proc.label, op = SCAN.lxEQ)
                ELSIF e.obj = eIMP THEN
                    IL.ProcImpCmp(e.ident.import, op = SCAN.lxEQ)
                ELSIF e1.obj = eIMP THEN
                    IL.ProcImpCmp(e1.ident.import, op = SCAN.lxEQ)
                ELSE
                    IL.AddCmd0(IL.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(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
                        IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
                    ELSIF e1.obj = eCONST THEN
                        IL.AddCmd(IL.opEQC + cmpcode(op), ARITH.Int(e1.value))
                    ELSE
                        IL.AddCmd0(IL.opEQ + cmpcode(op))
                    END
                END

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

            ELSIF isStringW1(e1) & isCharW(e) THEN
                IL.AddCmd(IL.opEQC + cmpcode(op), 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
                        IL.Float(ARITH.Float(e.value));
                        IL.fcmp(IL.opEQF + invcmpcode(op))
                    ELSIF e1.obj = eCONST THEN
                        IL.Float(ARITH.Float(e1.value));
                        IL.fcmp(IL.opEQF + cmpcode(op))
                    ELSE
                        IL.fcmp(IL.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(pos, 37)
                END

            ELSE
                PARS.error(pos, 37)
            END

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

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

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

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

        END;

        ASSERT(error = 0);

        e.type := tBOOLEAN;

        IF ~constant THEN
            e.obj := eEXPR
        END

    END
END expression;


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

BEGIN
    getpos(parser, pos);

    IL.pushBegEnd(begcall, endcall);

    designator(parser, e);

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

        IL.setlast(begcall);

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

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

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

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

    IL.popBegEnd(begcall, endcall)
END ElementaryStatement;


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

    label, L: INTEGER;

BEGIN
    L := IL.NewLabel();

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

    REPEAT
        NextPos(parser, pos);

        label := IL.NewLabel();

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

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

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

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

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

    UNTIL parser.sym # SCAN.lxELSIF;

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

    PARS.checklex(parser, SCAN.lxEND);

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

    PARS.Next(parser)
END IfStatement;


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

BEGIN
    IL.AddCmd0(IL.opLOOP);

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

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

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

    IL.AddCmd0(IL.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: IL.COMMAND): CASE_VARIANT;
VAR
    res:   CASE_VARIANT;
    citem: C.ITEM;

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

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

    RETURN res
END NewVariant;


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


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

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

        IF isChar(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tCHAR, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isCharW(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.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}, pos, 99)
            END;
            a := ARITH.getInt(value)
        ELSIF isInt(caseExpr) THEN
            PARS.ConstExpression(parser, value);
            PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
            a := ARITH.getInt(value)
        ELSIF isRecPtr(caseExpr) THEN
            qualident(parser, label);
            PARS.check(label.obj = eTYPE, pos, 79);
            PARS.check(PROG.isBaseOf(caseExpr.type, label.type), pos, 99);
            IF isRec(caseExpr) THEN
                a := label.type.num
            ELSE
                a := label.type.base.num
            END;
            type := label.type
        END

        RETURN a
    END Label;


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


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

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

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

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

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

        label.range := range;

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

        RETURN node

    END LabelRange;


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

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

        RETURN res
    END CaseLabelList;


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

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

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

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

            parser.StatSeq(parser);
            IL.AddJmpCmd(IL.opJMP, end);

            IF isRecPtr(caseExpr) THEN
                caseExpr.ident.type := t
            END
        END
    END case;


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

    BEGIN
        IF node # NIL THEN

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

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

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

            last := IL.getlast();

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

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

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

            IL.setlast(last);

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


    PROCEDURE TableT (node: AVL.NODE);
    BEGIN
        IF node # NIL THEN
            IL.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: PARS.POSITION);
    VAR
        table, end, else: INTEGER;
        tree: AVL.NODE;
        item: LISTS.ITEM;

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

        tree := NIL;

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

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

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

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

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

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

    END ParseCase;


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

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

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


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

BEGIN
    IL.AddCmd0(IL.opLOOP);

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

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

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

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

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

    IL.SetLabel(L1);

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

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

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

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

    IL.AddJmpCmd(IL.opJNE, L2);

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

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

    IL.AddCmd(IL.opINCC, st);

    IL.AddJmpCmd(IL.opJMP, L1);

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

    IL.SetLabel(L2);

    IL.AddCmd0(IL.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: PARS.POSITION): BOOLEAN;
VAR
    res: BOOLEAN;

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

        IF e.type = tREAL THEN
            IL.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 := PROG.getIdent(rtl, SCAN.enterid(name), FALSE);

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


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

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

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

END setrtl;


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

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

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

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

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

    IL.init(CPU);

    IF CPU # TARGETS.cpuMSP430 THEN
        parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
        IF parser.open(parser, UTILS.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, UTILS.RTL_NAME) THEN
                parser.parse(parser);
                PARS.destroy(parser)
            ELSE
                ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
            END
        END
    END;

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

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

    PARS.destroy(parser);

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

    IF CPU # TARGETS.cpuMSP430 THEN
        setrtl
    END;

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

    IL.set_bss(PARS.program.bss);

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

END compile;


END STATEMENTS.