ruberon/source/PARS.ob07

MODULE PARS;

IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS IN "./utils/UTILS.ob07",
       C := COLLECTIONS, TARGETS, THUMB, MSP430;


CONST

    eCONST*   =  1;  eTYPE*   =  2;  eVAR*     =  3;  eEXPR*    =  4;
    eVREC*    =  5;  ePROC*   =  6;  eVPAR*    =  7;  ePARAM*   =  8;
    eSTPROC*  =  9;  eSTFUNC* = 10;  eSYSFUNC* = 11;  eSYSPROC* = 12;
    eIMP*     = 13;


TYPE

    PATH* = PATHS.PATH;

    PARSER* = POINTER TO rPARSER;

    POSITION* = RECORD (SCAN.POSITION)

        parser*: PARSER

    END;

    EXPR* = RECORD

        obj*:         INTEGER;
        _type*:       PROG._TYPE;
        value*:       ARITH.VALUE;
        stproc*:      INTEGER;
        readOnly*:    BOOLEAN;
        ident*:       PROG.IDENT

    END;

    STATPROC  = PROCEDURE (parser: PARSER);
    EXPRPROC  = PROCEDURE (parser: PARSER; VAR e: EXPR);
    RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG._TYPE; pos: POSITION): BOOLEAN;

    rPARSER = RECORD (C.ITEM)

        fname*:      PATH;
        path:        PATH;
        lib_path:    PATH;
        ext:         PATH;
        modname:     PATH;
        scanner:     SCAN.SCANNER;
        lex*:        SCAN.LEX;
        sym*:        INTEGER;
        unit*:       PROG.UNIT;
        constexp*:   BOOLEAN;
        main*:       BOOLEAN;

        open*:       PROCEDURE (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
        parse*:      PROCEDURE (parser: PARSER);
        StatSeq*:    STATPROC;
        expression*: EXPRPROC;
        designator*: EXPRPROC;
        chkreturn:   RETPROC;

        create*:     PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER

    END;


VAR

    parsers: C.COLLECTION;

    lines*, modules: INTEGER;


PROCEDURE destroy* (VAR parser: PARSER);
    BEGIN
        IF parser.scanner # NIL THEN
            SCAN.close(parser.scanner)
        END;

        C.push(parsers, parser);
        parser := NIL
    END destroy;


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


PROCEDURE error* (pos: POSITION; errno: INTEGER);
    BEGIN
        ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
    END error;


PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
    BEGIN
        IF ~condition THEN
            error(pos, errno)
        END
    END check;


PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
    VAR
        pos: POSITION;

    BEGIN
        IF ~condition THEN
            getpos(parser, pos);
            error(pos, errno)
        END
    END check1;


PROCEDURE Next* (parser: PARSER);
    VAR
        errno: INTEGER;

    BEGIN
        SCAN.Next(parser.scanner, parser.lex);
        errno := parser.lex.error;
        IF errno = 0 THEN
            IF (TARGETS.RealSize = 0) & (parser.lex.sym = SCAN.lxFLOAT) THEN
                errno := -SCAN.lxERROR13
            ELSIF (TARGETS.BitDepth = 16) & (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
                errno := -SCAN.lxERROR10
            END
        END;

        IF errno # 0 THEN
            check1(FALSE, parser, errno)
        END;
        parser.sym := parser.lex.sym
    END Next;


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


PROCEDURE checklex* (parser: PARSER; sym: INTEGER);
    VAR
        err: INTEGER;

    BEGIN

        IF parser.sym # sym THEN

            CASE sym OF
            |SCAN.lxCOMMA:   err := 65
            |SCAN.lxRROUND:  err := 33
            |SCAN.lxPOINT:   err := 26
            |SCAN.lxIDENT:   err := 22
            |SCAN.lxRSQUARE: err := 71
            |SCAN.lxRCURLY:  err := 35
            |SCAN.lxUNDEF:   err := 34
            |SCAN.lxTHEN:    err := 88
            |SCAN.lxEND:     err := 27
            |SCAN.lxDO:      err := 89
            |SCAN.lxUNTIL:   err := 90
            |SCAN.lxCOLON:   err := 53
            |SCAN.lxOF:      err := 67
            |SCAN.lxASSIGN:  err := 96
            |SCAN.lxTO:      err := 57
            |SCAN.lxLROUND:  err := 64
            |SCAN.lxEQ:      err := 32
            |SCAN.lxSEMI:    err := 24
            |SCAN.lxRETURN:  err := 38
            |SCAN.lxMODULE:  err := 21
            END;

            check1(FALSE, parser, err)
        END
    END checklex;


PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);
    BEGIN
        Next(parser);
        checklex(parser, sym)
    END ExpectSym;


PROCEDURE ImportList (parser: PARSER);
    VAR
        fname, path, ext, _name: PATH;
        name:    SCAN.IDENT;
        parser2: PARSER;
        pos:     POSITION;
        alias, _in: BOOLEAN;
        unit:    PROG.UNIT;
        ident:   PROG.IDENT;

    BEGIN
        alias := FALSE;

        REPEAT

            ExpectSym(parser, SCAN.lxIDENT);
            name := parser.lex.ident;

            getpos(parser, pos);

            IF ~alias THEN
                ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
                check(ident # NIL, pos, 30)
            END;

            Next(parser);

            path := parser.path;
            fname := "";
            ext := UTILS.FILE_EXT;
            COPY(name.s, _name);
            _in := FALSE;

            IF parser.sym = SCAN.lxIN THEN
                _in := TRUE;
                Next(parser);
                IF parser.sym = SCAN.lxSTRING THEN
                    STRINGS.trim(parser.lex.string.s, fname)
                ELSIF parser.sym = SCAN.lxCHAR THEN
                    fname[0] := CHR(ARITH.Int(parser.lex.value));
                    fname[1] := 0X
                ELSE
                    check1(FALSE, parser, 117)
                END;
                STRINGS.replace(fname, "/", UTILS.slash);
                STRINGS.replace(fname, "\", UTILS.slash);
                PATHS.DelSlashes(fname);
                PATHS.split(fname, path, _name, ext);
                IF PATHS.isRelative(path) THEN
                    PATHS.RelPath(parser.path, path, fname);
                    STRINGS.append(fname, _name);
                    STRINGS.append(fname, ext);
                    PATHS.split(fname, path, _name, ext)
                END;
                Next(parser)
            END;

            IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
                alias := FALSE;
                IF (fname = "") & ((_name = "SYSTEM") OR PROG.LowerCase & (_name = "system")) THEN
                    unit := PROG.program.sysunit
                ELSE
                    IF fname # "" THEN
                        unit := PROG.getUnit(fname)
                    ELSE
                        fname := path;
                        STRINGS.append(fname, _name);
                        STRINGS.append(fname, UTILS.FILE_EXT);
                        unit := PROG.getUnit(fname);
                        IF unit = NIL THEN
                            fname := parser.lib_path;
                            STRINGS.append(fname, _name);
                            STRINGS.append(fname, UTILS.FILE_EXT);
                            unit := PROG.getUnit(fname)
                        END
                    END
                END;

                IF unit # NIL THEN
                    check(unit.closed, pos, 31)
                ELSE
                    parser2 := parser.create(path, parser.lib_path,
                        parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);

                    IF ~parser2.open(parser2, _name, ext) THEN
                        IF (path # parser.lib_path) & ~_in THEN
                            destroy(parser2);
                            parser2 := parser.create(parser.lib_path, parser.lib_path,
                                parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
                            check(parser2.open(parser2, _name, ext), pos, 29)
                        ELSE
                            error(pos, 29)
                        END
                    END;

                    parser2.parse(parser2);
                    unit := parser2.unit;
                    unit.fname := parser2.fname;
                    destroy(parser2)
                END;
                IF unit = PROG.program.sysunit THEN
                    parser.unit.sysimport := TRUE
                END;
                ident.unit := unit

            ELSIF parser.sym = SCAN.lxASSIGN THEN
                alias := TRUE

            ELSE
                check1(FALSE, parser, 28)
            END

        UNTIL parser.sym = SCAN.lxSEMI;

        Next(parser)

    END ImportList;


PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;
    VAR
        ident: PROG.IDENT;
        unit:  PROG.UNIT;

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

        ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);

        IF ~forward THEN
            check1(ident # NIL, parser, 48)
        END;

        IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN
            unit := ident.unit;
            ExpectSym(parser, SCAN.lxPOINT);
            ExpectSym(parser, SCAN.lxIDENT);
            ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
            check1((ident # NIL) & ident.export, parser, 48)
        END

        RETURN ident
    END QIdent;


PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
    VAR
        str: SCAN.TEXTSTR;
        string1, string2: SCAN.STRING;
        bool: BOOLEAN;

    BEGIN

        IF v.typ = ARITH.tCHAR THEN
            ASSERT(v2.typ = ARITH.tSTRING);
            ARITH.charToStr(v, str);
            string1 := SCAN.enterStr(str);
            string2 := v2.string(SCAN.STRING)
        END;

        IF v2.typ = ARITH.tCHAR THEN
            ASSERT(v.typ = ARITH.tSTRING);
            ARITH.charToStr(v2, str);
            string2 := SCAN.enterStr(str);
            string1 := v.string(SCAN.STRING)
        END;

        IF v.typ = v2.typ THEN
            string1 := v.string(SCAN.STRING);
            string2 := v2.string(SCAN.STRING)
        END;

        CASE operator OF
        |SCAN.lxEQ: bool := string1.s =  string2.s
        |SCAN.lxNE: bool := string1.s #  string2.s
        |SCAN.lxLT: bool := string1.s <  string2.s
        |SCAN.lxGT: bool := string1.s >  string2.s
        |SCAN.lxLE: bool := string1.s <= string2.s
        |SCAN.lxGE: bool := string1.s >= string2.s
        END;

        ARITH.setbool(v, bool)
    END strcmp;


PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
    VAR
        e: EXPR;
        pos: POSITION;

    BEGIN
        getpos(parser, pos);
        parser.constexp := TRUE;
        parser.expression(parser, e);
        parser.constexp := FALSE;
        check(e.obj = eCONST, pos, 62);
        v := e.value
    END ConstExpression;


PROCEDURE FieldList (parser: PARSER; rec: PROG._TYPE);
    VAR
        name:   SCAN.IDENT;
        export: BOOLEAN;
        pos:    POSITION;

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

        WHILE parser.sym = SCAN.lxIDENT DO

            getpos(parser, pos);

            name := parser.lex.ident;

            Next(parser);

            export := parser.sym = SCAN.lxMUL;

            IF export THEN
                check1(parser.unit.scopeLvl = 0, parser, 61);
                Next(parser)
            END;

            check(PROG.addField(rec, name, export), pos, 30);

            IF parser.sym = SCAN.lxCOMMA THEN
                ExpectSym(parser, SCAN.lxIDENT)
            ELSE
                checklex(parser, SCAN.lxCOLON)
            END

        END

    END FieldList;


PROCEDURE FormalParameters (parser: PARSER; _type: PROG._TYPE);
    VAR
        ident: PROG.IDENT;


        PROCEDURE FPSection (parser: PARSER; _type: PROG._TYPE);
        VAR
            ident:   PROG.IDENT;
            exit:    BOOLEAN;
            vPar:    BOOLEAN;
            dim:     INTEGER;
            t0, t1:  PROG._TYPE;
            pos:     POSITION;

        BEGIN
            vPar := parser.sym = SCAN.lxVAR;
            IF vPar THEN
                Next(parser)
            END;

            checklex(parser, SCAN.lxIDENT);
            exit := FALSE;

            WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
                check1(PROG.addParam(_type, parser.lex.ident, vPar), parser, 30);
                Next(parser);
                IF parser.sym = SCAN.lxCOMMA THEN
                    ExpectSym(parser, SCAN.lxIDENT)
                ELSIF parser.sym = SCAN.lxCOLON THEN
                    Next(parser);
                    getpos(parser, pos);
                    dim := 0;
                    WHILE parser.sym = SCAN.lxARRAY DO
                        INC(dim);
                        check1(dim <= PROG.MAXARRDIM, parser, 84);
                        ExpectSym(parser, SCAN.lxOF);
                        Next(parser)
                    END;
                    checklex(parser, SCAN.lxIDENT);
                    ident := QIdent(parser, FALSE);
                    check1(ident.typ = PROG.idTYPE, parser, 68);

                    t0 := ident._type;
                    t1 := t0;

                    WHILE dim > 0 DO
                        t1 := PROG.enterType(PROG.tARRAY, -1, 0, parser.unit);
                        t1.base := t0;
                        t0 := t1;
                        DEC(dim)
                    END;
                    IF _type.call IN {PROG.fastcall, PROG._fastcall} THEN
                        check(t1.typ # PROG.tREAL, pos, 126)
                    END;
                    PROG.setParams(_type, t1);
                    Next(parser);
                    exit := TRUE
                ELSE
                    checklex(parser, SCAN.lxCOLON)
                END
            END

        END FPSection;


    BEGIN
        IF parser.sym = SCAN.lxLROUND THEN

            Next(parser);

            IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
                FPSection(parser, _type);
                WHILE parser.sym = SCAN.lxSEMI DO
                    Next(parser);
                    FPSection(parser, _type)
                END
            END;

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

            IF parser.sym = SCAN.lxCOLON THEN
                ExpectSym(parser, SCAN.lxIDENT);
                ident := QIdent(parser, FALSE);
                check1(ident.typ = PROG.idTYPE, parser, 68);
                check1(~(ident._type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
                check1( ~(ODD(_type.call) & (ident._type.typ = PROG.tREAL)), parser, 113);
                _type.base := ident._type;
                Next(parser)
            ELSE
                _type.base := NIL
            END

        END
    END FormalParameters;


PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
    VAR
        res, sf: INTEGER;

    BEGIN
        checklex(parser, SCAN.lxIDENT);
        IF parser.lex.ident.s = "stdcall" THEN
            sf := PROG.sf_stdcall
        ELSIF parser.lex.ident.s = "cdecl" THEN
            sf := PROG.sf_cdecl
        ELSIF parser.lex.ident.s = "ccall" THEN
            sf := PROG.sf_ccall
        ELSIF parser.lex.ident.s = "win64" THEN
            sf := PROG.sf_win64
        ELSIF parser.lex.ident.s = "systemv" THEN
            sf := PROG.sf_systemv
        ELSIF parser.lex.ident.s = "windows" THEN
            sf := PROG.sf_windows
        ELSIF parser.lex.ident.s = "linux" THEN
            sf := PROG.sf_linux
        ELSIF parser.lex.ident.s = "code" THEN
            sf := PROG.sf_code
        ELSIF parser.lex.ident.s = "oberon" THEN
            sf := PROG.sf_oberon
        ELSIF parser.lex.ident.s = "fastcall" THEN
            sf := PROG.sf_fastcall
        ELSIF parser.lex.ident.s = "noalign" THEN
            sf := PROG.sf_noalign
        ELSE
            check1(FALSE, parser, 124)
        END;

        check1(sf IN PROG.program.sysflags, parser, 125);

        IF proc THEN
            check1(sf IN PROG.proc_flags, parser, 123)
        ELSE
            check1(sf IN PROG.rec_flags, parser, 123)
        END;

        CASE sf OF
        |PROG.sf_stdcall:
            res := PROG.stdcall
        |PROG.sf_cdecl:
            res := PROG.cdecl
        |PROG.sf_ccall:
            IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
                res := PROG.ccall
            ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
                res := PROG.win64
            ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
                res := PROG.systemv
            END
        |PROG.sf_win64:
            res := PROG.win64
        |PROG.sf_systemv:
            res := PROG.systemv
        |PROG.sf_code:
            res := PROG.code
        |PROG.sf_fastcall:
            res := PROG.fastcall
        |PROG.sf_oberon:
            IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
                res := PROG.default32
            ELSIF TARGETS.OS IN {TARGETS.osWIN64, TARGETS.osLINUX64} THEN
                res := PROG.default64
            END
        |PROG.sf_windows:
            IF TARGETS.OS = TARGETS.osWIN32 THEN
                res := PROG.stdcall
            ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
                res := PROG.win64
            END
        |PROG.sf_linux:
            IF TARGETS.OS = TARGETS.osLINUX32 THEN
                res := PROG.ccall
            ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
                res := PROG.systemv
            END
        |PROG.sf_noalign:
            res := PROG.noalign
        END

        RETURN res
    END sysflag;


PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
    VAR
        call: INTEGER;
        dll, proc: SCAN.TEXTSTR;
        pos: POSITION;


        PROCEDURE getStr (parser: PARSER; VAR name: SCAN.TEXTSTR);
        VAR
            pos: POSITION;
            str: ARITH.VALUE;

        BEGIN
            getpos(parser, pos);
            ConstExpression(parser, str);
            IF str.typ = ARITH.tSTRING THEN
                name := str.string(SCAN.STRING).s
            ELSIF str.typ = ARITH.tCHAR THEN
                ARITH.charToStr(str, name)
            ELSE
                check(FALSE, pos, 117)
            END
        END getStr;


    BEGIN
        _import := NIL;

        IF parser.sym = SCAN.lxLSQUARE THEN
            getpos(parser, pos);
            check1(parser.unit.sysimport, parser, 54);
            Next(parser);
            call := sysflag(parser, TRUE);
            Next(parser);
            IF parser.sym = SCAN.lxMINUS THEN
                Next(parser);
                INC(call)
            END;

            IF isProc & (parser.sym = SCAN.lxCOMMA) THEN
                Next(parser);
                getStr(parser, dll);
                STRINGS.UpCase(dll);
                checklex(parser, SCAN.lxCOMMA);
                Next(parser);
                getStr(parser, proc);
                _import := IL.AddImp(dll, proc)
            END;

            checklex(parser, SCAN.lxRSQUARE);
            Next(parser)
        ELSE
            CASE TARGETS.BitDepth OF
            |16: call := PROG.default16
            |32: IF TARGETS.CPU = TARGETS.cpuX86 THEN
                    call := PROG.default32
                ELSE
                    call := PROG.cdecl
                END
            |64: IF TARGETS.CPU = TARGETS.cpuAMD64 THEN
                    call := PROG.default64
                ELSE
                    call := PROG.cdecl
                END
            END
        END;

        IF _import # NIL THEN
            check(TARGETS.Import, pos, 70)
        END

        RETURN call
    END procflag;


PROCEDURE _type (parser: PARSER; VAR t: PROG._TYPE; flags: SET);
    CONST
        comma   = 0;
        closed  = 1;
        forward = 2;

    VAR
        arrLen:     ARITH.VALUE;
        typeSize:   ARITH.VALUE;
        ident:      PROG.IDENT;
        unit:       PROG.UNIT;
        pos, pos2:  POSITION;
        fieldType:  PROG._TYPE;
        baseIdent:  SCAN.IDENT;
        a, b:       INTEGER;
        RecFlag:    INTEGER;
        _import:     IL.IMPORT_PROC;

    BEGIN
        unit := parser.unit;
        t := NIL;

        IF parser.sym = SCAN.lxIDENT THEN
            ident := QIdent(parser, forward IN flags);

            IF ident # NIL THEN
                check1(ident.typ = PROG.idTYPE, parser, 49);
                t := ident._type;
                check1(t # NIL, parser, 50);
                IF closed IN flags THEN
                    check1(t.closed, parser, 50)
                END
            END;

            Next(parser)

        ELSIF (parser.sym = SCAN.lxARRAY) OR ((parser.sym = SCAN.lxCOMMA) & (comma IN flags)) THEN

            IF parser.sym = SCAN.lxARRAY THEN
                getpos(parser, pos2)
            END;
            NextPos(parser, pos);

            ConstExpression(parser, arrLen);

            check(arrLen.typ = ARITH.tINTEGER, pos, 43);
            check(ARITH.check(arrLen),         pos, 39);
            check(ARITH.getInt(arrLen) > 0,    pos, 51);

            t := PROG.enterType(PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);

            IF parser.sym = SCAN.lxCOMMA THEN
                _type(parser, t.base, {comma, closed})
            ELSIF parser.sym = SCAN.lxOF THEN
                Next(parser);
                _type(parser, t.base, {closed})
            ELSE
                check1(FALSE, parser, 47)
            END;

            t.align := t.base.align;

            a := t.length;
            b := t.base.size;
            check(ARITH.mulInt(a, b), pos2, 104);
            check(ARITH.setInt(typeSize, a), pos2, 104);
            t.size := a;

            t.closed := TRUE

        ELSIF parser.sym = SCAN.lxRECORD THEN
            getpos(parser, pos2);
            Next(parser);

            t := PROG.enterType(PROG.tRECORD, 0, 0, unit);
            t.align := 1;

            IF parser.sym = SCAN.lxLSQUARE THEN
                check1(parser.unit.sysimport, parser, 54);
                Next(parser);
                RecFlag := sysflag(parser, FALSE);
                t.noalign := RecFlag = PROG.noalign;
                ExpectSym(parser, SCAN.lxRSQUARE);
                Next(parser)
            END;

            IF parser.sym = SCAN.lxLROUND THEN
                check1(~t.noalign, parser, 111);
                ExpectSym(parser, SCAN.lxIDENT);
                getpos(parser, pos);

                _type(parser, t.base, {closed});

                check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, pos, 52);

                IF t.base.typ = PROG.tPOINTER THEN
                    t.base := t.base.base;
                    check(t.base # NIL, pos, 55)
                END;

                check(~t.base.noalign, pos, 112);

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

                t.size := t.base.size;
                IF t.base.align > t.align THEN
                    t.align := t.base.align
                END
            ELSE
                t.base := PROG.program.stTypes.tANYREC
            END;

            WHILE parser.sym = SCAN.lxIDENT DO
                FieldList(parser, t);

                ASSERT(parser.sym = SCAN.lxCOLON);
                Next(parser);

                _type(parser, fieldType, {closed});
                check(PROG.setFields(t, fieldType), pos2, 104);

                IF (fieldType.align > t.align) & ~t.noalign THEN
                    t.align := fieldType.align
                END;

                IF parser.sym = SCAN.lxSEMI THEN
                    ExpectSym(parser, SCAN.lxIDENT)
                ELSE
                    checklex(parser, SCAN.lxEND)
                END
            END;

            t.closed := TRUE;

            IL.AddRec(t.base.num);

            IF ~t.noalign THEN
                check(UTILS.Align(t.size, t.align), pos2, 104);
                check(ARITH.setInt(typeSize, t.size), pos2, 104)
            END;

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

        ELSIF parser.sym = SCAN.lxPOINTER THEN
            ExpectSym(parser, SCAN.lxTO);
            Next(parser);

            t := PROG.enterType(PROG.tPOINTER, TARGETS.AdrSize, 0, unit);
            t.align := TARGETS.AdrSize;

            getpos(parser, pos);

            IF parser.sym = SCAN.lxIDENT THEN
                baseIdent := parser.lex.ident
            END;

            _type(parser, t.base, {forward});

            IF t.base # NIL THEN
                check(t.base.typ = PROG.tRECORD, pos, 58)
            ELSE
                PROG.frwPtr(unit, t, baseIdent, pos)
            END

        ELSIF parser.sym = SCAN.lxPROCEDURE THEN
            NextPos(parser, pos);
            t := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
            t.align := TARGETS.AdrSize;
            t.call := procflag(parser, _import, FALSE);
            FormalParameters(parser, t)
        ELSE
            check1(FALSE, parser, 49)
        END

    END _type;


PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
    VAR
        ident:  PROG.IDENT;
        pos:    POSITION;

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

        name := parser.lex.ident;
        getpos(parser, pos);
        ident := PROG.addIdent(parser.unit, name, typ);
        check(ident # NIL, pos, 30);
        ident.pos := pos;
        Next(parser);

        IF parser.sym = SCAN.lxMUL THEN
            check1(ident.global, parser, 61);
            ident.export := TRUE;
            Next(parser)
        END

        RETURN ident
    END IdentDef;


PROCEDURE ConstTypeDeclaration (parser: PARSER; _const: BOOLEAN);
    VAR
        ident: PROG.IDENT;
        name:  SCAN.IDENT;
        pos:   POSITION;

    BEGIN
        IF _const THEN
            ident := IdentDef(parser, PROG.idNONE, name)
        ELSE
            ident := IdentDef(parser, PROG.idTYPE, name)
        END;

        checklex(parser, SCAN.lxEQ);
        NextPos(parser, pos);

        IF _const THEN
            ConstExpression(parser, ident.value);
            IF ident.value.typ = ARITH.tINTEGER THEN
                check(ARITH.check(ident.value), pos, 39)
            ELSIF ident.value.typ = ARITH.tREAL THEN
                check(ARITH.check(ident.value), pos, 40)
            END;
            ident.typ  := PROG.idCONST;
            ident._type := PROG.getType(ident.value.typ)
        ELSE
            _type(parser, ident._type, {})
        END;

        checklex(parser, SCAN.lxSEMI);
        Next(parser)

    END ConstTypeDeclaration;


PROCEDURE VarDeclaration (parser: PARSER);
    VAR
        ident: PROG.IDENT;
        name:  SCAN.IDENT;
        t:     PROG._TYPE;

    BEGIN

        REPEAT
            ident := IdentDef(parser, PROG.idVAR, name);

            IF parser.sym = SCAN.lxCOMMA THEN
                ExpectSym(parser, SCAN.lxIDENT)
            ELSIF parser.sym = SCAN.lxCOLON THEN
                Next(parser);
                _type(parser, t, {});
                PROG.setVarsType(parser.unit, t);
                checklex(parser, SCAN.lxSEMI);
                Next(parser)
            ELSE
                checklex(parser, SCAN.lxCOLON)
            END

        UNTIL parser.sym # SCAN.lxIDENT

    END VarDeclaration;


PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
    VAR
        ptr: PROG.FRWPTR;
        endmod: BOOLEAN;
        pos: POSITION;


        PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
        VAR
            proc:       PROG.IDENT;
            endname,
            name:       SCAN.IDENT;
            param:      PROG.PARAM;
            unit:       PROG.UNIT;
            ident:      PROG.IDENT;
            e:          EXPR;
            pos, pos1,
            pos2:       POSITION;
            label:      INTEGER;
            enter:      IL.COMMAND;
            call:       INTEGER;
            t:          PROG._TYPE;
            _import:    IL.IMPORT_PROC;
            endmod, b:  BOOLEAN;
            fparams:    SET;
            int, flt:   INTEGER;
            comma:      BOOLEAN;
            code, iv:   ARITH.VALUE;
            codeProc,
            handler:    BOOLEAN;
            line:       INTEGER;

        BEGIN
            endmod := FALSE;
            handler := FALSE;

            unit := parser.unit;

            call := procflag(parser, _import, TRUE);

            getpos(parser, pos);
            pos1 := pos;
            checklex(parser, SCAN.lxIDENT);
            line := pos.line;

            IF _import # NIL THEN
                proc := IdentDef(parser, PROG.idIMP, name);
                proc._import := _import;
                IF _import.name = "" THEN
                    COPY(name.s, _import.name)
                END;
                PROG.program.procs.last(PROG.PROC)._import := _import
            ELSE
                proc := IdentDef(parser, PROG.idPROC, name)
            END;

            check(PROG.openScope(unit, proc.proc), pos, 116);

            proc._type := PROG.enterType(PROG.tPROCEDURE, TARGETS.AdrSize, 0, unit);
            t := proc._type;
            t.align := TARGETS.AdrSize;
            t.call  := call;

            FormalParameters(parser, t);

            IF parser.sym = SCAN.lxLSQUARE THEN
                getpos(parser, pos2);
                check((TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE), pos2, 24);
                Next(parser);
                getpos(parser, pos2);
                ConstExpression(parser, iv);
                check(iv.typ = ARITH.tINTEGER, pos2, 43);
                check((0 <= ARITH.Int(iv)) & (ARITH.Int(iv) <= THUMB.maxIVT), pos2, 46);
                check(THUMB.SetIV(ARITH.Int(iv)), pos2, 121);
                checklex(parser, SCAN.lxRSQUARE);
                Next(parser);
                handler := TRUE
            END;

            codeProc := call IN {PROG.code, PROG._code};

            IF call IN {PROG.systemv, PROG._systemv} THEN
                check(t.parSize <= PROG.MAXSYSVPARAM, pos, 120)
            END;

            param := t.params.first(PROG.PARAM);
            WHILE param # NIL DO
                ident := PROG.addIdent(unit, param.name, PROG.idPARAM);
                ASSERT(ident # NIL);
                ident._type := param._type;
                ident.offset := param.offset;
                IF param.vPar THEN
                    ident.typ := PROG.idVPAR
                END;
                param := param.next(PROG.PARAM)
            END;

            IF _import = NIL THEN
                label := IL.NewLabel();
                proc.proc.label := label;
                proc.proc.used  := handler;
                IF handler THEN
                    IL.AddCmd2(IL.opHANDLER, label, ARITH.Int(iv))
                END
            END;

            IF codeProc THEN
                enter := IL.EnterC(label);
                comma := FALSE;
                WHILE (parser.sym # SCAN.lxSEMI) OR comma DO
                    getpos(parser, pos2);
                    ConstExpression(parser, code);
                    check(code.typ = ARITH.tINTEGER, pos2, 43);
                    IF TARGETS.WordSize > TARGETS.InstrSize THEN
                        CASE TARGETS.InstrSize OF
                        |1: check(ARITH.range(code, 0, 255), pos, 42)
                        |2: check(ARITH.range(code, 0, 65535), pos, 110)
                        END
                    END;
                    IL.AddCmd(IL.opCODE, ARITH.getInt(code));
                    comma := parser.sym = SCAN.lxCOMMA;
                    IF comma THEN
                        Next(parser)
                    ELSE
                        checklex(parser, SCAN.lxSEMI)
                    END
                END
            END;

            checklex(parser, SCAN.lxSEMI);
            Next(parser);

            IF _import = NIL THEN

                IF parser.main & proc.export & TARGETS.Dll THEN
                    IF TARGETS.target = TARGETS.KolibriOSDLL THEN
                        check((proc.name.s # "lib_init") & (proc.name.s # "version"), pos, 114)
                    END;
                    IL.AddExp(label, proc.name.s);
                    proc.proc.used := TRUE
                END;

                IF ~codeProc THEN
                    b := DeclarationSequence(parser)
                END;

                PROG.ResetLocSize;
                IF call IN {PROG._win64, PROG.win64} THEN
                    fparams := PROG.getFloatParamsPos(proc._type, 3, int, flt);
                    enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc._type.parSize, 4))
                ELSIF call IN {PROG._systemv, PROG.systemv} THEN
                    fparams := PROG.getFloatParamsPos(proc._type, PROG.MAXSYSVPARAM - 1, int, flt);
                    enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc._type.parSize))
                ELSIF codeProc THEN

                ELSIF call IN {PROG.fastcall, PROG._fastcall} THEN
                    enter := IL.Enter(label, proc._type.parSize)
                ELSE
                    enter := IL.Enter(label, 0)
                END;
                proc.proc.enter := enter;

                IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
                    Next(parser);
                    parser.StatSeq(parser)
                END;

                IF ~codeProc & (t.base # NIL) THEN
                    checklex(parser, SCAN.lxRETURN);
                    NextPos(parser, pos);
                    parser.expression(parser, e);
                    check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
                END;

                IF ~codeProc THEN
                    proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), PROG.program.locsize,
                        t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
                    enter.param2 := PROG.program.locsize;
                    checklex(parser, SCAN.lxEND)
                ELSE
                    proc.proc.leave := IL.LeaveC()
                END;

                IF (TARGETS.CPU = TARGETS.cpuMSP430) & ~codeProc THEN
                    check(MSP430.CheckProcDataSize(enter.param2 + proc._type.parSize, PROG.program.options.ram), pos1, 63);
                    enter.param2 := enter.param2 * 65536 + line;
                    enter.param3 := IL.codes.errlabels[10]
                END
            END;

            IF parser.sym = SCAN.lxEND THEN
                Next(parser);
                IF parser.sym = SCAN.lxIDENT THEN
                    getpos(parser, pos);
                    endname := parser.lex.ident;
                    IF ~codeProc & (_import = NIL) THEN
                        check(PROG.IdEq(endname, name), pos, 60);
                        ExpectSym(parser, SCAN.lxSEMI);
                        Next(parser)
                    ELSE
                        IF PROG.IdEq(endname, parser.unit.name) THEN
                            ExpectSym(parser, SCAN.lxPOINT);
                            Next(parser);
                            endmod := TRUE
                        ELSIF PROG.IdEq(endname, name) THEN
                            ExpectSym(parser, SCAN.lxSEMI);
                            Next(parser)
                        ELSE
                            error(pos, 60)
                        END
                    END
                ELSIF parser.sym = SCAN.lxSEMI THEN
                    Next(parser)
                ELSE
                    checklex(parser, SCAN.lxIDENT)
                END
            END;

            PROG.closeScope(unit);

            RETURN endmod
        END ProcDeclaration;


    BEGIN
        IF parser.sym = SCAN.lxCONST THEN
            Next(parser);
            WHILE parser.sym = SCAN.lxIDENT DO
                ConstTypeDeclaration(parser, TRUE)
            END
        END;

        IF parser.sym = SCAN.lxTYPE THEN
            Next(parser);
            WHILE parser.sym = SCAN.lxIDENT DO
                ConstTypeDeclaration(parser, FALSE)
            END
        END;

        ptr := PROG.linkPtr(parser.unit);
        IF ptr # NIL THEN
            pos.line := ptr.pos.line;
            pos.col  := ptr.pos.col;
            pos.parser := parser;
            IF ptr.notRecord THEN
                error(pos, 58)
            ELSE
                error(pos, 48)
            END
        END;

        IF parser.sym = SCAN.lxVAR THEN
            Next(parser);
            IF parser.sym = SCAN.lxIDENT THEN
                VarDeclaration(parser)
            END
        END;

        endmod := FALSE;
        WHILE ~endmod & (parser.sym = SCAN.lxPROCEDURE) DO
            Next(parser);
            endmod := ProcDeclaration(parser)
        END

        RETURN endmod
    END DeclarationSequence;


PROCEDURE parse (parser: PARSER);
    VAR
        unit:     PROG.UNIT;
        label:    INTEGER;
        name:     INTEGER;
        endmod:   BOOLEAN;
        errlabel: INTEGER;
        errno:    INTEGER;
        ident:    PROG.IDENT;

    BEGIN
        ASSERT(parser # NIL);
        ASSERT(parser.scanner # NIL);

        ExpectSym(parser, SCAN.lxMODULE);
        ExpectSym(parser, SCAN.lxIDENT);

        IF ~parser.main THEN
            check1(parser.lex.ident.s = parser.modname, parser, 23)
        END;

        unit := PROG.newUnit(parser.lex.ident);
        unit.fname := parser.fname;
        parser.unit := unit;

        ExpectSym(parser, SCAN.lxSEMI);

        Next(parser);
        IF parser.sym = SCAN.lxIMPORT THEN
            ImportList(parser)
        END;

        INC(modules);

        CONSOLE.String("compiling ");
        CONSOLE.String("("); CONSOLE.Int(modules); CONSOLE.String(") ");
        CONSOLE.String(unit.name.s);
        IF unit.sysimport THEN
            CONSOLE.String(" (SYSTEM)")
        END;
        CONSOLE.Ln;

        IF PROG.program.options.uses THEN
            ident := unit.idents.first(PROG.IDENT);
            WHILE ident # NIL DO
                IF (ident.typ = PROG.idMODULE) & (ident.unit # PROG.program.sysunit) THEN
                    CONSOLE.String("    "); CONSOLE.String(ident.unit.fname); CONSOLE.Ln
                END;
                ident := ident.next(PROG.IDENT)
            END;
            CONSOLE.Ln
        END;

        IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
            IL.fname(parser.fname)
        END;

        label := IL.NewLabel();
        IL.Jmp(IL.opJMP, label);

        name := IL.putstr(unit.name.s);

        errlabel := IL.NewLabel();
        IL.SetLabel(errlabel);
        IL.StrAdr(name);
        IL.Param1;
        IL.AddCmd(IL.opPUSHC, modules);
        IL.AddCmd0(IL.opERR);

        FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
            IL.SetErrLabel(errno);
            IL.AddCmd(IL.opPUSHC, errno);
            IL.Jmp(IL.opJMP, errlabel)
        END;

        endmod := DeclarationSequence(parser);

        IL.SetLabel(label);

        IF ~endmod THEN

            IF parser.sym = SCAN.lxBEGIN THEN
                Next(parser);
                parser.StatSeq(parser)
            END;

            checklex(parser, SCAN.lxEND);

            ExpectSym(parser, SCAN.lxIDENT);
            check1(parser.lex.ident.s = unit.name.s, parser, 25);
            ExpectSym(parser, SCAN.lxPOINT)
        END;

        INC(lines, parser.lex.pos.line);
        PROG.closeUnit(unit)
    END parse;


PROCEDURE open (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
    BEGIN
        ASSERT(parser # NIL);

        STRINGS.append(parser.fname, modname);
        STRINGS.append(parser.fname, FileExt);
        STRINGS.append(parser.modname, modname);

        parser.scanner := SCAN.open(parser.fname)

        RETURN parser.scanner # NIL
    END open;


PROCEDURE NewParser (): PARSER;
    VAR
        pars:  PARSER;
        citem: C.ITEM;

    BEGIN
        citem := C.pop(parsers);
        IF citem = NIL THEN
            NEW(pars)
        ELSE
            pars := citem(PARSER)
        END

        RETURN pars
    END NewParser;


PROCEDURE create* (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER;
    VAR
        parser: PARSER;

    BEGIN
        parser := NewParser();

        parser.path     := path;
        parser.lib_path := lib_path;
        parser.ext      := UTILS.FILE_EXT;
        parser.fname    := path;
        parser.modname  := "";
        parser.scanner  := NIL;
        parser.unit     := NIL;
        parser.constexp := FALSE;
        parser.main     := FALSE;

        parser.open       := open;
        parser.parse      := parse;
        parser.StatSeq    := StatSeq;
        parser.expression := expression;
        parser.designator := designator;
        parser.chkreturn  := chkreturn;
        parser.create     := create

        RETURN parser
    END create;


PROCEDURE init* (options: PROG.OPTIONS);
    BEGIN
        PROG.create(options);
        parsers := C.create();
        lines   := 0;
        modules := 0
    END init;


END PARS.