synchronized with original

BlackBox/Po/Files/ORG.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORG; (* NW  31.5.2015  code generator in Oberon-07 for RISC*)
+MODULE ORG; (* NW  15.2.2016  code generator in Oberon-07 for RISC*)
   IMPORT SYSTEM, Files, ORS, ORB;
   (*Code generator for Oberon compiler for RISC processor.
      Procedural interface to Parser OSAP; result in array "code".
@@ -64,7 +64,7 @@ MODULE ORG; (* NW  31.5.2015  code generator in Oberon-07 for RISC*)
   END Put1;
 
   PROCEDURE Put1a(op, a, b, im: LONGINT);
-  BEGIN (*same as Pu1, but with range test  -10000H <= im < 10000H*)
+  BEGIN (*same as Put1, but with range test  -10000H <= im < 10000H*)
     IF (im >= -10000H) & (im <= 0FFFFH) THEN Put1(op, a, b, im)
     ELSE Put1(Mov+U, RH, 0, im DIV 10000H);
       IF im MOD 10000H # 0 THEN Put1(Ior, RH, RH, im MOD 10000H) END ;
@@ -652,7 +652,7 @@ MODULE ORG; (* NW  31.5.2015  code generator in Oberon-07 for RISC*)
     END ;
     Put2(Ldr, RH+1, y.r, 0); Put1(Add, y.r, y.r, 4);
     Put2(Str, RH+1, x.r, 0); Put1(Add, x.r, x.r, 4);
-    Put1(Sub, RH, RH, 1); Put3(BC, NE, -6); DEC(RH, 2)
+    Put1(Sub, RH, RH, 1); Put3(BC, NE, -6); RH := 0
   END StoreStruct;
 
   PROCEDURE CopyString*(VAR x, y: Item);  (*from x to y*)

BlackBox/Po/Files/ORP.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*)
+MODULE ORP; (*N. Wirth 1.7.97 / 15.2.2016  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),
@@ -97,19 +97,22 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
   PROCEDURE TypeTest(VAR x: ORG.Item; T: ORB.Type; guard: BOOLEAN);
     VAR xt: ORB.Type;
   BEGIN xt := x.type;
-    WHILE (xt # T) & (xt # NIL) DO xt := xt.base END ;
-    IF xt # T THEN xt := x.type;
-      IF (xt.form = ORB.Pointer) & (T.form = ORB.Pointer) THEN
-        IF IsExtension(xt.base, T.base) THEN ORG.TypeTest(x, T.base, FALSE, guard); x.type := T
-        ELSE ORS.Mark("not an extension")
-        END
-      ELSIF (xt.form = ORB.Record) & (T.form = ORB.Record) & (x.mode = ORB.Par) THEN
-        IF IsExtension(xt, T) THEN  ORG.TypeTest(x, T, TRUE, guard); x.type := T
-        ELSE ORS.Mark("not an extension")
+    IF (T.form IN {ORB.Pointer, ORB.Record}) & (T.form = xt.form) THEN
+      WHILE (xt # T) & (xt # NIL) DO xt := xt.base END ;
+      IF xt # T THEN xt := x.type;
+        IF xt.form = ORB.Pointer THEN
+          IF IsExtension(xt.base, T.base) THEN ORG.TypeTest(x, T.base, FALSE, guard); x.type := T
+          ELSE ORS.Mark("not an extension")
+          END
+        ELSIF (xt.form = ORB.Record) & (x.mode = ORB.Par) THEN
+          IF IsExtension(xt, T) THEN  ORG.TypeTest(x, T, TRUE, guard); x.type := T
+          ELSE ORS.Mark("not an extension")
+          END
+        ELSE ORS.Mark("incompatible types")
         END
-      ELSE ORS.Mark("incompatible types")
+      ELSIF ~guard THEN ORG.MakeConstItem(x, ORB.boolType, 1)
       END
-    ELSIF ~guard THEN ORG.MakeConstItem(x, ORB.boolType, 1)
+    ELSE ORS.Mark("type mismatch")
     END ;
     IF ~guard THEN x.type := ORB.boolType END
   END TypeTest;
@@ -158,7 +161,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
     END
   END selector;
 
-  PROCEDURE CompTypes(t0, t1: ORB.Type; varpar: BOOLEAN): BOOLEAN;
+  PROCEDURE CompTypes(t0, t1: ORB.Type; varpar, top: BOOLEAN): BOOLEAN;
 
     PROCEDURE EqualSignatures(t0, t1: ORB.Type): BOOLEAN;
       VAR p0, p1: ORB.Object; com: BOOLEAN;
@@ -166,8 +169,8 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
       IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
         p0 := t0.dsc; p1 := t1.dsc;
         WHILE p0 # NIL DO
-          IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN
-            IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ;
+          IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE, FALSE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN
+            IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par), FALSE) END ;
             p0 := p0.next; p1 := p1.next
           ELSE p0 := NIL; com := FALSE
           END
