kpmy 6 years ago
parent
commit
a60d4cdcbf

+ 20 - 15
people.inf.ethz.ch/wirth/ProjectOberon/Sources/ORG.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORG; (* N.Wirth, 16.4.2016 / 4.4.2017 / 17.9.2018  Oberon compiler; code generator for RISC*)
+MODULE ORG; (* N.Wirth, 16.4.2016 / 4.4.2017 / 31.5.2019  Oberon compiler; code generator for RISC*)
   IMPORT SYSTEM, Files, ORS, ORB;
   (*Code generator for Oberon compiler for RISC processor.
      Procedural interface to Parser OSAP; result in array "code".
@@ -355,20 +355,25 @@ MODULE ORG; (* N.Wirth, 16.4.2016 / 4.4.2017 / 17.9.2018  Oberon compiler; code
 
   PROCEDURE TypeTest*(VAR x: Item; T: ORB.Type; varpar, isguard: BOOLEAN);
     VAR pc0: LONGINT;
-  BEGIN (*fetch tag into RH*)
-    IF varpar THEN Put2(Ldr, RH, SP, x.a+4+frame)
-    ELSE load(x);
-      pc0 := pc; Put3(BC, EQ, 0);  (*NIL belongs to every pointer type*)
-      Put2(Ldr, RH, x.r, -8)
-    END ;
-    Put2(Ldr, RH, RH, T.nofpar*4); incR;
-    loadTypTagAdr(T);  (*tag of T*)
-    Put0(Cmp, RH-1, RH-1, RH-2); DEC(RH, 2);
-    IF ~varpar THEN fix(pc0, pc - pc0 - 1) END ;
-    IF isguard THEN
-      IF check THEN Trap(NE, 2) END
-    ELSE SetCC(x, EQ);
-      IF ~varpar THEN DEC(RH) END
+  BEGIN
+    IF T = NIL THEN
+      IF x.mode >= Reg THEN DEC(RH) END ;
+      SetCC(x, 7)
+    ELSE (*fetch tag into RH*)
+      IF varpar THEN Put2(Ldr, RH, SP, x.a+4+frame)
+      ELSE load(x);
+        pc0 := pc; Put3(BC, EQ, 0);  (*NIL belongs to every pointer type*)
+        Put2(Ldr, RH, x.r, -8)
+      END ;
+      Put2(Ldr, RH, RH, T.nofpar*4); incR;
+      loadTypTagAdr(T);  (*tag of T*)
+      Put0(Cmp, RH-1, RH-1, RH-2); DEC(RH, 2);
+      IF ~varpar THEN fix(pc0, pc - pc0 - 1) END ;
+      IF isguard THEN
+        IF check THEN Trap(NE, 2) END
+      ELSE SetCC(x, EQ);
+        IF ~varpar THEN DEC(RH) END
+      END
     END
   END TypeTest;
 

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

@@ -1,4 +1,4 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 17.9.2018  Oberon compiler for RISC in Oberon-07*)
+MODULE ORP; (*N. Wirth 1.7.97 / 31.5.2019  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),
@@ -110,7 +110,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 17.9.2018  Oberon compiler for RISC in Oberon-07
           END
         ELSE ORS.Mark("incompatible types")
         END
-      ELSIF ~guard THEN ORG.MakeConstItem(x, ORB.boolType, 1)
+      ELSIF ~guard THEN ORG.TypeTest(x, NIL, FALSE, FALSE)
       END
     ELSE ORS.Mark("type mismatch")
     END ;
@@ -898,14 +898,14 @@ MODULE ORP; (*N. Wirth 1.7.97 / 17.9.2018  Oberon compiler for RISC in Oberon-07
   BEGIN Texts.WriteString(W, "  compiling "); ORS.Get(sym);
     IF sym = ORS.module THEN
       ORS.Get(sym);
-      IF sym = ORS.times THEN version := 0; Texts.Write(W, "*"); ORS.Get(sym) ELSE version := 1 END ;
+      IF sym = ORS.times THEN version := 0; dc := 8; Texts.Write(W, "*"); ORS.Get(sym) ELSE dc := 0; version := 1 END ;
       ORB.Init; ORB.OpenScope;
       IF sym = ORS.ident THEN
         ORS.CopyId(modid); ORS.Get(sym);
         Texts.WriteString(W, modid); Texts.Append(Oberon.Log, W.buf)
       ELSE ORS.Mark("identifier expected")
       END ;
-      Check(ORS.semicolon, "no ;"); level := 0; dc := 0; exno := 1; key := 0;
+      Check(ORS.semicolon, "no ;"); level := 0; exno := 1; key := 0;
       IF sym = ORS.import THEN
         ORS.Get(sym);
         WHILE sym = ORS.ident DO
@@ -990,7 +990,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 17.9.2018  Oberon compiler for RISC in Oberon-07
     Oberon.Collect(0)
   END Compile;
 
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  17.9.2018");
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  31.5.2019");
   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

+ 11 - 8
people.inf.ethz.ch/wirth/ProjectOberon/Sources/Texts.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.1.2019*)
+MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 10.1.2019*)
   IMPORT Files, Fonts;
 
   CONST (*scanner symbol classes*)
