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

     All rights reserved.
 *)
 MODULE PARS;
-IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS;
+IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS, C := COLLECTIONS, mConst := CONSTANTS;
     PATH* = PATHS.PATH;
+    PARSER* = POINTER TO rPARSER;
+    POSITION* = RECORD (SCAN.POSITION)
+        parser*: PARSER
-    PARSER* = POINTER TO rPARSER;
+    END;
     EXPR* = RECORD
     END;
     STATPROC  = PROCEDURE (parser: PARSER);
     EXPRPROC  = PROCEDURE (parser: PARSER; VAR e: EXPR);
-    RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN;
+    RETPROC   = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: POSITION): BOOLEAN;
     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* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
+PROCEDURE error* (pos: POSITION; errno: INTEGER);
 BEGIN
-    ERRORS.errormsg(parser.fname, pos.line, pos.col, errno)
+    ERRORS.ErrorMsg(pos.parser.fname, pos.line, pos.col, errno)
 END error;
-PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER);
+PROCEDURE check* (condition: BOOLEAN; pos: POSITION; errno: INTEGER);
 BEGIN
     IF ~condition THEN
+        error(pos, errno)
+    END
+END check;
         error(parser, pos, errno)
     END
+PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
-END check;
+VAR
     pos: POSITION;
-PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER);
-BEGIN
-    IF ~condition THEN
-        error(parser, parser.lex.pos, errno)
-    END
-END check1;
 BEGIN
     IF ~condition THEN
-PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION);
+        getpos(parser, pos);
-BEGIN
+        error(pos, errno)
-    pos := parser.lex.pos
+    END
-END getpos;
+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
-PROCEDURE Next* (parser: PARSER);
+        IF parser.lex.sym = SCAN.lxFLOAT THEN
-VAR
+            errno := -SCAN.lxERROR13
-    errno: INTEGER;
+        ELSIF (parser.lex.sym = SCAN.lxCHAR) & (parser.lex.value.typ = ARITH.tWCHAR) THEN
+            errno := -SCAN.lxERROR10
-BEGIN
+        END
-    SCAN.Next(parser.scanner, parser.lex);
+    END;
-    errno := parser.lex.error;
     IF errno # 0 THEN
         check1(FALSE, parser, errno)
     END;
 PROCEDURE ImportList (parser: PARSER);
 VAR
-    name:       SCAN.IDENT;
+    name:    SCAN.IDENT;
-    parser2:    PARSER;
+    parser2: PARSER;
-    pos:        SCAN.POSITION;
+    pos:     POSITION;
-    alias:      BOOLEAN;
+    alias:   BOOLEAN;
-    unit:       PROG.UNIT;
+    unit:    PROG.UNIT;
-    ident:      PROG.IDENT;
-    units:      PROG.UNITS;
+    ident:   PROG.IDENT;
-BEGIN
     units := program.units;
 BEGIN
     alias := FALSE;
     REPEAT
         ExpectSym(parser, SCAN.lxIDENT);
         name := parser.lex.ident;
         getpos(parser, pos);
         IF ~alias THEN
-            ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE);
+            ident := PROG.addIdent(parser.unit, name, PROG.idMODULE);
-            check(ident # NIL, parser, pos, 30)
+            check(ident # NIL, pos, 30)
         END;
         Next(parser);
         IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
             alias := FALSE;
-            unit := units.get(units, name);
+            unit := PROG.getUnit(program, name);
             IF unit # NIL THEN
-                check(unit.closed, parser, pos, 31)
+                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
     unit:  PROG.UNIT;
 BEGIN
     ASSERT(parser.sym = SCAN.lxIDENT);
-    ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE);
+    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 := unit.idents.get(unit, parser.lex.ident, FALSE);
+        ident := PROG.getIdent(unit, parser.lex.ident, FALSE);
     |SCAN.lxLE: bool := string1.s <= string2.s
     |SCAN.lxGE: bool := string1.s >= string2.s
     END;
-    ARITH.setbool(v, bool)
     ARITH.setbool(v, bool)
 END strcmp;
 PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE);
 VAR
     e: EXPR;
-    pos: SCAN.POSITION;
+    pos: POSITION;
 BEGIN
     getpos(parser, pos);
     parser.constexp := TRUE;
     parser.expression(parser, e);
     parser.constexp := FALSE;
-    check(e.obj = eCONST, parser, pos, 62);
+    check(e.obj = eCONST, pos, 62);
     v := e.value
 END ConstExpression;
 PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_);
 VAR
         IF export THEN
             check1(parser.unit.scopeLvl = 0, parser, 61);
             Next(parser)
         END;
-        check(rec.fields.add(rec, name, export), parser, pos, 30);
+        check(PROG.addField(rec, name, export), pos, 30);
         IF parser.sym = SCAN.lxCOMMA THEN
             ExpectSym(parser, SCAN.lxIDENT)
         checklex(parser, SCAN.lxIDENT);
         exit := FALSE;
         WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO
-            check1(type.params.add(type, parser.lex.ident, vPar), parser, 30);
+            check1(PROG.addParam(type, parser.lex.ident, vPar), parser, 30);
             Next(parser);
             IF parser.sym = SCAN.lxCOMMA THEN
                 ExpectSym(parser, SCAN.lxIDENT)
                 t0 := ident.type;
                 t1 := t0;
                 WHILE dim > 0 DO
-                    t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
+                    t1 := PROG.enterType(program, PROG.tARRAY, -1, 0, parser.unit);
                     t1.base := t0;
                     t0 := t1;
                     DEC(dim)
                 END;
-                type.params.set(type, t1);
+                PROG.setParams(type, t1);
                 Next(parser);
                 exit := TRUE
         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 # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69);
+            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
     END
 END FormalParameters;
-PROCEDURE sysflag (parser: PARSER): INTEGER;
+PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
 VAR
-    res: INTEGER;
+    res, sf: INTEGER;
 BEGIN
     IF parser.lex.s = "stdcall" THEN
-        res := PROG.stdcall
+        sf := PROG.sf_stdcall
     ELSIF parser.lex.s = "stdcall64" THEN
-        res := PROG.stdcall64
+        sf := PROG.sf_stdcall64
     ELSIF parser.lex.s = "ccall" THEN
-        res := PROG.ccall
+        sf := PROG.sf_ccall
     ELSIF parser.lex.s = "ccall16" THEN
-        res := PROG.ccall16
+        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.win64
+        res := PROG.systemv
-    ELSIF parser.lex.s = "systemv" THEN
+    |PROG.sf_code:
-        res := PROG.systemv
+        res := PROG.code
-    ELSIF parser.lex.s = "windows" THEN
+    |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
+        IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN
-            res := PROG.win64
+            res := PROG.stdcall
-        ELSE
+        ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN
-            check1(FALSE, parser, 118)
+            res := PROG.win64
         END
-    ELSIF parser.lex.s = "linux" THEN
+    |PROG.sf_linux:
-        IF program.target.sys = mConst.Target_iELF32 THEN
-            res := PROG.ccall16
-        ELSIF program.target.sys = mConst.Target_iELF64 THEN
+        IF program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELFSO32} THEN
-            res := PROG.systemv
+            res := PROG.ccall16
-        ELSE
+        ELSIF program.target.sys IN {mConst.Target_iELF64, mConst.Target_iELFSO64} THEN
-            check1(FALSE, parser, 119)
-        END
-    ELSIF parser.lex.s = "noalign" THEN
+            res := PROG.systemv
-        res := PROG.noalign
+        END
-    ELSE
+    |PROG.sf_noalign:
-        res := 0
+        res := PROG.noalign
     END
     RETURN res
 END sysflag;
-PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
+PROCEDURE procflag (parser: PARSER; VAR import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
 VAR
     call: INTEGER;
     dll, proc: SCAN.LEXSTR;
-    pos:  SCAN.POSITION;
+    pos: POSITION;
-BEGIN
-    import := NIL;
     IF parser.sym = SCAN.lxLSQUARE THEN
-        getpos(parser, pos);
+BEGIN
         check1(parser.unit.sysimport, parser, 54);
-        Next(parser);
+    import := NIL;
         call := sysflag(parser);
             dll := parser.lex.s;
             ExpectSym(parser, SCAN.lxCOMMA);
             ExpectSym(parser, SCAN.lxSTRING);
             proc := parser.lex.s;
             Next(parser);
-            import := CODE.AddImp(dll, proc)
+            import := IL.AddImp(dll, proc)
         END;
         checklex(parser, SCAN.lxRSQUARE);
         Next(parser)
     ELSE
-        IF program.target.bit_depth = 32 THEN
+        CASE program.target.bit_depth OF
-            call := PROG.default
+        |16: call := PROG.default16
-        ELSIF program.target.bit_depth = 64 THEN
+        |32: call := PROG.default32
-            call := PROG.default64
+        |64: call := PROG.default64
         END
     END;
     IF import # NIL THEN
+        check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64, mConst.Target_iELFSO32,
-        check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70)
+            mConst.Target_iELFSO64, mConst.Target_iMSP430}), pos, 70)
     END
 VAR
     arrLen:     ARITH.VALUE;
     typeSize:   ARITH.VALUE;
     ident:      PROG.IDENT;
     unit:       PROG.UNIT;
-    pos, pos2:  SCAN.POSITION;
+    pos, pos2:  POSITION;
     fieldType:  PROG.TYPE_;
     baseIdent:  SCAN.IDENT;
     a, b:       INTEGER;
     RecFlag:    INTEGER;
-    import:     CODE.IMPORT_PROC;
+    import:     IL.IMPORT_PROC;
 BEGIN
     unit := parser.unit;
         END;
         NextPos(parser, pos);
         ConstExpression(parser, arrLen);
-        check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43);
+        check(arrLen.typ = ARITH.tINTEGER, pos, 43);
-        check(ARITH.check(arrLen),         parser, pos, 39);
+        check(ARITH.check(arrLen),         pos, 39);
-        check(ARITH.getInt(arrLen) > 0,    parser, pos, 51);
+        check(ARITH.getInt(arrLen) > 0,    pos, 51);
-        t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
+        t := PROG.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit);
         t.align := t.base.align;
         a := t.length;
         b := t.base.size;
-        check(ARITH.mulInt(a, b), parser, pos2, 104);
+        check(ARITH.mulInt(a, b), pos2, 104);
-        check(ARITH.setInt(typeSize, a), parser, 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 := program.enterType(program, PROG.tRECORD, 0, 0, unit);
+        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);
             IF RecFlag = PROG.noalign THEN
-                t.noalign := TRUE
+        IF parser.sym = SCAN.lxLSQUARE THEN
-            ELSE
+            check1(parser.unit.sysimport, parser, 54);
-                check1(FALSE, parser, 110)
+            Next(parser);
             ExpectSym(parser, SCAN.lxIDENT);
             getpos(parser, pos);
             type(parser, t.base, {closed});
