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

 (*
     BSD 2-Clause License
-    Copyright (c) 2018-2020, Anton Krotov
+    Copyright (c) 2018-2021, Anton Krotov
     All rights reserved.
 *)
 MODULE PARS;
 IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, IL, CONSOLE, PATHS, UTILS,
         sym*:        INTEGER;
         unit*:       PROG.UNIT;
         constexp*:   BOOLEAN;
         main*:       BOOLEAN;
-        open*:       PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN;
+        open*:       PROCEDURE (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
         parse*:      PROCEDURE (parser: PARSER);
         StatSeq*:    STATPROC;
         expression*: EXPRPROC;
         designator*: EXPRPROC;
 END ExpectSym;
+PROCEDURE ImportList (parser: PARSER);
-PROCEDURE ImportList (parser: PARSER);
+VAR
-VAR
+    fname, path, ext, _name: PATH;
     name:    SCAN.IDENT;
     parser2: PARSER;
     pos:     POSITION;
-    alias:   BOOLEAN;
+    alias, _in: BOOLEAN;
     unit:    PROG.UNIT;
     ident:   PROG.IDENT;
             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)
-        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;
-        IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN
+                    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
-            alias := FALSE;
+                END
-            unit := PROG.getUnit(name);
+            END;
             IF unit # NIL THEN
                 check(unit.closed, pos, 31)
             ELSE
-                parser2 := parser.create(parser.path, parser.lib_path,
+                parser2 := parser.create(path, parser.lib_path,
                     parser.StatSeq, parser.expression, parser.designator, parser.chkreturn);
-                IF ~parser2.open(parser2, name.s) THEN
+                IF ~parser2.open(parser2, _name, ext) THEN
-                    IF parser.path # parser.lib_path 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.s), pos, 29)
+                        check(parser2.open(parser2, _name, ext), pos, 29)
                     ELSE
                         error(pos, 29)
+                    END
-                    END
+                END;
                 END;
                 parser2.parse(parser2);
-                parser2.parse(parser2);
+                unit := parser2.unit;
-                unit := parser2.unit;
+                unit.fname := parser2.fname;
 END QIdent;
 PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER);
 VAR
-    str: SCAN.LEXSTR;
+    str: SCAN.TEXTSTR;
-    string1, string2: SCAN.IDENT;
+    string1, string2: SCAN.STRING;
     bool: BOOLEAN;
 BEGIN
     IF v.typ = ARITH.tCHAR THEN
         ASSERT(v2.typ = ARITH.tSTRING);
         ARITH.charToStr(v, str);
-        string1 := SCAN.enterid(str);
+        string1 := SCAN.enterStr(str);
-        string2 := v2.string(SCAN.IDENT)
+        string2 := v2.string(SCAN.STRING)
     END;
     IF v2.typ = ARITH.tCHAR THEN
         ASSERT(v.typ = ARITH.tSTRING);
         ARITH.charToStr(v2, str);
-        string2 := SCAN.enterid(str);
+        string2 := SCAN.enterStr(str);
-        string1 := v.string(SCAN.IDENT)
+        string1 := v.string(SCAN.STRING)
     END;
     IF v.typ = v2.typ THEN
 PROCEDURE sysflag (parser: PARSER; proc: BOOLEAN): INTEGER;
 VAR
     res, sf: INTEGER;
+BEGIN
-BEGIN
+    checklex(parser, SCAN.lxIDENT);
-    IF parser.lex.s = "stdcall" THEN
+    IF parser.lex.ident.s = "stdcall" THEN
         sf := PROG.sf_stdcall
-    ELSIF parser.lex.s = "stdcall64" THEN
+    ELSIF parser.lex.ident.s = "cdecl" THEN
-        sf := PROG.sf_stdcall64
+        sf := PROG.sf_cdecl
-    ELSIF parser.lex.s = "ccall" THEN
+    ELSIF parser.lex.ident.s = "ccall" THEN
-        sf := PROG.sf_ccall
-    ELSIF parser.lex.s = "ccall16" THEN
-        sf := PROG.sf_ccall16
+        sf := PROG.sf_ccall
-    ELSIF parser.lex.s = "win64" THEN
+    ELSIF parser.lex.ident.s = "win64" THEN
         sf := PROG.sf_win64
-    ELSIF parser.lex.s = "systemv" THEN
+    ELSIF parser.lex.ident.s = "systemv" THEN
         sf := PROG.sf_systemv
-    ELSIF parser.lex.s = "windows" THEN
+    ELSIF parser.lex.ident.s = "windows" THEN
         sf := PROG.sf_windows
-    ELSIF parser.lex.s = "linux" THEN
+    ELSIF parser.lex.ident.s = "linux" THEN
         sf := PROG.sf_linux
-    ELSIF parser.lex.s = "code" THEN
+    ELSIF parser.lex.ident.s = "code" THEN
         sf := PROG.sf_code
-    ELSIF parser.lex.s = "oberon" THEN
+    ELSIF parser.lex.ident.s = "oberon" THEN
         sf := PROG.sf_oberon
-    ELSIF parser.lex.s = "noalign" THEN
+    ELSIF parser.lex.ident.s = "noalign" THEN
         sf := PROG.sf_noalign
     ELSE
         check1(FALSE, parser, 124)
     END;
     CASE sf OF
     |PROG.sf_stdcall:
         res := PROG.stdcall
