vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 00:32:24 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix line endings.

Browse source
This commit is contained in:
David Brown 2016-06-16 16:14:30 +01:00
parent c64a75bd78
commit a9b273e30a
15 changed files with 5328 additions and 5328 deletions
Download patch file Download diff file Expand all files Collapse all files

104
src/test/confidence/lola/LSB.Mod
View file

@ -1,52 +1,52 @@
MODULE LSB; (*Lola System Compiler Base LSBX, 26.9.2015*)
IMPORT Texts, Oberon;
CONST
bit* = 0; array* = 1; unit* = 2; (*type forms*)
(*tags in output*) const* = 1; typ* = 2; var* = 3; lit* = 4; sel* = 7; range* = 8; cons* = 9;
repl* = 10; not* = 11; and* = 12; mul* = 13; div* = 14; or* = 15; xor* = 16; add* = 17; sub* = 18;
eql* = 20; neq* = 21; lss* = 22; geq* = 23; leq* = 24; gtr* = 25;
then* = 30; else* = 31; ts* = 32; next* = 33;
TYPE
Item* = POINTER TO ItemDesc;
Object* = POINTER TO ObjDesc;
Type* = POINTER TO TypeDesc;
ArrayType* = POINTER TO ArrayTypeDesc;
UnitType* = POINTER TO UnitTypeDesc;
ItemDesc* = RECORD
tag*: INTEGER;
type*: Type;
val*, size*: LONGINT;
a*, b*: Item
END ;
ObjDesc* = RECORD (ItemDesc)
next*: Object;
name*: ARRAY 32 OF CHAR;
marked*: BOOLEAN
END ;
TypeDesc* = RECORD len*, size*: LONGINT; typobj*: Object END ;
ArrayTypeDesc* = RECORD (TypeDesc) eltyp*: Type END ;
UnitTypeDesc* = RECORD (TypeDesc) firstobj*: Object END ;
VAR root*, top*: Object;
bitType*, integer*, string*: Type;
byteType*, wordType*: ArrayType;
modname*: ARRAY 32 OF CHAR;
PROCEDURE Register*(name: ARRAY OF CHAR; list: Object);
BEGIN (*modname := name*) COPY(name, modname); top := list
END Register;
BEGIN NEW(bitType); bitType.len := 0; bitType.size := 1; NEW(integer); NEW(string);
NEW(byteType); byteType.len := 8; byteType.size := 8; byteType.eltyp := bitType;
NEW(wordType); wordType.len := 32; wordType.size := 32; wordType.eltyp := bitType;
NEW(root); root.tag := typ; root.name := "WORD"; root.type := wordType; root.next := NIL;
NEW(top); top.tag := typ; top.name := "BYTE"; top.type := byteType; top.next := root; root := top;
NEW(top); top.tag := typ; top.name := "BIT"; top.type := bitType; top.next := root; root := top
END LSB.
MODULE LSB; (*Lola System Compiler Base LSBX, 26.9.2015*)
IMPORT Texts, Oberon;
CONST
bit* = 0; array* = 1; unit* = 2; (*type forms*)
(*tags in output*) const* = 1; typ* = 2; var* = 3; lit* = 4; sel* = 7; range* = 8; cons* = 9;
repl* = 10; not* = 11; and* = 12; mul* = 13; div* = 14; or* = 15; xor* = 16; add* = 17; sub* = 18;
eql* = 20; neq* = 21; lss* = 22; geq* = 23; leq* = 24; gtr* = 25;
then* = 30; else* = 31; ts* = 32; next* = 33;
TYPE
Item* = POINTER TO ItemDesc;
Object* = POINTER TO ObjDesc;
Type* = POINTER TO TypeDesc;
ArrayType* = POINTER TO ArrayTypeDesc;
UnitType* = POINTER TO UnitTypeDesc;
ItemDesc* = RECORD
tag*: INTEGER;
type*: Type;
val*, size*: LONGINT;
a*, b*: Item
END ;
ObjDesc* = RECORD (ItemDesc)
next*: Object;
name*: ARRAY 32 OF CHAR;
marked*: BOOLEAN
END ;
TypeDesc* = RECORD len*, size*: LONGINT; typobj*: Object END ;
ArrayTypeDesc* = RECORD (TypeDesc) eltyp*: Type END ;
UnitTypeDesc* = RECORD (TypeDesc) firstobj*: Object END ;
VAR root*, top*: Object;
bitType*, integer*, string*: Type;
byteType*, wordType*: ArrayType;
modname*: ARRAY 32 OF CHAR;
PROCEDURE Register*(name: ARRAY OF CHAR; list: Object);
BEGIN (*modname := name*) COPY(name, modname); top := list
END Register;
BEGIN NEW(bitType); bitType.len := 0; bitType.size := 1; NEW(integer); NEW(string);
NEW(byteType); byteType.len := 8; byteType.size := 8; byteType.eltyp := bitType;
NEW(wordType); wordType.len := 32; wordType.size := 32; wordType.eltyp := bitType;
NEW(root); root.tag := typ; root.name := "WORD"; root.type := wordType; root.next := NIL;
NEW(top); top.tag := typ; top.name := "BYTE"; top.type := byteType; top.next := root; root := top;
NEW(top); top.tag := typ; top.name := "BIT"; top.type := bitType; top.next := root; root := top
END LSB.

1072
src/test/confidence/lola/LSC.Mod
View file

File diff suppressed because it is too large Load diff

330
src/test/confidence/lola/LSS.Mod
View file

@ -1,165 +1,165 @@
MODULE LSS; (* NW 16.10.93 / 1.9.2015*)
IMPORT Texts, Oberon;
CONST IdLen* = 32; NofKeys = 11;
(*symbols*) null = 0;
arrow* = 1; times* = 2; div* = 3; and* = 4; plus* = 5; minus* = 6; or* = 7; xor* = 8; not* = 9;
eql* = 10; neq* = 11; lss* = 12; leq* = 13; gtr* = 14; geq* = 15;
at* = 16; apo* = 17; period* = 18; comma* = 19; colon* = 20; rparen* = 21; rbrak* = 22; rbrace* = 23;
then* = 24; lparen* = 26; lbrak* = 27; lbrace* = 28; repl* = 29; becomes* = 30;
ident* = 31; integer* = 32; ts* = 33; semicolon* = 40; end* = 41;
const* = 51; type* = 52; reg* = 53; var* = 54; out* = 55; inout* = 56; in* = 57;
begin* = 58; module* = 59; eof = 60;
TYPE Ident* = ARRAY IdLen OF CHAR;
VAR val*: LONGINT;
id*: Ident;
error*: BOOLEAN;
ch: CHAR;
errpos: LONGINT;
R: Texts.Reader;
W: Texts.Writer;
key: ARRAY NofKeys OF Ident;
symno: ARRAY NofKeys OF INTEGER;
PROCEDURE Mark*(msg: ARRAY OF CHAR);
VAR p: LONGINT;
BEGIN p := Texts.Pos(R);
IF p > errpos+2 THEN
Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1);
Texts.WriteString(W, " err: "); Texts.WriteString(W, msg);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END ;
errpos := p; error := TRUE
END Mark;
PROCEDURE identifier(VAR sym: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
REPEAT
IF i < IdLen THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
IF ch = "'" THEN
IF i < IdLen THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
END ;
IF i = IdLen THEN Mark("ident too long"); id[IdLen-1] := 0X
ELSE id[i] := 0X
END ;
i := 0;
WHILE (i < NofKeys) & (id # key[i]) DO INC(i) END ;
IF i < NofKeys THEN sym := symno[i] ELSE sym := ident END
END identifier;
PROCEDURE Number(VAR sym: INTEGER);
VAR i, k, h, n, d: LONGINT;
hex: BOOLEAN;
dig: ARRAY 16 OF LONGINT;
BEGIN sym := integer; i := 0; k := 0; n := 0; hex := FALSE;
REPEAT
IF n < 16 THEN d := ORD(ch)-30H;
IF d >= 10 THEN hex := TRUE ; d := d - 7 END ;
dig[n] := d; INC(n)
ELSE Mark("too many digits"); n := 0
END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
IF ch = "H" THEN (*hex*)
REPEAT h := dig[i]; k := k*10H + h; INC(i) (*no overflow check*)
UNTIL i = n;
Texts.Read(R, ch)
ELSE
IF hex THEN Mark("illegal hex digit") END ;
REPEAT k := k*10 + dig[i]; INC(i) UNTIL i = n
END ;
val := k
END Number;
PROCEDURE comment;
BEGIN Texts.Read(R, ch);
REPEAT
WHILE ~R.eot & (ch # "*") DO
IF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN comment END
ELSE Texts.Read(R, ch)
END
END ;
WHILE ch = "*" DO Texts.Read(R, ch) END
UNTIL (ch = ")") OR R.eot;
IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("comment not terminated") END
END comment;
PROCEDURE Get*(VAR sym: INTEGER);
BEGIN
REPEAT
WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
IF R.eot THEN sym := eof
ELSIF ch < "A" THEN
IF ch < "0" THEN
IF ch = "!" THEN Texts.Read(R, ch); sym := repl
ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
ELSIF ch = "$" THEN Texts.Read(R, ch); sym := null
ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
ELSIF ch = "'" THEN Texts.Read(R, ch); sym := apo
ELSIF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
ELSIF ch = "-" THEN Texts.Read(R, ch);
IF ch = ">" THEN Texts.Read(R, ch); sym := then ELSE sym := minus END
ELSIF ch = "." THEN Texts.Read(R, ch); sym := period
ELSIF ch = "/" THEN Texts.Read(R, ch); sym := div
ELSE sym := null
END
ELSIF ch <= "9" THEN Number(sym)
ELSIF ch = ":" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
ELSIF ch = "<" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
ELSIF ch = ">" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
ELSIF ch = "?" THEN Texts.Read(R, ch); sym := then
ELSIF ch = "@" THEN Texts.Read(R, ch); sym := at
ELSE sym := null
END
ELSIF ch <= "Z" THEN identifier(sym)
ELSIF ch < "a" THEN
IF ch = "[" THEN Texts.Read(R, ch); sym := lbrak
ELSIF ch = "]" THEN Texts.Read(R, ch); sym := rbrak
ELSIF ch = "^" THEN Texts.Read(R, ch); sym := xor
ELSE sym := null
END
ELSIF ch <= "z" THEN identifier(sym)
ELSIF ch <= "{" THEN Texts.Read(R, ch); sym := lbrace
ELSIF ch <= "|" THEN Texts.Read(R, ch); sym := or
ELSIF ch <= "}" THEN Texts.Read(R, ch); sym := rbrace
ELSIF ch <= "~" THEN Texts.Read(R, ch); sym := not
ELSE sym := null
END
UNTIL sym # null
END Get;
PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
BEGIN error := FALSE; errpos := pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
END Init;
BEGIN Texts.OpenWriter(W);
key[ 0] := "BEGIN"; symno[0] := begin;
key[ 1] := "CONST"; symno[1] := const;
key[ 2] := "END"; symno[2] := end;
key[3] := "IN"; symno[3] := in;
key[4] := "INOUT"; symno[4] := inout;
key[5] := "MODULE"; symno[5] := module;
key[6] := "OUT"; symno[6] := out;
key[7] := "REG"; symno[7] := reg;
key[8] := "TYPE"; symno[8] := type;
key[9] := "VAR"; symno[9] := var;
key[10] := "TS"; symno[10] := ts
END LSS.
MODULE LSS; (* NW 16.10.93 / 1.9.2015*)
IMPORT Texts, Oberon;
CONST IdLen* = 32; NofKeys = 11;
(*symbols*) null = 0;
arrow* = 1; times* = 2; div* = 3; and* = 4; plus* = 5; minus* = 6; or* = 7; xor* = 8; not* = 9;
eql* = 10; neq* = 11; lss* = 12; leq* = 13; gtr* = 14; geq* = 15;
at* = 16; apo* = 17; period* = 18; comma* = 19; colon* = 20; rparen* = 21; rbrak* = 22; rbrace* = 23;
then* = 24; lparen* = 26; lbrak* = 27; lbrace* = 28; repl* = 29; becomes* = 30;
ident* = 31; integer* = 32; ts* = 33; semicolon* = 40; end* = 41;
const* = 51; type* = 52; reg* = 53; var* = 54; out* = 55; inout* = 56; in* = 57;
begin* = 58; module* = 59; eof = 60;
TYPE Ident* = ARRAY IdLen OF CHAR;
VAR val*: LONGINT;
id*: Ident;
error*: BOOLEAN;
ch: CHAR;
errpos: LONGINT;
R: Texts.Reader;
W: Texts.Writer;
key: ARRAY NofKeys OF Ident;
symno: ARRAY NofKeys OF INTEGER;
PROCEDURE Mark*(msg: ARRAY OF CHAR);
VAR p: LONGINT;
BEGIN p := Texts.Pos(R);
IF p > errpos+2 THEN
Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1);
Texts.WriteString(W, " err: "); Texts.WriteString(W, msg);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END ;
errpos := p; error := TRUE
END Mark;
PROCEDURE identifier(VAR sym: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
REPEAT
IF i < IdLen THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
IF ch = "'" THEN
IF i < IdLen THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
END ;
IF i = IdLen THEN Mark("ident too long"); id[IdLen-1] := 0X
ELSE id[i] := 0X
END ;
i := 0;
WHILE (i < NofKeys) & (id # key[i]) DO INC(i) END ;
IF i < NofKeys THEN sym := symno[i] ELSE sym := ident END
END identifier;
PROCEDURE Number(VAR sym: INTEGER);
VAR i, k, h, n, d: LONGINT;
hex: BOOLEAN;
dig: ARRAY 16 OF LONGINT;
BEGIN sym := integer; i := 0; k := 0; n := 0; hex := FALSE;
REPEAT
IF n < 16 THEN d := ORD(ch)-30H;
IF d >= 10 THEN hex := TRUE ; d := d - 7 END ;
dig[n] := d; INC(n)
ELSE Mark("too many digits"); n := 0
END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
IF ch = "H" THEN (*hex*)
REPEAT h := dig[i]; k := k*10H + h; INC(i) (*no overflow check*)
UNTIL i = n;
Texts.Read(R, ch)
ELSE
IF hex THEN Mark("illegal hex digit") END ;
REPEAT k := k*10 + dig[i]; INC(i) UNTIL i = n
END ;
val := k
END Number;
PROCEDURE comment;
BEGIN Texts.Read(R, ch);
REPEAT
WHILE ~R.eot & (ch # "*") DO
IF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN comment END
ELSE Texts.Read(R, ch)
END
END ;
WHILE ch = "*" DO Texts.Read(R, ch) END
UNTIL (ch = ")") OR R.eot;
IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("comment not terminated") END
END comment;
PROCEDURE Get*(VAR sym: INTEGER);
BEGIN
REPEAT
WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
IF R.eot THEN sym := eof
ELSIF ch < "A" THEN
IF ch < "0" THEN
IF ch = "!" THEN Texts.Read(R, ch); sym := repl
ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
ELSIF ch = "$" THEN Texts.Read(R, ch); sym := null
ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
ELSIF ch = "'" THEN Texts.Read(R, ch); sym := apo
ELSIF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
ELSIF ch = "-" THEN Texts.Read(R, ch);
IF ch = ">" THEN Texts.Read(R, ch); sym := then ELSE sym := minus END
ELSIF ch = "." THEN Texts.Read(R, ch); sym := period
ELSIF ch = "/" THEN Texts.Read(R, ch); sym := div
ELSE sym := null
END
ELSIF ch <= "9" THEN Number(sym)
ELSIF ch = ":" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
ELSIF ch = "<" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
ELSIF ch = ">" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
ELSIF ch = "?" THEN Texts.Read(R, ch); sym := then
ELSIF ch = "@" THEN Texts.Read(R, ch); sym := at
ELSE sym := null
END
ELSIF ch <= "Z" THEN identifier(sym)
ELSIF ch < "a" THEN
IF ch = "[" THEN Texts.Read(R, ch); sym := lbrak
ELSIF ch = "]" THEN Texts.Read(R, ch); sym := rbrak
ELSIF ch = "^" THEN Texts.Read(R, ch); sym := xor
ELSE sym := null
END
ELSIF ch <= "z" THEN identifier(sym)
ELSIF ch <= "{" THEN Texts.Read(R, ch); sym := lbrace
ELSIF ch <= "|" THEN Texts.Read(R, ch); sym := or
ELSIF ch <= "}" THEN Texts.Read(R, ch); sym := rbrace
ELSIF ch <= "~" THEN Texts.Read(R, ch); sym := not
ELSE sym := null
END
UNTIL sym # null
END Get;
PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
BEGIN error := FALSE; errpos := pos; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
END Init;
BEGIN Texts.OpenWriter(W);
key[ 0] := "BEGIN"; symno[0] := begin;
key[ 1] := "CONST"; symno[1] := const;
key[ 2] := "END"; symno[2] := end;
key[3] := "IN"; symno[3] := in;
key[4] := "INOUT"; symno[4] := inout;
key[5] := "MODULE"; symno[5] := module;
key[6] := "OUT"; symno[6] := out;
key[7] := "REG"; symno[7] := reg;
key[8] := "TYPE"; symno[8] := type;
key[9] := "VAR"; symno[9] := var;
key[10] := "TS"; symno[10] := ts
END LSS.

476
src/test/confidence/lola/LSV.Mod
View file

@ -1,238 +1,238 @@
MODULE LSV; (*Lola System: display Verilog; generate txt-File; NW 31.8.2015*)
IMPORT Files, Texts, Oberon, LSB;
VAR W: Texts.Writer;
nofgen: INTEGER;
Constructor: PROCEDURE (VAR x: LSB.Item); (*to avoid forward reference*)
F: Files.File; R: Files.Rider;
C: ARRAY 64, 6 OF CHAR;
PROCEDURE Write(ch: CHAR);
BEGIN Files.Write(R, ch)
END Write;
PROCEDURE WriteLn;
BEGIN Files.Write(R, 0DX); Files.Write(R, 0AX)
END WriteLn;
PROCEDURE WriteInt(x: LONGINT); (* x >= 0 *)
VAR i: INTEGER; d: ARRAY 14 OF LONGINT;
BEGIN i := 0;
IF x < 0 THEN Files.Write(R, "-"); x := -x END ;
REPEAT d[i] := x MOD 10; x := x DIV 10; INC(i) UNTIL x = 0;
REPEAT DEC(i); Files.Write(R, CHR(d[i] + 30H)) UNTIL i = 0
END WriteInt;
PROCEDURE WriteHex(x: LONGINT); (*x >= 0*)
VAR i: INTEGER; d: ARRAY 8 OF LONGINT;
BEGIN i := 0;
REPEAT d[i] := x MOD 10H; x := x DIV 10H; INC(i) UNTIL (x = 0) OR (i = 8);
REPEAT DEC(i);
IF d[i] >= 10 THEN Files.Write(R, CHR(d[i] + 37H)) ELSE Files.Write(R, CHR(d[i] + 30H)) END
UNTIL i = 0
END WriteHex;
PROCEDURE WriteString(s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE s[i] # 0X DO Files.Write(R, s[i]); INC(i) END
END WriteString;
(* ------------------------------- *)
PROCEDURE Type(typ: LSB.Type);
VAR obj: LSB.Object;
BEGIN
IF typ IS LSB.ArrayType THEN
IF typ(LSB.ArrayType).eltyp # LSB.bitType THEN
Write("["); WriteInt(typ.len - 1); WriteString(":0]"); Type(typ(LSB.ArrayType).eltyp)
END
ELSIF typ IS LSB.UnitType THEN (* obj := typ(LSB.UnitType).firstobj; *)
END
END Type;
PROCEDURE BitArrLen(typ: LSB.Type);
VAR eltyp: LSB.Type;
BEGIN
IF typ IS LSB.ArrayType THEN
eltyp := typ(LSB.ArrayType).eltyp;
WHILE eltyp IS LSB.ArrayType DO typ := eltyp; eltyp := typ(LSB.ArrayType).eltyp END ;
IF eltyp = LSB.bitType THEN
Write("["); WriteInt(typ.len - 1);WriteString(":0] ")
END
END
END BitArrLen;
PROCEDURE Expression(x: LSB.Item);
VAR z: LSB.Item;
BEGIN
IF x # NIL THEN
IF x IS LSB.Object THEN WriteString(x(LSB.Object).name)
ELSIF x.tag = LSB.cons THEN
Write("{"); Constructor(x); Write("}")
ELSE
IF x.tag = LSB.repl THEN
Write("{"); WriteInt(x.b.val); Write("{"); Expression(x.a);
Write("}"); Write("}")
ELSE
IF (x.tag >= LSB.and) & (x.tag <= LSB.gtr) THEN Write("(") END ;
Expression(x.a);
IF x.tag = LSB.sel THEN Write("["); Expression(x.b); Write("]")
ELSIF x.tag = LSB.lit THEN
IF x.size # 0 THEN WriteInt(x.size); Write("'"); Write("h"); WriteHex(x.val)
ELSE WriteInt(x.val)
END
ELSE WriteString(C[x.tag]); Expression(x.b)
END ;
IF (x.tag >= LSB.and) & (x.tag <= LSB.gtr) THEN Write(")") END
END
END
END
END Expression;
PROCEDURE Elem(VAR x: LSB.Item);
BEGIN
IF x.tag = LSB.repl THEN
Write("{"); WriteInt(x.b.val); Write("{"); Expression(x.a); WriteString("}}")
ELSE Expression(x)
END
END Elem;
PROCEDURE Constructor0(VAR x: LSB.Item);
BEGIN
IF x.tag = LSB.cons THEN Constructor(x.a); WriteString(", "); Elem(x.b) ELSE Elem(x) END
END Constructor0;
PROCEDURE Declaration(obj: LSB.Object);
VAR apar: LSB.Item; typ: LSB.Type;
BEGIN typ := obj.type;
IF obj.type IS LSB.UnitType THEN WriteString("unit ") ELSE Type(obj.type) END ;
IF obj.tag = LSB.var THEN
IF obj.type IS LSB.UnitType THEN
apar := obj.a; WriteLn; Write("[");
WHILE apar # NIL DO Expression(apar.b); apar := apar.a END ;
Write("]")
END
ELSIF obj.tag = LSB.const THEN WriteString(" = "); WriteInt(obj.val)
END
END Declaration;
PROCEDURE ObjList0(obj: LSB.Object); (*declarations*)
VAR obj1: LSB.Object; param: BOOLEAN;
BEGIN param := TRUE;
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) THEN
IF obj.val <= 1 THEN WriteString("reg ")
ELSIF obj.val = 2 THEN WriteString("wire ")
ELSIF obj.val = 3 THEN WriteString("output ")
ELSIF obj.val = 4 THEN WriteString("output reg ")
ELSIF obj.val = 5 THEN WriteString("inout ")
ELSIF obj.val = 6 THEN WriteString("input ")
ELSE WriteString("??? ")
END ;
BitArrLen(obj.type); WriteString(obj.name);
obj1 := obj.next;
WHILE (obj1 # LSB.top) & (obj1.type = obj.type) & (obj1.val = obj.val) DO
WriteString(", "); obj := obj1; WriteString(obj.name); obj1 := obj.next
END ;
IF param & (obj.val >= 3) & (obj1.val < 3) THEN (*end param list*) param := FALSE; Write(")")
END ;
IF (obj.type # LSB.bitType) & (obj.type(LSB.ArrayType).eltyp # LSB.bitType) THEN Type(obj.type) END ;
IF param THEN Write(",") ELSE Write(";") END ;
WriteLn
ELSIF obj.tag = LSB.const THEN
END ;
obj := obj.next
END
END ObjList0;
PROCEDURE ActParam(VAR x: LSB.Item; fpar: LSB.Object);
BEGIN Write("."); WriteString(fpar.name); Write("("); Expression(x); Write(")")
END ActParam;
PROCEDURE ObjList1(obj: LSB.Object); (*assignments to variables*)
VAR apar, x: LSB.Item; fpar: LSB.Object; size: LONGINT;
BEGIN
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) OR (obj.tag = LSB.const) THEN
IF obj.type IS LSB.UnitType THEN
WriteString(obj.type.typobj.name); Write(" "); WriteString(obj.name);
apar := obj.b; fpar := obj.type(LSB.UnitType).firstobj;
Write("("); ActParam(apar.b, fpar); apar := apar.a; fpar := fpar.next; (*actual param list*)
WHILE apar # NIL DO WriteString(", "); ActParam(apar.b, fpar); apar := apar.a; fpar := fpar.next END ;
Write(")"); Write(";"); WriteLn
ELSIF (obj.b # NIL) & (obj.val = 5) THEN (*tri-state*)
size := obj.type.size; x := obj.b;
IF x.tag = LSB.ts THEN
IF obj.type = LSB.bitType THEN
WriteString("IOBUF block"); INC(nofgen); WriteInt(nofgen); WriteString(" (.IO("); WriteString(obj.name);
WriteString("), .O("); WriteString(x.a(LSB.Object).name); WriteString("), .I("); x := x.b;
IF x.a.type = LSB.bitType THEN Expression(x.a) ELSE WriteString(x.a(LSB.Object).name) END ;
WriteString("), .T(");
IF x.b.type = LSB.bitType THEN Expression(x.b) ELSE WriteString(x.b(LSB.Object).name) END ;
WriteString("));")
ELSE (*array type*)
IF nofgen = 0 THEN WriteString("genvar i;"); WriteLn END ;
INC(nofgen); WriteString("generate"); WriteLn;
WriteString("for (i = 0; i < "); WriteInt(size); WriteString("; i = i+1) begin : bufblock"); WriteInt(nofgen); WriteLn;
WriteString("IOBUF block (.IO("); WriteString(obj.name);
WriteString("[i]), .O("); WriteString(x.a(LSB.Object).name); WriteString("[i]), .I("); x := x.b;
WriteString(x.a(LSB.Object).name); WriteString("[i]), .T(");
IF x.b.type = LSB.bitType THEN Expression(x.b) ELSE WriteString(x.b(LSB.Object).name); WriteString("[i]") END ;
WriteString("));"); WriteLn; WriteString("end"); WriteLn; WriteString("endgenerate")
END ;
WriteLn
END
ELSIF (obj.b # NIL) & (obj.val >= 2) THEN
WriteString("assign "); WriteString(obj.name);
IF (obj.a # NIL) THEN Write("["); Expression(obj.a); Write("]") END ;
WriteString(" = "); Expression(obj.b); Write(";"); WriteLn
END
ELSIF obj.tag = LSB.typ THEN (*instantiation; actual parameters*)
END ;
obj := obj.next
END
END ObjList1;
PROCEDURE ObjList2(obj: LSB.Object); (*assignments to registers*)
VAR apar: LSB.Item; kind: LONGINT; clk: LSB.Item;
BEGIN
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) & (obj.val < 2) THEN
WriteString("always @ (posedge "); kind := obj.val;
IF kind = 0 THEN Expression(obj.a)
ELSE (*kind = 1*) WriteString("clk")
END ;
WriteString(") begin ");
REPEAT WriteString(obj.name);
IF (kind = 1) & (obj.a # NIL) THEN Write("["); Expression(obj.a); Write("]") END ;
WriteString(" <= "); Expression(obj.b); Write(";"); WriteLn; obj := obj.next
UNTIL (obj = LSB.top) OR (obj.val # kind);
WriteString("end"); WriteLn
ELSE obj := obj.next
END
END
END ObjList2;
PROCEDURE List*;
VAR S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
Texts.WriteString(W, LSB.modname); Texts.WriteString(W, " translating to "); Texts.WriteString(W, S.s);
F := Files.New(S.s); Files.Set(R, F, 0);
WriteString("`timescale 1ns / 1 ps"); WriteLn; nofgen := 0;
WriteString("module "); WriteString(LSB.modname); WriteString("( // translated from Lola"); WriteLn;
ObjList0(LSB.top); ObjList1(LSB.top); ObjList2(LSB.top);
WriteString("endmodule"); WriteLn;
Files.Register(F); Texts.WriteString(W, " done"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END List;
BEGIN Texts.OpenWriter(W); Constructor := Constructor0;
C[LSB.const] := "CONST"; C[LSB.typ] := "TYPE"; C[LSB.var] := "VAR";
C[LSB.lit] := "LIT"; C[LSB.sel] := "SEL"; C[LSB.range] := ":"; C[LSB.cons] := ",";
C[LSB.or] := " | "; C[LSB.xor] := " ^ "; C[LSB.and] := " & "; C[LSB.not] := "~";
C[LSB.add] := " + "; C[LSB.sub] := " - "; C[LSB.mul] := " * "; C[LSB.div] := " / ";
C[LSB.eql] := " == "; C[LSB.neq] := " != "; C[LSB.lss] := " < "; C[LSB.geq] := " >= "; C[LSB.leq] := " <= "; C[LSB.gtr] := " > ";
C[LSB.then] := " ? "; C[LSB.else] := " : "; C[LSB.ts] := "TS"; C[LSB.next] := "--"
END LSV.
MODULE LSV; (*Lola System: display Verilog; generate txt-File; NW 31.8.2015*)
IMPORT Files, Texts, Oberon, LSB;
VAR W: Texts.Writer;
nofgen: INTEGER;
Constructor: PROCEDURE (VAR x: LSB.Item); (*to avoid forward reference*)
F: Files.File; R: Files.Rider;
C: ARRAY 64, 6 OF CHAR;
PROCEDURE Write(ch: CHAR);
BEGIN Files.Write(R, ch)
END Write;
PROCEDURE WriteLn;
BEGIN Files.Write(R, 0DX); Files.Write(R, 0AX)
END WriteLn;
PROCEDURE WriteInt(x: LONGINT); (* x >= 0 *)
VAR i: INTEGER; d: ARRAY 14 OF LONGINT;
BEGIN i := 0;
IF x < 0 THEN Files.Write(R, "-"); x := -x END ;
REPEAT d[i] := x MOD 10; x := x DIV 10; INC(i) UNTIL x = 0;
REPEAT DEC(i); Files.Write(R, CHR(d[i] + 30H)) UNTIL i = 0
END WriteInt;
PROCEDURE WriteHex(x: LONGINT); (*x >= 0*)
VAR i: INTEGER; d: ARRAY 8 OF LONGINT;
BEGIN i := 0;
REPEAT d[i] := x MOD 10H; x := x DIV 10H; INC(i) UNTIL (x = 0) OR (i = 8);
REPEAT DEC(i);
IF d[i] >= 10 THEN Files.Write(R, CHR(d[i] + 37H)) ELSE Files.Write(R, CHR(d[i] + 30H)) END
UNTIL i = 0
END WriteHex;
PROCEDURE WriteString(s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE s[i] # 0X DO Files.Write(R, s[i]); INC(i) END
END WriteString;
(* ------------------------------- *)
PROCEDURE Type(typ: LSB.Type);
VAR obj: LSB.Object;
BEGIN
IF typ IS LSB.ArrayType THEN
IF typ(LSB.ArrayType).eltyp # LSB.bitType THEN
Write("["); WriteInt(typ.len - 1); WriteString(":0]"); Type(typ(LSB.ArrayType).eltyp)
END
ELSIF typ IS LSB.UnitType THEN (* obj := typ(LSB.UnitType).firstobj; *)
END
END Type;
PROCEDURE BitArrLen(typ: LSB.Type);
VAR eltyp: LSB.Type;
BEGIN
IF typ IS LSB.ArrayType THEN
eltyp := typ(LSB.ArrayType).eltyp;
WHILE eltyp IS LSB.ArrayType DO typ := eltyp; eltyp := typ(LSB.ArrayType).eltyp END ;
IF eltyp = LSB.bitType THEN
Write("["); WriteInt(typ.len - 1);WriteString(":0] ")
END
END
END BitArrLen;
PROCEDURE Expression(x: LSB.Item);
VAR z: LSB.Item;
BEGIN
IF x # NIL THEN
IF x IS LSB.Object THEN WriteString(x(LSB.Object).name)
ELSIF x.tag = LSB.cons THEN
Write("{"); Constructor(x); Write("}")
ELSE
IF x.tag = LSB.repl THEN
Write("{"); WriteInt(x.b.val); Write("{"); Expression(x.a);
Write("}"); Write("}")
ELSE
IF (x.tag >= LSB.and) & (x.tag <= LSB.gtr) THEN Write("(") END ;
Expression(x.a);
IF x.tag = LSB.sel THEN Write("["); Expression(x.b); Write("]")
ELSIF x.tag = LSB.lit THEN
IF x.size # 0 THEN WriteInt(x.size); Write("'"); Write("h"); WriteHex(x.val)
ELSE WriteInt(x.val)
END
ELSE WriteString(C[x.tag]); Expression(x.b)
END ;
IF (x.tag >= LSB.and) & (x.tag <= LSB.gtr) THEN Write(")") END
END
END
END
END Expression;
PROCEDURE Elem(VAR x: LSB.Item);
BEGIN
IF x.tag = LSB.repl THEN
Write("{"); WriteInt(x.b.val); Write("{"); Expression(x.a); WriteString("}}")
ELSE Expression(x)
END
END Elem;
PROCEDURE Constructor0(VAR x: LSB.Item);
BEGIN
IF x.tag = LSB.cons THEN Constructor(x.a); WriteString(", "); Elem(x.b) ELSE Elem(x) END
END Constructor0;
PROCEDURE Declaration(obj: LSB.Object);
VAR apar: LSB.Item; typ: LSB.Type;
BEGIN typ := obj.type;
IF obj.type IS LSB.UnitType THEN WriteString("unit ") ELSE Type(obj.type) END ;
IF obj.tag = LSB.var THEN
IF obj.type IS LSB.UnitType THEN
apar := obj.a; WriteLn; Write("[");
WHILE apar # NIL DO Expression(apar.b); apar := apar.a END ;
Write("]")
END
ELSIF obj.tag = LSB.const THEN WriteString(" = "); WriteInt(obj.val)
END
END Declaration;
PROCEDURE ObjList0(obj: LSB.Object); (*declarations*)
VAR obj1: LSB.Object; param: BOOLEAN;
BEGIN param := TRUE;
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) THEN
IF obj.val <= 1 THEN WriteString("reg ")
ELSIF obj.val = 2 THEN WriteString("wire ")
ELSIF obj.val = 3 THEN WriteString("output ")
ELSIF obj.val = 4 THEN WriteString("output reg ")
ELSIF obj.val = 5 THEN WriteString("inout ")
ELSIF obj.val = 6 THEN WriteString("input ")
ELSE WriteString("??? ")
END ;
BitArrLen(obj.type); WriteString(obj.name);
obj1 := obj.next;
WHILE (obj1 # LSB.top) & (obj1.type = obj.type) & (obj1.val = obj.val) DO
WriteString(", "); obj := obj1; WriteString(obj.name); obj1 := obj.next
END ;
IF param & (obj.val >= 3) & (obj1.val < 3) THEN (*end param list*) param := FALSE; Write(")")
END ;
IF (obj.type # LSB.bitType) & (obj.type(LSB.ArrayType).eltyp # LSB.bitType) THEN Type(obj.type) END ;
IF param THEN Write(",") ELSE Write(";") END ;
WriteLn
ELSIF obj.tag = LSB.const THEN
END ;
obj := obj.next
END
END ObjList0;
PROCEDURE ActParam(VAR x: LSB.Item; fpar: LSB.Object);
BEGIN Write("."); WriteString(fpar.name); Write("("); Expression(x); Write(")")
END ActParam;
PROCEDURE ObjList1(obj: LSB.Object); (*assignments to variables*)
VAR apar, x: LSB.Item; fpar: LSB.Object; size: LONGINT;
BEGIN
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) OR (obj.tag = LSB.const) THEN
IF obj.type IS LSB.UnitType THEN
WriteString(obj.type.typobj.name); Write(" "); WriteString(obj.name);
apar := obj.b; fpar := obj.type(LSB.UnitType).firstobj;
Write("("); ActParam(apar.b, fpar); apar := apar.a; fpar := fpar.next; (*actual param list*)
WHILE apar # NIL DO WriteString(", "); ActParam(apar.b, fpar); apar := apar.a; fpar := fpar.next END ;
Write(")"); Write(";"); WriteLn
ELSIF (obj.b # NIL) & (obj.val = 5) THEN (*tri-state*)
size := obj.type.size; x := obj.b;
IF x.tag = LSB.ts THEN
IF obj.type = LSB.bitType THEN
WriteString("IOBUF block"); INC(nofgen); WriteInt(nofgen); WriteString(" (.IO("); WriteString(obj.name);
WriteString("), .O("); WriteString(x.a(LSB.Object).name); WriteString("), .I("); x := x.b;
IF x.a.type = LSB.bitType THEN Expression(x.a) ELSE WriteString(x.a(LSB.Object).name) END ;
WriteString("), .T(");
IF x.b.type = LSB.bitType THEN Expression(x.b) ELSE WriteString(x.b(LSB.Object).name) END ;
WriteString("));")
ELSE (*array type*)
IF nofgen = 0 THEN WriteString("genvar i;"); WriteLn END ;
INC(nofgen); WriteString("generate"); WriteLn;
WriteString("for (i = 0; i < "); WriteInt(size); WriteString("; i = i+1) begin : bufblock"); WriteInt(nofgen); WriteLn;
WriteString("IOBUF block (.IO("); WriteString(obj.name);
WriteString("[i]), .O("); WriteString(x.a(LSB.Object).name); WriteString("[i]), .I("); x := x.b;
WriteString(x.a(LSB.Object).name); WriteString("[i]), .T(");
IF x.b.type = LSB.bitType THEN Expression(x.b) ELSE WriteString(x.b(LSB.Object).name); WriteString("[i]") END ;
WriteString("));"); WriteLn; WriteString("end"); WriteLn; WriteString("endgenerate")
END ;
WriteLn
END
ELSIF (obj.b # NIL) & (obj.val >= 2) THEN
WriteString("assign "); WriteString(obj.name);
IF (obj.a # NIL) THEN Write("["); Expression(obj.a); Write("]") END ;
WriteString(" = "); Expression(obj.b); Write(";"); WriteLn
END
ELSIF obj.tag = LSB.typ THEN (*instantiation; actual parameters*)
END ;
obj := obj.next
END
END ObjList1;
PROCEDURE ObjList2(obj: LSB.Object); (*assignments to registers*)
VAR apar: LSB.Item; kind: LONGINT; clk: LSB.Item;
BEGIN
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) & ~(obj.type IS LSB.UnitType) & (obj.val < 2) THEN
WriteString("always @ (posedge "); kind := obj.val;
IF kind = 0 THEN Expression(obj.a)
ELSE (*kind = 1*) WriteString("clk")
END ;
WriteString(") begin ");
REPEAT WriteString(obj.name);
IF (kind = 1) & (obj.a # NIL) THEN Write("["); Expression(obj.a); Write("]") END ;
WriteString(" <= "); Expression(obj.b); Write(";"); WriteLn; obj := obj.next
UNTIL (obj = LSB.top) OR (obj.val # kind);
WriteString("end"); WriteLn
ELSE obj := obj.next
END
END
END ObjList2;
PROCEDURE List*;
VAR S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN
Texts.WriteString(W, LSB.modname); Texts.WriteString(W, " translating to "); Texts.WriteString(W, S.s);
F := Files.New(S.s); Files.Set(R, F, 0);
WriteString("`timescale 1ns / 1 ps"); WriteLn; nofgen := 0;
WriteString("module "); WriteString(LSB.modname); WriteString("( // translated from Lola"); WriteLn;
ObjList0(LSB.top); ObjList1(LSB.top); ObjList2(LSB.top);
WriteString("endmodule"); WriteLn;
Files.Register(F); Texts.WriteString(W, " done"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END List;
BEGIN Texts.OpenWriter(W); Constructor := Constructor0;
C[LSB.const] := "CONST"; C[LSB.typ] := "TYPE"; C[LSB.var] := "VAR";
C[LSB.lit] := "LIT"; C[LSB.sel] := "SEL"; C[LSB.range] := ":"; C[LSB.cons] := ",";
C[LSB.or] := " | "; C[LSB.xor] := " ^ "; C[LSB.and] := " & "; C[LSB.not] := "~";
C[LSB.add] := " + "; C[LSB.sub] := " - "; C[LSB.mul] := " * "; C[LSB.div] := " / ";
C[LSB.eql] := " == "; C[LSB.neq] := " != "; C[LSB.lss] := " < "; C[LSB.geq] := " >= "; C[LSB.leq] := " <= "; C[LSB.gtr] := " > ";
C[LSB.then] := " ? "; C[LSB.else] := " : "; C[LSB.ts] := "TS"; C[LSB.next] := "--"
END LSV.

428
src/test/confidence/lola/RISC5.Lola
View file

@ -1,214 +1,214 @@
MODULE RISC5 (IN clk, rst, stallX: BIT; (*NW 26.10.2015*)
IN inbus, codebus: WORD;
OUT adr: [24] BIT;
rd, wr, ben: BIT;
outbus: WORD);
CONST StartAdr = 3FF800H'22;
TYPE PROM := MODULE (IN clk: BIT;
IN adr: [9] BIT;
OUT data: WORD) ^;
Multiplier := MODULE (IN clk, run, u: BIT;
OUT stall: BIT;
IN x, y: WORD;
OUT z: [64] BIT) ^;
Divider := MODULE (IN clk, run, u: BIT;
OUT stall: BIT;
IN x, y: WORD;
OUT quot, rem: WORD) ^;
FPAdder := MODULE (IN clk, run, u, v: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
FPMultiplier := MODULE (IN clk, run: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
FPDivider := MODULE (IN clk, run: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
REG (clk) PC: [22] BIT; (*program counter*)
IR: WORD; (*instruction register*)
N, Z, C, OV: BIT; (*condition flags*)
stall1, PMsel: BIT;
R: [16] WORD; (*data registers*)
H: WORD; (*auxiliary register*)
VAR PM: PROM; (*mem for boot loader*)
mulUnit: Multiplier;
divUnit: Divider;
faddUnit: FPAdder;
fmulUnit: FPMultiplier;
fdivUnit: FPDivider;
pcmux, nxpc: [22] BIT;
cond, S: BIT;
sa, sb, sc: BIT;
ins, pmout: WORD;
p, q, u, v, w: BIT; (*instruction fields*)
op, ira, ira0, irb, irc: [4] BIT;
cc: [3] BIT;
imm: [16] BIT;
off: [20] BIT;
offL: [24] BIT;
regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD: BIT;
sc1, sc0: [2] BIT; (*shift counts*)
a0, a1, a2, a3: BIT;
inbusL, outbusB0, outbusB1, outbusB2, outbusB3: BYTE;
inbusH: [24] BIT;
A, B, C0, C1, aluRes, regmux: WORD;
s1, s2, s3, t1, t2, t3: WORD; (*shifting*)
quotient, remainder: WORD;
product: [64] BIT;
fsum, fprod, fquot: WORD;
Add, Sub, Mul, Div: BIT;
Fadd, Fsub, Fmul, Fdiv: BIT;
Ldr, Str, Br: BIT;
BEGIN PM(clk, pcmux[8:0], pmout);
mulUnit (clk, Mul, ~u, stallM, B, C1, product);
divUnit (clk, Div, ~u, stallD, B, C1, quotient, remainder);
faddUnit (clk, Fadd|Fsub, u, v, stallFA, B, {Fsub^C0.31, C0[30:0]}, fsum);
fmulUnit (clk, Fmul, stallFM, B, C0, fprod);
fdivUnit (clk, Fdiv, stallFD, B, C0, fquot);
ins := PMsel -> pmout : IR; (*current instruction*)
p := ins.31; (*instruction fields*)
q := ins.30;
u := ins.29;
v := ins.28;
w := ins.16;
cc:= ins[26:24];
ira := ins[27:24];
irb := ins[23:20];
op := ins[19:16];
irc := ins[3:0];
imm := ins[15:0]; (*reg instr*)
off := ins[19:0]; (*mem instr*)
offL := ins[23:0]; (*branch instr*)
Add := ~p & (op = 8);
Sub := ~p & (op = 9);
Mul := ~p & (op = 10);
Div := ~p & (op = 11);
Fadd := ~p & (op = 12);
Fsub := ~p & (op = 13);
Fmul := ~p & (op = 14);
Fdiv := ~p & (op = 15);
Ldr := p & ~q & ~u;
Str := p & ~q & u;
Br := p & q;
(*ALU*)
A := R[ira0]; (*main data path*)
B := R[irb];
C0 := R[irc];
C1 := q -> {v!16, imm} : C0 ;
ira0 := Br -> 15'4 : ira;
adr := stallL -> B[23:0] + {0'4, off} : {pcmux, 0'2};
rd := Ldr & ~stallX & ~stall1;
wr := Str & ~stallX & ~stall1;
ben := p & ~q & v & ~stallX & ~stall1; (*byte enable*)
sc0 := C1[1:0];
sc1 := C1[3:2];
(*right shifter*)
s1 := (sc0 = 3) -> {(w -> B[2:0] : {B.31 ! 3}), B[31:3]} :
(sc0 = 2) -> {(w -> B[1:0] : {B.31 ! 2}), B[31:2]} :
(sc0 = 1) -> {(w -> B.0 : B.31), B[31:1]} : B;
s2 := (sc1 = 3) -> {(w -> s1[11:0] : {B.31 ! 12}), s1[31:12]} :
(sc1 = 2) -> {(w -> s1[7:0] : {B.31 ! 8}), s1[31:8]} :
(sc1 = 1) -> {(w -> s1[3:0] : {B.31 ! 4}), s1[31:4]} : s1;
s3 := C1.4 -> {(w -> s2[15:0] : {s2.31 ! 16}), s2[31:16]} : s2;
(*left shifter*)
t1 := (sc0 = 3) -> {B[28:0], 0'3} :
(sc0 = 2) -> {B[29:0], 0'2} :
(sc0 = 1) -> {B[30:0], 0'1} : B;
t2 := (sc1 = 3) -> {t1[19:0], 0'12} :
(sc1 = 2) -> {t1[23:0], 0'8} :
(sc1 = 1) -> {t1[27:0], 0'4} : t1;
t3 := C1.4 -> {t2[15:0], 0'16} : t2;
aluRes :=
~op.3 ->
(~op.2 ->
(~op.1 ->
(~op.0 -> (*Mov*)
(q ->
(~u -> {v!16 , imm} : {imm, 0'16}) :
(~u -> C0 : (~v -> H : {N, Z, C, OV, 0'20, 58H'8}))) :
t3 ): (*Lsl*)
s3) : (*Asr, Ror*)
(~op.1 ->
(~op.0 -> B & C1 : B & ~C1) : (*And, Ann*)
(~op.0 -> B | C1 : B ^ C1)) ): (*Ior, Xor*)
(~op.2 ->
(~op.1 ->
(~op.0 -> B + C + (u&C) : B - C1 - (u&C)) : (*Add, Sub*)
(~op.0 -> product[31:0] : quotient)) : (*Mul, Div*)
(~op.1 ->
fsum : (*Fad, Fsb*)
(~op.0 -> fprod : fquot))) ; (*Fml, Fdv*)
regwr := ~p & ~stall | (Ldr & ~stallX & ~stall1) | (Br & cond & v & ~stallX);
a0 := ~adr.1 & ~adr.0;
a1 := ~adr.1 & adr.0;
a2 := adr.1 & ~adr.0;
a3 := adr.1 & adr.0;
inbusL := (~ben | a0) -> inbus[7:0] : a1 -> inbus[15:8] : a2 -> inbus[23:16] : inbus[31:24];
inbusH := ~ben -> inbus[31:8] : 0'24;
regmux := Ldr -> {inbusH, inbusL} : (Br & v) -> {0'8, nxpc, 0'2} : aluRes ;
outbusB0 := A[7:0];
outbusB1 := ben & a1 -> A[7:0] : A[15:8];
outbusB2 := ben & a2 -> A[7:0] : A[23:16];
outbusB3 := ben & a3 -> A[7:0] : A[31:24];
outbus := {outbusB3, outbusB2, outbusB1, outbusB0};
(*control unit*)
S := N ^ OV;
nxpc := PC + 1;
cond := ins.27 ^ (
(cc = 0) & N | (*MI, PL*)
(cc = 1) & Z | (*EQ, NE*)
(cc = 2) & C | (*CS, CC*)
(cc = 3) & OV | (*VS, VC*)
(cc = 4) & (C|Z) | (*LS, HI*)
(cc = 5) & S | (*LT, GE*)
(cc = 6) & (S|Z) | (*LE, GT*)
(cc = 7));
pcmux := ~rst -> 3FF800H'22 :
stall -> PC :
(Br & cond & u) -> offL[21:0] + nxpc :
(Br & cond & ~u) -> C0[23:2] : nxpc;
sa := aluRes.31;
sb := B.31;
sc := C1.31;
stall := stallL | stallM | stallD | stallFA | stallFM | stallFD | stallX;
stallL := (Ldr | Str) & ~stall1;
(*assignments to registers*)
PC := pcmux;
PMsel := ~rst | (pcmux[21:12] = 03FFH'10);
IR := stall -> IR : codebus;
stall1 := stallX -> stall1 : stallL;
R[ira0] := regwr -> regmux : A;
N := regwr -> regmux.31 : N;
Z := regwr -> (regmux = 0) : Z;
C := Add -> (sb&sc) | (~sa&~sb&sc) | (~sa&sb&~sc&sa) :
Sub -> (~sb&sc) | (sa&~sb&~sc) | (sa&sb&sc) : C;
OV := Add -> (sa&~sb&~sc) | (~sa&sb&sc) :
Sub -> (sa&~sb&sc) | (~sa&sb&~sc) : OV;
H := Mul -> product[63:32] : Div -> remainder : H
END RISC5.
MODULE RISC5 (IN clk, rst, stallX: BIT; (*NW 26.10.2015*)
IN inbus, codebus: WORD;
OUT adr: [24] BIT;
rd, wr, ben: BIT;
outbus: WORD);
CONST StartAdr = 3FF800H'22;
TYPE PROM := MODULE (IN clk: BIT;
IN adr: [9] BIT;
OUT data: WORD) ^;
Multiplier := MODULE (IN clk, run, u: BIT;
OUT stall: BIT;
IN x, y: WORD;
OUT z: [64] BIT) ^;
Divider := MODULE (IN clk, run, u: BIT;
OUT stall: BIT;
IN x, y: WORD;
OUT quot, rem: WORD) ^;
FPAdder := MODULE (IN clk, run, u, v: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
FPMultiplier := MODULE (IN clk, run: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
FPDivider := MODULE (IN clk, run: BIT; OUT stall: BIT;
IN x, y: WORD; OUT z: WORD) ^;
REG (clk) PC: [22] BIT; (*program counter*)
IR: WORD; (*instruction register*)
N, Z, C, OV: BIT; (*condition flags*)
stall1, PMsel: BIT;
R: [16] WORD; (*data registers*)
H: WORD; (*auxiliary register*)
VAR PM: PROM; (*mem for boot loader*)
mulUnit: Multiplier;
divUnit: Divider;
faddUnit: FPAdder;
fmulUnit: FPMultiplier;
fdivUnit: FPDivider;
pcmux, nxpc: [22] BIT;
cond, S: BIT;
sa, sb, sc: BIT;
ins, pmout: WORD;
p, q, u, v, w: BIT; (*instruction fields*)
op, ira, ira0, irb, irc: [4] BIT;
cc: [3] BIT;
imm: [16] BIT;
off: [20] BIT;
offL: [24] BIT;
regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD: BIT;
sc1, sc0: [2] BIT; (*shift counts*)
a0, a1, a2, a3: BIT;
inbusL, outbusB0, outbusB1, outbusB2, outbusB3: BYTE;
inbusH: [24] BIT;
A, B, C0, C1, aluRes, regmux: WORD;
s1, s2, s3, t1, t2, t3: WORD; (*shifting*)
quotient, remainder: WORD;
product: [64] BIT;
fsum, fprod, fquot: WORD;
Add, Sub, Mul, Div: BIT;
Fadd, Fsub, Fmul, Fdiv: BIT;
Ldr, Str, Br: BIT;
BEGIN PM(clk, pcmux[8:0], pmout);
mulUnit (clk, Mul, ~u, stallM, B, C1, product);
divUnit (clk, Div, ~u, stallD, B, C1, quotient, remainder);
faddUnit (clk, Fadd|Fsub, u, v, stallFA, B, {Fsub^C0.31, C0[30:0]}, fsum);
fmulUnit (clk, Fmul, stallFM, B, C0, fprod);
fdivUnit (clk, Fdiv, stallFD, B, C0, fquot);
ins := PMsel -> pmout : IR; (*current instruction*)
p := ins.31; (*instruction fields*)
q := ins.30;
u := ins.29;
v := ins.28;
w := ins.16;
cc:= ins[26:24];
ira := ins[27:24];
irb := ins[23:20];
op := ins[19:16];
irc := ins[3:0];
imm := ins[15:0]; (*reg instr*)
off := ins[19:0]; (*mem instr*)
offL := ins[23:0]; (*branch instr*)
Add := ~p & (op = 8);
Sub := ~p & (op = 9);
Mul := ~p & (op = 10);
Div := ~p & (op = 11);
Fadd := ~p & (op = 12);
Fsub := ~p & (op = 13);
Fmul := ~p & (op = 14);
Fdiv := ~p & (op = 15);
Ldr := p & ~q & ~u;
Str := p & ~q & u;
Br := p & q;
(*ALU*)
A := R[ira0]; (*main data path*)
B := R[irb];
C0 := R[irc];
C1 := q -> {v!16, imm} : C0 ;
ira0 := Br -> 15'4 : ira;
adr := stallL -> B[23:0] + {0'4, off} : {pcmux, 0'2};
rd := Ldr & ~stallX & ~stall1;
wr := Str & ~stallX & ~stall1;
ben := p & ~q & v & ~stallX & ~stall1; (*byte enable*)
sc0 := C1[1:0];
sc1 := C1[3:2];
(*right shifter*)
s1 := (sc0 = 3) -> {(w -> B[2:0] : {B.31 ! 3}), B[31:3]} :
(sc0 = 2) -> {(w -> B[1:0] : {B.31 ! 2}), B[31:2]} :
(sc0 = 1) -> {(w -> B.0 : B.31), B[31:1]} : B;
s2 := (sc1 = 3) -> {(w -> s1[11:0] : {B.31 ! 12}), s1[31:12]} :
(sc1 = 2) -> {(w -> s1[7:0] : {B.31 ! 8}), s1[31:8]} :
(sc1 = 1) -> {(w -> s1[3:0] : {B.31 ! 4}), s1[31:4]} : s1;
s3 := C1.4 -> {(w -> s2[15:0] : {s2.31 ! 16}), s2[31:16]} : s2;
(*left shifter*)
t1 := (sc0 = 3) -> {B[28:0], 0'3} :
(sc0 = 2) -> {B[29:0], 0'2} :
(sc0 = 1) -> {B[30:0], 0'1} : B;
t2 := (sc1 = 3) -> {t1[19:0], 0'12} :
(sc1 = 2) -> {t1[23:0], 0'8} :
(sc1 = 1) -> {t1[27:0], 0'4} : t1;
t3 := C1.4 -> {t2[15:0], 0'16} : t2;
aluRes :=
~op.3 ->
(~op.2 ->
(~op.1 ->
(~op.0 -> (*Mov*)
(q ->
(~u -> {v!16 , imm} : {imm, 0'16}) :
(~u -> C0 : (~v -> H : {N, Z, C, OV, 0'20, 58H'8}))) :
t3 ): (*Lsl*)
s3) : (*Asr, Ror*)
(~op.1 ->
(~op.0 -> B & C1 : B & ~C1) : (*And, Ann*)
(~op.0 -> B | C1 : B ^ C1)) ): (*Ior, Xor*)
(~op.2 ->
(~op.1 ->
(~op.0 -> B + C + (u&C) : B - C1 - (u&C)) : (*Add, Sub*)
(~op.0 -> product[31:0] : quotient)) : (*Mul, Div*)
(~op.1 ->
fsum : (*Fad, Fsb*)
(~op.0 -> fprod : fquot))) ; (*Fml, Fdv*)
regwr := ~p & ~stall | (Ldr & ~stallX & ~stall1) | (Br & cond & v & ~stallX);
a0 := ~adr.1 & ~adr.0;
a1 := ~adr.1 & adr.0;
a2 := adr.1 & ~adr.0;
a3 := adr.1 & adr.0;
inbusL := (~ben | a0) -> inbus[7:0] : a1 -> inbus[15:8] : a2 -> inbus[23:16] : inbus[31:24];
inbusH := ~ben -> inbus[31:8] : 0'24;
regmux := Ldr -> {inbusH, inbusL} : (Br & v) -> {0'8, nxpc, 0'2} : aluRes ;
outbusB0 := A[7:0];
outbusB1 := ben & a1 -> A[7:0] : A[15:8];
outbusB2 := ben & a2 -> A[7:0] : A[23:16];
outbusB3 := ben & a3 -> A[7:0] : A[31:24];
outbus := {outbusB3, outbusB2, outbusB1, outbusB0};
(*control unit*)
S := N ^ OV;
nxpc := PC + 1;
cond := ins.27 ^ (
(cc = 0) & N | (*MI, PL*)
(cc = 1) & Z | (*EQ, NE*)
(cc = 2) & C | (*CS, CC*)
(cc = 3) & OV | (*VS, VC*)
(cc = 4) & (C|Z) | (*LS, HI*)
(cc = 5) & S | (*LT, GE*)
(cc = 6) & (S|Z) | (*LE, GT*)
(cc = 7));
pcmux := ~rst -> 3FF800H'22 :
stall -> PC :
(Br & cond & u) -> offL[21:0] + nxpc :
(Br & cond & ~u) -> C0[23:2] : nxpc;
sa := aluRes.31;
sb := B.31;
sc := C1.31;
stall := stallL | stallM | stallD | stallFA | stallFM | stallFD | stallX;
stallL := (Ldr | Str) & ~stall1;
(*assignments to registers*)
PC := pcmux;
PMsel := ~rst | (pcmux[21:12] = 03FFH'10);
IR := stall -> IR : codebus;
stall1 := stallX -> stall1 : stallL;
R[ira0] := regwr -> regmux : A;
N := regwr -> regmux.31 : N;
Z := regwr -> (regmux = 0) : Z;
C := Add -> (sb&sc) | (~sa&~sb&sc) | (~sa&sb&~sc&sa) :
Sub -> (~sb&sc) | (sa&~sb&~sc) | (sa&sb&sc) : C;
OV := Add -> (sa&~sb&~sc) | (~sa&sb&sc) :
Sub -> (sa&~sb&sc) | (~sa&sb&~sc) : OV;
H := Mul -> product[63:32] : Div -> remainder : H
END RISC5.

226
src/test/confidence/lola/expected
View file

@ -1,113 +1,113 @@
`timescale 1ns / 1 ps
module RISC5( // translated from Lola
input clk, rst, stallX,
input [31:0] inbus, codebus,
output [23:0] adr,
output rd, wr, ben,
output [31:0] outbus);
reg [21:0] PC;
reg [31:0] IR;
reg N, Z, C, OV, stall1, PMsel;
reg [31:0] R[15:0];
reg [31:0] H;
wire [21:0] pcmux, nxpc;
wire cond, S, sa, sb, sc;
wire [31:0] ins, pmout;
wire p, q, u, v, w;
wire [3:0] op, ira, ira0, irb, irc;
wire [2:0] cc;
wire [15:0] imm;
wire [19:0] off;
wire [23:0] offL;
wire regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD;
wire [1:0] sc1, sc0;
wire a0, a1, a2, a3;
wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3;
wire [23:0] inbusH;
wire [31:0] A, B, C0, C1, aluRes, regmux, s1, s2, s3, t1, t2, t3, quotient, remainder;
wire [63:0] product;
wire [31:0] fsum, fprod, fquot;
wire Add, Sub, Mul, Div, Fadd, Fsub, Fmul, Fdiv, Ldr, Str, Br;
assign adr = stallL ? (B[23:0] + {4'h0, off}) : {pcmux, 2'h0};
assign rd = ((Ldr & ~stallX) & ~stall1);
assign wr = ((Str & ~stallX) & ~stall1);
assign ben = ((((p & ~q) & v) & ~stallX) & ~stall1);
assign outbus = {outbusB3, outbusB2, outbusB1, outbusB0};
PROM PM(.clk(clk), .adr(pcmux[8:0]), .data(pmout));
Multiplier mulUnit(.clk(clk), .run(Mul), .u(~u), .stall(stallM), .x(B), .y(C1), .z(product));
Divider divUnit(.clk(clk), .run(Div), .u(~u), .stall(stallD), .x(B), .y(C1), .quot(quotient), .rem(remainder));
FPAdder faddUnit(.clk(clk), .run((Fadd | Fsub)), .u(u), .v(v), .stall(stallFA), .x(B), .y({(Fsub ^ C0[31]), C0[30:0]}), .z(fsum));
FPMultiplier fmulUnit(.clk(clk), .run(Fmul), .stall(stallFM), .x(B), .y(C0), .z(fprod));
FPDivider fdivUnit(.clk(clk), .run(Fdiv), .stall(stallFD), .x(B), .y(C0), .z(fquot));
assign pcmux = ~rst ? 22'h3FF800 : stall ? PC : ((Br & cond) & u) ? (offL[21:0] + nxpc) : ((Br & cond) & ~u) ? C0[23:2] : nxpc;
assign nxpc = (PC + 1);
assign cond = (ins[27] ^ (((((((((cc == 0) & N) | ((cc == 1) & Z)) | ((cc == 2) & C)) | ((cc == 3) & OV)) | ((cc == 4) & (C | Z))) | ((cc == 5) & S)) | ((cc == 6) & (S | Z))) | (cc == 7)));
assign S = (N ^ OV);
assign sa = aluRes[31];
assign sb = B[31];
assign sc = C1[31];
assign ins = PMsel ? pmout : IR;
assign p = ins[31];
assign q = ins[30];
assign u = ins[29];
assign v = ins[28];
assign w = ins[16];
assign op = ins[19:16];
assign ira = ins[27:24];
assign ira0 = Br ? 4'hF : ira;
assign irb = ins[23:20];
assign irc = ins[3:0];
assign cc = ins[26:24];
assign imm = ins[15:0];
assign off = ins[19:0];
assign offL = ins[23:0];
assign regwr = (((~p & ~stall) | ((Ldr & ~stallX) & ~stall1)) | (((Br & cond) & v) & ~stallX));
assign stall = ((((((stallL | stallM) | stallD) | stallFA) | stallFM) | stallFD) | stallX);
assign stallL = ((Ldr | Str) & ~stall1);
assign sc1 = C1[3:2];
assign sc0 = C1[1:0];
assign a0 = (~adr[1] & ~adr[0]);
assign a1 = (~adr[1] & adr[0]);
assign a2 = (adr[1] & ~adr[0]);
assign a3 = (adr[1] & adr[0]);
assign inbusL = (~ben | a0) ? inbus[7:0] : a1 ? inbus[15:8] : a2 ? inbus[23:16] : inbus[31:24];
assign outbusB0 = A[7:0];
assign outbusB1 = (ben & a1) ? A[7:0] : A[15:8];
assign outbusB2 = (ben & a2) ? A[7:0] : A[23:16];
assign outbusB3 = (ben & a3) ? A[7:0] : A[31:24];
assign inbusH = ~ben ? inbus[31:8] : 24'h0;
assign A = R[ira0];
assign B = R[irb];
assign C0 = R[irc];
assign C1 = q ? {{16{v}}, imm} : C0;
assign aluRes = ~op[3] ? ~op[2] ? ~op[1] ? ~op[0] ? q ? ~u ? {{16{v}}, imm} : {imm, 16'h0} : ~u ? C0 : ~v ? H : {N, Z, C, OV, 20'h0, 8'h58} : t3 : s3 : ~op[1] ? ~op[0] ? (B & C1) : (B & ~C1) : ~op[0] ? (B | C1) : (B ^ C1) : ~op[2] ? ~op[1] ? ~op[0] ? ((B + C) + (u & C)) : ((B - C1) - (u & C)) : ~op[0] ? product[31:0] : quotient : ~op[1] ? fsum : ~op[0] ? fprod : fquot;
assign regmux = Ldr ? {inbusH, inbusL} : (Br & v) ? {8'h0, nxpc, 2'h0} : aluRes;
assign s1 = (sc0 == 3) ? {w ? B[2:0] : {3{B[31]}}, B[31:3]} : (sc0 == 2) ? {w ? B[1:0] : {2{B[31]}}, B[31:2]} : (sc0 == 1) ? {w ? B[0] : B[31], B[31:1]} : B;
assign s2 = (sc1 == 3) ? {w ? s1[11:0] : {12{B[31]}}, s1[31:12]} : (sc1 == 2) ? {w ? s1[7:0] : {8{B[31]}}, s1[31:8]} : (sc1 == 1) ? {w ? s1[3:0] : {4{B[31]}}, s1[31:4]} : s1;
assign s3 = C1[4] ? {w ? s2[15:0] : {16{s2[31]}}, s2[31:16]} : s2;
assign t1 = (sc0 == 3) ? {B[28:0], 3'h0} : (sc0 == 2) ? {B[29:0], 2'h0} : (sc0 == 1) ? {B[30:0], 1'h0} : B;
assign t2 = (sc1 == 3) ? {t1[19:0], 12'h0} : (sc1 == 2) ? {t1[23:0], 8'h0} : (sc1 == 1) ? {t1[27:0], 4'h0} : t1;
assign t3 = C1[4] ? {t2[15:0], 16'h0} : t2;
assign Add = (~p & (op == 8));
assign Sub = (~p & (op == 9));
assign Mul = (~p & (op == 10));
assign Div = (~p & (op == 11));
assign Fadd = (~p & (op == 12));
assign Fsub = (~p & (op == 13));
assign Fmul = (~p & (op == 14));
assign Fdiv = (~p & (op == 15));
assign Ldr = ((p & ~q) & ~u);
assign Str = ((p & ~q) & u);
assign Br = (p & q);
always @ (posedge clk) begin PC <= pcmux;
IR <= stall ? IR : codebus;
N <= regwr ? regmux[31] : N;
Z <= regwr ? (regmux == 0) : Z;
C <= Add ? (((sb & sc) | ((~sa & ~sb) & sc)) | (((~sa & sb) & ~sc) & sa)) : Sub ? (((~sb & sc) | ((sa & ~sb) & ~sc)) | ((sa & sb) & sc)) : C;
OV <= Add ? (((sa & ~sb) & ~sc) | ((~sa & sb) & sc)) : Sub ? (((sa & ~sb) & sc) | ((~sa & sb) & ~sc)) : OV;
stall1 <= stallX ? stall1 : stallL;
PMsel <= (~rst | (pcmux[21:12] == 10'h3FF));
R[ira0] <= regwr ? regmux : A;
H <= Mul ? product[63:32] : Div ? remainder : H;
end
endmodule
`timescale 1ns / 1 ps
module RISC5( // translated from Lola
input clk, rst, stallX,
input [31:0] inbus, codebus,
output [23:0] adr,
output rd, wr, ben,
output [31:0] outbus);
reg [21:0] PC;
reg [31:0] IR;
reg N, Z, C, OV, stall1, PMsel;
reg [31:0] R[15:0];
reg [31:0] H;
wire [21:0] pcmux, nxpc;
wire cond, S, sa, sb, sc;
wire [31:0] ins, pmout;
wire p, q, u, v, w;
wire [3:0] op, ira, ira0, irb, irc;
wire [2:0] cc;
wire [15:0] imm;
wire [19:0] off;
wire [23:0] offL;
wire regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD;
wire [1:0] sc1, sc0;
wire a0, a1, a2, a3;
wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3;
wire [23:0] inbusH;
wire [31:0] A, B, C0, C1, aluRes, regmux, s1, s2, s3, t1, t2, t3, quotient, remainder;
wire [63:0] product;
wire [31:0] fsum, fprod, fquot;
wire Add, Sub, Mul, Div, Fadd, Fsub, Fmul, Fdiv, Ldr, Str, Br;
assign adr = stallL ? (B[23:0] + {4'h0, off}) : {pcmux, 2'h0};
assign rd = ((Ldr & ~stallX) & ~stall1);
assign wr = ((Str & ~stallX) & ~stall1);
assign ben = ((((p & ~q) & v) & ~stallX) & ~stall1);
assign outbus = {outbusB3, outbusB2, outbusB1, outbusB0};
PROM PM(.clk(clk), .adr(pcmux[8:0]), .data(pmout));
Multiplier mulUnit(.clk(clk), .run(Mul), .u(~u), .stall(stallM), .x(B), .y(C1), .z(product));
Divider divUnit(.clk(clk), .run(Div), .u(~u), .stall(stallD), .x(B), .y(C1), .quot(quotient), .rem(remainder));
FPAdder faddUnit(.clk(clk), .run((Fadd | Fsub)), .u(u), .v(v), .stall(stallFA), .x(B), .y({(Fsub ^ C0[31]), C0[30:0]}), .z(fsum));
FPMultiplier fmulUnit(.clk(clk), .run(Fmul), .stall(stallFM), .x(B), .y(C0), .z(fprod));
FPDivider fdivUnit(.clk(clk), .run(Fdiv), .stall(stallFD), .x(B), .y(C0), .z(fquot));
assign pcmux = ~rst ? 22'h3FF800 : stall ? PC : ((Br & cond) & u) ? (offL[21:0] + nxpc) : ((Br & cond) & ~u) ? C0[23:2] : nxpc;
assign nxpc = (PC + 1);
assign cond = (ins[27] ^ (((((((((cc == 0) & N) | ((cc == 1) & Z)) | ((cc == 2) & C)) | ((cc == 3) & OV)) | ((cc == 4) & (C | Z))) | ((cc == 5) & S)) | ((cc == 6) & (S | Z))) | (cc == 7)));
assign S = (N ^ OV);
assign sa = aluRes[31];
assign sb = B[31];
assign sc = C1[31];
assign ins = PMsel ? pmout : IR;
assign p = ins[31];
assign q = ins[30];
assign u = ins[29];
assign v = ins[28];
assign w = ins[16];
assign op = ins[19:16];
assign ira = ins[27:24];
assign ira0 = Br ? 4'hF : ira;
assign irb = ins[23:20];
assign irc = ins[3:0];
assign cc = ins[26:24];
assign imm = ins[15:0];
assign off = ins[19:0];
assign offL = ins[23:0];
assign regwr = (((~p & ~stall) | ((Ldr & ~stallX) & ~stall1)) | (((Br & cond) & v) & ~stallX));
assign stall = ((((((stallL | stallM) | stallD) | stallFA) | stallFM) | stallFD) | stallX);
assign stallL = ((Ldr | Str) & ~stall1);
assign sc1 = C1[3:2];
assign sc0 = C1[1:0];
assign a0 = (~adr[1] & ~adr[0]);
assign a1 = (~adr[1] & adr[0]);
assign a2 = (adr[1] & ~adr[0]);
assign a3 = (adr[1] & adr[0]);
assign inbusL = (~ben | a0) ? inbus[7:0] : a1 ? inbus[15:8] : a2 ? inbus[23:16] : inbus[31:24];
assign outbusB0 = A[7:0];
assign outbusB1 = (ben & a1) ? A[7:0] : A[15:8];
assign outbusB2 = (ben & a2) ? A[7:0] : A[23:16];
assign outbusB3 = (ben & a3) ? A[7:0] : A[31:24];
assign inbusH = ~ben ? inbus[31:8] : 24'h0;
assign A = R[ira0];
assign B = R[irb];
assign C0 = R[irc];
assign C1 = q ? {{16{v}}, imm} : C0;
assign aluRes = ~op[3] ? ~op[2] ? ~op[1] ? ~op[0] ? q ? ~u ? {{16{v}}, imm} : {imm, 16'h0} : ~u ? C0 : ~v ? H : {N, Z, C, OV, 20'h0, 8'h58} : t3 : s3 : ~op[1] ? ~op[0] ? (B & C1) : (B & ~C1) : ~op[0] ? (B | C1) : (B ^ C1) : ~op[2] ? ~op[1] ? ~op[0] ? ((B + C) + (u & C)) : ((B - C1) - (u & C)) : ~op[0] ? product[31:0] : quotient : ~op[1] ? fsum : ~op[0] ? fprod : fquot;
assign regmux = Ldr ? {inbusH, inbusL} : (Br & v) ? {8'h0, nxpc, 2'h0} : aluRes;
assign s1 = (sc0 == 3) ? {w ? B[2:0] : {3{B[31]}}, B[31:3]} : (sc0 == 2) ? {w ? B[1:0] : {2{B[31]}}, B[31:2]} : (sc0 == 1) ? {w ? B[0] : B[31], B[31:1]} : B;
assign s2 = (sc1 == 3) ? {w ? s1[11:0] : {12{B[31]}}, s1[31:12]} : (sc1 == 2) ? {w ? s1[7:0] : {8{B[31]}}, s1[31:8]} : (sc1 == 1) ? {w ? s1[3:0] : {4{B[31]}}, s1[31:4]} : s1;
assign s3 = C1[4] ? {w ? s2[15:0] : {16{s2[31]}}, s2[31:16]} : s2;
assign t1 = (sc0 == 3) ? {B[28:0], 3'h0} : (sc0 == 2) ? {B[29:0], 2'h0} : (sc0 == 1) ? {B[30:0], 1'h0} : B;
assign t2 = (sc1 == 3) ? {t1[19:0], 12'h0} : (sc1 == 2) ? {t1[23:0], 8'h0} : (sc1 == 1) ? {t1[27:0], 4'h0} : t1;
assign t3 = C1[4] ? {t2[15:0], 16'h0} : t2;
assign Add = (~p & (op == 8));
assign Sub = (~p & (op == 9));
assign Mul = (~p & (op == 10));
assign Div = (~p & (op == 11));
assign Fadd = (~p & (op == 12));
assign Fsub = (~p & (op == 13));
assign Fmul = (~p & (op == 14));
assign Fdiv = (~p & (op == 15));
assign Ldr = ((p & ~q) & ~u);
assign Str = ((p & ~q) & u);
assign Br = (p & q);
always @ (posedge clk) begin PC <= pcmux;
IR <= stall ? IR : codebus;
N <= regwr ? regmux[31] : N;
Z <= regwr ? (regmux == 0) : Z;
C <= Add ? (((sb & sc) | ((~sa & ~sb) & sc)) | (((~sa & sb) & ~sc) & sa)) : Sub ? (((~sb & sc) | ((sa & ~sb) & ~sc)) | ((sa & sb) & sc)) : C;
OV <= Add ? (((sa & ~sb) & ~sc) | ((~sa & sb) & sc)) : Sub ? (((sa & ~sb) & sc) | ((~sa & sb) & ~sc)) : OV;
stall1 <= stallX ? stall1 : stallL;
PMsel <= (~rst | (pcmux[21:12] == 10'h3FF));
R[ira0] <= regwr ? regmux : A;
H <= Mul ? product[63:32] : Div ? remainder : H;
end
endmodule

24
src/test/confidence/lola/lola.Mod
View file

@ -1,12 +1,12 @@
MODULE Lola; (* Command line runner for Lola to verilog compilation *)
IMPORT LSB, LSC, LSV, Platform, Console;
BEGIN
IF Platform.ArgCount < 3 THEN
Console.String("Lola - compile lola source to verilog source."); Console.Ln; Console.Ln;
Console.String("usage:"); Console.Ln; Console.Ln;
Console.String(" lola lola-source-file verilog-source-file"); Console.Ln; Console.Ln;
ELSE
LSC.Compile;
IF LSB.modname # "" THEN LSV.List END
END
END Lola.
MODULE Lola; (* Command line runner for Lola to verilog compilation *)
IMPORT LSB, LSC, LSV, Platform, Console;
BEGIN
IF Platform.ArgCount < 3 THEN
Console.String("Lola - compile lola source to verilog source."); Console.Ln; Console.Ln;
Console.String("usage:"); Console.Ln; Console.Ln;
Console.String(" lola lola-source-file verilog-source-file"); Console.Ln; Console.Ln;
ELSE
LSC.Compile;
IF LSB.modname # "" THEN LSV.List END
END
END Lola.

226
src/test/confidence/lola/result
View file

@ -1,113 +1,113 @@
`timescale 1ns / 1 ps
module RISC5( // translated from Lola
input clk, rst, stallX,
input [31:0] inbus, codebus,
output [23:0] adr,
output rd, wr, ben,
output [31:0] outbus);
reg [21:0] PC;
reg [31:0] IR;
reg N, Z, C, OV, stall1, PMsel;
reg [31:0] R[15:0];
reg [31:0] H;
wire [21:0] pcmux, nxpc;
wire cond, S, sa, sb, sc;
wire [31:0] ins, pmout;
wire p, q, u, v, w;
wire [3:0] op, ira, ira0, irb, irc;
wire [2:0] cc;
wire [15:0] imm;
wire [19:0] off;
wire [23:0] offL;
wire regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD;
wire [1:0] sc1, sc0;
wire a0, a1, a2, a3;
wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3;
wire [23:0] inbusH;
wire [31:0] A, B, C0, C1, aluRes, regmux, s1, s2, s3, t1, t2, t3, quotient, remainder;
wire [63:0] product;
wire [31:0] fsum, fprod, fquot;
wire Add, Sub, Mul, Div, Fadd, Fsub, Fmul, Fdiv, Ldr, Str, Br;
assign adr = stallL ? (B[23:0] + {4'h0, off}) : {pcmux, 2'h0};
assign rd = ((Ldr & ~stallX) & ~stall1);
assign wr = ((Str & ~stallX) & ~stall1);
assign ben = ((((p & ~q) & v) & ~stallX) & ~stall1);
assign outbus = {outbusB3, outbusB2, outbusB1, outbusB0};
PROM PM(.clk(clk), .adr(pcmux[8:0]), .data(pmout));
Multiplier mulUnit(.clk(clk), .run(Mul), .u(~u), .stall(stallM), .x(B), .y(C1), .z(product));
Divider divUnit(.clk(clk), .run(Div), .u(~u), .stall(stallD), .x(B), .y(C1), .quot(quotient), .rem(remainder));
FPAdder faddUnit(.clk(clk), .run((Fadd | Fsub)), .u(u), .v(v), .stall(stallFA), .x(B), .y({(Fsub ^ C0[31]), C0[30:0]}), .z(fsum));
FPMultiplier fmulUnit(.clk(clk), .run(Fmul), .stall(stallFM), .x(B), .y(C0), .z(fprod));
FPDivider fdivUnit(.clk(clk), .run(Fdiv), .stall(stallFD), .x(B), .y(C0), .z(fquot));
assign pcmux = ~rst ? 22'h3FF800 : stall ? PC : ((Br & cond) & u) ? (offL[21:0] + nxpc) : ((Br & cond) & ~u) ? C0[23:2] : nxpc;
assign nxpc = (PC + 1);
assign cond = (ins[27] ^ (((((((((cc == 0) & N) | ((cc == 1) & Z)) | ((cc == 2) & C)) | ((cc == 3) & OV)) | ((cc == 4) & (C | Z))) | ((cc == 5) & S)) | ((cc == 6) & (S | Z))) | (cc == 7)));
assign S = (N ^ OV);
assign sa = aluRes[31];
assign sb = B[31];
assign sc = C1[31];
assign ins = PMsel ? pmout : IR;
assign p = ins[31];
assign q = ins[30];
assign u = ins[29];
assign v = ins[28];
assign w = ins[16];
assign op = ins[19:16];
assign ira = ins[27:24];
assign ira0 = Br ? 4'hF : ira;
assign irb = ins[23:20];
assign irc = ins[3:0];
assign cc = ins[26:24];
assign imm = ins[15:0];
assign off = ins[19:0];
assign offL = ins[23:0];
assign regwr = (((~p & ~stall) | ((Ldr & ~stallX) & ~stall1)) | (((Br & cond) & v) & ~stallX));
assign stall = ((((((stallL | stallM) | stallD) | stallFA) | stallFM) | stallFD) | stallX);
assign stallL = ((Ldr | Str) & ~stall1);
assign sc1 = C1[3:2];
assign sc0 = C1[1:0];
assign a0 = (~adr[1] & ~adr[0]);
assign a1 = (~adr[1] & adr[0]);
assign a2 = (adr[1] & ~adr[0]);
assign a3 = (adr[1] & adr[0]);
assign inbusL = (~ben | a0) ? inbus[7:0] : a1 ? inbus[15:8] : a2 ? inbus[23:16] : inbus[31:24];
assign outbusB0 = A[7:0];
assign outbusB1 = (ben & a1) ? A[7:0] : A[15:8];
assign outbusB2 = (ben & a2) ? A[7:0] : A[23:16];
assign outbusB3 = (ben & a3) ? A[7:0] : A[31:24];
assign inbusH = ~ben ? inbus[31:8] : 24'h0;
assign A = R[ira0];
assign B = R[irb];
assign C0 = R[irc];
assign C1 = q ? {{16{v}}, imm} : C0;
assign aluRes = ~op[3] ? ~op[2] ? ~op[1] ? ~op[0] ? q ? ~u ? {{16{v}}, imm} : {imm, 16'h0} : ~u ? C0 : ~v ? H : {N, Z, C, OV, 20'h0, 8'h58} : t3 : s3 : ~op[1] ? ~op[0] ? (B & C1) : (B & ~C1) : ~op[0] ? (B | C1) : (B ^ C1) : ~op[2] ? ~op[1] ? ~op[0] ? ((B + C) + (u & C)) : ((B - C1) - (u & C)) : ~op[0] ? product[31:0] : quotient : ~op[1] ? fsum : ~op[0] ? fprod : fquot;
assign regmux = Ldr ? {inbusH, inbusL} : (Br & v) ? {8'h0, nxpc, 2'h0} : aluRes;
assign s1 = (sc0 == 3) ? {w ? B[2:0] : {3{B[31]}}, B[31:3]} : (sc0 == 2) ? {w ? B[1:0] : {2{B[31]}}, B[31:2]} : (sc0 == 1) ? {w ? B[0] : B[31], B[31:1]} : B;
assign s2 = (sc1 == 3) ? {w ? s1[11:0] : {12{B[31]}}, s1[31:12]} : (sc1 == 2) ? {w ? s1[7:0] : {8{B[31]}}, s1[31:8]} : (sc1 == 1) ? {w ? s1[3:0] : {4{B[31]}}, s1[31:4]} : s1;
assign s3 = C1[4] ? {w ? s2[15:0] : {16{s2[31]}}, s2[31:16]} : s2;
assign t1 = (sc0 == 3) ? {B[28:0], 3'h0} : (sc0 == 2) ? {B[29:0], 2'h0} : (sc0 == 1) ? {B[30:0], 1'h0} : B;
assign t2 = (sc1 == 3) ? {t1[19:0], 12'h0} : (sc1 == 2) ? {t1[23:0], 8'h0} : (sc1 == 1) ? {t1[27:0], 4'h0} : t1;
assign t3 = C1[4] ? {t2[15:0], 16'h0} : t2;
assign Add = (~p & (op == 8));
assign Sub = (~p & (op == 9));
assign Mul = (~p & (op == 10));
assign Div = (~p & (op == 11));
assign Fadd = (~p & (op == 12));
assign Fsub = (~p & (op == 13));
assign Fmul = (~p & (op == 14));
assign Fdiv = (~p & (op == 15));
assign Ldr = ((p & ~q) & ~u);
assign Str = ((p & ~q) & u);
assign Br = (p & q);
always @ (posedge clk) begin PC <= pcmux;
IR <= stall ? IR : codebus;
N <= regwr ? regmux[31] : N;
Z <= regwr ? (regmux == 0) : Z;
C <= Add ? (((sb & sc) | ((~sa & ~sb) & sc)) | (((~sa & sb) & ~sc) & sa)) : Sub ? (((~sb & sc) | ((sa & ~sb) & ~sc)) | ((sa & sb) & sc)) : C;
OV <= Add ? (((sa & ~sb) & ~sc) | ((~sa & sb) & sc)) : Sub ? (((sa & ~sb) & sc) | ((~sa & sb) & ~sc)) : OV;
stall1 <= stallX ? stall1 : stallL;
PMsel <= (~rst | (pcmux[21:12] == 10'h3FF));
R[ira0] <= regwr ? regmux : A;
H <= Mul ? product[63:32] : Div ? remainder : H;
end
endmodule
`timescale 1ns / 1 ps
module RISC5( // translated from Lola
input clk, rst, stallX,
input [31:0] inbus, codebus,
output [23:0] adr,
output rd, wr, ben,
output [31:0] outbus);
reg [21:0] PC;
reg [31:0] IR;
reg N, Z, C, OV, stall1, PMsel;
reg [31:0] R[15:0];
reg [31:0] H;
wire [21:0] pcmux, nxpc;
wire cond, S, sa, sb, sc;
wire [31:0] ins, pmout;
wire p, q, u, v, w;
wire [3:0] op, ira, ira0, irb, irc;
wire [2:0] cc;
wire [15:0] imm;
wire [19:0] off;
wire [23:0] offL;
wire regwr, stall, stallL, stallM, stallD, stallFA, stallFM, stallFD;
wire [1:0] sc1, sc0;
wire a0, a1, a2, a3;
wire [7:0] inbusL, outbusB0, outbusB1, outbusB2, outbusB3;
wire [23:0] inbusH;
wire [31:0] A, B, C0, C1, aluRes, regmux, s1, s2, s3, t1, t2, t3, quotient, remainder;
wire [63:0] product;
wire [31:0] fsum, fprod, fquot;
wire Add, Sub, Mul, Div, Fadd, Fsub, Fmul, Fdiv, Ldr, Str, Br;
assign adr = stallL ? (B[23:0] + {4'h0, off}) : {pcmux, 2'h0};
assign rd = ((Ldr & ~stallX) & ~stall1);
assign wr = ((Str & ~stallX) & ~stall1);
assign ben = ((((p & ~q) & v) & ~stallX) & ~stall1);
assign outbus = {outbusB3, outbusB2, outbusB1, outbusB0};
PROM PM(.clk(clk), .adr(pcmux[8:0]), .data(pmout));
Multiplier mulUnit(.clk(clk), .run(Mul), .u(~u), .stall(stallM), .x(B), .y(C1), .z(product));
Divider divUnit(.clk(clk), .run(Div), .u(~u), .stall(stallD), .x(B), .y(C1), .quot(quotient), .rem(remainder));
FPAdder faddUnit(.clk(clk), .run((Fadd | Fsub)), .u(u), .v(v), .stall(stallFA), .x(B), .y({(Fsub ^ C0[31]), C0[30:0]}), .z(fsum));
FPMultiplier fmulUnit(.clk(clk), .run(Fmul), .stall(stallFM), .x(B), .y(C0), .z(fprod));
FPDivider fdivUnit(.clk(clk), .run(Fdiv), .stall(stallFD), .x(B), .y(C0), .z(fquot));
assign pcmux = ~rst ? 22'h3FF800 : stall ? PC : ((Br & cond) & u) ? (offL[21:0] + nxpc) : ((Br & cond) & ~u) ? C0[23:2] : nxpc;
assign nxpc = (PC + 1);
assign cond = (ins[27] ^ (((((((((cc == 0) & N) | ((cc == 1) & Z)) | ((cc == 2) & C)) | ((cc == 3) & OV)) | ((cc == 4) & (C | Z))) | ((cc == 5) & S)) | ((cc == 6) & (S | Z))) | (cc == 7)));
assign S = (N ^ OV);
assign sa = aluRes[31];
assign sb = B[31];
assign sc = C1[31];
assign ins = PMsel ? pmout : IR;
assign p = ins[31];
assign q = ins[30];
assign u = ins[29];
assign v = ins[28];
assign w = ins[16];
assign op = ins[19:16];
assign ira = ins[27:24];
assign ira0 = Br ? 4'hF : ira;
assign irb = ins[23:20];
assign irc = ins[3:0];
assign cc = ins[26:24];
assign imm = ins[15:0];
assign off = ins[19:0];
assign offL = ins[23:0];
assign regwr = (((~p & ~stall) | ((Ldr & ~stallX) & ~stall1)) | (((Br & cond) & v) & ~stallX));
assign stall = ((((((stallL | stallM) | stallD) | stallFA) | stallFM) | stallFD) | stallX);
assign stallL = ((Ldr | Str) & ~stall1);
assign sc1 = C1[3:2];
assign sc0 = C1[1:0];
assign a0 = (~adr[1] & ~adr[0]);
assign a1 = (~adr[1] & adr[0]);
assign a2 = (adr[1] & ~adr[0]);
assign a3 = (adr[1] & adr[0]);
assign inbusL = (~ben | a0) ? inbus[7:0] : a1 ? inbus[15:8] : a2 ? inbus[23:16] : inbus[31:24];
assign outbusB0 = A[7:0];
assign outbusB1 = (ben & a1) ? A[7:0] : A[15:8];
assign outbusB2 = (ben & a2) ? A[7:0] : A[23:16];
assign outbusB3 = (ben & a3) ? A[7:0] : A[31:24];
assign inbusH = ~ben ? inbus[31:8] : 24'h0;
assign A = R[ira0];
assign B = R[irb];
assign C0 = R[irc];
assign C1 = q ? {{16{v}}, imm} : C0;
assign aluRes = ~op[3] ? ~op[2] ? ~op[1] ? ~op[0] ? q ? ~u ? {{16{v}}, imm} : {imm, 16'h0} : ~u ? C0 : ~v ? H : {N, Z, C, OV, 20'h0, 8'h58} : t3 : s3 : ~op[1] ? ~op[0] ? (B & C1) : (B & ~C1) : ~op[0] ? (B | C1) : (B ^ C1) : ~op[2] ? ~op[1] ? ~op[0] ? ((B + C) + (u & C)) : ((B - C1) - (u & C)) : ~op[0] ? product[31:0] : quotient : ~op[1] ? fsum : ~op[0] ? fprod : fquot;
assign regmux = Ldr ? {inbusH, inbusL} : (Br & v) ? {8'h0, nxpc, 2'h0} : aluRes;
assign s1 = (sc0 == 3) ? {w ? B[2:0] : {3{B[31]}}, B[31:3]} : (sc0 == 2) ? {w ? B[1:0] : {2{B[31]}}, B[31:2]} : (sc0 == 1) ? {w ? B[0] : B[31], B[31:1]} : B;
assign s2 = (sc1 == 3) ? {w ? s1[11:0] : {12{B[31]}}, s1[31:12]} : (sc1 == 2) ? {w ? s1[7:0] : {8{B[31]}}, s1[31:8]} : (sc1 == 1) ? {w ? s1[3:0] : {4{B[31]}}, s1[31:4]} : s1;
assign s3 = C1[4] ? {w ? s2[15:0] : {16{s2[31]}}, s2[31:16]} : s2;
assign t1 = (sc0 == 3) ? {B[28:0], 3'h0} : (sc0 == 2) ? {B[29:0], 2'h0} : (sc0 == 1) ? {B[30:0], 1'h0} : B;
assign t2 = (sc1 == 3) ? {t1[19:0], 12'h0} : (sc1 == 2) ? {t1[23:0], 8'h0} : (sc1 == 1) ? {t1[27:0], 4'h0} : t1;
assign t3 = C1[4] ? {t2[15:0], 16'h0} : t2;
assign Add = (~p & (op == 8));
assign Sub = (~p & (op == 9));
assign Mul = (~p & (op == 10));
assign Div = (~p & (op == 11));
assign Fadd = (~p & (op == 12));
assign Fsub = (~p & (op == 13));
assign Fmul = (~p & (op == 14));
assign Fdiv = (~p & (op == 15));
assign Ldr = ((p & ~q) & ~u);
assign Str = ((p & ~q) & u);
assign Br = (p & q);
always @ (posedge clk) begin PC <= pcmux;
IR <= stall ? IR : codebus;
N <= regwr ? regmux[31] : N;
Z <= regwr ? (regmux == 0) : Z;
C <= Add ? (((sb & sc) | ((~sa & ~sb) & sc)) | (((~sa & sb) & ~sc) & sa)) : Sub ? (((~sb & sc) | ((sa & ~sb) & ~sc)) | ((sa & sb) & sc)) : C;
OV <= Add ? (((sa & ~sb) & ~sc) | ((~sa & sb) & sc)) : Sub ? (((sa & ~sb) & sc) | ((~sa & sb) & ~sc)) : OV;
stall1 <= stallX ? stall1 : stallL;
PMsel <= (~rst | (pcmux[21:12] == 10'h3FF));
R[ira0] <= regwr ? regmux : A;
H <= Mul ? product[63:32] : Div ? remainder : H;
end
endmodule

1170
src/voc07R/CompatTexts.Mod
View file

File diff suppressed because it is too large Load diff

292
src/voc07R/Fonts.Mod
View file

@ -1,146 +1,146 @@
MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*)
IMPORT SYSTEM, Files := CompatFiles;
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
BYTE = CHAR;
CONST FontFileId = 0DBH;
TYPE Font* = POINTER TO FontDesc;
FontDesc* = RECORD
name*: ARRAY 32 OF CHAR;
height*, minX*, maxX*, minY*, maxY*: INTEGER;
next*: Font;
T: ARRAY 128 OF INTEGER;
raster: ARRAY 2360 OF BYTE
END ;
LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ;
LargeFont = POINTER TO LargeFontDesc;
(* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983,
Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302 *)
VAR Default*, root*: Font;
PROCEDURE GetPat*(fnt: Font; ch: CHAR; VAR dx, x, y, w, h, patadr: INTEGER);
VAR pa: INTEGER; dxb, xb, yb, wb, hb: BYTE;
BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa;
SYSTEM.GET(pa-3, dxb); SYSTEM.GET(pa-2, xb); SYSTEM.GET(pa-1, yb); SYSTEM.GET(pa, wb); SYSTEM.GET(pa+1, hb);
(*dx := dxb;*)
dx := ORD(dxb); (* voc adaptation by noch *)
(*x := xb;*)
x := ORD(xb); (* voc adaptation by noch *)
(*y := yb;*)
y := ORD(yb); (* voc adaptation by noch *)
(*w := wb;*)
w := ORD(wb); (* voc adaptation by noch *)
(*h := hb;*)
h := ORD(hb); (* voc adaptation by noch *)
(*IF yb < 128 THEN y := yb ELSE y := yb - 256 END*)
IF ORD(yb) < 128 THEN y := ORD(yb) ELSE y := ORD(yb) - 256 END (* voc adaptation by noch *)
END GetPat;
PROCEDURE This*(name: ARRAY OF CHAR): Font;
TYPE RunRec = RECORD beg, end: BYTE END ;
BoxRec = RECORD dx, x, y, w, h: BYTE END ;
VAR F: Font; LF: LargeFont;
f: Files.File; R: Files.Rider;
NofRuns, NofBoxes: BYTE;
NofBytes: INTEGER;
height, minX, maxX, minY, maxY: BYTE;
i, j, k, m, n: INTEGER;
a, a0: INTEGER;
b, beg, end: BYTE;
run: ARRAY 16 OF RunRec;
box: ARRAY 512 OF BoxRec;
PROCEDURE RdInt16(VAR R: Files.Rider; VAR b0: BYTE);
VAR b1: BYTE;
BEGIN Files.ReadByte(R, b0); Files.ReadByte(R, b1)
END RdInt16;
BEGIN F := root;
WHILE (F # NIL) & (name # F.name) DO F := F.next END;
IF F = NIL THEN
f := Files.Old(name);
IF f # NIL THEN
Files.Set(R, f, 0); Files.ReadByte(R, b);
(*IF b = FontFileId THEN*)
IF ORD(b) = FontFileId THEN (* voc adaptation by noch *)
Files.ReadByte(R, b); (*abstraction*)
Files.ReadByte(R, b); (*family*)
Files.ReadByte(R, b); (*variant*)
NEW(F);
(*F.name := name;*)
COPY(name, F.name); (* voc adaptation by noch *)
RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns);
(*NofBoxes := 0;*) (* voc adaptation by noch *)
NofBoxes := 0X;
k := 0;
(*WHILE k # NofRuns DO*)
WHILE k # ORD(NofRuns) DO (* voc adaptation by noch *)
RdInt16(R, beg);
run[k].beg := beg; RdInt16(R, end);
run[k].end := end;
(*NofBoxes := NofBoxes + end - beg;*)
NofBoxes := CHR(ORD(NofBoxes) + ORD(end) - ORD(beg)); (* voc adaptation by noch *)
INC(k)
END;
NofBytes := 5; j := 0;
(*WHILE j # NofBoxes DO*)
WHILE j # ORD(NofBoxes) DO (* voc adaptation by noch *)
RdInt16(R, box[j].dx); RdInt16(R, box[j].x); RdInt16(R, box[j].y);
RdInt16(R, box[j].w); RdInt16(R, box[j].h);
(*NofBytes := NofBytes + 5 + (box[j].w + 7) DIV 8 * box[j].h;*)
NofBytes := (NofBytes + 5 + (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h)); (* voc adaptation by noch *)
INC(j)
END;
IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ;
(*F.name := name;*)
COPY(name, F.name); (* voc adaptation by noch *)
(*F.height := height; F.minX := minX; F.maxX := maxX; F.maxY := maxY;*)
F.height := ORD(height); F.minX := ORD(minX); F.maxX := ORD(maxX); F.maxY := ORD(maxY); (* voc adaptation by noch *)
(*IF minY >= 80H THEN F.minY := minY - 100H ELSE F.minY := minY END ;*)
IF ORD(minY) >= 80H THEN F.minY := ORD(minY) - 100H ELSE F.minY := ORD(minY) END ; (* voc adaptation by noch *)
a0 := SYSTEM.ADR(F.raster);
SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X);
(*null pattern for characters not in a run*)
INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0;
(*WHILE k < NofRuns DO*)
WHILE k < ORD(NofRuns) DO
(*WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END;*)
WHILE (m < ORD(run[k].beg)) & (m < 128) DO F.T[m] := a0; INC(m) END; (* voc adaptation by noch *)
(*WHILE (m < run[k].end) & (m < 128) DO*) (* voc adaptation by noch *)
WHILE (m < ORD(run[k].end)) & (m < 128) DO
F.T[m] := a+3;
SYSTEM.PUT(a, box[j].dx); SYSTEM.PUT(a+1, box[j].x); SYSTEM.PUT(a+2, box[j].y);
SYSTEM.PUT(a+3, box[j].w); SYSTEM.PUT(a+4, box[j].h); INC(a, 5);
(*n := (box[j].w + 7) DIV 8 * box[j].h;*)
n := (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h); (* voc adaptation by noch *)
WHILE n # 0 DO DEC(n); Files.ReadByte(R, b); SYSTEM.PUT(a, b); INC(a) END ;
INC(j); INC(m)
END;
INC(k)
END;
WHILE m < 128 DO F.T[m] := a0; INC(m) END ;
F.next := root; root := F
ELSE (*bad file id*) F := Default
END
ELSE (*font file not available*) F := Default
END
END;
RETURN F
END This;
PROCEDURE Free*; (*remove all but first two from font list*)
VAR f: Font;
BEGIN f := root.next;
IF f # NIL THEN f := f.next END ;
f.next := NIL
END Free;
BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt")
END Fonts.
MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*)
IMPORT SYSTEM, Files := CompatFiles;
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
BYTE = CHAR;
CONST FontFileId = 0DBH;
TYPE Font* = POINTER TO FontDesc;
FontDesc* = RECORD
name*: ARRAY 32 OF CHAR;
height*, minX*, maxX*, minY*, maxY*: INTEGER;
next*: Font;
T: ARRAY 128 OF INTEGER;
raster: ARRAY 2360 OF BYTE
END ;
LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ;
LargeFont = POINTER TO LargeFontDesc;
(* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983,
Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302 *)
VAR Default*, root*: Font;
PROCEDURE GetPat*(fnt: Font; ch: CHAR; VAR dx, x, y, w, h, patadr: INTEGER);
VAR pa: INTEGER; dxb, xb, yb, wb, hb: BYTE;
BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa;
SYSTEM.GET(pa-3, dxb); SYSTEM.GET(pa-2, xb); SYSTEM.GET(pa-1, yb); SYSTEM.GET(pa, wb); SYSTEM.GET(pa+1, hb);
(*dx := dxb;*)
dx := ORD(dxb); (* voc adaptation by noch *)
(*x := xb;*)
x := ORD(xb); (* voc adaptation by noch *)
(*y := yb;*)
y := ORD(yb); (* voc adaptation by noch *)
(*w := wb;*)
w := ORD(wb); (* voc adaptation by noch *)
(*h := hb;*)
h := ORD(hb); (* voc adaptation by noch *)
(*IF yb < 128 THEN y := yb ELSE y := yb - 256 END*)
IF ORD(yb) < 128 THEN y := ORD(yb) ELSE y := ORD(yb) - 256 END (* voc adaptation by noch *)
END GetPat;
PROCEDURE This*(name: ARRAY OF CHAR): Font;
TYPE RunRec = RECORD beg, end: BYTE END ;
BoxRec = RECORD dx, x, y, w, h: BYTE END ;
VAR F: Font; LF: LargeFont;
f: Files.File; R: Files.Rider;
NofRuns, NofBoxes: BYTE;
NofBytes: INTEGER;
height, minX, maxX, minY, maxY: BYTE;
i, j, k, m, n: INTEGER;
a, a0: INTEGER;
b, beg, end: BYTE;
run: ARRAY 16 OF RunRec;
box: ARRAY 512 OF BoxRec;
PROCEDURE RdInt16(VAR R: Files.Rider; VAR b0: BYTE);
VAR b1: BYTE;
BEGIN Files.ReadByte(R, b0); Files.ReadByte(R, b1)
END RdInt16;
BEGIN F := root;
WHILE (F # NIL) & (name # F.name) DO F := F.next END;
IF F = NIL THEN
f := Files.Old(name);
IF f # NIL THEN
Files.Set(R, f, 0); Files.ReadByte(R, b);
(*IF b = FontFileId THEN*)
IF ORD(b) = FontFileId THEN (* voc adaptation by noch *)
Files.ReadByte(R, b); (*abstraction*)
Files.ReadByte(R, b); (*family*)
Files.ReadByte(R, b); (*variant*)
NEW(F);
(*F.name := name;*)
COPY(name, F.name); (* voc adaptation by noch *)
RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns);
(*NofBoxes := 0;*) (* voc adaptation by noch *)
NofBoxes := 0X;
k := 0;
(*WHILE k # NofRuns DO*)
WHILE k # ORD(NofRuns) DO (* voc adaptation by noch *)
RdInt16(R, beg);
run[k].beg := beg; RdInt16(R, end);
run[k].end := end;
(*NofBoxes := NofBoxes + end - beg;*)
NofBoxes := CHR(ORD(NofBoxes) + ORD(end) - ORD(beg)); (* voc adaptation by noch *)
INC(k)
END;
NofBytes := 5; j := 0;
(*WHILE j # NofBoxes DO*)
WHILE j # ORD(NofBoxes) DO (* voc adaptation by noch *)
RdInt16(R, box[j].dx); RdInt16(R, box[j].x); RdInt16(R, box[j].y);
RdInt16(R, box[j].w); RdInt16(R, box[j].h);
(*NofBytes := NofBytes + 5 + (box[j].w + 7) DIV 8 * box[j].h;*)
NofBytes := (NofBytes + 5 + (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h)); (* voc adaptation by noch *)
INC(j)
END;
IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ;
(*F.name := name;*)
COPY(name, F.name); (* voc adaptation by noch *)
(*F.height := height; F.minX := minX; F.maxX := maxX; F.maxY := maxY;*)
F.height := ORD(height); F.minX := ORD(minX); F.maxX := ORD(maxX); F.maxY := ORD(maxY); (* voc adaptation by noch *)
(*IF minY >= 80H THEN F.minY := minY - 100H ELSE F.minY := minY END ;*)
IF ORD(minY) >= 80H THEN F.minY := ORD(minY) - 100H ELSE F.minY := ORD(minY) END ; (* voc adaptation by noch *)
a0 := SYSTEM.ADR(F.raster);
SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X);
(*null pattern for characters not in a run*)
INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0;
(*WHILE k < NofRuns DO*)
WHILE k < ORD(NofRuns) DO
(*WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END;*)
WHILE (m < ORD(run[k].beg)) & (m < 128) DO F.T[m] := a0; INC(m) END; (* voc adaptation by noch *)
(*WHILE (m < run[k].end) & (m < 128) DO*) (* voc adaptation by noch *)
WHILE (m < ORD(run[k].end)) & (m < 128) DO
F.T[m] := a+3;
SYSTEM.PUT(a, box[j].dx); SYSTEM.PUT(a+1, box[j].x); SYSTEM.PUT(a+2, box[j].y);
SYSTEM.PUT(a+3, box[j].w); SYSTEM.PUT(a+4, box[j].h); INC(a, 5);
(*n := (box[j].w + 7) DIV 8 * box[j].h;*)
n := (ORD(box[j].w) + 7) DIV 8 * ORD(box[j].h); (* voc adaptation by noch *)
WHILE n # 0 DO DEC(n); Files.ReadByte(R, b); SYSTEM.PUT(a, b); INC(a) END ;
INC(j); INC(m)
END;
INC(k)
END;
WHILE m < 128 DO F.T[m] := a0; INC(m) END ;
F.next := root; root := F
ELSE (*bad file id*) F := Default
END
ELSE (*font file not available*) F := Default
END
END;
RETURN F
END This;
PROCEDURE Free*; (*remove all but first two from font list*)
VAR f: Font;
BEGIN f := root.next;
IF f # NIL THEN f := f.next END ;
f.next := NIL
END Free;
BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt")
END Fonts.

894
src/voc07R/ORB.Mod
View file

@ -1,447 +1,447 @@
MODULE ORB; (*NW 25.6.2014 in Oberon-07*)
IMPORT Files := CompatFiles (* voc adaptation by noch *)
, ORS;
(*Definition of data types Object and Type, which together form the data structure
called "symbol table". Contains procedures for creation of Objects, and for search:
NewObj, this, thisimport, thisfield (and OpenScope, CloseScope).
Handling of import and export, i.e. reading and writing of "symbol files" is done by procedures
Import and Export. This module contains the list of standard identifiers, with which
the symbol table (universe), and that of the pseudo-module SYSTEM are initialized. *)
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
BYTE = CHAR;
CONST versionkey* = 1; maxTypTab = 64;
(* class values*) Head* = 0;
Const* = 1; Var* = 2; Par* = 3; Fld* = 4; Typ* = 5;
SProc* = 6; SFunc* = 7; Mod* = 8;
(* form values*)
Byte* = 1; Bool* = 2; Char* = 3; Int* = 4; Real* = 5; Set* = 6;
Pointer* = 7; NilTyp* = 8; NoTyp* = 9; Proc* = 10;
String* = 11; Array* = 12; Record* = 13;
TYPE Object* = POINTER TO ObjDesc;
Module* = POINTER TO ModDesc;
Type* = POINTER TO TypeDesc;
ObjDesc*= RECORD
class*, lev*, exno*: INTEGER;
expo*, rdo*: BOOLEAN; (*exported / read-only*)
next*, dsc*: Object;
type*: Type;
name*: ORS.Ident;
val*: LONGINT
END ;
ModDesc* = RECORD (ObjDesc) orgname*: ORS.Ident END ;
TypeDesc* = RECORD
form*, ref*, mno*: INTEGER; (*ref is only used for import/export*)
nofpar*: INTEGER; (*for procedures, extension level for records*)
len*: LONGINT; (*for arrays, len < 0 => open array; for records: adr of descriptor*)
dsc*, typobj*: Object;
base*: Type; (*for arrays, records, pointers*)
size*: LONGINT; (*in bytes; always multiple of 4, except for Byte, Bool and Char*)
END ;
(* Object classes and the meaning of "val":
class val
----------
Var address
Par address
Const value
Fld offset
Typ type descriptor (TD) address
SProc inline code number
SFunc inline code number
Mod key
Type forms and the meaning of "dsc" and "base":
form dsc base
------------------------
Pointer - type of dereferenced object
Proc params result type
Array - type of elements
Record fields extension *)
VAR topScope*, universe, system*: Object;
byteType*, boolType*, charType*: Type;
intType*, realType*, setType*, nilType*, noType*, strType*: Type;
nofmod, Ref: INTEGER;
typtab: ARRAY maxTypTab OF Type;
PROCEDURE NewObj*(VAR obj: Object; id: ORS.Ident; class: INTEGER); (*insert new Object with name id*)
VAR new, x: Object;
BEGIN x := topScope;
WHILE (x.next # NIL) & (x.next.name # id) DO x := x.next END ;
IF x.next = NIL THEN
NEW(new); new.name := id; new.class := class; new.next := NIL; new.rdo := FALSE; new.dsc := NIL;
x.next := new; obj := new
ELSE obj := x.next; ORS.Mark("mult def")
END
END NewObj;
PROCEDURE thisObj*(): Object;
VAR s, x: Object;
BEGIN s := topScope;
REPEAT x := s.next;
WHILE (x # NIL) & (x.name # ORS.id) DO x := x.next END ;
s := s.dsc
UNTIL (x # NIL) OR (s = NIL);
RETURN x
END thisObj;
PROCEDURE thisimport*(mod: Object): Object;
VAR obj: Object;
BEGIN
IF mod.rdo THEN
IF mod.name[0] # 0X THEN
obj := mod.dsc;
WHILE (obj # NIL) & (obj.name # ORS.id) DO obj := obj.next END
ELSE obj := NIL
END
ELSE obj := NIL
END ;
RETURN obj
END thisimport;
PROCEDURE thisfield*(rec: Type): Object;
VAR fld: Object;
BEGIN fld := rec.dsc;
WHILE (fld # NIL) & (fld.name # ORS.id) DO fld := fld.next END ;
RETURN fld
END thisfield;
PROCEDURE OpenScope*;
VAR s: Object;
BEGIN NEW(s); s.class := Head; s.dsc := topScope; s.next := NIL; topScope := s
END OpenScope;
PROCEDURE CloseScope*;
BEGIN topScope := topScope.dsc
END CloseScope;
(*------------------------------- Import ---------------------------------*)
PROCEDURE MakeFileName*(VAR FName: ORS.Ident; name, ext: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0; (*assume name suffix less than 4 characters*)
WHILE (i < ORS.IdLen-5) & (name[i] > 0X) DO FName[i] := name[i]; INC(i) END ;
REPEAT FName[i]:= ext[j]; INC(i); INC(j) UNTIL ext[j] = 0X;
FName[i] := 0X
END MakeFileName;
PROCEDURE ThisModule(name, orgname: ORS.Ident; non: BOOLEAN; key: LONGINT): Object;
VAR mod: Module; obj, obj1: Object;
BEGIN obj1 := topScope; obj := obj1.next; (*search for module*)
WHILE (obj # NIL) & (obj.name # name) DO obj1 := obj; obj := obj1.next END ;
IF obj = NIL THEN (*insert new module*)
NEW(mod); mod.class := Mod; mod.rdo := FALSE;
mod.name := name; mod.orgname := orgname; mod.val := key;
mod.lev := nofmod; INC(nofmod); mod.type := noType; mod.dsc := NIL; mod.next := NIL;
obj1.next := mod; obj := mod
ELSE (*module already present*)
IF non THEN ORS.Mark("invalid import order") END
END ;
RETURN obj
END ThisModule;
PROCEDURE Read(VAR R: Files.Rider; VAR x: INTEGER);
VAR b: BYTE;
BEGIN Files.ReadByte(R, b);
(*IF b < 80H THEN x := b ELSE x := b - 100H END*)
IF b < 80X THEN x := ORD(b) ELSE x := ORD(b) - 100H END (* voc adaptation by noch *)
END Read;
PROCEDURE InType(VAR R: Files.Rider; thismod: Object; VAR T: Type);
VAR key: LONGINT;
ref, class, mno, form, np, readonly: INTEGER;
new, fld, par, obj, mod, impmod: Object;
t: Type;
name, modname: ORS.Ident;
BEGIN Read(R, ref);
IF ref < 0 THEN T := typtab[-ref] (*already read*)
ELSE NEW(t); T := t; typtab[ref] := t; t.mno := thismod.lev;
Read(R, form); t.form := form;
IF form = Pointer THEN InType(R, thismod, t.base); t.size := 4
ELSIF form = Array THEN
InType(R, thismod, t.base); Files.ReadNum(R, t.len); Files.ReadNum(R, t.size)
ELSIF form = Record THEN
InType(R, thismod, t.base);
IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ;
Files.ReadNum(R, t.len); (*TD adr/exno*)
Files.ReadNum(R, t.nofpar); (*ext level*)
Files.ReadNum(R, t.size);
Read(R, class);
WHILE class # 0 DO (*fields*)
NEW(fld); fld.class := class; Files.ReadString(R, fld.name);
IF fld.name[0] # 0X THEN fld.expo := TRUE; InType(R, thismod, fld.type) ELSE fld.expo := FALSE; fld.type := nilType END ;
Files.ReadNum(R, fld.val); fld.next := obj; obj := fld; Read(R, class)
END ;
t.dsc := obj
ELSIF form = Proc THEN
InType(R, thismod, t.base);
obj := NIL; np := 0; Read(R, class);
WHILE class # 0 DO (*parameters*)
NEW(par); par.class := class; Read(R, readonly); par.rdo := readonly = 1;
InType(R, thismod, par.type); par.next := obj; obj := par; INC(np); Read(R, class)
END ;
t.dsc := obj; t.nofpar := np; t.size := 4
END ;
Files.ReadString(R, modname);
IF modname[0] # 0X THEN (*re-import*)
Files.ReadInt(R, key); Files.ReadString(R, name);
mod := ThisModule(modname, modname, FALSE, key);
obj := mod.dsc; (*search type*)
WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ;
IF obj # NIL THEN T := obj.type (*type object found in object list of mod*)
ELSE (*insert new type object in object list of mod*)
NEW(obj); obj.name := name; obj.class := Typ; obj.next := mod.dsc; mod.dsc := obj; obj.type := t;
t.mno := mod.lev; t.typobj := obj; T := t
END ;
typtab[ref] := T
END
END
END InType;
PROCEDURE Import*(VAR modid, modid1: ORS.Ident);
VAR key: LONGINT; class, k: INTEGER;
obj: Object; t: Type;
thismod: Object;
modname, fname: ORS.Ident;
F: Files.File; R: Files.Rider;
BEGIN
IF modid1 = "SYSTEM" THEN
thismod := ThisModule(modid, modid1, TRUE, key); DEC(nofmod);
thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE
ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadInt(R, key); Files.ReadInt(R, key); Files.ReadString(R, modname);
thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE;
Read(R, class); (*version key*)
IF class # versionkey THEN ORS.Mark("wrong version") END ;
Read(R, class);
WHILE class # 0 DO
NEW(obj); obj.class := class; Files.ReadString(R, obj.name);
InType(R, thismod, obj.type); obj.lev := -thismod.lev;
IF class = Typ THEN
t := obj.type; t.typobj := obj; Read(R, k); (*fixup bases of previously declared pointer types*)
WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
ELSE
IF class = Const THEN
IF obj.type.form = Real THEN Files.ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END
ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
END
END ;
obj.next := thismod.dsc; thismod.dsc := obj; Read(R, class)
END ;
ELSE ORS.Mark("import not available")
END
END
END Import;
(*-------------------------------- Export ---------------------------------*)
PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
BEGIN
(*Files.WriteByte(R, x)*)
Files.WriteByte(R, SHORT(SHORT(x))) (* voc adaptation by noch *)
END Write;
PROCEDURE OutType(VAR R: Files.Rider; t: Type);
VAR obj, mod, fld: Object;
PROCEDURE OutPar(VAR R: Files.Rider; par: Object; n: INTEGER);
VAR cl: INTEGER;
BEGIN
IF n > 0 THEN
OutPar(R, par.next, n-1); cl := par.class;
Write(R, cl);
IF par.rdo THEN Write(R, 1) ELSE Write(R, 0) END ;
OutType(R, par.type)
END
END OutPar;
PROCEDURE FindHiddenPointers(VAR R: Files.Rider; typ: Type; offset: LONGINT);
VAR fld: Object; i, n: LONGINT;
BEGIN
IF (typ.form = Pointer) OR (typ.form = NilTyp) THEN Write(R, Fld); Write(R, 0); Files.WriteNum(R, offset)
ELSIF typ.form = Record THEN fld := typ.dsc;
WHILE fld # NIL DO FindHiddenPointers(R, fld.type, fld.val + offset); fld := fld.next END
ELSIF typ.form = Array THEN i := 0; n := typ.len;
WHILE i < n DO FindHiddenPointers(R, typ.base, typ.base.size * i + offset); INC(i) END
END
END FindHiddenPointers;
BEGIN
IF t.ref > 0 THEN (*type was already output*) Write(R, -t.ref)
ELSE obj := t.typobj;
IF obj # NIL THEN Write(R, Ref); t.ref := Ref; INC(Ref) ELSE (*anonymous*) Write(R, 0) END ;
Write(R, t.form);
IF t.form = Pointer THEN OutType(R, t.base)
ELSIF t.form = Array THEN OutType(R, t.base); Files.WriteNum(R, t.len); Files.WriteNum(R, t.size)
ELSIF t.form = Record THEN
IF t.base # NIL THEN OutType(R, t.base) ELSE OutType(R, noType) END ;
IF obj # NIL THEN Files.WriteNum(R, obj.exno) ELSE Write(R, 0) END ;
Files.WriteNum(R, t.nofpar); Files.WriteNum(R, t.size);
fld := t.dsc;
WHILE fld # NIL DO (*fields*)
IF fld.expo THEN
Write(R, Fld); Files.WriteString(R, fld.name); OutType(R, fld.type); Files.WriteNum(R, fld.val)
ELSE FindHiddenPointers(R, fld.type, fld.val) (*offset*)
END ;
fld := fld.next
END ;
Write(R, 0)
ELSIF t.form = Proc THEN OutType(R, t.base); OutPar(R, t.dsc, t.nofpar); Write(R, 0)
END ;
IF (t.mno > 0) & (obj # NIL) THEN (*re-export, output name*)
mod := topScope.next;
WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ;
IF mod # NIL THEN Files.WriteString(R, mod.name); Files.WriteInt(R, mod.val); Files.WriteString(R, obj.name)
ELSE ORS.Mark("re-export not found"); Write(R, 0)
END
ELSE Write(R, 0)
END
END
END OutType;
PROCEDURE Export*(VAR modid: ORS.Ident; VAR newSF: BOOLEAN; VAR key: LONGINT);
VAR x, sum, oldkey: LONGINT;
obj, obj0: Object;
filename: ORS.Ident;
F, F1: Files.File; R, R1: Files.Rider;
BEGIN Ref := Record + 1; MakeFileName(filename, modid, ".smb");
F := Files.New(filename); Files.Set(R, F, 0);
Files.WriteInt(R, 0); (*placeholder*)
Files.WriteInt(R, 0); (*placeholder for key to be inserted at the end*)
Files.WriteString(R, modid); Write(R, versionkey);
obj := topScope.next;
WHILE obj # NIL DO
IF obj.expo THEN
Write(R, obj.class); Files.WriteString(R, obj.name);
OutType(R, obj.type);
IF obj.class = Typ THEN
IF obj.type.form = Record THEN
obj0 := topScope.next; (*check whether this is base of previously declared pointer types*)
WHILE obj0 # obj DO
IF (obj0.type.form = Pointer) & (obj0.type.base = obj.type) & (obj0.type.ref > 0) THEN Write(R, obj0.type.ref) END ;
obj0 := obj0.next
END
END ;
Write(R, 0)
ELSIF obj.class = Const THEN
IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val)
ELSE Files.WriteNum(R, obj.val)
END
ELSIF obj.class = Var THEN
Files.WriteNum(R, obj.exno);
IF obj.type.form = String THEN
Files.WriteNum(R, obj.val DIV 10000H); obj.val := obj.val MOD 10000H
END
END
END ;
obj := obj.next
END ;
REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0;
FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ;
Files.Set(R, F, 0); sum := 0; Files.ReadInt(R, x); (* compute key (checksum) *)
WHILE ~R.eof DO sum := sum + x; Files.ReadInt(R, x) END ;
F1 := Files.Old(filename); (*sum is new key*)
IF F1 # NIL THEN Files.Set(R1, F1, 4); Files.ReadInt(R1, oldkey) ELSE oldkey := sum+1 END ;
IF sum # oldkey THEN
IF newSF OR (F1 = NIL) THEN
key := sum; newSF := TRUE; Files.Set(R, F, 4); Files.WriteInt(R, sum); Files.Register(F) (*insert checksum*)
ELSE ORS.Mark("new symbol file inhibited")
END
ELSE newSF := FALSE; key := sum
END
END Export;
PROCEDURE Init*;
BEGIN topScope := universe; nofmod := 1
END Init;
PROCEDURE type(ref, form: INTEGER; size: LONGINT): Type;
VAR tp: Type;
BEGIN NEW(tp); tp.form := form; tp.size := size; tp.ref := ref; tp.base := NIL;
typtab[ref] := tp; RETURN tp
END type;
PROCEDURE enter(name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT);
VAR obj: Object;
BEGIN
NEW(obj);
(*obj.name := name; *)
COPY(name, obj.name); (* voc adaptation by noch *)
obj.class := cl;
obj.type := type;
obj.val := n;
obj.dsc := NIL;
IF cl = Typ THEN type.typobj := obj END ;
obj.next := system; system := obj
END enter;
BEGIN
byteType := type(Byte, Int, 1);
boolType := type(Bool, Bool, 1);
charType := type(Char, Char,1);
intType := type(Int, Int, 4);
realType := type(Real, Real, 4);
setType := type(Set, Set,4);
nilType := type(NilTyp, NilTyp, 4);
noType := type(NoTyp, NoTyp, 4);
strType := type(String, String, 8);
(*initialize universe with data types and in-line procedures;
LONGINT is synonym to INTEGER, LONGREAL to REAL.
LED, ADC, SBC; LDPSR, LDREG, REG, COND are not in language definition*)
system := NIL; (*n = procno*10 + nofpar*)
enter("UML", SFunc, intType, 132); (*functions*)
enter("SBC", SFunc, intType, 122);
enter("ADC", SFunc, intType, 112);
enter("ROR", SFunc, intType, 92);
enter("ASR", SFunc, intType, 82);
enter("LSL", SFunc, intType, 72);
enter("LEN", SFunc, intType, 61);
enter("CHR", SFunc, charType, 51);
enter("ORD", SFunc, intType, 41);
enter("FLT", SFunc, realType, 31);
enter("FLOOR", SFunc, intType, 21);
enter("ODD", SFunc, boolType, 11);
enter("ABS", SFunc, intType, 1);
enter("LED", SProc, noType, 81); (*procedures*)
enter("UNPK", SProc, noType, 72);
enter("PACK", SProc, noType, 62);
enter("NEW", SProc, noType, 51);
enter("ASSERT", SProc, noType, 41);
enter("EXCL", SProc, noType, 32);
enter("INCL", SProc, noType, 22);
enter("DEC", SProc, noType, 11);
enter("INC", SProc, noType, 1);
enter("SET", Typ, setType, 0); (*types*)
enter("BOOLEAN", Typ, boolType, 0);
enter("BYTE", Typ, byteType, 0);
enter("CHAR", Typ, charType, 0);
enter("LONGREAL", Typ, realType, 0);
enter("REAL", Typ, realType, 0);
enter("LONGINT", Typ, intType, 0);
enter("INTEGER", Typ, intType, 0);
topScope := NIL; OpenScope; topScope.next := system; universe := topScope;
system := NIL; (* initialize "unsafe" pseudo-module SYSTEM*)
enter("H", SFunc, intType, 201); (*functions*)
enter("COND", SFunc, boolType, 191);
enter("SIZE", SFunc, intType, 181);
enter("ADR", SFunc, intType, 171);
enter("VAL", SFunc, intType, 162);
enter("REG", SFunc, intType, 151);
enter("BIT", SFunc, boolType, 142);
enter("LDREG", SProc, noType, 142); (*procedures*)
enter("LDPSR", SProc, noType, 131);
enter("COPY", SProc, noType, 123);
enter("PUT", SProc, noType, 112);
enter("GET", SProc, noType, 102);
END ORB.
MODULE ORB; (*NW 25.6.2014 in Oberon-07*)
IMPORT Files := CompatFiles (* voc adaptation by noch *)
, ORS;
(*Definition of data types Object and Type, which together form the data structure
called "symbol table". Contains procedures for creation of Objects, and for search:
NewObj, this, thisimport, thisfield (and OpenScope, CloseScope).
Handling of import and export, i.e. reading and writing of "symbol files" is done by procedures
Import and Export. This module contains the list of standard identifiers, with which
the symbol table (universe), and that of the pseudo-module SYSTEM are initialized. *)
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
BYTE = CHAR;
CONST versionkey* = 1; maxTypTab = 64;
(* class values*) Head* = 0;
Const* = 1; Var* = 2; Par* = 3; Fld* = 4; Typ* = 5;
SProc* = 6; SFunc* = 7; Mod* = 8;
(* form values*)
Byte* = 1; Bool* = 2; Char* = 3; Int* = 4; Real* = 5; Set* = 6;
Pointer* = 7; NilTyp* = 8; NoTyp* = 9; Proc* = 10;
String* = 11; Array* = 12; Record* = 13;
TYPE Object* = POINTER TO ObjDesc;
Module* = POINTER TO ModDesc;
Type* = POINTER TO TypeDesc;
ObjDesc*= RECORD
class*, lev*, exno*: INTEGER;
expo*, rdo*: BOOLEAN; (*exported / read-only*)
next*, dsc*: Object;
type*: Type;
name*: ORS.Ident;
val*: LONGINT
END ;
ModDesc* = RECORD (ObjDesc) orgname*: ORS.Ident END ;
TypeDesc* = RECORD
form*, ref*, mno*: INTEGER; (*ref is only used for import/export*)
nofpar*: INTEGER; (*for procedures, extension level for records*)
len*: LONGINT; (*for arrays, len < 0 => open array; for records: adr of descriptor*)
dsc*, typobj*: Object;
base*: Type; (*for arrays, records, pointers*)
size*: LONGINT; (*in bytes; always multiple of 4, except for Byte, Bool and Char*)
END ;
(* Object classes and the meaning of "val":
class val
----------
Var address
Par address
Const value
Fld offset
Typ type descriptor (TD) address
SProc inline code number
SFunc inline code number
Mod key
Type forms and the meaning of "dsc" and "base":
form dsc base
------------------------
Pointer - type of dereferenced object
Proc params result type
Array - type of elements
Record fields extension *)
VAR topScope*, universe, system*: Object;
byteType*, boolType*, charType*: Type;
intType*, realType*, setType*, nilType*, noType*, strType*: Type;
nofmod, Ref: INTEGER;
typtab: ARRAY maxTypTab OF Type;
PROCEDURE NewObj*(VAR obj: Object; id: ORS.Ident; class: INTEGER); (*insert new Object with name id*)
VAR new, x: Object;
BEGIN x := topScope;
WHILE (x.next # NIL) & (x.next.name # id) DO x := x.next END ;
IF x.next = NIL THEN
NEW(new); new.name := id; new.class := class; new.next := NIL; new.rdo := FALSE; new.dsc := NIL;
x.next := new; obj := new
ELSE obj := x.next; ORS.Mark("mult def")
END
END NewObj;
PROCEDURE thisObj*(): Object;
VAR s, x: Object;
BEGIN s := topScope;
REPEAT x := s.next;
WHILE (x # NIL) & (x.name # ORS.id) DO x := x.next END ;
s := s.dsc
UNTIL (x # NIL) OR (s = NIL);
RETURN x
END thisObj;
PROCEDURE thisimport*(mod: Object): Object;
VAR obj: Object;
BEGIN
IF mod.rdo THEN
IF mod.name[0] # 0X THEN
obj := mod.dsc;
WHILE (obj # NIL) & (obj.name # ORS.id) DO obj := obj.next END
ELSE obj := NIL
END
ELSE obj := NIL
END ;
RETURN obj
END thisimport;
PROCEDURE thisfield*(rec: Type): Object;
VAR fld: Object;
BEGIN fld := rec.dsc;
WHILE (fld # NIL) & (fld.name # ORS.id) DO fld := fld.next END ;
RETURN fld
END thisfield;
PROCEDURE OpenScope*;
VAR s: Object;
BEGIN NEW(s); s.class := Head; s.dsc := topScope; s.next := NIL; topScope := s
END OpenScope;
PROCEDURE CloseScope*;
BEGIN topScope := topScope.dsc
END CloseScope;
(*------------------------------- Import ---------------------------------*)
PROCEDURE MakeFileName*(VAR FName: ORS.Ident; name, ext: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0; (*assume name suffix less than 4 characters*)
WHILE (i < ORS.IdLen-5) & (name[i] > 0X) DO FName[i] := name[i]; INC(i) END ;
REPEAT FName[i]:= ext[j]; INC(i); INC(j) UNTIL ext[j] = 0X;
FName[i] := 0X
END MakeFileName;
PROCEDURE ThisModule(name, orgname: ORS.Ident; non: BOOLEAN; key: LONGINT): Object;
VAR mod: Module; obj, obj1: Object;
BEGIN obj1 := topScope; obj := obj1.next; (*search for module*)
WHILE (obj # NIL) & (obj.name # name) DO obj1 := obj; obj := obj1.next END ;
IF obj = NIL THEN (*insert new module*)
NEW(mod); mod.class := Mod; mod.rdo := FALSE;
mod.name := name; mod.orgname := orgname; mod.val := key;
mod.lev := nofmod; INC(nofmod); mod.type := noType; mod.dsc := NIL; mod.next := NIL;
obj1.next := mod; obj := mod
ELSE (*module already present*)
IF non THEN ORS.Mark("invalid import order") END
END ;
RETURN obj
END ThisModule;
PROCEDURE Read(VAR R: Files.Rider; VAR x: INTEGER);
VAR b: BYTE;
BEGIN Files.ReadByte(R, b);
(*IF b < 80H THEN x := b ELSE x := b - 100H END*)
IF b < 80X THEN x := ORD(b) ELSE x := ORD(b) - 100H END (* voc adaptation by noch *)
END Read;
PROCEDURE InType(VAR R: Files.Rider; thismod: Object; VAR T: Type);
VAR key: LONGINT;
ref, class, mno, form, np, readonly: INTEGER;
new, fld, par, obj, mod, impmod: Object;
t: Type;
name, modname: ORS.Ident;
BEGIN Read(R, ref);
IF ref < 0 THEN T := typtab[-ref] (*already read*)
ELSE NEW(t); T := t; typtab[ref] := t; t.mno := thismod.lev;
Read(R, form); t.form := form;
IF form = Pointer THEN InType(R, thismod, t.base); t.size := 4
ELSIF form = Array THEN
InType(R, thismod, t.base); Files.ReadNum(R, t.len); Files.ReadNum(R, t.size)
ELSIF form = Record THEN
InType(R, thismod, t.base);
IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ;
Files.ReadNum(R, t.len); (*TD adr/exno*)
Files.ReadNum(R, t.nofpar); (*ext level*)
Files.ReadNum(R, t.size);
Read(R, class);
WHILE class # 0 DO (*fields*)
NEW(fld); fld.class := class; Files.ReadString(R, fld.name);
IF fld.name[0] # 0X THEN fld.expo := TRUE; InType(R, thismod, fld.type) ELSE fld.expo := FALSE; fld.type := nilType END ;
Files.ReadNum(R, fld.val); fld.next := obj; obj := fld; Read(R, class)
END ;
t.dsc := obj
ELSIF form = Proc THEN
InType(R, thismod, t.base);
obj := NIL; np := 0; Read(R, class);
WHILE class # 0 DO (*parameters*)
NEW(par); par.class := class; Read(R, readonly); par.rdo := readonly = 1;
InType(R, thismod, par.type); par.next := obj; obj := par; INC(np); Read(R, class)
END ;
t.dsc := obj; t.nofpar := np; t.size := 4
END ;
Files.ReadString(R, modname);
IF modname[0] # 0X THEN (*re-import*)
Files.ReadInt(R, key); Files.ReadString(R, name);
mod := ThisModule(modname, modname, FALSE, key);
obj := mod.dsc; (*search type*)
WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ;
IF obj # NIL THEN T := obj.type (*type object found in object list of mod*)
ELSE (*insert new type object in object list of mod*)
NEW(obj); obj.name := name; obj.class := Typ; obj.next := mod.dsc; mod.dsc := obj; obj.type := t;
t.mno := mod.lev; t.typobj := obj; T := t
END ;
typtab[ref] := T
END
END
END InType;
PROCEDURE Import*(VAR modid, modid1: ORS.Ident);
VAR key: LONGINT; class, k: INTEGER;
obj: Object; t: Type;
thismod: Object;
modname, fname: ORS.Ident;
F: Files.File; R: Files.Rider;
BEGIN
IF modid1 = "SYSTEM" THEN
thismod := ThisModule(modid, modid1, TRUE, key); DEC(nofmod);
thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE
ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadInt(R, key); Files.ReadInt(R, key); Files.ReadString(R, modname);
thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE;
Read(R, class); (*version key*)
IF class # versionkey THEN ORS.Mark("wrong version") END ;
Read(R, class);
WHILE class # 0 DO
NEW(obj); obj.class := class; Files.ReadString(R, obj.name);
InType(R, thismod, obj.type); obj.lev := -thismod.lev;
IF class = Typ THEN
t := obj.type; t.typobj := obj; Read(R, k); (*fixup bases of previously declared pointer types*)
WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
ELSE
IF class = Const THEN
IF obj.type.form = Real THEN Files.ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END
ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
END
END ;
obj.next := thismod.dsc; thismod.dsc := obj; Read(R, class)
END ;
ELSE ORS.Mark("import not available")
END
END
END Import;
(*-------------------------------- Export ---------------------------------*)
PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
BEGIN
(*Files.WriteByte(R, x)*)
Files.WriteByte(R, SHORT(SHORT(x))) (* voc adaptation by noch *)
END Write;
PROCEDURE OutType(VAR R: Files.Rider; t: Type);
VAR obj, mod, fld: Object;
PROCEDURE OutPar(VAR R: Files.Rider; par: Object; n: INTEGER);
VAR cl: INTEGER;
BEGIN
IF n > 0 THEN
OutPar(R, par.next, n-1); cl := par.class;
Write(R, cl);
IF par.rdo THEN Write(R, 1) ELSE Write(R, 0) END ;
OutType(R, par.type)
END
END OutPar;
PROCEDURE FindHiddenPointers(VAR R: Files.Rider; typ: Type; offset: LONGINT);
VAR fld: Object; i, n: LONGINT;
BEGIN
IF (typ.form = Pointer) OR (typ.form = NilTyp) THEN Write(R, Fld); Write(R, 0); Files.WriteNum(R, offset)
ELSIF typ.form = Record THEN fld := typ.dsc;
WHILE fld # NIL DO FindHiddenPointers(R, fld.type, fld.val + offset); fld := fld.next END
ELSIF typ.form = Array THEN i := 0; n := typ.len;
WHILE i < n DO FindHiddenPointers(R, typ.base, typ.base.size * i + offset); INC(i) END
END
END FindHiddenPointers;
BEGIN
IF t.ref > 0 THEN (*type was already output*) Write(R, -t.ref)
ELSE obj := t.typobj;
IF obj # NIL THEN Write(R, Ref); t.ref := Ref; INC(Ref) ELSE (*anonymous*) Write(R, 0) END ;
Write(R, t.form);
IF t.form = Pointer THEN OutType(R, t.base)
ELSIF t.form = Array THEN OutType(R, t.base); Files.WriteNum(R, t.len); Files.WriteNum(R, t.size)
ELSIF t.form = Record THEN
IF t.base # NIL THEN OutType(R, t.base) ELSE OutType(R, noType) END ;
IF obj # NIL THEN Files.WriteNum(R, obj.exno) ELSE Write(R, 0) END ;
Files.WriteNum(R, t.nofpar); Files.WriteNum(R, t.size);
fld := t.dsc;
WHILE fld # NIL DO (*fields*)
IF fld.expo THEN
Write(R, Fld); Files.WriteString(R, fld.name); OutType(R, fld.type); Files.WriteNum(R, fld.val)
ELSE FindHiddenPointers(R, fld.type, fld.val) (*offset*)
END ;
fld := fld.next
END ;
Write(R, 0)
ELSIF t.form = Proc THEN OutType(R, t.base); OutPar(R, t.dsc, t.nofpar); Write(R, 0)
END ;
IF (t.mno > 0) & (obj # NIL) THEN (*re-export, output name*)
mod := topScope.next;
WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ;
IF mod # NIL THEN Files.WriteString(R, mod.name); Files.WriteInt(R, mod.val); Files.WriteString(R, obj.name)
ELSE ORS.Mark("re-export not found"); Write(R, 0)
END
ELSE Write(R, 0)
END
END
END OutType;
PROCEDURE Export*(VAR modid: ORS.Ident; VAR newSF: BOOLEAN; VAR key: LONGINT);
VAR x, sum, oldkey: LONGINT;
obj, obj0: Object;
filename: ORS.Ident;
F, F1: Files.File; R, R1: Files.Rider;
BEGIN Ref := Record + 1; MakeFileName(filename, modid, ".smb");
F := Files.New(filename); Files.Set(R, F, 0);
Files.WriteInt(R, 0); (*placeholder*)
Files.WriteInt(R, 0); (*placeholder for key to be inserted at the end*)
Files.WriteString(R, modid); Write(R, versionkey);
obj := topScope.next;
WHILE obj # NIL DO
IF obj.expo THEN
Write(R, obj.class); Files.WriteString(R, obj.name);
OutType(R, obj.type);
IF obj.class = Typ THEN
IF obj.type.form = Record THEN
obj0 := topScope.next; (*check whether this is base of previously declared pointer types*)
WHILE obj0 # obj DO
IF (obj0.type.form = Pointer) & (obj0.type.base = obj.type) & (obj0.type.ref > 0) THEN Write(R, obj0.type.ref) END ;
obj0 := obj0.next
END
END ;
Write(R, 0)
ELSIF obj.class = Const THEN
IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val)
ELSE Files.WriteNum(R, obj.val)
END
ELSIF obj.class = Var THEN
Files.WriteNum(R, obj.exno);
IF obj.type.form = String THEN
Files.WriteNum(R, obj.val DIV 10000H); obj.val := obj.val MOD 10000H
END
END
END ;
obj := obj.next
END ;
REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0;
FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ;
Files.Set(R, F, 0); sum := 0; Files.ReadInt(R, x); (* compute key (checksum) *)
WHILE ~R.eof DO sum := sum + x; Files.ReadInt(R, x) END ;
F1 := Files.Old(filename); (*sum is new key*)
IF F1 # NIL THEN Files.Set(R1, F1, 4); Files.ReadInt(R1, oldkey) ELSE oldkey := sum+1 END ;
IF sum # oldkey THEN
IF newSF OR (F1 = NIL) THEN
key := sum; newSF := TRUE; Files.Set(R, F, 4); Files.WriteInt(R, sum); Files.Register(F) (*insert checksum*)
ELSE ORS.Mark("new symbol file inhibited")
END
ELSE newSF := FALSE; key := sum
END
END Export;
PROCEDURE Init*;
BEGIN topScope := universe; nofmod := 1
END Init;
PROCEDURE type(ref, form: INTEGER; size: LONGINT): Type;
VAR tp: Type;
BEGIN NEW(tp); tp.form := form; tp.size := size; tp.ref := ref; tp.base := NIL;
typtab[ref] := tp; RETURN tp
END type;
PROCEDURE enter(name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT);
VAR obj: Object;
BEGIN
NEW(obj);
(*obj.name := name; *)
COPY(name, obj.name); (* voc adaptation by noch *)
obj.class := cl;
obj.type := type;
obj.val := n;
obj.dsc := NIL;
IF cl = Typ THEN type.typobj := obj END ;
obj.next := system; system := obj
END enter;
BEGIN
byteType := type(Byte, Int, 1);
boolType := type(Bool, Bool, 1);
charType := type(Char, Char,1);
intType := type(Int, Int, 4);
realType := type(Real, Real, 4);
setType := type(Set, Set,4);
nilType := type(NilTyp, NilTyp, 4);
noType := type(NoTyp, NoTyp, 4);
strType := type(String, String, 8);
(*initialize universe with data types and in-line procedures;
LONGINT is synonym to INTEGER, LONGREAL to REAL.
LED, ADC, SBC; LDPSR, LDREG, REG, COND are not in language definition*)
system := NIL; (*n = procno*10 + nofpar*)
enter("UML", SFunc, intType, 132); (*functions*)
enter("SBC", SFunc, intType, 122);
enter("ADC", SFunc, intType, 112);
enter("ROR", SFunc, intType, 92);
enter("ASR", SFunc, intType, 82);
enter("LSL", SFunc, intType, 72);
enter("LEN", SFunc, intType, 61);
enter("CHR", SFunc, charType, 51);
enter("ORD", SFunc, intType, 41);
enter("FLT", SFunc, realType, 31);
enter("FLOOR", SFunc, intType, 21);
enter("ODD", SFunc, boolType, 11);
enter("ABS", SFunc, intType, 1);
enter("LED", SProc, noType, 81); (*procedures*)
enter("UNPK", SProc, noType, 72);
enter("PACK", SProc, noType, 62);
enter("NEW", SProc, noType, 51);
enter("ASSERT", SProc, noType, 41);
enter("EXCL", SProc, noType, 32);
enter("INCL", SProc, noType, 22);
enter("DEC", SProc, noType, 11);
enter("INC", SProc, noType, 1);
enter("SET", Typ, setType, 0); (*types*)
enter("BOOLEAN", Typ, boolType, 0);
enter("BYTE", Typ, byteType, 0);
enter("CHAR", Typ, charType, 0);
enter("LONGREAL", Typ, realType, 0);
enter("REAL", Typ, realType, 0);
enter("LONGINT", Typ, intType, 0);
enter("INTEGER", Typ, intType, 0);
topScope := NIL; OpenScope; topScope.next := system; universe := topScope;
system := NIL; (* initialize "unsafe" pseudo-module SYSTEM*)
enter("H", SFunc, intType, 201); (*functions*)
enter("COND", SFunc, boolType, 191);
enter("SIZE", SFunc, intType, 181);
enter("ADR", SFunc, intType, 171);
enter("VAL", SFunc, intType, 162);
enter("REG", SFunc, intType, 151);
enter("BIT", SFunc, boolType, 142);
enter("LDREG", SProc, noType, 142); (*procedures*)
enter("LDPSR", SProc, noType, 131);
enter("COPY", SProc, noType, 123);
enter("PUT", SProc, noType, 112);
enter("GET", SProc, noType, 102);
END ORB.

2268
src/voc07R/ORG.Mod
View file

File diff suppressed because it is too large Load diff

1994
src/voc07R/ORP.Mod
View file

File diff suppressed because it is too large Load diff

650
src/voc07R/ORS.Mod
View file

@ -1,325 +1,325 @@
MODULE ORS; (* NW 19.9.93 / 1.4.2014 Scanner in Oberon-07*)
IMPORT SYSTEM, Texts := CompatTexts, Oberon; (* CompatTexts is voc adaptation by noch *)
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
(* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
sequence of symbols, i.e identifiers, numbers, strings, and special symbols.
Recognises all Oberon keywords and skips comments. The keywords are
recorded in a table.
Get(sym) delivers next symbol from input text with Reader R.
Mark(msg) records error and delivers error message with Writer W.
If Get delivers ident, then the identifier (a string) is in variable id, if int or char
in ival, if real in rval, and if string in str (and slen) *)
CONST IdLen* = 32;
NKW = 34; (*nof keywords*)
maxExp = 38; stringBufSize = 256;
(*lexical symbols*)
null = 0; times* = 1; rdiv* = 2; div* = 3; mod* = 4;
and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9;
neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14;
in* = 15; is* = 16; arrow* = 17; period* = 18;
char* = 20; int* = 21; real* = 22; false* = 23; true* = 24;
nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29;
lbrace* = 30; ident* = 31;
if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37;
comma* = 40; colon* = 41; becomes* = 42; upto* = 43; rparen* = 44;
rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49;
to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
else* = 55; elsif* = 56; until* = 57; return* = 58;
array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69;
TYPE Ident* = ARRAY IdLen OF CHAR;
VAR ival*, slen*: LONGINT; (*results of Get*)
rval*: REAL;
id*: Ident; (*for identifiers*)
str*: ARRAY stringBufSize OF CHAR;
errcnt*: INTEGER;
ch: CHAR; (*last character read*)
errpos: LONGINT;
R: Texts.Reader;
W: Texts.Writer;
k: INTEGER;
KWX: ARRAY 10 OF INTEGER;
keyTab: ARRAY NKW OF
RECORD sym: INTEGER; id: ARRAY 12 OF CHAR END;
PROCEDURE CopyId*(VAR ident: Ident);
BEGIN ident := id
END CopyId;
PROCEDURE Pos*(): LONGINT;
BEGIN RETURN Texts.Pos(R) - 1
END Pos;
PROCEDURE Mark*(msg: ARRAY OF CHAR);
VAR p: LONGINT;
BEGIN p := Pos();
IF (p > errpos) & (errcnt < 25) THEN
Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " ");
Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf);
Oberon.DumpLog; (* voc adaptation by noch *)
END ;
INC(errcnt); errpos := p + 4
END Mark;
PROCEDURE Identifier(VAR sym: INTEGER);
VAR i, k: INTEGER;
BEGIN i := 0;
REPEAT
IF i < IdLen-1 THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
id[i] := 0X;
IF i < 10 THEN k := KWX[i-1]; (*search for keyword*)
WHILE (id # keyTab[k].id) & (k < KWX[i]) DO INC(k) END ;
IF k < KWX[i] THEN sym := keyTab[k].sym ELSE sym := ident END
ELSE sym := ident
END
END Identifier;
PROCEDURE String;
VAR i: INTEGER;
BEGIN i := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch # 22X) DO
IF ch >= " " THEN
IF i < stringBufSize-1 THEN str[i] := ch; INC(i) ELSE Mark("string too long") END ;
END ;
Texts.Read(R, ch)
END ;
str[i] := 0X; INC(i); Texts.Read(R, ch); slen := i
END String;
PROCEDURE HexString;
VAR i, m, n: INTEGER;
BEGIN i := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch # "$") DO
WHILE (ch = " ") OR (ch = 9X) OR (ch = 0DX) DO Texts.Read(R, ch) END ; (*skip*)
IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H
ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H
ELSE m := 0; Mark("hexdig expected")
END ;
Texts.Read(R, ch);
IF ("0" <= ch) & (ch <= "9") THEN n := ORD(ch) - 30H
ELSIF ("A" <= ch) & (ch <= "F") THEN n := ORD(ch) - 37H
ELSE n := 0; Mark("hexdig expected")
END ;
IF i < stringBufSize THEN str[i] := CHR(m*10H + n); INC(i) ELSE Mark("string too long") END ;
Texts.Read(R, ch)
END ;
Texts.Read(R, ch); slen := i (*no 0X appended!*)
END HexString;
PROCEDURE Ten(e: LONGINT): REAL;
VAR x, t: REAL;
BEGIN x := 1.0; t := 10.0;
WHILE e > 0 DO
IF ODD(e) THEN x := t * x END ;
t := t * t; e := e DIV 2
END ;
RETURN x
END Ten;
PROCEDURE Number(VAR sym: INTEGER);
CONST max = 2147483647 (*2^31 - 1*);
VAR i, k, e, n, s, h: LONGINT; x: REAL;
d: ARRAY 16 OF INTEGER;
negE: BOOLEAN;
BEGIN ival := 0; i := 0; n := 0; k := 0;
REPEAT
IF n < 16 THEN d[n] := ORD(ch)-30H; INC(n) ELSE Mark("too many digits"); n := 0 END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
IF (ch = "H") OR (ch = "R") OR (ch = "X") THEN (*hex*)
REPEAT h := d[i];
IF h >= 10 THEN h := h-7 END ;
k := k*10H + h; INC(i) (*no overflow check*)
UNTIL i = n;
IF ch = "X" THEN sym := char;
IF k < 100H THEN ival := k ELSE Mark("illegal value"); ival := 0 END
ELSIF ch = "R" THEN sym := real; rval := SYSTEM.VAL(REAL, k)
ELSE sym := int; ival := k
END ;
Texts.Read(R, ch)
ELSIF ch = "." THEN
Texts.Read(R, ch);
IF ch = "." THEN (*double dot*) ch := 7FX; (*decimal integer*)
REPEAT
IF d[i] < 10 THEN
IF k <= (max-d[i]) DIV 10 THEN k := k *10 + d[i] ELSE Mark("too large"); k := 0 END
ELSE Mark("bad integer")
END ;
INC(i)
UNTIL i = n;
sym := int; ival := k
ELSE (*real number*) x := 0.0; e := 0;
REPEAT (*integer part*)
(*x := x * 10.0 + FLT(d[i]); *)
x := x * 10.0 + (d[i]); (* voc adaptation by noch *)
INC(i)
UNTIL i = n;
WHILE (ch >= "0") & (ch <= "9") DO (*fraction*)
(*x := x * 10.0 + FLT(ORD(ch) - 30H);*)
x := x * 10.0 + (ORD(ch) - 30H); (* voc adaptation by noch *)
DEC(e);
Texts.Read(R, ch)
END ;
IF (ch = "E") OR (ch = "D") THEN (*scale factor*)
Texts.Read(R, ch); s := 0;
IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch)
ELSE negE := FALSE;
IF ch = "+" THEN Texts.Read(R, ch) END
END ;
IF (ch >= "0") & (ch <= "9") THEN
REPEAT s := s*10 + ORD(ch)-30H; Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch >"9");
IF negE THEN e := e-s ELSE e := e+s END
ELSE Mark("digit?")
END
END ;
IF e < 0 THEN
IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
ELSIF e > 0 THEN
IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0; Mark("too large") END
END ;
sym := real; rval := x
END
ELSE (*decimal integer*)
REPEAT
IF d[i] < 10 THEN
IF k <= (max-d[i]) DIV 10 THEN k := k*10 + d[i] ELSE Mark("too large"); k := 0 END
ELSE Mark("bad integer")
END ;
INC(i)
UNTIL i = n;
sym := int; ival := k
END
END Number;
PROCEDURE comment;
BEGIN Texts.Read(R, ch);
REPEAT
WHILE ~R.eot & (ch # "*") DO
IF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN comment END
ELSE Texts.Read(R, ch)
END
END ;
WHILE ch = "*" DO Texts.Read(R, ch) END
UNTIL (ch = ")") OR R.eot;
IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("unterminated comment") END
END comment;
PROCEDURE Get*(VAR sym: INTEGER);
BEGIN
REPEAT
WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
IF ch < "A" THEN
IF ch < "0" THEN
IF ch = 22X THEN String; sym := string
ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
ELSIF ch = "$" THEN HexString; sym := string
ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
ELSIF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
ELSIF ch = "-" THEN Texts.Read(R, ch); sym := minus
ELSIF ch = "." THEN Texts.Read(R, ch);
IF ch = "." THEN Texts.Read(R, ch); sym := upto ELSE sym := period END
ELSIF ch = "/" THEN Texts.Read(R, ch); sym := rdiv
ELSE Texts.Read(R, ch); (* ! % ' *) sym := null
END
ELSIF ch < ":" THEN Number(sym)
ELSIF ch = ":" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
ELSIF ch = "<" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
ELSIF ch = ">" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
ELSE (* ? @ *) Texts.Read(R, ch); sym := null
END
ELSIF ch < "[" THEN Identifier(sym)
ELSIF ch < "a" THEN
IF ch = "[" THEN sym := lbrak
ELSIF ch = "]" THEN sym := rbrak
ELSIF ch = "^" THEN sym := arrow
ELSE (* _ ` *) sym := null
END ;
Texts.Read(R, ch)
ELSIF ch < "{" THEN Identifier(sym) ELSE
IF ch = "{" THEN sym := lbrace
ELSIF ch = "}" THEN sym := rbrace
ELSIF ch = "|" THEN sym := bar
ELSIF ch = "~" THEN sym := not
ELSIF ch = 7FX THEN sym := upto
ELSE sym := null
END ;
Texts.Read(R, ch)
END
UNTIL sym # null
END Get;
PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
BEGIN errpos := pos; errcnt := 0; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
END Init;
PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR);
BEGIN
(*keyTab[k].id := name; *)
COPY(name, keyTab[k].id); (* voc adaptation by noch *)
keyTab[k].sym := sym;
INC(k)
END EnterKW;
BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0;
EnterKW(if, "IF");
EnterKW(do, "DO");
EnterKW(of, "OF");
EnterKW(or, "OR");
EnterKW(to, "TO");
EnterKW(in, "IN");
EnterKW(is, "IS");
EnterKW(by, "BY");
KWX[2] := k;
EnterKW(end, "END");
EnterKW(nil, "NIL");
EnterKW(var, "VAR");
EnterKW(div, "DIV");
EnterKW(mod, "MOD");
EnterKW(for, "FOR");
KWX[3] := k;
EnterKW(else, "ELSE");
EnterKW(then, "THEN");
EnterKW(true, "TRUE");
EnterKW(type, "TYPE");
EnterKW(case, "CASE");
KWX[4] := k;
EnterKW(elsif, "ELSIF");
EnterKW(false, "FALSE");
EnterKW(array, "ARRAY");
EnterKW(begin, "BEGIN");
EnterKW(const, "CONST");
EnterKW(until, "UNTIL");
EnterKW(while, "WHILE");
KWX[5] := k;
EnterKW(record, "RECORD");
EnterKW(repeat, "REPEAT");
EnterKW(return, "RETURN");
EnterKW(import, "IMPORT");
EnterKW(module, "MODULE");
KWX[6] := k;
EnterKW(pointer, "POINTER");
KWX[7] := k; KWX[8] := k;
EnterKW(procedure, "PROCEDURE");
KWX[9] := k
END ORS.
MODULE ORS; (* NW 19.9.93 / 1.4.2014 Scanner in Oberon-07*)
IMPORT SYSTEM, Texts := CompatTexts, Oberon; (* CompatTexts is voc adaptation by noch *)
TYPE INTEGER = LONGINT; (* voc adaptation by noch *)
(* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
sequence of symbols, i.e identifiers, numbers, strings, and special symbols.
Recognises all Oberon keywords and skips comments. The keywords are
recorded in a table.
Get(sym) delivers next symbol from input text with Reader R.
Mark(msg) records error and delivers error message with Writer W.
If Get delivers ident, then the identifier (a string) is in variable id, if int or char
in ival, if real in rval, and if string in str (and slen) *)
CONST IdLen* = 32;
NKW = 34; (*nof keywords*)
maxExp = 38; stringBufSize = 256;
(*lexical symbols*)
null = 0; times* = 1; rdiv* = 2; div* = 3; mod* = 4;
and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9;
neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14;
in* = 15; is* = 16; arrow* = 17; period* = 18;
char* = 20; int* = 21; real* = 22; false* = 23; true* = 24;
nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29;
lbrace* = 30; ident* = 31;
if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37;
comma* = 40; colon* = 41; becomes* = 42; upto* = 43; rparen* = 44;
rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49;
to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
else* = 55; elsif* = 56; until* = 57; return* = 58;
array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69;
TYPE Ident* = ARRAY IdLen OF CHAR;
VAR ival*, slen*: LONGINT; (*results of Get*)
rval*: REAL;
id*: Ident; (*for identifiers*)
str*: ARRAY stringBufSize OF CHAR;
errcnt*: INTEGER;
ch: CHAR; (*last character read*)
errpos: LONGINT;
R: Texts.Reader;
W: Texts.Writer;
k: INTEGER;
KWX: ARRAY 10 OF INTEGER;
keyTab: ARRAY NKW OF
RECORD sym: INTEGER; id: ARRAY 12 OF CHAR END;
PROCEDURE CopyId*(VAR ident: Ident);
BEGIN ident := id
END CopyId;
PROCEDURE Pos*(): LONGINT;
BEGIN RETURN Texts.Pos(R) - 1
END Pos;
PROCEDURE Mark*(msg: ARRAY OF CHAR);
VAR p: LONGINT;
BEGIN p := Pos();
IF (p > errpos) & (errcnt < 25) THEN
Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " ");
Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf);
Oberon.DumpLog; (* voc adaptation by noch *)
END ;
INC(errcnt); errpos := p + 4
END Mark;
PROCEDURE Identifier(VAR sym: INTEGER);
VAR i, k: INTEGER;
BEGIN i := 0;
REPEAT
IF i < IdLen-1 THEN id[i] := ch; INC(i) END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z");
id[i] := 0X;
IF i < 10 THEN k := KWX[i-1]; (*search for keyword*)
WHILE (id # keyTab[k].id) & (k < KWX[i]) DO INC(k) END ;
IF k < KWX[i] THEN sym := keyTab[k].sym ELSE sym := ident END
ELSE sym := ident
END
END Identifier;
PROCEDURE String;
VAR i: INTEGER;
BEGIN i := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch # 22X) DO
IF ch >= " " THEN
IF i < stringBufSize-1 THEN str[i] := ch; INC(i) ELSE Mark("string too long") END ;
END ;
Texts.Read(R, ch)
END ;
str[i] := 0X; INC(i); Texts.Read(R, ch); slen := i
END String;
PROCEDURE HexString;
VAR i, m, n: INTEGER;
BEGIN i := 0; Texts.Read(R, ch);
WHILE ~R.eot & (ch # "$") DO
WHILE (ch = " ") OR (ch = 9X) OR (ch = 0DX) DO Texts.Read(R, ch) END ; (*skip*)
IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H
ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H
ELSE m := 0; Mark("hexdig expected")
END ;
Texts.Read(R, ch);
IF ("0" <= ch) & (ch <= "9") THEN n := ORD(ch) - 30H
ELSIF ("A" <= ch) & (ch <= "F") THEN n := ORD(ch) - 37H
ELSE n := 0; Mark("hexdig expected")
END ;
IF i < stringBufSize THEN str[i] := CHR(m*10H + n); INC(i) ELSE Mark("string too long") END ;
Texts.Read(R, ch)
END ;
Texts.Read(R, ch); slen := i (*no 0X appended!*)
END HexString;
PROCEDURE Ten(e: LONGINT): REAL;
VAR x, t: REAL;
BEGIN x := 1.0; t := 10.0;
WHILE e > 0 DO
IF ODD(e) THEN x := t * x END ;
t := t * t; e := e DIV 2
END ;
RETURN x
END Ten;
PROCEDURE Number(VAR sym: INTEGER);
CONST max = 2147483647 (*2^31 - 1*);
VAR i, k, e, n, s, h: LONGINT; x: REAL;
d: ARRAY 16 OF INTEGER;
negE: BOOLEAN;
BEGIN ival := 0; i := 0; n := 0; k := 0;
REPEAT
IF n < 16 THEN d[n] := ORD(ch)-30H; INC(n) ELSE Mark("too many digits"); n := 0 END ;
Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F");
IF (ch = "H") OR (ch = "R") OR (ch = "X") THEN (*hex*)
REPEAT h := d[i];
IF h >= 10 THEN h := h-7 END ;
k := k*10H + h; INC(i) (*no overflow check*)
UNTIL i = n;
IF ch = "X" THEN sym := char;
IF k < 100H THEN ival := k ELSE Mark("illegal value"); ival := 0 END
ELSIF ch = "R" THEN sym := real; rval := SYSTEM.VAL(REAL, k)
ELSE sym := int; ival := k
END ;
Texts.Read(R, ch)
ELSIF ch = "." THEN
Texts.Read(R, ch);
IF ch = "." THEN (*double dot*) ch := 7FX; (*decimal integer*)
REPEAT
IF d[i] < 10 THEN
IF k <= (max-d[i]) DIV 10 THEN k := k *10 + d[i] ELSE Mark("too large"); k := 0 END
ELSE Mark("bad integer")
END ;
INC(i)
UNTIL i = n;
sym := int; ival := k
ELSE (*real number*) x := 0.0; e := 0;
REPEAT (*integer part*)
(*x := x * 10.0 + FLT(d[i]); *)
x := x * 10.0 + (d[i]); (* voc adaptation by noch *)
INC(i)
UNTIL i = n;
WHILE (ch >= "0") & (ch <= "9") DO (*fraction*)
(*x := x * 10.0 + FLT(ORD(ch) - 30H);*)
x := x * 10.0 + (ORD(ch) - 30H); (* voc adaptation by noch *)
DEC(e);
Texts.Read(R, ch)
END ;
IF (ch = "E") OR (ch = "D") THEN (*scale factor*)
Texts.Read(R, ch); s := 0;
IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch)
ELSE negE := FALSE;
IF ch = "+" THEN Texts.Read(R, ch) END
END ;
IF (ch >= "0") & (ch <= "9") THEN
REPEAT s := s*10 + ORD(ch)-30H; Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch >"9");
IF negE THEN e := e-s ELSE e := e+s END
ELSE Mark("digit?")
END
END ;
IF e < 0 THEN
IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END
ELSIF e > 0 THEN
IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0; Mark("too large") END
END ;
sym := real; rval := x
END
ELSE (*decimal integer*)
REPEAT
IF d[i] < 10 THEN
IF k <= (max-d[i]) DIV 10 THEN k := k*10 + d[i] ELSE Mark("too large"); k := 0 END
ELSE Mark("bad integer")
END ;
INC(i)
UNTIL i = n;
sym := int; ival := k
END
END Number;
PROCEDURE comment;
BEGIN Texts.Read(R, ch);
REPEAT
WHILE ~R.eot & (ch # "*") DO
IF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN comment END
ELSE Texts.Read(R, ch)
END
END ;
WHILE ch = "*" DO Texts.Read(R, ch) END
UNTIL (ch = ")") OR R.eot;
IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("unterminated comment") END
END comment;
PROCEDURE Get*(VAR sym: INTEGER);
BEGIN
REPEAT
WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END;
IF ch < "A" THEN
IF ch < "0" THEN
IF ch = 22X THEN String; sym := string
ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq
ELSIF ch = "$" THEN HexString; sym := string
ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and
ELSIF ch = "(" THEN Texts.Read(R, ch);
IF ch = "*" THEN sym := null; comment ELSE sym := lparen END
ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen
ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times
ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus
ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma
ELSIF ch = "-" THEN Texts.Read(R, ch); sym := minus
ELSIF ch = "." THEN Texts.Read(R, ch);
IF ch = "." THEN Texts.Read(R, ch); sym := upto ELSE sym := period END
ELSIF ch = "/" THEN Texts.Read(R, ch); sym := rdiv
ELSE Texts.Read(R, ch); (* ! % ' *) sym := null
END
ELSIF ch < ":" THEN Number(sym)
ELSIF ch = ":" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END
ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon
ELSIF ch = "<" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END
ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql
ELSIF ch = ">" THEN Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END
ELSE (* ? @ *) Texts.Read(R, ch); sym := null
END
ELSIF ch < "[" THEN Identifier(sym)
ELSIF ch < "a" THEN
IF ch = "[" THEN sym := lbrak
ELSIF ch = "]" THEN sym := rbrak
ELSIF ch = "^" THEN sym := arrow
ELSE (* _ ` *) sym := null
END ;
Texts.Read(R, ch)
ELSIF ch < "{" THEN Identifier(sym) ELSE
IF ch = "{" THEN sym := lbrace
ELSIF ch = "}" THEN sym := rbrace
ELSIF ch = "|" THEN sym := bar
ELSIF ch = "~" THEN sym := not
ELSIF ch = 7FX THEN sym := upto
ELSE sym := null
END ;
Texts.Read(R, ch)
END
UNTIL sym # null
END Get;
PROCEDURE Init*(T: Texts.Text; pos: LONGINT);
BEGIN errpos := pos; errcnt := 0; Texts.OpenReader(R, T, pos); Texts.Read(R, ch)
END Init;
PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR);
BEGIN
(*keyTab[k].id := name; *)
COPY(name, keyTab[k].id); (* voc adaptation by noch *)
keyTab[k].sym := sym;
INC(k)
END EnterKW;
BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0;
EnterKW(if, "IF");
EnterKW(do, "DO");
EnterKW(of, "OF");
EnterKW(or, "OR");
EnterKW(to, "TO");
EnterKW(in, "IN");
EnterKW(is, "IS");
EnterKW(by, "BY");
KWX[2] := k;
EnterKW(end, "END");
EnterKW(nil, "NIL");
EnterKW(var, "VAR");
EnterKW(div, "DIV");
EnterKW(mod, "MOD");
EnterKW(for, "FOR");
KWX[3] := k;
EnterKW(else, "ELSE");
EnterKW(then, "THEN");
EnterKW(true, "TRUE");
EnterKW(type, "TYPE");
EnterKW(case, "CASE");
KWX[4] := k;
EnterKW(elsif, "ELSIF");
EnterKW(false, "FALSE");
EnterKW(array, "ARRAY");
EnterKW(begin, "BEGIN");
EnterKW(const, "CONST");
EnterKW(until, "UNTIL");
EnterKW(while, "WHILE");
KWX[5] := k;
EnterKW(record, "RECORD");
EnterKW(repeat, "REPEAT");
EnterKW(return, "RETURN");
EnterKW(import, "IMPORT");
EnterKW(module, "MODULE");
KWX[6] := k;
EnterKW(pointer, "POINTER");
KWX[7] := k; KWX[8] := k;
EnterKW(procedure, "PROCEDURE");
KWX[9] := k
END ORS.

502
src/voc07R/ORTool.Mod
View file

@ -1,251 +1,251 @@
MODULE ORTool; (*NW 18.2.2013*)
IMPORT SYSTEM, Files, Texts, Oberon, ORB;
VAR W: Texts.Writer;
Form: INTEGER; (*result of ReadType*)
mnemo0, mnemo1: ARRAY 16, 4 OF CHAR; (*mnemonics*)
PROCEDURE Read(VAR R: Files.Rider; VAR n: INTEGER);
VAR b: BYTE;
BEGIN Files.ReadByte(R, b);
IF b < 80H THEN n := b ELSE n := b - 100H END
END Read;
PROCEDURE ReadType(VAR R: Files.Rider);
VAR key, len, lev, size, off: INTEGER;
ref, mno, class, form, readonly: INTEGER;
name, modname: ARRAY 32 OF CHAR;
BEGIN Read(R, ref); Texts.Write(W, " "); Texts.Write(W, "[");
IF ref < 0 THEN Texts.Write(W, "^"); Texts.WriteInt(W, -ref, 1)
ELSE Texts.WriteInt(W, ref, 1);
Read(R, form); Texts.WriteString(W, " form = "); Texts.WriteInt(W, form, 1);
IF form = ORB.Pointer THEN ReadType(R)
ELSIF form = ORB.Array THEN
ReadType(R); Files.ReadNum(R, len); Files.ReadNum(R, size);
Texts.WriteString(W, " len = "); Texts.WriteInt(W, len, 1);
Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1)
ELSIF form = ORB.Record THEN
ReadType(R); (*base type*)
Files.ReadNum(R, off); Texts.WriteString(W, " exno = "); Texts.WriteInt(W, off, 1);
Files.ReadNum(R, off); Texts.WriteString(W, " extlev = "); Texts.WriteInt(W, off, 1);
Files.ReadNum(R, size); Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1);
Texts.Write(W, " "); Texts.Write(W, "{"); Read(R, class);
WHILE class # 0 DO (*fields*)
Files.ReadString(R, name);
IF name[0] # 0X THEN Texts.Write(W, " "); Texts.WriteString(W, name); ReadType(R)
ELSE Texts.WriteString(W, " --")
END ;
Files.ReadNum(R, off); Texts.WriteInt(W, off, 4); Read(R, class)
END ;
Texts.Write(W, "}")
ELSIF form = ORB.Proc THEN
ReadType(R); Texts.Write(W, "("); Read(R, class);
WHILE class # 0 DO
Texts.WriteString(W, " class = "); Texts.WriteInt(W, class, 1); Read(R, readonly);
IF readonly = 1 THEN Texts.Write(W, "#") END ;
ReadType(R); Read(R, class)
END ;
Texts.Write(W, ")")
END ;
Files.ReadString(R, modname);
IF modname[0] # 0X THEN
Files.ReadInt(R, key); Files.ReadString(R, name);
Texts.Write(W, " "); Texts.WriteString(W, modname); Texts.Write(W, "."); Texts.WriteString(W, name);
Texts.WriteHex(W, key)
END
END ;
Form := form; Texts.Write(W, "]")
END ReadType;
PROCEDURE DecSym*; (*decode symbol file*)
VAR class, typno, k: INTEGER;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, "OR-decode "); Texts.WriteString(W, S.s);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
F := Files.Old(S.s);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadInt(R, k); Files.ReadInt(R, k);
Files.ReadString(R, name); Texts.WriteString(W, name); Texts.WriteHex(W, k);
Read(R, class); Texts.WriteInt(W, class, 3); (*sym file version*)
IF class = ORB.versionkey THEN
Texts.WriteLn(W); Read(R, class);
WHILE class # 0 DO
Texts.WriteInt(W, class, 4); Files.ReadString(R, name); Texts.Write(W, " "); Texts.WriteString(W, name);
ReadType(R);
IF class = ORB.Typ THEN
Texts.Write(W, "("); Read(R, class);
WHILE class # 0 DO (*pointer base fixup*)
Texts.WriteString(W, " ->"); Texts.WriteInt(W, class, 4); Read(R, class)
END ;
Texts.Write(W, ")")
ELSIF (class = ORB.Const) OR (class = ORB.Var) THEN
Files.ReadNum(R, k); Texts.WriteInt(W, k, 5); (*Reals, Strings!*)
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Read(R, class)
END
ELSE Texts.WriteString(W, " bad symfile version")
END
ELSE Texts.WriteString(W, " not found")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END DecSym;
(* ---------------------------------------------------*)
PROCEDURE WriteReg(r: LONGINT);
BEGIN Texts.Write(W, " ");
IF r < 12 THEN Texts.WriteString(W, " R"); Texts.WriteInt(W, r MOD 10H, 1)
ELSIF r = 12 THEN Texts.WriteString(W, "MT")
ELSIF r = 13 THEN Texts.WriteString(W, "SB")
ELSIF r = 14 THEN Texts.WriteString(W, "SP")
ELSE Texts.WriteString(W, "LNK")
END
END WriteReg;
PROCEDURE opcode(w: LONGINT);
VAR k, op, u, a, b, c: LONGINT;
BEGIN
k := w DIV 40000000H MOD 4;
a := w DIV 1000000H MOD 10H;
b := w DIV 100000H MOD 10H;
op := w DIV 10000H MOD 10H;
u := w DIV 20000000H MOD 2;
IF k = 0 THEN
Texts.WriteString(W, mnemo0[op]);
IF u = 1 THEN Texts.Write(W, "'") END ;
WriteReg(a); WriteReg(b); WriteReg(w MOD 10H)
ELSIF k = 1 THEN
Texts.WriteString(W, mnemo0[op]);
IF u = 1 THEN Texts.Write(W, "'") END ;
WriteReg(a); WriteReg(b); w := w MOD 10000H;
IF w >= 8000H THEN w := w - 10000H END ;
Texts.WriteInt(W, w, 7)
ELSIF k = 2 THEN (*LDR/STR*)
IF u = 1 THEN Texts.WriteString(W, "STR ") ELSE Texts.WriteString(W, "LDR") END ;
WriteReg(a); WriteReg(b); w := w MOD 100000H;
IF w >= 80000H THEN w := w - 100000H END ;
Texts.WriteInt(W, w, 8)
ELSIF k = 3 THEN (*Branch instr*)
Texts.Write(W, "B");
IF ODD(w DIV 10000000H) THEN Texts.Write(W, "L") END ;
Texts.WriteString(W, mnemo1[a]);
IF u = 0 THEN WriteReg(w MOD 10H) ELSE
w := w MOD 100000H;
IF w >= 80000H THEN w := w - 100000H END ;
Texts.WriteInt(W, w, 8)
END
END
END opcode;
PROCEDURE Sync(VAR R: Files.Rider);
VAR ch: CHAR;
BEGIN Files.Read(R, ch); Texts.WriteString(W, "Sync "); Texts.Write(W, ch); Texts.WriteLn(W)
END Sync;
PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
BEGIN Files.WriteByte(R, x) (* -128 <= x < 128 *)
END Write;
PROCEDURE DecObj*; (*decode object file*)
VAR class, i, n, key, size, fix, adr, data, len: INTEGER;
ch: CHAR;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); F := Files.Old(S.s);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadString(R, name); Texts.WriteLn(W); Texts.WriteString(W, name);
Files.ReadInt(R, key); Texts.WriteHex(W, key); Read(R, class); Texts.WriteInt(W, class, 4); (*version*)
Files.ReadInt(R, size); Texts.WriteInt(W, size, 6); Texts.WriteLn(W);
Texts.WriteString(W, "imports:"); Texts.WriteLn(W); Files.ReadString(R, name);
WHILE name[0] # 0X DO
Texts.Write(W, 9X); Texts.WriteString(W, name);
Files.ReadInt(R, key); Texts.WriteHex(W, key); Texts.WriteLn(W);
Files.ReadString(R, name)
END ;
(* Sync(R); *)
Texts.WriteString(W, "type descriptors"); Texts.WriteLn(W);
Files.ReadInt(R, n); n := n DIV 4; i := 0;
WHILE i < n DO Files.ReadInt(R, data); Texts.WriteHex(W, data); INC(i) END ;
Texts.WriteLn(W);
Texts.WriteString(W, "data"); Files.ReadInt(R, data); Texts.WriteInt(W, data, 6); Texts.WriteLn(W);
Texts.WriteString(W, "strings"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO Files.Read(R, ch); Texts.Write(W, ch); INC(i) END ;
Texts.WriteLn(W);
Texts.WriteString(W, "code"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO
Files.ReadInt(R, data); Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data);
Texts.Write(W, 9X); opcode(data); Texts.WriteLn(W); INC(i)
END ;
(* Sync(R); *)
Texts.WriteString(W, "commands:"); Texts.WriteLn(W);
Files.ReadString(R, name);
WHILE name[0] # 0X DO
Texts.Write(W, 9X); Texts.WriteString(W, name);
Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 5); Texts.WriteLn(W);
Files.ReadString(R, name)
END ;
(* Sync(R); *)
Texts.WriteString(W, "entries"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO
Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 6); INC(i)
END ;
Texts.WriteLn(W);
(* Sync(R); *)
Texts.WriteString(W, "pointer refs"); Texts.WriteLn(W); Files.ReadInt(R, adr);
WHILE adr # -1 DO Texts.WriteInt(W, adr, 6); Files.ReadInt(R, adr) END ;
Texts.WriteLn(W);
(* Sync(R); *)
Files.ReadInt(R, data); Texts.WriteString(W, "fixP = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "fixD = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "fixT = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "entry = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.Read(R, ch);
IF ch # "O" THEN Texts.WriteString(W, "format eror"); Texts.WriteLn(W) END
(* Sync(R); *)
ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
END ;
Texts.Append(Oberon.Log, W.buf)
END
END DecObj;
BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "ORTool 18.2.2013");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
mnemo0[0] := "MOV";
mnemo0[1] := "LSL";
mnemo0[2] := "ASR";
mnemo0[3] := "ROR";
mnemo0[4] := "AND";
mnemo0[5] := "ANN";
mnemo0[6] := "IOR";
mnemo0[7] := "XOR";
mnemo0[8] := "ADD";
mnemo0[9] := "SUB";
mnemo0[10] := "MUL";
mnemo0[11] := "DIV";
mnemo0[12] := "FAD";
mnemo0[13] := "FSB";
mnemo0[14] := "FML";
mnemo0[15] := "FDV";
mnemo1[0] := "MI ";
mnemo1[8] := "PL";
mnemo1[1] := "EQ ";
mnemo1[9] := "NE ";
mnemo1[2] := "LS ";
mnemo1[10] := "HI ";
mnemo1[5] := "LT ";
mnemo1[13] := "GE ";
mnemo1[6] := "LE ";
mnemo1[14] := "GT ";
mnemo1[15] := "NO ";
END ORTool.
MODULE ORTool; (*NW 18.2.2013*)
IMPORT SYSTEM, Files, Texts, Oberon, ORB;
VAR W: Texts.Writer;
Form: INTEGER; (*result of ReadType*)
mnemo0, mnemo1: ARRAY 16, 4 OF CHAR; (*mnemonics*)
PROCEDURE Read(VAR R: Files.Rider; VAR n: INTEGER);
VAR b: BYTE;
BEGIN Files.ReadByte(R, b);
IF b < 80H THEN n := b ELSE n := b - 100H END
END Read;
PROCEDURE ReadType(VAR R: Files.Rider);
VAR key, len, lev, size, off: INTEGER;
ref, mno, class, form, readonly: INTEGER;
name, modname: ARRAY 32 OF CHAR;
BEGIN Read(R, ref); Texts.Write(W, " "); Texts.Write(W, "[");
IF ref < 0 THEN Texts.Write(W, "^"); Texts.WriteInt(W, -ref, 1)
ELSE Texts.WriteInt(W, ref, 1);
Read(R, form); Texts.WriteString(W, " form = "); Texts.WriteInt(W, form, 1);
IF form = ORB.Pointer THEN ReadType(R)
ELSIF form = ORB.Array THEN
ReadType(R); Files.ReadNum(R, len); Files.ReadNum(R, size);
Texts.WriteString(W, " len = "); Texts.WriteInt(W, len, 1);
Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1)
ELSIF form = ORB.Record THEN
ReadType(R); (*base type*)
Files.ReadNum(R, off); Texts.WriteString(W, " exno = "); Texts.WriteInt(W, off, 1);
Files.ReadNum(R, off); Texts.WriteString(W, " extlev = "); Texts.WriteInt(W, off, 1);
Files.ReadNum(R, size); Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1);
Texts.Write(W, " "); Texts.Write(W, "{"); Read(R, class);
WHILE class # 0 DO (*fields*)
Files.ReadString(R, name);
IF name[0] # 0X THEN Texts.Write(W, " "); Texts.WriteString(W, name); ReadType(R)
ELSE Texts.WriteString(W, " --")
END ;
Files.ReadNum(R, off); Texts.WriteInt(W, off, 4); Read(R, class)
END ;
Texts.Write(W, "}")
ELSIF form = ORB.Proc THEN
ReadType(R); Texts.Write(W, "("); Read(R, class);
WHILE class # 0 DO
Texts.WriteString(W, " class = "); Texts.WriteInt(W, class, 1); Read(R, readonly);
IF readonly = 1 THEN Texts.Write(W, "#") END ;
ReadType(R); Read(R, class)
END ;
Texts.Write(W, ")")
END ;
Files.ReadString(R, modname);
IF modname[0] # 0X THEN
Files.ReadInt(R, key); Files.ReadString(R, name);
Texts.Write(W, " "); Texts.WriteString(W, modname); Texts.Write(W, "."); Texts.WriteString(W, name);
Texts.WriteHex(W, key)
END
END ;
Form := form; Texts.Write(W, "]")
END ReadType;
PROCEDURE DecSym*; (*decode symbol file*)
VAR class, typno, k: INTEGER;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, "OR-decode "); Texts.WriteString(W, S.s);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
F := Files.Old(S.s);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadInt(R, k); Files.ReadInt(R, k);
Files.ReadString(R, name); Texts.WriteString(W, name); Texts.WriteHex(W, k);
Read(R, class); Texts.WriteInt(W, class, 3); (*sym file version*)
IF class = ORB.versionkey THEN
Texts.WriteLn(W); Read(R, class);
WHILE class # 0 DO
Texts.WriteInt(W, class, 4); Files.ReadString(R, name); Texts.Write(W, " "); Texts.WriteString(W, name);
ReadType(R);
IF class = ORB.Typ THEN
Texts.Write(W, "("); Read(R, class);
WHILE class # 0 DO (*pointer base fixup*)
Texts.WriteString(W, " ->"); Texts.WriteInt(W, class, 4); Read(R, class)
END ;
Texts.Write(W, ")")
ELSIF (class = ORB.Const) OR (class = ORB.Var) THEN
Files.ReadNum(R, k); Texts.WriteInt(W, k, 5); (*Reals, Strings!*)
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Read(R, class)
END
ELSE Texts.WriteString(W, " bad symfile version")
END
ELSE Texts.WriteString(W, " not found")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END DecSym;
(* ---------------------------------------------------*)
PROCEDURE WriteReg(r: LONGINT);
BEGIN Texts.Write(W, " ");
IF r < 12 THEN Texts.WriteString(W, " R"); Texts.WriteInt(W, r MOD 10H, 1)
ELSIF r = 12 THEN Texts.WriteString(W, "MT")
ELSIF r = 13 THEN Texts.WriteString(W, "SB")
ELSIF r = 14 THEN Texts.WriteString(W, "SP")
ELSE Texts.WriteString(W, "LNK")
END
END WriteReg;
PROCEDURE opcode(w: LONGINT);
VAR k, op, u, a, b, c: LONGINT;
BEGIN
k := w DIV 40000000H MOD 4;
a := w DIV 1000000H MOD 10H;
b := w DIV 100000H MOD 10H;
op := w DIV 10000H MOD 10H;
u := w DIV 20000000H MOD 2;
IF k = 0 THEN
Texts.WriteString(W, mnemo0[op]);
IF u = 1 THEN Texts.Write(W, "'") END ;
WriteReg(a); WriteReg(b); WriteReg(w MOD 10H)
ELSIF k = 1 THEN
Texts.WriteString(W, mnemo0[op]);
IF u = 1 THEN Texts.Write(W, "'") END ;
WriteReg(a); WriteReg(b); w := w MOD 10000H;
IF w >= 8000H THEN w := w - 10000H END ;
Texts.WriteInt(W, w, 7)
ELSIF k = 2 THEN (*LDR/STR*)
IF u = 1 THEN Texts.WriteString(W, "STR ") ELSE Texts.WriteString(W, "LDR") END ;
WriteReg(a); WriteReg(b); w := w MOD 100000H;
IF w >= 80000H THEN w := w - 100000H END ;
Texts.WriteInt(W, w, 8)
ELSIF k = 3 THEN (*Branch instr*)
Texts.Write(W, "B");
IF ODD(w DIV 10000000H) THEN Texts.Write(W, "L") END ;
Texts.WriteString(W, mnemo1[a]);
IF u = 0 THEN WriteReg(w MOD 10H) ELSE
w := w MOD 100000H;
IF w >= 80000H THEN w := w - 100000H END ;
Texts.WriteInt(W, w, 8)
END
END
END opcode;
PROCEDURE Sync(VAR R: Files.Rider);
VAR ch: CHAR;
BEGIN Files.Read(R, ch); Texts.WriteString(W, "Sync "); Texts.Write(W, ch); Texts.WriteLn(W)
END Sync;
PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
BEGIN Files.WriteByte(R, x) (* -128 <= x < 128 *)
END Write;
PROCEDURE DecObj*; (*decode object file*)
VAR class, i, n, key, size, fix, adr, data, len: INTEGER;
ch: CHAR;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); F := Files.Old(S.s);
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadString(R, name); Texts.WriteLn(W); Texts.WriteString(W, name);
Files.ReadInt(R, key); Texts.WriteHex(W, key); Read(R, class); Texts.WriteInt(W, class, 4); (*version*)
Files.ReadInt(R, size); Texts.WriteInt(W, size, 6); Texts.WriteLn(W);
Texts.WriteString(W, "imports:"); Texts.WriteLn(W); Files.ReadString(R, name);
WHILE name[0] # 0X DO
Texts.Write(W, 9X); Texts.WriteString(W, name);
Files.ReadInt(R, key); Texts.WriteHex(W, key); Texts.WriteLn(W);
Files.ReadString(R, name)
END ;
(* Sync(R); *)
Texts.WriteString(W, "type descriptors"); Texts.WriteLn(W);
Files.ReadInt(R, n); n := n DIV 4; i := 0;
WHILE i < n DO Files.ReadInt(R, data); Texts.WriteHex(W, data); INC(i) END ;
Texts.WriteLn(W);
Texts.WriteString(W, "data"); Files.ReadInt(R, data); Texts.WriteInt(W, data, 6); Texts.WriteLn(W);
Texts.WriteString(W, "strings"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO Files.Read(R, ch); Texts.Write(W, ch); INC(i) END ;
Texts.WriteLn(W);
Texts.WriteString(W, "code"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO
Files.ReadInt(R, data); Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data);
Texts.Write(W, 9X); opcode(data); Texts.WriteLn(W); INC(i)
END ;
(* Sync(R); *)
Texts.WriteString(W, "commands:"); Texts.WriteLn(W);
Files.ReadString(R, name);
WHILE name[0] # 0X DO
Texts.Write(W, 9X); Texts.WriteString(W, name);
Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 5); Texts.WriteLn(W);
Files.ReadString(R, name)
END ;
(* Sync(R); *)
Texts.WriteString(W, "entries"); Texts.WriteLn(W);
Files.ReadInt(R, n); i := 0;
WHILE i < n DO
Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 6); INC(i)
END ;
Texts.WriteLn(W);
(* Sync(R); *)
Texts.WriteString(W, "pointer refs"); Texts.WriteLn(W); Files.ReadInt(R, adr);
WHILE adr # -1 DO Texts.WriteInt(W, adr, 6); Files.ReadInt(R, adr) END ;
Texts.WriteLn(W);
(* Sync(R); *)
Files.ReadInt(R, data); Texts.WriteString(W, "fixP = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "fixD = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "fixT = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.ReadInt(R, data); Texts.WriteString(W, "entry = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W);
Files.Read(R, ch);
IF ch # "O" THEN Texts.WriteString(W, "format eror"); Texts.WriteLn(W) END
(* Sync(R); *)
ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W)
END ;
Texts.Append(Oberon.Log, W.buf)
END
END DecObj;
BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "ORTool 18.2.2013");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
mnemo0[0] := "MOV";
mnemo0[1] := "LSL";
mnemo0[2] := "ASR";
mnemo0[3] := "ROR";
mnemo0[4] := "AND";
mnemo0[5] := "ANN";
mnemo0[6] := "IOR";
mnemo0[7] := "XOR";
mnemo0[8] := "ADD";
mnemo0[9] := "SUB";
mnemo0[10] := "MUL";
mnemo0[11] := "DIV";
mnemo0[12] := "FAD";
mnemo0[13] := "FSB";
mnemo0[14] := "FML";
mnemo0[15] := "FDV";
mnemo1[0] := "MI ";
mnemo1[8] := "PL";
mnemo1[1] := "EQ ";
mnemo1[9] := "NE ";
mnemo1[2] := "LS ";
mnemo1[10] := "HI ";
mnemo1[5] := "LT ";
mnemo1[13] := "GE ";
mnemo1[6] := "LE ";
mnemo1[14] := "GT ";
mnemo1[15] := "NO ";
END ORTool.