-            check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52);
+            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, parser, pos, 55)
+                check(t.base # NIL, pos, 55)
             END;
             ASSERT(parser.sym = SCAN.lxCOLON);
             Next(parser);
             type(parser, fieldType, {closed});
-            check(t.fields.set(t, fieldType), parser, pos2, 104);
+            check(PROG.setFields(t, fieldType), pos2, 104);
             END
         END;
         t.closed := TRUE;
-        CODE.AddRec(t.base.num);
+        IL.AddRec(t.base.num);
         IF ~t.noalign THEN
-            check(MACHINE.Align(t.size, t.align), parser, pos2, 104);
+            check(UTILS.Align(t.size, t.align), pos2, 104);
-            check(ARITH.setInt(typeSize, t.size), parser, pos2, 104)
+            check(ARITH.setInt(typeSize, t.size), pos2, 104)
         END;
         checklex(parser, SCAN.lxEND);
         Next(parser)
-    ELSIF parser.sym = SCAN.lxPOINTER   THEN
+    ELSIF parser.sym = SCAN.lxPOINTER THEN
         ExpectSym(parser, SCAN.lxTO);
         END;
         type(parser, t.base, {forward});
         IF t.base # NIL THEN
-            check(t.base.typ = PROG.tRECORD, parser, pos, 58)
+            check(t.base.typ = PROG.tRECORD, pos, 58)
         ELSE
-            unit.pointers.add(unit, t, baseIdent, pos)
+            PROG.frwPtr(unit, t, baseIdent, pos)
         END
     ELSIF parser.sym = SCAN.lxPROCEDURE THEN
         NextPos(parser, pos);
-        t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
+        t := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
         t.align := program.target.adr;
         t.call := procflag(parser, import, FALSE);
 PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT;
 VAR
     ident:  PROG.IDENT;
-    pos:    SCAN.POSITION;
+    pos:    POSITION;
 BEGIN
     ASSERT(parser.sym = SCAN.lxIDENT);
     name := parser.lex.ident;
     getpos(parser, pos);
-    ident := parser.unit.idents.add(parser.unit, name, typ);
+    ident := PROG.addIdent(parser.unit, name, typ);
-    check(ident # NIL, parser, pos, 30);
+    check(ident # NIL, pos, 30);
 PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN);
 VAR
-    ident:  PROG.IDENT;
+    ident: PROG.IDENT;
-    name:   SCAN.IDENT;
+    name:  SCAN.IDENT;
-    pos:    SCAN.POSITION;
+    pos:   POSITION;
 BEGIN
     IF const THEN
     NextPos(parser, pos);
     IF const THEN
         ConstExpression(parser, ident.value);
         IF ident.value.typ = ARITH.tINTEGER THEN
-            check(ARITH.check(ident.value), parser, pos, 39)
+            check(ARITH.check(ident.value), pos, 39)
         ELSIF ident.value.typ = ARITH.tREAL THEN
-            check(ARITH.check(ident.value), parser, pos, 40)
+            check(ARITH.check(ident.value), pos, 40)
         END;
         ident.typ  := PROG.idCONST;
-        ident.type := program.getType(program, ident.value.typ)
+        ident.type := PROG.getType(program, ident.value.typ)
     ELSE
         type(parser, ident.type, {})
     END;
         IF parser.sym = SCAN.lxCOMMA THEN
             ExpectSym(parser, SCAN.lxIDENT)
         ELSIF parser.sym = SCAN.lxCOLON THEN
             Next(parser);
             type(parser, t, {});
-            parser.unit.setvars(parser.unit, t);
+            PROG.setVarsType(parser.unit, t);
             checklex(parser, SCAN.lxSEMI);
             Next(parser)
         ELSE
             checklex(parser, SCAN.lxCOLON)
         END
 PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN;
 VAR
     ptr: PROG.FRWPTR;
+    endmod: BOOLEAN;
-    endmod: BOOLEAN;
+    pos: POSITION;
     PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN;
     VAR
         proc:       PROG.IDENT;
         endname,
         name:       SCAN.IDENT;
-        param:      LISTS.ITEM;
+        param:      PROG.PARAM;
+        unit:       PROG.UNIT;
-        unit:       PROG.UNIT;
+        ident:      PROG.IDENT;
-        ident:      PROG.IDENT;
+        e:          EXPR;
-        e:          EXPR;
+        pos, pos1,
-        pos:        SCAN.POSITION;
+        pos2:       POSITION;
         label:      INTEGER;
-        enter:      CODE.COMMAND;
+        enter:      IL.COMMAND;
         call:       INTEGER;
         t:          PROG.TYPE_;
-        import:     CODE.IMPORT_PROC;
+        import:     IL.IMPORT_PROC;
         endmod, b:  BOOLEAN;
+        fparams:    SET;
+        variables:  LISTS.LIST;
+        int, flt:   INTEGER;
-        fparams:    SET;
+        comma:      BOOLEAN;
-        variables:  LISTS.LIST;
+        code:       ARITH.VALUE;
-        int, flt:   INTEGER;
+        codeProc:   BOOLEAN;
     BEGIN
+        endmod := FALSE;
         endmod := FALSE;
         unit := parser.unit;
         unit := parser.unit;
         call := procflag(parser, import, TRUE);
         call := procflag(parser, import, TRUE);
         getpos(parser, pos);
-        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;
             proc := IdentDef(parser, PROG.idPROC, name)
-        END;
+        check(PROG.openScope(unit, proc.proc), pos, 116);
-        check(unit.scope.open(unit, proc.proc), parser, pos, 116);
+        proc.type := PROG.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
         t := proc.type;
-        proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit);
+        t.align := program.target.adr;
-        t := proc.type;
+        t.call  := call;
-        t.align  := program.target.adr;
-        t.call   := call;
+        FormalParameters(parser, t);
-        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);
-            check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120)
+                ConstExpression(parser, code);
-        END;
+                check(code.typ = ARITH.tINTEGER, pos2, 43);
                 IF program.target.sys # mConst.Target_iMSP430 THEN
-        param := t.params.first;
+                    check(ARITH.range(code, 0, 255), pos2, 42)
-        WHILE param # NIL DO
-            ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM);
-            ASSERT(ident # NIL);
-            ident.type := param(PROG.PARAM).type;
+                END;
-            ident.offset := param(PROG.PARAM).offset;
+                IL.AddCmd(IL.opCODE, ARITH.getInt(code));
-            IF param(PROG.PARAM).vPar THEN
+                comma := parser.sym = SCAN.lxCOMMA;
-                ident.typ := PROG.idVPAR
+                IF comma THEN
-            END;
+                    Next(parser)
-            param := param.next
+                ELSE
-        END;
+                    checklex(parser, SCAN.lxSEMI)
+                END
+            END
+        END;
         checklex(parser, SCAN.lxSEMI);
-        Next(parser);
+        checklex(parser, SCAN.lxSEMI);
+        Next(parser);
-        IF import = NIL THEN
         IF import = NIL THEN
-            label := CODE.NewLabel();
-            proc.proc.label := label;
+            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;
-            IF parser.main & proc.export & program.dll THEN
+                IL.AddExp(label, proc.name.s);
-                IF program.obj THEN
+                proc.proc.used := TRUE
-                    check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114)
+            END;
-                END;
-                CODE.AddExp(label, proc.name.s);
+            IF ~codeProc THEN
-                proc.proc.used := TRUE
+                b := DeclarationSequence(parser)
             END;
-            b := DeclarationSequence(parser);
+            program.locsize := 0;
             IF call IN {PROG._win64, PROG.win64} THEN
-            program.locsize := 0;
+                fparams := PROG.getFloatParamsPos(proc.type, 3, int, flt);
-            IF call IN {PROG._win64, PROG.win64} THEN
+                enter := IL.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.parSize, 4))
-                fparams := proc.type.params.getfparams(proc.type, 3, int, flt);
+            ELSIF call IN {PROG._systemv, PROG.systemv} THEN
+                fparams := PROG.getFloatParamsPos(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
-                enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4))
+                enter := IL.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.parSize))
-            ELSIF call IN {PROG._systemv, PROG.systemv} THEN
+            ELSIF codeProc THEN
                 fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt);
-                enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size))
+            ELSE
+                enter := IL.Enter(label, 0)
+            END;
+            proc.proc.enter := enter;
+            IF ~codeProc & (parser.sym = SCAN.lxBEGIN) THEN
+                Next(parser);
+                parser.StatSeq(parser)
-            ELSE
+            END;
                 enter := CODE.Enter(label, 0)
-            END;
+            IF ~codeProc & (t.base # NIL) THEN
-            proc.proc.enter := enter;
+                checklex(parser, SCAN.lxRETURN);
                 NextPos(parser, pos);
-            IF parser.sym = SCAN.lxBEGIN THEN
+                parser.expression(parser, e);
-                Next(parser);
+                check(parser.chkreturn(parser, e, t.base, pos), pos, 87)
-                parser.StatSeq(parser)
+            END;
             END;
             IF ~codeProc THEN
-            IF t.base # NIL THEN
+                proc.proc.leave := IL.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), program.locsize,
-                checklex(parser, SCAN.lxRETURN);
+                    t.parSize * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv})));
                     endmod := TRUE
                 ELSIF endname = name THEN
                     ExpectSym(parser, SCAN.lxSEMI);
                     Next(parser)
                 ELSE
-                    check(FALSE, parser, pos, 60)
+                    error(pos, 60)
                 END
             END
         END;
-        IF import = NIL THEN
+        IF ~codeProc & (import = NIL) THEN
             variables := LISTS.create(NIL);
         ELSE
             variables := NIL
         END;
-        unit.scope.close(unit, variables);
+        PROG.closeScope(unit, variables);
-        IF import = NIL THEN
+        IF ~codeProc & (import = NIL) THEN
             enter.variables := variables
         WHILE parser.sym = SCAN.lxIDENT DO
             ConstTypeDeclaration(parser, FALSE)
         END
     END;
-    ptr := parser.unit.pointers.link(parser.unit);
+    ptr := PROG.linkPtr(parser.unit);
+    IF ptr # NIL THEN
+        pos.line := ptr.pos.line;
+        pos.col  := ptr.pos.col;
-    IF ptr # NIL THEN
+        pos.parser := parser;
         IF ptr.notRecord THEN
-            error(parser, ptr.pos, 58)
+            error(pos, 58)
         ELSE
-            error(parser, ptr.pos, 48)
+            error(pos, 48)
         END
     END;
 VAR
-    unit:    PROG.UNIT;
+    unit:     PROG.UNIT;
-    label:   INTEGER;
+    label:    INTEGER;
-    name:    INTEGER;
+    name:     INTEGER;
-    endmod:  BOOLEAN;
+    endmod:   BOOLEAN;
+    errlabel: INTEGER;
+    errno:    INTEGER;
 BEGIN
     ASSERT(parser # NIL);
     IF ~parser.main THEN
         check1(parser.lex.s = parser.modname, parser, 23)
     END;
-    unit := program.units.create(program.units, parser.lex.ident);
+    unit := PROG.newUnit(program, parser.lex.ident);
     IF parser.unit.sysimport THEN
         CONSOLE.String(" (SYSTEM)")
     END;
     CONSOLE.Ln;
-    label := CODE.NewLabel();
+    label := IL.NewLabel();
-    CODE.AddJmpCmd(CODE.opJMP, label);
+    IL.AddJmpCmd(IL.opJMP, label);
+    name := IL.putstr(unit.name.s);
+    errlabel := IL.NewLabel();
-    name := CODE.putstr(unit.name.s);
+    IL.SetLabel(errlabel);
+    IL.StrAdr(name);
+    IL.Param1;
+    IL.AddCmd0(IL.opERR);
-    CODE.SetErrLabel;
+    FOR errno := 1 TO LEN(IL.codes.errlabels) - 1 DO
+        IL.SetErrLabel(errno);
-    CODE.AddCmd(CODE.opSADR, name);
+        IL.AddCmd(IL.opPUSHC, errno);
-    CODE.AddCmd(CODE.opPARAM, 1);
+        IL.AddJmpCmd(IL.opJMP, errlabel)
-    CODE.AddCmd0(CODE.opERR);
+    END;
     endmod := DeclarationSequence(parser);
         check1(parser.lex.s = unit.name.s, parser, 25);
         ExpectSym(parser, SCAN.lxPOINT)
     END;
     unit.close(unit)
     PROG.closeUnit(unit)
 END parse;
     RETURN parser
 END create;
-PROCEDURE init* (bit_depth, sys: INTEGER);
+PROCEDURE init* (bit_depth, target: INTEGER; options: PROG.OPTIONS);
 BEGIN
-    program := PROG.create(bit_depth, sys);
+    program := PROG.create(bit_depth, target, options);
     parsers := C.create()

Subversion Repositories Kolibri OS

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