synchronized with original

BlackBox/Po/Files/Display.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Display;  (*NW 5.11.2013 / 3.7.2016*)
+MODULE Display;  (*NW 5.11.2013 / 17.1.2019*)
   IMPORT SYSTEM;
 
   CONST black* = 0; white* = 1;  (*black = background*)
@@ -72,11 +72,11 @@ MODULE Display;  (*NW 5.11.2013 / 3.7.2016*)
 
   PROCEDURE CopyPattern*(col, patadr, x, y, mode: INTEGER);  (*only for modes = paint, invert*)
     VAR a, a0, pwd: INTEGER;
-      w, h, pbt: BYTE; pix: SET;
+      w, h, pbt: BYTE; pix, mask: SET;
   BEGIN SYSTEM.GET(patadr, w); SYSTEM.GET(patadr+1, h); INC(patadr, 2);
-    a := base + (x DIV 32)*4 + y*128; 
+    a := base + (x DIV 32)*4 + y*128; x := x MOD 32; mask := SYSTEM.VAL(SET, ASR(7FFFFFFFH, 31-x));
     FOR a0 := a TO a + (h-1)*128 BY 128 DO
-      (*build pattern line; w < 32*)
+      (*build pattern line; w <= 32*)
       SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt;
       IF w > 8 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*100H + pwd;
         IF w > 16 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*10000H + pwd;
@@ -84,13 +84,13 @@ MODULE Display;  (*NW 5.11.2013 / 3.7.2016*)
         END
       END ;
       SYSTEM.GET(a0, pix);
-      IF mode = invert THEN SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x MOD 32)) / pix)
-      ELSE SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x MOD 32)) + pix)
+      IF mode = invert THEN SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x)) / pix)
+      ELSE SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x)) + pix)
       END ;
-      IF (x MOD 32) + w > 32 THEN (*spill over*)
+      IF x + w > 32 THEN (*spill over*)
         SYSTEM.GET(a0+4, pix);
-        IF mode = invert THEN SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -(x MOD 32))) / pix)
-        ELSE SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -(x MOD 32))) + pix)
+        IF mode = invert THEN SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -x)) * mask/ pix)
+        ELSE SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -x)) * mask+ pix)
         END
       END
     END

BlackBox/Po/Files/Fonts.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*)
+MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 18.1.2019*)
   IMPORT SYSTEM, Files;
 
   CONST FontFileId = 0DBH;
@@ -14,7 +14,9 @@ MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*)
 
     LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ;
     LargeFont = POINTER TO LargeFontDesc;
-
+    RunRec = RECORD beg, end: BYTE END ;
+    BoxRec = RECORD dx, x, y, w, h: BYTE END ;
+    
   (* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983,
       Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302  *)
 
@@ -29,10 +31,6 @@ BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa;
 END GetPat;
 
 PROCEDURE This*(name: ARRAY OF CHAR): Font;
-
-  TYPE RunRec = RECORD beg, end: BYTE END ;
-    BoxRec = RECORD dx, x, y, w, h: BYTE END ;
-    
   VAR F: Font; LF: LargeFont;
     f: Files.File; R: Files.Rider;
     NofRuns, NofBoxes: BYTE;
@@ -59,7 +57,6 @@ BEGIN F := root;
         Files.ReadByte(R, b); (*abstraction*)
         Files.ReadByte(R, b); (*family*)
         Files.ReadByte(R, b); (*variant*)
-        NEW(F); F.name := name;
         RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns);
         NofBoxes := 0; k := 0;
         WHILE k # NofRuns DO
@@ -81,7 +78,7 @@ BEGIN F := root;
         a0 := SYSTEM.ADR(F.raster);
         SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X);
         (*null pattern for characters not in a run*)
-        INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0;
+        INC(a0, 3); a := a0+2; j := 0; k := 0; m := 0;
         WHILE k < NofRuns DO
           WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END;
           WHILE (m < run[k].end) & (m < 128) DO
@@ -105,10 +102,7 @@ BEGIN F := root;
 END This;
 
 PROCEDURE Free*;  (*remove all but first two from font list*)
-  VAR f: Font;
-BEGIN f := root.next;
-  IF f # NIL THEN f := f.next END ;
-  f.next := NIL
+BEGIN IF root.next # NIL THEN root.next.next := NIL END
 END Free;
 
 BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt")

BlackBox/Po/Files/GraphicFrames.Mod.txt

@@ -1,4 +1,4 @@
-MODULE GraphicFrames; (*NW 18.4.88 / 18.11.2013*)
+MODULE GraphicFrames; (*NW 18.4.88 / 18.11.2013 / 27.8.2018*)
   IMPORT SYSTEM, Display, Viewers, Input, Fonts, Texts, Graphics, Oberon, MenuViewers;
 
   CONST (*update message ids*)
@@ -454,7 +454,7 @@ MODULE GraphicFrames; (*NW 18.4.88 / 18.11.2013*)
     CASE M OF DrawMsg:
       x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
       IF (x+w > f.X) & (x < f.X1) & (y+h > f.Y) & (y < f.Y1) THEN
-        col := Display.white;
+        col := obj.col;
         IF (M.mode = 0) & obj.selected OR (M.mode = 1) THEN
           ReplPattern(f, col, Display.grey, x, y, w, h, Display.replace)
         ELSIF M.mode IN {0, 2} THEN ReplConst(f, col, x, y, w, h, Display.replace)
@@ -477,7 +477,7 @@ MODULE GraphicFrames; (*NW 18.4.88 / 18.11.2013*)
         Texts.OpenReader(R, Graphics.T, obj(Graphics.Caption).pos); Texts.Read(R, ch);
         IF M.mode = 0 THEN
           IF ch >= " " THEN
-            fnt := R.fnt; x0 := x; y0 := y - fnt.minY;
+            fnt := R.fnt; x0 := x; y0 := y - fnt.minY; col := obj.col;
             REPEAT Fonts.GetPat(fnt, ch, dx, x1, y1, w1, h1, pat);
               IF x0+x1+w1 <= f.X1 THEN
                 Display.CopyPattern(col, pat, x0+x1, y0+y1, Display.paint); INC(x0, dx); Texts.Read(R, ch)

BlackBox/Po/Files/LSC.Mod.txt

@@ -1,25 +1,14 @@
-MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
+MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 27.8.2018 for RISC (LSCX)*)
   IMPORT Texts, Oberon, LSB, LSS;
   
   VAR sym: INTEGER;
     err: BOOLEAN;  (*used at end of Unit*)
     top, bot, undef: LSB.Object;
+    factor: PROCEDURE (VAR x: LSB.Item);  (*to avoid forward references*)
+    expression: PROCEDURE (VAR x: LSB.Item);
+    Unit: PROCEDURE (VAR locals: LSB.Object);
     W: Texts.Writer;
 
-  PROCEDURE Out(n: INTEGER);
-  BEGIN Texts.Write(W, "\"); Texts.WriteInt(W, n, 4); Texts.Append(Oberon.Log, W.buf)
-  END Out;
-
-  PROCEDURE WrTyp(t: LSB.Type);
-  BEGIN 
-    IF t = LSB.integer THEN Texts.Write(W, "N"); Texts.WriteInt(W, t.size, 4)
-    ELSIF t = LSB.string THEN Texts.Write(W, "S"); Texts.WriteInt(W, t.size, 4)
-    ELSIF t = LSB.bitType THEN Texts.Write(W, "B")
-    ELSIF t IS LSB.ArrayType THEN Texts.Write(W, "A"); WrTyp(t(LSB.ArrayType).eltyp)
-    END ;
-    Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
-  END WrTyp;
-
   PROCEDURE Err(n: INTEGER);
   BEGIN LSS.Mark("type error"); Texts.WriteInt(W, n, 4);
     Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
@@ -42,7 +31,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   BEGIN x := top;
     WHILE (x.next # bot) & (x.next.name # LSS.id) DO x := x.next END ;
     IF x.next = bot THEN
-      NEW(new); COPY(LSS.id, new.name); new.tag := class; new.next := bot; x.next := new
+      NEW(new); new.name := LSS.id; new.tag := class; new.next := bot; x.next := new
     ELSE LSS.Mark("mult def"); new := x
     END ;
     RETURN new
@@ -59,7 +48,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   PROCEDURE CheckTypes(x, y, z: LSB.Item);  (*z.type = result type*)
     VAR xtyp, ytyp: LSB.Type;
   BEGIN xtyp := x.type; ytyp := y.type; z.type := xtyp; z.size := x.size; z.val := x.val;
-    IF xtyp = LSB.bitType THEN 
+    IF xtyp = LSB.bitType THEN
       IF ytyp = LSB.integer THEN  (* b + 0 *)
         IF y.val >= 2 THEN Err(20); LSS.Mark("only 0 or 1") END
       ELSIF ytyp = LSB.string THEN (* b + {...} *) Err(21)
@@ -102,8 +91,6 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     END
   END CheckTypes;
 
-  PROCEDURE ^ expression(VAR x: LSB.Item);
-
   PROCEDURE selector(VAR x: LSB.Item);
     VAR y, z: LSB.Item; obj: LSB.Object;
       eltyp: LSB.Type; len, kind: LONGINT;
@@ -116,14 +103,12 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
           IF (y.tag = LSB.lit) & (z.tag = LSB.lit) THEN
             len := y.val - z.val + 1; y := New(LSB.range, y, z); x := New(LSB.sel, x, y); x.type := LSB.string; x.size := len
           END
-        ELSE x := New(LSB.sel, x, y); x.type := eltyp
+        ELSE kind := x.val; x := New(LSB.sel, x, y); x.type := eltyp; x.val := kind
         END ;
         IF sym = LSS.rbrak THEN LSS.Get(sym) ELSE LSS.Mark("rbrak ?") END
       ELSE (*sym = LSS.period*) LSS.Get(sym); factor(y);
         IF (y.tag = LSB.lit) & (y.val >= x.type.len) THEN LSS.Mark("too large") END ;
-        (*Texts.WriteString(W, "Sel"); Texts.WriteInt(W, x.tag, 4); Texts.WriteInt(W, x.val, 4);*)
-        eltyp := x.type(LSB.ArrayType).eltyp; kind := x.val; x := New(LSB.sel, x, y); x.type := eltyp; x.val := kind;
-        (*Texts.WriteInt(W, x.tag, 4); Texts.WriteInt(W, x.val, 4); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);*)
+        eltyp := x.type(LSB.ArrayType).eltyp; kind := x.val; x := New(LSB.sel, x, y); x.type := eltyp; x.val := kind
       END
     END
   END selector;
@@ -153,7 +138,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     IF sym = LSS.rbrace THEN LSS.Get(sym) ELSE LSS.Mark("rbrace ?") END
   END constructor;
 
-  PROCEDURE factor(VAR x: LSB.Item);
+  PROCEDURE factor0(VAR x: LSB.Item);
     VAR obj: LSB.Object; y, z: LSB.Item;
       n, len: LONGINT; t: LSB.ArrayType;
   BEGIN
@@ -182,7 +167,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     ELSIF sym = LSS.lbrace THEN LSS.Get(sym); constructor(x)
     ELSE LSS.Mark("bad factor")
     END
-  END factor;
+  END factor0;
 
   PROCEDURE term(VAR x: LSB.Item);
     VAR y, z: LSB.Item; op: INTEGER;
@@ -231,7 +216,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     END
   END UncondExpression;
 
-  PROCEDURE expression(VAR x: LSB.Item);
+  PROCEDURE expression0(VAR x: LSB.Item);
     VAR y, z, w: LSB.Item;
   BEGIN UncondExpression(x);
     IF sym = LSS.then THEN
@@ -243,12 +228,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
       ELSE LSS.Mark("colon ?")
       END
     END
-  END expression;
-
-  PROCEDURE WritePars(fpar: LSB.Object; apar: LSB.Item);
-  BEGIN Texts.Write(W, 9X); Texts.WriteString(W, fpar.name); Texts.Write(W, "\");
-    IF apar IS LSB.Object THEN Texts.WriteString(W, apar(LSB.Object).name) END
-  END WritePars;
+  END expression0;
 
   PROCEDURE CheckAssign(x, y: LSB.Item);
     VAR xtyp, ytyp: LSB.Type;
@@ -276,8 +256,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     VAR y, z: LSB.Item;
   BEGIN expression(y); apar := New(LSB.next, NIL, y); CheckAssign(fpar, y);
     IF fpar.val IN {3, 4} THEN  (*OUT or INOUT parameter*)
-      (* Texts.WriteString(W, "Param"); Texts.WriteInt(W, fpar.val, 4); Texts.WriteInt(W, y.val, 4); Texts.WriteInt(W, y.tag, 4); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); *)
-      IF (*y.tag # 3*) ~(y.tag IN {3, 7}) THEN  (*actual param is expression?*) LSS.Mark("bad actual param"); 
+      IF ~(y.tag IN {3, 7}) THEN  (*actual param is expression?*) LSS.Mark("bad actual param")
       ELSIF y.b = NIL THEN y.b := undef
       END
     END
@@ -285,7 +264,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
 
   PROCEDURE Statement;
     VAR x, y, z, w, apar, npar: LSB.Item;
-    unit: LSB.UnitType; fpar: LSB.Object;
+      unit: LSB.UnitType; fpar: LSB.Object;
   BEGIN
     IF sym < LSS.ident THEN LSS.Mark("bad factor");
       REPEAT LSS.Get(sym) UNTIL sym >= LSS.ident
@@ -296,7 +275,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
         IF x.val >= 5 THEN LSS.Mark("assignment to read-only") END ;
         IF (x.b # NIL) & ~(x.type IS LSB.ArrayType) THEN LSS.Mark("mult assign") END ;
         expression(y); CheckAssign(z, y); x.b := y; (*tricky*)
-        IF z # x THEN x.a := z.b; x.val := 1 (*overwriting clk field x.a with index*) END
+        IF z # x THEN x.a := z.b; x.val := 1 (*overwriting clk field x.a *) END
       ELSIF sym = LSS.lparen THEN LSS.Get(sym);  (*unit instantiation*)
         IF x.type IS LSB.UnitType THEN
           unit := x.type(LSB.UnitType); fpar := unit.firstobj;
@@ -341,9 +320,6 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   PROCEDURE StatSequence;
   BEGIN Statement;
     WHILE sym <= LSS.semicolon DO
-    (* IF sym = LSS.semicolon THEN LSS.Get(sym)
-      ELSIF sym < LSS.semicolon THEN LSS.Mark("semicolon missing?");
-      END ; *)
       IF sym < LSS.semicolon THEN LSS.Mark("semicolon missing?") END ;
       WHILE sym = LSS.semicolon DO LSS.Get(sym) END ;
       Statement
@@ -351,14 +327,14 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     IF sym = LSS.end THEN LSS.Get(sym) ELSE LSS.Mark("END ?") END
   END StatSequence;
 
-  (*----------------------declarations-----------------------------*)
+  (*---------------------------------------------------*)
   
   (* for variables and registers,, obj.val has the meaning
     0  register
-    1  register with imlicit clock "clk"
+    1  --
     2  variable
     3  output parameter
-    4  output parameter with register
+    4  --
     5  inout parameter
     6  input parameter  *)
   
@@ -367,7 +343,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   BEGIN
     IF sym = LSS.ident THEN
       obj := NewObj(LSB.const); LSS.Get(sym);
-      IF (sym = LSS.becomes) OR (sym = LSS.eql) THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
+      IF sym = LSS.eql THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
       expression(obj.b); obj.type := LSB.integer;
       IF sym = LSS.semicolon THEN LSS.Get(sym) ELSE LSS.Mark("semicolon ?") END
     ELSE LSS.Mark("ident ?")
@@ -400,7 +376,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   BEGIN
     IF sym = LSS.ident THEN
       obj := NewObj(LSB.typ); LSS.Get(sym);
-      IF (sym = LSS.becomes) OR (sym = LSS.eql) THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
+      IF sym = LSS.eql THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
       IF sym = LSS.module THEN
         LSS.Get(sym); NEW(utyp); Unit(utyp.firstobj); obj.type := utyp; obj.type.typobj := obj
       ELSE Type0(obj.type)
@@ -414,10 +390,10 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     VAR first, new, obj: LSB.Object; type: LSB.Type;
   BEGIN obj := NIL;
     WHILE sym = LSS.ident DO
-      new := NewObj(LSB.var); COPY(LSS.id, new.name); new.val := kind; first := new; LSS.Get(sym);
+      new := NewObj(LSB.var); new.name := LSS.id; new.val := kind; first := new; LSS.Get(sym);
       IF sym = LSS.comma THEN LSS.Get(sym) ELSIF sym = LSS.ident THEN LSS.Mark("comma missing") END ;
       WHILE sym = LSS.ident DO
-        new := NewObj(LSB.var); COPY(LSS.id, new.name); new.val := kind; LSS.Get(sym);
+        new := NewObj(LSB.var); new.name := LSS.id; new.val := kind; LSS.Get(sym);
         IF sym = LSS.comma THEN LSS.Get(sym) ELSIF sym = LSS.ident THEN LSS.Mark("comma missing") END
       END ;
       IF sym = LSS.colon THEN
@@ -435,20 +411,12 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     VAR kind: INTEGER;
   BEGIN
     IF sym = LSS.in THEN LSS.Get(sym); kind := 6
-    ELSIF sym = LSS.out THEN LSS.Get(sym);
-      IF sym = LSS.reg THEN LSS.Get(sym); kind := 4 ELSE kind := 3 END
+    ELSIF sym = LSS.out THEN LSS.Get(sym); kind := 3
     ELSIF sym = LSS.inout THEN LSS.Get(sym); kind := 5
     END ;
     VarList(kind, NIL)
   END ParamList;
 
-  PROCEDURE List*;
-    VAR obj: LSB.Object;
-  BEGIN obj := top.next;
-    WHILE obj # NIL DO Texts.WriteString(W, obj.name); Texts.Write(W, "|"); obj := obj.next END ;
-    Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
-  END List;
-  
   PROCEDURE Traverse(x: LSB.Item);
   BEGIN
     IF x # NIL THEN
@@ -465,7 +433,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     END
   END Traverse;
 
-  PROCEDURE Unit(VAR locals: LSB.Object);
+  PROCEDURE Unit0(VAR locals: LSB.Object);
     VAR obj, oldtop: LSB.Object; kind: INTEGER; clock: LSB.Item;
   BEGIN oldtop := top.next; top.next := LSB.root;  (*top is dummy*)
     IF sym = LSS.lparen THEN LSS.Get(sym) ELSE LSS.Mark("lparen ?") END ;
@@ -494,7 +462,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
           WHILE sym = LSS.ident DO VarList(kind, clock) END
         END
       END ;
-      List; locals := top.next;
+      locals := top.next;
       IF sym = LSS.begin THEN LSS.Get(sym); StatSequence END ;
       obj := locals; err := FALSE;  (*find unassigned variables*)
       WHILE obj # LSB.root DO
@@ -516,7 +484,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     END ;
     IF err THEN Texts.Append(Oberon.Log, W.buf) END ;
     top.next := oldtop
-  END Unit;
+  END Unit0;
 
   PROCEDURE Module(T: Texts.Text; pos: LONGINT);
     VAR root: LSB.Object; modname: ARRAY 32 OF CHAR;
@@ -525,7 +493,7 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
     IF sym = LSS.module THEN
       LSS.Get(sym);
       IF sym = LSS.ident THEN
-        COPY(LSS.id, modname); Texts.WriteString(W, LSS.id); LSS.Get(sym);
+        modname := LSS.id; Texts.WriteString(W, LSS.id); LSS.Get(sym);
         Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
       ELSE LSS.Mark("ident ?")
       END ;
@@ -559,6 +527,8 @@ MODULE LSC;  (*Lola System Compiler, NW 8.1.95 / 28.10.2016*)
   END Compile;
 
 BEGIN Texts.OpenWriter(W);
-  Texts.WriteString(W, "Lola compiler; NW 28.10.20165"); Texts.WriteLn(W);
-  NEW(top); bot := LSB.root; NEW(undef); undef.tag := 2; undef.type := LSB.bitType
+  Texts.WriteString(W, "Lola compiler; NW 27.8.2018"); Texts.WriteLn(W);
+  factor := factor0; expression := expression0; Unit := Unit0;
+  NEW(top); bot := LSB.root;
+  NEW(undef); undef.tag := LSB.typ; undef.type := LSB.bitType; undef.next := NIL
 END LSC.

BlackBox/Po/Files/LSS.Mod.txt

@@ -1,4 +1,4 @@
-MODULE LSS; (* NW 16.10.93 / 1.9.2015*)
+MODULE LSS; (* NW 16.10.93 / 13.8.2018*)
   IMPORT Texts, Oberon;
   
   CONST IdLen* = 32; NofKeys = 11;
@@ -7,7 +7,7 @@ MODULE LSS; (* NW 16.10.93 / 1.9.2015*)
     eql* = 10; neq* = 11; lss* = 12; leq* = 13; gtr* = 14; geq* = 15;
     at* = 16; apo* = 17; period* = 18; comma* = 19; colon* = 20; rparen* = 21; rbrak* = 22; rbrace* = 23; 
     then* = 24; lparen* = 26; lbrak* = 27; lbrace* = 28; repl* = 29; becomes* = 30;
-    ident* = 31; integer* = 32; ts* = 33; semicolon* = 40; end* = 41;
+    integer* = 31; ident* = 32; ts* = 33; semicolon* = 40; end* = 41;
     const* = 51; type* = 52; reg* = 53; var* = 54; out* = 55; inout* = 56; in* = 57;
     begin* = 58; module* = 59; eof = 60;
 

BlackBox/Po/Files/LSV.Mod.txt

@@ -1,4 +1,4 @@
-MODULE LSV;  (*Lola System: display Verilog; generate txt-File; NW 31.8.2015*)
+MODULE LSV;  (*Lola System: display Verilog; generate txt-File; NW 27.8.2018*)
   IMPORT Files, Texts, Oberon, LSB;
 
   VAR W: Texts.Writer;
@@ -122,17 +122,16 @@ MODULE LSV;  (*Lola System: display Verilog; generate txt-File; NW 31.8.2015*)
   BEGIN param := TRUE;
     WHILE obj # LSB.root DO
       IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) THEN
-        IF obj.val <= 1 THEN WriteString("reg ")
+        IF obj.val = 0 THEN WriteString("reg ")
         ELSIF obj.val = 2 THEN WriteString("wire ")
         ELSIF obj.val = 3 THEN WriteString("output ")
-        ELSIF obj.val = 4 THEN WriteString("output reg ")
         ELSIF obj.val = 5 THEN WriteString("inout ")
         ELSIF obj.val = 6 THEN WriteString("input ")
         ELSE WriteString("??? ")
         END ;
         BitArrLen(obj.type); WriteString(obj.name);
         obj1 := obj.next;
-        WHILE (obj1 # LSB.top) & (obj1.type = obj.type) & (obj1.val = obj.val) DO
+        WHILE (obj1 # LSB.root) & (obj1.type = obj.type) & (obj1.val = obj.val) DO
           WriteString(", "); obj := obj1; WriteString(obj.name); obj1 := obj.next
         END ;
         IF param & (obj.val >= 3) & (obj1.val < 3) THEN  (*end param list*) param := FALSE; Write(")")
@@ -195,19 +194,15 @@ MODULE LSV;  (*Lola System: display Verilog; generate txt-File; NW 31.8.2015*)
   END ObjList1;
 
   PROCEDURE ObjList2(obj: LSB.Object);  (*assignments to registers*)
-    VAR apar: LSB.Item; kind: LONGINT; clk: LSB.Item;
+    VAR clk: LSB.Item;
   BEGIN
     WHILE obj # LSB.root DO
-      IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) & (obj.val < 2) THEN
-        WriteString("always @ (posedge "); kind := obj.val;
-        IF kind = 0 THEN Expression(obj.a)
-        ELSE (*kind = 1*) WriteString("clk")
-        END ;
+      IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) & (obj.val = 0) THEN
+        WriteString("always @ (posedge "); clk := obj.a; Expression(clk);
         WriteString(") begin ");
         REPEAT WriteString(obj.name);
-          IF (kind = 1) & (obj.a # NIL) THEN Write("["); Expression(obj.a); Write("]") END ;
           WriteString(" <= "); Expression(obj.b); Write(";"); WriteLn; obj := obj.next
-        UNTIL (obj = LSB.top) OR (obj.val # kind);
+        UNTIL (obj = LSB.top) OR (obj.a # clk);
         WriteString("end"); WriteLn
       ELSE obj := obj.next
       END

BlackBox/Po/Files/LeftShifter.Lola.txt

@@ -0,0 +1,17 @@
+MODULE LeftShifter(    (*NW 10.11.2016*)
+  IN x: WORD; sc: [5] BIT;
+  OUT y: WORD);
+
+  VAR sc0, sc1: [2] BIT;
+    t1, t2: WORD;
+
+BEGIN sc0 := sc[1:0]; sc1 := sc[3:2];
+  t1 := (sc0 = 3) -> {x[28:0], 0'3} :
+      (sc0 = 2) -> {x[29:0], 0'2} :
+      (sc0 = 1) -> {x[30:0], 0'1} : x;
+  t2 := (sc1 = 3) -> {t1[19:0], 0'12} :
+      (sc1 = 2) -> {t1[23:0], 0'8} :
+      (sc1 = 1) -> {t1[27:0], 0'4} : t1;
+  y := sc.4 -> {t2[15:0], 0'16} : t2
+END LeftShifter.
+

BlackBox/Po/Files/Modules.Mod.txt

@@ -1,4 +1,4 @@
-MODULE Modules;  (*Link and load on RISC; NW 20.10.2013 / 9.4.2016*)
+MODULE Modules;  (*Link and load on RISC; NW 20.10.2013 / 8.1.2019*)
   IMPORT SYSTEM, Files;
   CONST versionkey = 1X; MT = 12; DescSize = 80;
 
@@ -56,7 +56,7 @@ MODULE Modules;  (*Link and load on RISC; NW 20.10.2013 / 9.4.2016*)
       name1, impname: ModuleName;
       F: Files.File; R: Files.Rider;
       import: ARRAY 16 OF Module;
-  BEGIN mod := root; res := 0; nofimps := 0;
+  BEGIN mod := root; error(0, name); nofimps := 0;
     WHILE (mod # NIL) & (name # mod.name) DO mod := mod.next END ;
     IF mod = NIL THEN (*load*)
       Check(name);
@@ -178,7 +178,7 @@ MODULE Modules;  (*Link and load on RISC; NW 20.10.2013 / 9.4.2016*)
           SYSTEM.PUT(adr, inst); adr := adr - disp*4
         END ;
         body   (*initialize module*)
-      ELSIF res = 3 THEN importing := name;
+      ELSIF res >= 3 THEN importing := name;
         WHILE nofimps > 0 DO DEC(nofimps); DEC(import[nofimps].refcnt) END
       END 
     END ;

BlackBox/Po/Files/MouseP.Lola.txt

@@ -3,7 +3,7 @@ MODULE MouseP (   (*NW 7.9.2015*)
   INOUT msclk, msdat: BIT;
   OUT out: [28] BIT);
   (* init mouse cmd F4 (start reporting) with start, parity and stop bits added *)
-  CONST InitBuf := 0FFFFFDE8H;  (* 1...1 1 0 1111 0100 0 *)
+  CONST InitBuf = 0FFFFFDE8H;  (* 1...1 1 0 1111 0100 0 *)
   REG (clk) x, y: [10] BIT;   (*counters*)
     btns: [3] BIT;
     Q0, Q1, run: BIT;
@@ -29,3 +29,65 @@ BEGIN TS(msclk, msclk0, 0'1, rst);
   y := ~rst -> 0'10 : endbit -> y + dy : y;
   btns := ~rst -> 0'3 : endbit -> {shreg.1, shreg.3, shreg.2} : btns
 END MouseP.
+
+MODULE MouseP (
+  IN clk, rst, msdat: BIT;
+  INOUT msclk: BIT;
+  OUT out: [28] BIT);
+
+  CONST InitBuf := 0; (*0FFFFFBE8H;  hex*)
+  TYPE IOBUF = MODULE (IN I: BIT; OUT O: BIT; INOUT IO: BIT; IN T: BIT) ^;
+  REG x, y: [10] BIT;   (*counters*)
+    btns: [3] BIT;
+    Q0, Q1, run: BIT;
+    shreg: [32] BIT;
+    iobuf: IOBUF;
+  VAR shift, endbit, reply, q: BIT;
+    dx, dy: [10] BIT;
+BEGIN iobuf (0, q msclk, rst);
+  shift := Q1 & ~Q0;   (*falling edge detector*)
+  reply := ~run & ~shreg.11;   (*start bit of echoed initBuf, if response*)
+  endbit := run & ~shreg.0;   (*normal packet received*)
+  dx := {shreg.5 !2, shreg.7 -> 0'8 : shreg[19:12]};   (*sign + ovfl*)
+  dy := {shreg.6 !2, shreg.8 -> 0'8 : shreg[30:23]};   (*sign + ovfl*)
+  out := {run, btns, 0'2, y, 0'2, x};
+
+  run := rst & (reply | run);
+  Q0 := q; Q1 := Q0;
+  shreg := ~rst -> InitBuf : (endbit | reply) -> 0FFFFFFFFH'32: shift -> {msdat, shreg[31:1]} : shreg;
+  x := ~rst -> 0'10 : endbit -> x + dx : x;
+  y := ~rst -> 0'10 : endbit -> y + dy : y;
+  btns := ~rst -> 0'3 : endbit -> {shreg.1, shreg.3, shreg.2} : btns
+END MouseP.
+
+MODULE MouseP (
+  IN clk, rst: BIT;
+  INOUT io: [2] BIT;
+  OUT out: [28] BIT);
+
+  (* init mouse cmd F4 (start reporting) with start, parity and stop bits added *)
+  CONST InitBuf := 0FFFFFDE8H;  (* 1...1 1 0 1111 0100 0 *)
+  TYPE PS2BUF = MODULE (OUT O: [2] BIT; INOUT IO: [2] BIT; IN T: [2] BIT) ^;
+  REG x, y: [10] BIT;   (*counters*)
+    btns: [3] BIT;
+    Q0, Q1, run: BIT;
+    shreg: [32] BIT;
+  VAR shift, endbit, reply: BIT;
+    dx, dy: [10] BIT;
+    in: [2] BIT;
+    ps2buf: PS2BUF;
+BEGIN ps2buf(in, io, {run | shreg[0], rst});  (*open-collector wiring*)
+  shift := Q1 & ~Q0;   (*falling edge detector*)
+  reply := ~run & ~shreg.11;   (*start bit of echoed initBuf, if response*)
+  endbit := run & ~shreg.0;   (*normal packet received*)
+  dx := {shreg.5 !2, shreg.7 -> 0'8 : shreg[19:12]};   (*sign + ovfl*)
+  dy := {shreg.6 !2, shreg.8 -> 0'8 : shreg[30:23]};   (*sign + ovfl*)
+  out := {run, btns, 0'2, y, 0'2, x};
+
+  run := rst & (reply | run);
+  Q0 := in[0]; Q1 := Q0;
+  shreg := ~rst -> InitBuf : (endbit | reply) -> 0FFFFFFFFH'32: shift -> {in[1], shreg[31:1]} : shreg;
+  x := ~rst -> 0'10 : endbit -> x + dx : x;
+  y := ~rst -> 0'10 : endbit -> y + dy : y;
+  btns := ~rst -> 0'3 : endbit -> {shreg.1, shreg.3, shreg.2} : btns
+END MouseP.

BlackBox/Po/Files/Net.Mod.txt

@@ -12,7 +12,8 @@ MODULE Net; (*NW 3.7.88 / 25.8.91 / PR 7.8.13 / 9.12.13*)
   VAR W: Texts.Writer;
      Server: Oberon.Task;
      head0, head1: SCC.Header;
-     partner, dmy: ARRAY 8 OF CHAR;
+     partner: ARRAY 8 OF CHAR;
+     dmy: ARRAY 8 OF BYTE;
      protected: BOOLEAN; (*write-protection*)
 
   PROCEDURE SetPartner(name: ARRAY OF CHAR);
@@ -36,12 +37,13 @@ MODULE Net; (*NW 3.7.88 / 25.8.91 / PR 7.8.13 / 9.12.13*)
   END ReceiveHead;
 
   PROCEDURE FindPartner(name: ARRAY OF CHAR; VAR res: INTEGER);
-    VAR time: LONGINT; k: INTEGER; Id: ARRAY 8 OF CHAR;
+    VAR time: LONGINT; k: INTEGER;
+      Id: ARRAY 8 OF CHAR; IdB: ARRAY 8 OF BYTE;
   BEGIN SCC.Skip(SCC.Available()); res := 0; k := 0;
-    WHILE (k < 7) & (name[k] # 0X) DO Id[k] := name[k]; INC(k) END;
-    Id[k] := 0X;
+    WHILE (k < 7) & (name[k] # 0X) DO Id[k] := name[k]; IdB[k] := ORD(Id[k]); INC(k) END;
+    Id[k] := 0X; IdB[k] := 0; (* <-- also terminate IdB *)
     IF Id # partner THEN
-      head0.dadr := 0FFH; Send(NRQ, k+1, name); time := Oberon.Time() + T1;
+      head0.dadr := 0FFH; Send(NRQ, k+1, IdB); time := Oberon.Time() + T1;
       REPEAT
         SCC.ReceiveHead(head1);
         IF head1.valid THEN
@@ -143,6 +145,7 @@ MODULE Net; (*NW 3.7.88 / 25.8.91 / PR 7.8.13 / 9.12.13*)
       F: Files.File;
       pw, clock, newclock: LONGINT;
       Id: ARRAY 8 OF CHAR;
+      IdB: ARRAY 8 OF BYTE;
       FileName: ARRAY 32 OF CHAR;
   BEGIN
     SCC.ReceiveHead(head1);
@@ -179,7 +182,7 @@ Texts.WriteString(W, FileName);
 INC(i) END ;
         Send(ACK, 0, dmy); reply(0)
       ELSIF head1.typ = TRQ THEN
-        i := 0; AppendW(Oberon.Clock(), Id, 4, i); Send(TIM, 4, Id)
+        i := 0; AppendW(Oberon.Clock(), IdB, 4, i); Send(TIM, 4, IdB)
       ELSIF head1.typ = TIM THEN PickQ(newclock); PickS(Id); PickQ(pw);
         clock := Oberon.Clock();
         IF ~protected & (Id[0] # 0X) & (ABS(pw - clock) > 10) THEN
@@ -372,4 +375,4 @@ Oberon.User);
   END SCCStatus;
 
 BEGIN Texts.OpenWriter(W); Server := Oberon.NewTask(Serve, 500)
-END Net.
+END Net.

BlackBox/Po/Files/ORG.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
+MODULE ORG; (* N.Wirth, 16.4.2016 / 4.4.2017 / 17.9.2018  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".
@@ -6,8 +6,8 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
 
   CONST WordSize* = 4;
     StkOrg0 = -64; VarOrg0 = 0;  (*for RISC-0 only*)
-    MT = 12; SB = 13; SP = 14; LNK = 15;   (*dedicated registers*)
-    maxCode = 8000; maxStrx = 2400; maxTD = 120; C24 = 1000000H;
+    MT = 12; SP = 14; LNK = 15;   (*dedicated registers*)
+    maxCode = 8000; maxStrx = 2400; maxTD = 160; C24 = 1000000H;
     Reg = 10; RegI = 11; Cond = 12;  (*internal item modes*)
 
   (*frequently used opcodes*)  U = 2000H; V = 1000H;
@@ -39,7 +39,6 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     tdx, strx: LONGINT;
     entry: LONGINT;   (*main entry point*)
     RH: LONGINT;  (*available registers R[0] ... R[H-1]*)
-    curSB: LONGINT;  (*current static base in SB*)
     frame: LONGINT;  (*frame offset changed in SaveRegs and RestoreRegs*)
     fixorgP, fixorgD, fixorgT: LONGINT;   (*origins of lists of locations to be fixed up by loader*)
     check: BOOLEAN;  (*emit run-time checks*)
@@ -90,7 +89,8 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   PROCEDURE CheckRegs*;
   BEGIN
     IF RH # 0 THEN ORS.Mark("Reg Stack"); RH := 0 END ;
-    IF pc >= maxCode - 40 THEN ORS.Mark("program too long") END
+    IF pc >= maxCode - 40 THEN ORS.Mark("program too long") END ;
+    IF frame # 0 THEN ORS.Mark("frame error"); frame := 0 END
   END CheckRegs;
 
   PROCEDURE SetCC(VAR x: Item; n: LONGINT);
@@ -109,17 +109,17 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     RETURN cond
   END negated;
 
-  PROCEDURE invalSB;
-  BEGIN curSB := 1
-  END invalSB;
-
   PROCEDURE fix(at, with: LONGINT);
   BEGIN code[at] := code[at] DIV C24 * C24 + (with MOD C24)
   END fix;
 
+  PROCEDURE FixOne*(at: LONGINT);
+  BEGIN fix(at, pc-at-1)
+  END FixOne;
+
   PROCEDURE FixLink*(L: LONGINT);
     VAR L1: LONGINT;
-  BEGIN invalSB;
+  BEGIN
     WHILE L # 0 DO L1 := code[L] MOD 40000H; fix(L, pc-L-1); L := L1 END
   END FixLink;
 
@@ -146,8 +146,8 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
 
   PROCEDURE GetSB(base: LONGINT);
   BEGIN
-    IF (version # 0) & ((base # curSB) OR (base # 0)) THEN
-      Put2(Ldr, SB, -base, pc-fixorgD); fixorgD := pc-1; curSB := base
+    IF version = 0 THEN Put1(Mov, RH, 0, VarOrg0)
+    ELSE Put2(Ldr, RH, -base, pc-fixorgD); fixorgD := pc-1
     END
   END GetSB;
 
@@ -164,7 +164,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
         IF x.type.form = ORB.Proc THEN
           IF x.r > 0 THEN ORS.Mark("not allowed")
           ELSIF x.r = 0 THEN Put3(BL, 7, 0); Put1a(Sub, RH, LNK, pc*4 - x.a)
-          ELSE GetSB(x.r); Put1(Add, RH, SB, x.a + 100H) (*mark as progbase-relative*)
+          ELSE GetSB(x.r); Put1(Add, RH, RH, x.a + 100H) (*mark as progbase-relative*)
           END
         ELSIF (x.a <= 0FFFFH) & (x.a >= -10000H) THEN Put1(Mov, RH, 0, x.a)
         ELSE Put1(Mov+U, RH, 0, x.a DIV 10000H MOD 10000H);
@@ -173,7 +173,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
         x.r := RH; incR
       ELSIF x.mode = ORB.Var THEN
         IF x.r > 0 THEN (*local*) Put2(op, RH, SP, x.a + frame)
-        ELSE GetSB(x.r); Put2(op, RH, SB, x.a)
+        ELSE GetSB(x.r); Put2(op, RH, RH, x.a)
         END ;
         x.r := RH; incR
       ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame); Put2(op, RH, RH, x.b); x.r := RH; incR
@@ -191,7 +191,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   BEGIN
     IF x.mode = ORB.Var THEN
       IF x.r > 0 THEN (*local*) Put1a(Add, RH, SP, x.a + frame)
-      ELSE GetSB(x.r); Put1a(Add, RH, SB, x.a)
+      ELSE GetSB(x.r); Put1a(Add, RH, RH, x.a)
       END ;
       x.r := RH; incR
     ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame);
@@ -223,7 +223,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   END loadTypTagAdr;
 
   PROCEDURE loadStringAdr(VAR x: Item);
-  BEGIN GetSB(0); Put1a(Add, RH, SB, varsize+x.a); x.mode := Reg; x.r := RH; incR
+  BEGIN GetSB(0); Put1a(Add, RH, RH, varsize+x.a); x.mode := Reg; x.r := RH; incR
   END loadStringAdr;
 
   (* Items: Conversion from constants or from Objects on the Heap to Items on the Stack*)
@@ -249,11 +249,10 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   PROCEDURE MakeItem*(VAR x: Item; y: ORB.Object; curlev: LONGINT);
   BEGIN x.mode := y.class; x.type := y.type; x.a := y.val; x.rdo := y.rdo;
     IF y.class = ORB.Par THEN x.b := 0
-    ELSIF y.class = ORB.Typ THEN x.a := y.type.len; x.r := -y.lev
-    ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.b := y.lev  (*len*)
+    ELSIF (y.class = ORB.Const) & (y.type.form = ORB.String) THEN x.b := y.lev  (*len*) ;
     ELSE x.r := y.lev
     END ;
-    IF (y.lev > 0) & (y.lev # curlev) & (y.class # ORB.Const) THEN ORS.Mark("level error, not accessible") END
+    IF (y.lev > 0) & (y.lev # curlev) & (y.class # ORB.Const) THEN ORS.Mark("not accessible ") END
   END MakeItem;
 
   (* Code generation for Selectors, Variables, Constants *)
@@ -291,8 +290,8 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
       IF x.mode = ORB.Var THEN
         IF x.r > 0 THEN Put0(Add, y.r, SP, y.r); INC(x.a, frame)
         ELSE GetSB(x.r);
-          IF x.r = 0 THEN Put0(Add, y.r, SB, y.r)
-          ELSE Put1a(Add, RH, SB, x.a); Put0(Add, y.r, RH, y.r); x.a := 0
+          IF x.r = 0 THEN Put0(Add, y.r, RH, y.r)
+          ELSE Put1a(Add, RH, RH, x.a); Put0(Add, y.r, RH, y.r); x.a := 0
           END
         END ;
         x.r := y.r; x.mode := RegI
@@ -307,7 +306,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   PROCEDURE DeRef*(VAR x: Item);
   BEGIN
     IF x.mode = ORB.Var THEN
-      IF x.r > 0 THEN (*local*) Put2(Ldr, RH, SP, x.a + frame) ELSE GetSB(x.r); Put2(Ldr, RH, SB, x.a) END ;
+      IF x.r > 0 THEN (*local*) Put2(Ldr, RH, SP, x.a + frame) ELSE GetSB(x.r); Put2(Ldr, RH, RH, x.a) END ;
       NilCheck; x.r := RH; incR
     ELSIF x.mode = ORB.Par THEN
       Put2(Ldr, RH, SP, x.a + frame); Put2(Ldr, RH, RH, x.b); NilCheck; x.r := RH; incR
@@ -503,7 +502,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
 
   PROCEDURE Singleton*(VAR x: Item);  (* x := {x} *)
   BEGIN
-    IF x.mode = ORB.Const THEN x.a := LSL(1, x.a)
+    IF x.mode = ORB.Const THEN x.a := LSL(1, x.a) 
     ELSE load(x); Put1(Mov, RH, 0, 1); Put0(Lsl, x.r, RH,  x.r)
     END
   END Singleton;
@@ -610,7 +609,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     IF x.type.size = 1 THEN op := Str+1 ELSE op := Str END ;
     IF x.mode = ORB.Var THEN
       IF x.r > 0 THEN (*local*) Put2(op, y.r, SP, x.a + frame)
-      ELSE GetSB(x.r); Put2(op, y.r, SB, x.a)
+      ELSE GetSB(x.r); Put2(op, y.r, RH, x.a)
       END
     ELSIF x.mode = ORB.Par THEN Put2(Ldr, RH, SP, x.a + frame); Put2(op, y.r, RH, x.b);
     ELSIF x.mode = RegI THEN Put2(op, y.r, x.r, x.a); DEC(RH);
@@ -662,7 +661,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     Put2(Str, RH, x.r, 0); Put1(Add, x.r, x.r, 4);
     Put1(Asr, RH, RH, 24); Put3(BC, NE,  -6);  RH := 0
    END CopyString;
-
+  
   (* Code generation for parameters *)
   
   PROCEDURE OpenArrayParam*(VAR x: Item);
@@ -716,7 +715,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   (* Branches, procedure calls, procedure prolog and epilog *)
 
   PROCEDURE Here*(): LONGINT;
-  BEGIN invalSB; RETURN pc
+  BEGIN RETURN pc
   END Here;
 
   PROCEDURE FJump*(VAR L: LONGINT);
@@ -785,22 +784,20 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     ELSE (*function*)
       IF r > 0 THEN Put0(Mov, r, 0, 0); RestoreRegs(r) END ;
       x.mode := Reg; x.r := r; RH := r+1
-    END ;
-    invalSB
+    END
   END Call;
 
   PROCEDURE Enter*(parblksize, locblksize: LONGINT; int: BOOLEAN);
     VAR a, r: LONGINT;
-  BEGIN invalSB; frame := 0;
+  BEGIN frame := 0;
     IF ~int THEN (*procedure prolog*)
       IF locblksize >= 10000H THEN ORS.Mark("too many locals") END ;
       a := 4; r := 0;
       Put1(Sub, SP, SP, locblksize); Put2(Str, LNK, SP, 0);
       WHILE a < parblksize DO Put2(Str, r, SP, a); INC(r); INC(a, 4) END
     ELSE (*interrupt procedure*)
-      IF locblksize > 0H THEN ORS.Mark("locals not allowed") END ;
-      Put1(Sub, SP, SP, 12); Put2(Str, 0, SP, 0); Put2(Str, 1, SP, 4); Put2(Str, SB, SP, 8)
-      (*R0, R1, SB saved on stack*)
+      Put1(Sub, SP, SP, locblksize); Put2(Str, 0, SP, 0); Put2(Str, 1, SP, 4); Put2(Str, 2, SP, 8)
+      (*R0, R1, R2 saved on stack*)
     END
   END Enter;
 
@@ -809,8 +806,9 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     IF form # ORB.NoTyp THEN load(x) END ;
     IF ~int THEN (*procedure epilog*)
       Put2(Ldr, LNK, SP, 0); Put1(Add, SP, SP, size); Put3(BR, 7, LNK)
-    ELSE (*interrupt return, restore SB, R1, R0*)
-      Put2(Ldr, SB, SP, 8); Put2(Ldr, 1, SP, 4); Put2(Ldr, 0, SP, 0); Put1(Add, SP, SP, 12); Put3(BR, 7, 10H)
+    ELSE (*interrupt return, restore R2, R1, R0*)
+      Put2(Ldr, 2, SP, 8); Put2(Ldr, 1, SP, 4); Put2(Ldr, 0, SP, 0); Put1(Add, SP, SP, size);
+      Put3(BR, 7, 10H) (*RTI*)
     END ;
     RH := 0
   END Return;
@@ -854,7 +852,7 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
   END Assert; 
 
   PROCEDURE New*(VAR x: Item);
-  BEGIN loadAdr(x); loadTypTagAdr(x.type.base); Trap(7, 0); RH := 0; invalSB
+  BEGIN loadAdr(x); loadTypTagAdr(x.type.base); Trap(7, 0); RH := 0
   END New;
 
   PROCEDURE Pack*(VAR x, y: Item);
@@ -1009,8 +1007,8 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
 
   PROCEDURE Header*;
   BEGIN entry := pc*4;
-    IF version = 0 THEN code[0] := 0E7000000H-1 + pc; Put1a(Mov, SB, 0, VarOrg0); Put1a(Mov, SP, 0, StkOrg0)  (*RISC-0*)
-    ELSE Put1(Sub, SP, SP, 4); Put2(Str, LNK, SP, 0); invalSB
+    IF version = 0 THEN code[0] := 0E7000000H-1 + pc;  Put1a(Mov, SP, 0, StkOrg0)  (*RISC-0*)
+    ELSE Put1(Sub, SP, SP, 4); Put2(Str, LNK, SP, 0)
     END
   END Header;
 
@@ -1061,9 +1059,9 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
       obj := obj.next
     END ;
     size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4;  (*varsize includes type descriptors*)
-
+    
     ORB.MakeFileName(name, modid, ".rsc"); (*write code file*)
-    F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteInt(R, key); Files.WriteByte(R, version);
+    F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteInt(R, key); Files.Write(R, CHR(version));
     Files.WriteInt(R, size);
     obj := ORB.topScope.next;
     WHILE (obj # NIL) & (obj.class = ORB.Mod) DO  (*imports*)
@@ -1093,11 +1091,11 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     WHILE obj # NIL DO  (*entries*)
       IF obj.exno # 0 THEN
         IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN
-          Files.WriteInt(R, obj.val)
+          Files.WriteInt(R, obj.val);
         ELSIF obj.class = ORB.Typ THEN
           IF obj.type.form = ORB.Record THEN Files.WriteInt(R,  obj.type.len MOD 10000H)
           ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN
-            Files.WriteInt(R, obj.type.base.len MOD 10000H)
+            Files.WriteInt(R,  obj.type.base.len MOD 10000H)
           END
         END
       END ;
@@ -1113,6 +1111,5 @@ MODULE ORG; (* NW  18.4.2016 / 4.4.2017  code generator in Oberon-07 for RISC*)
     Files.Write(R, "O"); Files.Register(F)
   END Close;
 
-BEGIN
-  relmap[0] := 1; relmap[1] := 9; relmap[2] := 5; relmap[3] := 6; relmap[4] := 14; relmap[5] := 13
+BEGIN relmap[0] := 1; relmap[1] := 9; relmap[2] := 5; relmap[3] := 6; relmap[4] := 14; relmap[5] := 13;
 END ORG.

BlackBox/Po/Files/ORP.Mod.txt

@@ -1,4 +1,4 @@
-MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07*)
+MODULE ORP; (*N. Wirth 1.7.97 / 17.9.2018  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,7 +97,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  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;
-    IF (T.form IN {ORB.Pointer, ORB.Record}) & (T.form = xt.form) THEN
+    IF (T.form = xt.form ) & ((T.form = ORB.Pointer) OR (T.form = ORB.Record) & (x.mode = ORB.Par)) THEN
       WHILE (xt # T) & (xt # NIL) DO xt := xt.base END ;
       IF xt # T THEN xt := x.type;
         IF xt.form = ORB.Pointer THEN
@@ -179,7 +179,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
     END ;
     RETURN com
   END EqualSignatures;
-  
+
   PROCEDURE CompTypes(t0, t1: ORB.Type; varpar: BOOLEAN): BOOLEAN;
   BEGIN (*check for assignment compatibility*)
     RETURN (t0 = t1)    (*openarray assignment disallowed in ORG*)
@@ -310,7 +310,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
     VAR obj: ORB.Object; rx: LONGINT;
   BEGIN (*sync*)
     IF (sym < ORS.char) OR (sym > ORS.ident) THEN ORS.Mark("expression expected");
-      REPEAT ORS.Get(sym) UNTIL (sym >= ORS.char) & (sym <= ORS.ident)
+      REPEAT ORS.Get(sym) UNTIL (sym >= ORS.char) & (sym <= ORS.for) OR (sym >= ORS.then)
     END ;
     IF sym = ORS.ident THEN
       qualident(obj);  
@@ -486,9 +486,9 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
 
   BEGIN (* StatSequence *)
     REPEAT (*sync*) obj := NIL;
-      IF ~((sym = ORS.ident) OR (sym >= ORS.if) & (sym <= ORS.for) OR (sym >= ORS.semicolon)) THEN
+      IF ~((sym >= ORS.ident)  & (sym <= ORS.for) OR (sym >= ORS.semicolon)) THEN
         ORS.Mark("statement expected");
-        REPEAT ORS.Get(sym) UNTIL (sym = ORS.ident) OR (sym >= ORS.if)
+        REPEAT ORS.Get(sym) UNTIL (sym >= ORS.ident)
       END ;
       IF sym = ORS.ident THEN
         qualident(obj); ORG.MakeItem(x, obj, level);
@@ -852,15 +852,17 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
       x: ORG.Item;
       locblksize, parblksize, L: LONGINT;
       int: BOOLEAN;
-  BEGIN (* ProcedureDecl *) int := FALSE; ORS.Get(sym);
+  BEGIN (* ProcedureDecl *) int := FALSE; ORS.Get(sym); 
     IF sym = ORS.times THEN ORS.Get(sym); int := TRUE END ;
     IF sym = ORS.ident THEN
       ORS.CopyId(procid); ORS.Get(sym);
-      ORB.NewObj(proc, ORS.id, ORB.Const); parblksize := 4;
-      NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize; proc.type := type;
+      ORB.NewObj(proc, ORS.id, ORB.Const);
+      IF int THEN parblksize := 12 ELSE parblksize := 4 END ;
+      NEW(type); type.form := ORB.Proc; type.size := ORG.WordSize;
+      proc.type := type; proc.val := -1; proc.lev := level; 
       CheckExport(proc.expo);
       IF proc.expo THEN proc.exno := exno; INC(exno) END ;
-      ORB.OpenScope; INC(level); proc.val := -1; type.base := ORB.noType;
+      ORB.OpenScope; INC(level); type.base := ORB.noType;
       ProcedureType(type, parblksize);  (*formal parameter list*)
       Check(ORS.semicolon, "no ;"); locblksize := parblksize; 
       Declarations(locblksize);
@@ -868,7 +870,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
       IF sym = ORS.procedure THEN
         L := 0; ORG.FJump(L);
         REPEAT ProcedureDecl; Check(ORS.semicolon, "no ;") UNTIL sym # ORS.procedure;
-        ORG.FixLink(L); proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next
+        ORG.FixOne(L); proc.val := ORG.Here() * 4; proc.type.dsc := ORB.topScope.next
       END ;
       ORG.Enter(parblksize, locblksize, int);
       IF sym = ORS.begin THEN ORS.Get(sym); StatSequence END ;
@@ -887,8 +889,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
         ORS.Get(sym)
       ELSE ORS.Mark("no proc id")
       END
-    END ;
-    int := FALSE
+    END
   END ProcedureDecl;
 
   PROCEDURE Module;
@@ -952,7 +953,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
   PROCEDURE Option(VAR S: Texts.Scanner);
   BEGIN newSF := FALSE;
     IF S.nextCh = "/" THEN
-      Texts.Scan(S); Texts.Scan(S);
+      Texts.Scan(S); Texts.Scan(S); 
       IF (S.class = Texts.Name) & (S.s[0] = "s") THEN newSF := TRUE END
     END
   END Option;
@@ -989,7 +990,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 23.9.2017  Oberon compiler for RISC in Oberon-07
     Oberon.Collect(0)
   END Compile;
 
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  4.4.2017");
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler  17.9.2018");
   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 / 20.3.2017  Scanner in Oberon-07*)
+MODULE ORS; (* NW 19.9.93 / 15.3.2017  Scanner in Oberon-07*)
   IMPORT SYSTEM, Texts, Oberon;
 
 (* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
@@ -96,7 +96,7 @@ MODULE ORS; (* NW 19.9.93 / 20.3.2017  Scanner in Oberon-07*)
     VAR i, m, n: INTEGER;
   BEGIN i := 0; Texts.Read(R, ch);
     WHILE ~R.eot & (ch # "$") DO
-      WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END ;  (*skip*)
+      WHILE ~R.eot  & (ch <= " ") DO Texts.Read(R, ch) END ;  (*skip*)
       IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H
       ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H
       ELSE m := 0; Mark("hexdig expected")

BlackBox/Po/Files/RISC5.Lola.txt

@@ -1,4 +1,5 @@
-MODULE RISC5 (IN clk, rst, stallX: BIT;  (*NW 28.10.2016*)
+MODULE RISC5(   (*NW 14.8.2018; with floating-point and interrupts*)
+  IN clk, rst, irq, stallX: BIT;
   IN inbus, codebus: WORD;
   OUT adr: [24] BIT;
     rd, wr, ben: BIT;
@@ -6,94 +7,98 @@ MODULE RISC5 (IN clk, rst, stallX: BIT;  (*NW 28.10.2016*)
   
   CONST StartAdr = 3FF800H'22;
 
-  TYPE PROM := MODULE (IN clk: BIT;
-      IN adr: [9] BIT;
-      OUT data: WORD) ^;
-  
-    Multiplier := MODULE (IN clk, run, u: BIT;
+  TYPE Registers = MODULE (IN clk, wr: BIT;
+      IN rno0, rno1, rno2: [4] BIT;
+      IN din: WORD;
+      OUT dout0, dout1, dout2: WORD) ^;
+
+    Multiplier = MODULE (IN clk, run, u: BIT;
       OUT stall: BIT;
       IN x, y: WORD;
       OUT z: [64] BIT) ^;
 
-    Divider := MODULE (IN clk, run, u: BIT;
+    Divider = MODULE (IN clk, run, u: BIT;
       OUT stall: BIT;
       IN x, y: WORD;
       OUT quot, rem: WORD) ^;
 
-    FPAdder := MODULE (IN clk, run, u, v: BIT; OUT stall: BIT;
+    LeftShifter = MODULE (IN x: WORD; sc: [5] BIT; OUT y: WORD) ^;
+
+    RightShifter = MODULE (IN x: WORD; sc: [5] BIT; md: BIT; OUT y: WORD) ^;
+
+    FPAdder = MODULE (IN clk, run, u, v: BIT; OUT stall: BIT;
       IN x, y: WORD; OUT z: WORD) ^;
 
-    FPMultiplier := MODULE (IN clk, run: BIT; OUT  stall: BIT;
+    FPMultiplier = MODULE (IN clk, run: BIT; OUT  stall: BIT;
       IN x, y: WORD; OUT z: WORD) ^;
 
-    FPDivider := MODULE (IN clk, run: BIT; OUT stall: BIT;
+    FPDivider = MODULE (IN clk, run: BIT; OUT stall: BIT;
       IN x, y: WORD; OUT z: WORD) ^;
 
   REG (clk) PC: [22] BIT;  (*program counter*)
     IR: WORD;   (*instruction register*)
     N, Z, C, OV: BIT;   (*condition flags*)
-    stall1, PMsel: BIT;
-    R: [16] WORD;   (*data registers*)
+    stallL1: BIT;
     H: WORD;  (*auxiliary register*)
+    irq1, intEnb, intPnd, intMd: BIT;
+    SPC: [26] BIT;  (*saved PC on interrupt*)
 
-  VAR PM: PROM;  (*mem for boot loader*)
+  VAR regs: Registers;
     mulUnit: Multiplier;
     divUnit: Divider;
+    LshUnit: LeftShifter;
+    RshUnit: RightShifter;
     faddUnit: FPAdder;
     fmulUnit: FPMultiplier;
     fdivUnit: FPDivider;
 
-    pcmux, nxpc: [22] BIT;
+    pcmux, pcmux0, nxpc: [22] BIT;
     cond, S: BIT;
     sa, sb, sc: BIT;
 
-    ins, pmout: WORD;
-    p, q, u, v, w: BIT;   (*instruction fields*)
+    p, q, u, v: BIT;   (*instruction fields*)
     op, ira, ira0, irb, irc: [4] BIT;
     cc: [3] BIT;
     imm: [16] BIT;
     off: [20] BIT;
     disp: [22] BIT;
 
-    regwr, ccwr: BIT;
-    stall, stallL, stallM, stallD, stallFA, stallFM, stallFD: BIT;
-    sc1, sc0: [2] BIT;  (*shift counts*)
-
-    a0, a1, a2, a3: BIT;
-    inbusL, outbusB0, outbusB1, outbusB2, outbusB3: BYTE;
-    inbusH: [24] BIT;
+    regwr: BIT;
+    stall, stallL0, stallM, stallD, stallFA, stallFM, stallFD: BIT;
+    intAck, nn, zz, cx, vv: BIT;
 
-    A, B, C0, C1, aluRes, regmux: WORD;
-    s1, s2, s3, t1, t2, t3: WORD;  (*shifting*)
+    A, B, C0, C1, aluRes, regmux, inbus1: WORD;
+    lshout, rshout: WORD;  (*shifting*)
     quotient, remainder: WORD;
     product: [64] BIT;
     fsum, fprod, fquot: WORD;
 
     Add, Sub, Mul, Div: BIT;
     Fadd, Fsub, Fmul, Fdiv: BIT; 
-    Ldr, Str, Br: BIT;
+    Ldr, Str, Br, RTI: BIT;
 
-BEGIN PM(clk, pcmux[8:0], pmout);
+BEGIN 
+  regs (clk, regwr, ira0, irb, irc, regmux, A, B, C0);
   mulUnit (clk, Mul, ~u, stallM, B, C1, product);
   divUnit (clk, Div, ~u, stallD, B, C1, quotient, remainder);
+  LshUnit (B, C1[4:0], lshout);
+  RshUnit (B, C1[4:0], IR.16, rshout);
   faddUnit (clk, Fadd|Fsub, u, v, stallFA, B, {Fsub^C0.31, C0[30:0]}, fsum);
   fmulUnit (clk, Fmul, stallFM, B, C0, fprod);
   fdivUnit (clk, Fdiv, stallFD, B, C0, fquot);
 
-  ins := PMsel -> pmout : IR;  (*current instruction*)
-  p := ins.31;  (*instruction fields*)
-  q := ins.30;
-  u := ins.29;
-  v := ins.28;
-  w := ins.16;
-  cc:= ins[26:24];
-  ira := ins[27:24];
-  irb := ins[23:20];
-  op := ins[19:16];
-  irc := ins[3:0];
-  imm := ins[15:0];  (*reg instr*)
-  off := ins[19:0];    (*mem instr*)
-  disp := ins[21:0];  (*branch instr*)
+  p := IR.31;  (*instruction fields*)
+  q := IR.30;
+  u := IR.29;
+  v := IR.28;
+  cc:= IR[26:24];
+  ira := IR[27:24];
+  irb := IR[23:20];
+  op := IR[19:16];
+  irc := IR[3:0];
+  imm := IR[15:0];  (*reg instr*)
+  off := IR[19:0];    (*mem instr*)
+  disp := IR[21:0];  (*branch instr*)
 
   Add := ~p & (op = 8);
   Sub := ~p & (op = 9);
@@ -106,39 +111,16 @@ BEGIN PM(clk, pcmux[8:0], pmout);
   Ldr := p & ~q & ~u;
   Str := p & ~q & u;
   Br := p & q;
+  RTI := Br & ~u & ~v & IR[4];
 
   (*ALU*)
-  A := R[ira0];  (*main data path*)
-  B := R[irb];
-  C0 := R[irc];
   C1 := q -> {v!16, imm} : C0 ;
   ira0 := Br -> 15'4 : ira;
-  adr := stallL -> B[23:0] + {off.19 ! 4, off} : {pcmux, 0'2};
-  rd := Ldr & ~stallX & ~stall1;
-  wr := Str & ~stallX & ~stall1;
-  ben := p & ~q & v & ~stallX & ~stall1; (*byte enable*)
+  adr := stallL0 -> B[23:0] + {off.19 ! 4, off} : {pcmux, 0'2};
+  rd := Ldr & ~stallX & ~stallL1;
+  wr := Str & ~stallX & ~stallL1;
+  ben := p & ~q & v & ~stallX & ~stallL1; (*byte enable*)
 
-  sc0 := C1[1:0];
-  sc1 := C1[3:2];
-  
-  (*right shifter*)
-  s1 := (sc0 = 3) -> {(w -> B[2:0] : {B.31 ! 3}), B[31:3]} :
-      (sc0 = 2) -> {(w -> B[1:0] : {B.31 ! 2}), B[31:2]} :
-      (sc0 = 1) -> {(w -> B.0 : B.31), B[31:1]} : B;
-  s2 := (sc1 = 3) -> {(w -> s1[11:0] : {B.31 ! 12}), s1[31:12]} :
-      (sc1 = 2) -> {(w -> s1[7:0] : {B.31 ! 8}), s1[31:8]} :
-      (sc1 = 1) -> {(w -> s1[3:0] : {B.31 ! 4}), s1[31:4]} : s1;
-  s3 := C1.4 -> {(w -> s2[15:0] : {s2.31 ! 16}), s2[31:16]} : s2;
-
-  (*left shifter*)
-  t1 := (sc0 = 3) -> {B[28:0], 0'3} :
-      (sc0 = 2) -> {B[29:0], 0'2} :
-      (sc0 = 1) -> {B[30:0], 0'1} : B;
-  t2 := (sc1 = 3) -> {t1[19:0], 0'12} :
-      (sc1 = 2) -> {t1[23:0], 0'8} :
-      (sc1 = 1) -> {t1[27:0], 0'4} : t1;
-  t3 := C1.4 -> {t2[15:0], 0'16} : t2;
- 
   aluRes :=
     ~op.3 ->
       (~op.2 ->
@@ -146,9 +128,9 @@ BEGIN PM(clk, pcmux[8:0], pmout);
           (~op.0 ->  (*Mov*)
             (q -> 
               (~u ->  {v!16 , imm} : {imm, 0'16}) :
-              (~u -> C0 : (~v -> H : {N, Z, C, OV, 0'20, 58H'8}))) :
-            t3 ):   (*Lsl*)
-          s3) :   (*Asr, Ror*)
+              (~u -> C0 : (~v -> H : {N, Z, C, OV, 0'20, 5BH'8}))) :
+            lshout ):   (*Lsl*)
+          rshout) :   (*Asr, Ror*)
         (~op.1 -> 
           (~op.0 -> B & C1 : B & ~C1) :   (*And, Ann*)
           (~op.0 -> B | C1 : B ^ C1)) ):   (*Ior, Xor*)
@@ -160,26 +142,19 @@ BEGIN PM(clk, pcmux[8:0], pmout);
           fsum :     (*Fad, Fsb*)
           (~op.0 -> fprod : fquot))) ;  (*Fml, Fdv*)
 
-  ccwr := ~p & ~stall | (Ldr & ~stallX & ~stall1);
-  regwr := ccwr | (Br & cond & v & ~stallX);
-  a0 := ~adr.1 & ~adr.0;
-  a1 := ~adr.1 & adr.0;
-  a2 := adr.1 & ~adr.0;
-  a3 := adr.1 & adr.0;
-  inbusL := (~ben | a0) -> inbus[7:0] : a1 -> inbus[15:8] : a2 -> inbus[23:16] : inbus[31:24];
-  inbusH := ~ben -> inbus[31:8] : 0'24;
-  regmux := Ldr -> {inbusH, inbusL} : (Br & v) -> {0'8, nxpc, 0'2} : aluRes ;
-
-  outbusB0 := A[7:0];
-  outbusB1 := ben & a1 -> A[7:0] : A[15:8];
-  outbusB2 := ben & a2 -> A[7:0] : A[23:16];
-  outbusB3 := ben & a3 -> A[7:0] : A[31:24];
-  outbus := {outbusB3, outbusB2, outbusB1, outbusB0};
+  regwr := ~p & ~stall | (Ldr & ~stallX & ~stallL1) | (Br & cond & v & ~stallX);
+  regmux := Ldr -> inbus1 : (Br  & v) -> {0'8, nxpc, 0'2} : aluRes ;
+  inbus1 := ~ben -> inbus :
+    {0'24, (adr[1] -> (adr[0] -> inbus[31:24] : inbus[23:16]) :
+            (adr[0] -> inbus[15:8] : inbus[7:0]))};
+  outbus := ~ben -> A :
+    adr[1] -> (adr[0] -> {A[7:0], 0'24} : {0'8, A[7:0], 0'16}) :
+            (adr[0] -> {0'16, A[7:0], 0'8} : {0'24, A[7:0]});
 
   (*control unit*)
   S := N ^ OV;
   nxpc := PC + 1;
-  cond := ins.27 ^ (
+  cond := IR.27 ^ (
       (cc = 0) & N  |  (*MI, PL*)
       (cc = 1) & Z  |  (*EQ, NE*)
       (cc = 2) & C  |  (*CS, CC*)
@@ -188,29 +163,39 @@ BEGIN PM(clk, pcmux[8:0], pmout);
       (cc = 5) & S  |  (*LT, GE*)
       (cc = 6) & (S|Z) | (*LE, GT*)
       (cc = 7));
-  pcmux := ~rst -> 3FF800H'22 :
-    stall -> PC :
-    (Br & cond & u) -> disp + nxpc :
-    (Br & cond & ~u) -> C0[23:2] : nxpc;
+
+  intAck := intPnd & intEnb & ~intMd & ~stall;
+  pcmux0 := stall -> PC :
+    RTI-> SPC[21:0] :
+    (Br & cond) -> (u -> disp + nxpc : C0[23:2]) : nxpc;
+  pcmux := ~rst -> StartAdr : intAck -> 1 : pcmux0;
 
   sa := aluRes.31;
   sb := B.31;
   sc := C1.31;
 
-  stall := stallL | stallM | stallD | stallFA | stallFM | stallFD | stallX;
-  stallL := (Ldr | Str) & ~stall1;
+  nn := RTI -> SPC[25] : regwr -> regmux.31 : N;
+  zz := RTI -> SPC[24] :  regwr -> (regmux = 0) : Z;
+  cx := RTI -> SPC[23] :
+    Add -> (sb&sc) | (~sa&~sb&sc) | (~sa&sb&~sc&sa) :
+    Sub -> (~sb&sc) | (sa&~sb&~sc) | (sa&sb&sc) : C;
+  vv := RTI -> SPC[22] :
+    Add -> (sa&~sb&~sc) | (~sa&sb&sc) :
+    Sub -> (sa&~sb&sc) | (~sa&sb&~sc) : OV;
+
+  stall := stallL0 | stallM | stallD | stallFA | stallFM | stallFD | stallX;
+  stallL0 := (Ldr | Str) & ~stallL1;
   
   (*assignments to registers*)
   PC := pcmux;
-  PMsel := ~rst | (pcmux[21:12] = 03FFH'10);
   IR := stall -> IR : codebus;
-  stall1 := stallX -> stall1 : stallL;
-  R[ira0] := regwr -> regmux : A;
-  N := regwr -> regmux.31 : N;
-  Z := regwr -> (regmux = 0) : Z;
-  C := Add -> (sb&sc) | (~sa&~sb&sc) | (~sa&sb&~sc&sa) :
-    Sub -> (~sb&sc) | (sa&~sb&~sc) | (sa&sb&sc) : C;
-  OV := Add -> (sa&~sb&~sc) | (~sa&sb&sc) :
-    Sub -> (sa&~sb&sc) | (~sa&sb&~sc) : OV;
-  H := Mul -> product[63:32] : Div -> remainder : H
+  stallL1 := stallX -> stallL1 : stallL0;
+  N := nn; Z := zz; C := cx; OV := vv;
+  H := Mul -> product[63:32] : Div -> remainder : H;
+
+  irq1 := irq;   (*edge detector*)
+  intPnd := rst & ~intAck & ((~irq1 & irq) | intPnd);
+  intMd := rst & ~RTI & (intAck | intMd);
+  intEnb := ~rst -> 0 : (Br & ~u & ~v & IR[5]) -> IR[0] : intEnb;
+  SPC := intAck -> {nn, zz, cx, vv, pcmux0} : SPC
 END RISC5.

BlackBox/Po/Files/RISC5.v

@@ -1,4 +1,4 @@
-`timescale 1ns / 1ps  // 13.9.2016
+`timescale 1ns / 1ps  // 9.11.2016
 
 module RISC5(
 input clk, rst, stallX,
@@ -21,7 +21,7 @@ wire [21:0] pcmux, nxpc;
 wire cond, S;
 wire sa, sb, sc;
 
-wire p, q, u, v, w;  // instruction fields
+wire p, q, u, v;  // instruction fields
 wire [3:0] op, ira, ira0, irb, irc;
 wire [2:0] cc;
 wire [15:0] imm;
@@ -30,19 +30,18 @@ wire [21:0] disp;
 
 wire regwr;
 wire stall, stallL, stallM, stallD, stallFA, stallFM, stallFD;
-wire [1:0] sc1, sc0;  // shift counts
-
 wire a0, a1, a2, a3;
 wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3;
 wire [23:0] inbusH;
 
 wire [31:0] A, B, C0, C1, aluRes, regmux;
-wire [31:0] s1, s2, s3, t1, t2, t3;
+wire [31:0] lshout, rshout;
 wire [31:0] quotient, remainder;
 wire [63:0] product;
 wire [31:0] fsum, fprod, fquot;
 
-wire ADD, SUB, MUL, DIV; wire FAD, FSB, FML, FDV;
+wire ADD, SUB, MUL, DIV;
+wire FAD, FSB, FML, FDV;
 wire LDR, STR, BR;
 
 PROM PM (.adr(pcmux[8:0]), .data(pmout), .clk(clk));
@@ -53,6 +52,10 @@ Multiplier mulUnit (.clk(clk), .run(MUL), .stall(stallM),
 Divider divUnit (.clk(clk), .run(DIV), .stall(stallD),
    .u(~u), .x(B), .y(C1), .quot(quotient), .rem(remainder));
 
+LeftShifter LSUnit (.x(B), .y(lshout), .sc(C1[4:0]));
+
+RightShifter RSUnit(.x(B), .y(rshout), .sc(C1[4:0]), .md(ins[16]));
+
 FPAdder fpaddx (.clk(clk), .run(FAD|FSB), .u(u), .v(v), .stall(stallFA),
    .x(B), .y({FSB^C0[31], C0[30:0]}), .z(fsum));
 
@@ -67,7 +70,6 @@ assign p = ins[31];
 assign q = ins[30];
 assign u = ins[29];
 assign v = ins[28];
-assign w = ins[16];
 assign cc  = ins[26:24];
 assign ira = ins[27:24];
 assign irb = ins[23:20];
@@ -97,33 +99,11 @@ assign C0 = R[irc];
 // Arithmetic-logical unit (ALU)
 assign ira0 = BR ? 15 : ira;
 assign C1 = q ? {{16{v}}, imm} : C0;
-// assign adr = stallL ? B[23:0] + {4'b0, off} : {pcmux, 2'b00};
 assign adr = stallL ? B[23:0] + {{4{off[19]}}, off} : {pcmux, 2'b00};
 assign rd = LDR & ~stallX & ~stall1;
 assign wr = STR & ~stallX & ~stall1;
 assign ben = p & ~q & v & ~stallX & ~stall1;  // byte enable
 
-assign sc0 = C1[1:0];
-assign sc1 = C1[3:2];
-
-// shifter for ASR and ROR
-assign s1 = (sc0 == 3) ? {(w ? B[2:0] : {3{B[31]}}), B[31:3]} :
-    (sc0 == 2) ? {(w ? B[1:0] : {2{B[31]}}), B[31:2]} :
-    (sc0 == 1) ? {(w ? B[0] : B[31]), B[31:1]} : B;
-assign s2 = (sc1 == 3) ? {(w ? s1[11:0] : {12{s1[31]}}), s1[31:12]} :
-    (sc1 == 2) ? {(w ? s1[7:0] : {8{s1[31]}}), s1[31:8]} :
-    (sc1 == 1) ? {(w ? s1[3:0] : {4{s1[31]}}), s1[31:4]} : s1;
-assign s3 = C1[4] ? {(w ? s2[15:0] : {16{s2[31]}}), s2[31:16]} : s2;
-
-// shifter for LSL
-assign t1 = (sc0 == 3) ? {B[28:0], 3'b0} :
-    (sc0 == 2) ? {B[29:0], 2'b0} :
-    (sc0 == 1) ? {B[30:0], 1'b0} : B;
-assign t2 = (sc1 == 3) ? {t1[19:0], 12'b0} :
-    (sc1 == 2) ? {t1[23:0], 8'b0} :
-    (sc1 == 1) ? {t1[27:0], 4'b0} : t1;
-assign t3 = C1[4] ? {t2[15:0], 16'b0} : t2;
-
 assign aluRes =  // 21.71 ns
   ~op[3] ?
     (~op[2] ?
@@ -132,8 +112,8 @@ assign aluRes =  // 21.71 ns
           (q ?  // MOV
             (~u ? {{16{v}}, imm} : {imm, 16'b0}) :
             (~u ? C0 : (~v ? H : {N, Z, C, OV, 20'b0, 8'h50}))) :
-          t3) :  //  LSL
-        s3) : //  ASR, ROR
+          lshout) :  //  LSL
+        rshout) : //  ASR, ROR
       (~op[1] ?
         (~op[0] ? B & C1 : B & ~C1) :  // AND, ANN
         (~op[0] ? B | C1 : B ^ C1))) : // IOR. XOR

BlackBox/Po/Files/RISC5Top.Lola.txt

@@ -1,4 +1,4 @@
-MODULE RISC5Top(   (*NW 28.10.2016*)
+MODULE RISC5Top(   (*NW 25.7.2018*)
   IN CLK50M: BIT;
   IN btn: [4] BIT;
   IN swi: BYTE;
@@ -30,33 +30,37 @@ MODULE RISC5Top(   (*NW 28.10.2016*)
   8  general-purpose I/O data
   9  general-purpose I/O tri-state control *)
 
-TYPE RISC5 := MODULE (
-    IN clk, rst, stallX: BIT;
+TYPE RISC5 = MODULE (
+    IN clk, rst, irq, stallX: BIT;
       inbus, codebus: WORD;
     OUT adr: [24] BIT;
       rd, wr, ben: BIT;
       outbus: WORD) ^;
 
-  RS232R := MODULE (
+  PROM = MODULE (IN clk: BIT;
+      IN adr: [9] BIT;
+      OUT data: WORD) ^;
+
+  RS232R = MODULE (
     IN clk, rst, done, RxD, fsel: BIT;
     OUT rdy: BIT; data: BYTE) ^;
 
-  RS232T := MODULE (
+  RS232T = MODULE (
     IN clk, rst, start, fsel: BIT; data: BYTE;
     OUT rdy, TxD: BIT) ^;
 
-  SPI := MODULE (
+  SPI = MODULE (
     IN clk, rst, start, fast: BIT; dataTx: WORD;
     OUT dataRx: WORD; rdy: BIT;
     IN MISO: BIT; 
     OUT MOSI, SCLK: BIT)  ^;
 
-  VID := MODULE (
+  VID = MODULE (
     IN clk, inv: BIT; viddata: WORD;
     OUT req: BIT; vidadr: [18] BIT;
       hsync, vsync: BIT; RGB: [3] BIT) ^;
 
-  MouseP := MODULE ( 
+  MouseP = MODULE ( 
     IN clk, rst: BIT;
     INOUT msclk, msdat: BIT;
     OUT out: [28] BIT) ^;
@@ -75,7 +79,8 @@ REG (clk) rst: BIT;
   spiCtrl: [4] BIT;
   gpout, gpoc: BYTE;
 
-VAR riscx: RISC5;
+VAR riscx: RISC5;   (*instantiations*)
+  PM: PROM;  (*mem for boot loader*)
   receiver: RS232R;
   transmitter: RS232T;
   spi: SPI;  (*CD-ROM and net*)
@@ -90,6 +95,7 @@ VAR riscx: RISC5;
   be0, be1: BIT;
   inbus, inbus0: WORD;  (*data to RISC6 core*)
   outbus: WORD;   (*data from RISC6 core*)
+  romout, codebus: WORD;
 
   dataTx, dataRx, dataKbd: BYTE;
   rdyRx, doneRx, startTx, rdyTx, rdyKbd, doneKbd: BIT;
@@ -101,7 +107,8 @@ VAR riscx: RISC5;
   gpin: BYTE;
 
 BEGIN
-  riscx (clk, rst, dspreq, inbus, inbus0, adr, rd, wr, ben, outbus);
+  riscx (clk, rst, limit, dspreq, inbus, codebus, adr, rd, wr, ben, outbus);
+  PM (~clk, adr[10:2], romout);
   receiver (clk, rst, doneRx, RxD, bitrate, rdyRx, dataRx);
   transmitter (clk, rst, startTx, bitrate, dataTx, rdyTx, TxD);
   spi (clk, rst, spiStart, spiCtrl.2, outbus, spiRx, spiRdy, MISO.0 & MISO.1, MOSI1, SCLK1); 
@@ -111,6 +118,7 @@ BEGIN
   TS(SRdat, inbus0, outbus, ~wr);
   TS(gpio, gpin, gpout, gpoc);
 
+  codebus := (adr[23:14] = 3FFH'10) -> romout : inbus0;
   iowadr := adr[5:2];
   ioenb := (adr[23:6] = 3FFFFH'18);
   inbus := ~ioenb -> inbus0 :

BlackBox/Po/Files/RightShifter.Lola.txt

@@ -0,0 +1,16 @@
+MODULE RightShifter(    (*NW 11.11.2016*)
+  IN x: WORD; sc: [5] BIT; md: BIT;    (*md = 0 -> rotate; md = 1 -=> arith shift*)
+  OUT y: WORD);
+
+  VAR sc0, sc1: [2] BIT;
+    s1, s2: WORD;
+
+BEGIN sc0 := sc[1:0]; sc1 := sc[3:2];
+  s1 := (sc0 = 3) -> {(md -> x[2:0] : {x.31 ! 3}), x[31:3]} :
+      (sc0 = 2) -> {(md -> x[1:0] : {x.31 ! 2}), x[31:2]} :
+      (sc0 = 1) -> {(md -> x.0 : x.31), x[31:1]} : x;
+  s2 := (sc1 = 3) -> {(md -> s1[11:0] : {x.31 ! 12}), s1[31:12]} :
+      (sc1 = 2) -> {(md -> s1[7:0] : {x.31 ! 8}), s1[31:8]} :
+      (sc1 = 1) -> {(md -> s1[3:0] : {x.31 ! 4}), s1[31:4]} : s1;
+  y := sc.4 -> {(md -> s2[15:0] : {s2.31 ! 16}), s2[31:16]} : s2;
+END RightShifter.

BlackBox/Po/Files/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 / 30.11.2018*)
+MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 7.1.2019*)
   IMPORT Files, Fonts;
 
   CONST (*scanner symbol classes*)
@@ -240,7 +240,8 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 30
     END;
     T.len := T.len + B.len; end := pos + B.len;
     B.last := B.header; B.last.next := NIL; B.len := 0;
-    T.changed := TRUE; T.notify(T, insert, pos, end)
+    T.changed := TRUE;
+    IF T.notify # NIL THEN  T.notify(T, insert, pos, end) END
   END Insert;
 
   PROCEDURE Append* (T: Text; B: Buffer);
@@ -261,7 +262,8 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 30
     B.last.next := NIL; B.len := end - beg;
     per.prev := pbr.prev; pbr.prev.next := per;
     T.len := T.len - B.len;
-    T.changed := TRUE; T.notify(T, delete, beg, end)
+    T.changed := TRUE;
+    IF T.notify # NIL THEN T.notify(T, delete, beg, end) END
   END Delete;
 
   PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: Fonts.Font; col, voff: INTEGER);
@@ -277,7 +279,8 @@ MODULE Texts; (*JG 21.11.90 / NW 11.7.90 / 24.12.95 / 22.11.10 / 18.11.2014 / 30
       IF 2 IN sel THEN p.voff := voff END;
       p := p.next
     UNTIL p = pe;
-    T.changed := TRUE; T.notify(T, replace, beg, end)
+    T.changed := TRUE;
+    IF T.notify # NIL THEN T.notify(T, replace, beg, end) END
   END ChangeLooks;
 
   PROCEDURE Attributes*(T: Text; pos: LONGINT; VAR fnt: Fonts.Font; VAR col, voff: INTEGER);

BlackBox/Po/Files/VID.Lola.txt

@@ -6,7 +6,7 @@ MODULE VID (
     hsync, vsync: BIT;  (*to display*)
     RGB: [3] BIT);
 
-  CONST Org := 37FC0H; (* DFF00: adr of vcnt=1023 *)
+  CONST Org = 37FC0H; (* DFF00: adr of vcnt=1023 *)
   TYPE DCMX3 = MODULE (IN CLKIN: BIT; OUT CLKFX: BIT) ^;
   VAR hend, vend, vblank, xfer, vid, pclk: BIT;
     dcmx3: DCMX3;
@@ -36,3 +36,38 @@ BEGIN dcmx3 (clk, pclk);  (* pixel clock generation *)
   req := req1; req1 := ~vblank & ~hcnt.10 & (hcnt.5 ^ hword.0);
   vidbuf := req -> viddata : vidbuf
 END VID.
+
+MODULE VID (
+  IN clk, inv: BIT;
+    viddata: WORD;
+  OUT  req: BIT;   (*SRAM read request*)
+    vidadr: [18] BIT;
+    hsync, vsync: BIT;
+    RGB: [3] BIT);
+
+  CONST Org := 0DFF00H;
+  REG (clk) hcnt, vcnt: [10] BIT;
+    buffer: WORD;  (*from hcnt, but latched in the clk domain*)
+    hblank1: BIT;
+  VAR hend, vend, hblank, vblank, pixel, vid: BIT;
+    
+BEGIN (*25MHz clock; 2 pixels per cycle*)
+  hend := (hcnt = 591);
+  vend := (vcnt = 791);
+  hblank := hcnt.9;  (*hcnt = 512*)
+  vblank := vcnt.8 & vcnt.9;  (*vcnt >= 768*)
+  hsync := (hcnt >= 537) & (hcnt < 553);
+  vsync := ~((vcnt >= 772) & (vcnt < 776));
+
+  vidadr := {0'3, ~vcnt, hcnt[8:4]} + 37FC0H'18;
+  req := ~vblank & ~hcnt.9 & (hcnt[3:0] = 0'4);
+  pixel := clk -> buffer.0 : buffer.1;
+  vid := (pixel ^ inv) & ~hblank1 & ~vblank;
+  RGB := {vid, vid, vid};
+
+  hcnt := hend -> 0 : hcnt+1;
+  vcnt := hend -> (vend -> 0 : vcnt+1) : vcnt;
+  hblank1 := hblank;
+  buffer := req -> viddata : {0'2, buffer[31:2]}
+END VID.
+