-    |PROG.sf_stdcall64:
+    |PROG.sf_cdecl:
-        res := PROG.stdcall64
+        res := PROG.cdecl
+    |PROG.sf_ccall:
-    |PROG.sf_ccall:
+        IF TARGETS.OS IN {TARGETS.osWIN32, TARGETS.osLINUX32, TARGETS.osKOS} THEN
+            res := PROG.ccall
-        res := PROG.ccall
+        ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
+            res := PROG.win64
-    |PROG.sf_ccall16:
+        ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
+            res := PROG.systemv
-        res := PROG.ccall16
+        END
     |PROG.sf_win64:
         res := PROG.win64
     |PROG.sf_systemv:
         res := PROG.systemv
         ELSIF TARGETS.OS = TARGETS.osWIN64 THEN
             res := PROG.win64
         END
     |PROG.sf_linux:
         IF TARGETS.OS = TARGETS.osLINUX32 THEN
-            res := PROG.ccall16
+            res := PROG.ccall
         ELSIF TARGETS.OS = TARGETS.osLINUX64 THEN
             res := PROG.systemv
         END
     |PROG.sf_noalign:
         res := PROG.noalign
 PROCEDURE procflag (parser: PARSER; VAR _import: IL.IMPORT_PROC; isProc: BOOLEAN): INTEGER;
 VAR
     call: INTEGER;
-    dll, proc: SCAN.LEXSTR;
+    dll, proc: SCAN.TEXTSTR;
     pos: POSITION;
-    PROCEDURE getStr (parser: PARSER; VAR name: SCAN.LEXSTR);
+    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.IDENT).s
+            name := str.string(SCAN.STRING).s
         CASE TARGETS.BitDepth OF
         |16: call := PROG.default16
         |32: IF TARGETS.CPU = TARGETS.cpuX86 THEN
                  call := PROG.default32
              ELSE
-                 call := PROG.ccall
+                 call := PROG.cdecl
+             END
+        |64: IF TARGETS.CPU = TARGETS.cpuAMD64 THEN
+                 call := PROG.default64
+             ELSE
+                 call := PROG.cdecl
              END
-        |64: call := PROG.default64
         END
     END;
     IF _import # NIL THEN
         call:       INTEGER;
         t:          PROG._TYPE;
         _import:    IL.IMPORT_PROC;
         endmod, b:  BOOLEAN;
         fparams:    SET;
-        variables:  LISTS.LIST;
         int, flt:   INTEGER;
         comma:      BOOLEAN;
         code, iv:   ARITH.VALUE;
         codeProc,
         handler:    BOOLEAN;
+        line:       INTEGER;
     BEGIN
         endmod := FALSE;
         call := procflag(parser, _import, TRUE);
         getpos(parser, pos);
         pos1 := pos;
+        checklex(parser, SCAN.lxIDENT);
-        checklex(parser, SCAN.lxIDENT);
+        line := pos.line;
         IF _import # NIL THEN
             proc := IdentDef(parser, PROG.idIMP, name);
             proc._import := _import;
             IF _import.name = "" THEN
-                _import.name := name.s
+                COPY(name.s, _import.name)
             END;
             PROG.program.procs.last(PROG.PROC)._import := _import
         ELSE
         FormalParameters(parser, t);
         IF parser.sym = SCAN.lxLSQUARE THEN
             getpos(parser, pos2);
-            check(TARGETS.target = TARGETS.STM32CM3, pos2, 24);
+            check((TARGETS.CPU = TARGETS.cpuTHUMB) & (TARGETS.OS = TARGETS.osNONE), pos2, 24);
             Next(parser);
             getpos(parser, pos2);
             ConstExpression(parser, iv);
                 checklex(parser, SCAN.lxEND)
             ELSE
                 proc.proc.leave := IL.LeaveC()
             END;
-            IF TARGETS.CPU = TARGETS.cpuMSP430 THEN
+            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;
-                check((enter.param2 * ORD(~codeProc) + proc._type.parSize) * 2 + 16 < PROG.program.options.ram, pos1, 63)
+                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(endname = name, pos, 60);
+                    check(PROG.IdEq(endname, name), pos, 60);
                     ExpectSym(parser, SCAN.lxSEMI);
                     Next(parser)
                 ELSE
-                    IF endname = parser.unit.name THEN
+                    IF PROG.IdEq(endname, parser.unit.name) THEN
                         ExpectSym(parser, SCAN.lxPOINT);
                         Next(parser);
                         endmod := TRUE
-                    ELSIF endname = name THEN
+                    ELSIF PROG.IdEq(endname, name) THEN
                         ExpectSym(parser, SCAN.lxSEMI);
                         Next(parser)
                     ELSE
             ELSE
                 checklex(parser, SCAN.lxIDENT)
             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
+        PROG.closeScope(unit);
     ExpectSym(parser, SCAN.lxMODULE);
     ExpectSym(parser, SCAN.lxIDENT);
     IF ~parser.main THEN
-        check1(parser.lex.s = parser.modname, parser, 23)
+        check1(parser.lex.ident.s = parser.modname, parser, 23)
-    END;
+    END;
     unit := PROG.newUnit(parser.lex.ident);
     unit.fname := parser.fname;
     IF TARGETS.CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
         IL.fname(parser.fname)
     END;
     label := IL.NewLabel();
-    IL.AddJmpCmd(IL.opJMP, label);
+    IL.Jmp(IL.opJMP, label);
     name := IL.putstr(unit.name.s);
     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)
+        IL.Jmp(IL.opJMP, errlabel)
     END;
         END;
         checklex(parser, SCAN.lxEND);
         ExpectSym(parser, SCAN.lxIDENT);
-        check1(parser.lex.s = unit.name.s, parser, 25);
+        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: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE open (parser: PARSER; modname, FileExt: ARRAY OF CHAR): BOOLEAN;
 BEGIN
     ASSERT(parser # NIL);

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/source/PARS.ob07 – Rev 8097 → 8859