├── Lola ├── Lola2.pdf ├── LolaCompiler.pdf └── Sources │ ├── DCMX3.v │ ├── Divider.Lola │ ├── FPAdder.Lola │ ├── FPDivider.Lola │ ├── FPMultiplier.Lola │ ├── LSB.Mod │ ├── LSC.Mod │ ├── LSP.Mod │ ├── LSS.Mod │ ├── LSV.Mod │ ├── MouseP.Lola │ ├── Multiplier.Lola │ ├── PS2.Lola │ ├── RISC5.Lola │ ├── RISC5Top.Lola │ ├── RS232R.Lola │ ├── RS232T.Lola │ ├── SPI.Lola │ ├── SmallPrograms.Lola │ └── VID.Lola ├── Oberon07.Report.pdf ├── PIO.pdf ├── PO.Applications.pdf ├── PO.Computer.pdf ├── PO.System.pdf ├── README.md ├── Sources ├── Blink.Mod ├── BootLoad.Mod ├── Checkers.Mod ├── Curves.Mod ├── Display.Mod ├── Draw.Mod ├── Draw.Tool ├── EBNF.Mod ├── Edit.Mod ├── FileDir.Mod ├── Files.Mod ├── Fonts.Mod ├── GraphTool.Mod ├── GraphicFrames.Mod ├── Graphics.Mod ├── Hilbert.Mod ├── Input.Mod ├── Kernel.Mod ├── MacroTool.Mod ├── Math.Mod ├── MenuViewers.Mod ├── Modules.Mod ├── Net.Mod ├── ORB.Mod ├── ORC.Mod ├── ORG.Mod ├── ORP.Mod ├── ORS.Mod ├── ORTool.Mod ├── Oberon.Mod ├── OberonSyntax.Text ├── PCLink1.Mod ├── PIO.Mod ├── RISC.Mod ├── RS232.Mod ├── Rectangles.Mod ├── SCC.Mod ├── Sierpinski.Mod ├── SmallPrograms.Mod ├── Stars.Mod ├── System.Mod ├── System.Tool ├── TextFrames.Mod ├── Texts.Mod ├── Tools.Mod └── Viewers.Mod ├── SourcesVerilog ├── Divider.v ├── Divider0.v ├── FPAdder.v ├── FPDivider.v ├── FPMultiplier.v ├── MouseP.v ├── MouseX.v ├── Multiplier.v ├── Multiplier1.v ├── PROM.v ├── PS2.v ├── RISC5.ucf ├── RISC5.v ├── RISC5Top.v ├── RS232R.v ├── RS232T.v ├── SPI.v └── VID.v ├── UsingOberon.pdf ├── license.txt ├── news.txt └── oberonV5.jpg /Lola/Lola2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/Lola/Lola2.pdf -------------------------------------------------------------------------------- /Lola/LolaCompiler.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/Lola/LolaCompiler.pdf -------------------------------------------------------------------------------- /Lola/Sources/DCMX3.v: -------------------------------------------------------------------------------- 1 | module DCMX3 (input CLKIN, output CLKFX); 2 | (* LOC = "DCM_X1Y1" *) DCM #(.CLKFX_MULTIPLY(3), .CLK_FEEDBACK("NONE")) 3 | dcm(.CLKIN(CLKIN), .CLKFX(CLKFX)); 4 | endmodule 5 | -------------------------------------------------------------------------------- /Lola/Sources/Divider.Lola: -------------------------------------------------------------------------------- 1 | MODULE Divider( (*NW 14.9.2015*) 2 | IN clk, run, u: BIT; 3 | OUT stall: BIT; 4 | IN x, y: WORD; (*y > 0*) 5 | OUT quot, rem: WORD); 6 | 7 | REG (clk) S: [6] BIT; 8 | RQ: [64] BIT; 9 | VAR sign: BIT; 10 | x0, w0, w1: WORD; 11 | BEGIN stall := run & (S # 33); 12 | sign := x.31 & u; 13 | x0 := sign -> -x : x; 14 | w0 := RQ[62:31]; 15 | w1 := w0 - y; 16 | S := run -> S+1 : 0; 17 | quot := ~sign -> RQ[31:0] : (RQ[63:32] = 0) -> -RQ[31:0] : -RQ[31:0] - 1; 18 | rem := ~sign -> RQ[63:32] : (RQ[63:32] = 0) -> 0 : y - RQ[63:32]; 19 | RQ := (S = 0) -> {0'32, x0} : {w1.31 -> w0 : w1, RQ[30:0], ~w1[31]} 20 | END Divider. 21 | -------------------------------------------------------------------------------- /Lola/Sources/FPAdder.Lola: -------------------------------------------------------------------------------- 1 | MODULE FPAdder( (*NW 28.9.2015*) 2 | IN clk, run, u, v: BIT; x, y: WORD; 3 | OUT stall: BIT; z: WORD); 4 | 5 | REG (clk) State: [2] BIT; 6 | x3, y3, t3: [25] BIT; 7 | Sum: [27] BIT; 8 | 9 | VAR xs, ys: BIT; (*signs*) 10 | xe, ye: [9] BIT; (*exponents*) 11 | xm, ym: [25] BIT; (*mantissas*) 12 | 13 | dx, dy, e0, e1: [9] BIT; 14 | sx, sy: [9] BIT; (*shift counts*) 15 | sx0, sx1, sy0, sy1: [2] BIT; 16 | sxh, syh: BIT; 17 | x0, x1,x2, y0, y1, y2: [25] BIT; 18 | s: [27] BIT; 19 | 20 | z24, z22, z20, z18, z16, z14, z12, z10, z8, z6, z4, z2: BIT; 21 | sc: [5] BIT; (*shift count*) 22 | sc0, sc1: [2] BIT; 23 | t1, t2: [25] BIT; 24 | 25 | BEGIN (*unpack*) 26 | xs := x.31; 27 | xe := u -> 150'9 : {0'1, x[30:23]}; 28 | xm := {(~u | x.23), x[22:0], 0'1}; 29 | ys := y.31; 30 | ye := {0'1, y[30:23]}; 31 | ym := {(~u & ~v), y[22:0], 0'1}; 32 | dx := xe - ye; dy := ye - xe; 33 | e0 := dx.8 -> ye : xe; 34 | sx := dy.8 -> 0 : dy; sy := dx.8 -> 0 : dx; 35 | sx0 := sx[1:0]; sx1 := sx[3:2]; 36 | sy0 := sy[1:0]; sy1 := sy[3:2]; 37 | sxh := sx.7 | sx.6 | sx.5; syh := sy.7 | sy.6 | sy.5; 38 | 39 | (*denormalize; right shift*) 40 | x0 := (xs & ~u) -> -xm : xm; 41 | x1 := (sx0 = 3) -> {xs!3, x0[24:3]} : 42 | (sx0 = 2) -> {xs!2, x0[24:2]} : 43 | (sx0 = 1) -> {xs, x0[24:1]} : x0; 44 | x2 := (sx1 = 3) -> {xs!12, x1[24:12]} : 45 | (sx1 = 2) -> {xs!8, x1[24:8]} : 46 | (sx1 = 1) -> {xs!4, x1[24:4]} : x1; 47 | x3 := sxh -> {xs!25} : sx.4 -> {xs!16, x2[24:16]} : x2; 48 | 49 | y0 := (ys & ~u) -> -ym : ym; 50 | y1 := (sy0 = 3) -> {ys!3, y0[24:3]} : 51 | (sy0 = 2) -> {ys!2, y0[24:2]} : 52 | (sy0 = 1) -> {ys, y0[24:1]} : y0; 53 | y2 := (sy1 = 3) -> {ys!12, y1[24:12]} : 54 | (sy1 = 2) -> {ys!8, y1[24:8]} : 55 | (sy1 = 1) -> {ys!4, y1[24:4]} : y1; 56 | y3 := syh -> {ys!25} : (sy.4 -> {ys!16, y2[24:16]} : y2); 57 | 58 | (*addition*) 59 | Sum := {xs, xs, x3} + {ys, ys, y3}; s := (Sum.26 -> -Sum : Sum) + 1; (*round*) 60 | 61 | (*post-normalize, shift left; sc = shift count*) 62 | z24 := ~s.25 & ~s.24; 63 | z22 := z24 & ~s.23 & ~s.22; 64 | z20 := z22 & ~s.21 & ~s.20; 65 | z18 := z20 & ~s.19 & ~s.18; 66 | z16 := z18 & ~s.17 & ~s.16; 67 | z14 := z16 & ~s.15 & ~s.14; 68 | z12 := z14 & ~s.13 & ~s.12; 69 | z10 := z12 & ~s.11 & ~s.10; 70 | z8 := z10 & ~s.9 & ~s.8; 71 | z6 := z8 & ~s.7 & ~s.6; 72 | z4 := z6 & ~s.5 & ~s.4; 73 | z2 := z4 & ~s.3 & ~s.2; 74 | 75 | sc := {z10, 76 | z18 & (s.17 | s.16 | s.15 | s.14 | s.13 | s.12 | s.11 | s.10) | z2, 77 | z22 & (s.21 | s.20 | s.19 | s.18) | z14 & (s.13 | s.12 | s.11 | s.10) | z6 & (s.5 | s.4 | s.3 | s.2), 78 | z24 & (s.23 | s.22) | z20 & (s.19 | s.18) | z16 & (s.15 | s.14) | z12 & (s.11 | s.10) | z8 & (s.7 | s.6) | z4 & (s.3 | s.2), 79 | ~s.25 & s.24 | z24 & ~s.23 & s.22 | z24 & ~s.23 & s.22 | z22 & ~s.21 & s.20 | z20 & ~s.19 & s.18 | z18 & ~s.17 & s.16 | 80 | z16 & ~s.15 & s.14 | z14 & ~s.13 & s.12 | z12 & ~s.11 & s.10 | z10 & ~s.9 & s.8 | z8 & ~s.7 & s.6 | z6 & ~s.5 & s.4 | z4 & ~s.3 & s.2}; 81 | 82 | e1 := e0 - {0'4, sc} + 1; 83 | sc0 := sc[1:0]; sc1 := sc[3:2]; 84 | t1 := (sc0 = 3) -> {s[22:1], 0'3} : 85 | (sc0 = 2) -> {s[23:1], 0'2} : 86 | (sc0 = 1) -> {s[24:1], 0'1} : s[25:1]; 87 | t2 := (sc1 = 3) -> {t1[12:0], 0'12} : 88 | (sc1 = 2) -> {t1[16:0], 0'8} : 89 | (sc1 = 1) -> {t1[20:0], 0'4} : t1; 90 | t3 := sc.4 -> {t2[8:0], 0'16} : t2; 91 | 92 | stall := run & (State # 3); 93 | State := run -> State+1 : 0; 94 | 95 | z := v -> {Sum.26 ! 7, Sum[25:1]} : (*FLOOR*) 96 | x[30:0] = 0 -> (~u -> y : 0) : 97 | y[30:0] = 0 -> x : 98 | (t3 = 0) | e1.8 -> 0 : {Sum.26, e1[7:0], t3[23:1]} 99 | END FPAdder. 100 | -------------------------------------------------------------------------------- /Lola/Sources/FPDivider.Lola: -------------------------------------------------------------------------------- 1 | MODULE FPDivider( (*NW 19.9.2015*) 2 | IN clk, run: BIT; x, y: WORD; 3 | OUT stall: BIT; z: WORD); 4 | 5 | REG (clk) S: [5] BIT; (*state*) 6 | R: [24] BIT; (*remainder*) 7 | Q: [25] BIT; (*quotient*) 8 | 9 | VAR sign: BIT; 10 | xe, ye: [8] BIT; 11 | e0, e1: [9] BIT; 12 | z0: [24] BIT; 13 | r0, r1, d, q0: [25] BIT; 14 | 15 | BEGIN 16 | sign := x.31 ^ y.31; (*xor*) 17 | xe := x[30:23]; ye := y[30:23]; 18 | e0 := {0'1, xe} - {0'1, ye}; 19 | e1 := e0 + 126 + Q.24; 20 | stall := run & (S # 25); 21 | 22 | r0 := (S = 0) -> {1'2, x[22:0]} : {R, 0'1}; 23 | d := r0 - {1'2, y[22:0]}; 24 | r1 := d.24 -> r0 : d; 25 | q0 := (S = 0) -> 0 : Q; 26 | 27 | z0 := Q.24 -> Q[24:1] : Q[23:0]; (*post norm*) 28 | z := (xe = 0) -> 0 : 29 | (ye = 0) -> {sign, 0FFH'8, 0'23} : (*divide by 0*) 30 | ~e1.8 -> {sign, e1[7:0], z0[22:0]} : 31 | ~e1.7 -> {sign, 0FFH'8, z0[22:0]} : 0; (*overflow*) 32 | 33 | R := r1[23:0]; 34 | Q := {q0[23:0], ~d.24}; 35 | S := run -> S+1 : 0 36 | END FPDivider. 37 | -------------------------------------------------------------------------------- /Lola/Sources/FPMultiplier.Lola: -------------------------------------------------------------------------------- 1 | MODULE FPMultiplier( (*NW 15.9.2015*) 2 | IN clk, run: BIT; x, y: WORD; 3 | OUT stall: BIT; z: WORD); 4 | 5 | REG (clk) S: [5] BIT; (*state*) 6 | P: [48] BIT; (*product*) 7 | 8 | VAR sign: BIT; 9 | xe, ye: [8] BIT; 10 | e0, e1: [9] BIT; 11 | w0, z0: [24] BIT; 12 | w1: [25] BIT; 13 | 14 | BEGIN sign := x.31 ^ y.31; (*xor*) 15 | xe := x[30:23]; ye := y[30:23]; 16 | e0 := {0'1, xe} + {0'1, ye}; 17 | e1 := e0 - 127 + P.47; 18 | stall := run & (S # 25); 19 | w0 := P.0 -> {1'1, y[22:0]} : 0; 20 | w1 := {0'1, P[47:24]} + {0'1, w0}; 21 | 22 | P := (S = 0) -> {0'24, 1'1, x[22:0]} : {w1, P[23:1]}; 23 | S := run -> S+1 : 0; 24 | 25 | z0 := P.47 -> P[47:24] : P[46:23]; (*post norm*) 26 | z := (xe = 0) | (ye = 0) -> 0 : 27 | ~e1.8 -> {sign, e1[7:0], z0[22:0]} : 28 | ~e1.7 -> {sign, 0FFH'8, z0[22:0]} : 0; (*overflow*) 29 | END FPMultiplier. 30 | -------------------------------------------------------------------------------- /Lola/Sources/LSB.Mod: -------------------------------------------------------------------------------- 1 | MODULE LSB; (*Lola System Compiler Base LSBX, 26.9.2015*) 2 | IMPORT Texts, Oberon; 3 | 4 | CONST 5 | bit* = 0; array* = 1; unit* = 2; (*type forms*) 6 | 7 | (*tags in output*) const* = 1; typ* = 2; var* = 3; lit* = 4; sel* = 7; range* = 8; cons* = 9; 8 | repl* = 10; not* = 11; and* = 12; mul* = 13; div* = 14; or* = 15; xor* = 16; add* = 17; sub* = 18; 9 | eql* = 20; neq* = 21; lss* = 22; geq* = 23; leq* = 24; gtr* = 25; 10 | then* = 30; else* = 31; ts* = 32; next* = 33; 11 | 12 | TYPE 13 | Item* = POINTER TO ItemDesc; 14 | Object* = POINTER TO ObjDesc; 15 | Type* = POINTER TO TypeDesc; 16 | ArrayType* = POINTER TO ArrayTypeDesc; 17 | UnitType* = POINTER TO UnitTypeDesc; 18 | 19 | ItemDesc* = RECORD 20 | tag*: INTEGER; 21 | type*: Type; 22 | val*, size*: LONGINT; 23 | a*, b*: Item 24 | END ; 25 | 26 | ObjDesc* = RECORD (ItemDesc) 27 | next*: Object; 28 | name*: ARRAY 32 OF CHAR; 29 | marked*: BOOLEAN 30 | END ; 31 | 32 | TypeDesc* = RECORD len*, size*: LONGINT; typobj*: Object END ; 33 | ArrayTypeDesc* = RECORD (TypeDesc) eltyp*: Type END ; 34 | UnitTypeDesc* = RECORD (TypeDesc) firstobj*: Object END ; 35 | 36 | VAR root*, top*: Object; 37 | bitType*, integer*, string*: Type; 38 | byteType*, wordType*: ArrayType; 39 | modname*: ARRAY 32 OF CHAR; 40 | 41 | PROCEDURE Register*(name: ARRAY OF CHAR; list: Object); 42 | BEGIN modname := name; top := list 43 | END Register; 44 | 45 | BEGIN NEW(bitType); bitType.len := 0; bitType.size := 1; NEW(integer); NEW(string); 46 | NEW(byteType); byteType.len := 8; byteType.size := 8; byteType.eltyp := bitType; 47 | NEW(wordType); wordType.len := 32; wordType.size := 32; wordType.eltyp := bitType; 48 | NEW(root); root.tag := typ; root.name := "WORD"; root.type := wordType; root.next := NIL; 49 | NEW(top); top.tag := typ; top.name := "BYTE"; top.type := byteType; top.next := root; root := top; 50 | NEW(top); top.tag := typ; top.name := "BIT"; top.type := bitType; top.next := root; root := top 51 | END LSB. 52 | 53 | -------------------------------------------------------------------------------- /Lola/Sources/LSP.Mod: -------------------------------------------------------------------------------- 1 | MODULE LSP; (*display data structure; NW 28.8.2015*) 2 | IMPORT Texts, Oberon, LSB; 3 | 4 | VAR W: Texts.Writer; 5 | C: ARRAY 64, 6 OF CHAR; 6 | 7 | PROCEDURE PrintType(typ: LSB.Type); 8 | VAR obj: LSB.Object; 9 | BEGIN 10 | IF typ IS LSB.ArrayType THEN 11 | Texts.Write(W, "["); Texts.WriteInt(W, typ.len, 1); Texts.Write(W, "]"); PrintType(typ(LSB.ArrayType).eltyp) 12 | ELSIF typ IS LSB.UnitType THEN 13 | Texts.WriteString(W, "UnitType "); obj := typ(LSB.UnitType).firstobj; 14 | ELSE Texts.WriteString(W, "BIT") 15 | END ; 16 | Texts.Append(Oberon.Log, W.buf) 17 | END PrintType; 18 | 19 | PROCEDURE PrintTree(x: LSB.Item; n: INTEGER); 20 | VAR i: INTEGER; 21 | BEGIN 22 | IF x # NIL THEN i := n; 23 | IF x IS LSB.Object THEN 24 | WHILE i > 0 DO Texts.Write(W, 9X); DEC(i) END ; 25 | Texts.WriteString(W, x(LSB.Object).name); Texts.WriteLn(W) 26 | ELSE 27 | PrintTree(x.a, n+1); 28 | WHILE i > 0 DO Texts.Write(W, 9X); DEC(i) END ; 29 | IF x.tag = LSB.lit THEN Texts. WriteInt(W, x.val, 1) ELSE Texts.WriteString(W, C[x.tag]); END ; 30 | Texts.WriteLn(W); 31 | PrintTree(x.b, n+1) 32 | END 33 | END 34 | END PrintTree; 35 | 36 | PROCEDURE PrintObj(obj: LSB.Object; n: INTEGER); 37 | VAR apar: LSB.Item; obj1: LSB.Object; 38 | BEGIN 39 | IF n > 0 THEN Texts.Write(W, 9X) END ; 40 | Texts.WriteString(W, C[obj.tag]); Texts.Write(W, " "); Texts.WriteString(W, obj.name); Texts.Append(Oberon.Log, W.buf); 41 | IF obj.tag = LSB.const THEN Texts.WriteString(W, " = "); PrintTree(obj.b, 1); Texts.WriteLn(W) 42 | ELSIF obj.tag = LSB.typ THEN 43 | IF obj.type IS LSB.UnitType THEN (*formal param list*) 44 | obj1 := obj.type(LSB.UnitType).firstobj; 45 | Texts.WriteString(W, " BEGIN "); Texts.WriteLn(W); 46 | WHILE (obj1 # NIL) & (obj1 # LSB.root) DO PrintObj(obj1, 0); obj1 := obj1.next END ; 47 | Texts.WriteString(W, "END"); Texts.WriteLn(W) 48 | ELSE PrintType(obj.type) 49 | END 50 | ELSE (*var*) Texts.WriteString(W, ": "); 51 | IF obj.type IS LSB.UnitType THEN 52 | Texts.WriteString(W, obj.type.typobj.name); 53 | apar := obj.b; Texts.WriteString(W, " ["); (*actual param list*) 54 | WHILE apar # NIL DO PrintTree(apar.b, 1); apar := apar.a END ; 55 | Texts.Write(W, "]"); Texts.WriteLn(W) 56 | ELSE PrintType(obj.type); 57 | Texts.WriteString(W, " #"); Texts.WriteInt(W, obj.val, 1); 58 | IF obj.a # NIL THEN 59 | IF obj.val = 0 THEN Texts.WriteString(W, " CLK") ELSIF obj.val = 1 THEN (*indexed*) Texts.WriteString(W, " DEMUX") END ; 60 | PrintTree(obj.a, 1) 61 | END ; 62 | IF obj.b # NIL THEN Texts.WriteString(W, " := "); Texts.WriteLn(W); PrintTree(obj.b, 1) 63 | ELSE Texts.WriteLn(W) 64 | END 65 | END 66 | END ; 67 | Texts.Append(Oberon.Log, W.buf) 68 | END PrintObj; 69 | 70 | PROCEDURE List*; 71 | VAR obj: LSB.Object; 72 | BEGIN obj := LSB.top; 73 | Texts.WriteString(W, "listing "); Texts.WriteString(W, LSB.modname); Texts.WriteLn(W); 74 | WHILE (obj # LSB.root) & (obj # NIL) DO PrintObj(obj, 0); obj := obj.next END ; 75 | Texts.Append(Oberon.Log, W.buf) 76 | END List; 77 | 78 | BEGIN Texts.OpenWriter(W); 79 | C[LSB.const] := "CONST"; C[LSB.typ] := "TYPE"; C[LSB.var] := "VAR"; 80 | C[LSB.lit] := "LIT"; C[LSB.sel] := "MUX"; C[LSB.range] := ": "; C[LSB.cons] := ", "; C[LSB.repl] := "**"; 81 | C[LSB.or] := "| "; C[LSB.xor] := "^ "; C[LSB.and] := "& "; C[LSB.not] := "~ "; 82 | C[LSB.add] := "+ "; C[LSB.sub] := "- "; C[LSB.mul] := "* "; C[LSB.div] := "/ "; 83 | C[LSB.eql] := "= "; C[LSB.neq] := "# "; C[LSB.lss] := "< "; C[LSB.geq] := ">="; C[LSB.leq] := "<="; C[LSB.gtr] := "> "; 84 | C[LSB.then] := " -> "; C[LSB.else] := " :: "; C[LSB.ts] := "TS "; C[LSB.next] := "--" 85 | END LSP. 86 | -------------------------------------------------------------------------------- /Lola/Sources/LSS.Mod: -------------------------------------------------------------------------------- 1 | MODULE LSS; (* NW 16.10.93 / 1.9.2015*) 2 | IMPORT Texts, Oberon; 3 | 4 | CONST IdLen* = 32; NofKeys = 11; 5 | (*symbols*) null = 0; 6 | arrow* = 1; times* = 2; div* = 3; and* = 4; plus* = 5; minus* = 6; or* = 7; xor* = 8; not* = 9; 7 | eql* = 10; neq* = 11; lss* = 12; leq* = 13; gtr* = 14; geq* = 15; 8 | at* = 16; apo* = 17; period* = 18; comma* = 19; colon* = 20; rparen* = 21; rbrak* = 22; rbrace* = 23; 9 | then* = 24; lparen* = 26; lbrak* = 27; lbrace* = 28; repl* = 29; becomes* = 30; 10 | ident* = 31; integer* = 32; ts* = 33; semicolon* = 40; end* = 41; 11 | const* = 51; type* = 52; reg* = 53; var* = 54; out* = 55; inout* = 56; in* = 57; 12 | begin* = 58; module* = 59; eof = 60; 13 | 14 | TYPE Ident* = ARRAY IdLen OF CHAR; 15 | 16 | VAR val*: LONGINT; 17 | id*: Ident; 18 | error*: BOOLEAN; 19 | 20 | ch: CHAR; 21 | errpos: LONGINT; 22 | R: Texts.Reader; 23 | W: Texts.Writer; 24 | key: ARRAY NofKeys OF Ident; 25 | symno: ARRAY NofKeys OF INTEGER; 26 | 27 | PROCEDURE Mark*(msg: ARRAY OF CHAR); 28 | VAR p: LONGINT; 29 | BEGIN p := Texts.Pos(R); 30 | IF p > errpos+2 THEN 31 | Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); 32 | Texts.WriteString(W, " err: "); Texts.WriteString(W, msg); 33 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 34 | END ; 35 | errpos := p; error := TRUE 36 | END Mark; 37 | 38 | PROCEDURE identifier(VAR sym: INTEGER); 39 | VAR i: INTEGER; 40 | BEGIN i := 0; 41 | REPEAT 42 | IF i < IdLen THEN id[i] := ch; INC(i) END ; 43 | Texts.Read(R, ch) 44 | UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z"); 45 | IF ch = "'" THEN 46 | IF i < IdLen THEN id[i] := ch; INC(i) END ; 47 | Texts.Read(R, ch) 48 | END ; 49 | IF i = IdLen THEN Mark("ident too long"); id[IdLen-1] := 0X 50 | ELSE id[i] := 0X 51 | END ; 52 | i := 0; 53 | WHILE (i < NofKeys) & (id # key[i]) DO INC(i) END ; 54 | IF i < NofKeys THEN sym := symno[i] ELSE sym := ident END 55 | END identifier; 56 | 57 | PROCEDURE Number(VAR sym: INTEGER); 58 | VAR i, k, h, n, d: LONGINT; 59 | hex: BOOLEAN; 60 | dig: ARRAY 16 OF LONGINT; 61 | BEGIN sym := integer; i := 0; k := 0; n := 0; hex := FALSE; 62 | REPEAT 63 | IF n < 16 THEN d := ORD(ch)-30H; 64 | IF d >= 10 THEN hex := TRUE ; d := d - 7 END ; 65 | dig[n] := d; INC(n) 66 | ELSE Mark("too many digits"); n := 0 67 | END ; 68 | Texts.Read(R, ch) 69 | UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F"); 70 | IF ch = "H" THEN (*hex*) 71 | REPEAT h := dig[i]; k := k*10H + h; INC(i) (*no overflow check*) 72 | UNTIL i = n; 73 | Texts.Read(R, ch) 74 | ELSE 75 | IF hex THEN Mark("illegal hex digit") END ; 76 | REPEAT k := k*10 + dig[i]; INC(i) UNTIL i = n 77 | END ; 78 | val := k 79 | END Number; 80 | 81 | PROCEDURE comment; 82 | BEGIN Texts.Read(R, ch); 83 | REPEAT 84 | WHILE ~R.eot & (ch # "*") DO 85 | IF ch = "(" THEN Texts.Read(R, ch); 86 | IF ch = "*" THEN comment END 87 | ELSE Texts.Read(R, ch) 88 | END 89 | END ; 90 | WHILE ch = "*" DO Texts.Read(R, ch) END 91 | UNTIL (ch = ")") OR R.eot; 92 | IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("comment not terminated") END 93 | END comment; 94 | 95 | PROCEDURE Get*(VAR sym: INTEGER); 96 | BEGIN 97 | REPEAT 98 | WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END; 99 | IF R.eot THEN sym := eof 100 | ELSIF ch < "A" THEN 101 | IF ch < "0" THEN 102 | IF ch = "!" THEN Texts.Read(R, ch); sym := repl 103 | ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq 104 | ELSIF ch = "$" THEN Texts.Read(R, ch); sym := null 105 | ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and 106 | ELSIF ch = "'" THEN Texts.Read(R, ch); sym := apo 107 | ELSIF ch = "(" THEN Texts.Read(R, ch); 108 | IF ch = "*" THEN sym := null; comment ELSE sym := lparen END 109 | ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen 110 | ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times 111 | ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus 112 | ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma 113 | ELSIF ch = "-" THEN Texts.Read(R, ch); 114 | IF ch = ">" THEN Texts.Read(R, ch); sym := then ELSE sym := minus END 115 | ELSIF ch = "." THEN Texts.Read(R, ch); sym := period 116 | ELSIF ch = "/" THEN Texts.Read(R, ch); sym := div 117 | ELSE sym := null 118 | END 119 | ELSIF ch <= "9" THEN Number(sym) 120 | ELSIF ch = ":" THEN Texts.Read(R, ch); 121 | IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END 122 | ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon 123 | ELSIF ch = "<" THEN Texts.Read(R, ch); 124 | IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END 125 | ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql 126 | ELSIF ch = ">" THEN Texts.Read(R, ch); 127 | IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END 128 | ELSIF ch = "?" THEN Texts.Read(R, ch); sym := then 129 | ELSIF ch = "@" THEN Texts.Read(R, ch); sym := at 130 | ELSE sym := null 131 | END 132 | ELSIF ch <= "Z" THEN identifier(sym) 133 | ELSIF ch < "a" THEN 134 | IF ch = "[" THEN Texts.Read(R, ch); sym := lbrak 135 | ELSIF ch = "]" THEN Texts.Read(R, ch); sym := rbrak 136 | ELSIF ch = "^" THEN Texts.Read(R, ch); sym := xor 137 | ELSE sym := null 138 | END 139 | ELSIF ch <= "z" THEN identifier(sym) 140 | ELSIF ch <= "{" THEN Texts.Read(R, ch); sym := lbrace 141 | ELSIF ch <= "|" THEN Texts.Read(R, ch); sym := or 142 | ELSIF ch <= "}" THEN Texts.Read(R, ch); sym := rbrace 143 | ELSIF ch <= "~" THEN Texts.Read(R, ch); sym := not 144 | ELSE sym := null 145 | END 146 | UNTIL sym # null 147 | END Get; 148 | 149 | PROCEDURE Init*(T: Texts.Text; pos: LONGINT); 150 | BEGIN error := FALSE; errpos := pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch) 151 | END Init; 152 | 153 | BEGIN Texts.OpenWriter(W); 154 | key[ 0] := "BEGIN"; symno[0] := begin; 155 | key[ 1] := "CONST"; symno[1] := const; 156 | key[ 2] := "END"; symno[2] := end; 157 | key[3] := "IN"; symno[3] := in; 158 | key[4] := "INOUT"; symno[4] := inout; 159 | key[5] := "MODULE"; symno[5] := module; 160 | key[6] := "OUT"; symno[6] := out; 161 | key[7] := "REG"; symno[7] := reg; 162 | key[8] := "TYPE"; symno[8] := type; 163 | key[9] := "VAR"; symno[9] := var; 164 | key[10] := "TS"; symno[10] := ts 165 | END LSS. 166 | -------------------------------------------------------------------------------- /Lola/Sources/MouseP.Lola: -------------------------------------------------------------------------------- 1 | MODULE MouseP ( (*NW 7.9.2015*) 2 | IN clk, rst: BIT; 3 | INOUT msclk, msdat: BIT; 4 | OUT out: [28] BIT); 5 | (* init mouse cmd F4 (start reporting) with start, parity and stop bits added *) 6 | CONST InitBuf := 0FFFFFDE8H; (* 1...1 1 0 1111 0100 0 *) 7 | REG (clk) x, y: [10] BIT; (*counters*) 8 | btns: [3] BIT; 9 | Q0, Q1, run: BIT; 10 | shreg: [32] BIT; 11 | VAR shift, endbit, reply: BIT; 12 | dx, dy: [10] BIT; 13 | msclk0, msdat0: BIT; 14 | BEGIN TS(msclk, msclk0, 0'1, rst); 15 | TS(msdat, msdat0, 0'1, run | shreg.0); 16 | shift := Q1 & ~Q0; (*falling edge detector*) 17 | reply := ~run & ~shreg.1; (*start bit of echoed initBuf, if response*) 18 | endbit := run & ~shreg.0; (*normal packet received*) 19 | dx := {shreg.5 !2, shreg.7 -> 0'8 : shreg[19:12]}; (*sign + ovfl*) 20 | dy := {shreg.6 !2, shreg.8 -> 0'8 : shreg[30:23]}; (*sign + ovfl*) 21 | out := {run, btns, 0'2, y, 0'2, x}; 22 | 23 | run := rst & (reply | run); 24 | Q0 := msclk0; Q1 := Q0; (*edhe detector*) 25 | shreg := ~rst -> 0FFFFFDE8H: 26 | (endbit | reply) -> 0FFFFFFFFH'32: 27 | shift -> {msdat0, shreg[31:1]} : shreg; 28 | x := ~rst -> 0'10 : endbit -> x + dx : x; 29 | y := ~rst -> 0'10 : endbit -> y + dy : y; 30 | btns := ~rst -> 0'3 : endbit -> {shreg.1, shreg.3, shreg.2} : btns 31 | END MouseP. 32 | -------------------------------------------------------------------------------- /Lola/Sources/Multiplier.Lola: -------------------------------------------------------------------------------- 1 | MODULE Multiplier ( (*NW 13.9.2014*) 2 | IN clk, run, u: BIT; 3 | OUT stall: BIT; 4 | IN x, y: WORD; (*32 bit*) 5 | OUT z: [64] BIT); 6 | 7 | REG (clk) S: [6] BIT; (*state*) 8 | P: [64] BIT; (*product*) 9 | VAR w0: WORD; 10 | w1: [33] BIT; 11 | 12 | BEGIN stall := run & (S # 33); 13 | w0 := P.0 -> y : 0; 14 | w1 := (S =32) & u -> {P.63, P[63:32]} - {w0.31, w0} : {P.63, P[63:32]} + {w0.31, w0}; 15 | S := run -> S+1 : 0; 16 | P := (S = 0) -> {0'32, x} : {w1[32:0], P[31:1]}; 17 | z := P 18 | END Multiplier. 19 | -------------------------------------------------------------------------------- /Lola/Sources/PS2.Lola: -------------------------------------------------------------------------------- 1 | MODULE PS2 ( 2 | IN clk, rst, done: BIT; 3 | OUT rdy, shift: BIT; 4 | OUT data: BYTE; 5 | IN PS2C, PS2D: BIT); 6 | 7 | REG (clk) 8 | Q0, Q1: BIT; (*synchronizer and falling edge detector*) 9 | shreg: [11] BIT; 10 | inptr, outptr: [4] BIT; 11 | fifo: [16] BYTE; 12 | VAR endbit: BIT; 13 | 14 | BEGIN endbit := ~shreg.0; (*start bit reached correct pos*) 15 | shift := Q1 & ~Q0; 16 | Q0 := PS2C; Q1 := Q0; 17 | data := fifo[outptr]; 18 | rdy := (inptr # outptr); 19 | 20 | shreg := (~rst | endbit) -> 7FFH'11: 21 | shift -> {PS2D, shreg[10:1]} : shreg; 22 | outptr := ~rst -> 0 : rdy & done -> outptr + 1 : outptr; 23 | inptr := ~rst -> 0 : endbit -> inptr + 1 : inptr; 24 | fifo[inptr] := endbit -> shreg[8:1] : fifo[inptr]; 25 | END PS2. 26 | -------------------------------------------------------------------------------- /Lola/Sources/RISC5.Lola: -------------------------------------------------------------------------------- 1 | MODULE RISC5 (IN clk, rst, stallX: BIT; (*NW 26.10.2015*) 2 | IN inbus, codebus: WORD; 3 | OUT adr: [24] BIT; 4 | rd, wr, ben: BIT; 5 | outbus: WORD); 6 | 7 | CONST StartAdr = 3FF800H'22; 8 | 9 | TYPE PROM := MODULE (IN clk: BIT; 10 | IN adr: [9] BIT; 11 | OUT data: WORD) ^; 12 | 13 | Multiplier := MODULE (IN clk, run, u: BIT; 14 | OUT stall: BIT; 15 | IN x, y: WORD; 16 | OUT z: [64] BIT) ^; 17 | 18 | Divider := MODULE (IN clk, run, u: BIT; 19 | OUT stall: BIT; 20 | IN x, y: WORD; 21 | OUT quot, rem: WORD) ^; 22 | 23 | FPAdder := MODULE (IN clk, run, u, v: BIT; OUT stall: BIT; 24 | IN x, y: WORD; OUT z: WORD) ^; 25 | 26 | FPMultiplier := MODULE (IN clk, run: BIT; OUT stall: BIT; 27 | IN x, y: WORD; OUT z: WORD) ^; 28 | 29 | FPDivider := MODULE (IN clk, run: BIT; OUT stall: BIT; 30 | IN x, y: WORD; OUT z: WORD) ^; 31 | 32 | REG (clk) PC: [22] BIT; (*program counter*) 33 | IR: WORD; (*instruction register*) 34 | N, Z, C, OV: BIT; (*condition flags*) 35 | stall1, PMsel: BIT; 36 | R: [16] WORD; (*data registers*) 37 | H: WORD; (*auxiliary register*) 38 | 39 | VAR PM: PROM; (*mem for boot loader*) 40 | mulUnit: Multiplier; 41 | divUnit: Divider; 42 | faddUnit: FPAdder; 43 | fmulUnit: FPMultiplier; 44 | fdivUnit: FPDivider; 45 | 46 | pcmux, nxpc: [22] BIT; 47 | cond, S: BIT; 48 | sa, sb, sc: BIT; 49 | 50 | ins, pmout: WORD; 51 | p, q, u, v, w: BIT; (*instruction fields*) 52 | op, ira, ira0, irb, irc: [4] BIT; 53 | cc: [3] BIT; 54 | imm: [16] BIT; 55 | off: [20] BIT; 56 | offL: [24] BIT; 57 | 58 | regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD: BIT; 59 | sc1, sc0: [2] BIT; (*shift counts*) 60 | 61 | a0, a1, a2, a3: BIT; 62 | inbusL, outbusB0, outbusB1, outbusB2, outbusB3: BYTE; 63 | inbusH: [24] BIT; 64 | 65 | A, B, C0, C1, aluRes, regmux: WORD; 66 | s1, s2, s3, t1, t2, t3: WORD; (*shifting*) 67 | quotient, remainder: WORD; 68 | product: [64] BIT; 69 | fsum, fprod, fquot: WORD; 70 | 71 | Add, Sub, Mul, Div: BIT; 72 | Fadd, Fsub, Fmul, Fdiv: BIT; 73 | Ldr, Str, Br: BIT; 74 | 75 | BEGIN PM(clk, pcmux[8:0], pmout); 76 | mulUnit (clk, Mul, ~u, stallM, B, C1, product); 77 | divUnit (clk, Div, ~u, stallD, B, C1, quotient, remainder); 78 | faddUnit (clk, Fadd|Fsub, u, v, stallFA, B, {Fsub^C0.31, C0[30:0]}, fsum); 79 | fmulUnit (clk, Fmul, stallFM, B, C0, fprod); 80 | fdivUnit (clk, Fdiv, stallFD, B, C0, fquot); 81 | 82 | ins := PMsel -> pmout : IR; (*current instruction*) 83 | p := ins.31; (*instruction fields*) 84 | q := ins.30; 85 | u := ins.29; 86 | v := ins.28; 87 | w := ins.16; 88 | cc:= ins[26:24]; 89 | ira := ins[27:24]; 90 | irb := ins[23:20]; 91 | op := ins[19:16]; 92 | irc := ins[3:0]; 93 | imm := ins[15:0]; (*reg instr*) 94 | off := ins[19:0]; (*mem instr*) 95 | offL := ins[23:0]; (*branch instr*) 96 | 97 | Add := ~p & (op = 8); 98 | Sub := ~p & (op = 9); 99 | Mul := ~p & (op = 10); 100 | Div := ~p & (op = 11); 101 | Fadd := ~p & (op = 12); 102 | Fsub := ~p & (op = 13); 103 | Fmul := ~p & (op = 14); 104 | Fdiv := ~p & (op = 15); 105 | Ldr := p & ~q & ~u; 106 | Str := p & ~q & u; 107 | Br := p & q; 108 | 109 | (*ALU*) 110 | A := R[ira0]; (*main data path*) 111 | B := R[irb]; 112 | C0 := R[irc]; 113 | C1 := q -> {v!16, imm} : C0 ; 114 | ira0 := Br -> 15'4 : ira; 115 | adr := stallL -> B[23:0] + {0'4, off} : {pcmux, 0'2}; 116 | rd := Ldr & ~stallX & ~stall1; 117 | wr := Str & ~stallX & ~stall1; 118 | ben := p & ~q & v & ~stallX & ~stall1; (*byte enable*) 119 | 120 | sc0 := C1[1:0]; 121 | sc1 := C1[3:2]; 122 | 123 | (*right shifter*) 124 | s1 := (sc0 = 3) -> {(w -> B[2:0] : {B.31 ! 3}), B[31:3]} : 125 | (sc0 = 2) -> {(w -> B[1:0] : {B.31 ! 2}), B[31:2]} : 126 | (sc0 = 1) -> {(w -> B.0 : B.31), B[31:1]} : B; 127 | s2 := (sc1 = 3) -> {(w -> s1[11:0] : {B.31 ! 12}), s1[31:12]} : 128 | (sc1 = 2) -> {(w -> s1[7:0] : {B.31 ! 8}), s1[31:8]} : 129 | (sc1 = 1) -> {(w -> s1[3:0] : {B.31 ! 4}), s1[31:4]} : s1; 130 | s3 := C1.4 -> {(w -> s2[15:0] : {s2.31 ! 16}), s2[31:16]} : s2; 131 | 132 | (*left shifter*) 133 | t1 := (sc0 = 3) -> {B[28:0], 0'3} : 134 | (sc0 = 2) -> {B[29:0], 0'2} : 135 | (sc0 = 1) -> {B[30:0], 0'1} : B; 136 | t2 := (sc1 = 3) -> {t1[19:0], 0'12} : 137 | (sc1 = 2) -> {t1[23:0], 0'8} : 138 | (sc1 = 1) -> {t1[27:0], 0'4} : t1; 139 | t3 := C1.4 -> {t2[15:0], 0'16} : t2; 140 | 141 | aluRes := 142 | ~op.3 -> 143 | (~op.2 -> 144 | (~op.1 -> 145 | (~op.0 -> (*Mov*) 146 | (q -> 147 | (~u -> {v!16 , imm} : {imm, 0'16}) : 148 | (~u -> C0 : (~v -> H : {N, Z, C, OV, 0'20, 58H'8}))) : 149 | t3 ): (*Lsl*) 150 | s3) : (*Asr, Ror*) 151 | (~op.1 -> 152 | (~op.0 -> B & C1 : B & ~C1) : (*And, Ann*) 153 | (~op.0 -> B | C1 : B ^ C1)) ): (*Ior, Xor*) 154 | (~op.2 -> 155 | (~op.1 -> 156 | (~op.0 -> B + C + (u&C) : B - C1 - (u&C)) : (*Add, Sub*) 157 | (~op.0 -> product[31:0] : quotient)) : (*Mul, Div*) 158 | (~op.1 -> 159 | fsum : (*Fad, Fsb*) 160 | (~op.0 -> fprod : fquot))) ; (*Fml, Fdv*) 161 | 162 | regwr := ~p & ~stall | (Ldr & ~stallX & ~stall1) | (Br & cond & v & ~stallX); 163 | a0 := ~adr.1 & ~adr.0; 164 | a1 := ~adr.1 & adr.0; 165 | a2 := adr.1 & ~adr.0; 166 | a3 := adr.1 & adr.0; 167 | inbusL := (~ben | a0) -> inbus[7:0] : a1 -> inbus[15:8] : a2 -> inbus[23:16] : inbus[31:24]; 168 | inbusH := ~ben -> inbus[31:8] : 0'24; 169 | regmux := Ldr -> {inbusH, inbusL} : (Br & v) -> {0'8, nxpc, 0'2} : aluRes ; 170 | 171 | outbusB0 := A[7:0]; 172 | outbusB1 := ben & a1 -> A[7:0] : A[15:8]; 173 | outbusB2 := ben & a2 -> A[7:0] : A[23:16]; 174 | outbusB3 := ben & a3 -> A[7:0] : A[31:24]; 175 | outbus := {outbusB3, outbusB2, outbusB1, outbusB0}; 176 | 177 | (*control unit*) 178 | S := N ^ OV; 179 | nxpc := PC + 1; 180 | cond := ins.27 ^ ( 181 | (cc = 0) & N | (*MI, PL*) 182 | (cc = 1) & Z | (*EQ, NE*) 183 | (cc = 2) & C | (*CS, CC*) 184 | (cc = 3) & OV | (*VS, VC*) 185 | (cc = 4) & (C|Z) | (*LS, HI*) 186 | (cc = 5) & S | (*LT, GE*) 187 | (cc = 6) & (S|Z) | (*LE, GT*) 188 | (cc = 7)); 189 | pcmux := ~rst -> 3FF800H'22 : 190 | stall -> PC : 191 | (Br & cond & u) -> offL[21:0] + nxpc : 192 | (Br & cond & ~u) -> C0[23:2] : nxpc; 193 | 194 | sa := aluRes.31; 195 | sb := B.31; 196 | sc := C1.31; 197 | 198 | stall := stallL | stallM | stallD | stallFA | stallFM | stallFD | stallX; 199 | stallL := (Ldr | Str) & ~stall1; 200 | 201 | (*assignments to registers*) 202 | PC := pcmux; 203 | PMsel := ~rst | (pcmux[21:12] = 03FFH'10); 204 | IR := stall -> IR : codebus; 205 | stall1 := stallX -> stall1 : stallL; 206 | R[ira0] := regwr -> regmux : A; 207 | N := regwr -> regmux.31 : N; 208 | Z := regwr -> (regmux = 0) : Z; 209 | C := Add -> (sb&sc) | (~sa&~sb&sc) | (~sa&sb&~sc&sa) : 210 | Sub -> (~sb&sc) | (sa&~sb&~sc) | (sa&sb&sc) : C; 211 | OV := Add -> (sa&~sb&~sc) | (~sa&sb&sc) : 212 | Sub -> (sa&~sb&sc) | (~sa&sb&~sc) : OV; 213 | H := Mul -> product[63:32] : Div -> remainder : H 214 | END RISC5. 215 | -------------------------------------------------------------------------------- /Lola/Sources/RISC5Top.Lola: -------------------------------------------------------------------------------- 1 | MODULE RISC5Top( (*NW 23.9.2015*) 2 | IN CLK50M: BIT; 3 | IN btn: [4] BIT; 4 | IN swi: BYTE; 5 | IN RxD: BIT; 6 | OUT TxD: BIT; 7 | OUT leds: BYTE; 8 | OUT SRce0, SRce1, SRwe, SRoe: BIT; (*SRAM*) 9 | OUT SRbe: [4] BIT; 10 | OUT SRadr: [18] BIT; 11 | INOUT SRdat: WORD; 12 | IN MISO: [2] BIT; (*SPI - SD card & network*) 13 | OUT SCLK, MOSI, SS: [2] BIT; 14 | OUT NEN: BIT; (*network enable*) 15 | OUT hsync, vsync: BIT; (*video control*) 16 | OUT RGB: [3] BIT; 17 | IN PS2C, PS2D: BIT; (*keyboard*) 18 | INOUT msclk, msdat: BIT; 19 | INOUT gpio: BYTE); 20 | 21 | (* I/O addresses: 22 | 0 millisconds / -- 23 | 1 switches / LEDs 24 | 2 RS232 data / data (start) 25 | 3 RS232 status / control 26 | 4 SPI data / data (start) 27 | 5 SPI status / control 28 | 6 PS2 keyboard data 29 | 7 mouse 30 | 8 general-purpose I/O data 31 | 9 general-purpose I/O tri-state control *) 32 | 33 | TYPE RISC5 := MODULE ( 34 | IN clk, rst, stallX: BIT; 35 | inbus, codebus: WORD; 36 | OUT adr: [24] BIT; 37 | rd, wr, ben: BIT; 38 | outbus: WORD) ^; 39 | 40 | RS232R := MODULE ( 41 | IN clk, rst, done, RxD, fsel: BIT; 42 | OUT rdy: BIT; data: BYTE) ^; 43 | 44 | RS232T := MODULE ( 45 | IN clk, rst, start, fsel: BIT; data: BYTE; 46 | OUT rdy, TxD: BIT) ^; 47 | 48 | SPI := MODULE ( 49 | IN clk, rst, start, fast: BIT; dataTx: WORD; 50 | OUT dataRx: WORD; rdy: BIT; 51 | IN MISO: BIT; 52 | OUT MOSI, SCLK: BIT) ^; 53 | 54 | VID := MODULE ( 55 | IN clk, inv: BIT; viddata: WORD; 56 | OUT req: BIT; vidadr: [18] BIT; 57 | hsync, vsync: BIT; RGB: [3] BIT) ^; 58 | 59 | MouseP := MODULE ( 60 | IN clk, rst: BIT; 61 | INOUT msclk, msdat: BIT; 62 | OUT out: [28] BIT) ^; 63 | 64 | PS2 = MODULE ( 65 | IN clk, rst, done: BIT; 66 | OUT rdy, shift: BIT; data: BYTE; 67 | IN PS2C, PS2D: BIT) ^; 68 | 69 | REG (CLK50M) clk: BIT; 70 | REG (clk) rst: BIT; 71 | bitrate: BIT; (*RS-232*) 72 | Lreg: BYTE; (*LED*) 73 | cnt0: [16] BIT; 74 | cnt1: WORD; (*milliseconds*) 75 | spiCtrl: [4] BIT; 76 | gpout, gpoc: BYTE; 77 | 78 | VAR riscx: RISC5; 79 | receiver: RS232R; 80 | transmitter: RS232T; 81 | spi: SPI; (*CD-ROM and net*) 82 | vid: VID; 83 | kbd: PS2; 84 | Ms: MouseP; 85 | 86 | dmy: BIT; 87 | adr: [24] BIT; 88 | iowadr: [4] BIT; (*word adress*) 89 | rd, wr, ben, ioenb, dspreq: BIT; 90 | be0, be1: BIT; 91 | inbus, inbus0: WORD; (*data to RISC6 core*) 92 | outbus: WORD; (*data from RISC6 core*) 93 | 94 | dataTx, dataRx, dataKbd: BYTE; 95 | rdyRx, doneRx, startTx, rdyTx, rdyKbd, doneKbd: BIT; 96 | dataMs: [28] BIT; (*mouse*) 97 | limit: BIT; (*of cnt0*) 98 | spiRx: WORD; 99 | spiStart, spiRdy, MOSI1, SCLK1: BIT; 100 | vidadr: [18] BIT; 101 | gpin: BYTE; 102 | 103 | BEGIN 104 | riscx (clk, rst, dspreq, inbus, inbus0, adr, rd, wr, ben, outbus); 105 | receiver (clk, rst, doneRx, RxD, bitrate, rdyRx, dataRx); 106 | transmitter (clk, rst, startTx, bitrate, dataTx, rdyTx, TxD); 107 | spi (clk, rst, spiStart, spiCtrl.2, outbus, spiRx, spiRdy, MISO.0 & MISO.1, MOSI1, SCLK1); 108 | vid (clk, swi.7, inbus0, dspreq, vidadr, hsync, vsync, RGB); 109 | kbd (clk, rst, doneKbd, rdyKbd, dmy, dataKbd, PS2C, PS2D); 110 | Ms (clk, rst, msclk, msdat, dataMs); 111 | TS(SRdat, inbus0, outbus, ~wr); 112 | TS(gpio, gpin, gpout, gpoc); 113 | 114 | iowadr := adr[5:2]; 115 | ioenb := (adr[23:6] = 3FFFFH'18); 116 | inbus := ~ioenb -> inbus0 : 117 | ((iowadr = 0) -> cnt1 : 118 | (iowadr = 1) -> {0'20, btn, swi} : 119 | (iowadr = 2) -> {0'24, dataRx} : 120 | (iowadr = 3) -> {0'30, rdyTx, rdyRx} : 121 | (iowadr = 4) -> spiRx : 122 | (iowadr = 5) -> {0'31, spiRdy} : 123 | (iowadr = 6) -> {0'3, rdyKbd, dataMs} : 124 | (iowadr = 7) -> {0'24, dataKbd} : 125 | (iowadr = 8) -> {0'24, gpin} : 126 | (iowadr = 9) -> {0'24, gpoc} : 0'32); 127 | 128 | (*access to SRAM*) 129 | be0 := ben & adr.0; 130 | be1 := ben & ~adr.0; 131 | SRce0 := ben & adr.1; 132 | SRce1 := ben & ~adr.1; 133 | SRwe := ~wr | clk; 134 | SRoe := wr; 135 | SRbe := {be1, be0, be1, be0}; 136 | SRadr := dspreq -> vidadr : adr[19:2]; 137 | 138 | dataTx := outbus[7:0]; 139 | startTx := wr & ioenb & (iowadr = 2); 140 | doneRx := rd & ioenb & (iowadr = 2); 141 | spiStart := wr & ioenb & (iowadr = 4); 142 | doneKbd := rd & ioenb & (iowadr = 7); 143 | limit := (cnt0 = 24999); 144 | leds := Lreg; 145 | SS := ~spiCtrl[1:0]; (*active low slave select*) 146 | MOSI := {MOSI1, MOSI1}; SCLK := {SCLK1, SCLK1}; 147 | NEN := spiCtrl[3]; 148 | 149 | rst := (cnt1[4:0] = 0'5) & limit -> ~btn[3] : rst; 150 | Lreg := ~rst -> 0 : (wr & ioenb & (iowadr = 1)) -> outbus[7:0] : Lreg; 151 | spiCtrl := ~rst -> 0 : (wr & ioenb & (iowadr = 5)) -> outbus[3:0] : spiCtrl; 152 | bitrate := ~rst -> 0 : (wr & ioenb & (iowadr = 3)) -> outbus[0] : bitrate; 153 | gpout := ~rst -> 0 : (wr & ioenb & (iowadr = 8)) -> outbus[7:0] : gpout; 154 | gpoc := ~rst -> 0 : (wr & ioenb & (iowadr = 9)) -> outbus[7:0] : gpoc; 155 | cnt0 := limit -> 0 : cnt0 + 1; 156 | cnt1 := cnt1 + limit; 157 | 158 | clk := ~clk (* @ 50 MHz *) 159 | END RISC5Top. 160 | -------------------------------------------------------------------------------- /Lola/Sources/RS232R.Lola: -------------------------------------------------------------------------------- 1 | MODULE RS232R ( (*NW 10.8.2015*) 2 | IN clk, rst, done, RxD, fsel: BIT; 3 | OUT rdy: BIT; data: BYTE); 4 | REG (clk) run, stat: BIT; 5 | Q0, Q1: BIT; (*synchronizer and edge detector*) 6 | tick: [12] BIT; 7 | bitcnt: [4] BIT; 8 | shreg: BYTE; 9 | VAR endtick, midtick, endbit: BIT; 10 | limit: [12] BIT; 11 | BEGIN 12 | limit := fsel -> 217 : 1302; 13 | endtick := tick = limit; 14 | midtick := tick = {0'1, limit[11:1]}; (*limit/2*) 15 | endbit := bitcnt = 8; 16 | data := shreg; 17 | rdy := stat; 18 | 19 | Q0 := RxD; Q1 := Q0; 20 | run := (Q1 & ~Q0) | ~(~rst | endtick & endbit) & run; 21 | tick := (run & ~endtick) -> tick + 1 : 0; 22 | bitcnt := (endtick & ~endbit) -> bitcnt + 1 : 23 | (endtick & endbit) -> 0 : bitcnt; 24 | shreg := midtick -> {Q1, shreg[7:1]} : shreg; 25 | stat := (endtick & endbit) | ~(~rst | done) & stat 26 | END RS232R. 27 | 28 | -------------------------------------------------------------------------------- /Lola/Sources/RS232T.Lola: -------------------------------------------------------------------------------- 1 | MODULE RS232T (IN clk, rst: BIT; (*NW 15.9.2014*) 2 | IN start, fsel: BIT; (*request to send a byte / freq select*) 3 | IN data: BYTE; OUT rdy, TxD: BIT); 4 | REG (clk) run: BIT; 5 | tick: [12] BIT; 6 | bitcnt: [4] BIT; 7 | shreg: [9] BIT; 8 | VAR endtick, endbit: BIT; 9 | limit: [12] BIT; 10 | BEGIN limit := fsel -> 217 : 1302; 11 | endtick := tick = limit; 12 | endbit := bitcnt = 9; 13 | rdy := ~run; 14 | TxD := shreg.0; 15 | 16 | run := (~rst | endtick & endbit) -> 0 : start -> 1 : run; 17 | tick := (run & ~endtick) -> tick + 1 : 0; 18 | bitcnt := (endtick & ~endbit) -> bitcnt + 1 : 19 | (endtick & endbit) -> 0'4 : bitcnt; 20 | shreg := ~rst -> 1 : 21 | start -> {data, 0'1} : 22 | endtick -> {1'1, shreg[8:1]} : shreg; 23 | END RS232T. 24 | -------------------------------------------------------------------------------- /Lola/Sources/SPI.Lola: -------------------------------------------------------------------------------- 1 | MODULE SPI ( 2 | IN clk, rst, start, fast: BIT; dataTx: WORD; 3 | OUT dataRx: WORD; rdy: BIT; 4 | IN MISO: BIT; 5 | OUT MOSI, SCLK: BIT); 6 | 7 | REG (clk) rdyR: BIT; 8 | shreg: WORD; 9 | tick: [6] BIT; 10 | bitcnt: [5] BIT; 11 | VAR endbit, endtick: BIT; 12 | 13 | BEGIN endtick := fast -> (tick = 1) : (tick = 63); (*25 MHz clock*) 14 | endbit := fast -> (bitcnt = 31) : (bitcnt = 7); 15 | rdy := rdyR; 16 | dataRx := fast -> shreg : {0'24, shreg[7:0]}; 17 | MOSI := (~rst | rdyR) -> 1 : shreg.7; 18 | SCLK := (~rst | rdyR) -> 1 : (fast -> tick.0 : tick.5); 19 | 20 | tick := (~rst | rdyR | endtick) -> 0 : tick + 1; 21 | rdyR := (~rst | endtick & endbit) | ~start & rdyR; 22 | bitcnt := (~rst | start) -> 0 : (endtick & ~endbit) -> bitcnt + 1 : bitcnt; 23 | shreg := ~rst -> $FFFFFFFF'32 : start -> dataTx : 24 | endtick -> {shreg[30:24], MISO, shreg[22:16], shreg[31], shreg[14:8], shreg[23], shreg[6:0], (fast -> shreg[15] : MISO)} : shreg; 25 | END SPI. 26 | -------------------------------------------------------------------------------- /Lola/Sources/SmallPrograms.Lola: -------------------------------------------------------------------------------- 1 | (* LSC.Compile @ LSV.List Test.Lola.v *) 2 | 3 | MODULE Counter (IN CLK50M, rstIn: BIT; 4 | IN swi: BYTE; OUT leds: BYTE); 5 | REG (CLK50M) rst: BIT; 6 | cnt0: [16] BIT; (*milliseconds*) 7 | cnt1: [10] BIT; (*half seconds*) 8 | cnt2: [8] BIT; 9 | VAR tick0, tick1: BIT; 10 | BEGIN leds := swi.7 -> swi : cnt2; 11 | tick0 := (cnt0 = 24999); 12 | tick1 := tick0 & (cnt1 = 499); 13 | rst := ~rstIn; 14 | cnt0 := ~rst -> 0 : tick0 -> 0 : cnt0 + 1; 15 | cnt1 := ~rst -> 0 : tick1 -> 0 : cnt1 + tick0; 16 | cnt2 := ~rst -> 0 : cnt2 + tick1 17 | END Counter. 18 | 19 | MODULE Shifter(IN CLK50M, rstIn: BIT; 20 | IN swi: BYTE; OUT leds: BYTE); 21 | REG (CLK50M) rst, up: BIT; 22 | cnt0: [16] BIT; (*milliseconds*) 23 | cnt1: [10] BIT; (*half seconds*) 24 | shreg: [8] BIT; 25 | VAR tick0, tick1: BIT; 26 | BEGIN leds := swi.7 -> swi : shreg; 27 | tick0 := (cnt0 = 24999); 28 | tick1 := tick0 & (cnt1 = 499); 29 | rst := ~rstIn; 30 | cnt0 := ~rst -> 0 : tick0 -> 0 : cnt0 + 1; 31 | cnt1 := ~rst -> 0 : tick1 -> 0 : cnt1 + tick0; 32 | shreg := ~rst -> 1'8 : 33 | ~tick1 -> shreg : 34 | up -> {shreg[6:0], 0'1} : {0'1, shreg[7:1]}; 35 | up := shreg.0 -> 1 : shreg.7 -> 0 : up 36 | END Shifter. 37 | -------------------------------------------------------------------------------- /Lola/Sources/VID.Lola: -------------------------------------------------------------------------------- 1 | MODULE VID ( 2 | IN clk, inv: BIT; 3 | viddata: WORD; 4 | OUT req: BIT; (*SRAM read request*) 5 | vidadr: [18] BIT; 6 | hsync, vsync: BIT; (*to display*) 7 | RGB: [3] BIT); 8 | 9 | CONST Org := 37FC0H; (* DFF00: adr of vcnt=1023 *) 10 | TYPE DCMX3 = MODULE (IN CLKIN: BIT; OUT CLKFX: BIT) ^; 11 | VAR hend, vend, vblank, xfer, vid, pclk: BIT; 12 | dcmx3: DCMX3; 13 | REG (pclk) hcnt: [11] BIT; 14 | vcnt: [10] BIT; 15 | hblank: BIT; 16 | pixbuf, vidbuf: WORD; 17 | REG (clk) req1: BIT; 18 | hword: [5] BIT; (*from hcnt, but latched in the clk domain*) 19 | 20 | BEGIN dcmx3 (clk, pclk); (* pixel clock generation *) 21 | hend := (hcnt = 1343); vend := (vcnt = 801); 22 | vblank := (vcnt.8 & vcnt.9); (*vcnt >= 768*) 23 | hsync := ~((hcnt >= 1086) & (hcnt < 1190)); (*-ve polarity*) 24 | vsync := (vcnt >= 771) & (vcnt < 776); (*+ve polarity*) 25 | xfer := (hcnt[4:0] = 6'5); (*data delay > hcnt cycle + req cycle*) 26 | vid := (pixbuf.0 ^ inv) & ~hblank & ~ vblank; 27 | RGB := {vid, vid, vid}; 28 | vidadr := Org + {0'3, ~vcnt, hword}; 29 | (*on pclk:*) 30 | hcnt := hend -> 0 : hcnt + 1; 31 | vcnt := hend -> (vend -> 0 : vcnt + 1) : vcnt; 32 | hblank := xfer -> hcnt.10 : hblank; (*hcnt >= 1024*) 33 | pixbuf := xfer -> vidbuf : {0'1, pixbuf[31:1]}; 34 | (*on clk:*) 35 | hword := hcnt[9:5]; 36 | req := req1; req1 := ~vblank & ~hcnt.10 & (hcnt.5 ^ hword.0); 37 | vidbuf := req -> viddata : vidbuf 38 | END VID. 39 | -------------------------------------------------------------------------------- /Oberon07.Report.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/Oberon07.Report.pdf -------------------------------------------------------------------------------- /PIO.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/PIO.pdf -------------------------------------------------------------------------------- /PO.Applications.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/PO.Applications.pdf -------------------------------------------------------------------------------- /PO.Computer.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/PO.Computer.pdf -------------------------------------------------------------------------------- /PO.System.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/PO.System.pdf -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Project Oberon 2 | The Design of an Operating System, 3 | a Compiler, and a Computer 4 | Revised Edition 2013 5 | Niklaus Wirth 6 | Jürg Gutknecht 7 | ISBN 0-201-54428-8 8 | http://www.inf.ethz.ch/personal/wirth/ProjectOberon/index.html 9 | http://projectoberon.com/ 10 | 11 | Emulators for the Oberon RISC machine: 12 | https://github.com/pdewacht/oberon-risc-emu 13 | http://schierlm.github.io/OberonEmulator 14 | https://github.com/MGreim/riscpas_repo 15 | https://github.com/aixp/ProjectOberon-BlackBox 16 | http://www.informatik.uni-bremen.de/~fld/UnixAos/RISC-Oberon/ 17 | 18 | Related: 19 | https://github.com/andreaspirklbauer/Oberon-experimental 20 | 21 | ![Oberon V5](/oberonV5.jpg "Oberon V5") 22 | -------------------------------------------------------------------------------- /Sources/Blink.Mod: -------------------------------------------------------------------------------- 1 | MODULE Blink; (*NW 30.5.2013*) 2 | IMPORT SYSTEM, Oberon; 3 | VAR z: INTEGER; 4 | T: Oberon.Task; 5 | 6 | PROCEDURE Run*; 7 | BEGIN Oberon.Install(T) 8 | END Run; 9 | 10 | PROCEDURE Stop*; 11 | BEGIN Oberon.Remove(T) 12 | END Stop; 13 | 14 | PROCEDURE Tick; 15 | BEGIN z := 1-z; LED(z) 16 | END Tick; 17 | 18 | BEGIN z := 0; T := Oberon.NewTask(Tick, 500) 19 | END Blink. 20 | -------------------------------------------------------------------------------- /Sources/BootLoad.Mod: -------------------------------------------------------------------------------- 1 | ORP.Compile @ 2 | ORX.WriteFile BootLoad.rsc 512 "D:/Verilog/RISC5/prom.mem"~ 3 | 4 | MODULE* BootLoad; (*NW 20.10.2013 / PR 4.2.2014; boot from SDHC disk or line*) 5 | IMPORT SYSTEM; 6 | (* sw0: init SD; sw1: line|disk*) 7 | CONST MT = 12; SP = 14; LNK = 15; 8 | MTOrg = 20H; MemLim = 0E7EF0H; stackOrg = 80000H; 9 | swi = -60; led = -60; rsData = -56; rsCtrl = -52; 10 | spiData = -48; spiCtrl = -44; 11 | CARD0 = 1; SPIFAST = 4; 12 | FSoffset = 80000H; (*block offset*) 13 | 14 | PROCEDURE RecInt(VAR x: INTEGER); 15 | VAR z, y, i: INTEGER; 16 | BEGIN z := 0; i := 4; 17 | REPEAT i := i-1; 18 | REPEAT UNTIL SYSTEM.BIT(rsCtrl, 0); 19 | SYSTEM.GET(rsData, y); z := ROR(z+y, 8) 20 | UNTIL i = 0; 21 | x := z 22 | END RecInt; 23 | 24 | PROCEDURE LoadFromLine; 25 | VAR len, adr, dat: INTEGER; 26 | BEGIN RecInt(len); 27 | WHILE len > 0 DO 28 | RecInt(adr); 29 | REPEAT RecInt(dat); SYSTEM.PUT(adr, dat); adr := adr + 4; len := len - 4 UNTIL len = 0; 30 | RecInt(len) 31 | END 32 | END LoadFromLine; 33 | 34 | (* ---------- disk ------------*) 35 | 36 | PROCEDURE SPIIdle(n: INTEGER); (*send n FFs slowly with no card selected*) 37 | BEGIN SYSTEM.PUT(spiCtrl, 0); 38 | WHILE n > 0 DO DEC(n); SYSTEM.PUT(spiData, -1); 39 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0) 40 | END 41 | END SPIIdle; 42 | 43 | PROCEDURE SPI(n: INTEGER); (*send&rcv byte slowly with card selected*) 44 | BEGIN SYSTEM.PUT(spiCtrl, CARD0); SYSTEM.PUT(spiData, n); 45 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0) 46 | END SPI; 47 | 48 | PROCEDURE SPICmd(n, arg: INTEGER); 49 | VAR i, data, crc: INTEGER; 50 | BEGIN (*send cmd*) 51 | REPEAT SPIIdle(1); SYSTEM.GET(spiData, data) UNTIL data = 255; (*flush while unselected*) 52 | REPEAT SPI(255); SYSTEM.GET(spiData, data) UNTIL data = 255; (*flush while selected*) 53 | IF n = 8 THEN crc := 135 ELSIF n = 0 THEN crc := 149 ELSE crc := 255 END; 54 | SPI(n MOD 64 + 64); (*send command*) 55 | FOR i := 24 TO 0 BY -8 DO SPI(ROR(arg, i)) END; (*send arg*) 56 | SPI(crc); i := 32; 57 | REPEAT SPI(255); SYSTEM.GET(spiData, data); DEC(i) UNTIL (data < 80H) OR (i = 0) 58 | END SPICmd; 59 | 60 | PROCEDURE InitSPI; 61 | VAR res, data: INTEGER; 62 | BEGIN SPIIdle(9); (*first, idle for at least 80 clks*) 63 | SPICmd(0, 0); (*CMD0 when card selected, sets MMC SPI mode*) 64 | SPICmd(8, 1AAH); SPI(-1); SPI(-1); SPI(-1); (*CMD8 for SD cards*) 65 | REPEAT (*until card becomes ready*) 66 | (*ACMD41, optionally with high-capacity (HCS) bit set, starts init*) 67 | SPICmd(55, 0); (*APP cmd follows*) 68 | SPICmd(41, LSL(1(*HCS*), 30)); 69 | SYSTEM.GET(spiData, res); 70 | SPI(-1); SPI(-1); SPI(-1); (*flush response*) 71 | SPIIdle(10000) 72 | UNTIL res = 0; 73 | (*CMD16 set block size as a precaution (should default)*) 74 | SPICmd(16, 512); SPIIdle(1) 75 | END InitSPI; 76 | 77 | PROCEDURE SDShift(VAR n: INTEGER); 78 | VAR data: INTEGER; 79 | BEGIN SPICmd(58, 0); (*CMD58 get card capacity bit*) 80 | SYSTEM.GET(spiData, data); SPI(-1); 81 | IF (data # 0) OR ~SYSTEM.BIT(spiData, 6) THEN n := n * 512 END ; (*non-SDHC card*) 82 | SPI(-1); SPI(-1); SPIIdle(1) (*flush response*) 83 | END SDShift; 84 | 85 | PROCEDURE ReadSD(src, dst: INTEGER); 86 | VAR i, data: INTEGER; 87 | BEGIN SDShift(src); SPICmd(17, src); (*CMD17 read one block*) 88 | i := 0; (*wait for start data marker*) 89 | REPEAT SPI(-1); SYSTEM.GET(spiData, data); INC(i) UNTIL data = 254; 90 | SYSTEM.PUT(spiCtrl, SPIFAST + CARD0); 91 | FOR i := 0 TO 508 BY 4 DO 92 | SYSTEM.PUT(spiData, -1); 93 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0); 94 | SYSTEM.GET(spiData, data); SYSTEM.PUT(dst, data); INC(dst, 4) 95 | END; 96 | SPI(255); SPI(255); SPIIdle(1) (*may be a checksum; deselect card*) 97 | END ReadSD; 98 | 99 | PROCEDURE LoadFromDisk; 100 | VAR src, dst, adr, lim: INTEGER; 101 | BEGIN src := FSoffset + 4; (*start at boot block*) 102 | ReadSD(src, 0); SYSTEM.GET(16, lim); 103 | INC(src); dst := 512; 104 | WHILE dst < lim DO ReadSD(src, dst); INC(src); INC(dst, 512) END 105 | END LoadFromDisk; 106 | 107 | BEGIN SYSTEM.LDREG(SP, stackOrg); SYSTEM.LDREG(MT, MTOrg); 108 | IF SYSTEM.REG(LNK) = 0 THEN (*cold start*) 109 | LED(80H); InitSPI; 110 | IF SYSTEM.BIT(swi, 0) THEN LED(81H); LoadFromLine ELSE LED(82H); LoadFromDisk END ; 111 | ELSIF SYSTEM.BIT(swi, 0) THEN LED(81H); LoadFromLine 112 | END ; 113 | SYSTEM.PUT(12, MemLim); SYSTEM.PUT(24, stackOrg); LED(84H) 114 | END BootLoad. 115 | 116 | ORP.Compile @ ORG.Decode 117 | ORX.WriteFile BootLoad.rsc "Spartan" "D:/Verilog/RISC/scripts/ins1.mem"~ 118 | ORG.WriteFile BootLoad.rsc "Spartan" "D:/Verilog/RISC3/scripts/ins1.mem" ~ 119 | ORG.WriteFile BootLoad.rsc "Spartan" "D:/Verilog/RISC5/scripts/ins1.mem"~ 120 | 121 | MODULE* BootLoad; (*NW 10.2.2013, boot from line only*) 122 | IMPORT SYSTEM; 123 | CONST MT = 12; SP = 14; StkOrg = 0FFFE7F00H; 124 | swi = -60; led = -60; data = -56; stat = -52; 125 | 126 | PROCEDURE RecInt(VAR x: INTEGER); 127 | VAR z, y, i: INTEGER; 128 | BEGIN z := 0; i := 4; 129 | REPEAT i := i-1; 130 | REPEAT UNTIL SYSTEM.BIT(stat, 0); 131 | SYSTEM.GET(data, y); z := ROR(z+y, 8) 132 | UNTIL i = 0; 133 | x := z 134 | END RecInt; 135 | 136 | PROCEDURE Load; 137 | VAR len, adr, dat: INTEGER; 138 | BEGIN RecInt(len); 139 | WHILE len > 0 DO 140 | RecInt(adr); 141 | REPEAT RecInt(dat); SYSTEM.PUT(adr, dat); adr := adr + 4; len := len - 4 UNTIL len = 0; 142 | RecInt(len) 143 | END ; 144 | SYSTEM.GET(4, adr); SYSTEM.LDREG(13, adr); SYSTEM.LDREG(12, 20H) 145 | END Load; 146 | 147 | BEGIN SYSTEM.LDREG(SP, StkOrg); SYSTEM.LDREG(MT, 20H); SYSTEM.PUT(led, 128); 148 | IF ~SYSTEM.BIT(swi, 0) THEN Load END 149 | END BootLoad. 150 | 151 | ORP.Compile @ ORG.Decode 152 | ORX.WriteFile Counter.rsc 2048 "D:/Verilog/RISC/prom.mem"~ 153 | ORX.WriteFile Shifter.rsc 2048 "D:/Verilog/RISC/prom.mem"~ 154 | ORX.WriteFile TestInt.rsc 2048 "D:/Verilog/RISC3/scripts/ins1.mem"~ 155 | ORX.WriteFile BootLoad.rsc 512 "D:/Verilog/RISC5/prom.mem"~ 156 | 157 | MODULE* Counter; 158 | VAR x, y, z: INTEGER; 159 | BEGIN LED(1); z := 0; 160 | REPEAT LED(z); x := 1000; 161 | REPEAT y := 1000; 162 | REPEAT y := y-1 UNTIL y = 0; 163 | x := x-1 164 | UNTIL x = 0; 165 | z := z+1 166 | UNTIL FALSE 167 | END Counter. 168 | 169 | MODULE* Shifter; 170 | VAR x, y, z, d: INTEGER; 171 | BEGIN z := 1; d := 1; 172 | REPEAT LED(z); x := 1000; 173 | REPEAT y := 1000; 174 | REPEAT y := y-1 UNTIL y = 0; 175 | x := x-1 176 | UNTIL x = 0; 177 | IF z = 128 THEN d := -1 ELSIF z = 1 THEN d := 1 END ; 178 | IF d = 1 THEN z := LSL(z, 1) ELSE z := ASR(z, 1) END 179 | UNTIL FALSE 180 | END Shifter. 181 | 182 | MODULE* TestInt; 183 | IMPORT SYSTEM; 184 | VAR led, led1, cnt, cnt1: INTEGER; 185 | 186 | PROCEDURE* Int; (*interrupt every millisecond*) 187 | BEGIN INC(cnt1); 188 | IF cnt1 = 500 THEN led1 := 1 - led1; LED(led1); cnt1 := 0 END 189 | END Int; 190 | 191 | BEGIN led := 0; led1 := 0; cnt := 0; cnt1 := 0; 192 | SYSTEM.PUT(4, 0E7000000H + SYSTEM.ADR(Int) DIV 4 - 2); 193 | SYSTEM.LDPSR(1); (*int enable*) 194 | REPEAT 195 | IF SYSTEM.BIT(-60, 0) THEN 196 | cnt := 100000; 197 | REPEAT DEC(cnt) UNTIL cnt = 0; 198 | LED(led); INC(led) 199 | END 200 | UNTIL FALSE; 201 | END TestInt. 202 | -------------------------------------------------------------------------------- /Sources/Checkers.Mod: -------------------------------------------------------------------------------- 1 | MODULE Checkers; (*NW 4.10.90 / 10.3.2013*) 2 | IMPORT SYSTEM, Display, Viewers, Oberon, MenuViewers, TextFrames; 3 | 4 | TYPE Frame = POINTER TO FrameDesc; 5 | 6 | FrameDesc = RECORD (Display.FrameDesc) 7 | col: INTEGER 8 | END ; 9 | 10 | VAR i: INTEGER; 11 | checks: INTEGER; 12 | pat: ARRAY 17 OF INTEGER; 13 | 14 | PROCEDURE Restore(F: Frame); 15 | BEGIN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); 16 | Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); (*clear*) 17 | Display.ReplPattern(F.col, checks, F.X+1, F.Y, F.W-1, F.H-1, Display.paint) 18 | END Restore; 19 | 20 | PROCEDURE Handle(G: Display.Frame; VAR M: Display.FrameMsg); 21 | VAR G1: Frame; 22 | BEGIN 23 | CASE G OF Frame: 24 | CASE M OF 25 | Oberon.InputMsg: 26 | IF M.id = Oberon.track THEN Oberon.DrawMouseArrow(M.X, M.Y) END | 27 | Oberon.CopyMsg: 28 | Oberon.RemoveMarks(G.X, G.Y, G.W, G.H); NEW(G1); G1^ := G^; M.F := G1 | 29 | MenuViewers.ModifyMsg: 30 | IF (M.Y # G.Y) OR (M.H # G.H) THEN G.Y := M.Y; G.H := M.H; Restore(G) END 31 | END 32 | END 33 | END Handle; 34 | 35 | PROCEDURE Open*; 36 | VAR F: Frame; V: Viewers.Viewer; X, Y: INTEGER; 37 | BEGIN NEW(F); F.col := 14; F.handle := Handle; 38 | Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 39 | V := MenuViewers.New( 40 | TextFrames.NewMenu("CheckerViewer", "System.Close System.Copy System.Grow"), 41 | F, TextFrames.menuH, X, Y) 42 | END Open; 43 | 44 | BEGIN checks := SYSTEM.ADR(pat); pat[0] := 1010H; i := 1; 45 | REPEAT pat[i] := 0FF00FFH; INC(i) UNTIL i = 9; 46 | REPEAT pat[i] := 0FF00FF00H; INC(i) UNTIL i = 17 47 | END Checkers. 48 | -------------------------------------------------------------------------------- /Sources/Curves.Mod: -------------------------------------------------------------------------------- 1 | MODULE Curves; (*NW 8.11.90 / 18.4.2013*) 2 | IMPORT Display, Files, Oberon, Graphics, GraphicFrames; 3 | 4 | TYPE 5 | Curve* = POINTER TO CurveDesc; 6 | 7 | CurveDesc* = RECORD (Graphics.ObjectDesc) 8 | kind*, lw*: INTEGER 9 | END ; 10 | 11 | (*kind: 0 = up-line, 1 = down-line, 2 = circle, 3 = ellipse*) 12 | 13 | VAR method*: Graphics.Method; 14 | 15 | PROCEDURE Dot(f: GraphicFrames.Frame; col, x, y: INTEGER); 16 | BEGIN 17 | IF (x >= f.X) & (x+7 < f.X1) & (y >= f.Y) & (x+7 < f.Y1) THEN Display.Dot(col, x, y, Display.replace) END 18 | END Dot; 19 | 20 | PROCEDURE mark(f: GraphicFrames.Frame; col, x, y: INTEGER); 21 | BEGIN DEC(x, 3); DEC(y, 3); 22 | IF (x >= f.X) & (x+7 < f.X1) & (y >= f.Y) & (y+7 < f.Y1) THEN 23 | IF col = Display.black THEN Display.ReplConst(Display.black, x, y, 7, 7, Display.replace) 24 | ELSE Display.CopyPattern(col, GraphicFrames.tack, x, y, Display.replace) 25 | END 26 | END 27 | END mark; 28 | 29 | PROCEDURE line(f: GraphicFrames.Frame; col: INTEGER; x, y, w, h, d: LONGINT); 30 | VAR x1, y1, u: LONGINT; 31 | BEGIN 32 | IF h < w THEN 33 | x1 := x+w; u := (h-w) DIV 2; 34 | IF d = -1 THEN INC(y, h) END ; 35 | WHILE x < x1 DO 36 | Dot(f, col, x, y); INC(x); 37 | IF u < 0 THEN INC(u, h) ELSE INC(u, h-w); INC(y, d) END 38 | END 39 | ELSE y1 := y+h; u := (w-h) DIV 2; 40 | IF d = -1 THEN INC(x, w) END ; 41 | WHILE y < y1 DO 42 | Dot(f, col, x, y); INC(y); 43 | IF u < 0 THEN INC(u, w) ELSE INC(u, w-h); INC(x, d) END 44 | END 45 | END 46 | END line; 47 | 48 | PROCEDURE circle(f: GraphicFrames.Frame; col: INTEGER; x0, y0, r: LONGINT); 49 | VAR x, y, u: LONGINT; 50 | BEGIN u := 1 - r; x := r; y := 0; 51 | WHILE y <= x DO 52 | Dot(f, col, x0+x, y0+y); 53 | Dot(f, col, x0+y, y0+x); 54 | Dot(f, col, x0-y, y0+x); 55 | Dot(f, col, x0-x, y0+y); 56 | Dot(f, col, x0-x, y0-y); 57 | Dot(f, col, x0-y, y0-x); 58 | Dot(f, col, x0+y, y0-x); 59 | Dot(f, col, x0+x, y0-y); 60 | IF u < 0 THEN INC(u, 2*y+3) ELSE INC(u, 2*(y-x)+5); DEC(x) END ; 61 | INC(y) 62 | END 63 | END circle; 64 | 65 | PROCEDURE ellipse(f: GraphicFrames.Frame; col: INTEGER; x0, y0, a, b: LONGINT); 66 | VAR x, y, y1, aa, bb, d, g, h: LONGINT; 67 | BEGIN aa := a*a; bb := b*b; 68 | h := (aa DIV 4) - b*aa + bb; g := (9*aa DIV 4) - 3*b*aa + bb; x := 0; y := b; 69 | WHILE g < 0 DO 70 | Dot(f, col, x0+x, y0+y); 71 | Dot(f, col, x0-x, y0+y); 72 | Dot(f, col, x0-x, y0-y); 73 | Dot(f, col, x0+x, y0-y); 74 | IF h < 0 THEN d := (2*x+3)*bb; INC(g, d) 75 | ELSE d := (2*x+3)*bb - 2*(y-1)*aa; INC(g, d + 2*aa); DEC(y) 76 | END ; 77 | INC(h, d); INC(x) 78 | END ; 79 | y1 := y; h := (bb DIV 4) - a*bb + aa; x := a; y := 0; 80 | WHILE y <= y1 DO 81 | Dot(f, col, x0+x, y0+y); 82 | Dot(f, col, x0-x, y0+y); 83 | Dot(f, col, x0-x, y0-y); 84 | Dot(f, col, x0+x, y0-y); 85 | IF h < 0 THEN INC(h, (2*y+3)*aa) ELSE INC(h, (2*y+3)*aa - 2*(x-1)*bb); DEC(x) END ; 86 | INC(y) 87 | END 88 | END ellipse; 89 | 90 | PROCEDURE New*; 91 | VAR c: Curve; 92 | BEGIN NEW(c); c.do := method; Graphics.New(c) 93 | END New; 94 | 95 | PROCEDURE Copy(src, dst: Graphics.Object); 96 | BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col; 97 | dst(Curve).kind := src(Curve).kind; dst(Curve).lw := src(Curve).lw 98 | END Copy; 99 | 100 | PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg); 101 | VAR x, y, w, h, col: INTEGER; f: GraphicFrames.Frame; 102 | BEGIN 103 | CASE M OF GraphicFrames.DrawMsg: 104 | x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f; 105 | IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ; 106 | IF (x < f.X1) & (f.X <= x+w) & (y < f.Y1) & (f.Y <= y+h) THEN 107 | IF obj(Curve).kind = 0 THEN (*up-line*) 108 | IF M.mode = 0 THEN 109 | IF obj.selected THEN mark(f, Display.white, x, y) END ; 110 | line(f, col, x, y, w, h, 1) 111 | ELSIF M.mode = 1 THEN mark(f, Display.white, x, y) 112 | ELSIF M.mode = 2 THEN mark(f, f.col, x, y) 113 | ELSIF M.mode = 3 THEN mark(f, Display.black, x, y); line(f, Display.black, x, y, w, h, 1) 114 | END 115 | ELSIF obj(Curve).kind = 1 THEN (*down-line*) 116 | IF M.mode = 0 THEN 117 | IF obj.selected THEN mark(f, Display.white, x, y+h) END ; 118 | line(f, col, x, y, w, h, -1) 119 | ELSIF M.mode = 1 THEN mark(f, Display.white, x, y+h) 120 | ELSIF M.mode = 2 THEN mark(f, f.col, x, y+h) 121 | ELSIF M.mode = 3 THEN mark(f, Display.black, x, y+h); line(f, Display.black, x, y, w, h, -1) 122 | END 123 | ELSIF obj(Curve).kind = 2 THEN (*circle*) 124 | w := w DIV 2; 125 | IF M.mode = 0 THEN 126 | IF obj.selected THEN mark(f, Display.white, x+w, y) END ; 127 | circle(f, col, x+w, y+w, w) 128 | ELSIF M.mode = 1 THEN mark(f, Display.white, x+w, y) 129 | ELSIF M.mode = 2 THEN mark(f, f.col, x+w, y) 130 | ELSIF M.mode = 3 THEN mark(f, Display.black, x+w, y); circle(f, Display.black, x+w, y+w, w) 131 | END 132 | ELSIF obj(Curve).kind = 3 THEN (*ellipse*) 133 | w := w DIV 2; h := h DIV 2; 134 | IF M.mode = 0 THEN 135 | IF obj.selected THEN mark(f, Display.white, x+w, y) END ; 136 | ellipse(f, col, x+w, y+h, w, h) 137 | ELSIF M.mode = 1 THEN mark(f, Display.white, x+w, y) 138 | ELSIF M.mode = 2 THEN mark(f, f.col, x+w, y) 139 | ELSIF M.mode = 3 THEN mark(f, Display.black, x+w, y); ellipse(f, Display.black, x+w, y+h, w, h) 140 | END 141 | END 142 | END 143 | END 144 | END Draw; 145 | 146 | PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN; 147 | VAR xm, y0, w, h: INTEGER; res: BOOLEAN; 148 | BEGIN 149 | IF obj(Curve).kind <= 1 THEN (*line*) 150 | w := obj.w; h := obj.h; 151 | IF obj(Curve).kind = 1 THEN y0 := obj.y + h; h := -h ELSE y0 := obj.y END ; 152 | res := (obj.x <= x) & (x < obj.x + w) & (ABS(y-y0)*w - (x-obj.x)*h < w*4) 153 | ELSE (*circle or ellipse*) 154 | xm := obj.w DIV 2 + obj.x; 155 | res := (xm - 4 <= x) & (x <= xm + 4) & (obj.y - 4 <= y) & (y <= obj.y + 4) 156 | END ; 157 | RETURN res 158 | END Selectable; 159 | 160 | PROCEDURE Change(obj: Graphics.Object; VAR M: Graphics.Msg); 161 | BEGIN 162 | IF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col END 163 | END Change; 164 | 165 | PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context); 166 | VAR len: BYTE; 167 | BEGIN Files.ReadByte(R, len); Files.ReadByte(R, len); obj(Curve).kind := len; 168 | Files.ReadByte(R, len); obj(Curve).lw := len 169 | END Read; 170 | 171 | PROCEDURE Write(obj: Graphics.Object; cno: INTEGER; VAR W: Files.Rider; VAR C: Graphics.Context); 172 | BEGIN Graphics.WriteObj(W, cno, obj); 173 | Files.WriteByte(W, 2); Files.WriteByte(W, obj(Curve).kind); Files.WriteByte(W, obj(Curve).lw) 174 | END Write; 175 | 176 | PROCEDURE MakeLine*; (*command*) 177 | VAR x0, x1, y0, y1: INTEGER; 178 | c: Curve; 179 | G: GraphicFrames.Frame; 180 | BEGIN G := GraphicFrames.Focus(); 181 | IF (G # NIL) & (G.mark.next # NIL) THEN 182 | GraphicFrames.Deselect(G); 183 | x0 := G.mark.x; y0 := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y; 184 | NEW(c); c.col := Oberon.CurCol; 185 | c.w := ABS(x1-x0); c.h := ABS(y1-y0); c.lw := Graphics.width; 186 | IF x0 <= x1 THEN c.x := x0; 187 | IF y0 <= y1 THEN c.kind := 0; c.y := y0 ELSE c.kind := 1; c.y := y1 END 188 | ELSE c.x := x1; 189 | IF y1 < y0 THEN c.kind := 0; c.y := y1 ELSE c.kind := 1; c.y := y0 END 190 | END ; 191 | DEC(c.x, G.x); DEC(c.y, G.y); c.do := method; 192 | Graphics.Add(G.graph, c); 193 | GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c) 194 | END 195 | END MakeLine; 196 | 197 | PROCEDURE MakeCircle*; (*command*) 198 | VAR x0, y0, r: INTEGER; 199 | c: Curve; 200 | G: GraphicFrames.Frame; 201 | BEGIN G := GraphicFrames.Focus(); 202 | IF (G # NIL) & (G.mark.next # NIL) THEN 203 | GraphicFrames.Deselect(G); 204 | x0 := G.mark.x; y0 := G.mark.y; r := ABS(G.mark.next.x-x0); 205 | IF r > 4 THEN 206 | NEW(c); c.x := x0 - r - G.x; c.y := y0 - r - G.y; c.w := 2*r+1; c.h := c.w; 207 | c.kind := 2; c.col := Oberon.CurCol; 208 | c.lw := Graphics.width; c.do := method; 209 | Graphics.Add(G.graph, c); 210 | GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c) 211 | END 212 | END 213 | END MakeCircle; 214 | 215 | PROCEDURE MakeEllipse*; (*command*) 216 | VAR x0, y0, a, b: INTEGER; 217 | c: Curve; 218 | G: GraphicFrames.Frame; 219 | BEGIN G := GraphicFrames.Focus(); 220 | IF (G # NIL) & (G.mark.next # NIL) & (G.mark.next.next # NIL) THEN 221 | GraphicFrames.Deselect(G); 222 | x0 := G.mark.x; y0 := G.mark.y; 223 | a := ABS(G.mark.next.x-x0); b := ABS(G.mark.next.next.y - y0); 224 | IF (a > 4) & (b > 4) THEN 225 | NEW(c); c.x := x0 - a - G.x; c.y := y0 - b - G.y; c.w := 2*a+1; c.h := 2*b+1; 226 | c.kind := 3; c.col := Oberon.CurCol; 227 | c.lw := Graphics.width; c.do := method; 228 | Graphics.Add(G.graph, c); 229 | GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c) 230 | END 231 | END 232 | END MakeEllipse; 233 | 234 | BEGIN NEW(method); method.module := "Curves"; method.allocator := "New"; 235 | method.new := New; method.copy := Copy; method.draw := Draw; 236 | method.selectable := Selectable; method.change := Change; 237 | method.read := Read; method.write := Write 238 | END Curves. 239 | -------------------------------------------------------------------------------- /Sources/Display.Mod: -------------------------------------------------------------------------------- 1 | MODULE Display; (*NW 5.11.2013*) 2 | IMPORT SYSTEM; 3 | 4 | CONST black* = 0; white* = 1; (*black = background*) 5 | replace* = 0; paint* = 1; invert* = 2; (*modes*) 6 | base = 0E7F00H; (*adr of 1024 x 768 pixel, monocolor display frame*) 7 | 8 | TYPE Frame* = POINTER TO FrameDesc; 9 | FrameMsg* = RECORD END ; 10 | Handler* = PROCEDURE (F: Frame; VAR M: FrameMsg); 11 | FrameDesc* = RECORD next*, dsc*: Frame; 12 | X*, Y*, W*, H*: INTEGER; 13 | handle*: Handler 14 | END ; 15 | 16 | VAR Base*, Width*, Height*: INTEGER; 17 | arrow*, star*, hook*, updown*, block*, cross*, grey*: INTEGER; 18 | (*a pattern is an array of bytes; the first is its width (< 32), the second its height, the rest the raster*) 19 | 20 | PROCEDURE Handle*(F: Frame; VAR M: FrameMsg); 21 | BEGIN 22 | IF (F # NIL) & (F.handle # NIL) THEN F.handle(F, M) END 23 | END Handle; 24 | 25 | (* raster ops *) 26 | 27 | PROCEDURE Dot*(col, x, y, mode: INTEGER); 28 | VAR a: INTEGER; u, s: SET; 29 | BEGIN a := base + (x DIV 32)*4 + y*128; 30 | s := {x MOD 32}; SYSTEM.GET(a, u); 31 | IF mode = paint THEN SYSTEM.PUT(a, u + s) 32 | ELSIF mode = invert THEN SYSTEM.PUT(a, u / s) 33 | ELSE (*mode = replace*) 34 | IF col # black THEN SYSTEM.PUT(a, u + s) ELSE SYSTEM.PUT(a, u - s) END 35 | END 36 | END Dot; 37 | 38 | PROCEDURE ReplConst*(col, x, y, w, h, mode: INTEGER); 39 | VAR al, ar, a0, a1: INTEGER; left, right, mid, pix, pixl, pixr: SET; 40 | BEGIN al := base + y*128; 41 | ar := ((x+w-1) DIV 32)*4 + al; al := (x DIV 32)*4 + al; 42 | IF ar = al THEN 43 | mid := {(x MOD 32) .. ((x+w-1) MOD 32)}; 44 | FOR a1 := al TO al + (h-1)*128 BY 128 DO 45 | SYSTEM.GET(a1, pix); 46 | IF mode = invert THEN SYSTEM.PUT(a1, pix / mid) 47 | ELSIF (mode = replace) & (col = black) THEN (*erase*) SYSTEM.PUT(a1, pix - mid) 48 | ELSE (* (mode = paint) OR (mode = replace) & (col # black) *) SYSTEM.PUT(a1, pix + mid) 49 | END 50 | END 51 | ELSE 52 | left := {(x MOD 32) .. 31}; right := {0 .. ((x+w-1) MOD 32)}; 53 | FOR a0 := al TO al + (h-1)*128 BY 128 DO 54 | SYSTEM.GET(a0, pixl); SYSTEM.GET(ar, pixr); 55 | IF mode = invert THEN 56 | SYSTEM.PUT(a0, pixl / left); 57 | FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.GET(a1, pix); SYSTEM.PUT(a1, -pix) END ; 58 | SYSTEM.PUT(ar, pixr / right) 59 | ELSIF (mode = replace) & (col = black) THEN (*erase*) 60 | SYSTEM.PUT(a0, pixl - left); 61 | FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.PUT(a1, {}) END ; 62 | SYSTEM.PUT(ar, pixr - right) 63 | ELSE (* (mode = paint) OR (mode = replace) & (col # black) *) 64 | SYSTEM.PUT(a0, pixl + left); 65 | FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.PUT(a1, {0 .. 31}) END ; 66 | SYSTEM.PUT(ar, pixr + right) 67 | END ; 68 | INC(ar, 128) 69 | END 70 | END 71 | END ReplConst; 72 | 73 | PROCEDURE CopyPattern*(col, patadr, x, y, mode: INTEGER); (*only for modes = paint, invert*) 74 | VAR a, a0, pwd: INTEGER; 75 | w, h, pbt: BYTE; pix: SET; 76 | BEGIN SYSTEM.GET(patadr, w); SYSTEM.GET(patadr+1, h); INC(patadr, 2); 77 | a := base + (x DIV 32)*4 + y*128; 78 | FOR a0 := a TO a + (h-1)*128 BY 128 DO 79 | (*build pattern line; w < 32*) 80 | SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt; 81 | IF w > 8 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*100H + pwd; 82 | IF w > 16 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*10000H + pwd; 83 | IF w > 24 THEN SYSTEM.GET(patadr, pbt); INC(patadr); pwd := pbt*1000000H + pwd END 84 | END 85 | END ; 86 | SYSTEM.GET(a0, pix); 87 | IF mode = invert THEN SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x MOD 32)) / pix) 88 | ELSE SYSTEM.PUT(a0, SYSTEM.VAL(SET, LSL(pwd, x MOD 32)) + pix) 89 | END ; 90 | IF (x MOD 32) + w > 32 THEN (*spill over*) 91 | SYSTEM.GET(a0+4, pix); 92 | IF mode = invert THEN SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -(x MOD 32))) / pix) 93 | ELSE SYSTEM.PUT(a0+4, SYSTEM.VAL(SET, ASR(pwd, -(x MOD 32))) + pix) 94 | END 95 | END 96 | END 97 | END CopyPattern; 98 | 99 | PROCEDURE CopyBlock*(sx, sy, w, h, dx, dy, mode: INTEGER); (*only for mode = replace*) 100 | VAR sa, da, sa0, sa1, d, len: INTEGER; 101 | u0, u1, u2, u3, v0, v1, v2, v3, n: INTEGER; 102 | end, step: INTEGER; 103 | src, dst, spill: SET; 104 | m0, m1, m2, m3: SET; 105 | BEGIN 106 | u0 := sx DIV 32; u1 := sx MOD 32; u2 := (sx+w) DIV 32; u3 := (sx+w) MOD 32; 107 | v0 := dx DIV 32; v1 := dx MOD 32; v2 := (dx+w) DIV 32; v3 := (dx+w) MOD 32; 108 | sa := base + u0*4 + sy*128; da := base + v0*4 + dy*128; 109 | d := da - sa; n := u1 - v1; (*displacement in words and bits*) 110 | len := (u2 - u0) * 4; 111 | m0 := {v1 .. 31}; m2 := {v3 .. 31}; m3 := m0 / m2; 112 | IF d >= 0 THEN (*copy up, scan down*) sa0 := sa + (h-1)*128; end := sa-128; step := -128 113 | ELSE (*copy down, scan up*) sa0 := sa; end := sa + h*128; step := 128 114 | END ; 115 | WHILE sa0 # end DO 116 | IF n >= 0 THEN (*shift right*) m1 := {n .. 31}; 117 | IF v1 + w >= 32 THEN 118 | SYSTEM.GET(sa0+len, src); src := ROR(src, n); 119 | SYSTEM.GET(sa0+len+d, dst); 120 | SYSTEM.PUT(sa0+len+d, (dst * m2) + (src - m2)); 121 | spill := src - m1; 122 | FOR sa1 := sa0 + len-4 TO sa0+4 BY -4 DO 123 | SYSTEM.GET(sa1, src); src := ROR(src, n); 124 | SYSTEM.PUT(sa1+d, spill + (src * m1)); 125 | spill := src - m1 126 | END ; 127 | SYSTEM.GET(sa0, src); src := ROR(src, n); 128 | SYSTEM.GET(sa0+d, dst); 129 | SYSTEM.PUT(sa0+d, (src * m0) + (dst - m0)) 130 | ELSE SYSTEM.GET(sa0, src); src := ROR(src, n); 131 | SYSTEM.GET(sa0+d, dst); 132 | SYSTEM.PUT(sa0+d, (src * m3) + (dst - m3)) 133 | END 134 | ELSE (*shift left*) m1 := {-n .. 31}; 135 | SYSTEM.GET(sa0, src); src := ROR(src, n); 136 | SYSTEM.GET(sa0+d, dst); 137 | IF v1 + w < 32 THEN 138 | SYSTEM.PUT(sa0+d, (dst - m3) + (src * m3)) 139 | ELSE SYSTEM.PUT(sa0+d, (dst - m0) + (src * m0)); 140 | spill := src - m1; 141 | FOR sa1 := sa0+4 TO sa0 + len-4 BY 4 DO 142 | SYSTEM.GET(sa1, src); src := ROR(src, n); 143 | SYSTEM.PUT(sa1+d, spill + (src * m1)); 144 | spill := src - m1 145 | END ; 146 | SYSTEM.GET(sa0+len, src); src := ROR(src, n); 147 | SYSTEM.GET(sa0+len+d, dst); 148 | SYSTEM.PUT(sa0+len+d, (src - m2) + (dst * m2)) 149 | END 150 | END ; 151 | INC(sa0, step) 152 | END 153 | END CopyBlock; 154 | 155 | PROCEDURE ReplPattern*(col, patadr, x, y, w, h, mode: INTEGER); 156 | (* pattern width = 32, fixed; pattern starts at patadr+4, for mode = invert only *) 157 | VAR al, ar, a0, a1: INTEGER; 158 | pta0, pta1: INTEGER; (*pattern addresses*) 159 | ph: BYTE; 160 | left, right, mid, pix, pixl, pixr, ptw: SET; 161 | BEGIN al := base + y*128; SYSTEM.GET(patadr+1, ph); 162 | pta0 := patadr+4; pta1 := ph*4 + pta0; 163 | ar := ((x+w-1) DIV 32)*4 + al; al := (x DIV 32)*4 + al; 164 | IF ar = al THEN 165 | mid := {(x MOD 32) .. ((x+w-1) MOD 32)}; 166 | FOR a1 := al TO al + (h-1)*128 BY 128 DO 167 | SYSTEM.GET(a1, pix); SYSTEM.GET(pta0, ptw); SYSTEM.PUT(a1, (pix - mid) + (pix/ptw * mid)); INC(pta0, 4); 168 | IF pta0 = pta1 THEN pta0 := patadr+4 END 169 | END 170 | ELSE 171 | left := {(x MOD 32) .. 31}; right := {0 .. ((x+w-1) MOD 32)}; 172 | FOR a0 := al TO al + (h-1)*128 BY 128 DO 173 | SYSTEM.GET(a0, pixl); SYSTEM.GET(pta0, ptw); SYSTEM.PUT(a0, (pixl - left) + (pixl/ptw * left)); 174 | FOR a1 := a0+4 TO ar-4 BY 4 DO SYSTEM.GET(a1, pix); SYSTEM.PUT(a1, pix/ptw) END ; 175 | SYSTEM.GET(ar, pixr); SYSTEM.PUT(ar, (pixr - right) + (pixr/ptw * right)); 176 | INC(pta0, 4); INC(ar, 128); 177 | IF pta0 = pta1 THEN pta0 := patadr+4 END 178 | END 179 | END 180 | END ReplPattern; 181 | 182 | BEGIN Base := base; Width := 1024; Height := 768; 183 | arrow := SYSTEM.ADR($0F0F 0060 0070 0038 001C 000E 0007 8003 C101 E300 7700 3F00 1F00 3F00 7F00 FF00$); 184 | star := SYSTEM.ADR($0F0F 8000 8220 8410 8808 9004 A002 C001 7F7F C001 A002 9004 8808 8410 8220 8000$); 185 | hook := SYSTEM.ADR($0C0C 070F 8707 C703 E701 F700 7F00 3F00 1F00 0F00 0700 0300 01$); 186 | updown := SYSTEM.ADR($080E 183C 7EFF 1818 1818 1818 FF7E3C18$); 187 | block := SYSTEM.ADR($0808 FFFF C3C3 C3C3 FFFF$); 188 | cross := SYSTEM.ADR($0F0F 0140 0220 0410 0808 1004 2002 4001 0000 4001 2002 1004 0808 0410 0220 0140$); 189 | grey := SYSTEM.ADR($2002 0000 5555 5555 AAAA AAAA$) 190 | END Display. 191 | -------------------------------------------------------------------------------- /Sources/Draw.Mod: -------------------------------------------------------------------------------- 1 | MODULE Draw; (*NW 29.6.88 / 12.11.94 / 18.11.2013*) 2 | 3 | IMPORT Files, Fonts, Viewers, Texts, Oberon, 4 | TextFrames, MenuViewers, Graphics, GraphicFrames; 5 | 6 | CONST Menu = "System.Close System.Copy System.Grow Draw.Delete Draw.Ticks Draw.Restore Draw.Store"; 7 | 8 | VAR W: Texts.Writer; 9 | 10 | (*Exported commands: 11 | Open, Delete, 12 | SetWidth, ChangeColor, ChangeWidth, ChangeFont, 13 | Store, Print, Macro, Ticks, Restore*) 14 | 15 | PROCEDURE Open*; 16 | VAR X, Y: INTEGER; 17 | beg, end, t: LONGINT; 18 | G: Graphics.Graph; 19 | F: GraphicFrames.Frame; 20 | V: Viewers.Viewer; 21 | S: Texts.Scanner; 22 | text: Texts.Text; 23 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 24 | IF (S.class = Texts.Char) & (S.c = "^") THEN 25 | Oberon.GetSelection(text, beg, end, t); 26 | IF t >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END 27 | END ; 28 | IF S.class = Texts.Name THEN 29 | NEW(G); Graphics.Open(G, S.s); 30 | NEW(F); GraphicFrames.Open(F, G); 31 | Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 32 | V := MenuViewers.New(TextFrames.NewMenu(S.s, Menu), F, TextFrames.menuH, X, Y) 33 | END 34 | END Open; 35 | 36 | PROCEDURE Delete*; 37 | VAR F: GraphicFrames.Frame; 38 | BEGIN 39 | IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN 40 | F := Oberon.Par.vwr.dsc.next(GraphicFrames.Frame); 41 | GraphicFrames.Erase(F); Graphics.Delete(F.graph) 42 | END 43 | END Delete; 44 | 45 | PROCEDURE GetArg(VAR S: Texts.Scanner); 46 | VAR T: Texts.Text; beg, end, time: LONGINT; 47 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 48 | IF (S.class = Texts.Char) & (S.c = "^") THEN 49 | Oberon.GetSelection(T, beg, end, time); 50 | IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END 51 | END 52 | END GetArg; 53 | 54 | PROCEDURE SetWidth*; 55 | VAR S: Texts.Scanner; 56 | BEGIN GetArg(S); 57 | IF (S.class = Texts.Int) & (S.i > 0) & (S.i < 7) THEN Graphics.SetWidth(S.i) END 58 | END SetWidth; 59 | 60 | PROCEDURE ChangeColor*; 61 | VAR S: Texts.Scanner; CM: Graphics.ColorMsg; 62 | BEGIN GetArg(S); 63 | IF S.class = Texts.Int THEN 64 | CM.col := S.i MOD 16; GraphicFrames.Change(GraphicFrames.Selected(), CM) 65 | END 66 | END ChangeColor; 67 | 68 | PROCEDURE ChangeWidth*; 69 | VAR S: Texts.Scanner; WM: Graphics.WidMsg; 70 | BEGIN GetArg(S); 71 | IF S.class = Texts.Int THEN 72 | WM.w := S.i; GraphicFrames.Change(GraphicFrames.Selected(), WM) 73 | END 74 | END ChangeWidth; 75 | 76 | PROCEDURE ChangeFont*; 77 | VAR S: Texts.Scanner; FM: Graphics.FontMsg; 78 | BEGIN GetArg(S); 79 | IF S.class = Texts.Name THEN 80 | FM.fnt := Fonts.This(S.s); 81 | IF FM.fnt # NIL THEN GraphicFrames.Change(GraphicFrames.Selected(), FM) END 82 | END 83 | END ChangeFont; 84 | 85 | PROCEDURE Redraw(Q: BOOLEAN); 86 | VAR v: Viewers.Viewer; G: GraphicFrames.Frame; 87 | BEGIN 88 | IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN v := Oberon.Par.vwr 89 | ELSE v := Oberon.MarkedViewer() 90 | END ; 91 | IF (v # NIL) & (v.dsc # NIL) & (v.dsc.next IS GraphicFrames.Frame) THEN 92 | G := v.dsc.next(GraphicFrames.Frame); G.ticked := Q OR ~G.ticked; GraphicFrames.Restore(G) 93 | END 94 | END Redraw; 95 | 96 | PROCEDURE Ticks*; 97 | BEGIN Redraw(FALSE) 98 | END Ticks; 99 | 100 | PROCEDURE Restore*; 101 | BEGIN Redraw(TRUE) 102 | END Restore; 103 | 104 | PROCEDURE Backup (VAR name: ARRAY OF CHAR); 105 | VAR res, i: INTEGER; ch: CHAR; 106 | bak: ARRAY 32 OF CHAR; 107 | BEGIN i := 0; ch := name[0]; 108 | WHILE ch > 0X DO bak[i] := ch; INC(i); ch := name[i] END ; 109 | IF i < 28 THEN 110 | bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X; 111 | Files.Rename(name, bak, res) 112 | END 113 | END Backup; 114 | 115 | PROCEDURE Store*; 116 | VAR S: Texts.Scanner; 117 | Menu: TextFrames.Frame; G: GraphicFrames.Frame; 118 | v: Viewers.Viewer; 119 | BEGIN 120 | IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN 121 | Menu := Oberon.Par.vwr.dsc(TextFrames.Frame); G := Menu.next(GraphicFrames.Frame); 122 | Texts.OpenScanner(S, Menu.text, 0); Texts.Scan(S); 123 | IF S.class = Texts.Name THEN 124 | Texts.WriteString(W, S.s); Texts.WriteString(W, " storing"); 125 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 126 | Backup(S.s); GraphicFrames.Store(G, S.s) 127 | END 128 | ELSE 129 | Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 130 | IF S.class = Texts.Name THEN 131 | v := Oberon.MarkedViewer(); 132 | IF (v.dsc # NIL) & (v.dsc.next IS GraphicFrames.Frame) THEN 133 | G := v.dsc.next(GraphicFrames.Frame); 134 | Texts.WriteString(W, S.s); Texts.WriteString(W, " storing"); 135 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 136 | Backup(S.s); GraphicFrames.Store(G, S.s) 137 | END 138 | END 139 | END 140 | END Store; 141 | 142 | PROCEDURE Macro*; 143 | VAR S: Texts.Scanner; 144 | T: Texts.Text; 145 | time, beg, end: LONGINT; 146 | Lname: ARRAY 32 OF CHAR; 147 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 148 | IF S.class = Texts.Name THEN 149 | Lname := S.s; Texts.Scan(S); 150 | IF S.class = Texts.Name THEN GraphicFrames.Macro(Lname, S.s) END ; 151 | END 152 | END Macro; 153 | 154 | BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "Draw - NW 9.8.2013"); 155 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 156 | END Draw. 157 | -------------------------------------------------------------------------------- /Sources/Draw.Tool: -------------------------------------------------------------------------------- 1 | Draw.Open XX.Graph Draw.Store 2 | Rectangles.Make Curves.MakeCircle 3 | 4 | System.SetFont Oberon10.Scn.Fnt 5 | Draw.SetWidth 2 6 | Draw.ChangeFont Oberon8.Scn.Fnt 7 | Draw.ChangeFont Oberon10b.Scn.Fnt 8 | Draw.ChangeWidth 2 9 | Draw.Macro TTL0 N02 10 | 11 | Blinkers.Make Blinkers.Blink Blinkers.Run Blinkers.Stop -------------------------------------------------------------------------------- /Sources/Edit.Mod: -------------------------------------------------------------------------------- 1 | MODULE Edit; (*JG 2.11.90 / NW 28.11.2015*) 2 | IMPORT Files, Fonts, Texts, Display, Viewers, Oberon, MenuViewers, TextFrames; 3 | 4 | CONST CR = 0DX; maxlen = 32; 5 | StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store"; 6 | 7 | VAR W: Texts.Writer; 8 | time: LONGINT; 9 | M: INTEGER; 10 | pat: ARRAY maxlen OF CHAR; 11 | d: ARRAY 256 OF INTEGER; 12 | 13 | PROCEDURE Max(i, j: LONGINT): LONGINT; 14 | VAR m: LONGINT; 15 | BEGIN IF i >= j THEN m := i ELSE m := j END ; 16 | RETURN m 17 | END Max; 18 | 19 | PROCEDURE Open*; 20 | VAR T: Texts.Text; 21 | S: Texts.Scanner; 22 | V: Viewers.Viewer; 23 | X, Y: INTEGER; 24 | beg, end, time: LONGINT; 25 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 26 | IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN 27 | Oberon.GetSelection(T, beg, end, time); 28 | IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END 29 | END; 30 | IF S.class = Texts.Name THEN 31 | Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 32 | V := MenuViewers.New( 33 | TextFrames.NewMenu(S.s, StandardMenu), 34 | TextFrames.NewText(TextFrames.Text(S.s), 0), 35 | TextFrames.menuH, X, Y) 36 | END 37 | END Open; 38 | 39 | PROCEDURE Store*; 40 | VAR V: Viewers.Viewer; 41 | Text: TextFrames.Frame; 42 | T: Texts.Text; 43 | S: Texts.Scanner; 44 | f: Files.File; R: Files.Rider; 45 | beg, end, time, len: LONGINT; 46 | 47 | PROCEDURE Backup (VAR name: ARRAY OF CHAR); 48 | VAR res, i: INTEGER; bak: ARRAY 32 OF CHAR; 49 | BEGIN i := 0; 50 | WHILE name[i] # 0X DO bak[i] := name[i]; INC(i) END; 51 | bak[i] := "."; bak[i+1] := "B"; bak[i+2] := "a"; bak[i+3] := "k"; bak[i+4] := 0X; 52 | Files.Rename(name, bak, res) 53 | END Backup; 54 | 55 | BEGIN Texts.WriteString(W, "Edit.Store "); 56 | IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN 57 | V := Oberon.Par.vwr; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0) 58 | ELSE V := Oberon.MarkedViewer(); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos) 59 | END; 60 | Texts.Scan(S); 61 | IF (S.class = Texts.Char) & (S.c = "^") THEN 62 | Oberon.GetSelection(T, beg, end, time); 63 | IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END 64 | END; 65 | IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN 66 | Text := V.dsc.next(TextFrames.Frame); 67 | Texts.WriteString(W, S.s); Texts.WriteInt(W, Text.text.len, 8); 68 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 69 | Backup(S.s); Texts.Close(Text.text, S.s) 70 | END 71 | END Store; 72 | 73 | PROCEDURE CopyLooks*; 74 | VAR T: Texts.Text; 75 | F: TextFrames.Frame; 76 | v: Viewers.Viewer; 77 | beg, end, time: LONGINT; 78 | fnt: Fonts.Font; col, voff: INTEGER; 79 | BEGIN Oberon.GetSelection(T, beg, end, time); 80 | IF time >= 0 THEN 81 | v := Oberon.FocusViewer; 82 | IF (v # NIL) & (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN 83 | F := v.dsc.next(TextFrames.Frame); 84 | Texts.Attributes(F.text, F.carloc.pos, fnt, col, voff); 85 | Texts.ChangeLooks(T, beg, end, {0,1,2}, fnt, col, voff) 86 | END 87 | END 88 | END CopyLooks; 89 | 90 | PROCEDURE ChangeFont*; 91 | VAR S: Texts.Scanner; T: Texts.Text; beg, end: LONGINT; 92 | BEGIN 93 | Oberon.GetSelection(T, beg, end, time); 94 | IF time >= 0 THEN 95 | Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 96 | IF S.class = Texts.Name THEN 97 | Texts.ChangeLooks(T, beg, end, {0}, Fonts.This(S.s), 0, 0) 98 | END 99 | END 100 | END ChangeFont; 101 | 102 | PROCEDURE ChangeColor*; 103 | VAR S: Texts.Scanner; 104 | T: Texts.Text; 105 | col: INTEGER; 106 | beg, end, time: LONGINT; 107 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 108 | IF S.class = Texts.Int THEN 109 | col := S.i; Oberon.GetSelection(T, beg, end, time); 110 | IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {1}, NIL, col, 0) END 111 | END 112 | END ChangeColor; 113 | 114 | PROCEDURE ChangeOffset*; 115 | VAR S: Texts.Scanner; 116 | T: Texts.Text; 117 | voff: INTEGER; ch: CHAR; 118 | beg, end, time: LONGINT; 119 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 120 | IF S.class = Texts.Int THEN 121 | voff := S.i; Oberon.GetSelection(T, beg, end, time); 122 | IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {2}, NIL, voff, 0) END 123 | END 124 | END ChangeOffset; 125 | 126 | PROCEDURE Search*; (*uses global variables M, pat, d for Boyer-Moore search*) 127 | VAR Text: TextFrames.Frame; 128 | V: Viewers.Viewer; 129 | R: Texts.Reader; 130 | T: Texts.Text; 131 | pos, beg, end, prevTime, len: LONGINT; n, i, j: INTEGER; 132 | buf: ARRAY 32 OF CHAR; 133 | 134 | PROCEDURE Forward(n: INTEGER; VAR R: Texts.Reader; VAR buf: ARRAY OF CHAR); 135 | VAR m: INTEGER; j: INTEGER; 136 | BEGIN m := M - n; j := 0; 137 | WHILE j # m DO buf[j] := buf[n + j]; INC(j) END; 138 | WHILE j # M DO Texts.Read(R, buf[j]); INC(j) END 139 | END Forward; 140 | 141 | BEGIN V := Oberon.Par.vwr; 142 | IF Oberon.Par.frame # V.dsc THEN V := Oberon.FocusViewer END; 143 | IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN 144 | Text := V.dsc.next(TextFrames.Frame); 145 | prevTime := time; Oberon.GetSelection(T, beg, end, time); 146 | IF time > prevTime THEN 147 | Texts.OpenReader(R, T, beg); 148 | i := 0; pos := beg; 149 | REPEAT Texts.Read(R, pat[i]); INC(i); INC(pos) 150 | UNTIL (i = maxlen) OR (pos = end); 151 | M := i; j := 0; 152 | WHILE j # 256 DO d[j] := M; INC(j) END; 153 | j := 0; 154 | WHILE j # M - 1 DO d[ORD(pat[j])] := M - 1 - j; INC(j) END 155 | END; 156 | IF Text.hasCar THEN pos := Text.carloc.pos ELSE pos := 0 END; 157 | len := Text.text.len; 158 | Texts.OpenReader(R, Text.text, pos); 159 | Forward(M, R, buf); pos := pos + M; 160 | j := M; 161 | REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]); 162 | WHILE (j >= 0) & (pos < len) DO 163 | n := d[ORD(buf[M-1])]; Forward(n, R, buf); INC(pos, n); j := M; 164 | REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]) 165 | END ; 166 | IF j < 0 THEN 167 | TextFrames.RemoveSelection(Text); TextFrames.RemoveCaret(Text); 168 | Oberon.RemoveMarks(Text.X, Text.Y, Text.W, Text.H); 169 | TextFrames.Show(Text, pos - 300); Oberon.PassFocus(V); 170 | TextFrames.SetCaret(Text, pos) 171 | END 172 | END 173 | END Search; 174 | 175 | PROCEDURE Locate*; 176 | VAR Text: TextFrames.Frame; 177 | T: Texts.Text; S: Texts.Scanner; 178 | V: Viewers.Viewer; 179 | beg, end, time: LONGINT; 180 | BEGIN 181 | V := Oberon.FocusViewer; 182 | IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN 183 | Text := V.dsc.next(TextFrames.Frame); 184 | Oberon.GetSelection(T, beg, end, time); 185 | IF time >= 0 THEN 186 | Texts.OpenScanner(S, T, beg); 187 | REPEAT Texts.Scan(S) UNTIL (S.class >= Texts.Int); (*skip names*) 188 | IF S.class = Texts.Int THEN 189 | TextFrames.RemoveSelection(Text); 190 | TextFrames.RemoveCaret(Text); 191 | Oberon.RemoveMarks(Text.X, Text.Y, Text.W, Text.H); 192 | TextFrames.Show(Text, Max(0, S.i - 200)); 193 | Oberon.PassFocus(V); 194 | TextFrames.SetCaret(Text, S.i) 195 | END 196 | END 197 | END 198 | END Locate; 199 | 200 | PROCEDURE Recall*; 201 | VAR Menu, Main: Display.Frame; 202 | buf: Texts.Buffer; 203 | V: Viewers.Viewer; 204 | pos: LONGINT; 205 | M: TextFrames.Frame; 206 | BEGIN V := Oberon.FocusViewer; 207 | IF (V # NIL) & (V IS MenuViewers.Viewer) THEN 208 | Menu := V.dsc; Main := V.dsc.next; 209 | IF Main IS TextFrames.Frame THEN 210 | M := Main(TextFrames.Frame); 211 | IF M.hasCar THEN 212 | TextFrames.Recall(buf); 213 | pos := M.carloc.pos + buf.len; 214 | Texts.Insert(M.text, M.carloc.pos, buf); 215 | TextFrames.SetCaret(M, pos) 216 | END 217 | ELSIF Menu IS TextFrames.Frame THEN 218 | M := Menu(TextFrames.Frame); 219 | IF M.hasCar THEN 220 | TextFrames.Recall(buf); 221 | pos := M.carloc.pos + buf.len; 222 | Texts.Insert(M.text, M.carloc.pos, buf); 223 | TextFrames.SetCaret(M, pos) 224 | END 225 | END 226 | END 227 | END Recall; 228 | 229 | BEGIN Texts.OpenWriter(W) 230 | END Edit. 231 | 232 | 233 | -------------------------------------------------------------------------------- /Sources/Fonts.Mod: -------------------------------------------------------------------------------- 1 | MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*) 2 | IMPORT SYSTEM, Files; 3 | 4 | CONST FontFileId = 0DBH; 5 | 6 | TYPE Font* = POINTER TO FontDesc; 7 | FontDesc* = RECORD 8 | name*: ARRAY 32 OF CHAR; 9 | height*, minX*, maxX*, minY*, maxY*: INTEGER; 10 | next*: Font; 11 | T: ARRAY 128 OF INTEGER; 12 | raster: ARRAY 2360 OF BYTE 13 | END ; 14 | 15 | LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ; 16 | LargeFont = POINTER TO LargeFontDesc; 17 | 18 | (* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983, 19 | Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302 *) 20 | 21 | VAR Default*, root*: Font; 22 | 23 | PROCEDURE GetPat*(fnt: Font; ch: CHAR; VAR dx, x, y, w, h, patadr: INTEGER); 24 | VAR pa: INTEGER; dxb, xb, yb, wb, hb: BYTE; 25 | BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa; 26 | SYSTEM.GET(pa-3, dxb); SYSTEM.GET(pa-2, xb); SYSTEM.GET(pa-1, yb); SYSTEM.GET(pa, wb); SYSTEM.GET(pa+1, hb); 27 | dx := dxb; x := xb; y := yb; w := wb; h := hb; 28 | IF yb < 128 THEN y := yb ELSE y := yb - 256 END 29 | END GetPat; 30 | 31 | PROCEDURE This*(name: ARRAY OF CHAR): Font; 32 | 33 | TYPE RunRec = RECORD beg, end: BYTE END ; 34 | BoxRec = RECORD dx, x, y, w, h: BYTE END ; 35 | 36 | VAR F: Font; LF: LargeFont; 37 | f: Files.File; R: Files.Rider; 38 | NofRuns, NofBoxes: BYTE; 39 | NofBytes: INTEGER; 40 | height, minX, maxX, minY, maxY: BYTE; 41 | i, j, k, m, n: INTEGER; 42 | a, a0: INTEGER; 43 | b, beg, end: BYTE; 44 | run: ARRAY 16 OF RunRec; 45 | box: ARRAY 512 OF BoxRec; 46 | 47 | PROCEDURE RdInt16(VAR R: Files.Rider; VAR b0: BYTE); 48 | VAR b1: BYTE; 49 | BEGIN Files.ReadByte(R, b0); Files.ReadByte(R, b1) 50 | END RdInt16; 51 | 52 | BEGIN F := root; 53 | WHILE (F # NIL) & (name # F.name) DO F := F.next END; 54 | IF F = NIL THEN 55 | f := Files.Old(name); 56 | IF f # NIL THEN 57 | Files.Set(R, f, 0); Files.ReadByte(R, b); 58 | IF b = FontFileId THEN 59 | Files.ReadByte(R, b); (*abstraction*) 60 | Files.ReadByte(R, b); (*family*) 61 | Files.ReadByte(R, b); (*variant*) 62 | NEW(F); F.name := name; 63 | RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns); 64 | NofBoxes := 0; k := 0; 65 | WHILE k # NofRuns DO 66 | RdInt16(R, beg); 67 | run[k].beg := beg; RdInt16(R, end); 68 | run[k].end := end; NofBoxes := NofBoxes + end - beg; INC(k) 69 | END; 70 | NofBytes := 5; j := 0; 71 | WHILE j # NofBoxes DO 72 | RdInt16(R, box[j].dx); RdInt16(R, box[j].x); RdInt16(R, box[j].y); 73 | RdInt16(R, box[j].w); RdInt16(R, box[j].h); 74 | NofBytes := NofBytes + 5 + (box[j].w + 7) DIV 8 * box[j].h; 75 | INC(j) 76 | END; 77 | IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ; 78 | F.name := name; 79 | F.height := height; F.minX := minX; F.maxX := maxX; F.maxY := maxY; 80 | IF minY >= 80H THEN F.minY := minY - 100H ELSE F.minY := minY END ; 81 | a0 := SYSTEM.ADR(F.raster); 82 | SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X); 83 | (*null pattern for characters not in a run*) 84 | INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0; 85 | WHILE k < NofRuns DO 86 | WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END; 87 | WHILE (m < run[k].end) & (m < 128) DO 88 | F.T[m] := a+3; 89 | SYSTEM.PUT(a, box[j].dx); SYSTEM.PUT(a+1, box[j].x); SYSTEM.PUT(a+2, box[j].y); 90 | SYSTEM.PUT(a+3, box[j].w); SYSTEM.PUT(a+4, box[j].h); INC(a, 5); 91 | n := (box[j].w + 7) DIV 8 * box[j].h; 92 | WHILE n # 0 DO DEC(n); Files.ReadByte(R, b); SYSTEM.PUT(a, b); INC(a) END ; 93 | INC(j); INC(m) 94 | END; 95 | INC(k) 96 | END; 97 | WHILE m < 128 DO F.T[m] := a0; INC(m) END ; 98 | F.next := root; root := F 99 | ELSE (*bad file id*) F := Default 100 | END 101 | ELSE (*font file not available*) F := Default 102 | END 103 | END; 104 | RETURN F 105 | END This; 106 | 107 | PROCEDURE Free*; (*remove all but first two from font list*) 108 | VAR f: Font; 109 | BEGIN f := root.next; 110 | IF f # NIL THEN f := f.next END ; 111 | f.next := NIL 112 | END Free; 113 | 114 | BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt") 115 | END Fonts. 116 | -------------------------------------------------------------------------------- /Sources/Hilbert.Mod: -------------------------------------------------------------------------------- 1 | MODULE Hilbert; (*NW 8.1.2013 for RISC*) 2 | IMPORT Display, Viewers, Texts, Oberon, MenuViewers, TextFrames; 3 | 4 | CONST Menu = "System.Close System.Copy System.Grow"; 5 | 6 | VAR x, y, d: INTEGER; 7 | A, B, C, D: PROCEDURE (i: INTEGER); 8 | 9 | PROCEDURE E; 10 | BEGIN Display.ReplConst(Display.white, x, y, d, 1, Display.paint); INC(x, d) 11 | END E; 12 | 13 | PROCEDURE N; 14 | BEGIN Display.ReplConst(Display.white, x, y, 1, d, Display.paint); INC(y, d) 15 | END N; 16 | 17 | PROCEDURE W; 18 | BEGIN DEC(x, d); Display.ReplConst(Display.white, x, y, d, 1, Display.paint) 19 | END W; 20 | 21 | PROCEDURE S; 22 | BEGIN DEC(y, d); Display.ReplConst(Display.white, x, y, 1, d, Display.paint) 23 | END S; 24 | 25 | PROCEDURE HA(i: INTEGER); 26 | BEGIN 27 | IF i > 0 THEN D(i-1); W; A(i-1); S; A(i-1); E; B(i-1) END 28 | END HA; 29 | 30 | PROCEDURE HB(i: INTEGER); 31 | BEGIN 32 | IF i > 0 THEN C(i-1); N; B(i-1); E; B(i-1); S; A(i-1) END 33 | END HB; 34 | 35 | PROCEDURE HC(i: INTEGER); 36 | BEGIN 37 | IF i > 0 THEN B(i-1); E; C(i-1); N; C(i-1); W; D(i-1) END 38 | END HC; 39 | 40 | PROCEDURE HD(i: INTEGER); 41 | BEGIN 42 | IF i > 0 THEN A(i-1); S; D(i-1); W; D(i-1); N; C(i-1) END 43 | END HD; 44 | 45 | PROCEDURE DrawHilbert(F: Display.Frame); 46 | VAR k, n, w, x0, y0: INTEGER; 47 | BEGIN k := 0; d := 8; 48 | IF F.W < F.H THEN w := F.W ELSE w := F.H END ; 49 | WHILE d*2 < w DO d := d*2; INC(k) END ; 50 | Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); 51 | x0 := F.W DIV 2; y0 := F.H DIV 2; n := 0; 52 | WHILE n < k DO 53 | d := d DIV 2; INC(x0, d DIV 2); INC(y0, d DIV 2); 54 | x := F.X + x0; y := F.Y + y0; INC(n); HA(n) 55 | END 56 | END DrawHilbert; 57 | 58 | PROCEDURE Handler(F: Display.Frame; VAR M: Display.FrameMsg); 59 | VAR F0: Display.Frame; 60 | BEGIN 61 | IF M IS Oberon.InputMsg THEN 62 | IF M(Oberon.InputMsg).id = Oberon.track THEN 63 | Oberon.DrawMouseArrow(M(Oberon.InputMsg).X, M(Oberon.InputMsg).Y) 64 | END 65 | ELSIF M IS MenuViewers.ModifyMsg THEN 66 | F.Y := M(MenuViewers.ModifyMsg).Y; F.H := M(MenuViewers.ModifyMsg).H; DrawHilbert(F) 67 | ELSIF M IS Oberon.ControlMsg THEN 68 | IF M(Oberon.ControlMsg).id = Oberon.neutralize THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H) END 69 | ELSIF M IS Oberon.CopyMsg THEN 70 | NEW(F0); F0^ := F^; M(Oberon.CopyMsg).F := F0 71 | END 72 | END Handler; 73 | 74 | PROCEDURE New(): Display.Frame; 75 | VAR F: Display.Frame; 76 | BEGIN NEW(F); F.handle := Handler; RETURN F 77 | END New; 78 | 79 | PROCEDURE Draw*; 80 | VAR V: Viewers.Viewer; X, Y: INTEGER; 81 | BEGIN Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 82 | V := MenuViewers.New(TextFrames.NewMenu("Hilbert", Menu), New(), TextFrames.menuH, X, Y) 83 | END Draw; 84 | 85 | BEGIN A := HA; B := HB; C := HC; D := HD 86 | END Hilbert. 87 | -------------------------------------------------------------------------------- /Sources/Input.Mod: -------------------------------------------------------------------------------- 1 | MODULE Input; (*NW 5.10.86 / 15.11.90 Ceres-2; PDR 21.4.12 / NW 15.5.2013 Ceres-4*) 2 | IMPORT SYSTEM; 3 | 4 | CONST msAdr = -40; kbdAdr = -36; 5 | VAR kbdCode: BYTE; (*last keyboard code read*) 6 | Recd, Up, Shift, Ctrl, Ext: BOOLEAN; 7 | KTabAdr: INTEGER; (*keyboard code translation table*) 8 | MW, MH, MX, MY: INTEGER; (*mouse limits and coords*) 9 | MK: SET; (*mouse keys*) 10 | 11 | (*FIFO implemented in hardware, because every read must be handled, 12 | including tracking the state of the Shift and Ctrl keys*) 13 | 14 | PROCEDURE Peek(); 15 | BEGIN 16 | IF SYSTEM.BIT(msAdr, 28) THEN 17 | SYSTEM.GET(kbdAdr, kbdCode); 18 | IF kbdCode = 0F0H THEN Up := TRUE 19 | ELSIF kbdCode = 0E0H THEN Ext := TRUE 20 | ELSE 21 | IF (kbdCode = 12H) OR (kbdCode = 59H) THEN (*shift*) Shift := ~Up 22 | ELSIF kbdCode = 14H THEN (*ctrl*) Ctrl := ~Up 23 | ELSIF ~Up THEN Recd := TRUE (*real key going down*) 24 | END ; 25 | Up := FALSE; Ext := FALSE 26 | END 27 | END; 28 | END Peek; 29 | 30 | PROCEDURE Available*(): INTEGER; 31 | BEGIN Peek(); 32 | RETURN ORD(Recd) 33 | END Available; 34 | 35 | PROCEDURE Read*(VAR ch: CHAR); 36 | BEGIN 37 | WHILE ~Recd DO Peek() END ; 38 | IF Shift OR Ctrl THEN INC(kbdCode, 80H) END; (*ctrl implies shift*) 39 | (* ch := kbdTab[kbdCode]; *) 40 | SYSTEM.GET(KTabAdr + kbdCode, ch); 41 | IF Ctrl THEN ch := CHR(ORD(ch) MOD 20H) END; 42 | Recd := FALSE 43 | END Read; 44 | 45 | PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER); 46 | VAR w: INTEGER; 47 | BEGIN SYSTEM.GET(msAdr, w); 48 | keys := SYSTEM.VAL(SET, w DIV 1000000H MOD 8); 49 | x := w MOD 400H; y := (w DIV 1000H) MOD 400H; 50 | IF y >= MH THEN y := MH-1 END 51 | END Mouse; 52 | 53 | PROCEDURE SetMouseLimits*(w, h: INTEGER); 54 | BEGIN MW := w; MH := h 55 | END SetMouseLimits; 56 | 57 | PROCEDURE Init*; 58 | BEGIN Up := FALSE; Shift := FALSE; Ctrl := FALSE; Recd := FALSE; 59 | KTabAdr := SYSTEM.ADR($ 60 | 00 00 00 00 00 1A 00 00 00 00 00 00 00 09 60 00 61 | 00 00 00 00 00 71 31 00 00 00 7A 73 61 77 32 00 62 | 00 63 78 64 65 34 33 00 00 20 76 66 74 72 35 00 63 | 00 6E 62 68 67 79 36 00 00 00 6D 6A 75 37 38 00 64 | 00 2C 6B 69 6F 30 39 00 00 2E 2F 6C 3B 70 2D 00 65 | 00 00 27 00 5B 3D 00 00 00 00 0D 5D 00 5C 00 00 66 | 00 00 00 00 00 00 08 00 00 00 00 00 00 00 00 00 67 | 00 7F 00 00 00 00 1B 00 00 00 00 00 00 00 00 00 68 | 00 00 00 00 00 00 00 00 00 00 00 00 00 09 7E 00 69 | 00 00 00 00 00 51 21 00 00 00 5A 53 41 57 40 00 70 | 00 43 58 44 45 24 23 00 00 20 56 46 54 52 25 00 71 | 00 4E 42 48 47 59 5E 00 00 00 4D 4A 55 26 2A 00 72 | 00 3C 4B 49 4F 29 28 00 00 3E 3F 4C 3A 50 5F 00 73 | 00 00 22 00 7B 2B 00 00 00 00 0D 7D 00 7C 00 00 74 | 00 00 00 00 00 00 08 00 00 00 00 00 00 00 00 00 75 | 00 7F 00 00 00 00 1B 00 00 00 00 00 00 00 00 00$) 76 | END Init; 77 | 78 | BEGIN Init 79 | END Input. 80 | -------------------------------------------------------------------------------- /Sources/MacroTool.Mod: -------------------------------------------------------------------------------- 1 | MODULE MacroTool; (*NW 6.8.2013*) 2 | IMPORT Texts, Oberon, Graphics, GraphicFrames; 3 | VAR W: Texts.Writer; 4 | 5 | PROCEDURE OpenMacro*; 6 | VAR F: GraphicFrames.Frame; sel: Graphics.Object; 7 | BEGIN (*expand selected macro to caret position*) 8 | F := GraphicFrames.Selected(); 9 | IF F # NIL THEN 10 | sel := F.graph.sel; 11 | IF (sel # NIL) & (sel IS Graphics.Macro) THEN 12 | GraphicFrames.Deselect(F); 13 | Graphics.OpenMac(sel(Graphics.Macro).mac, F.graph, F.mark.x - F.x, F.mark.y - F.y); 14 | GraphicFrames.Draw(F) 15 | END 16 | END 17 | END OpenMacro; 18 | 19 | PROCEDURE MakeMacro*; (*lib mac*) 20 | (*compose macro from selected elements into caret area*) 21 | VAR newMac: BOOLEAN; 22 | machead: Graphics.MacHead; 23 | F: GraphicFrames.Frame; 24 | L: Graphics.Library; 25 | S: Texts.Scanner; 26 | Lname, Mname: ARRAY 32 OF CHAR; 27 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 28 | IF S.class = Texts.Name THEN 29 | Lname := S.s; Texts.Scan(S); 30 | IF (S.class = Texts.Name) OR (S.class = Texts.String) & (S.len <= 8) THEN 31 | F := GraphicFrames.Focus(); Mname := S.s; 32 | IF (F # NIL) & (F.graph.sel # NIL) THEN 33 | Graphics.GetLib(Lname, FALSE, L); 34 | IF L = NIL THEN 35 | Texts.WriteString(W, "new library "); Texts.WriteString(W, Lname); Texts.WriteLn(W); 36 | L := Graphics.NewLib(Lname) 37 | END ; 38 | Graphics.MakeMac(F.graph, machead); 39 | IF machead # NIL THEN 40 | machead.name := Mname; Graphics.InsertMac(machead, L, newMac); Texts.WriteString(W, Mname); 41 | IF newMac THEN Texts.WriteString(W, " inserted in ") ELSE Texts.WriteString(W, " replaced in ") END ; 42 | Texts.WriteString(W, Lname) 43 | ELSE Texts.WriteString(W, " empty macro") 44 | END ; 45 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 46 | END 47 | END 48 | END 49 | END MakeMacro; 50 | 51 | PROCEDURE LoadLibrary*; (*lib file name*) 52 | VAR S: Texts.Scanner; L: Graphics.Library; 53 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 54 | IF S.class = Texts.Name THEN 55 | Texts.WriteString(W, S.s); Graphics.GetLib(S.s, FALSE, L); 56 | IF L # NIL THEN Texts.WriteString(W, " loaded") ELSE Texts.WriteString(W, " not found") END ; 57 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 58 | END 59 | END LoadLibrary; 60 | 61 | PROCEDURE StoreLibrary*; (*lib file name*) 62 | VAR i: INTEGER; S: Texts.Scanner; L: Graphics.Library; 63 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 64 | IF S.class = Texts.Name THEN 65 | Graphics.StoreLib(L, S.s); Texts.WriteString(W, S.s); 66 | IF L # NIL THEN Texts.WriteString(W, " stored") ELSE Texts.WriteString(W, " not found") END ; 67 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 68 | END 69 | END StoreLibrary; 70 | 71 | BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "MacroTool - NW 6.8.2013"); 72 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 73 | END MacroTool. 74 | -------------------------------------------------------------------------------- /Sources/Math.Mod: -------------------------------------------------------------------------------- 1 | MODULE Math; (*Standard functions; NW 12.10.2013*) 2 | 3 | PROCEDURE sqrt*(x: REAL): REAL; 4 | CONST c1 = 0.70710680; (* 1/sqrt(2) *) 5 | c2 = 0.590162067; 6 | c3 = 1.4142135; (*sqrt(2)*) 7 | VAR s: REAL; e: INTEGER; 8 | BEGIN ASSERT(x >= 0.0); 9 | IF x > 0.0 THEN 10 | UNPK(x, e); 11 | s := c2*(x+c1); 12 | s := s + (x/s); 13 | s := 0.25*s + x/s; 14 | s := 0.5 * (s + x/s); 15 | IF ODD(e) THEN s := c3*s END ; 16 | PACK(s, e DIV 2) 17 | ELSE s := 0.0 18 | END ; 19 | RETURN s 20 | END sqrt; 21 | 22 | PROCEDURE exp*(x: REAL): REAL; 23 | CONST 24 | c1 = 1.4426951; (*1/ln(2) *) 25 | p0 = 1.513864173E3; 26 | p1= 2.020170000E1; 27 | p2 = 2.309432127E-2; 28 | q0 = 4.368088670E3; 29 | q1 = 2.331782320E2; 30 | VAR n: INTEGER; p, y, yy: REAL; 31 | BEGIN y := c1*x; 32 | n := FLOOR(y + 0.5); y := y - FLT(n); 33 | yy := y*y; 34 | p := ((p2*yy + p1)*yy + p0)*y; 35 | p := p/((yy + q1)*yy + q0 - p) + 0.5; 36 | PACK(p, n+1); RETURN p 37 | END exp; 38 | 39 | PROCEDURE ln*(x: REAL): REAL; 40 | CONST c1 = 0.70710680; (* 1/sqrt(2) *) 41 | c2 = 0.69314720; (* ln(2) *) 42 | p0 = -9.01746917E1; 43 | p1 = 9.34639006E1; 44 | p2 = -1.83278704E1; 45 | q0 = -4.50873458E1; 46 | q1 = 6.76106560E1; 47 | q2 = -2.07334879E1; 48 | VAR e: INTEGER; xx, y: REAL; 49 | BEGIN ASSERT(x > 0.0); UNPK(x, e); 50 | IF x < c1 THEN x := x*2.0; e := e-1 END ; 51 | x := (x-1.0)/(x+1.0); 52 | xx := x; 53 | y := c2*FLT(e) + x*((p2*xx + p1)*xx + p0) / (((xx + q2)*xx + q1)*xx + q0); 54 | RETURN y 55 | END ln; 56 | 57 | PROCEDURE sin*(x: REAL): REAL; 58 | CONST 59 | c1 = 6.3661977E-1; (*2/pi*) 60 | p0 = 7.8539816E-1; 61 | p1 = -8.0745512E-2; 62 | p2 = 2.4903946E-3; 63 | p3 = -3.6576204E-5; 64 | p4 = 3.1336162E-7; 65 | p5 = -1.7571493E-9; 66 | p6 = 6.8771004E-12; 67 | q0 = 9.9999999E-1; 68 | q1 = -3.0842514E-1; 69 | q2 = 1.5854344E-2; 70 | q3 = -3.2599189E-4; 71 | q4 = 3.5908591E-6; 72 | q5 = -2.4609457E-8; 73 | q6 = 1.1363813E-10; 74 | VAR n: INTEGER; y, yy, f: REAL; 75 | BEGIN y := c1*x; 76 | IF y >= 0.0 THEN n := FLOOR(y + 0.5) ELSE n := FLOOR(y - 0.5) END ; 77 | y := (y - FLT(n)) * 2.0; yy := y*y; 78 | IF ODD(n) THEN f := (((((q6*yy + q5)*yy + q4)*yy + q3)*yy + q2)*yy + q1)*yy + q0 79 | ELSE f := ((((((p6*yy + p5)*yy + p4)*yy + p3)*yy + p2)*yy + p1)*yy + p0)*y 80 | END ; 81 | IF ODD(n DIV 2) THEN f := -f END ; 82 | RETURN f 83 | END sin; 84 | 85 | PROCEDURE cos*(x: REAL): REAL; 86 | CONST 87 | c1 = 6.3661977E-1; (*2/pi*) 88 | p0 = 7.8539816E-1; 89 | p1 = -8.0745512E-2; 90 | p2 = 2.4903946E-3; 91 | p3 = -3.6576204E-5; 92 | p4 = 3.1336162E-7; 93 | p5 = -1.7571493E-9; 94 | p6 = 6.8771004E-12; 95 | q0 = 9.9999999E-1; 96 | q1 = -3.0842514E-1; 97 | q2 = 1.5854344E-2; 98 | q3 = -3.2599189E-4; 99 | q4 = 3.5908591E-6; 100 | q5 = -2.4609457E-8; 101 | q6 = 1.1363813E-10; 102 | VAR n: INTEGER; y, yy, f: REAL; 103 | BEGIN y := c1*x; 104 | IF y >= 0.0 THEN n := FLOOR(y + 0.5) ELSE n := FLOOR(y - 0.5) END ; 105 | y := (y - FLT(n)) * 2.0; yy := y*y; 106 | IF ~ODD(n) THEN f := (((((q6*yy + q5)*yy + q4)*yy + q3)*yy + q2)*yy + q1)*yy + q0 107 | ELSE f := ((((((p6*yy + p5)*yy + p4)*yy + p3)*yy + p2)*yy + p1)*yy + p0)*y 108 | END ; 109 | IF ODD((n+1) DIV 2) THEN f := -f END ; 110 | RETURN f 111 | END cos; 112 | END Math. 113 | -------------------------------------------------------------------------------- /Sources/MenuViewers.Mod: -------------------------------------------------------------------------------- 1 | MODULE MenuViewers; (*JG 26.8.90 / 16.9.93 / NW 10.3.2013*) 2 | IMPORT Input, Display, Viewers, Oberon; 3 | 4 | CONST extend* = 0; reduce* = 1; FrameColor = Display.white; 5 | 6 | TYPE Viewer* = POINTER TO ViewerDesc; 7 | 8 | ViewerDesc* = RECORD (Viewers.ViewerDesc) 9 | menuH*: INTEGER 10 | END; 11 | 12 | ModifyMsg* = RECORD (Display.FrameMsg) 13 | id*: INTEGER; 14 | dY*, Y*, H*: INTEGER 15 | END; 16 | 17 | PROCEDURE Copy (V: Viewer; VAR V1: Viewer); 18 | VAR Menu, Main: Display.Frame; M: Oberon.CopyMsg; 19 | BEGIN Menu := V.dsc; Main := V.dsc.next; 20 | NEW(V1); V1^ := V^; V1.state := 0; 21 | M.F := NIL; Menu.handle(Menu, M); V1.dsc := M.F; 22 | M.F := NIL; Main.handle(Main, M); V1.dsc.next := M.F 23 | END Copy; 24 | 25 | PROCEDURE Draw (V: Viewers.Viewer); 26 | BEGIN 27 | Display.ReplConst(FrameColor, V.X, V.Y, 1, V.H, Display.replace); 28 | Display.ReplConst(FrameColor, V.X + V.W - 1, V.Y, 1, V.H, Display.replace); 29 | Display.ReplConst(FrameColor, V.X + 1, V.Y, V.W - 2, 1, Display.replace); 30 | Display.ReplConst(FrameColor, V.X + 1, V.Y + V.H - 1, V.W - 2, 1, Display.replace) 31 | END Draw; 32 | 33 | PROCEDURE Extend (V: Viewer; newY: INTEGER); 34 | VAR dH: INTEGER; 35 | BEGIN dH := V.Y - newY; 36 | IF dH > 0 THEN 37 | Display.ReplConst(Display.black, V.X + 1, newY + 1, V.W - 2, dH, Display.replace); 38 | Display.ReplConst(FrameColor, V.X, newY, 1, dH, Display.replace); 39 | Display.ReplConst(FrameColor, V.X + V.W - 1, newY, 1, dH, Display.replace); 40 | Display.ReplConst(FrameColor, V.X + 1, newY, V.W - 2, 1, Display.replace) 41 | END 42 | END Extend; 43 | 44 | PROCEDURE Reduce (V: Viewer; newY: INTEGER); 45 | BEGIN Display.ReplConst(FrameColor, V.X + 1, newY, V.W - 2, 1, Display.replace) 46 | END Reduce; 47 | 48 | PROCEDURE Grow (V: Viewer; oldH: INTEGER); 49 | VAR dH: INTEGER; 50 | BEGIN dH := V.H - oldH; 51 | IF dH > 0 THEN 52 | Display.ReplConst(FrameColor, V.X, V.Y + oldH, 1, dH, Display.replace); 53 | Display.ReplConst(FrameColor, V.X + V.W - 1, V.Y + oldH, 1, dH, Display.replace); 54 | Display.ReplConst(FrameColor, V.X + 1, V.Y + V.H - 1, V.W - 2, 1, Display.replace) 55 | END 56 | END Grow; 57 | 58 | PROCEDURE Shrink (V: Viewer; newH: INTEGER); 59 | BEGIN Display.ReplConst(FrameColor, V.X + 1, V.Y + newH - 1, V.W - 2, 1, Display.replace) 60 | END Shrink; 61 | 62 | PROCEDURE Adjust (F: Display.Frame; id, dY, Y, H: INTEGER); 63 | VAR M: ModifyMsg; 64 | BEGIN M.id := id; M.dY := dY; M.Y := Y; M.H := H; F.handle(F, M); F.Y := Y; F.H := H 65 | END Adjust; 66 | 67 | PROCEDURE Restore (V: Viewer); 68 | VAR Menu, Main: Display.Frame; 69 | BEGIN Menu := V.dsc; Main := V.dsc.next; 70 | Oberon.RemoveMarks(V.X, V.Y, V.W, V.H); 71 | Draw(V); 72 | Menu.X := V.X + 1; Menu.Y := V.Y + V.H - 1; Menu.W := V.W - 2; Menu.H := 0; 73 | Main.X := V.X + 1; Main.Y := V.Y + V.H - V.menuH; Main.W := V.W - 2; Main.H := 0; 74 | IF V.H > V.menuH + 1 THEN 75 | Adjust(Menu, extend, 0, V.Y + V.H - V.menuH, V.menuH - 1); 76 | Adjust(Main, extend, 0, V.Y + 1, V.H - V.menuH - 1) 77 | ELSE Adjust(Menu, extend, 0, V.Y + 1, V.H - 2) 78 | END 79 | END Restore; 80 | 81 | PROCEDURE Modify (V: Viewer; Y, H: INTEGER); 82 | VAR Menu, Main: Display.Frame; 83 | BEGIN Menu := V.dsc; Main := V.dsc.next; 84 | IF Y < V.Y THEN (*extend*) 85 | Oberon.RemoveMarks(V.X, Y, V.W, V.Y - Y); 86 | Extend(V, Y); 87 | IF H > V.menuH + 1 THEN 88 | Adjust(Menu, extend, 0, Y + H - V.menuH, V.menuH - 1); 89 | Adjust(Main, extend, 0, Y + 1, H - V.menuH - 1) 90 | ELSE Adjust(Menu, extend, 0, Y + 1, H - 2) 91 | END 92 | ELSIF Y > V.Y THEN (*reduce*) 93 | Oberon.RemoveMarks(V.X, V.Y, V.W, V.H); 94 | IF H > V.menuH + 1 THEN 95 | Adjust(Main, reduce, 0, Y + 1, H - V.menuH - 1); 96 | Adjust(Menu, reduce, 0, Y + H - V.menuH, V.menuH - 1) 97 | ELSE 98 | Adjust(Main, reduce, 0, Y + H - V.menuH, 0); 99 | Adjust(Menu, reduce, 0, Y + 1, H - 2) 100 | END; 101 | Reduce(V, Y) 102 | END 103 | END Modify; 104 | 105 | PROCEDURE Change (V: Viewer; X, Y: INTEGER; Keys: SET); 106 | VAR Menu, Main: Display.Frame; 107 | V1: Viewers.Viewer; 108 | keysum: SET; Y0, dY, H: INTEGER; 109 | BEGIN (*Keys # {}*) 110 | Menu := V.dsc; Main := V.dsc.next; 111 | Oberon.DrawMouseArrow(X, Y); 112 | Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1 - V.dsc.H, V.W - 2, V.dsc.H, Display.invert); 113 | Y0 := Y; keysum := Keys; Input.Mouse(Keys, X, Y); 114 | WHILE Keys # {} DO 115 | keysum := keysum + Keys; 116 | Oberon.DrawMouseArrow(X, Y); Input.Mouse(Keys, X, Y) 117 | END; 118 | Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1 - V.dsc.H, V.W - 2, V.dsc.H, Display.invert); 119 | IF ~(0 IN keysum) THEN 120 | IF 1 IN keysum THEN V1 := Viewers.This(X, Y); 121 | IF (V1 IS Viewer) & (Y > V1.Y + V1.H - V1(Viewer).menuH - 2) THEN Y := V1.Y + V1.H END; 122 | IF Y < V1.Y + V.menuH + 2 THEN Y := V1.Y + V.menuH + 2 END; 123 | Viewers.Close(V); Viewers.Open(V, X, Y); Restore(V) 124 | ELSE 125 | IF Y > Y0 THEN (*extend*) dY := Y - Y0; 126 | V1 := Viewers.Next(V); 127 | IF V1.state > 1 THEN 128 | CASE V1 OF 129 | Viewer: 130 | IF V1.H < V1.menuH + 2 THEN dY := 0 131 | ELSIF V1.H < V1.menuH + 2 + dY THEN dY := V1.H - V1.menuH - 2 132 | END | 133 | Viewers.Viewer: IF V1.H < 1 + dY THEN dY := V1.H - 1 END 134 | END 135 | ELSIF V1.H < dY THEN dY := V1.H 136 | END; 137 | Viewers.Change(V, V.Y + V.H + dY); 138 | Oberon.RemoveMarks(V.X, V.Y, V.W, V.H); 139 | Grow(V, V.H - dY); 140 | IF V.H > V.menuH + 1 THEN 141 | Adjust(Menu, extend, dY, V.Y + V.H - V.menuH, V.menuH - 1); 142 | Adjust(Main, extend, dY, V.Y + 1, V.H - V.menuH - 1) 143 | ELSE (*V.H > 1*) 144 | Adjust(Menu, extend, dY, V.Y + 1, V.H - 2); 145 | Adjust(Main, extend, dY, V.Y + V.H - V.menuH, 0) 146 | END 147 | ELSIF Y < Y0 THEN (*reduce*) dY := Y0 - Y; 148 | IF V.H >= V.menuH + 2 THEN 149 | IF V.H < V.menuH + 2 + dY THEN dY := V.H - V.menuH - 2 END; 150 | Oberon.RemoveMarks(V.X, V.Y, V.W, V.H); 151 | H := V.H - dY; 152 | Adjust(Main, reduce, dY, V.Y + 1, H - V.menuH - 1); 153 | Adjust(Menu, reduce, dY, V.Y + H - V.menuH, V.menuH - 1); 154 | Shrink(V, H); Viewers.Change(V, V.Y + H) 155 | END 156 | END 157 | END 158 | END 159 | END Change; 160 | 161 | PROCEDURE Suspend (V: Viewer); 162 | VAR Menu, Main: Display.Frame; 163 | BEGIN Menu := V.dsc; Main := V.dsc.next; 164 | Adjust(Main, reduce, 0, V.Y + V.H - V.menuH, 0); 165 | Adjust(Menu, reduce, 0, V.Y + V.H - 1, 0) 166 | END Suspend; 167 | 168 | PROCEDURE Handle* (V: Display.Frame; VAR M: Display.FrameMsg); 169 | VAR X, Y: INTEGER; 170 | Menu, Main: Display.Frame; V1: Viewer; 171 | BEGIN Menu := V.dsc; Main := V.dsc.next; 172 | CASE M OF 173 | Oberon.InputMsg: 174 | IF M.id = Oberon.track THEN 175 | X := M.X; Y := M.Y; 176 | IF Y < V.Y + 1 THEN Oberon.DrawMouseArrow(X, Y) 177 | ELSIF Y < V.Y + V.H - V(Viewer).menuH THEN Main.handle(Main, M) 178 | ELSIF Y < V.Y + V.H - V(Viewer).menuH + 2 THEN Menu.handle(Menu, M) 179 | ELSIF Y < V.Y + V.H - 1 THEN 180 | IF 2 IN M.keys THEN Change(V(Viewer), X, Y, M.keys) ELSE Menu.handle(Menu, M) END 181 | ELSE Oberon.DrawMouseArrow(X, Y) 182 | END 183 | ELSE Menu.handle(Menu, M); Main.handle(Main, M) 184 | END | 185 | Oberon.ControlMsg: 186 | IF M.id = Oberon.mark THEN 187 | X := M.X; Y := M.Y; Oberon.DrawMouseArrow(X, Y); Oberon.DrawPointer(X, Y) 188 | ELSE Menu.handle(Menu, M); Main.handle(Main, M) 189 | END | 190 | Oberon.CopyMsg: 191 | Copy(V(Viewer), V1); M.F := V1 | 192 | Viewers.ViewerMsg: 193 | IF M.id = Viewers.restore THEN Restore(V(Viewer)) 194 | ELSIF M.id = Viewers.modify THEN Modify(V(Viewer), M.Y, M.H) 195 | ELSIF M.id = Viewers.suspend THEN Suspend(V(Viewer)) 196 | END | 197 | Display.FrameMsg: Menu.handle(Menu, M); Main.handle(Main, M) 198 | END 199 | END Handle; 200 | 201 | PROCEDURE New* (Menu, Main: Display.Frame; menuH, X, Y: INTEGER): Viewer; 202 | VAR V: Viewer; 203 | BEGIN NEW(V); 204 | V.handle := Handle; V.dsc := Menu; V.dsc.next := Main; V.menuH := menuH; 205 | Viewers.Open(V, X, Y); Restore(V); RETURN V 206 | END New; 207 | 208 | END MenuViewers. 209 | -------------------------------------------------------------------------------- /Sources/ORC.Mod: -------------------------------------------------------------------------------- 1 | MODULE ORC; (*Connection to RISC; NW 11.11.2013*) 2 | IMPORT SYSTEM, Files, Texts, Oberon, V24; 3 | CONST portno = 1; (*RS-232*) 4 | BlkLen = 255; pno = 1; 5 | REQ = 20X; REC = 21X; SND = 22X; CLS = 23X; ACK = 10X; 6 | Tout = 1000; 7 | 8 | VAR res: LONGINT; 9 | W: Texts.Writer; 10 | 11 | PROCEDURE Flush*; 12 | VAR ch: CHAR; 13 | BEGIN 14 | WHILE V24.Available(portno) > 0 DO V24.Receive(portno, ch, res); Texts.Write(W, ch) END ; 15 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 16 | END Flush; 17 | 18 | PROCEDURE Open*; 19 | VAR ch: CHAR; 20 | BEGIN V24.Start(pno, 19200, 8, V24.ParNo, V24.Stop1, res); 21 | WHILE V24.Available(pno) > 0 DO V24.Receive(pno, ch, res) END ; 22 | IF res > 0 THEN Texts.WriteString(W, "open V24, error ="); Texts.WriteInt(W, res, 4) 23 | ELSE Texts.WriteString(W, "connection open") 24 | END ; 25 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 26 | END Open; 27 | 28 | PROCEDURE TestReq*; 29 | VAR ch: CHAR; 30 | BEGIN V24.Send(pno, REQ, res); Rec(ch); Texts.WriteInt(W, ORD(ch), 4); 31 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 32 | END TestReq; 33 | 34 | PROCEDURE SendInt(x: LONGINT); 35 | VAR i: INTEGER; 36 | BEGIN i := 4; 37 | WHILE i > 0 DO 38 | DEC(i); V24.Send(portno, CHR(x), res); x := x DIV 100H 39 | END 40 | END SendInt; 41 | 42 | PROCEDURE Load*; (*linked boot file F.bin*) 43 | VAR i, m, n, w: LONGINT; 44 | F: Files.File; R: Files.Rider; 45 | S: Texts.Scanner; 46 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 47 | IF S.class = Texts.Name THEN (*input file name*) 48 | Texts.WriteString(W, S.s); F := Files.Old(S.s); 49 | IF F # NIL THEN 50 | Files.Set(R, F, 0); Files.ReadLInt(R, n); Files.ReadLInt(R, m); n := n DIV 4; 51 | Texts.WriteInt(W, n, 6); Texts.WriteString(W, " loading "); Texts.Append(Oberon.Log, W.buf); 52 | i := 0; SendInt(n*4); SendInt(m); 53 | WHILE i < n DO 54 | IF i + 1024 < n THEN m := i + 1024 ELSE m := n END ; 55 | WHILE i < m DO Files.ReadLInt(R, w); SendInt(w); INC(i) END ; 56 | Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf) 57 | END ; 58 | SendInt(0); Texts.WriteString(W, "done") 59 | ELSE Texts.WriteString(W, " not found") 60 | END ; 61 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 62 | END 63 | END Load; 64 | 65 | (* ------------ send and receive files ------------ *) 66 | 67 | PROCEDURE Rec(VAR ch: CHAR); (*receive with timeout*) 68 | VAR time: LONGINT; 69 | BEGIN time := Oberon.Time() + 3000; 70 | LOOP 71 | IF V24.Available(pno) > 0 THEN V24.Receive(pno, ch, res); EXIT END ; 72 | IF Oberon.Time() >= time THEN ch := 0X; EXIT END 73 | END 74 | END Rec; 75 | 76 | PROCEDURE SendName(VAR s: ARRAY OF CHAR); 77 | VAR i: INTEGER; ch: CHAR; 78 | BEGIN i := 0; ch := s[0]; 79 | WHILE ch > 0X DO V24.Send(pno, ch, res); INC(i); ch := s[i] END ; 80 | V24.Send(pno, 0X, res) 81 | END SendName; 82 | 83 | PROCEDURE Send*; 84 | VAR ch, code: CHAR; 85 | n, n0, L: LONGINT; 86 | F: Files.File; R: Files.Rider; 87 | S: Texts.Scanner; 88 | BEGIN V24.Send(pno, REQ, res); Rec(code); 89 | IF code = ACK THEN 90 | Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 91 | WHILE S.class = Texts.Name DO 92 | Texts.WriteString(W, S.s); F := Files.Old(S.s); 93 | IF F # NIL THEN 94 | V24.Send(pno, REC, res); SendName(S.s); Rec(code); 95 | IF code = ACK THEN 96 | Texts.WriteString(W, " sending "); 97 | L := Files.Length(F); Files.Set(R, F, 0); 98 | REPEAT (*send paket*) 99 | IF L > BlkLen THEN n := BlkLen ELSE n := L END ; 100 | n0 := n; V24.Send(pno, CHR(n), res); DEC(L, n); 101 | WHILE n > 0 DO Files.Read(R, ch); V24.Send(pno, ch, res); DEC(n) END ; 102 | Rec(code); 103 | IF code = ACK THEN Texts.Write(W, ".") ELSE Texts.Write(W, "*"); n := 0 END ; 104 | Texts.Append(Oberon.Log, W.buf) 105 | UNTIL n0 < BlkLen; 106 | Rec(code) 107 | ELSE Texts.WriteString(W, " no response"); Texts.WriteInt(W, ORD(code), 4) 108 | END 109 | ELSE Texts.WriteString(W, " not found") 110 | END ; 111 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S) 112 | END 113 | ELSE Texts.WriteString(W, " connection not open"); 114 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 115 | END 116 | END Send; 117 | 118 | PROCEDURE Receive*; 119 | VAR ch, code: CHAR; 120 | n, L, LL: LONGINT; 121 | F: Files.File; R: Files.Rider; 122 | orgname: ARRAY 32 OF CHAR; 123 | S: Texts.Scanner; 124 | BEGIN V24.Send(pno, REQ, res); Rec(code); 125 | IF code = ACK THEN 126 | Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 127 | WHILE S.class = Texts.Name DO 128 | Texts.WriteString(W, S.s); COPY(S.s, orgname); 129 | F := Files.New(S.s); Files.Set(R, F, 0); LL := 0; 130 | V24.Send(pno, SND, res); SendName(S.s); Rec(code); 131 | IF code = ACK THEN 132 | Texts.WriteString(W, " receiving "); 133 | REPEAT Rec(ch); L := ORD(ch); n := L; 134 | WHILE n > 0 DO V24.Receive(pno, ch, res); Files.Write(R, ch); DEC(n) END ; 135 | V24.Send(pno, ACK, res); LL := LL + L; Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf) 136 | UNTIL L < BlkLen; 137 | Files.Register(F); Texts.WriteInt(W, LL, 6) 138 | ELSE Texts.WriteString(W, " no response"); Texts.WriteInt(W, ORD(code), 4) 139 | END ; 140 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S) 141 | END 142 | ELSE Texts.WriteString(W, " connection not open"); 143 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 144 | END 145 | END Receive; 146 | 147 | PROCEDURE Close*; 148 | BEGIN V24.Send(pno, CLS, res); 149 | Texts.WriteString(W, "Server closed"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 150 | END Close; 151 | 152 | (* ------------ Oberon-0 commands ------------ *) 153 | 154 | PROCEDURE RecByte(VAR ch: CHAR); 155 | VAR T: LONGINT; ch0: CHAR; 156 | BEGIN T := Oberon.Time() + Tout; 157 | REPEAT UNTIL (V24.Available(portno) > 0) OR (Oberon.Time() >= T); 158 | IF V24.Available(portno) > 0 THEN V24.Receive(portno, ch, res) ELSE ch := 0X END ; 159 | END RecByte; 160 | 161 | PROCEDURE RecInt(VAR x: LONGINT); 162 | VAR i, k, T: LONGINT; ch: CHAR; 163 | BEGIN i := 4; k := 0; 164 | REPEAT 165 | DEC(i); V24.Receive(portno, ch, res); 166 | k := SYSTEM.ROT(ORD(ch)+k, -8) 167 | UNTIL i = 0; 168 | x := k 169 | END RecInt; 170 | 171 | PROCEDURE SR*; (*send, then receive sequence of items*) 172 | VAR S: Texts.Scanner; i, k: LONGINT; ch, xch: CHAR; 173 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 174 | WHILE (S.class # Texts.Char) & (S.c # "~") DO 175 | IF S.class = Texts.Int THEN Texts.WriteInt(W, S.i, 6); SendInt(S.i) 176 | ELSIF S.class = Texts.Real THEN 177 | Texts.WriteReal(W, S.x, 12); SendInt(SYSTEM.VAL(LONGINT, S.x)) 178 | ELSIF S.class IN {Texts.Name, Texts.String} THEN 179 | Texts.Write(W, " "); Texts.WriteString(W, S.s); i := 0; 180 | REPEAT ch := S.s[i]; V24.Send(portno, ch, res); INC(i) UNTIL ch = 0X 181 | ELSIF S.class = Texts.Char THEN Texts.Write(W, S.c) 182 | ELSE Texts.WriteString(W, "bad value") 183 | END ; 184 | Texts.Scan(S) 185 | END ; 186 | Texts.Write(W, "|"); (*Texts.Append(Oberon.Log, W.buf);*) 187 | (*receive input*) 188 | REPEAT RecByte(xch); 189 | IF xch = 0X THEN Texts.WriteString(W, " timeout"); Flush 190 | ELSIF xch = 1X THEN RecInt(k); Texts.WriteInt(W, k, 6) 191 | ELSIF xch = 2X THEN RecInt(k); Texts.WriteHex(W, k) 192 | ELSIF xch = 3X THEN RecInt(k); Texts.WriteReal(W, SYSTEM.VAL(REAL, k), 15) 193 | ELSIF xch = 4X THEN Texts.Write(W, " "); V24.Receive(portno, ch, res); 194 | WHILE ch > 0X DO Texts.Write(W, ch); V24.Receive(portno, ch, res) END 195 | ELSIF xch = 5X THEN V24.Receive(portno, ch, res); Texts.Write(W, ch) 196 | ELSIF xch = 6X THEN Texts.WriteLn(W) 197 | ELSIF xch = 7X THEN Texts.Write(W, "~"); xch := 0X 198 | ELSIF xch = 8X THEN RecByte(ch); Texts.WriteInt(W, ORD(ch), 4); Texts.Append(Oberon.Log, W.buf) 199 | ELSE xch := 0X 200 | END 201 | UNTIL xch = 0X; 202 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 203 | END SR; 204 | 205 | BEGIN Texts.OpenWriter(W); 206 | END ORC. 207 | -------------------------------------------------------------------------------- /Sources/OberonSyntax.Text: -------------------------------------------------------------------------------- 1 | digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9". 2 | hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F". 3 | ident = letter {letter | digit}. 4 | qualident = [ident "."] ident. 5 | identdef = ident ["*"]. 6 | integer = digit {digit} | digit {hexDigit} "H". 7 | real = digit {digit} "." {digit} [ScaleFactor]. 8 | ScaleFactor = ("E" |"D") ["+" | "-"] digit {digit}. 9 | number = integer | real. 10 | string = "'" {character} "'" | digit {hexdigit} "X". 11 | ConstDeclaration = identdef "=" ConstExpression. 12 | ConstExpression = expression. 13 | TypeDeclaration = identdef "=" StrucType. 14 | StrucType = ArrayType | RecordType | PointerType | ProcedureType. 15 | type = qualident | StrucType. 16 | ArrayType = "ARRAY" length {"," length} "OF" type. 17 | length = ConstExpression. 18 | RecordType = "RECORD" ["(" BaseType ")"] [FieldListSequence] "END". 19 | BaseType = qualident. 20 | FieldListSequence = FieldList {";" FieldList}. 21 | FieldList = IdentList ":" type. 22 | IdentList = identdef {"," identdef}. 23 | PointerType = "POINTER" "TO" type. 24 | ProcedureType = "PROCEDURE" [FormalParameters]. 25 | VariableDeclaration = IdentList ":" type. 26 | expression = SimpleExpression [relation SimpleExpression]. 27 | relation = "=" | "#" | "<" | "<=" | ">" | ">=" | "IN" | "IS". 28 | SimpleExpression = ["+" | "-"] term {AddOperator term}. 29 | AddOperator = "+" | "-" | "OR". 30 | term = factor {MulOperator factor}. 31 | MulOperator = "*" | "/" | "DIV" | "MOD" | "&". 32 | factor = number | string | "NIL" | "TRUE" | "FALSE" | 33 | set | designator [ActualParameters] | "(" expression ")" | "~" factor. 34 | designator = qualident {selector}. 35 | selector = "." ident | "[" ExpList "]" | "^" | "(" qualident ")". 36 | set = "{" [element {"," element}] "}". 37 | element = expression [".." expression]. 38 | ExpList = expression {"," expression}. 39 | ActualParameters = "(" [ExpList] ")" . 40 | statement = [assignment | ProcedureCall | IfStatement | CaseStatement | 41 | WhileStatement | RepeatStatement | ForStatement]. 42 | assignment = designator ":=" expression. 43 | ProcedureCall = designator [ActualParameters]. 44 | StatementSequence = statement {";" statement}. 45 | IfStatement = "IF" expression "THEN" StatementSequence 46 | {"ELSIF" expression "THEN" StatementSequence} 47 | ["ELSE" StatementSequence] "END". 48 | CaseStatement = "CASE" expression "OF" case {"|" case} "END". 49 | Case = CaseLabelList ":" StatementSequence. 50 | CaseLabelList = LabelRange {"," LabelRange}. 51 | LabelRange = label [".." label]. 52 | label = integer | string | ident. 53 | WhileStatement = "WHILE" expression "DO" StatementSequence 54 | {"ELSIF" expression "DO" StatementSequence} "END". 55 | RepeatStatement = "REPEAT" StatementSequence "UNTIL" expression. 56 | ForStatement = "FOR" ident ":=" expression "TO" expression ["BY" ConstExpression] 57 | "DO" StatementSequence "END". 58 | ProcedureDeclaration = ProcedureHeading ";" ProcedureBody ident. 59 | ProcedureHeading = "PROCEDURE" identdef [FormalParameters]. 60 | ProcedureBody = DeclarationSequence ["BEGIN" StatementSequence] 61 | ["RETURN" expression] "END". 62 | DeclarationSequence = ["CONST" {ConstDeclaration ";"}] 63 | ["TYPE" {TypeDeclaration ";"}] 64 | ["VAR" {VariableDeclaration ";"}] 65 | {ProcedureDeclaration ";"}. 66 | FormalParameters = "(" [FPSection {";" FPSection}] ")" [":" qualident]. 67 | FPSection = ["CONST" | "VAR"] ident {"," ident} ":" FormalType. 68 | FormalType = ["ARRAY" "OF"] qualident. 69 | module = "MODULE" ident ";" [ImportList] DeclarationSequence 70 | ["BEGIN" StatementSequence] "END" ident "." . 71 | ImportList = "IMPORT" import {"," import} ";". 72 | import = ident [":=" ident]. 73 | -------------------------------------------------------------------------------- /Sources/PCLink1.Mod: -------------------------------------------------------------------------------- 1 | MODULE PCLink1; (*NW 25.7.2013 for Oberon on RISC*) 2 | IMPORT SYSTEM, Files, Texts, Oberon; 3 | 4 | CONST data = -56; stat = -52; 5 | BlkLen = 255; 6 | REQ = 20H; REC = 21H; SND = 22H; ACK = 10H; NAK = 11H; 7 | 8 | VAR T: Oberon.Task; 9 | W: Texts.Writer; 10 | 11 | PROCEDURE Rec(VAR x: BYTE); 12 | BEGIN 13 | REPEAT UNTIL SYSTEM.BIT(stat, 0); 14 | SYSTEM.GET(data, x) 15 | END Rec; 16 | 17 | PROCEDURE RecName(VAR s: ARRAY OF CHAR); 18 | VAR i: INTEGER; x: BYTE; 19 | BEGIN i := 0; Rec(x); 20 | WHILE x > 0 DO s[i] := CHR(x); INC(i); Rec(x) END ; 21 | s[i] := 0X 22 | END RecName; 23 | 24 | PROCEDURE Send(x: BYTE); 25 | BEGIN 26 | REPEAT UNTIL SYSTEM.BIT(stat, 1); 27 | SYSTEM.PUT(data, x) 28 | END Send; 29 | 30 | PROCEDURE Task; 31 | VAR len, n, i: INTEGER; 32 | x, ack, len1, code: BYTE; 33 | name: ARRAY 32 OF CHAR; 34 | F: Files.File; R: Files.Rider; 35 | buf: ARRAY 256 OF BYTE; 36 | BEGIN 37 | IF SYSTEM.BIT(stat, 0) THEN (*byte available*) 38 | Rec(code); 39 | IF code = SND THEN (*send file*) 40 | LED(20H); RecName(name); F := Files.Old(name); 41 | IF F # NIL THEN 42 | Texts.WriteString(W, "sending "); Texts.WriteString(W, name); 43 | Texts.Append(Oberon.Log, W.buf); 44 | Send(ACK); len := Files.Length(F); Files.Set(R, F, 0); 45 | REPEAT 46 | IF len >= BlkLen THEN len1 := BlkLen ELSE len1 := len END ; 47 | Send(len1); n := len1; len := len - len1; 48 | WHILE n > 0 DO Files.ReadByte(R, x); Send(x); DEC(n) END ; 49 | Rec(ack); 50 | IF ack # ACK THEN len1 := 0 END 51 | UNTIL len1 < BlkLen; 52 | Texts.WriteString(W, " done"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 53 | ELSE Send(11H) 54 | END 55 | ELSIF code = REC THEN (*receive file*) 56 | LED(30H); RecName(name); F := Files.New(name); 57 | IF F # NIL THEN 58 | Texts.WriteString(W, "receiving "); Texts.WriteString(W, name); 59 | Texts.Append(Oberon.Log, W.buf); 60 | Files.Set(R, F, 0); Send(ACK); 61 | REPEAT Rec(x); len := x; i := 0; 62 | WHILE i < len DO Rec(x); buf[i] := x; INC(i) END ; 63 | i := 0; 64 | WHILE i < len DO Files.WriteByte(R, buf[i]); INC(i) END ; 65 | Send(ACK) 66 | UNTIL len < 255; 67 | Files.Register(F); Send(ACK); 68 | Texts.WriteString(W, " done"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 69 | ELSE Send(NAK) 70 | END 71 | ELSIF code = REQ THEN Send(ACK) 72 | END ; 73 | LED(0) 74 | END 75 | END Task; 76 | 77 | PROCEDURE Run*; 78 | BEGIN Oberon.Install(T); Texts.WriteString(W, "PCLink started"); 79 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 80 | END Run; 81 | 82 | PROCEDURE Stop*; 83 | BEGIN Oberon.Remove(T); Texts.WriteString(W, "PCLink stopped"); 84 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 85 | END Stop; 86 | 87 | BEGIN Texts.OpenWriter(W); T := Oberon.NewTask(Task, 0) 88 | END PCLink1. 89 | -------------------------------------------------------------------------------- /Sources/PIO.Mod: -------------------------------------------------------------------------------- 1 | MODULE PIO; (*NW 16.10.2014 PIC Input/Output for RISC*) 2 | IMPORT SYSTEM; 3 | 4 | (* PIC interface, output: 5 | D0 = PIC B7 data out 6 | D1 = PIC B6 clk out 7 | D2 = PIC A4 data in *) 8 | 9 | CONST gpio = -32; gpoc = -28; (*I/O addresses*) 10 | 11 | PROCEDURE del(i: INTEGER); 12 | BEGIN 13 | REPEAT DEC(i) UNTIL i = 0 14 | END del; 15 | 16 | PROCEDURE Send*(x: LONGINT); 17 | VAR i: INTEGER; 18 | BEGIN (*send byte*) 19 | FOR i := 0 TO 7 DO 20 | SYSTEM.PUT(gpio, x MOD 2 + 2); del(60); SYSTEM.PUT(gpio, x MOD 2); del(25); x := x DIV 2 21 | END ; 22 | SYSTEM.PUT(gpio, 0); del(100) 23 | END Send; 24 | 25 | PROCEDURE Receive*(VAR x: LONGINT); 26 | VAR i, x0: INTEGER; 27 | BEGIN (*receive byte*) x0 := 0; 28 | REPEAT UNTIL ~SYSTEM.BIT(gpio, 2); 29 | FOR i := 0 TO 7 DO 30 | SYSTEM.PUT(gpio, 2); del(60); 31 | IF SYSTEM.BIT(gpio, 2) THEN x0 := x0 + 100H END ; 32 | SYSTEM.PUT(gpio, 0); del(25); x0 := ROR(x0, 1) 33 | END ; 34 | x := x0 35 | END Receive; 36 | 37 | PROCEDURE Reset*; 38 | BEGIN SYSTEM.PUT(gpio, 0); SYSTEM.PUT(gpoc, 3) (*set bit 0, 1 to output*) 39 | END Reset; 40 | 41 | BEGIN Reset 42 | END PIO. 43 | -------------------------------------------------------------------------------- /Sources/RISC.Mod: -------------------------------------------------------------------------------- 1 | MODULE RISC; (*NW 22.9.07 / 1.11.2013*) 2 | IMPORT SYSTEM, Texts, Oberon; 3 | CONST 4 | MOV = 0; LSL = 1; ASR = 2; ROR = 3; AND = 4; ANN = 5; IOR = 6; XOR = 7; 5 | ADD = 8; SUB = 9; MUL = 10; Div = 11; 6 | 7 | VAR IR: LONGINT; (*instruction register*) 8 | PC: LONGINT; (*program counter*) 9 | N, Z: BOOLEAN; (*condition flags*) 10 | R: ARRAY 16 OF LONGINT; 11 | H: LONGINT; (*aux register for division*) 12 | 13 | PROCEDURE Execute*(VAR M: ARRAY OF LONGINT; pc: LONGINT; 14 | VAR S: Texts.Scanner; VAR W: Texts.Writer); 15 | VAR a, b, op, im: LONGINT; (*instruction fields*) 16 | adr, A, B, C, n: LONGINT; 17 | MemSize: LONGINT; 18 | BEGIN PC := 0; R[13] := pc * 4; R[14] := LEN(M)*4; n := 0; 19 | REPEAT (*interpretation cycle*) 20 | IR := M[PC]; INC(PC); INC(n); 21 | a := IR DIV 1000000H MOD 10H; 22 | b := IR DIV 100000H MOD 10H; 23 | op := IR DIV 10000H MOD 10H; 24 | im := IR MOD 10000H; 25 | IF ~ODD(IR DIV 80000000H) THEN (*~p: register instruction*) 26 | B := R[b]; 27 | IF ~ODD(IR DIV 40000000H) THEN (*~q*) C := R[IR MOD 10H] 28 | ELSIF ~ODD(IR DIV 10000000H) THEN (*q&~v*) C := im 29 | ELSE (*q&v*) C := im + 0FFFF0000H 30 | END ; 31 | CASE op OF 32 | MOV: IF ~ODD(IR DIV 20000000H) THEN A := C ELSE A := H END | 33 | LSL: A := SYSTEM.LSH(B, C) | 34 | ASR: A := ASH(B, -C) | 35 | ROR: A := SYSTEM.ROT(B, -C) | 36 | AND: A := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, B) * SYSTEM.VAL(SET, C)) | 37 | ANN: A := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, B) - SYSTEM.VAL(SET, C)) | 38 | IOR: A := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, B) + SYSTEM.VAL(SET, C)) | 39 | XOR: A := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, B) / SYSTEM.VAL(SET, C)) | 40 | ADD: A := B + C | 41 | SUB: A := B - C | 42 | MUL: A := B * C | 43 | Div: A := B DIV C; H := B MOD C 44 | END ; 45 | R[a] := A; N := A < 0; Z := A = 0 46 | ELSIF ~ODD(IR DIV 40000000H) THEN (*p & ~q: memory instruction*) 47 | adr := (R[b] + IR MOD 100000H) DIV 4; 48 | IF ~ODD(IR DIV 20000000H) THEN 49 | IF adr >= 0 THEN (*load*) R[a] := M[adr]; N := A < 0; Z := A = 0 50 | ELSE (*input*) 51 | IF adr = -1 THEN (*ReadInt*) Texts.Scan(S); R[a] := S.i; 52 | ELSIF adr = -2 THEN (*eot*) Z := S.class # Texts.Int 53 | END 54 | END 55 | ELSE 56 | IF adr >= 0 THEN (*store*) M[adr] := R[a]; 57 | ELSE (*output*) 58 | IF adr = -1 THEN Texts.WriteInt(W, R[a], 4) 59 | ELSIF adr = -2 THEN Texts.Write(W, CHR(R[a] MOD 80H)) 60 | ELSIF adr = -3 THEN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 61 | END 62 | END 63 | END 64 | ELSE (* p & q: branch instruction*) 65 | IF (a = 0) & N OR (a = 1) & Z OR (a = 5) & N OR (a = 6) & (N OR Z) OR (a = 7) OR 66 | (a = 8) & ~N OR (a = 9) & ~Z OR (a = 13) & ~N OR (a = 14) & ~(N OR Z) THEN 67 | IF ODD(IR DIV 10000000H) THEN R[15] := PC * 4 END ; 68 | IF ODD(IR DIV 20000000H) THEN PC := (PC + (IR MOD 1000000H)) MOD 40000H 69 | ELSE PC := R[IR MOD 10H] DIV 4 70 | END 71 | END 72 | END 73 | UNTIL (PC = 0) OR (n = 100000); 74 | Texts.WriteInt(W, n, 8); 75 | IF n = 100000 THEN Texts.WriteString(W, " aborted") END ; 76 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 77 | END Execute; 78 | END RISC. 79 | 80 | 81 | -------------------------------------------------------------------------------- /Sources/RS232.Mod: -------------------------------------------------------------------------------- 1 | MODULE RS232; (*NW 3.1.2012*) 2 | IMPORT SYSTEM; 3 | CONST data = -56; stat = -52; 4 | 5 | PROCEDURE Send*(x: INTEGER); 6 | BEGIN 7 | REPEAT UNTIL SYSTEM.BIT(stat, 1); 8 | SYSTEM.PUT(data, x) 9 | END Send; 10 | 11 | PROCEDURE Rec*(VAR x: INTEGER); 12 | BEGIN 13 | REPEAT UNTIL SYSTEM.BIT(stat, 0); 14 | SYSTEM.GET(data, x) 15 | END Rec; 16 | 17 | PROCEDURE SendInt*(x: INTEGER); 18 | VAR i: INTEGER; 19 | BEGIN Send(1); i := 4; 20 | REPEAT i := i-1; Send(x); x := ROR(x, 8) UNTIL i = 0 21 | END SendInt; 22 | 23 | PROCEDURE SendHex*(x: INTEGER); 24 | VAR i: INTEGER; 25 | BEGIN Send(2); i := 4; 26 | REPEAT i := i-1; Send(x); x := ROR(x, 8) UNTIL i = 0 27 | END SendHex; 28 | 29 | PROCEDURE SendReal*(x: REAL); 30 | VAR i, u: INTEGER; 31 | BEGIN Send(3); u := ORD(x); i := 4; 32 | REPEAT i := i-1; Send(u); u := ROR(u, 8) UNTIL i = 0 33 | END SendReal; 34 | 35 | PROCEDURE SendStr*(x: ARRAY OF CHAR); 36 | VAR i, k: INTEGER; 37 | BEGIN Send(4); i := 0; 38 | REPEAT k := ORD(x[i]); Send(k); INC(i) UNTIL k = 0 39 | END SendStr; 40 | 41 | PROCEDURE RecInt*(VAR x: INTEGER); 42 | VAR i, x0, y: INTEGER; 43 | BEGIN i := 4; x0 := 0; 44 | REPEAT i := i-1; Rec(y); x0 := ROR(x0+y, 8) UNTIL i = 0; 45 | x := x0 46 | END RecInt; 47 | 48 | PROCEDURE RecReal*(VAR x: REAL); 49 | VAR i, x0, y: INTEGER; 50 | BEGIN i := 4; x0 := 0; 51 | REPEAT i := i-1; Rec(y); x0 := ROR(x0+y, 8) UNTIL i = 0; 52 | x := SYSTEM.VAL(REAL, x0) 53 | END RecReal; 54 | 55 | PROCEDURE RecStr*(VAR x: ARRAY OF CHAR); 56 | VAR i, k: INTEGER; 57 | BEGIN i := 0; 58 | REPEAT Rec(k); x[i] := CHR(k); INC(i) UNTIL k = 0 59 | END RecStr; 60 | 61 | PROCEDURE Line*; 62 | BEGIN Send(6) 63 | END Line; 64 | 65 | PROCEDURE End*; 66 | BEGIN Send(7) 67 | END End; 68 | 69 | BEGIN END RS232. 70 | -------------------------------------------------------------------------------- /Sources/Rectangles.Mod: -------------------------------------------------------------------------------- 1 | MODULE Rectangles; (*NW 25.2.90 / 18.4.2013*) 2 | IMPORT SYSTEM, Display, Files, Input, Texts, Oberon, Graphics, GraphicFrames; 3 | 4 | TYPE 5 | Rectangle* = POINTER TO RectDesc; 6 | RectDesc* = RECORD (Graphics.ObjectDesc) 7 | lw*, vers*: INTEGER 8 | END ; 9 | 10 | VAR method*: Graphics.Method; 11 | tack*, grey*: INTEGER; 12 | 13 | PROCEDURE New*; 14 | VAR r: Rectangle; 15 | BEGIN NEW(r); r.do := method; Graphics.New(r) 16 | END New; 17 | 18 | PROCEDURE Copy(src, dst: Graphics.Object); 19 | BEGIN dst.x := src.x; dst.y := src.y; dst.w := src.w; dst.h := src.h; dst.col := src.col; 20 | dst(Rectangle).lw := src(Rectangle).lw; dst(Rectangle).vers := src(Rectangle).vers 21 | END Copy; 22 | 23 | PROCEDURE mark(f: GraphicFrames.Frame; col, x, y: INTEGER); 24 | BEGIN GraphicFrames.ReplConst(f, col, x+1, y+1, 4, 4, 0) 25 | END mark; 26 | 27 | PROCEDURE Draw(obj: Graphics.Object; VAR M: Graphics.Msg); 28 | VAR x, y, w, h, lw, col: INTEGER; f: GraphicFrames.Frame; 29 | 30 | PROCEDURE draw(f: GraphicFrames.Frame; col, x, y, w, h, lw: INTEGER); 31 | BEGIN 32 | GraphicFrames.ReplConst(f, col, x, y, w, lw, Display.replace); 33 | GraphicFrames.ReplConst(f, col, x+w-lw, y, lw, h, Display.replace); 34 | GraphicFrames.ReplConst(f, col, x, y+h-lw, w, lw, Display.replace); 35 | GraphicFrames.ReplConst(f, col, x, y, lw, h, Display.replace) 36 | END draw; 37 | 38 | BEGIN 39 | CASE M OF GraphicFrames.DrawMsg: 40 | x := obj.x + M.x; y := obj.y + M.y; w := obj.w; h := obj.h; f := M.f; 41 | lw := obj(Rectangle).lw; 42 | IF (x < f.X1) & (x+w > f.X) & (y < f.Y1) & (y+h > f.Y) THEN 43 | IF M.col = Display.black THEN col := obj.col ELSE col := M.col END ; 44 | IF M.mode = 0 THEN 45 | draw(f, col, x, y, w, h, lw); 46 | IF obj.selected THEN mark(f, Display.white, x, y) END 47 | ELSIF M.mode = 1 THEN mark(f, Display.white, x, y) (*normal -> selected*) 48 | ELSIF M.mode = 2 THEN mark(f, Display.black, x, y) (*selected -> normal*) 49 | ELSIF M.mode = 3 THEN draw(f, Display.black, x, y, w, h, lw); mark(f, Display.black, x, y) (*erase*) 50 | END 51 | END 52 | END 53 | END Draw; 54 | 55 | PROCEDURE Selectable(obj: Graphics.Object; x, y: INTEGER): BOOLEAN; 56 | BEGIN 57 | RETURN (obj.x <= x) & (x <= obj.x + 4) & (obj.y <= y) & (y <= obj.y + 4) 58 | END Selectable; 59 | 60 | PROCEDURE Change(obj: Graphics.Object; VAR M: Graphics.Msg); 61 | VAR x0, y0, x1, y1, dx, dy: INTEGER; k: SET; 62 | BEGIN 63 | CASE M OF 64 | Graphics.WidMsg: obj(Rectangle).lw := M.w | 65 | Graphics.ColorMsg: obj.col := M.col 66 | END 67 | END Change; 68 | 69 | PROCEDURE Read(obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context); 70 | VAR b: BYTE; len: INTEGER; 71 | BEGIN Files.ReadByte(R, b); (*len*); 72 | Files.ReadByte(R, b); obj(Rectangle).lw := b; 73 | Files.ReadByte(R, b); obj(Rectangle).vers := b; 74 | END Read; 75 | 76 | PROCEDURE Write(obj: Graphics.Object; cno: INTEGER; VAR W: Files.Rider; VAR C: Graphics.Context); 77 | BEGIN Graphics.WriteObj(W, cno, obj); Files.WriteByte(W, 2); 78 | Files.WriteByte(W, obj(Rectangle).lw); Files.WriteByte(W, obj(Rectangle).vers) 79 | END Write; 80 | 81 | (* PROCEDURE Print(obj: Graphics.Object; x, y: INTEGER); 82 | VAR w, h, lw, s: INTEGER; 83 | BEGIN INC(x, obj.x * 4); INC(y, obj.y * 4); w := obj.w * 4; h := obj.h * 4; 84 | lw := obj(Rectangle).lw * 2; s := obj(Rectangle).vers; 85 | Printer.ReplConst(x, y, w, lw); 86 | Printer.ReplConst(x+w-lw, y, lw, h); 87 | Printer.ReplConst(x, y+h-lw, w, lw); 88 | Printer.ReplConst(x, y, lw, h); 89 | IF s > 0 THEN Printer.ReplPattern(x, y, w, h, s) END 90 | END Print; *) 91 | 92 | PROCEDURE Make*; (*command*) 93 | VAR x0, x1, y0, y1: INTEGER; 94 | R: Rectangle; 95 | G: GraphicFrames.Frame; 96 | BEGIN G := GraphicFrames.Focus(); 97 | IF (G # NIL) & (G.mark.next # NIL) THEN 98 | GraphicFrames.Deselect(G); 99 | x0 := G.mark.x; y0 := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y; 100 | NEW(R); R.col := Oberon.CurCol; 101 | R.w := ABS(x1-x0); R.h := ABS(y1-y0); 102 | IF x1 < x0 THEN x0 := x1 END ; 103 | IF y1 < y0 THEN y0 := y1 END ; 104 | R.x := x0 - G.x; R.y := y0 - G.y; 105 | R.lw := Graphics.width; R.vers := 0; R.do := method; 106 | Graphics.Add(G.graph, R); 107 | GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, R) 108 | END 109 | END Make; 110 | 111 | BEGIN NEW(method); 112 | method.module := "Rectangles"; method.allocator := "New"; 113 | method.new := New; method.copy := Copy; method.draw := Draw; 114 | method.selectable := Selectable; method.change := Change; 115 | method.read := Read; method.write := Write; (*method.print := Print*) 116 | tack := SYSTEM.ADR($0707 4122 1408 1422 4100$); 117 | grey := SYSTEM.ADR($2004 0000 1111 1111 0000 0000 4444 4444 0000 0000$) 118 | END Rectangles. 119 | -------------------------------------------------------------------------------- /Sources/SCC.Mod: -------------------------------------------------------------------------------- 1 | MODULE SCC; (*NW 13.11.87 / 22.8.90 Ceres-2; nRF24L01+ version PR 21.7.13 / 23.12.13*) 2 | IMPORT SYSTEM, Kernel; 3 | 4 | CONST 5 | swi = -60; spiData = -48; spiCtrl = -44; 6 | netSelect = 1; spiFast = 2; netEnable = 3; 7 | HdrSize = 8; MaxPayload = 512; SubPacket = 32; Wait = 50; SendTries = 50; 8 | MaxPacket = (HdrSize + MaxPayload + SubPacket-1) DIV SubPacket * 9 | SubPacket; 10 | 11 | TYPE Header* = 12 | RECORD valid*: BOOLEAN; 13 | dadr*, sadr*, typ*: BYTE; 14 | len*: INTEGER (*of data following header*) 15 | END ; 16 | 17 | VAR 18 | filter*: BOOLEAN; Adr*: BYTE; rcvd: INTEGER; 19 | rx: RECORD 20 | hd: Header; 21 | dat: ARRAY MaxPacket-HdrSize OF BYTE 22 | END; 23 | 24 | PROCEDURE SPICtrl(s: SET); 25 | BEGIN SYSTEM.PUT(spiCtrl, s); 26 | IF netEnable IN s THEN LED(55H) ELSE LED(0) END 27 | END SPICtrl; 28 | 29 | PROCEDURE SPI(n: INTEGER); 30 | BEGIN (*send (& rcv into shift reg) one byte or word, at current speed*) 31 | SYSTEM.PUT(spiData, n); REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0) (*wait until done*) 32 | END SPI; 33 | 34 | PROCEDURE StartCmd(cmd: INTEGER); 35 | BEGIN SPICtrl({netSelect}); SPI(cmd) 36 | END StartCmd; 37 | 38 | PROCEDURE WriteReg1(reg, dat: INTEGER); (*disables radio!*) 39 | BEGIN StartCmd(reg + 20H); SPI(dat); SPICtrl({}) (*W_REGISTER*) 40 | END WriteReg1; 41 | 42 | PROCEDURE SubRcv(dst: INTEGER); 43 | VAR i, dat: INTEGER; 44 | BEGIN 45 | StartCmd(061H); (*R_RX_PAYLOAD, disables radio*) 46 | SPICtrl({netSelect, spiFast}); 47 | FOR i := 0 TO SubPacket-4 BY 4 DO 48 | SPI(-1); SYSTEM.GET(spiData, dat); SYSTEM.PUT(dst+i, dat) 49 | END; 50 | SPICtrl({}); WriteReg1(7, 40H); (*done; STATUS <= clear RX_DR*) 51 | SPICtrl({netEnable}) (*enable radio*) 52 | END SubRcv; 53 | 54 | PROCEDURE SubSnd(src: INTEGER; VAR timeout: BOOLEAN); 55 | VAR i, dat, res, t1, try: INTEGER; x, status: BYTE; 56 | BEGIN (*already in xmit mode*) 57 | StartCmd(0A0H); (*W_TX_PAYLOAD*) 58 | SPICtrl({netSelect, spiFast}); 59 | FOR i := 0 TO SubPacket-4 BY 4 DO 60 | SYSTEM.GET(src+i, dat); SPI(dat) 61 | END; 62 | SPICtrl({}); (*end W_TX_PAYLOAD command*) 63 | try := 0; 64 | SPICtrl({netEnable, netSelect}); (*start xmit pulse, start NOP cmd*) 65 | REPEAT 66 | t1 := Kernel.Time() + Wait; 67 | REPEAT (*wait for sent or retransmits exceeded*); 68 | SPI(0FFH); SYSTEM.GET(spiData, status); (*NOP*) 69 | res := status DIV 10H MOD 4; 70 | SPICtrl({}); SPICtrl({netSelect}) (*end & restart NOP cmd, end =10us pulse on enable*) 71 | UNTIL res # 0; 72 | IF res = 2 THEN WriteReg1(7, 20H) (*TX_DS: sent, ack received; reset it*) 73 | ELSIF res = 1 THEN WriteReg1(7, 10H); INC(try); (*MAX_RT: retransmits exceeded; reset it*) 74 | IF try = SendTries THEN res := 0 75 | ELSE REPEAT UNTIL Kernel.Time() >= t1; 76 | SPICtrl({netEnable, netSelect}); (*start xmit pulse, start NOP cmd again*) 77 | END 78 | END 79 | UNTIL res # 1; 80 | timeout := (res # 2) 81 | END SubSnd; 82 | 83 | PROCEDURE Flush(); 84 | BEGIN StartCmd(0E1H); SPICtrl({}); StartCmd(0E2H); SPICtrl({}) 85 | (*FLUSH_TX, FLUSH_RX*) 86 | END Flush; 87 | 88 | PROCEDURE ResetRcv; 89 | BEGIN SYSTEM.PUT(SYSTEM.ADR(rx), 0); rx.hd.len := 0; rcvd := 0 90 | END ResetRcv; 91 | 92 | PROCEDURE Listen(b: BOOLEAN); 93 | BEGIN 94 | WriteReg1(0, 07EH + ORD(b)); (*CONFIG <= mask ints; EN_CRC(2 byte), PWR_UP, PRX/PTX*) 95 | WriteReg1(7, 70H); (*STATUS <= clear ints*) 96 | IF b THEN SPICtrl({netEnable}) END (*turn radio on*) 97 | END Listen; 98 | 99 | PROCEDURE Start*(filt: BOOLEAN); 100 | VAR n: INTEGER; 101 | BEGIN filter := filt; Adr := 0; 102 | SYSTEM.GET(swi, n); n := n DIV 4 MOD 10H * 10 + 5; 103 | WriteReg1(5, n); (*RF_CH <= channel: 5, 15, 25...*) 104 | WriteReg1(6, 07H); (*RF_SETUP <= 1Mb for better range, 0dBm*) 105 | WriteReg1(11H, SubPacket); (*RX_PW_P0 <= pipe 0 payload width*) 106 | Flush(); Listen(TRUE); ResetRcv 107 | END Start; 108 | 109 | PROCEDURE SendPacket*(VAR head: Header; dat: ARRAY OF BYTE); 110 | VAR len, i, off: INTEGER; timeout: BOOLEAN; payload: ARRAY SubPacket 111 | OF BYTE; 112 | BEGIN (*let any receive ack finish before turning radio off*) 113 | i := Kernel.Time() + Wait; 114 | REPEAT SPICtrl({netEnable, netSelect}); SPI(0FFH); SPICtrl({netEnable}) (*NOP*) 115 | UNTIL Kernel.Time() >= i; 116 | IF Adr = 0 THEN Adr := i MOD 100H END; 117 | Listen(FALSE); 118 | head.sadr := Adr; head.valid := TRUE; 119 | SYSTEM.COPY(SYSTEM.ADR(head), SYSTEM.ADR(payload), HdrSize DIV 4); 120 | i := HdrSize; off := 0; len := head.len; 121 | WHILE (len > 0) & (i < SubPacket) DO payload[i] := dat[off]; INC(i); INC(off); DEC(len) END; 122 | WHILE i < SubPacket DO payload[i] := 0; INC(i) END; 123 | SubSnd(SYSTEM.ADR(payload), timeout); 124 | WHILE ~timeout & (len # 0) DO i := 0; (*send the rest*) 125 | WHILE (len > 0) & (i < SubPacket) DO payload[i] := dat[off]; INC(i); INC(off); DEC(len) END; 126 | WHILE i < SubPacket DO payload[i] := 0; INC(i) END; 127 | SubSnd(SYSTEM.ADR(payload), timeout) 128 | END; 129 | Listen(TRUE) 130 | END SendPacket; 131 | 132 | PROCEDURE Available*(): INTEGER; 133 | BEGIN (*packet already rcvd*) 134 | RETURN rx.hd.len - rcvd 135 | END Available; 136 | 137 | PROCEDURE Receive*(VAR x: BYTE); 138 | BEGIN (*packet already rcvd*) 139 | IF rcvd < rx.hd.len THEN x := rx.dat[rcvd]; INC(rcvd) ELSE x := 0 END 140 | END Receive; 141 | 142 | PROCEDURE Rcvd(time: INTEGER): BOOLEAN; 143 | VAR status, fifoStatus: BYTE; rcvd: BOOLEAN; 144 | BEGIN time := time + Kernel.Time(); 145 | REPEAT 146 | SPICtrl({netEnable, netSelect}); SPI(17H); (*R_REGISTER FIFO_STATUS*) 147 | SYSTEM.GET(spiData, status); SPI(-1); SYSTEM.GET(spiData, fifoStatus); SPICtrl({netEnable}); 148 | rcvd := ODD(status DIV 40H) OR ~ODD(fifoStatus) (*RX_DR (data ready) or RX FIFO not empty*) 149 | UNTIL rcvd OR (Kernel.Time() >= time); 150 | RETURN rcvd 151 | END Rcvd; 152 | 153 | PROCEDURE ReceiveHead*(VAR head: Header); (*actually, recv whole packet*) 154 | VAR adr, n: INTEGER; 155 | BEGIN head.valid := FALSE; 156 | IF Rcvd(0) THEN 157 | ResetRcv; adr := SYSTEM.ADR(rx); SubRcv(adr); 158 | n := (rx.hd.len + HdrSize - 1) DIV SubPacket; 159 | IF (rx.hd.len <= MaxPayload) 160 | & ((rx.hd.dadr = 0FFH) OR ~filter OR (Adr = 0) OR (rx.hd.dadr = Adr)) THEN 161 | WHILE (n > 0) & Rcvd(Wait) DO 162 | INC(adr, SubPacket); SubRcv(adr); DEC(n) 163 | END; 164 | rx.hd.valid := (n = 0) 165 | ELSE WHILE Rcvd(Wait) DO SubRcv(adr) END; ResetRcv (*discard packet*) 166 | END; 167 | head := rx.hd 168 | END 169 | END ReceiveHead; 170 | 171 | PROCEDURE Skip*(m: INTEGER); 172 | VAR dmy: BYTE; 173 | BEGIN WHILE m # 0 DO Receive(dmy); DEC(m) END 174 | END Skip; 175 | 176 | PROCEDURE Stop*; 177 | BEGIN SPICtrl({}); Flush(); ResetRcv 178 | END Stop; 179 | 180 | BEGIN Start(TRUE) 181 | END SCC. 182 | -------------------------------------------------------------------------------- /Sources/Sierpinski.Mod: -------------------------------------------------------------------------------- 1 | MODULE Sierpinski; (*NW 15.1.2013*) 2 | IMPORT Display, Viewers, Oberon, MenuViewers, TextFrames; 3 | 4 | CONST Menu = "System.Close System.Copy System.Grow"; 5 | 6 | VAR x, y, d: INTEGER; 7 | A, B, C, D: PROCEDURE (i: INTEGER); 8 | 9 | PROCEDURE E; 10 | BEGIN Display.ReplConst(Display.white, x, y, d, 1, Display.paint); INC(x, d) 11 | END E; 12 | 13 | PROCEDURE N; 14 | BEGIN Display.ReplConst(Display.white, x, y, 1, d, Display.paint); INC(y, d) 15 | END N; 16 | 17 | PROCEDURE W; 18 | BEGIN DEC(x, d); Display.ReplConst(Display.white, x, y, d, 1, Display.paint) 19 | END W; 20 | 21 | PROCEDURE S; 22 | BEGIN DEC(y, d); Display.ReplConst(Display.white, x, y, 1, d, Display.paint) 23 | END S; 24 | 25 | PROCEDURE NE; 26 | VAR i: INTEGER; 27 | BEGIN i := d; 28 | REPEAT Display.Dot(Display.white, x, y, Display.paint); INC(x); INC(y); DEC(i) UNTIL i = 0 29 | END NE; 30 | 31 | PROCEDURE NW; 32 | VAR i: INTEGER; 33 | BEGIN i := d; 34 | REPEAT Display.Dot(Display.white, x, y, Display.paint); DEC(x); INC(y); DEC(i) UNTIL i = 0 35 | END NW; 36 | 37 | PROCEDURE SW; 38 | VAR i: INTEGER; 39 | BEGIN i := d; 40 | REPEAT Display.Dot(Display.white, x, y, Display.paint); DEC(x); DEC(y); DEC(i) UNTIL i = 0 41 | END SW; 42 | 43 | PROCEDURE SE; 44 | VAR i: INTEGER; 45 | BEGIN i := d; 46 | REPEAT Display.Dot(Display.white, x, y, Display.paint); INC(x); DEC(y); DEC(i) UNTIL i = 0 47 | END SE; 48 | 49 | PROCEDURE SA(i: INTEGER); 50 | BEGIN 51 | IF i > 0 THEN A(i-1); SE; B(i-1); E; E; D(i-1); NE; A(i-1) END 52 | END SA; 53 | 54 | PROCEDURE SB(i: INTEGER); 55 | BEGIN 56 | IF i > 0 THEN B(i-1); SW; C(i-1); S; S; A(i-1); SE; B(i-1) END 57 | END SB; 58 | 59 | PROCEDURE SC(i: INTEGER); 60 | BEGIN 61 | IF i > 0 THEN C(i-1); NW; D(i-1); W; W; B(i-1); SW; C(i-1) END 62 | END SC; 63 | 64 | PROCEDURE SD(i: INTEGER); 65 | BEGIN 66 | IF i > 0 THEN D(i-1); NE; A(i-1); N; N; C(i-1); NW; D(i-1) END 67 | END SD; 68 | 69 | PROCEDURE DrawSierpinski(F: Display.Frame); 70 | VAR k, n, w, x0, y0: INTEGER; 71 | BEGIN; k := 0; d := 4; 72 | IF F.W < F.H THEN w := F.W ELSE w := F.H END ; 73 | WHILE d*8 < w DO d := d*2; INC(k) END ; 74 | Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); 75 | x0 := F.W DIV 2; y0 := F.H DIV 2 + d; n := 0; 76 | WHILE n < k DO 77 | INC(n); DEC(x0, d); d := d DIV 2; INC(y0, d); 78 | x := F.X + x0; y := F.Y + y0; 79 | SA(n); SE; SB(n); SW; SC(n); NW; SD(n); NE 80 | END 81 | END DrawSierpinski; 82 | 83 | PROCEDURE Handler(F: Display.Frame; VAR M: Display.FrameMsg); 84 | VAR F1: Display.Frame; 85 | BEGIN 86 | IF M IS Oberon.InputMsg THEN 87 | IF M(Oberon.InputMsg).id = Oberon.track THEN 88 | Oberon.DrawMouseArrow(M(Oberon.InputMsg).X, M(Oberon.InputMsg).Y) 89 | END 90 | ELSIF M IS MenuViewers.ModifyMsg THEN 91 | F.Y := M(MenuViewers.ModifyMsg).Y; F.H := M(MenuViewers.ModifyMsg).H; DrawSierpinski(F) 92 | ELSIF M IS Oberon.ControlMsg THEN 93 | IF M(Oberon.ControlMsg).id = Oberon.neutralize THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H) END 94 | ELSIF M IS Oberon.CopyMsg THEN 95 | NEW(F1); F1^ := F^; M(Oberon.CopyMsg).F := F1 96 | END 97 | END Handler; 98 | 99 | PROCEDURE New(): Display.Frame; 100 | VAR F: Display.Frame; 101 | BEGIN NEW(F); F.handle := Handler; RETURN F 102 | END New; 103 | 104 | PROCEDURE Draw*; 105 | VAR V: Viewers.Viewer; X, Y: INTEGER; 106 | BEGIN Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 107 | V := MenuViewers.New(TextFrames.NewMenu("Sierpinski", Menu), New(), TextFrames.menuH, X, Y) 108 | END Draw; 109 | 110 | BEGIN A := SA; B := SB; C := SC; D := SD 111 | END Sierpinski. 112 | -------------------------------------------------------------------------------- /Sources/SmallPrograms.Mod: -------------------------------------------------------------------------------- 1 | ORP.Compile @/s Blink.Run BlinkStop 2 | 3 | MODULE Blink; (*NW 30.5.2013 use of a Task; blinks LED every second*) 4 | IMPORT SYSTEM, Oberon; 5 | VAR z: INTEGER; 6 | T: Oberon.Task; 7 | 8 | PROCEDURE Run*; 9 | BEGIN Oberon.Install(T) 10 | END Run; 11 | 12 | PROCEDURE Stop*; 13 | BEGIN Oberon.Remove(T) 14 | END Stop; 15 | 16 | PROCEDURE Tick; 17 | BEGIN z := 1-z; LED(z) 18 | END Tick; 19 | 20 | BEGIN z := 0; T := Oberon.NewTask(Tick, 500) 21 | END Blink. 22 | 23 | ORP.Compile @/s Permutations.Generate 2 3 4~ 24 | 25 | MODULE Permutations; (*NW 22.1.2013*) 26 | IMPORT Texts, Oberon; 27 | VAR n: INTEGER; 28 | a: ARRAY 10 OF INTEGER; 29 | S: Texts.Scanner; 30 | W: Texts.Writer; 31 | 32 | PROCEDURE perm(k: INTEGER); 33 | VAR i, x: INTEGER; 34 | BEGIN 35 | IF k = 0 THEN i := 0; 36 | WHILE i < n DO Texts.WriteInt(W, a[i], 5); i := i+1 END ; 37 | Texts.WriteLn(W) 38 | ELSE perm(k-1); i := 0; 39 | WHILE i < k-1 DO 40 | x := a[i]; a[i] := a[k-1]; a[k-1] := x; 41 | perm(k-1); 42 | x := a[i]; a[i] := a[k-1]; a[k-1] := x; 43 | i := i+1 44 | END 45 | END 46 | END perm; 47 | 48 | PROCEDURE Generate*; 49 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); n := 0; 50 | WHILE S.class = Texts.Int DO a[n] := S.i; INC(n); Texts.Scan(S) END ; 51 | perm(n); 52 | Texts.Append(Oberon.Log, W.buf) 53 | END Generate; 54 | 55 | BEGIN Texts.OpenWriter(W) 56 | END Permutations. 57 | 58 | ORP.Compile @/s MagicSquares.Generate 3 59 | 60 | MODULE MagicSquares; (*NW 11.8.97*) 61 | IMPORT Texts, Oberon; 62 | 63 | VAR W: Texts.Writer; 64 | 65 | PROCEDURE Generate*; (*magic square of order 3, 5, 7, ... *) 66 | VAR i, j, x, nx, nsq, n: INTEGER; 67 | M: ARRAY 13, 13 OF INTEGER; 68 | S: Texts.Scanner; 69 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 70 | IF S.class = Texts.Int THEN 71 | n := S.i; nsq := n*n; x := 0; 72 | i := n DIV 2; j := n-1; 73 | WHILE x < nsq DO 74 | nx := n + x; j := (j-1) MOD n; INC(x); M[i, j] := x; 75 | WHILE x < nx DO 76 | i := (i+1) MOD n; j := (j+1) MOD n; 77 | INC(x); M[i, j] := x 78 | END 79 | END ; 80 | FOR i := 0 TO n-1 DO 81 | FOR j := 0 TO n-1 DO Texts.WriteInt(W, M[i, j], 6) END ; 82 | Texts.WriteLn(W) 83 | END ; 84 | Texts.Append(Oberon.Log, W.buf) 85 | END 86 | END Generate; 87 | 88 | BEGIN Texts.OpenWriter(W) 89 | END MagicSquares. 90 | 91 | ORP.Compile @/s PrimeNumbers.Generate 12 92 | 93 | MODULE PrimeNumbers; (*NW 6.9.07; Tabulate prime numbers; for Oberon-07 NW 25.1.2013*) 94 | IMPORT Texts, Oberon; 95 | 96 | VAR n: INTEGER; 97 | W: Texts.Writer; 98 | p: ARRAY 400 OF INTEGER; 99 | v: ARRAY 20 OF INTEGER; 100 | 101 | PROCEDURE Primes(n: INTEGER); 102 | VAR i, k, m, x, inc, lim, sqr: INTEGER; prim: BOOLEAN; 103 | BEGIN x := 1; inc := 4; lim := 1; sqr := 4; m := 0; 104 | FOR i := 3 TO n DO 105 | REPEAT x := x + inc; inc := 6 - inc; 106 | IF sqr <= x THEN (*sqr = p[lim]^2*) 107 | v[lim] := sqr; INC(lim); sqr := p[lim]*p[lim] 108 | END ; 109 | k := 2; prim := TRUE; 110 | WHILE prim & (k < lim) DO 111 | INC(k);; 112 | IF v[k] < x THEN v[k] := v[k] + p[k] END ; 113 | prim := x # v[k] 114 | END 115 | UNTIL prim; 116 | p[i] := x; Texts.WriteInt(W, x, 5); 117 | IF m = 10 THEN Texts.WriteLn(W); m := 0 ELSE INC(m) END 118 | END ; 119 | IF m > 0 THEN Texts.WriteLn(W) END 120 | END Primes; 121 | 122 | PROCEDURE Generate*; 123 | VAR S: Texts.Scanner; 124 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 125 | IF S.i < 400 THEN 126 | Primes(S.i); Texts.Append(Oberon.Log, W.buf) 127 | END 128 | END Generate; 129 | 130 | BEGIN Texts.OpenWriter(W); 131 | END PrimeNumbers. 132 | 133 | ORP.Compile @/s Fractions.Generate 16 134 | 135 | MODULE Fractions; (*NW 10.10.07; Tabulate fractions 1/n*) 136 | IMPORT Texts, Oberon; 137 | 138 | CONST Base = 10; N = 32; 139 | VAR W: Texts.Writer; 140 | 141 | PROCEDURE Generate*; 142 | VAR i, j, m, r: INTEGER; 143 | d: ARRAY N OF INTEGER; (*digits*) 144 | x: ARRAY N OF INTEGER; (*index*) 145 | S: Texts.Scanner; 146 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 147 | IF (S.class = Texts.Int) & (S.i < N) THEN 148 | i := 2; 149 | WHILE i <= S.i DO j := 0; 150 | WHILE j < i DO x[j] := 0; INC(j) END ; 151 | m := 0; r := 1; 152 | WHILE x[r] = 0 DO 153 | x[r] := m; r := Base*r; d[m] := r DIV i; r := r MOD i; INC(m) 154 | END ; 155 | Texts.WriteInt(W, i, 5); Texts.Write(W, 9X); Texts.Write(W, "."); j := 0; 156 | WHILE j < x[r] DO Texts.Write(W, CHR(d[j] + 48)); INC(j) END ; 157 | Texts.Write(W, "'"); 158 | WHILE j < m DO Texts.Write(W, CHR(d[j] + 48)); INC(j) END ; 159 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); INC(i) 160 | END 161 | END 162 | END Generate; 163 | 164 | BEGIN Texts.OpenWriter(W) 165 | END Fractions. 166 | 167 | ORP.Compile @/s Powers.Generate 16 168 | 169 | MODULE Powers; (*NW 10.10.07; Tabulate positive and negative powers of 2*) 170 | IMPORT Texts, Oberon; 171 | 172 | CONST N = 32; M = 11; (*M ~ N*log2*) 173 | VAR W: Texts.Writer; 174 | 175 | PROCEDURE Generate*; 176 | VAR i, k, n, exp: INTEGER; 177 | c, r, t: INTEGER; 178 | d: ARRAY M OF INTEGER; 179 | f: ARRAY N OF INTEGER; 180 | S: Texts.Scanner; 181 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 182 | IF (S.class = Texts.Int) & (S.i <= N) THEN 183 | n := S.i; d[0] := 1; k := 1; exp := 1; 184 | WHILE exp < n DO 185 | (*compute d = 2^exp*) 186 | c := 0; (*carry*) i := 0; 187 | WHILE i < k DO 188 | t := 2*d[i] + c; 189 | IF t < 10 THEN d[i] := t; c := 0 ELSE d[i] := t - 10; c := 1 END ; 190 | i := i+1 191 | END ; 192 | IF c = 1 THEN d[k] := 1; k := k+1 END ; 193 | (*write d*) i := M; 194 | WHILE i > k DO i := i-1; Texts.Write(W, " ") END ; 195 | WHILE i > 0 DO i := i-1; Texts.Write(W, CHR(d[i] + 30H)) END ; 196 | Texts.WriteInt(W, exp, M); 197 | (*compute f = 2^-exp*) 198 | Texts.WriteString(W, " 0."); r := 0; i := 1; 199 | WHILE i < exp DO 200 | r := 10*r + f[i]; f[i] := r DIV 2; r := r MOD 2; 201 | Texts.Write(W, CHR(f[i] + 30H)); i := i+1 202 | END ; 203 | f[exp] := 5; Texts.Write(W, "5"); Texts.WriteLn(W); exp := exp + 1 204 | END ; 205 | Texts.Append(Oberon.Log, W.buf) 206 | END 207 | END Generate; 208 | 209 | BEGIN Texts.OpenWriter(W) 210 | END Powers. 211 | 212 | ORP.Compile @/s Harmonic.Compute 200 213 | 214 | MODULE Harmonic; (*NW 27.1.2013*) 215 | IMPORT Texts, Oberon; 216 | VAR W: Texts.Writer; 217 | 218 | PROCEDURE Compute*; 219 | VAR n: INTEGER; 220 | x0, x1, u: REAL; 221 | S: Texts.Scanner; 222 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 223 | IF (S.class = Texts.Int) & (S.i > 0) THEN 224 | n := 0; u := 0.0; x0 := 0.0; x1 := 0.0; 225 | WHILE n < S.i DO INC(n); u := u + 1.0; x0 := x0 + 1.0/u END ; 226 | WHILE n > 0 DO x1 := x1 + 1.0/u; u := u - 1.0; DEC(n) END ; 227 | Texts.WriteInt(W, S.i, 6); Texts.WriteReal(W, x0, 15); Texts.WriteReal(W, x1, 15); 228 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 229 | END 230 | END Compute; 231 | 232 | BEGIN Texts.OpenWriter(W) 233 | END Harmonic. 234 | -------------------------------------------------------------------------------- /Sources/Stars.Mod: -------------------------------------------------------------------------------- 1 | MODULE Stars; (*NW 15.1.2013, 15.11.2013*) 2 | IMPORT SYSTEM, Display, Viewers, Texts, Oberon, MenuViewers, TextFrames; 3 | 4 | CONST N = 6; (*nof stars*) 5 | w = 16; (*width of star*) 6 | interval = 200; (*millisec*) 7 | 8 | TYPE Frame = POINTER TO FrameDesc; 9 | Pos = RECORD x, y, dx, dy: INTEGER END ; 10 | FrameDesc = RECORD (Display.FrameDesc) s: ARRAY N OF Pos END ; 11 | RestoreMsg = RECORD (Display.FrameMsg) END ; 12 | StepMsg = RECORD (Display.FrameMsg) END ; 13 | 14 | VAR T: Oberon.Task; 15 | W: Texts.Writer; 16 | 17 | PROCEDURE Draw(x, y: INTEGER); 18 | BEGIN Display.CopyPattern(Display.white, Display.star, x, y, Display.invert) 19 | END Draw; 20 | 21 | PROCEDURE Restore(F: Frame); 22 | VAR x0, y0: INTEGER; 23 | BEGIN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); 24 | Display.ReplConst(0, F.X+1, F.Y, F.W-1, F.H, 0); 25 | x0 := F.W DIV 2 + F.X; y0 := F.H DIV 2 + F.Y; 26 | F.s[0].x := x0; F.s[0].y := y0; F.s[0].dx := 2; F.s[0].dy := 4; Draw(F.s[0].x, F.s[0].y); 27 | F.s[1].x := x0; F.s[1].y := y0; F.s[1].dx := 3; F.s[1].dy := 9; Draw(F.s[1].x, F.s[1].y); 28 | F.s[2].x := x0; F.s[2].y := y0; F.s[2].dx := -5; F.s[2].dy := -2; Draw(F.s[2].x, F.s[2].y); 29 | F.s[3].x := x0; F.s[3].y := y0; F.s[3].dx := -10; F.s[3].dy := 8; Draw(F.s[3].x, F.s[3].y); 30 | F.s[4].x := x0; F.s[4].y := y0; F.s[4].dx := -7; F.s[4].dy := -4; Draw(F.s[4].x, F.s[4].y); 31 | F.s[5].x := x0; F.s[5].y := y0; F.s[5].dx := 8; F.s[5].dy := -10; Draw(F.s[5].x, F.s[5].y) 32 | END Restore; 33 | 34 | PROCEDURE Move(F: Frame; VAR p: Pos); 35 | VAR X1, Y1: INTEGER; 36 | BEGIN X1 := F.X + F.W - w; Y1 := F.Y + F.H - w; 37 | Draw(p.x, p.y); INC(p.x, p.dx); INC(p.y, p.dy); 38 | IF p.x < F.X THEN p.x := 2*F.X - p.x; p.dx := -p.dx ELSIF p.x >= X1 THEN p.x := 2*X1 - p.x; p.dx := -p.dx END ; 39 | IF p.y < F.Y THEN p.y := 2*F.Y - p.y; p.dy := -p.dy ELSIF p.y >= Y1 THEN p.y := 2*Y1 - p.y; p.dy := -p.dy END ; 40 | Draw(p.x, p.y) 41 | END Move; 42 | 43 | PROCEDURE Steps(F: Frame); 44 | VAR i: INTEGER; 45 | BEGIN i := 0; 46 | WHILE i < N DO Move(F, F.s[i]); INC(i) END 47 | END Steps; 48 | 49 | PROCEDURE Handle(F: Display.Frame; VAR M: Display.FrameMsg); 50 | VAR F1: Frame; 51 | BEGIN 52 | CASE F OF Frame: 53 | CASE M OF 54 | Oberon.InputMsg: 55 | IF M(Oberon.InputMsg).id = Oberon.track THEN 56 | Oberon.DrawMouseArrow(M(Oberon.InputMsg).X, M(Oberon.InputMsg).Y) 57 | END 58 | | StepMsg: Steps(F) 59 | | RestoreMsg: Restore(F) 60 | | Oberon.CopyMsg: Oberon.Remove(T); NEW(F1); F1^ := F^; M.F := F1 61 | | MenuViewers.ModifyMsg: 62 | IF (M.Y # F.Y) OR (M.H # F.H) THEN F.Y := M.Y; F.H := M.H; Restore(F) END 63 | END 64 | END 65 | END Handle; 66 | 67 | PROCEDURE Step*; 68 | VAR k: INTEGER; M: StepMsg; 69 | BEGIN 70 | IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN Steps(Oberon.Par.frame.next(Frame)) 71 | ELSE Viewers.Broadcast(M) 72 | END 73 | END Step; 74 | 75 | PROCEDURE Open*; 76 | VAR F: Frame; V: Viewers.Viewer; X, Y: INTEGER; 77 | BEGIN NEW(F); F.handle := Handle; 78 | Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y); 79 | V := MenuViewers.New( 80 | TextFrames.NewMenu("Stars", "Stars.Close System.Grow System.Copy Stars.Step Stars.Run Stars.Stop"), 81 | F, TextFrames.menuH, X, Y) 82 | END Open; 83 | 84 | PROCEDURE Run*; 85 | BEGIN Oberon.Install(T) 86 | END Run; 87 | 88 | PROCEDURE Stop*; 89 | BEGIN Oberon.Remove(T) 90 | END Stop; 91 | 92 | PROCEDURE Close*; 93 | BEGIN 94 | IF Oberon.Par.vwr.dsc = Oberon.Par.frame THEN Stop; Viewers.Close(Oberon.Par.vwr) END 95 | END Close; 96 | 97 | PROCEDURE Step1; 98 | VAR M: StepMsg; 99 | BEGIN Viewers.Broadcast(M) 100 | END Step1; 101 | 102 | PROCEDURE SetPeriod*; 103 | VAR S: Texts.Scanner; 104 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 105 | IF S.class = Texts.Int THEN T.period := S.i END 106 | END SetPeriod; 107 | 108 | BEGIN Texts.OpenWriter(W); T := Oberon.NewTask(Step1, interval); 109 | END Stars. 110 | -------------------------------------------------------------------------------- /Sources/System.Tool: -------------------------------------------------------------------------------- 1 | System.Open ^ System.Recall System.Watch System.Collect 2 | Edit.Open ^ Edit.Recall 3 | Edit.ChangeFont Oberon10i.Scn.Fnt 4 | Edit.ChangeFont Oberon10b.Scn.Fnt 5 | 6 | System.Directory ^ 7 | *.Mod *.Bak *.Tool *.Text *.Scn.Fnt *.smb *.rsc 8 | 9 | ORP.Compile @ ORP.Compile @/s ORP.Compile name~ 10 | System.Free ~ 11 | System.Open Draw.Tool 12 | System.CopyFiles ~ 13 | System.RenameFiles ~ 14 | System.DeleteFiles ~ 15 | 16 | System.ShowModules System.ShowCommands ^ 17 | 18 | PCLink1.Run 19 | Hilbert.Draw Sierpinski.Draw Blink.Run Stars.Open 20 | 21 | Tools.Inspect 0 22 | Tools.Sector 1 23 | Tools.ShowFile 24 | Tools.Recall Tools.Clear 25 | -------------------------------------------------------------------------------- /Sources/Tools.Mod: -------------------------------------------------------------------------------- 1 | MODULE Tools; (*NW 22.2.2014*) 2 | IMPORT SYSTEM, Kernel, Files, Modules, Input, Texts, Viewers, MenuViewers, TextFrames, Oberon; 3 | VAR T: Texts.Text; V: MenuViewers.Viewer; W: Texts.Writer; 4 | 5 | PROCEDURE OpenViewer(T: Texts.Text; title: ARRAY OF CHAR); 6 | VAR X, Y: INTEGER; 7 | BEGIN 8 | Oberon.AllocateUserViewer(0, X, Y); 9 | V := MenuViewers.New( 10 | TextFrames.NewMenu(title, "System.Close System.Copy System.Grow Edit.Search Edit.Store"), 11 | TextFrames.NewText(T, 0), TextFrames.menuH, X, Y) 12 | END OpenViewer; 13 | 14 | PROCEDURE Clear*; (*used to clear output*) 15 | VAR buf: Texts.Buffer; 16 | BEGIN NEW(buf); Texts.OpenBuf(buf); Texts.Delete(T, 0, T.len, buf) 17 | END Clear; 18 | 19 | PROCEDURE Recall*; 20 | VAR M: Viewers.ViewerMsg; 21 | BEGIN 22 | IF (V # NIL) & (V.state = 0) THEN 23 | Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M) 24 | END 25 | END Recall; 26 | 27 | PROCEDURE Inspect*; 28 | VAR m, n, adr, data: INTEGER; 29 | S: Texts.Scanner; 30 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 31 | IF S.class = Texts.Int THEN 32 | adr := S.i DIV 20H * 20H; Texts.Scan(S); 33 | IF S.class = Texts.Int THEN n := S.i ELSE n := 8 END ; 34 | REPEAT DEC(n); Texts.WriteLn(W); Texts.WriteHex(W, adr); Texts.Write(W, 9X); m := 8; 35 | REPEAT SYSTEM.GET(adr, data); INC(adr, 4); Texts.WriteHex(W, data); DEC(m) 36 | UNTIL m = 0 37 | UNTIL n = 0; 38 | Texts.WriteLn(W); Texts.Append(T, W.buf) 39 | END 40 | END Inspect; 41 | 42 | PROCEDURE Sector*; 43 | VAR k, m, n, secno: INTEGER; 44 | S: Texts.Scanner; 45 | buf: ARRAY 256 OF INTEGER; 46 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 47 | IF S.class = Texts.Int THEN 48 | secno := S.i; Texts.Scan(S); 49 | IF S.class = Texts.Int THEN n := S.i ELSE n := 8 END ; 50 | Kernel.GetSector(secno*29, buf); Texts.WriteString(W, "Sector "); Texts.WriteInt(W, S.i, 4); 51 | k := 0; 52 | REPEAT DEC(n); m := 8; Texts.WriteLn(W); Texts.WriteHex(W, k*4); Texts.Write(W, 9X); 53 | REPEAT Texts.WriteHex(W, buf[k]); INC(k); DEC(m) UNTIL m = 0; 54 | UNTIL n = 0; 55 | Texts.WriteLn(W); Texts.Append(T, W.buf) 56 | END 57 | END Sector; 58 | 59 | PROCEDURE ShowFile*; 60 | VAR x, n: INTEGER; 61 | F: Files.File; R: Files.Rider; 62 | S: Texts.Scanner; 63 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 64 | IF S.class = Texts.Name THEN 65 | Texts.WriteString(W, S.s); F := Files.Old(S.s); 66 | IF F # NIL THEN 67 | n := 0; Files.Set(R, F, 0); Files.ReadInt(R, x); 68 | WHILE ~R.eof DO 69 | IF n MOD 20H = 0 THEN Texts.WriteLn(W); Texts.WriteHex(W, n); Texts.Write(W, 9X) END ; 70 | Texts.WriteHex(W, x); INC(n, 4); Files.ReadInt(R, x) 71 | END ; 72 | Texts.WriteHex(W, x) 73 | ELSE Texts.WriteString(W, " not found") 74 | END ; 75 | Texts.WriteLn(W); Texts.Append(T, W.buf) 76 | END 77 | END ShowFile; 78 | 79 | PROCEDURE Convert*; (*convert selected text to txt-format*) 80 | VAR beg, end, time: LONGINT 81 | ; ch: CHAR; 82 | T: Texts.Text; R: Texts.Reader; (*input*) 83 | F: Files.File; Q: Files.Rider; (*output*) 84 | S: Texts.Scanner; 85 | BEGIN Oberon.GetSelection(T, beg, end, time); 86 | IF time >= 0 THEN 87 | Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 88 | Texts.WriteString(W, "converting to "); Texts.WriteString(W, S.s); 89 | F := Files.New(S.s); Files.Set(Q, F, 0); Texts.OpenReader(R, T, beg); Texts.Read(R, ch); 90 | WHILE ~R.eot DO 91 | IF ch = 0DX THEN Files.Write(Q, 0DX); Files.Write(Q, 0AX) 92 | ELSIF ch = 9X THEN (*TAB*) Files.Write(Q, " "); Files.Write(Q, " ") 93 | ELSE Files.Write(Q, ch) 94 | END ; 95 | Texts.Read(R, ch) 96 | END ; 97 | Files.Register(F); Texts.WriteString(W, " done") 98 | ELSE Texts.WriteString(W, " not found") 99 | END ; 100 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S) 101 | END Convert; 102 | 103 | PROCEDURE Id*; 104 | BEGIN Texts.WriteHex(W, SYSTEM.H(1)); Texts.WriteLn(W); Texts.Append(T, W.buf) 105 | END Id; 106 | 107 | BEGIN Texts.OpenWriter(W); T := TextFrames.Text(""); OpenViewer(T, "Tools.Text") 108 | END Tools. 109 | 110 | Tools.Clear (clear tool viewer) 111 | Tools.Recall (recall closed tool viewer) 112 | Tools.Inspect adr len 113 | Tools.Sector secno 114 | Tools.ShowFile filename (in hex) 115 | Tools.Convert filename (selected text to txt-format) 116 | Tools.Id (processor id) 117 | -------------------------------------------------------------------------------- /Sources/Viewers.Mod: -------------------------------------------------------------------------------- 1 | MODULE Viewers; (*JG 14.9.90 / NW 15.9.2013*) 2 | IMPORT Display; 3 | 4 | CONST restore* = 0; modify* = 1; suspend* = 2; (*message ids*) 5 | inf = 65535; 6 | 7 | TYPE Viewer* = POINTER TO ViewerDesc; 8 | ViewerDesc* = RECORD (Display.FrameDesc) state*: INTEGER END; 9 | 10 | (*state > 1: displayed; state = 1: filler; state = 0: closed; state < 0: suspended*) 11 | 12 | ViewerMsg* = RECORD (Display.FrameMsg) 13 | id*: INTEGER; 14 | X*, Y*, W*, H*: INTEGER; 15 | state*: INTEGER 16 | END; 17 | 18 | Track = POINTER TO TrackDesc; 19 | TrackDesc = RECORD (ViewerDesc) under: Display.Frame END; 20 | 21 | VAR curW*, minH*, DH: INTEGER; 22 | FillerTrack: Track; FillerViewer, 23 | backup: Viewer; (*last closed viewer*) 24 | 25 | PROCEDURE Open* (V: Viewer; X, Y: INTEGER); 26 | VAR T, u, v: Display.Frame; M: ViewerMsg; 27 | BEGIN 28 | IF (V.state = 0) & (X < inf) THEN 29 | IF Y > DH THEN Y := DH END; 30 | T := FillerTrack.next; 31 | WHILE X >= T.X + T.W DO T := T.next END; 32 | u := T.dsc; v := u.next; 33 | WHILE Y > v.Y + v.H DO u := v; v := u.next END; 34 | IF Y < v.Y + minH THEN Y := v.Y + minH END; 35 | IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN 36 | V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H; 37 | M.id := suspend; M.state := 0; 38 | v.handle(v, M); v(Viewer).state := 0; 39 | V.next := v.next; u.next := V; V.state := 2 40 | ELSE V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y; 41 | M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y; 42 | v.handle(v, M); v.Y := M.Y; v.H := M.H; 43 | V.next := v; u.next := V; V.state := 2 44 | END 45 | END 46 | END Open; 47 | 48 | PROCEDURE Change* (V: Viewer; Y: INTEGER); 49 | VAR v: Display.Frame; M: ViewerMsg; 50 | BEGIN 51 | IF V.state > 1 THEN 52 | IF Y > DH THEN Y := DH END; 53 | v := V.next; 54 | IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN Y := v.Y + v.H - minH END; 55 | IF Y >= V.Y + minH THEN 56 | M.id := modify; M.Y := Y; M.H := v.Y + v.H - Y; 57 | v.handle(v, M); v.Y := M.Y; v.H := M.H; V.H := Y - V.Y 58 | END 59 | END 60 | END Change; 61 | 62 | PROCEDURE RestoreTrack (S: Display.Frame); 63 | VAR T, t, v: Display.Frame; M: ViewerMsg; 64 | BEGIN t := S.next; 65 | WHILE t.next # S DO t := t.next END; 66 | T := S(Track).under; 67 | WHILE T.next # NIL DO T := T.next END; 68 | t.next := S(Track).under; T.next := S.next; M.id := restore; 69 | REPEAT t := t.next; v := t.dsc; 70 | REPEAT v := v.next; v.handle(v, M); v(Viewer).state := - v(Viewer).state 71 | UNTIL v = t.dsc 72 | UNTIL t = T 73 | END RestoreTrack; 74 | 75 | PROCEDURE Close* (V: Viewer); 76 | VAR T, U: Display.Frame; M: ViewerMsg; 77 | BEGIN 78 | IF V.state > 1 THEN 79 | U := V.next; T := FillerTrack; 80 | REPEAT T := T.next UNTIL V.X < T.X + T.W; 81 | IF (T(Track).under = NIL) OR (U.next # V) THEN 82 | M.id := suspend; M.state := 0; 83 | V.handle(V, M); V.state := 0; backup := V; 84 | M.id := modify; M.Y := V.Y; M.H := V.H + U.H; 85 | U.handle(U, M); U.Y := M.Y; U.H := M.H; 86 | WHILE U.next # V DO U := U.next END; 87 | U.next := V.next 88 | ELSE (*close track*) 89 | M.id := suspend; M.state := 0; 90 | V.handle(V, M); V.state := 0; backup := V; 91 | U.handle(U, M); U(Viewer).state := 0; 92 | RestoreTrack(T) 93 | END 94 | END 95 | END Close; 96 | 97 | PROCEDURE Recall* (VAR V: Viewer); 98 | BEGIN V := backup 99 | END Recall; 100 | 101 | PROCEDURE This* (X, Y: INTEGER): Viewer; 102 | VAR T, V: Display.Frame; 103 | BEGIN 104 | IF (X < inf) & (Y < DH) THEN 105 | T := FillerTrack; 106 | REPEAT T := T.next UNTIL X < T.X + T.W; 107 | V := T.dsc; 108 | REPEAT V := V.next UNTIL Y < V.Y + V.H 109 | ELSE V := NIL 110 | END ; 111 | RETURN V(Viewer) 112 | END This; 113 | 114 | PROCEDURE Next* (V: Viewer): Viewer; 115 | BEGIN RETURN V.next(Viewer) 116 | END Next; 117 | 118 | PROCEDURE Locate* (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame); 119 | VAR T, V: Display.Frame; 120 | BEGIN 121 | IF X < inf THEN 122 | T := FillerTrack; 123 | REPEAT T := T.next UNTIL X < T.X + T.W; 124 | fil := T.dsc; bot := fil.next; 125 | IF bot.next # fil THEN 126 | alt := bot.next; V := alt.next; 127 | WHILE (V # fil) & (alt.H < H) DO 128 | IF V.H > alt.H THEN alt := V END; 129 | V := V.next 130 | END 131 | ELSE alt := bot 132 | END; 133 | max := T.dsc; V := max.next; 134 | WHILE V # fil DO 135 | IF V.H > max.H THEN max := V END; 136 | V := V.next 137 | END 138 | END 139 | END Locate; 140 | 141 | PROCEDURE InitTrack* (W, H: INTEGER; Filler: Viewer); 142 | VAR S: Display.Frame; T: Track; 143 | BEGIN 144 | IF Filler.state = 0 THEN 145 | Filler.X := curW; Filler.W := W; Filler.Y := 0; Filler.H := H; 146 | Filler.state := 1; Filler.next := Filler; 147 | NEW(T); T.X := curW; T.W := W; T.Y := 0; T.H := H; T.dsc := Filler; T.under := NIL; 148 | FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X; 149 | FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W; 150 | S := FillerTrack; 151 | WHILE S.next # FillerTrack DO S := S.next END; 152 | S.next := T; T.next := FillerTrack; curW := curW + W 153 | END 154 | END InitTrack; 155 | 156 | PROCEDURE OpenTrack* (X, W: INTEGER; Filler: Viewer); 157 | VAR newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg; v0: Viewer; 158 | BEGIN 159 | IF (X < inf) & (Filler.state = 0) THEN 160 | S := FillerTrack; T := S.next; 161 | WHILE X >= T.X + T.W DO S := T; T := S.next END; 162 | WHILE X + W > T.X + T.W DO T := T.next END; 163 | M.id := suspend; t := S; 164 | REPEAT t := t.next; v := t.dsc; 165 | REPEAT v := v.next; M.state := -v(Viewer).state; v.handle(v, M); v(Viewer).state := M.state 166 | UNTIL v = t.dsc 167 | UNTIL t = T; 168 | Filler.X := S.next.X; Filler.W := T.X + T.W - S.next.X; Filler.Y := 0; Filler.H := DH; 169 | Filler.state := 1; Filler.next := Filler; 170 | NEW(newT); newT.X := Filler.X; newT.W := Filler.W; newT.Y := 0; newT.H := DH; 171 | newT.dsc := Filler; newT.under := S.next; S.next := newT; 172 | newT.next := T.next; T.next := NIL 173 | END 174 | END OpenTrack; 175 | 176 | PROCEDURE CloseTrack* (X: INTEGER); 177 | VAR T, V: Display.Frame; M: ViewerMsg; 178 | BEGIN 179 | IF X < inf THEN 180 | T := FillerTrack; 181 | REPEAT T := T.next UNTIL X < T.X + T.W; 182 | IF T(Track).under # NIL THEN 183 | M.id := suspend; M.state := 0; V := T.dsc; 184 | REPEAT V := V.next; V.handle(V, M); V(Viewer).state := 0 UNTIL V = T.dsc; 185 | RestoreTrack(T) 186 | END 187 | END 188 | END CloseTrack; 189 | 190 | PROCEDURE Broadcast* (VAR M: Display.FrameMsg); 191 | VAR T, V: Display.Frame; 192 | BEGIN T := FillerTrack.next; 193 | WHILE T # FillerTrack DO 194 | V := T.dsc; 195 | REPEAT V := V.next; V.handle(V, M) UNTIL V = T.dsc; 196 | T := T.next 197 | END 198 | END Broadcast; 199 | 200 | BEGIN backup := NIL; curW := 0; minH := 1; DH := Display.Height; 201 | NEW(FillerViewer); FillerViewer.X := 0; FillerViewer.W := inf; FillerViewer.Y := 0; FillerViewer.H := DH; 202 | FillerViewer.next := FillerViewer; 203 | NEW(FillerTrack); 204 | FillerTrack.X := 0; FillerTrack.W := inf; FillerTrack.Y := 0; FillerTrack.H := DH; 205 | FillerTrack.dsc := FillerViewer; FillerTrack.next := FillerTrack 206 | END Viewers. 207 | -------------------------------------------------------------------------------- /SourcesVerilog/Divider.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 20.9.2015 2 | 3 | module Divider( 4 | input clk, run, u, 5 | output stall, 6 | input [31:0] x, y, // y > 0 7 | output [31:0] quot, rem); 8 | 9 | reg [5:0] S; // state 10 | reg [63:0] RQ; 11 | wire sign; 12 | wire [31:0] x0, w0, w1; 13 | 14 | assign stall = run & ~(S == 33); 15 | assign sign = x[31] & u; 16 | assign x0 = sign ? -x : x; 17 | assign w0 = RQ[62: 31]; 18 | assign w1 = w0 - y; 19 | assign quot = ~sign ? RQ[31:0] : 20 | (RQ[63:32] == 0) ? -RQ[31:0] : -RQ[31:0] - 1; 21 | assign rem = ~sign ? RQ[63:32] : 22 | (RQ[63:32] == 0) ? 0 : y - RQ[63:32]; 23 | 24 | always @ (posedge(clk)) begin 25 | RQ <= (S == 0) ? {32'b0, x0} : {(w1[31] ? w0 : w1), RQ[30:0], ~w1[31]}; 26 | S <= run ? S+1 : 0; 27 | end 28 | endmodule 29 | -------------------------------------------------------------------------------- /SourcesVerilog/Divider0.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 31.10.10 2 | 3 | module Divider( 4 | input clk, run, 5 | output stall, 6 | input [31:0] x, y, // x >= 0, y > 0 7 | output [31:0] quot, rem); 8 | 9 | reg [4:0] S; // state 10 | reg [31:0] R, Q; 11 | wire [31:0] r0, r1, r2, q0, q1, d; 12 | 13 | assign stall = run & ~(S == 31); 14 | assign r0 = (S == 0) ? 0 : R; 15 | assign d = r1 - y; 16 | assign r1 = {r0[30:0], q0[31]}; 17 | assign r2 = d[31] ? r1 : d; 18 | assign q0 = (S == 0) ? x : Q; 19 | assign q1 = {q0[30:0], ~d[31]}; 20 | assign rem = r2; 21 | assign quot = q1; 22 | 23 | always @ (posedge(clk)) begin 24 | R <= r2; Q <= q1; 25 | S <= run ? S+1 : 0; 26 | end 27 | 28 | endmodule 29 | -------------------------------------------------------------------------------- /SourcesVerilog/FPAdder.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 20.9.2015 pipelined 2 | // u = 1: FLT; v = 1: FLOOR 3 | 4 | module FPAdder( 5 | input clk, run, u, v, 6 | input [31:0] x, y, 7 | output stall, 8 | output [31:0] z); 9 | 10 | reg [1:0] State; 11 | 12 | wire xs, ys; // signs 13 | wire [7:0] xe, ye; 14 | wire [24:0] xm, ym; 15 | 16 | wire [8:0] dx, dy, e0, e1; 17 | wire [7:0] sx, sy; // shift counts 18 | wire [1:0] sx0, sx1, sy0, sy1; 19 | wire sxh, syh; 20 | wire [24:0] x0, x1, x2, y0, y1, y2; 21 | reg [24:0] x3, y3; 22 | 23 | reg [26:0] Sum; 24 | wire [26:0] s; 25 | 26 | wire z24, z22, z20, z18, z16, z14, z12, z10, z8, z6, z4, z2; 27 | wire [4:0] sc; // shift count 28 | wire [1:0] sc0, sc1; 29 | wire [24:0] t1, t2; 30 | reg [24:0] t3; 31 | 32 | assign xs = x[31]; // sign x 33 | assign xe = u ? 8'h96 : x[30:23]; // expo x 34 | assign xm = {~u|x[23], x[22:0], 1'b0}; //mant x 35 | assign ys = y[31]; // sign y 36 | assign ye = y[30:23]; // expo y 37 | assign ym = {~u&~v, y[22:0], 1'b0}; //mant y 38 | 39 | assign dx = xe - ye; 40 | assign dy = ye - xe; 41 | assign e0 = (dx[8]) ? ye : xe; 42 | assign sx = dy[8] ? 0 : dy; 43 | assign sy = dx[8] ? 0 : dx; 44 | assign sx0 = sx[1:0]; 45 | assign sx1 = sx[3:2]; 46 | assign sy0 = sy[1:0]; 47 | assign sy1 = sy[3:2]; 48 | assign sxh = sx[7] | sx[6] | sx[5]; 49 | assign syh = sy[7] | sy[6] | sy[5]; 50 | 51 | // denormalize, shift right 52 | assign x0 = xs&~u ? -xm : xm; 53 | assign x1 = (sx0 == 3) ? {{3{xs}}, x0[24:3]} : 54 | (sx0 == 2) ? {{2{xs}}, x0[24:2]} : (sx0 == 1) ? {xs, x0[24:1]} : x0; 55 | assign x2 = (sx1 == 3) ? {{12{xs}}, x1[24:12]} : 56 | (sx1 == 2) ? {{8{xs}}, x1[24:8]} : (sx1 == 1) ? {{4{xs}}, x1[24:4]} : x1; 57 | always @ (posedge(clk)) 58 | x3 <= sxh ? {25{xs}} : (sx[4] ? {{16{xs}}, x2[24:16]} : x2); 59 | 60 | assign y0 = ys&~u ? -ym : ym; 61 | assign y1 = (sy0 == 3) ? {{3{ys}}, y0[24:3]} : 62 | (sy0 == 2) ? {{2{ys}}, y0[24:2]} : (sy0 == 1) ? {ys, y0[24:1]} : y0; 63 | assign y2 = (sy1 == 3) ? {{12{ys}}, y1[24:12]} : 64 | (sy1 == 2) ? {{8{ys}}, y1[24:8]} : (sy1 == 1) ? {{4{ys}}, y1[24:4]} : y1; 65 | always @ (posedge(clk)) 66 | y3 <= syh ? {25{ys}} : (sy[4] ? {{16{ys}}, y2[24:16]} : y2); 67 | 68 | // add 69 | always @ (posedge(clk)) Sum <= {xs, xs, x3} + {ys, ys, y3}; 70 | assign s = (Sum[26] ? -Sum : Sum) + 1; 71 | 72 | // post-normalize 73 | assign z24 = ~s[25] & ~ s[24]; 74 | assign z22 = z24 & ~s[23] & ~s[22]; 75 | assign z20 = z22 & ~s[21] & ~s[20]; 76 | assign z18 = z20 & ~s[19] & ~s[18]; 77 | assign z16 = z18 & ~s[17] & ~s[16]; 78 | assign z14 = z16 & ~s[15] & ~s[14]; 79 | assign z12 = z14 & ~s[13] & ~s[12]; 80 | assign z10 = z12 & ~s[11] & ~s[10]; 81 | assign z8 = z10 & ~s[9] & ~s[8]; 82 | assign z6 = z8 & ~s[7] & ~s[6]; 83 | assign z4 = z6 & ~s[5] & ~s[4]; 84 | assign z2 = z4 & ~s[3] & ~s[2]; 85 | 86 | assign sc[4] = z10; // sc = shift count of post normalization 87 | assign sc[3] = z18 & (s[17] | s[16] | s[15] | s[14] | s[13] | s[12] | s[11] | s[10]) 88 | | z2; 89 | assign sc[2] = z22 & (s[21] | s[20] | s[19] | s[18]) 90 | | z14 & (s[13] | s[12] | s[11] | s[10]) 91 | | z6 & (s[5] | s[4] | s[3] | s[2]); 92 | assign sc[1] = z24 & (s[23] | s[22]) 93 | | z20 & (s[19] | s[18]) 94 | | z16 & (s[15] | s[14]) 95 | | z12 & (s[11] | s[10]) 96 | | z8 & (s[7] | s[6]) 97 | | z4 & (s[3] | s[2]); 98 | assign sc[0] = ~s[25] & s[24] 99 | | z24 & ~s[23] & s[22] 100 | | z22 & ~s[21] & s[20] 101 | | z20 & ~s[19] & s[18] 102 | | z18 & ~s[17] & s[16] 103 | | z16 & ~s[15] & s[14] 104 | | z14 & ~s[13] & s[12] 105 | | z12 & ~s[11] & s[10] 106 | | z10 & ~s[9] & s[8] 107 | | z8 & ~s[7] & s[6] 108 | | z6 & ~s[5] & s[4] 109 | | z4 & ~s[3] & s[2]; 110 | 111 | assign e1 = e0 - sc + 1; 112 | assign sc0 = sc[1:0]; 113 | assign sc1 = sc[3:2]; 114 | 115 | assign t1 = (sc0 == 3) ? {s[22:1], 3'b0} : 116 | (sc0 == 2) ? {s[23:1], 2'b0} : (sc0 == 1) ? {s[24:1], 1'b0} : s[25:1]; 117 | assign t2 = (sc1 == 3) ? {t1[12:0], 12'b0} : 118 | (sc1 == 2) ? {t1[16:0], 8'b0} : (sc1 == 1) ? {t1[20:0], 4'b0} : t1; 119 | always @ (posedge(clk)) t3 <= sc[4] ? {t2[8:0], 16'b0} : t2; 120 | 121 | assign stall = run & ~(State == 3); 122 | always @ (posedge(clk)) State <= run ? State + 1 : 0; 123 | 124 | assign z = v ? {{7{Sum[26]}}, Sum[25:1]} : // FLOOR 125 | (x[30:0] == 0) ? (~u ? y : 0) : 126 | (y[30:0] == 0) ? x : 127 | ((t3 == 0) | e1[8]) ? 0 : 128 | {Sum[26], e1[7:0], t3[23:1]}; 129 | endmodule 130 | 131 | -------------------------------------------------------------------------------- /SourcesVerilog/FPDivider.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 18.9.2015 2 | 3 | module FPDivider( 4 | input clk, run, 5 | input [31:0] x, 6 | input [31:0] y, 7 | output stall, 8 | output [31:0] z); 9 | 10 | reg [4:0] S; // state 11 | reg [23:0] R; 12 | reg [24:0] Q; 13 | 14 | wire sign; 15 | wire [7:0] xe, ye; 16 | wire [8:0] e0, e1; 17 | wire [24:0] r0, r1, d, q0; 18 | wire [23:0] z0; 19 | 20 | assign sign = x[31]^y[31]; 21 | assign xe = x[30:23]; 22 | assign ye = y[30:23]; 23 | assign e0 = {1'b0, xe} - {1'b0, ye}; 24 | assign e1 = e0 + 126 + Q[24]; 25 | assign stall = run & ~(S == 25); 26 | 27 | assign r0 = (S == 0) ? {2'b1, x[22:0]} : {R, 1'b0}; 28 | assign d = r0 - {2'b1, y[22:0]}; 29 | assign r1 = d[24] ? r0 : d; 30 | assign q0 = (S == 0) ? 0 : Q; 31 | 32 | assign z0 = Q[24] ? Q[24:1] : Q[23:0]; 33 | assign z = (xe == 0) ? 0 : 34 | (ye == 0) ? {sign, 8'b11111111, 23'b0} : 35 | (~e1[8]) ? {sign, e1[7:0], z0[22:0]} : 36 | (~e1[7]) ? {sign, 8'b11111111, z0[22:0]} : 0; 37 | 38 | always @ (posedge(clk)) begin 39 | R <= r1[23:0]; 40 | Q <= {q0[23:0], ~d[24]}; 41 | S <= run ? S+1 : 0; 42 | end 43 | endmodule 44 | -------------------------------------------------------------------------------- /SourcesVerilog/FPMultiplier.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 15.9.2015 2 | module FPMultiplier( 3 | input clk, run, 4 | input [31:0] x, y, 5 | output stall, 6 | output [31:0] z); 7 | 8 | reg [4:0] S; // state 9 | reg [47:0] P; // product 10 | 11 | wire sign; 12 | wire [7:0] xe, ye; 13 | wire [8:0] e0, e1; 14 | wire [23:0] w0, z0; 15 | wire [24:0] w1; 16 | 17 | assign sign = x[31] ^ y[31]; 18 | assign xe = x[30:23]; 19 | assign ye = y[30:23]; 20 | assign e0 = xe + ye; 21 | assign e1 = e0 - 127 + P[47]; 22 | 23 | assign stall = run & ~(S == 25); 24 | assign w0 = P[0] ? {1'b1, y[22:0]} : 0; 25 | assign w1 = {1'b0, P[47:24]} + {1'b0, w0}; 26 | assign z0 = P[47] ? P[47:24] : P[46:23]; 27 | assign z = (xe == 0) | (ye == 0) ? 0 : 28 | (~e1[8]) ? {sign, e1[7:0], z0[22:0]} : 29 | (~e1[7]) ? {sign, 8'b11111111, z0[22:0]} : 0; 30 | always @ (posedge(clk)) begin 31 | P <= (S == 0) ? {24'b0, 1'b1, x[22:0]} : {w1, P[23:1]}; 32 | S <= run ? S+1 : 0; 33 | end 34 | endmodule 35 | -------------------------------------------------------------------------------- /SourcesVerilog/MouseP.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // PS/2 Logitech mouse PDR 14.10.2013 / 8.9.2015 2 | module MouseP( 3 | input clk, rst, 4 | inout msclk, msdat, 5 | output [27:0] out); 6 | 7 | reg [9:0] x, y; 8 | reg [2:0] btns; 9 | reg Q0, Q1, run; 10 | reg [31:0] shreg; 11 | wire shift, endbit, reply; 12 | wire [9:0] dx, dy; 13 | 14 | // 3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 bit 15 | // 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 16 | // =============================================================== 17 | // p y y y y y y y y 0 1 p x x x x x x x x 0 1 p Y X t s 1 M R L 0 normal 18 | // --------------------------------------------------------------- 19 | // p ----response--- 0 1 --InitBuf echoed--- 1 1 1 1 1 1 1 1 1 1 1 init 20 | // --------------------------------------------------------------- 21 | // p = parity (ignored); X, Y = overflow; s, t = x, y sign bits 22 | 23 | // initially need to send F4 cmd (start reporting); add start and parity bits 24 | localparam InitBuf = 32'b11111111111111111111110_11110100_0; 25 | assign msclk = ~rst ? 0 : 1'bz; // initial drive clock low 26 | assign msdat = ~run & ~shreg[0] ? 0 : 1'bz; 27 | assign shift = Q1 & ~Q0; // falling edge detector 28 | assign reply = ~run & ~shreg[11]; // start bit of echoed InitBuf, if response 29 | assign endbit = run & ~shreg[0]; // normal packet received 30 | assign dx = {{2{shreg[5]}}, shreg[7] ? 8'b0 : shreg[19:12]}; //sign+overfl 31 | assign dy = {{2{shreg[6]}}, shreg[8] ? 8'b0 : shreg[30:23]}; //sign+overfl 32 | assign out = {run, btns, 2'b0, y, 2'b0, x}; 33 | 34 | always @ (posedge clk) begin 35 | run <= rst & (reply | run); Q0 <= msclk; Q1 <= Q0; 36 | shreg <= ~rst ? InitBuf : (endbit | reply) ? -1 : shift ? {msdat, 37 | shreg[31:1]} : shreg; 38 | x <= ~rst ? 0 : endbit ? x + dx : x; y <= ~rst ? 0 : endbit ? y + dy 39 | : y; 40 | btns <= ~rst ? 0 : endbit ? {shreg[1], shreg[3], shreg[2]} : btns; 41 | end 42 | 43 | endmodule 44 | 45 | -------------------------------------------------------------------------------- /SourcesVerilog/MouseX.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps 2 | // N.Wirth 10.10.2012 3 | module MouseX( 4 | input clk, 5 | input [6:0] in, 6 | output [27:0] out); 7 | 8 | reg x00, x01, x10, x11, y00, y01, y10, y11; 9 | reg ML, MM, MR; // keys 10 | reg [9:0] x, y; // counters 11 | 12 | wire xup, xdn, yup, ydn; 13 | 14 | assign xup = ~x00&~x01&~x10&x11 | ~x00&x01&x10&x11 | x00&~x01&~x10&~x11 | x00&x01&x10&~x11; 15 | assign yup = ~y00&~y01&~y10&y11 | ~y00&y01&y10&y11 | y00&~y01&~y10&~y11 | y00&y01&y10&~y11; 16 | assign xdn = ~x00&~x01&x10&~x11 | ~x00&x01&~x10&~x11 | x00&~x01&x10&x11 | x00&x01&~x10&x11; 17 | assign ydn = ~y00&~y01&y10&~y11 | ~y00&y01&~y10&~y11 | y00&~y01&y10&y11 | y00&y01&~y10&y11; 18 | assign out = {1'b0, ML, MM, MR, 2'b0, y, 2'b0, x}; 19 | 20 | always @ (posedge clk) begin 21 | x00 <= in[3]; x01 <= x00; x10 <= in[2]; x11 <= x10; 22 | y00 <= in[1]; y01 <= y00; y10 <= in[0]; y11 <= y10; 23 | MR <= ~in[4]; MM <= ~in[5]; ML <= ~in[6]; 24 | x <= xup ? x+1 : xdn ? x-1 : x; 25 | y <= yup ? y+1 : ydn ? y-1 : y; 26 | end 27 | endmodule 28 | 29 | -------------------------------------------------------------------------------- /SourcesVerilog/Multiplier.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 14.9.2015 2 | 3 | module Multiplier( 4 | input clk, run, u, 5 | output stall, 6 | input [31:0] x, y, 7 | output [63:0] z); 8 | 9 | reg [5:0] S; // state 10 | reg [63:0] P; // product 11 | wire [31:0] w0; 12 | wire [32:0] w1; 13 | 14 | assign stall = run & ~(S == 33); 15 | assign w0 = P[0] ? y : 0; 16 | assign w1 = (S == 32) & u ? {P[63], P[63:32]} - {w0[31], w0} : 17 | {P[63], P[63:32]} + {w0[31], w0}; 18 | assign z = P; 19 | 20 | always @ (posedge(clk)) begin 21 | P <= (S == 0) ? {32'b0, x} : {w1[32:0], P[31:1]}; 22 | S <= run ? S+1 : 0; 23 | end 24 | 25 | endmodule 26 | -------------------------------------------------------------------------------- /SourcesVerilog/Multiplier1.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 29.4.2011 2 | module Multiplier1( 3 | input clk, run, u, 4 | output stall, 5 | input [31:0] x, y, 6 | output [63:0] z); 7 | 8 | reg S; // state 9 | reg [15:0] z0; 10 | reg [47:0] z1, z2; 11 | wire [35:0] p0, p1, p2, p3; 12 | 13 | assign stall = run & ~S; 14 | assign z[15:0] = z0; 15 | assign z[63:16] = z1 + z2; 16 | 17 | MULT18X18 mult0(.P(p0), .A({2'b0, x[15:0]}), .B({2'b0, y[15:0]})); 18 | MULT18X18 mult1(.P(p1), .A({{2{u&x[31]}}, x[31:16]}), .B({2'b0, y[15:0]})); 19 | MULT18X18 mult2(.P(p2), .A({2'b0, x[15:0]}), .B({{2{u&y[31]}}, y[31:16]})); 20 | MULT18X18 mult3(.P(p3), .A({{2{u&x[31]}}, x[31:16]}), .B({{2{u&y[31]}}, y[31:16]})); 21 | 22 | always @(posedge clk) begin 23 | S <= stall; 24 | z0 <= p0[15:0]; 25 | z1 <= {{32'b0}, p0[31:16]} + {{16{u&p1[31]}}, p1[31:0]}; 26 | z2 <= {{16{u&p2[31]}}, p2[31:0]} + {p3[31:0], 16'b0}; 27 | end 28 | endmodule 29 | -------------------------------------------------------------------------------- /SourcesVerilog/PROM.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // 32-bit PROM initialised from hex file PDR 23.12.13 2 | 3 | module PROM (input clk, 4 | input [8:0] adr, 5 | output reg [31:0] data); 6 | 7 | reg [31:0] mem [511: 0]; 8 | initial $readmemh("../prom.mem", mem); 9 | always @(posedge clk) data <= mem[adr]; 10 | 11 | endmodule 12 | 13 | -------------------------------------------------------------------------------- /SourcesVerilog/PS2.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 20.10.2012 2 | // PS2 receiver for keyboard, 8 bit data 3 | // clock is 25 MHz; 25000 / 1302 = 19.2 KHz 4 | 5 | module PS2( 6 | input clk, rst, 7 | input done, // "byte has been read" 8 | output rdy, // "byte is available" 9 | output shift, // shift in, tramsmitter 10 | output [7:0] data, 11 | input PS2C, // serial input 12 | input PS2D); 13 | 14 | reg Q0, Q1; // synchronizer and falling edge detector 15 | reg [10:0] shreg; 16 | reg [3:0] inptr, outptr; 17 | reg [7:0] fifo [15:0]; // 16 byte buffer 18 | wire endbit; 19 | 20 | assign endbit = ~shreg[0]; //start bit reached correct pos 21 | assign shift = Q1 & ~Q0; 22 | assign data = fifo[outptr]; 23 | assign rdy = ~(inptr == outptr); 24 | 25 | always @ (posedge clk) begin 26 | Q0 <= PS2C; Q1 <= Q0; 27 | shreg <= (~rst | endbit) ? 11'h7FF : 28 | shift ? {PS2D, shreg[10:1]} : shreg; 29 | outptr <= ~rst ? 0 : rdy & done ? outptr+1 : outptr; 30 | inptr <= ~rst ? 0 : endbit ? inptr+1 : inptr; 31 | if (endbit) fifo[inptr] <= shreg[8:1]; 32 | end 33 | endmodule 34 | -------------------------------------------------------------------------------- /SourcesVerilog/RISC5.ucf: -------------------------------------------------------------------------------- 1 | NET "CLK50M" LOC = "T9" ; 2 | 3 | NET "TxD" LOC = "R13"; 4 | NET "RxD" LOC = "T13"; 5 | 6 | NET "btn[0]" LOC = "M13"; 7 | NET "btn[1]" LOC = "M14"; 8 | NET "btn[2]" LOC = "L13"; 9 | NET "btn[3]" LOC = "L14"; 10 | 11 | NET "swi[0]" LOC = "F12"; 12 | NET "swi[1]" LOC = "G12"; 13 | NET "swi[2]" LOC = "H14"; 14 | NET "swi[3]" LOC = "H13"; 15 | NET "swi[4]" LOC = "J14"; 16 | NET "swi[5]" LOC = "J13"; 17 | NET "swi[6]" LOC = "K14"; 18 | NET "swi[7]" LOC = "K13"; 19 | 20 | NET "leds[0]" LOC = "K12"; 21 | NET "leds[1]" LOC = "P14"; 22 | NET "leds[2]" LOC = "L12"; 23 | NET "leds[3]" LOC = "N14"; 24 | NET "leds[4]" LOC = "P13"; 25 | NET "leds[5]" LOC = "N12"; 26 | NET "leds[6]" LOC = "P12"; 27 | NET "leds[7]" LOC = "P11"; 28 | 29 | # SRAM 30 | NET "SRce0" LOC = "P7"; 31 | NET "SRce1" LOC = "N5"; 32 | NET "SRwe" LOC = "G3"; 33 | NET "SRoe" LOC = "K4"; 34 | NET "SRbe[0]" LOC = "P6"; 35 | NET "SRbe[1]" LOC = "T4"; 36 | NET "SRbe[2]" LOC = "P5"; 37 | NET "SRbe[3]" LOC = "R4"; 38 | NET "SRadr[0]" LOC = "L5"; 39 | NET "SRadr[1]" LOC = "N3"; 40 | NET "SRadr[2]" LOC = "M4"; 41 | NET "SRadr[3]" LOC = "M3"; 42 | NET "SRadr[4]" LOC = "L4"; 43 | NET "SRadr[5]" LOC = "G4"; 44 | NET "SRadr[6]" LOC = "F3"; 45 | NET "SRadr[7]" LOC = "F4"; 46 | NET "SRadr[8]" LOC = "E3"; 47 | NET "SRadr[9]" LOC = "E4"; 48 | NET "SRadr[10]" LOC = "G5"; 49 | NET "SRadr[11]" LOC = "H3"; 50 | NET "SRadr[12]" LOC = "H4"; 51 | NET "SRadr[13]" LOC = "J4"; 52 | NET "SRadr[14]" LOC = "J3"; 53 | NET "SRadr[15]" LOC = "K3"; 54 | NET "SRadr[16]" LOC = "K5"; 55 | NET "SRadr[17]" LOC = "L3"; 56 | NET "SRdat[0]" LOC = "N7"; 57 | NET "SRdat[1]" LOC = "T8"; 58 | NET "SRdat[2]" LOC = "R6"; 59 | NET "SRdat[3]" LOC = "T5"; 60 | NET "SRdat[4]" LOC = "R5"; 61 | NET "SRdat[5]" LOC = "C2"; 62 | NET "SRdat[6]" LOC = "C1"; 63 | NET "SRdat[7]" LOC = "B1"; 64 | NET "SRdat[8]" LOC = "D3"; 65 | NET "SRdat[9]" LOC = "P8"; 66 | NET "SRdat[10]" LOC = "F2"; 67 | NET "SRdat[11]" LOC = "H1"; 68 | NET "SRdat[12]" LOC = "J2"; 69 | NET "SRdat[13]" LOC = "L2"; 70 | NET "SRdat[14]" LOC = "P1"; 71 | NET "SRdat[15]" LOC = "R1"; 72 | NET "SRdat[16]" LOC = "P2"; 73 | NET "SRdat[17]" LOC = "N2"; 74 | NET "SRdat[18]" LOC = "M2"; 75 | NET "SRdat[19]" LOC = "K1"; 76 | NET "SRdat[20]" LOC = "J1"; 77 | NET "SRdat[21]" LOC = "G2"; 78 | NET "SRdat[22]" LOC = "E1"; 79 | NET "SRdat[23]" LOC = "D1"; 80 | NET "SRdat[24]" LOC = "D2"; 81 | NET "SRdat[25]" LOC = "E2"; 82 | NET "SRdat[26]" LOC = "G1"; 83 | NET "SRdat[27]" LOC = "F5"; 84 | NET "SRdat[28]" LOC = "C3"; 85 | NET "SRdat[29]" LOC = "K2"; 86 | NET "SRdat[30]" LOC = "M1"; 87 | NET "SRdat[31]" LOC = "N1"; 88 | 89 | # VGA port 90 | NET "Hsync" LOC = "R9"; 91 | NET "Vsync" LOC = "T10"; 92 | NET "RGB[0]" LOC = "R11"; 93 | NET "RGB[1]" LOC = "T12"; 94 | NET "RGB[2]" LOC = "R12"; 95 | 96 | # keyboard 97 | NET "PS2C" LOC = "M16" |PULLUP; 98 | NET "PS2D" LOC = "M15" |PULLUP; 99 | 100 | # PS/2 mouse and SPI (SD-Card and Network) on A2 connector 101 | NET "msclk" LOC = "E6" |PULLUP; # pin 4 102 | NET "msdat" LOC = "C5" |PULLUP; # pin 6 103 | NET "MOSI[0]" LOC = "D6"; # pin 7 104 | NET "MOSI[1]" LOC = "B11"; # pin 29 105 | NET "SCLK[0]" LOC = "D8"; # pin 13 106 | NET "SCLK[1]" LOC = "B12"; # pin 30 107 | NET "SS[0]" LOC = "D5"; # pin 5 108 | NET "SS[1]" LOC = "A12"; # pin 31 109 | NET "MISO[0]" LOC = "B4" |PULLUP; # pin 17 110 | NET "MISO[1]" LOC = "A10" |PULLUP; # pin 28 111 | NET "NEN" LOC = "B13"; # pin 32 112 | 113 | # general-purpose I/O port 114 | NET "gpio[0]" LOC = "C10"; 115 | NET "gpio[1]" LOC = "E10"; 116 | NET "gpio[2]" LOC = "C11"; 117 | NET "gpio[3]" LOC = "D11"; 118 | NET "gpio[4]" LOC = "C12"; 119 | NET "gpio[5]" LOC = "D12"; 120 | NET "gpio[6]" LOC = "E11"; 121 | NET "gpio[7]" LOC = "B16"; 122 | -------------------------------------------------------------------------------- /SourcesVerilog/RISC5.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // 25.9.2015 2 | 3 | module RISC5( 4 | input clk, rst, stallX, 5 | input [31:0] inbus, codebus, 6 | output [23:0] adr, 7 | output rd, wr, ben, 8 | output [31:0] outbus); 9 | 10 | localparam StartAdr = 22'h3FF800; 11 | 12 | reg [21:0] PC; 13 | reg [31:0] IR; // instruction register 14 | reg N, Z, C, OV; // condition flags 15 | reg [31:0] R [0:15]; // array of 16 registers 16 | reg [31:0] H; // aux register 17 | reg stall1, PMsel; 18 | 19 | wire [31:0] ins, pmout; 20 | wire [21:0] pcmux, nxpc; 21 | wire cond, S; 22 | wire sa, sb, sc; 23 | 24 | wire p, q, u, v, w; // instruction fields 25 | wire [3:0] op, ira, ira0, irb, irc; 26 | wire [2:0] cc; 27 | wire [15:0] imm; 28 | wire [19:0] off; 29 | wire [23:0] offL; 30 | 31 | wire regwr; 32 | wire stall, stallL, stallM, stallD, stallFA, stallFM, stallFD; 33 | wire [1:0] sc1, sc0; // shift counts 34 | 35 | wire a0, a1, a2, a3; 36 | wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3; 37 | wire [23:0] inbusH; 38 | 39 | wire [31:0] A, B, C0, C1, aluRes, regmux; 40 | wire [31:0] s1, s2, s3, t1, t2, t3; 41 | wire [31:0] quotient, remainder; 42 | wire [63:0] product; 43 | wire [31:0] fsum, fprod, fquot; 44 | 45 | wire MOV, LSL, ASR, ROR, AND, ANN, IOR, XOR; // operation signals 46 | wire ADD, SUB, MUL, DIV; wire FAD, FSB, FML, FDV; 47 | wire LDR, STR, BR; 48 | 49 | PROM PM (.adr(pcmux[8:0]), .data(pmout), .clk(clk)); 50 | 51 | Multiplier mulUnit (.clk(clk), .run(MUL), .stall(stallM), 52 | .u(~u), .x(B), .y(C1), .z(product)); 53 | 54 | Divider divUnit (.clk(clk), .run(DIV), .stall(stallD), 55 | .u(~u), .x(B), .y(C1), .quot(quotient), .rem(remainder)); 56 | 57 | FPAdder fpaddx (.clk(clk), .run(FAD|FSB), .u(u), .v(v), .stall(stallFA), 58 | .x(B), .y({FSB^C0[31], C0[30:0]}), .z(fsum)); 59 | 60 | FPMultiplier fpmulx (.clk(clk), .run(FML), .stall(stallFM), 61 | .x(B), .y(C0), .z(fprod)); 62 | 63 | FPDivider fpdivx (.clk(clk), .run(FDV), .stall(stallFD), 64 | .x(B), .y(C0), .z(fquot)); 65 | 66 | assign ins = PMsel ? pmout : IR; // decoding 67 | assign p = ins[31]; 68 | assign q = ins[30]; 69 | assign u = ins[29]; 70 | assign v = ins[28]; 71 | assign w = ins[16]; 72 | assign cc = ins[26:24]; 73 | assign ira = ins[27:24]; 74 | assign irb = ins[23:20]; 75 | assign op = ins[19:16]; 76 | assign irc = ins[3:0]; 77 | assign imm = ins[15:0]; // reg instr. 78 | assign off = ins[19:0]; // mem instr. 79 | assign offL = ins[23:0]; // branch instr. 80 | 81 | assign MOV = ~p & (op == 0); 82 | assign LSL = ~p & (op == 1); 83 | assign ASR = ~p & (op == 2); 84 | assign ROR = ~p & (op == 3); 85 | assign AND = ~p & (op == 4); 86 | assign ANN = ~p & (op == 5); 87 | assign IOR = ~p & (op == 6); 88 | assign XOR = ~p & (op == 7); 89 | 90 | assign ADD = ~p & (op == 8); 91 | assign SUB = ~p & (op == 9); 92 | assign MUL = ~p & (op == 10); 93 | assign DIV = ~p & (op == 11); 94 | assign FAD = ~p & (op == 12); 95 | assign FSB = ~p & (op == 13); 96 | assign FML = ~p & (op == 14); 97 | assign FDV = ~p & (op == 15); 98 | 99 | assign LDR = p & ~q & ~u; 100 | assign STR = p & ~q & u; 101 | assign BR = p & q; 102 | 103 | assign A = R[ira0]; // register data signals 104 | assign B = R[irb]; 105 | assign C0 = R[irc]; 106 | 107 | // Arithmetic-logical unit (ALU) 108 | assign ira0 = BR ? 15 : ira; 109 | assign C1 = q ? {{16{v}}, imm} : C0; 110 | assign adr = stallL ? B[23:0] + {4'b0, off} : {pcmux, 2'b00}; 111 | assign rd = LDR & ~stallX & ~stall1; 112 | assign wr = STR & ~stallX & ~stall1; 113 | assign ben = p & ~q & v & ~stallX & ~stall1; // byte enable 114 | 115 | assign sc0 = C1[1:0]; 116 | assign sc1 = C1[3:2]; 117 | 118 | // shifter for ASR and ROR 119 | assign s1 = (sc0 == 3) ? {(w ? B[2:0] : {3{B[31]}}), B[31:3]} : 120 | (sc0 == 2) ? {(w ? B[1:0] : {2{B[31]}}), B[31:2]} : 121 | (sc0 == 1) ? {(w ? B[0] : B[31]), B[31:1]} : B; 122 | assign s2 = (sc1 == 3) ? {(w ? s1[11:0] : {12{s1[31]}}), s1[31:12]} : 123 | (sc1 == 2) ? {(w ? s1[7:0] : {8{s1[31]}}), s1[31:8]} : 124 | (sc1 == 1) ? {(w ? s1[3:0] : {4{s1[31]}}), s1[31:4]} : s1; 125 | assign s3 = C1[4] ? {(w ? s2[15:0] : {16{s2[31]}}), s2[31:16]} : s2; 126 | 127 | // shifter for LSL 128 | assign t1 = (sc0 == 3) ? {B[28:0], 3'b0} : 129 | (sc0 == 2) ? {B[29:0], 2'b0} : 130 | (sc0 == 1) ? {B[30:0], 1'b0} : B; 131 | assign t2 = (sc1 == 3) ? {t1[19:0], 12'b0} : 132 | (sc1 == 2) ? {t1[23:0], 8'b0} : 133 | (sc1 == 1) ? {t1[27:0], 4'b0} : t1; 134 | assign t3 = C1[4] ? {t2[15:0], 16'b0} : t2; 135 | 136 | assign aluRes = 137 | MOV ? (q ? 138 | (~u ? {{16{v}}, imm} : {imm, 16'b0}) : 139 | (~u ? C0 : (~v ? H : {N, Z, C, OV, 20'b0, 8'h50}))) : 140 | LSL ? t3 : 141 | (ASR|ROR) ? s3 : 142 | AND ? B & C1 : 143 | ANN ? B & ~C1 : 144 | IOR ? B | C1 : 145 | XOR ? B ^ C1 : 146 | ADD ? B + C1 + (u & C) : 147 | SUB ? B - C1 - (u & C) : 148 | MUL ? product[31:0] : 149 | DIV ? quotient : 150 | (FAD|FSB) ? fsum : 151 | FML ? fprod : 152 | FDV ? fquot : 153 | 0; 154 | 155 | assign regwr = ~p & ~stall | (LDR & ~stallX & ~stall1) | (BR & cond & v & ~stallX); 156 | assign a0 = ~adr[1] & ~adr[0]; 157 | assign a1 = ~adr[1] & adr[0]; 158 | assign a2 = adr[1] & ~adr[0]; 159 | assign a3 = adr[1] & adr[0]; 160 | assign inbusL = (~ben | a0) ? inbus[7:0] : 161 | a1 ? inbus[15:8] : a2 ? inbus[23:16] : inbus[31:24]; 162 | assign inbusH = ~ben ? inbus[31:8] : 24'b0; 163 | assign regmux = LDR ? {inbusH, inbusL} : (BR & v) ? {8'b0, nxpc, 2'b0} : aluRes; 164 | 165 | assign outbusB0 = A[7:0]; 166 | assign outbusB1 = ben & a1 ? A[7:0] : A[15:8]; 167 | assign outbusB2 = ben & a2 ? A[7:0] : A[23:16]; 168 | assign outbusB3 = ben & a3 ? A[7:0] : A[31:24]; 169 | assign outbus = {outbusB3, outbusB2, outbusB1, outbusB0}; 170 | 171 | // Control unit CU 172 | assign S = N ^ OV; 173 | assign nxpc = PC + 1; 174 | assign cond = ins[27] ^ 175 | ((cc == 0) & N | // MI, PL 176 | (cc == 1) & Z | // EQ, NE 177 | (cc == 2) & C | // CS, CC 178 | (cc == 3) & OV | // VS, VC 179 | (cc == 4) & (C|Z) | // LS, HI 180 | (cc == 5) & S | // LT, GE 181 | (cc == 6) & (S|Z) | // LE, GT 182 | (cc == 7)); // T, F 183 | 184 | assign pcmux = ~rst ? StartAdr : 185 | stall ? PC : 186 | (BR & cond & u) ? offL[21:0] + nxpc : 187 | (BR & cond & ~u) ? C0[23:2] : nxpc; 188 | 189 | assign sa = aluRes[31]; 190 | assign sb = B[31]; 191 | assign sc = C1[31]; 192 | 193 | assign stall = stallL | stallM | stallD | stallX | stallFA | stallFM | stallFD; 194 | assign stallL = (LDR|STR) & ~stall1; 195 | 196 | always @ (posedge clk) begin 197 | PC <= pcmux; 198 | PMsel <= ~rst | (pcmux[21:12] == 10'h3FF); 199 | IR <= stall ? IR : codebus; 200 | stall1 <= stallX ? stall1 : stallL; 201 | R[ira0] <= regwr ? regmux : A; 202 | N <= regwr ? regmux[31] : N; 203 | Z <= regwr ? (regmux == 0) : Z; 204 | C <= ADD ? (~sb&sc&~sa) | (sb&sc&sa) | (sb&~sa) : 205 | SUB ? (~sb&sc&~sa) | (sb&sc&sa) | (~sb&sa) : C; 206 | OV <= ADD ? (sa&~sb&~sc) | (~sa&sb&sc): 207 | SUB ? (sa&~sb&sc) | (~sa&sb&~sc) : OV; 208 | H <= MUL ? product[63:32] : DIV ? remainder : H; 209 | end 210 | endmodule 211 | -------------------------------------------------------------------------------- /SourcesVerilog/RISC5Top.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // 22.9.2015 2 | // with SRAM, byte access, flt.-pt., and gpio 3 | // PS/2 mouse and network 7.1.2014 PDR 4 | 5 | module RISC5Top( 6 | input CLK50M, 7 | input [3:0] btn, 8 | input [7:0] swi, 9 | input RxD, // RS-232 10 | output TxD, 11 | output [7:0] leds, 12 | output SRce0, SRce1, SRwe, SRoe, //SRAM 13 | output [3:0] SRbe, 14 | output [17:0] SRadr, 15 | inout [31:0] SRdat, 16 | input [1:0] MISO, // SPI - SD card & network 17 | output [1:0] SCLK, MOSI, 18 | output [1:0] SS, 19 | output NEN, // network enable 20 | output hsync, vsync, // video controller 21 | output [2:0] RGB, 22 | input PS2C, PS2D, // keyboard 23 | inout msclk, msdat, 24 | inout [7:0] gpio); 25 | 26 | // IO addresses for input / output 27 | // 0 milliseconds / -- 28 | // 1 switches / LEDs 29 | // 2 RS-232 data / RS-232 data (start) 30 | // 3 RS-232 status / RS-232 control 31 | // 4 SPI data / SPI data (start) 32 | // 5 SPI status / SPI control 33 | // 6 PS2 keyboard / -- 34 | // 7 mouse / -- 35 | // 8 general-purpose I/O data 36 | // 9 general-purpose I/O tri-state control 37 | 38 | reg rst, clk; 39 | wire[23:0] adr; 40 | wire [3:0] iowadr; // word address 41 | wire [31:0] inbus, inbus0; // data to RISC core 42 | wire [31:0] outbus; // data from RISC core 43 | wire rd, wr, ben, ioenb, dspreq; 44 | 45 | wire [7:0] dataTx, dataRx, dataKbd; 46 | wire rdyRx, doneRx, startTx, rdyTx, rdyKbd, doneKbd; 47 | wire [27:0] dataMs; 48 | reg bitrate; // for RS232 49 | wire limit; // of cnt0 50 | 51 | reg [7:0] Lreg; 52 | reg [15:0] cnt0; 53 | reg [31:0] cnt1; // milliseconds 54 | 55 | wire [31:0] spiRx; 56 | wire spiStart, spiRdy; 57 | reg [3:0] spiCtrl; 58 | wire [17:0] vidadr; 59 | reg [7:0] gpout, gpoc; 60 | wire [7:0] gpin; 61 | 62 | RISC5 riscx(.clk(clk), .rst(rst), .rd(rd), .wr(wr), .ben(ben), .stallX(dspreq), 63 | .adr(adr), .codebus(inbus0), .inbus(inbus), .outbus(outbus)); 64 | RS232R receiver(.clk(clk), .rst(rst), .RxD(RxD), .fsel(bitrate), .done(doneRx), 65 | .data(dataRx), .rdy(rdyRx)); 66 | RS232T transmitter(.clk(clk), .rst(rst), .start(startTx), .fsel(bitrate), 67 | .data(dataTx), .TxD(TxD), .rdy(rdyTx)); 68 | SPI spi(.clk(clk), .rst(rst), .start(spiStart), .dataTx(outbus), 69 | .fast(spiCtrl[2]), .dataRx(spiRx), .rdy(spiRdy), 70 | .SCLK(SCLK[0]), .MOSI(MOSI[0]), .MISO(MISO[0] & MISO[1])); 71 | VID vid(.clk(clk), .req(dspreq), .inv(swi[7]), 72 | .vidadr(vidadr), .viddata(inbus0), .RGB(RGB), .hsync(hsync), .vsync(vsync)); 73 | PS2 kbd(.clk(clk), .rst(rst), .done(doneKbd), .rdy(rdyKbd), .shift(), 74 | .data(dataKbd), .PS2C(PS2C), .PS2D(PS2D)); 75 | MouseP Ms(.clk(clk), .rst(rst), .msclk(msclk), .msdat(msdat), .out(dataMs)); 76 | 77 | assign iowadr = adr[5:2]; 78 | assign ioenb = (adr[23:6] == 18'h3FFFF); 79 | assign inbus = ~ioenb ? inbus0 : 80 | ((iowadr == 0) ? cnt1 : 81 | (iowadr == 1) ? {20'b0, btn, swi} : 82 | (iowadr == 2) ? {24'b0, dataRx} : 83 | (iowadr == 3) ? {30'b0, rdyTx, rdyRx} : 84 | (iowadr == 4) ? spiRx : 85 | (iowadr == 5) ? {31'b0, spiRdy} : 86 | (iowadr == 6) ? {3'b0, rdyKbd, dataMs} : 87 | (iowadr == 7) ? {24'b0, dataKbd} : 88 | (iowadr == 8) ? {24'b0, gpin} : 89 | (iowadr == 9) ? {24'b0, gpoc} : 0); 90 | 91 | assign SRce0 = ben & adr[1]; 92 | assign SRce1 = ben & ~adr[1]; 93 | assign SRbe0 = ben & adr[0]; 94 | assign SRbe1 = ben & ~adr[0]; 95 | assign SRwe = ~wr | clk; 96 | assign SRoe = wr; 97 | assign SRbe = {SRbe1, SRbe0, SRbe1, SRbe0}; 98 | assign SRadr = dspreq ? vidadr : adr[19:2]; 99 | 100 | genvar i; 101 | generate // tri-state buffer for SRAM 102 | for (i = 0; i < 32; i = i+1) 103 | begin: bufblock 104 | IOBUF SRbuf (.I(outbus[i]), .O(inbus0[i]), .IO(SRdat[i]), .T(~wr)); 105 | end 106 | endgenerate 107 | 108 | generate // tri-state buffer for gpio port 109 | for (i = 0; i < 8; i = i+1) 110 | begin: gpioblock 111 | IOBUF gpiobuf (.I(gpout[i]), .O(gpin[i]), .IO(gpio[i]), .T(~gpoc[i])); 112 | end 113 | endgenerate 114 | 115 | assign dataTx = outbus[7:0]; 116 | assign startTx = wr & ioenb & (iowadr == 2); 117 | assign doneRx = rd & ioenb & (iowadr == 2); 118 | assign limit = (cnt0 == 24999); 119 | assign leds = Lreg; 120 | assign spiStart = wr & ioenb & (iowadr == 4); 121 | assign SS = ~spiCtrl[1:0]; //active low slave select 122 | assign MOSI[1] = MOSI[0], SCLK[1] = SCLK[0], NEN = spiCtrl[3]; 123 | assign doneKbd = rd & ioenb & (iowadr == 7); 124 | 125 | always @(posedge clk) 126 | begin 127 | rst <= ((cnt1[4:0] == 0) & limit) ? ~btn[3] : rst; 128 | Lreg <= ~rst ? 0 : (wr & ioenb & (iowadr == 1)) ? outbus[7:0] : Lreg; 129 | cnt0 <= limit ? 0 : cnt0 + 1; 130 | cnt1 <= cnt1 + limit; 131 | spiCtrl <= ~rst ? 0 : (wr & ioenb & (iowadr == 5)) ? outbus[3:0] : spiCtrl; 132 | bitrate <= ~rst ? 0 : (wr & ioenb & (iowadr == 3)) ? outbus[0] : bitrate; 133 | gpout <= (wr & ioenb & (iowadr == 8)) ? outbus[7:0] : gpout; 134 | gpoc <= ~rst ? 0 : (wr & ioenb & (iowadr == 9)) ? outbus[7:0] : gpoc; 135 | end 136 | 137 | always @ (posedge CLK50M) clk <= ~clk; 138 | endmodule -------------------------------------------------------------------------------- /SourcesVerilog/RS232R.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 4.5.09 / 15.11.10 2 | 3 | // RS232 receiver for 19200 or 115200 bps, 8 bit data 4 | // clock is 25 MHz 5 | 6 | module RS232R( 7 | input clk, rst, 8 | input RxD, 9 | input fsel, 10 | input done, // "byte has been read" 11 | output rdy, 12 | output [7:0] data); 13 | 14 | wire endtick, midtick, endbit; 15 | wire [11:0] limit; 16 | reg run, stat; 17 | reg Q0, Q1; // synchronizer and edge detector 18 | reg [11:0] tick; 19 | reg [3:0] bitcnt; 20 | reg [7:0] shreg; 21 | 22 | assign limit = fsel ? 217 : 1302; 23 | assign endtick = tick == limit; 24 | assign midtick = tick == {1'b0, limit[11:1]}; // limit/2 25 | assign endbit = bitcnt == 8; 26 | assign data = shreg; 27 | assign rdy = stat; 28 | 29 | always @ (posedge clk) begin 30 | Q0 <= RxD; Q1 <= Q0; 31 | run <= (Q1 & ~Q0) | ~(~rst | endtick & endbit) & run; 32 | tick <= (run & ~endtick) ? tick+1 : 0; 33 | bitcnt <= (endtick & ~endbit) ? bitcnt + 1 : 34 | (endtick & endbit) ? 0 : bitcnt; 35 | shreg <= midtick ? {Q1, shreg[7:1]} : shreg; 36 | stat <= (endtick & endbit) | ~(~rst | done) & stat; 37 | end 38 | endmodule 39 | -------------------------------------------------------------------------------- /SourcesVerilog/RS232T.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps // NW 4.5.09 / 15.8.10 / 15.11.10 2 | 3 | // RS232 transmitter for 19200 bps, 8 bit data 4 | // clock is 25 MHz; 25000 / 1302 = 19.2 KHz 5 | 6 | module RS232T( 7 | input clk, rst, 8 | input start, // request to accept and send a byte 9 | input fsel, // frequency selection 10 | input [7:0] data, 11 | output rdy, 12 | output TxD); 13 | 14 | wire endtick, endbit; 15 | wire [11:0] limit; 16 | reg run; 17 | reg [11:0] tick; 18 | reg [3:0] bitcnt; 19 | reg [8:0] shreg; 20 | 21 | assign limit = fsel ? 217 : 1302; 22 | assign endtick = tick == limit; 23 | assign endbit = bitcnt == 9; 24 | assign rdy = ~run; 25 | assign TxD = shreg[0]; 26 | 27 | always @ (posedge clk) begin 28 | run <= (~rst | endtick & endbit) ? 0 : start ? 1 : run; 29 | tick <= (run & ~endtick) ? tick + 1 : 0; 30 | bitcnt <= (endtick & ~endbit) ? bitcnt + 1 : 31 | (endtick & endbit) ? 0 : bitcnt; 32 | shreg <= (~rst) ? 1 : start ? {data, 1'b0} : 33 | endtick ? {1'b1, shreg[8:1]} : shreg; 34 | end 35 | endmodule 36 | -------------------------------------------------------------------------------- /SourcesVerilog/SPI.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps 2 | 3 | // Motorola Serial Peripheral Interface (SPI) PDR 23.3.12 / 16.10.13 4 | // transmitter / receiver of words (fast, clk/3) or bytes (slow, clk/64) 5 | // e.g 8.33MHz or ~400KHz respectively at 25MHz (slow needed for SD-card init) 6 | // note: bytes are always MSbit first; but if fast, words are LSByte first 7 | 8 | module SPI( 9 | input clk, rst, 10 | input start, fast, 11 | input [31:0] dataTx, 12 | output [31:0] dataRx, 13 | output reg rdy, 14 | input MISO, output MOSI, output SCLK); 15 | 16 | wire endbit, endtick; 17 | reg [31:0] shreg; 18 | reg [5:0] tick; 19 | reg [4:0] bitcnt; 20 | 21 | assign endtick = fast ? (tick == 2) : (tick == 63); //25MHz clk 22 | assign endbit = fast ? (bitcnt == 31) : (bitcnt == 7); 23 | assign dataRx = fast ? shreg : {24'b0, shreg[7:0]}; 24 | assign MOSI = (~rst | rdy) ? 1 : shreg[7]; 25 | assign SCLK = (~rst | rdy) ? 0 : fast ? endtick : tick[5]; 26 | 27 | always @ (posedge clk) begin 28 | tick <= (~rst | rdy | endtick) ? 0 : tick + 1; 29 | rdy <= (~rst | endtick & endbit) ? 1 : start ? 0 : rdy; 30 | bitcnt <= (~rst | start) ? 0 : (endtick & ~endbit) ? bitcnt + 1 : bitcnt; 31 | shreg <= ~rst ? -1 : start ? dataTx : endtick ? 32 | {shreg[30:24], MISO, shreg[22:16], shreg[31], shreg[14:8], 33 | shreg[23], shreg[6:0], (fast ? shreg[15] : MISO)} : shreg; 34 | end 35 | 36 | endmodule -------------------------------------------------------------------------------- /SourcesVerilog/VID.v: -------------------------------------------------------------------------------- 1 | `timescale 1ns / 1ps 2 | // 1024x768 display controller NW/PR 24.1.2014 3 | 4 | module VID( 5 | input clk, inv, 6 | input [31:0] viddata, 7 | output reg req, // SRAM read request 8 | output [17:0] vidadr, 9 | output hsync, vsync, // to display 10 | output [2:0] RGB); 11 | 12 | localparam Org = 18'b1101_1111_1111_0000_00; // DFF00: adr of vcnt=1023 13 | reg [10:0] hcnt; 14 | reg [9:0] vcnt; 15 | reg [4:0] hword; // from hcnt, but latched in the clk domain 16 | reg [31:0] vidbuf, pixbuf; 17 | reg hblank; 18 | wire pclk, hend, vend, vblank, xfer, vid; 19 | 20 | assign hend = (hcnt == 1343), vend = (vcnt == 801); 21 | assign vblank = (vcnt[8] & vcnt[9]); // (vcnt >= 768) 22 | assign hsync = ~((hcnt >= 1080+6) & (hcnt < 1184+6)); // -ve polarity 23 | assign vsync = (vcnt >= 771) & (vcnt < 776); // +ve polarity 24 | assign xfer = (hcnt[4:0] == 6); // data delay > hcnt cycle + req cycle 25 | assign vid = (pixbuf[0] ^ inv) & ~hblank & ~vblank; 26 | assign RGB = {vid, vid, vid}; 27 | assign vidadr = Org + {3'b0, ~vcnt, hword}; 28 | 29 | always @(posedge pclk) begin // pixel clock domain 30 | hcnt <= hend ? 0 : hcnt+1; 31 | vcnt <= hend ? (vend ? 0 : (vcnt+1)) : vcnt; 32 | hblank <= xfer ? hcnt[10] : hblank; // hcnt >= 1024 33 | pixbuf <= xfer ? vidbuf : {1'b0, pixbuf[31:1]}; 34 | end 35 | 36 | always @(posedge clk) begin // CPU (SRAM) clock domain 37 | hword <= hcnt[9:5]; 38 | req <= ~vblank & ~hcnt[10] & (hcnt[5] ^ hword[0]); // i.e. adr changed 39 | vidbuf <= req ? viddata : vidbuf; 40 | end 41 | 42 | // pixel clock generation 43 | (* LOC = "DCM_X1Y1" *) DCM #(.CLKFX_MULTIPLY(3), .CLK_FEEDBACK("NONE")) 44 | dcm(.CLKIN(clk), .CLKFX(pclk)); 45 | 46 | endmodule 47 | -------------------------------------------------------------------------------- /UsingOberon.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/UsingOberon.pdf -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | Project Oberon, Revised Edition 2013 2 | 3 | Book copyright (C)2013 Niklaus Wirth and Juerg Gutknecht; 4 | software copyright (C)2013 Niklaus Wirth (NW), Juerg Gutknecht (JG), Paul 5 | Reed (PR/PDR). 6 | 7 | Permission to use, copy, modify, and/or distribute this software and its 8 | accompanying documentation (the "Software") for any purpose with or 9 | without fee is hereby granted, provided that the above copyright notice 10 | and this permission notice appear in all copies. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES 13 | WITH REGARD TO THE SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF 14 | MERCHANTABILITY, FITNESS AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | AUTHORS BE LIABLE FOR ANY CLAIM, SPECIAL, DIRECT, INDIRECT, OR 16 | CONSEQUENTIAL DAMAGES OR ANY DAMAGES OR LIABILITY WHATSOEVER, WHETHER IN 17 | AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 18 | CONNECTION WITH THE DEALINGS IN OR USE OR PERFORMANCE OF THE SOFTWARE. 19 | -------------------------------------------------------------------------------- /news.txt: -------------------------------------------------------------------------------- 1 | 20160307 - compiler ORP updated 2 | ORP.Statsequence (assignment) 3 | ORP.CompTypes (dyn arrays: t1.len = -1) 4 | 20160304 - compiler updated 5 | comparison of Booleans re-restablished (ORP.expression, ORG.IntRelation) 6 | assignment of arrays: lengths of source and destination must be equal (ORP.CompTypes) 7 | 20160220 -compiler updated 8 | multi-dimensional array; dst := src 9 | first dimension of src less than first dimersion of dst 10 | changes in 11 | ORS.Get (eot) 12 | ORG.Put1a (typo) 13 | ORG.StoreStruct 14 | ORP.Declarations 15 | ORP.Type0 16 | ORP.TypeTest 17 | Report 8.2.4 18 | Report 9.8 19 | 20151130 - updated 20 | Oberon.GC (ActCnt <= 0) 21 | System.Free Oberon.Collect(0) 22 | System.Collect Oberon.Collect(0) 23 | Edit.Locate V := Oberon.FocusViewer 24 | Edit.Search V := Oberon.FocusViewer 25 | 20151118 - Project Oberon guide UsingOberon.pdf; TextFrames.Mod updated (upwards scrolling) 26 | 20151027 - RISC5.v, RISC5.Lola.txt aluRes improved, no functional change 27 | 20151016 - Added SmallPrograms.Lola (Lola section), 28 | and ThreeCounters.pdf, StandalonePrograms.Mod (FPGA-related section); 29 | Updated TextFrames.Mod - change in DisplayLine (ProjectOberon section) 30 | 20151001 - Divider.v and Divider.Lola.txt corrected 31 | 20150926 - Major update 32 | Revision of RISC programs for better portability. Architecture unchanged. 33 | 1. The byte selection stetements have been moved from RISCTop to RISC 34 | 2. Address bus width changed from 20 to 24 35 | the follwing programs are affected; all others remain unchanged 36 | RISC5Top.v RISC5.v Multiplier.v Divider.v RS232R.v 37 | FPAdder.v FPMultiplier.v FPDivider.v MouseP.v RISC5.ucf 38 | 20150926 - Updates of Lola corresponding programs 39 | the follwing programs are affected; all others remain unchanged 40 | RISC5Top.Lola RISC5.Lola Multiplier.Lola Divider.Lola 41 | FPAdder.Lola FPMultiplier.Lola FPDivider.Lola RS232R.Lola.txt MouseP.Lola 42 | 20150926 - The Lola compiler is updated. It accepts a new statement for tri-state ports. 43 | LSC Mod LSS.Mod LSB.Mod LSV.Mod LSP.Mod -------------------------------------------------------------------------------- /oberonV5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Spirit-of-Oberon/ProjectOberon2013/72966ea608613dad76f5afdd57578c7e53741bd3/oberonV5.jpg --------------------------------------------------------------------------------