upd

people.inf.ethz.ch/wirth/ProjectOberon/Sources/ORB.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
+MODULE ORB;   (*NW 25.6.2014  / 1.3.2019  in Oberon-07*)
   IMPORT Files, ORS;
   (*Definition of data types Object and Type, which together form the data structure
     called "symbol table". Contains procedures for creation of Objects, and for search:
@@ -133,13 +133,7 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
     VAR mod: Module; obj, obj1: Object;
   BEGIN obj1 := topScope; obj := obj1.next;  (*search for module*)
     WHILE (obj # NIL) & (obj.name # name) DO obj1 := obj; obj := obj1.next END ;
-    IF obj = NIL THEN 
-      obj1 := topScope; obj := obj1.next;
-      WHILE (obj # NIL) & (obj IS Module) & (obj(Module).orgname # orgname) DO
-        obj1 := obj; obj := obj1.next
-      END
-    END ;
-    IF obj = NIL THEN (*insert new module*)
+    IF obj = NIL THEN  (*insert new module*)
       NEW(mod); mod.class := Mod; mod.rdo := FALSE;
       mod.name := name; mod.orgname := orgname; mod.val := key;
       mod.lev := nofmod; INC(nofmod); mod.type := noType; mod.dsc := NIL; mod.next := NIL;
@@ -211,7 +205,8 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
   
   PROCEDURE Import*(VAR modid, modid1: ORS.Ident);
     VAR key: LONGINT; class, k: INTEGER;
-      obj, thismod: Object;
+      obj: Object;  t: Type;
+      thismod: Object;
       modname, fname: ORS.Ident;
       F: Files.File; R: Files.Rider;
   BEGIN
@@ -228,10 +223,14 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
         WHILE class # 0 DO
           NEW(obj); obj.class := class; Files.ReadString(R, obj.name);
           InType(R, thismod, obj.type); obj.lev := -thismod.lev;
-          IF class = Typ THEN obj.type.typobj := obj; Read(R, k)
-          ELSIF class = Const THEN
+          IF class = Typ THEN
+            t := obj.type; t.typobj := obj; Read(R, k);  (*fixup bases of previously declared pointer types*)
+            WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
+          ELSE
+            IF class = Const THEN
               IF obj.type.form = Real THEN Files.ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END
-          ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
+            ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
+            END
           END ;
           obj.next := thismod.dsc; thismod.dsc := obj; Read(R, class)
         END ;
@@ -280,10 +279,7 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
       ELSIF t.form = Array THEN OutType(R, t.base); Files.WriteNum(R, t.len); Files.WriteNum(R, t.size)
       ELSIF t.form = Record THEN
         IF t.base # NIL THEN OutType(R, t.base); bot := t.base.dsc ELSE OutType(R, noType); bot := NIL END ;
-        IF obj # NIL THEN
-           IF t.mno > 0 THEN Files.WriteNum(R, t.len) ELSE Files.WriteNum(R, obj.exno) END
-        ELSE Write(R, 0)
-        END ;
+        IF obj # NIL THEN Files.WriteNum(R, obj.exno) ELSE Write(R, 0) END ;
         Files.WriteNum(R, t.nofpar); Files.WriteNum(R, t.size);
         fld := t.dsc;
         WHILE fld # bot DO  (*fields*)
@@ -309,7 +305,7 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
 
   PROCEDURE Export*(VAR modid: ORS.Ident; VAR newSF: BOOLEAN; VAR key: LONGINT);
     VAR x, sum, oldkey: LONGINT;
-      obj: Object;
+      obj, obj0: Object;
       filename: ORS.Ident;
       F, F1: Files.File; R, R1: Files.Rider;
   BEGIN Ref := Record + 1; MakeFileName(filename, modid, ".smb");
@@ -322,7 +318,15 @@ MODULE ORB;   (*NW 25.6.2014  / 26.1.2020   in Oberon-07*)
       IF obj.expo THEN
         Write(R, obj.class); Files.WriteString(R, obj.name);
         OutType(R, obj.type);
-        IF obj.class = Typ THEN Write(R, 0)
+        IF obj.class = Typ THEN
+          IF obj.type.form = Record THEN
+            obj0 := topScope.next;  (*check whether this is base of previously declared pointer types*)
+            WHILE obj0 # obj DO
+              IF (obj0.type.form = Pointer) & (obj0.type.base = obj.type) & (obj0.type.ref > 0) THEN Write(R, obj0.type.ref) END ;
+              obj0 := obj0.next
+            END
+          END ;
+          Write(R, 0)
         ELSIF obj.class = Const THEN
           IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
           ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val)

people.inf.ethz.ch/wirth/ProjectOberon/Sources/ORP.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 31.5.2019  Oberon compiler for RISC in Oberon-07*)
+MODULE ORP; (*N. Wirth 1.7.97 / 8.2.2020  Oberon compiler for RISC in Oberon-07*)
   IMPORT Texts, Oberon, ORS, ORB, ORG;
   (*Author: Niklaus Wirth, 2014.
     Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
@@ -889,12 +889,29 @@ MODULE ORP; (*N. Wirth 1.7.97 / 31.5.2019  Oberon compiler for RISC in Oberon-07
         ORS.Get(sym)
       ELSE ORS.Mark("no proc id")
       END
+    ELSE ORS.Mark("proc id expected")
     END
   END ProcedureDecl;
 
+  PROCEDURE Import;
+    VAR impid, impid1: ORS.Ident;
+  BEGIN
+    IF sym = ORS.ident THEN
+      ORS.CopyId(impid); ORS.Get(sym);
+      IF sym = ORS.becomes THEN
+        ORS.Get(sym);
+        IF sym = ORS.ident THEN ORS.CopyId(impid1); ORS.Get(sym)
+        ELSE ORS.Mark("id expected"); impid1 := impid
+        END
+      ELSE impid1 := impid
+      END ;
+      ORB.Import(impid, impid1)
+    ELSE ORS.Mark("id expected")
+    END
+  END Import;
+
   PROCEDURE Module;
     VAR key: LONGINT;
-      impid, impid1: ORS.Ident;
   BEGIN Texts.WriteString(W, "  compiling "); ORS.Get(sym);
     IF sym = ORS.module THEN
       ORS.Get(sym);
@@ -907,22 +924,9 @@ MODULE ORP; (*N. Wirth 1.7.97 / 31.5.2019  Oberon compiler for RISC in Oberon-07
       END ;
       Check(ORS.semicolon, "no ;"); level := 0; exno := 1; key := 0;
       IF sym = ORS.import THEN
-        ORS.Get(sym);
-        WHILE sym = ORS.ident DO
-          ORS.CopyId(impid); ORS.Get(sym);
-          IF sym = ORS.becomes THEN
-            ORS.Get(sym);
-            IF sym = ORS.ident THEN ORS.CopyId(impid1); ORS.Get(sym)
-            ELSE ORS.Mark("id expected")
-            END
-          ELSE impid1 := impid
-          END ;
-          ORB.Import(impid, impid1);
-          IF sym = ORS.comma THEN ORS.Get(sym)
-          ELSIF sym = ORS.ident THEN ORS.Mark("comma missing")
-          END
-        END ;
-        Check(ORS.semicolon, "no ;")
+        ORS.Get(sym); Import;
+        WHILE sym = ORS.comma DO ORS.Get(sym); Import END ;
+        Check(ORS.semicolon, "; missing")
       END ;
       ORG.Open(version); Declarations(dc); ORG.SetDataSize((dc + 3) DIV 4 * 4);
       WHILE sym = ORS.procedure DO ProcedureDecl; Check(ORS.semicolon, "no ;") END ;
@@ -990,7 +994,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 31.5.2019  Oberon compiler for RISC in Oberon-07
     Oberon.Collect(0)
   END Compile;
 
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  31.5.2019");
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  8.2.2020");
   Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
   NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
   expression := expression0; Type := Type0; FormalType := FormalType0

people.inf.ethz.ch/wirth/news.txt

@@ -1,5 +1,5 @@
-26.1.2020 - Improvement suggest by A. Pirklbauer in ORB (ThisModule, Import, Export)
-  ORB.Mod.txt updated
+8.2.2020 - ORP.Mod.txt  correction suggested by A. Pirklbauer in ORP.Module (ORP.Import)
+26.1.2020  change aborted
 31.5.2019 - ORP.Mod.txt, ORG.Mod.txt updated in TypeTest
 15.5.2019 - Floating-point rounding corrected
   update Texts.WriteReal  and  ORS.Number