@@ -9,10 +9,10 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.
     Real* = 4;          (*real number x*)
     Char* = 6;          (*special character c*)
 
-    (* TextBlock = TextTag "1" offset run {run} "0" len {AsciiCode}.
+    (* TextBlock = TextTag offset run {run} "0" len {AsciiCode}.
       run = fnt [name] col voff len. *)
 
-    TAB = 9X; CR = 0DX; maxD = 9;
+    TAB = 9X; CR = 0DX;
     TextTag = 0F1X;
     replace* = 0; insert* = 1; delete* = 2; unmark* = 3;  (*op-codes*)
 
@@ -33,7 +33,7 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.
       notify*: Notifier;
       trailer: Piece;
       pce: Piece;  (*cache*)
-      org: LONGINT; (*cache*)
+      org: LONGINT (*cache*)
     END;
 
     Reader* = RECORD
@@ -334,10 +334,9 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.
 
   PROCEDURE Scan* (VAR S: Scanner);
     CONST maxExp = 38; maxM = 16777216; (*2^24*)
-    VAR ch, term: CHAR;
+    VAR ch: CHAR;
       neg, negE, hex: BOOLEAN;
       i, j, h, d, e, n, s: INTEGER;
-      k: LONGINT;
       x: REAL;
   BEGIN ch := S.nextCh; i := 0;
     WHILE (ch = " ") OR (ch = TAB) OR (ch = CR) DO
@@ -482,9 +481,13 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.
       IF x < 0.0 THEN Write(W, "-"); x := -x ELSE Write(W, " ") END ;
       e := (e - 127) * 77 DIV 256 - 6;  (*decimal exponent*)
       IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
-      m := FLOOR(x + 0.5); i := 0;
+      m := FLOOR(x + 0.5);
       IF m >= 10000000 THEN INC(e); m := m DIV 10 END ;
-      REPEAT d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i) UNTIL m = 0;
+      i := 0; k := 13-n;
+      REPEAT
+         IF i = k THEN INC(m, 5) END ;    (*rounding*)
+       d[i] := CHR(m MOD 10 + 30H); m := m DIV 10; INC(i)
+      UNTIL m = 0;
       DEC(i); Write(W, d[i]); Write(W, ".");
       IF i < n-7 THEN n := 0 ELSE n := 14 - n END ;
       WHILE i > n DO DEC(i); Write(W, d[i]) END ;

+ 3 - 0
people.inf.ethz.ch/wirth/news.txt

@@ -1,3 +1,6 @@
+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
 20190301 - ORB.Mod.txt updated, see InType (variable last)
 20290118 - Fonts.Mod.txt  cleanup and correction in Fonts.Load
 20190117 - Oberon System updates: