WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/PARS.ob07


(*
    BSD 2-Clause License
 
    Copyright (c) 2018-2019, Anton Krotov
    All rights reserved.
*)
 
MODULE PARS;
 
IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
 
 
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: 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
 
    program*: PROG.PROGRAM;
 
    parsers: C.COLLECTION;
 
    lines*: 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) & (program.target.sys = mConst.Target_iMSP430) THEN
        IF parser.lex.sym = SCAN.lxFLOAT THEN
            errno := -SCAN.lxERROR13
        ELSIF (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
        |SCAN.lxSTRING:  err := 66
        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
    name:    SCAN.IDENT;
    parser2: PARSER;
    pos:     POSITION;
    alias:   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);
 
        IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
            alias := FALSE;
            unit := PROG.getUnit(program, name);
 
            IF unit # NIL THEN
                check(unit.closed, pos, 31)
            ELSE
                parser2 := parser.create(parser.path, parser.lib_path,
                    parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
 
                IF ~parser2.open(parser2, name.s) THEN
                    IF parser.path # parser.lib_path 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.s), pos, 29)
                    ELSE
                        error(pos, 29)
                    END
                END;
 
                parser2.parse(parser2);
                unit := parser2.unit;
                destroy(parser2)
            END;
            IF unit = 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.LEXSTR;
    string1, string2: SCAN.IDENT;
    bool: BOOLEAN;
 
BEGIN
 
    IF v.typ = ARITH.tCHAR THEN
        ASSERT(v2.typ = ARITH.tSTRING);
        ARITH.charToStr(v, str);
        string1 := SCAN.enterid(str);
        string2 := v2.string(SCAN.IDENT)
    END;
 
    IF v2.typ = ARITH.tCHAR THEN
        ASSERT(v.typ = ARITH.tSTRING);
        ARITH.charToStr(v2, str);
        string2 := SCAN.enterid(str);
        string1 := v.string(SCAN.IDENT)
    END;
 
    IF v.typ = v2.typ THEN
        string1 := v.string(SCAN.IDENT);
        string2 := v2.string(SCAN.IDENT)
    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_;
 
    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);
                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(program, PROG.tARRAY, -1, 0, parser.unit);
                    t1.base := t0;
                    t0 := t1;
                    DEC(dim)
                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
    IF parser.lex.s = "stdcall" THEN
        sf := PROG.sf_stdcall
    ELSIF parser.lex.s = "stdcall64" THEN
        sf := PROG.sf_stdcall64
    ELSIF parser.lex.s = "ccall" THEN
        sf := PROG.sf_ccall
    ELSIF parser.lex.s = "ccall16" THEN
        sf := PROG.sf_ccall16
    ELSIF parser.lex.s = "win64" THEN
        sf := PROG.sf_win64
    ELSIF parser.lex.s = "systemv" THEN
        sf := PROG.sf_systemv
    ELSIF parser.lex.s = "windows" THEN
        sf := PROG.sf_windows
    ELSIF parser.lex.s = "linux" THEN
        sf := PROG.sf_linux
    ELSIF parser.lex.s = "code" THEN
        sf := PROG.sf_code
    ELSIF parser.lex.s = "noalign" THEN
        sf := PROG.sf_noalign
    ELSE
        check1(FALSE, parser, 124)
    END;
 
    check1(sf IN program.target.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_stdcall64:
        res := PROG.stdcall64
    |PROG.sf_ccall:
        res := PROG.ccall
    |PROG.sf_ccall16:
        res := PROG.ccall16
    |PROG.sf_win64:
        res := PROG.win64
    |PROG.sf_systemv:
        res := PROG.systemv
    |PROG.sf_code:
        res := PROG.code
    |PROG.sf_windows:
        IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
            res := PROG.stdcall
        ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
            res := PROG.win64
        END
    |PROG.sf_linux:
        IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
            res := PROG.ccall16
        ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} 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.LEXSTR;
    pos: POSITION;
 
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 THEN
            checklex(parser, SCAN.lxRSQUARE)
        END;
        IF parser.sym = SCAN.lxCOMMA THEN
            ExpectSym(parser, SCAN.lxSTRING);
            dll := parser.lex.s;
            ExpectSym(parser, SCAN.lxCOMMA);
            ExpectSym(parser, SCAN.lxSTRING);
            proc := parser.lex.s;
            Next(parser);
            import := IL.AddImp(dll, proc)
        END;
        checklex(parser, SCAN.lxRSQUARE);
        Next(parser)
    ELSE
        CASE program.target.bit_depth OF
        |16: call := PROG.default16
        |32: call := PROG.default32
        |64: call := PROG.default64
        END
    END;
 
    IF import # NIL THEN
        check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
            mConst.Target_iELFSO64, mConst.Target_iMSP430}), 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(program, 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(program, 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 := 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(program, PROG.tPOINTER, program.target.adr, 0, unit);
        t.align := program.target.adr;
 
        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(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
        t.align := program.target.adr;
        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(program, 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;
        variables:  LISTS.LIST;
        int, flt:   INTEGER;
        comma:      BOOLEAN;
        code:       ARITH.VALUE;
        codeProc:   BOOLEAN;
 
    BEGIN
        endmod := FALSE;
 
        unit := parser.unit;
 
        call := procflag(parser, import, TRUE);
 
        getpos(parser, pos);
        pos1 := pos;
        checklex(parser, SCAN.lxIDENT);
 
        IF import # NIL THEN
            proc := IdentDef(parser, PROG.idIMP, name);
            proc.import := import;
            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(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
        t := proc.type;
        t.align := program.target.adr;
        t.call  := call;
 
        FormalParameters(parser, t);
 
        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
        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 program.target.sys # mConst.Target_iMSP430 THEN
                    check(ARITH.range(code, 0, 255), pos2, 42)
                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 & program.dll THEN
                IF program.obj 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;
 
            program.locsize := 0;
            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
 
            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), program.locsize,
                    t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
                enter.param2 := program.locsize;
                checklex(parser, SCAN.lxEND)
            ELSE
                proc.proc.leave := IL.LeaveC()
            END;
 
            IF program.target.sys = mConst.Target_iMSP430 THEN
                check((enter.param2 * ORD(~codeProc) + proc.type.parSize) * 2 + 16 < program.target.options.ram, pos1, 63)
            END
        END;
 
        IF parser.sym = SCAN.lxEND THEN
            ExpectSym(parser, SCAN.lxIDENT);
            getpos(parser, pos);
            endname := parser.lex.ident;
            IF ~codeProc & (import = NIL) THEN
                check(endname = name, pos, 60);
                ExpectSym(parser, SCAN.lxSEMI);
                Next(parser)
            ELSE
                IF endname = parser.unit.name THEN
                    ExpectSym(parser, SCAN.lxPOINT);
                    Next(parser);
                    endmod := TRUE
                ELSIF endname = name THEN
                    ExpectSym(parser, SCAN.lxSEMI);
                    Next(parser)
                ELSE
                    error(pos, 60)
                END
            END
        END;
 
        IF ~codeProc & (import = NIL) THEN
            variables := LISTS.create(NIL);
        ELSE
            variables := NIL
        END;
 
        PROG.closeScope(unit, variables);
 
        IF ~codeProc & (import = NIL) THEN
            enter.variables := variables
        END
 
        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;
 
BEGIN
    ASSERT(parser # NIL);
    ASSERT(parser.scanner # NIL);
 
    ExpectSym(parser, SCAN.lxMODULE);
    ExpectSym(parser, SCAN.lxIDENT);
 
    IF ~parser.main THEN
        check1(parser.lex.s = parser.modname, parser, 23)
    END;
 
    unit := PROG.newUnit(program, parser.lex.ident);
 
    parser.unit := unit;
 
    ExpectSym(parser, SCAN.lxSEMI);
 
    Next(parser);
    IF parser.sym = SCAN.lxIMPORT THEN
        ImportList(parser)
    END;
 
    CONSOLE.String("compiling "); CONSOLE.String(unit.name.s);
    IF parser.unit.sysimport THEN
        CONSOLE.String(" (SYSTEM)")
    END;
    CONSOLE.Ln;
 
    label := IL.NewLabel();
    IL.AddJmpCmd(IL.opJMP, label);
 
    name := IL.putstr(unit.name.s);
 
    errlabel := IL.NewLabel();
    IL.SetLabel(errlabel);
    IL.StrAdr(name);
    IL.Param1;
    IL.AddCmd0(IL.opERR);
 
    FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
        IL.SetErrLabel(errno);
        IL.AddCmd(IL.opPUSHC, errno);
        IL.AddJmpCmd(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.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: ARRAY OF CHAR): BOOLEAN;
BEGIN
    ASSERT(parser # NIL);
 
    STRINGS.append(parser.fname, modname);
    STRINGS.append(parser.fname, parser.ext);
    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      := mConst.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* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
BEGIN
    program := PROG.create(bit_depth, target, options);
    parsers := C.create();
    lines   := 0
END init;
 
 
END PARS.

Rev 7693	Rev 7696
1	(*	1	(*
2	BSD 2-Clause License	2	BSD 2-Clause License
3		3
4	Copyright (c) 2018, 2019, Anton Krotov	4	Copyright (c) 2018-2019, Anton Krotov
5	All rights reserved.	5	All rights reserved.
6	*)	6	*)
7		7
8	MODULE PARS;	8	MODULE PARS;
9		9
10	IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;	10	IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
11		11
12		12
13	CONST	13	CONST
14		14
15	eCONST* = 1; eTYPE* = 2; eVAR* = 3; eEXPR* = 4;	15	eCONST* = 1; eTYPE* = 2; eVAR* = 3; eEXPR* = 4;
16	eVREC* = 5; ePROC* = 6; eVPAR* = 7; ePARAM* = 8;	16	eVREC* = 5; ePROC* = 6; eVPAR* = 7; ePARAM* = 8;
17	eSTPROC* = 9; eSTFUNC* = 10; eSYSFUNC* = 11; eSYSPROC* = 12;	17	eSTPROC* = 9; eSTFUNC* = 10; eSYSFUNC* = 11; eSYSPROC* = 12;
18	eIMP* = 13;	18	eIMP* = 13;
19		19
20		20
21	TYPE	21	TYPE
22		22
23	PATH* = PATHS.PATH;	23	PATH* = PATHS.PATH;
24		24
25	PARSER* = POINTER TO rPARSER;	25	PARSER* = POINTER TO rPARSER;
26		26
27	POSITION* = RECORD (SCAN.POSITION)	27	POSITION* = RECORD (SCAN.POSITION)
28		28
29	parser*: PARSER	29	parser*: PARSER
30		30
31	END;	31	END;
32		32
33	EXPR* = RECORD	33	EXPR* = RECORD
34		34
35	obj*: INTEGER;	35	obj*: INTEGER;
36	type*: PROG.TYPE_;	36	type*: PROG.TYPE_;
37	value*: ARITH.VALUE;	37	value*: ARITH.VALUE;
38	stproc*: INTEGER;	38	stproc*: INTEGER;
39	readOnly*: BOOLEAN;	39	readOnly*: BOOLEAN;
40	ident*: PROG.IDENT	40	ident*: PROG.IDENT
41		41
42	END;	42	END;
43		43
44	STATPROC = PROCEDURE (parser: PARSER);	44	STATPROC = PROCEDURE (parser: PARSER);
45	EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);	45	EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR);
46	RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;	46	RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
47		47
48	rPARSER = RECORD (C.ITEM)	48	rPARSER = RECORD (C.ITEM)
49		49
50	fname*: PATH;	50	fname*: PATH;
51	path: PATH;	51	path: PATH;
52	lib_path: PATH;	52	lib_path: PATH;
53	ext: PATH;	53	ext: PATH;
54	modname: PATH;	54	modname: PATH;
55	scanner: SCAN.SCANNER;	55	scanner: SCAN.SCANNER;
56	lex*: SCAN.LEX;	56	lex*: SCAN.LEX;
57	sym*: INTEGER;	57	sym*: INTEGER;
58	unit*: PROG.UNIT;	58	unit*: PROG.UNIT;
59	constexp*: BOOLEAN;	59	constexp*: BOOLEAN;
60	main*: BOOLEAN;	60	main*: BOOLEAN;
61		61
62	open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;	62	open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
63	parse*: PROCEDURE (parser: PARSER);	63	parse*: PROCEDURE (parser: PARSER);
64	StatSeq*: STATPROC;	64	StatSeq*: STATPROC;
65	expression*: EXPRPROC;	65	expression*: EXPRPROC;
66	designator*: EXPRPROC;	66	designator*: EXPRPROC;
67	chkreturn: RETPROC;	67	chkreturn: RETPROC;
68		68
69	create*: PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER	69	create*: PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER
70		70
71	END;	71	END;
72		72
73		73
74	VAR	74	VAR
75		75
76	program*: PROG.PROGRAM;	76	program*: PROG.PROGRAM;
77		77
78	parsers: C.COLLECTION;	78	parsers: C.COLLECTION;
-		79
-		80	lines*: INTEGER;
79		81
80		82
81	PROCEDURE destroy* (VAR parser: PARSER);	83	PROCEDURE destroy* (VAR parser: PARSER);
82	BEGIN	84	BEGIN
83	IF parser.scanner # NIL THEN	85	IF parser.scanner # NIL THEN
84	SCAN.close(parser.scanner)	86	SCAN.close(parser.scanner)
85	END;	87	END;
86		88
87	C.push(parsers, parser);	89	C.push(parsers, parser);
88	parser := NIL	90	parser := NIL
89	END destroy;	91	END destroy;
90		92
91		93
92	PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);	94	PROCEDURE getpos (parser: PARSER; VAR pos: POSITION);
93	BEGIN	95	BEGIN
94	pos.line := parser.lex.pos.line;	96	pos.line := parser.lex.pos.line;
95	pos.col := parser.lex.pos.col;	97	pos.col := parser.lex.pos.col;
96	pos.parser := parser	98	pos.parser := parser
97	END getpos;	99	END getpos;
98		100
99		101
100	PROCEDURE error* (pos: POSITION; errno: INTEGER);	102	PROCEDURE error* (pos: POSITION; errno: INTEGER);
101	BEGIN	103	BEGIN
102	ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)	104	ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
103	END error;	105	END error;
104		106
105		107
106	PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);	108	PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
107	BEGIN	109	BEGIN
108	IF ~condition THEN	110	IF ~condition THEN
109	error(pos, errno)	111	error(pos, errno)
110	END	112	END
111	END check;	113	END check;
112		114
113		115
114	PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);	116	PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
115	VAR	117	VAR
116	pos: POSITION;	118	pos: POSITION;
117		119
118	BEGIN	120	BEGIN
119	IF ~condition THEN	121	IF ~condition THEN
120	getpos(parser, pos);	122	getpos(parser, pos);
121	error(pos, errno)	123	error(pos, errno)
122	END	124	END
123	END check1;	125	END check1;
124		126
125		127
126	PROCEDURE Next* (parser: PARSER);	128	PROCEDURE Next* (parser: PARSER);
127	VAR	129	VAR
128	errno: INTEGER;	130	errno: INTEGER;
129		131
130	BEGIN	132	BEGIN
131	SCAN.Next(parser.scanner, parser.lex);	133	SCAN.Next(parser.scanner, parser.lex);
132	errno := parser.lex.error;	134	errno := parser.lex.error;
133	IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN	135	IF (errno = 0) & (program.target.sys = mConst.Target_iMSP430) THEN
134	IF parser.lex.sym = SCAN.lxFLOAT THEN	136	IF parser.lex.sym = SCAN.lxFLOAT THEN
135	errno := -SCAN.lxERROR13	137	errno := -SCAN.lxERROR13
136	ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN	138	ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
137	errno := -SCAN.lxERROR10	139	errno := -SCAN.lxERROR10
138	END	140	END
139	END;	141	END;
140		142
141	IF errno # 0 THEN	143	IF errno # 0 THEN
142	check1(FALSE, parser, errno)	144	check1(FALSE, parser, errno)
143	END;	145	END;
144	parser.sym := parser.lex.sym	146	parser.sym := parser.lex.sym
145	END Next;	147	END Next;
146		148
147		149
148	PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);	150	PROCEDURE NextPos (parser: PARSER; VAR pos: POSITION);
149	BEGIN	151	BEGIN
150	Next(parser);	152	Next(parser);
151	getpos(parser, pos)	153	getpos(parser, pos)
152	END NextPos;	154	END NextPos;
153		155
154		156
155	PROCEDURE checklex* (parser: PARSER; sym: INTEGER);	157	PROCEDURE checklex* (parser: PARSER; sym: INTEGER);
156	VAR	158	VAR
157	err: INTEGER;	159	err: INTEGER;
158		160
159	BEGIN	161	BEGIN
160		162
161	IF parser.sym # sym THEN	163	IF parser.sym # sym THEN
162		164
163	CASE sym OF	165	CASE sym OF
164	\|SCAN.lxCOMMA: err := 65	166	\|SCAN.lxCOMMA: err := 65
165	\|SCAN.lxRROUND: err := 33	167	\|SCAN.lxRROUND: err := 33
166	\|SCAN.lxPOINT: err := 26	168	\|SCAN.lxPOINT: err := 26
167	\|SCAN.lxIDENT: err := 22	169	\|SCAN.lxIDENT: err := 22
168	\|SCAN.lxRSQUARE: err := 71	170	\|SCAN.lxRSQUARE: err := 71
169	\|SCAN.lxRCURLY: err := 35	171	\|SCAN.lxRCURLY: err := 35
170	\|SCAN.lxUNDEF: err := 34	172	\|SCAN.lxUNDEF: err := 34
171	\|SCAN.lxTHEN: err := 88	173	\|SCAN.lxTHEN: err := 88
172	\|SCAN.lxEND: err := 27	174	\|SCAN.lxEND: err := 27
173	\|SCAN.lxDO: err := 89	175	\|SCAN.lxDO: err := 89
174	\|SCAN.lxUNTIL: err := 90	176	\|SCAN.lxUNTIL: err := 90
175	\|SCAN.lxCOLON: err := 53	177	\|SCAN.lxCOLON: err := 53
176	\|SCAN.lxOF: err := 67	178	\|SCAN.lxOF: err := 67
177	\|SCAN.lxASSIGN: err := 96	179	\|SCAN.lxASSIGN: err := 96
178	\|SCAN.lxTO: err := 57	180	\|SCAN.lxTO: err := 57
179	\|SCAN.lxLROUND: err := 64	181	\|SCAN.lxLROUND: err := 64
180	\|SCAN.lxEQ: err := 32	182	\|SCAN.lxEQ: err := 32
181	\|SCAN.lxSEMI: err := 24	183	\|SCAN.lxSEMI: err := 24
182	\|SCAN.lxRETURN: err := 38	184	\|SCAN.lxRETURN: err := 38
183	\|SCAN.lxMODULE: err := 21	185	\|SCAN.lxMODULE: err := 21
184	\|SCAN.lxSTRING: err := 66	186	\|SCAN.lxSTRING: err := 66
185	END;	187	END;
186		188
187	check1(FALSE, parser, err)	189	check1(FALSE, parser, err)
188	END	190	END
189	END checklex;	191	END checklex;
190		192
191		193
192	PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);	194	PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER);
193	BEGIN	195	BEGIN
194	Next(parser);	196	Next(parser);
195	checklex(parser, sym)	197	checklex(parser, sym)
196	END ExpectSym;	198	END ExpectSym;
197		199
198		200
199	PROCEDURE ImportList (parser: PARSER);	201	PROCEDURE ImportList (parser: PARSER);
200	VAR	202	VAR
201	name: SCAN.IDENT;	203	name: SCAN.IDENT;
202	parser2: PARSER;	204	parser2: PARSER;
203	pos: POSITION;	205	pos: POSITION;
204	alias: BOOLEAN;	206	alias: BOOLEAN;
205	unit: PROG.UNIT;	207	unit: PROG.UNIT;
206	ident: PROG.IDENT;	208	ident: PROG.IDENT;
207		209
208	BEGIN	210	BEGIN
209	alias := FALSE;	211	alias := FALSE;
210		212
211	REPEAT	213	REPEAT
212		214
213	ExpectSym(parser, SCAN.lxIDENT);	215	ExpectSym(parser, SCAN.lxIDENT);
214	name := parser.lex.ident;	216	name := parser.lex.ident;
215		217
216	getpos(parser, pos);	218	getpos(parser, pos);
217		219
218	IF ~alias THEN	220	IF ~alias THEN
219	ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);	221	ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
220	check(ident # NIL, pos, 30)	222	check(ident # NIL, pos, 30)
221	END;	223	END;
222		224
223	Next(parser);	225	Next(parser);
224		226
225	IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN	227	IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
226	alias := FALSE;	228	alias := FALSE;
227	unit := PROG.getUnit(program, name);	229	unit := PROG.getUnit(program, name);
228		230
229	IF unit # NIL THEN	231	IF unit # NIL THEN
230	check(unit.closed, pos, 31)	232	check(unit.closed, pos, 31)
231	ELSE	233	ELSE
232	parser2 := parser.create(parser.path, parser.lib_path,	234	parser2 := parser.create(parser.path, parser.lib_path,
233	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);	235	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
234		236
235	IF ~parser2.open(parser2, name.s) THEN	237	IF ~parser2.open(parser2, name.s) THEN
236	IF parser.path # parser.lib_path THEN	238	IF parser.path # parser.lib_path THEN
237	destroy(parser2);	239	destroy(parser2);
238	parser2 := parser.create(parser.lib_path, parser.lib_path,	240	parser2 := parser.create(parser.lib_path, parser.lib_path,
239	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);	241	parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
240	check(parser2.open(parser2, name.s), pos, 29)	242	check(parser2.open(parser2, name.s), pos, 29)
241	ELSE	243	ELSE
242	error(pos, 29)	244	error(pos, 29)
243	END	245	END
244	END;	246	END;
245		247
246	parser2.parse(parser2);	248	parser2.parse(parser2);
247	unit := parser2.unit;	249	unit := parser2.unit;
248	destroy(parser2)	250	destroy(parser2)
249	END;	251	END;
250	IF unit = program.sysunit THEN	252	IF unit = program.sysunit THEN
251	parser.unit.sysimport := TRUE	253	parser.unit.sysimport := TRUE
252	END;	254	END;
253	ident.unit := unit	255	ident.unit := unit
254		256
255	ELSIF parser.sym = SCAN.lxASSIGN THEN	257	ELSIF parser.sym = SCAN.lxASSIGN THEN
256	alias := TRUE	258	alias := TRUE
257		259
258	ELSE	260	ELSE
259	check1(FALSE, parser, 28)	261	check1(FALSE, parser, 28)
260	END	262	END
261		263
262	UNTIL parser.sym = SCAN.lxSEMI;	264	UNTIL parser.sym = SCAN.lxSEMI;
263		265
264	Next(parser)	266	Next(parser)
265		267
266	END ImportList;	268	END ImportList;
267		269
268		270
269	PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;	271	PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT;
270	VAR	272	VAR
271	ident: PROG.IDENT;	273	ident: PROG.IDENT;
272	unit: PROG.UNIT;	274	unit: PROG.UNIT;
273		275
274	BEGIN	276	BEGIN
275	ASSERT(parser.sym = SCAN.lxIDENT);	277	ASSERT(parser.sym = SCAN.lxIDENT);
276		278
277	ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);	279	ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
278		280
279	IF ~forward THEN	281	IF ~forward THEN
280	check1(ident # NIL, parser, 48)	282	check1(ident # NIL, parser, 48)
281	END;	283	END;
282		284
283	IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN	285	IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN
284	unit := ident.unit;	286	unit := ident.unit;
285	ExpectSym(parser, SCAN.lxPOINT);	287	ExpectSym(parser, SCAN.lxPOINT);
286	ExpectSym(parser, SCAN.lxIDENT);	288	ExpectSym(parser, SCAN.lxIDENT);
287	ident := PROG.getIdent(unit, parser.lex.ident, FALSE);	289	ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
288	check1((ident # NIL) & ident.export, parser, 48)	290	check1((ident # NIL) & ident.export, parser, 48)
289	END	291	END
290		292
291	RETURN ident	293	RETURN ident
292	END QIdent;	294	END QIdent;
293		295
294		296
295	PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);	297	PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
296	VAR	298	VAR
297	str: SCAN.LEXSTR;	299	str: SCAN.LEXSTR;
298	string1, string2: SCAN.IDENT;	300	string1, string2: SCAN.IDENT;
299	bool: BOOLEAN;	301	bool: BOOLEAN;
300		302
301	BEGIN	303	BEGIN
302		304
303	IF v.typ = ARITH.tCHAR THEN	305	IF v.typ = ARITH.tCHAR THEN
304	ASSERT(v2.typ = ARITH.tSTRING);	306	ASSERT(v2.typ = ARITH.tSTRING);
305	ARITH.charToStr(v, str);	307	ARITH.charToStr(v, str);
306	string1 := SCAN.enterid(str);	308	string1 := SCAN.enterid(str);
307	string2 := v2.string(SCAN.IDENT)	309	string2 := v2.string(SCAN.IDENT)
308	END;	310	END;
309		311
310	IF v2.typ = ARITH.tCHAR THEN	312	IF v2.typ = ARITH.tCHAR THEN
311	ASSERT(v.typ = ARITH.tSTRING);	313	ASSERT(v.typ = ARITH.tSTRING);
312	ARITH.charToStr(v2, str);	314	ARITH.charToStr(v2, str);
313	string2 := SCAN.enterid(str);	315	string2 := SCAN.enterid(str);
314	string1 := v.string(SCAN.IDENT)	316	string1 := v.string(SCAN.IDENT)
315	END;	317	END;
316		318
317	IF v.typ = v2.typ THEN	319	IF v.typ = v2.typ THEN
318	string1 := v.string(SCAN.IDENT);	320	string1 := v.string(SCAN.IDENT);
319	string2 := v2.string(SCAN.IDENT)	321	string2 := v2.string(SCAN.IDENT)
320	END;	322	END;
321		323
322	CASE operator OF	324	CASE operator OF
323	\|SCAN.lxEQ: bool := string1.s = string2.s	325	\|SCAN.lxEQ: bool := string1.s = string2.s
324	\|SCAN.lxNE: bool := string1.s # string2.s	326	\|SCAN.lxNE: bool := string1.s # string2.s
325	\|SCAN.lxLT: bool := string1.s < string2.s	327	\|SCAN.lxLT: bool := string1.s < string2.s
326	\|SCAN.lxGT: bool := string1.s > string2.s	328	\|SCAN.lxGT: bool := string1.s > string2.s
327	\|SCAN.lxLE: bool := string1.s <= string2.s	329	\|SCAN.lxLE: bool := string1.s <= string2.s
328	\|SCAN.lxGE: bool := string1.s >= string2.s	330	\|SCAN.lxGE: bool := string1.s >= string2.s
329	END;	331	END;
330		332
331	ARITH.setbool(v, bool)	333	ARITH.setbool(v, bool)
332	END strcmp;	334	END strcmp;
333		335
334		336
335	PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);	337	PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
336	VAR	338	VAR
337	e: EXPR;	339	e: EXPR;
338	pos: POSITION;	340	pos: POSITION;
339		341
340	BEGIN	342	BEGIN
341	getpos(parser, pos);	343	getpos(parser, pos);
342	parser.constexp := TRUE;	344	parser.constexp := TRUE;
343	parser.expression(parser, e);	345	parser.expression(parser, e);
344	parser.constexp := FALSE;	346	parser.constexp := FALSE;
345	check(e.obj = eCONST, pos, 62);	347	check(e.obj = eCONST, pos, 62);
346	v := e.value	348	v := e.value
347	END ConstExpression;	349	END ConstExpression;
348		350
349		351
350	PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);	352	PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
351	VAR	353	VAR
352	name: SCAN.IDENT;	354	name: SCAN.IDENT;
353	export: BOOLEAN;	355	export: BOOLEAN;
354	pos: POSITION;	356	pos: POSITION;
355		357
356	BEGIN	358	BEGIN
357	ASSERT(parser.sym = SCAN.lxIDENT);	359	ASSERT(parser.sym = SCAN.lxIDENT);
358		360
359	WHILE parser.sym = SCAN.lxIDENT DO	361	WHILE parser.sym = SCAN.lxIDENT DO
360		362
361	getpos(parser, pos);	363	getpos(parser, pos);
362		364
363	name := parser.lex.ident;	365	name := parser.lex.ident;
364		366
365	Next(parser);	367	Next(parser);
366		368
367	export := parser.sym = SCAN.lxMUL;	369	export := parser.sym = SCAN.lxMUL;
368		370
369	IF export THEN	371	IF export THEN
370	check1(parser.unit.scopeLvl = 0, parser, 61);	372	check1(parser.unit.scopeLvl = 0, parser, 61);
371	Next(parser)	373	Next(parser)
372	END;	374	END;
373		375
374	check(PROG.addField(rec, name, export), pos, 30);	376	check(PROG.addField(rec, name, export), pos, 30);
375		377
376	IF parser.sym = SCAN.lxCOMMA THEN	378	IF parser.sym = SCAN.lxCOMMA THEN
377	ExpectSym(parser, SCAN.lxIDENT)	379	ExpectSym(parser, SCAN.lxIDENT)
378	ELSE	380	ELSE
379	checklex(parser, SCAN.lxCOLON)	381	checklex(parser, SCAN.lxCOLON)
380	END	382	END
381		383
382	END	384	END
383		385
384	END FieldList;	386	END FieldList;
385		387
386		388
387	PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);	389	PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_);
388	VAR	390	VAR
389	ident: PROG.IDENT;	391	ident: PROG.IDENT;
390		392
391		393
392	PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);	394	PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_);
393	VAR	395	VAR
394	ident: PROG.IDENT;	396	ident: PROG.IDENT;
395	exit: BOOLEAN;	397	exit: BOOLEAN;
396	vPar: BOOLEAN;	398	vPar: BOOLEAN;
397	dim: INTEGER;	399	dim: INTEGER;
398	t0, t1: PROG.TYPE_;	400	t0, t1: PROG.TYPE_;
399		401
400	BEGIN	402	BEGIN
401	vPar := parser.sym = SCAN.lxVAR;	403	vPar := parser.sym = SCAN.lxVAR;
402	IF vPar THEN	404	IF vPar THEN
403	Next(parser)	405	Next(parser)
404	END;	406	END;
405		407
406	checklex(parser, SCAN.lxIDENT);	408	checklex(parser, SCAN.lxIDENT);
407	exit := FALSE;	409	exit := FALSE;
408		410
409	WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO	411	WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
410	check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);	412	check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
411	Next(parser);	413	Next(parser);
412	IF parser.sym = SCAN.lxCOMMA THEN	414	IF parser.sym = SCAN.lxCOMMA THEN
413	ExpectSym(parser, SCAN.lxIDENT)	415	ExpectSym(parser, SCAN.lxIDENT)
414	ELSIF parser.sym = SCAN.lxCOLON THEN	416	ELSIF parser.sym = SCAN.lxCOLON THEN
415	Next(parser);	417	Next(parser);
416	dim := 0;	418	dim := 0;
417	WHILE parser.sym = SCAN.lxARRAY DO	419	WHILE parser.sym = SCAN.lxARRAY DO
418	INC(dim);	420	INC(dim);
419	check1(dim <= PROG.MAXARRDIM, parser, 84);	421	check1(dim <= PROG.MAXARRDIM, parser, 84);
420	ExpectSym(parser, SCAN.lxOF);	422	ExpectSym(parser, SCAN.lxOF);
421	Next(parser)	423	Next(parser)
422	END;	424	END;
423	checklex(parser, SCAN.lxIDENT);	425	checklex(parser, SCAN.lxIDENT);
424	ident := QIdent(parser, FALSE);	426	ident := QIdent(parser, FALSE);
425	check1(ident.typ = PROG.idTYPE, parser, 68);	427	check1(ident.typ = PROG.idTYPE, parser, 68);
426		428
427	t0 := ident.type;	429	t0 := ident.type;
428	t1 := t0;	430	t1 := t0;
429		431
430	WHILE dim > 0 DO	432	WHILE dim > 0 DO
431	t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);	433	t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
432	t1.base := t0;	434	t1.base := t0;
433	t0 := t1;	435	t0 := t1;
434	DEC(dim)	436	DEC(dim)
435	END;	437	END;
436		438
437	PROG.setParams(type, t1);	439	PROG.setParams(type, t1);
438	Next(parser);	440	Next(parser);
439	exit := TRUE	441	exit := TRUE
440	ELSE	442	ELSE
441	checklex(parser, SCAN.lxCOLON)	443	checklex(parser, SCAN.lxCOLON)
442	END	444	END
443	END	445	END
444		446
445	END FPSection;	447	END FPSection;
446		448
447		449
448	BEGIN	450	BEGIN
449	IF parser.sym = SCAN.lxLROUND THEN	451	IF parser.sym = SCAN.lxLROUND THEN
450		452
451	Next(parser);	453	Next(parser);
452		454
453	IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN	455	IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN
454	FPSection(parser, type);	456	FPSection(parser, type);
455	WHILE parser.sym = SCAN.lxSEMI DO	457	WHILE parser.sym = SCAN.lxSEMI DO
456	Next(parser);	458	Next(parser);
457	FPSection(parser, type)	459	FPSection(parser, type)
458	END	460	END
459	END;	461	END;
460		462
461	checklex(parser, SCAN.lxRROUND);	463	checklex(parser, SCAN.lxRROUND);
462	Next(parser);	464	Next(parser);
463		465
464	IF parser.sym = SCAN.lxCOLON THEN	466	IF parser.sym = SCAN.lxCOLON THEN
465	ExpectSym(parser, SCAN.lxIDENT);	467	ExpectSym(parser, SCAN.lxIDENT);
466	ident := QIdent(parser, FALSE);	468	ident := QIdent(parser, FALSE);
467	check1(ident.typ = PROG.idTYPE, parser, 68);	469	check1(ident.typ = PROG.idTYPE, parser, 68);
468	check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);	470	check1(~(ident.type.typ IN {PROG.tRECORD, PROG.tARRAY}), parser, 69);
469	check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);	471	check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113);
470	type.base := ident.type;	472	type.base := ident.type;
471	Next(parser)	473	Next(parser)
472	ELSE	474	ELSE
473	type.base := NIL	475	type.base := NIL
474	END	476	END
475		477
476	END	478	END
477	END FormalParameters;	479	END FormalParameters;
478		480
479		481
480	PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;	482	PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
481	VAR	483	VAR
482	res, sf: INTEGER;	484	res, sf: INTEGER;
483		485
484	BEGIN	486	BEGIN
485	IF parser.lex.s = "stdcall" THEN	487	IF parser.lex.s = "stdcall" THEN
486	sf := PROG.sf_stdcall	488	sf := PROG.sf_stdcall
487	ELSIF parser.lex.s = "stdcall64" THEN	489	ELSIF parser.lex.s = "stdcall64" THEN
488	sf := PROG.sf_stdcall64	490	sf := PROG.sf_stdcall64
489	ELSIF parser.lex.s = "ccall" THEN	491	ELSIF parser.lex.s = "ccall" THEN
490	sf := PROG.sf_ccall	492	sf := PROG.sf_ccall
491	ELSIF parser.lex.s = "ccall16" THEN	493	ELSIF parser.lex.s = "ccall16" THEN
492	sf := PROG.sf_ccall16	494	sf := PROG.sf_ccall16
493	ELSIF parser.lex.s = "win64" THEN	495	ELSIF parser.lex.s = "win64" THEN
494	sf := PROG.sf_win64	496	sf := PROG.sf_win64
495	ELSIF parser.lex.s = "systemv" THEN	497	ELSIF parser.lex.s = "systemv" THEN
496	sf := PROG.sf_systemv	498	sf := PROG.sf_systemv
497	ELSIF parser.lex.s = "windows" THEN	499	ELSIF parser.lex.s = "windows" THEN
498	sf := PROG.sf_windows	500	sf := PROG.sf_windows

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/PARS.ob07 – Rev 7693 → 7696