@@ -179,7 +182,8 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
   
   BEGIN (*Compatible Types*)
     RETURN (t0 = t1)
-      OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & CompTypes(t0.base, t1.base, varpar)
+      OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & 
+        ((t0.len = t1.len) OR (top &( t0.len >= t1.len))) & CompTypes(t0.base, t1.base, varpar, FALSE)
       OR (t0.form = ORB.Pointer) & (t1.form = ORB.Pointer) & IsExtension(t0.base, t1.base)
       OR (t0.form = ORB.Record) & (t1.form = ORB.Record) & IsExtension(t0, t1)
       OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
@@ -193,7 +197,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
   BEGIN expression(x);
     IF par # NIL THEN
       varpar := par.class = ORB.Par;
-      IF CompTypes(par.type, x.type, varpar) THEN
+      IF CompTypes(par.type, x.type, varpar, TRUE) THEN
         IF ~varpar THEN ORG.ValueParam(x)
         ELSE (*par.class = Par*)
           IF ~par.rdo THEN CheckReadOnly(x) END ;
@@ -330,7 +334,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
     ELSIF sym = ORS.not THEN ORS.Get(sym); factor(x); CheckBool(x); ORG.Not(x)
     ELSIF sym = ORS.false THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 0)
     ELSIF sym = ORS.true THEN ORS.Get(sym); ORG.MakeConstItem(x, ORB.boolType, 1)
-    ELSE ORS.Mark("not a factor"); ORG.MakeItem(x, NIL, level)
+    ELSE ORS.Mark("not a factor"); ORG.MakeConstItem(x, ORB.intType, 0)
     END
   END factor;
 
@@ -380,7 +384,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
   BEGIN SimpleExpression(x);
     IF (sym >= ORS.eql) & (sym <= ORS.geq) THEN
       rel := sym; ORS.Get(sym); SimpleExpression(y); xf := x.type.form; yf := y.type.form;
-      IF CompTypes(x.type, y.type, FALSE) OR
+      IF CompTypes(x.type, y.type, FALSE,  TRUE) OR
           (xf = ORB.Pointer) & (yf = ORB.Pointer) & IsExtension(y.type.base, x.type.base) THEN
         IF (xf IN {ORB.Char, ORB.Int}) THEN ORG.IntRelation(rel, x, y)
         ELSIF xf = ORB.Real THEN ORG.RealRelation(rel, x, y)
@@ -489,7 +493,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
         ELSE selector(x);
           IF sym = ORS.becomes THEN (*assignment*)
             ORS.Get(sym); CheckReadOnly(x); expression(y);
-            IF CompTypes(x.type, y.type, FALSE) OR (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN
+            IF CompTypes(x.type, y.type, FALSE , TRUE) OR (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN
               IF (x.type.form <= ORB.Pointer) OR (x.type.form = ORB.Proc) THEN ORG.Store(x, y)
               ELSIF y.type.size # 0 THEN ORG.StoreStruct(x, y)
               END
@@ -602,18 +606,16 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
   PROCEDURE ArrayType(VAR type: ORB.Type);
     VAR x: ORG.Item; typ: ORB.Type; len: LONGINT;
   BEGIN NEW(typ); typ.form := ORB.NoTyp;
-    IF sym = ORS.of THEN (*dynamic array*) len := -1
-    ELSE expression(x);
-      IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
-      ELSE len := 0; ORS.Mark("not a valid length")
-      END
+    expression(x);
+    IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
+    ELSE len := 0; ORS.Mark("not a valid length")
     END ;
     IF sym = ORS.of THEN ORS.Get(sym); Type(typ.base);
       IF (typ.base.form = ORB.Array) & (typ.base.len < 0) THEN ORS.Mark("dyn array not allowed") END
     ELSIF sym = ORS.comma THEN ORS.Get(sym); ArrayType(typ.base)
     ELSE ORS.Mark("missing OF"); typ.base := ORB.intType
     END ;
-    IF len >= 0 THEN typ.size := (len * typ.base.size + 3) DIV 4 * 4 ELSE typ.size := 2*ORG.WordSize  (*array desc*) END ;
+    typ.size := (len * typ.base.size + 3) DIV 4 * 4 ;
     typ.form := ORB.Array; typ.len := len; type := typ
   END ArrayType;
 
@@ -747,7 +749,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
       ORS.Get(sym); Check(ORS.to, "no TO");
       NEW(type);  type.form := ORB.Pointer; type.size := ORG.WordSize; type.base := ORB.intType;
       IF sym = ORS.ident THEN
-        obj := ORB.thisObj(); ORS.Get(sym);
+        obj := ORB.thisObj();
         IF obj # NIL THEN
           IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Record, ORB.NoTyp}) THEN
             CheckRecLevel(obj.lev); type.base := obj.type
@@ -755,7 +757,8 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
           END
         ELSE CheckRecLevel(level); (*enter into list of forward references to be fixed in Declarations*)
           NEW(ptbase); ORS.CopyId(ptbase.name); ptbase.type := type; ptbase.next := pbsList; pbsList := ptbase
-        END
+        END ;
+        ORS.Get(sym)
       ELSE Type(type.base);
         IF type.base.form # ORB.Record THEN ORS.Mark("must point to record") END ;
         CheckRecLevel(level)
@@ -796,7 +799,8 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
         ORS.CopyId(id); ORS.Get(sym); CheckExport(expo);
         IF sym = ORS.eql THEN ORS.Get(sym) ELSE ORS.Mark("=?") END ;
         Type(tp);
-        ORB.NewObj(obj, id, ORB.Typ); obj.type := tp; obj.expo := expo; obj.lev := level; tp.typobj := obj;
+        ORB.NewObj(obj, id, ORB.Typ); obj.type := tp; obj.expo := expo; obj.lev := level;
+        IF tp.typobj = NIL THEN tp.typobj := obj END ;
         IF expo & (obj.type.form = ORB.Record) THEN obj.exno := exno; INC(exno) ELSE obj.exno := 0 END ;
         IF tp.form = ORB.Record THEN
           ptbase := pbsList;  (*check whether this is base of a pointer type; search and fixup*)
@@ -863,7 +867,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
       IF sym = ORS.return THEN
         ORS.Get(sym); expression(x);
         IF type.base = ORB.noType THEN ORS.Mark("this is not a function")
-        ELSIF ~CompTypes(type.base, x.type, FALSE) THEN ORS.Mark("wrong result type")
+        ELSIF ~CompTypes(type.base, x.type, FALSE, TRUE) THEN ORS.Mark("wrong result type")
         END
       ELSIF type.base.form # ORB.NoTyp THEN
         ORS.Mark("function without result"); type.base := ORB.noType
@@ -979,7 +983,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.6.2014  Oberon compiler for RISC in Oberon-07*
     Oberon.Collect(0)
   END Compile;
 
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  7.6.2014");
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  15.2.2016");
   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

BlackBox/Po/Files/ORS.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORS; (* NW 19.9.93 / 1.4.2014  Scanner in Oberon-07*)
+MODULE ORS; (* NW 19.9.93 / 15.2.2016  Scanner in Oberon-07*)
   IMPORT SYSTEM, Texts, Oberon;
 
 (* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
@@ -28,7 +28,7 @@ MODULE ORS; (* NW 19.9.93 / 1.4.2014  Scanner in Oberon-07*)
     to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
     else* = 55; elsif* = 56; until* = 57; return* = 58;
     array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
-    var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69;
+    var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69; eot = 70;
 
   TYPE Ident* = ARRAY IdLen OF CHAR;
 
@@ -209,7 +209,8 @@ MODULE ORS; (* NW 19.9.93 / 1.4.2014  Scanner in Oberon-07*)
   BEGIN
     REPEAT
       WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
-      IF ch < "A" THEN
+      IF R.eot THEN sym := eot
+      ELSIF ch < "A" THEN
         IF ch < "0" THEN
           IF ch = 22X THEN String; sym := string
           ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq