Add confidence tests.

This commit is contained in:
David Brown 2016-06-16 13:56:34 +01:00
parent 1304822769
commit efefcf0fb4
27 changed files with 1720 additions and 0 deletions

View file

@ -0,0 +1,26 @@
MODULE aa;
IMPORT Console;
CONST teststring = "1st 10 ch 2nd 10 ch 3rd 10 ch";
VAR
a30: ARRAY 30 OF CHAR;
a10: ARRAY 10 OF CHAR;
a20: ARRAY 20 OF CHAR;
buf: ARRAY 64 OF CHAR;
BEGIN
a30 := teststring; Console.String("a30: "); Console.String(a30); Console.Ln;
COPY(a30, a20); Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
COPY(a30, a10); Console.String("a10: "); Console.String(a10); Console.Ln;
Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
a10 := a30; Console.String("a10: "); Console.String(a10); Console.Ln;
Console.String("a20: "); Console.String(a20); Console.Ln;
Console.Ln;
Console.String("Array assignment test complete."); Console.Ln;
END aa.

View file

@ -0,0 +1,10 @@
a30: 1st 10 ch 2nd 10 ch 3rd 10 ch
a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
Array assignment test complete.

View file

@ -0,0 +1,10 @@
a30: 1st 10 ch 2nd 10 ch 3rd 10 ch
a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
a10: 1st 10 ch
a20: 1st 10 ch 2nd 10 ch
Array assignment test complete.

View file

@ -0,0 +1,4 @@
. ../testenv.sh
voc aa.mod -m
./aa >result
. ../testresult.sh

View file

@ -0,0 +1 @@
Hello.

View file

@ -0,0 +1,6 @@
MODULE hello;
IMPORT Console;
BEGIN
Console.String("Hello."); Console.Ln;
END hello.

View file

@ -0,0 +1 @@
Hello.

View file

@ -0,0 +1,4 @@
. ../testenv.sh
voc hello.mod -m
./hello >result
. ../testresult.sh

View file

@ -0,0 +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.

View file

@ -0,0 +1,79 @@
/* voc 1.2 [2016/06/16] for gcc LP64 on cygwin xtpka */
#ifndef LSB__h
#define LSB__h
#define LARGE
#include "SYSTEM.h"
typedef
struct LSB_ArrayTypeDesc *LSB_ArrayType;
typedef
struct LSB_ObjDesc *LSB_Object;
typedef
struct LSB_TypeDesc {
LONGINT len, size;
LSB_Object typobj;
} LSB_TypeDesc;
typedef
LSB_TypeDesc *LSB_Type;
typedef
struct LSB_ArrayTypeDesc { /* LSB_TypeDesc */
LONGINT len, size;
LSB_Object typobj;
LSB_Type eltyp;
} LSB_ArrayTypeDesc;
typedef
struct LSB_ItemDesc *LSB_Item;
typedef
struct LSB_ItemDesc {
INTEGER tag;
LSB_Type type;
LONGINT val, size;
LSB_Item a, b;
} LSB_ItemDesc;
typedef
struct LSB_ObjDesc { /* LSB_ItemDesc */
INTEGER tag;
LSB_Type type;
LONGINT val, size;
LSB_Item a, b;
LSB_Object next;
CHAR name[32];
BOOLEAN marked;
} LSB_ObjDesc;
typedef
struct LSB_UnitTypeDesc *LSB_UnitType;
typedef
struct LSB_UnitTypeDesc { /* LSB_TypeDesc */
LONGINT len, size;
LSB_Object typobj;
LSB_Object firstobj;
} LSB_UnitTypeDesc;
import LSB_Object LSB_root, LSB_top;
import LSB_Type LSB_bitType, LSB_integer, LSB_string;
import LSB_ArrayType LSB_byteType, LSB_wordType;
import CHAR LSB_modname[32];
import LONGINT *LSB_ItemDesc__typ;
import LONGINT *LSB_ObjDesc__typ;
import LONGINT *LSB_TypeDesc__typ;
import LONGINT *LSB_ArrayTypeDesc__typ;
import LONGINT *LSB_UnitTypeDesc__typ;
import void LSB_Register (CHAR *name, LONGINT name__len, LSB_Object list);
import void *LSB__init(void);
#endif

536
src/test/confidence/lola/LSC.Mod Executable file
View file

@ -0,0 +1,536 @@
MODULE LSC; (*Lola System Compiler, NW 8.1.95 / 26.9.2015 for RISC (LSCX)*)
IMPORT Texts, Oberon, LSB, LSS;
VAR sym: INTEGER;
err: BOOLEAN; (*used at end of Unit*)
top, bot, undef: LSB.Object;
factor: PROCEDURE (VAR x: LSB.Item); (*to avoid forward references*)
expression: PROCEDURE (VAR x: LSB.Item);
Unit: PROCEDURE (VAR locals: LSB.Object);
W: Texts.Writer;
PROCEDURE Err(n: INTEGER);
BEGIN LSS.Mark("type error"); Texts.WriteInt(W, n, 4);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Err;
PROCEDURE Log(m: LONGINT): LONGINT;
VAR n: LONGINT;
BEGIN n := 1;
WHILE m > 1 DO m := m DIV 2; INC(n) END ;
RETURN n
END Log;
PROCEDURE New(tag: INTEGER; a, b: LSB.Item): LSB.Item;
VAR z: LSB.Item;
BEGIN NEW(z); z.tag := tag; z.a := a; z.b := b; z.val := b.val; RETURN z
END New;
PROCEDURE NewObj(class: INTEGER): LSB.Object; (*insert at end, before BIT*)
VAR new, x: LSB.Object;
BEGIN x := top;
WHILE (x.next # bot) & (x.next.name # LSS.id) DO x := x.next END ;
IF x.next = bot THEN
NEW(new); new.name := LSS.id; new.tag := class; new.next := bot; x.next := new
ELSE LSS.Mark("mult def"); new := x
END ;
RETURN new
END NewObj;
PROCEDURE ThisObj(id: LSS.Ident): LSB.Object; (*find object with name = identifier last read*)
VAR x: LSB.Object;
BEGIN x := top.next;
WHILE (x # NIL) & (x.name # id) DO x := x.next END ;
IF x = NIL THEN LSS.Mark("undef"); x := undef END ;
RETURN x
END ThisObj;
PROCEDURE CheckTypes(x, y, z: LSB.Item); (*z.type = result type*)
VAR xtyp, ytyp: LSB.Type;
BEGIN xtyp := x.type; ytyp := y.type; z.type := xtyp; z.size := x.size; z.val := x.val;
IF xtyp = LSB.bitType THEN z.type := xtyp;
IF ytyp = LSB.integer THEN (* b + 0 *)
IF y.val >= 2 THEN Err(20); LSS.Mark("only 0 or 1") END
ELSIF ytyp = LSB.string THEN (* b + {...} *) Err(21)
ELSIF ytyp # LSB.bitType THEN Err(22)
END
ELSIF xtyp IS LSB.ArrayType THEN
IF xtyp(LSB.ArrayType).eltyp = LSB.bitType THEN
IF (ytyp IS LSB.ArrayType) & (xtyp(LSB.ArrayType).eltyp = LSB.bitType) THEN
IF xtyp.size # ytyp.size THEN Err(33) END (* x + y *)
ELSIF ytyp = LSB.integer THEN (* w + 5 *)
IF xtyp.size < Log(y.val) THEN Err(30) END
ELSIF ytyp = LSB.string THEN (*x + {...} *)
IF xtyp.size # y.size THEN Err(31) END
ELSIF ytyp # LSB.bitType THEN Err(34)
END
ELSIF (ytyp IS LSB.ArrayType) & (xtyp(LSB.ArrayType).eltyp = ytyp(LSB.ArrayType).eltyp) THEN
IF (xtyp.size # ytyp.size) THEN Err(40) END
ELSE Err(41)
END
ELSIF xtyp = LSB.string THEN
IF ytyp = LSB.bitType THEN (* {...} + b *) Err(12)
ELSIF (ytyp IS LSB.ArrayType) & (ytyp(LSB.ArrayType).eltyp = LSB.bitType) THEN (* {...} + w *)
IF x.size # ytyp.size THEN Err(13) END
ELSIF ytyp = LSB.integer THEN (* {...} + 5*)
IF x.size < Log(y.val) THEN Err(10) END
ELSIF ytyp = LSB.string THEN (* {...} + {...} *)
IF x.size # y.size THEN Err(11) END ;
ELSE Err(14)
END
ELSIF xtyp = LSB.integer THEN
IF (ytyp IS LSB.ArrayType) & (ytyp(LSB.ArrayType).eltyp = LSB.bitType) THEN (* 5 + w *)
IF Log(x.val) > ytyp.size THEN Err(3); LSS.Mark("const too large") END
ELSIF ytyp = LSB.bitType THEN (* 5 + b *)
IF x.val >= 2 THEN Err(2) END
ELSIF ytyp = LSB.integer THEN (* 5 + 5 *)
ELSIF ytyp = LSB.string THEN (* 5 + {...} *)
IF Log(x.val) > y.size THEN Err(12) END
ELSE Err(4)
END
END
END CheckTypes;
PROCEDURE selector(VAR x: LSB.Item);
VAR y, z: LSB.Item; obj: LSB.Object;
eltyp: LSB.Type; len, kind: LONGINT;
BEGIN
WHILE (sym = LSS.lbrak) OR (sym = LSS.period) DO
IF sym = LSS.lbrak THEN
eltyp := x.type(LSB.ArrayType).eltyp; LSS.Get(sym); expression(y);
IF sym = LSS.colon THEN (*range*)
LSS.Get(sym); expression(z);
IF (y.tag = LSB.lit) & (z.tag = LSB.lit) THEN
len := y.val - z.val + 1; y := New(LSB.range, y, z); x := New(LSB.sel, x, y); x.type := LSB.string; x.size := len
END
ELSE kind := x.val; x := New(LSB.sel, x, y); x.type := eltyp; x.val := kind
END ;
IF sym = LSS.rbrak THEN LSS.Get(sym) ELSE LSS.Mark("rbrak ?") END
ELSE (*sym = LSS.period*) LSS.Get(sym); factor(y);
IF (y.tag = LSB.lit) & (y.val >= x.type.len) THEN LSS.Mark("too large") END ;
eltyp := x.type(LSB.ArrayType).eltyp; kind := x.val; x := New(LSB.sel, x, y); x.type := eltyp; x.val := kind
END
END
END selector;
PROCEDURE elem(VAR x: LSB.Item; VAR len: LONGINT);
VAR y, z: LSB.Item; m, n: LONGINT;
BEGIN expression(x);
IF (x.type = LSB.integer) OR (x.type = LSB.string) THEN m := x.size ELSE m := x.type.size END ;
IF sym = LSS.repl THEN
LSS.Get(sym);
IF sym = LSS.integer THEN
NEW(y); y.tag := LSB.lit; n := LSS.val; y.val := n; y.type := LSB.integer; LSS.Get(sym);
x := New(LSB.repl, x, y)
END
ELSE n := 1
END ;
len := m*n
END elem;
PROCEDURE constructor(VAR x: LSB.Item);
VAR y: LSB.Item; n, len: LONGINT;
BEGIN elem(x, len);
WHILE sym = LSS.comma DO
LSS.Get(sym); elem(y, n); INC(len, n); x := New(LSB.cons, x, y); x.val := len
END ;
x.size := len; x.type := LSB.string;
IF sym = LSS.rbrace THEN LSS.Get(sym) ELSE LSS.Mark("rbrace ?") END
END constructor;
PROCEDURE factor0(VAR x: LSB.Item);
VAR obj: LSB.Object; y, z: LSB.Item;
n, len: LONGINT; t: LSB.ArrayType;
BEGIN
IF sym = LSS.ident THEN
x := ThisObj(LSS.id); LSS.Get(sym);
IF x.tag = LSB.var THEN selector(x)
ELSIF x.tag = LSB.const THEN n := x.b.val; NEW(x); x.tag := LSB.lit; x.val := n; x.type := LSB.integer
ELSE LSS.Mark("bad factor")
END
ELSIF sym = LSS.lparen THEN
LSS.Get(sym); expression(x);
IF sym = LSS.rparen THEN LSS.Get(sym) ELSE LSS.Mark("rparen ?") END
ELSIF sym = LSS.integer THEN
NEW(x); x.tag := LSB.lit; x.val := LSS.val; x.type := LSB.integer; LSS.Get(sym);
IF sym = LSS.apo THEN LSS.Get(sym);
IF sym = LSS.integer THEN
len := LSS.val; LSS.Get(sym);
IF len < Log(x.val) THEN LSS.Mark("value too large") END
ELSE LSS.Mark("integer ?"); len := 0
END ;
x.size := len
ELSE len := 0
END ;
x.size := len
ELSIF sym = LSS.not THEN
LSS.Get(sym); factor(x); y := New(LSB.not, NIL, x); y.type := x.type; y.size := x.size; x := y
ELSIF sym = LSS.lbrace THEN LSS.Get(sym); constructor(x)
ELSE LSS.Mark("bad factor")
END
END factor0;
PROCEDURE term(VAR x: LSB.Item);
VAR y, z: LSB.Item; op: INTEGER;
BEGIN factor(x);
WHILE (sym >= LSS.times) & (sym <= LSS.and) DO
IF sym = LSS.and THEN op := LSB.and
ELSIF sym = LSS.times THEN op := LSB.mul
ELSIF sym = LSS.div THEN op := LSB.div
END ;
LSS.Get(sym); factor(y); z := New(op, x, y); CheckTypes(x, y, z); x := z
END
END term;
PROCEDURE SimpleExpression(VAR x: LSB.Item);
VAR y, z: LSB.Item; op: INTEGER;
BEGIN
IF sym = LSS.minus THEN LSS.Get(sym); term(y);
IF y.tag = LSB.lit THEN x := y; x.val := -y.val
ELSE x := New(LSB.sub, NIL, y); x.type := y.type; x.size := y.size
END
ELSIF sym = LSS.plus THEN LSS.Get(sym); term(x);
ELSE term(x)
END ;
WHILE (sym >= LSS.plus) & (sym <= LSS.xor) DO
IF sym = LSS.or THEN op := LSB.or
ELSIF sym = LSS.xor THEN op := LSB.xor
ELSIF sym = LSS.plus THEN op := LSB.add
ELSIF sym = LSS.minus THEN op := LSB.sub
END ;
LSS.Get(sym); term(y); z := New(op, x, y); CheckTypes(x, y, z); x := z
END
END SimpleExpression;
PROCEDURE UncondExpression(VAR x: LSB.Item);
VAR y, z: LSB.Item; rel: INTEGER;
BEGIN SimpleExpression(x);
IF (sym >= LSS.eql) & (sym <= LSS.geq) THEN
IF sym = LSS.eql THEN rel := LSB.eql
ELSIF sym = LSS.neq THEN rel := LSB.neq
ELSIF sym = LSS.lss THEN rel := LSB.lss
ELSIF sym = LSS.geq THEN rel := LSB.geq
ELSIF sym = LSS.leq THEN rel := LSB.leq
ELSE rel := LSB.gtr
END ;
LSS.Get(sym); SimpleExpression(y); z := New(rel, x, y); CheckTypes(x, y, z); z.type := LSB.bitType; x := z
END
END UncondExpression;
PROCEDURE expression0(VAR x: LSB.Item);
VAR y, z, w: LSB.Item;
BEGIN UncondExpression(x);
IF sym = LSS.then THEN
IF x.type # LSB.bitType THEN LSS.Mark("Boolean?") END ;
LSS.Get(sym); expression(y);
IF sym = LSS.colon THEN
LSS.Get(sym); expression(z); w := New(LSB.else, y, z); CheckTypes(y, z, w);
x := New(LSB.then, x, w); x.type := w.type; x.size := w.size
ELSE LSS.Mark("colon ?")
END
END
END expression0;
PROCEDURE CheckAssign(x, y: LSB.Item);
VAR xtyp, ytyp: LSB.Type;
BEGIN xtyp := x.type; ytyp := y.type;
IF xtyp # ytyp THEN
IF xtyp = LSB.bitType THEN
IF (ytyp # LSB.integer) OR (y.val >= 2) THEN Err(70); END
ELSIF xtyp IS LSB.ArrayType THEN
IF xtyp(LSB.ArrayType).eltyp = LSB.bitType THEN
IF (ytyp IS LSB.ArrayType) & (xtyp(LSB.ArrayType).eltyp = LSB.bitType) THEN (*w := w*)
IF xtyp.size # ytyp.size THEN Err(71) END (* x + y *)
ELSIF ytyp = LSB.integer THEN (* w := 5 *)
IF xtyp.size < Log(y.val) THEN Err(72) END
ELSIF ytyp = LSB.string THEN (* w := {...} *)
IF xtyp.size # y.size THEN Err(73) END
ELSE Err(74)
END
ELSE Err(74)
END
END
END
END CheckAssign;
PROCEDURE Param(fpar: LSB.Object; VAR apar: LSB.Item);
VAR y, z: LSB.Item;
BEGIN expression(y); apar := New(LSB.next, NIL, y); CheckAssign(fpar, y);
IF fpar.val IN {3, 4} THEN (*OUT or INOUT parameter*)
IF ~(y.tag IN {3, 7}) THEN (*actual param is expression?*) LSS.Mark("bad actual param")
ELSIF y.b = NIL THEN y.b := undef
END
END
END Param;
PROCEDURE Statement;
VAR w, x, y, z, apar, npar: LSB.Item;
unit: LSB.UnitType; fpar: LSB.Object;
BEGIN
IF sym < LSS.ident THEN LSS.Mark("bad factor");
REPEAT LSS.Get(sym) UNTIL sym >= LSS.ident
END ;
IF sym = LSS.ident THEN
x := ThisObj(LSS.id); z := x; LSS.Get(sym); selector(z);
IF sym = LSS.becomes THEN LSS.Get(sym);
IF x.val >= 5 THEN LSS.Mark("assignment to read-only") END ;
IF (x.b # NIL) & ~(x.type IS LSB.ArrayType) THEN LSS.Mark("mult assign") END ;
expression(y); CheckAssign(z, y); x.b := y; (*tricky*)
IF z # x THEN x.a := z.b; x.val := 1 (*overwriting clk field x.a *) END
ELSIF sym = LSS.lparen THEN LSS.Get(sym); (*unit instantiation*)
IF x.type IS LSB.UnitType THEN
unit := x.type(LSB.UnitType); fpar := unit.firstobj;
IF sym # LSS.rparen THEN
Param(fpar, apar); x.b := apar; fpar := fpar.next;
WHILE sym # LSS.rparen DO
IF sym = LSS.comma THEN LSS.Get(sym) END ;
Param(fpar, npar);
IF fpar.tag >= 3 THEN fpar := fpar.next; apar.a := npar; apar := npar
ELSE LSS.Mark("too many params")
END
END ;
IF fpar.val >= 3 THEN LSS.Mark("too few params") END
END ;
IF sym = LSS.rparen THEN LSS.Get(sym) ELSE LSS.Mark("rparen ?") END
ELSE LSS.Mark("not a module")
END
ELSE LSS.Mark("bad statement")
END
ELSIF sym = LSS.ts THEN (*tri-state*) LSS.Get(sym);
IF sym = LSS.lparen THEN LSS.Get(sym) ELSE LSS.Mark("( missing") END ;
IF sym = LSS.ident THEN
x := ThisObj(LSS.id); x.b := undef; (*INOUT parameter*)
IF x.val # 5 THEN LSS.Mark("not INOUT") END ;
LSS.Get(sym);
IF sym = LSS.comma THEN LSS.Get(sym) END ;
IF sym = LSS.ident THEN y := ThisObj(LSS.id); CheckAssign(x, y); y.b := undef END ; (*output from gate*)
LSS.Get(sym);
IF sym = LSS.comma THEN LSS.Get(sym) END ;
expression(z);
IF (z.tag = LSB.lit) & (z.val <= 1) THEN z.type := LSB.bitType END ;
CheckAssign(x, z); LSS.Get(sym);
IF sym = LSS.comma THEN LSS.Get(sym) END ;
expression(w); (*control*)
IF w.type # LSB.bitType THEN CheckAssign(x, w) END ;
w := New(LSB.next, z, w); x.b := New(LSB.ts, y, w);
IF sym = LSS.rparen THEN LSS.Get(sym) ELSE LSS.Mark(") missing") END
END
END
END Statement;
PROCEDURE StatSequence;
BEGIN Statement;
WHILE sym <= LSS.semicolon DO
IF sym < LSS.semicolon THEN LSS.Mark("semicolon missing?") END ;
WHILE sym = LSS.semicolon DO LSS.Get(sym) END ;
Statement
END ;
IF sym = LSS.end THEN LSS.Get(sym) ELSE LSS.Mark("END ?") END
END StatSequence;
(*---------------------------------------------------*)
(* for variables and registers,, obj.val has the meaning
0 register
1 register with imlicit clock "clk"
2 variable
3 output parameter
4 output parameter with register
5 inout parameter
6 input parameter *)
PROCEDURE ConstDeclaration;
VAR obj: LSB.Object;
BEGIN
IF sym = LSS.ident THEN
obj := NewObj(LSB.const); LSS.Get(sym);
IF (sym = LSS.becomes) OR (sym = LSS.eql) THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
expression(obj.b); obj.type := LSB.integer;
IF sym = LSS.semicolon THEN LSS.Get(sym) ELSE LSS.Mark("semicolon ?") END
ELSE LSS.Mark("ident ?")
END
END ConstDeclaration;
PROCEDURE Type0(VAR type: LSB.Type);
VAR obj: LSB.Object; len, size: LONGINT;
eltyp: LSB.Type; arrtyp: LSB.ArrayType;
BEGIN len := 1;
IF sym = LSS.lbrak THEN (*array*) LSS.Get(sym);
IF sym = LSS.integer THEN len := LSS.val; LSS.Get(sym)
ELSIF sym = LSS.ident THEN obj := ThisObj(LSS.id); len := obj.val
END ;
IF sym = LSS.rbrak THEN LSS.Get(sym) ELSE LSS.Mark("rbrak ?") END ;
Type0(eltyp); NEW(arrtyp); size := eltyp.size * len;
arrtyp.eltyp := eltyp; type := arrtyp; type.len := len; type.size := size
ELSIF sym = LSS.ident THEN
obj := ThisObj(LSS.id); LSS.Get(sym);
IF obj # NIL THEN
IF obj.tag = LSB.typ THEN type := obj.type ELSE LSS.Mark("not a type"); type := LSB.bitType END
ELSE LSS.Mark("type ?")
END
ELSE type := LSB.bitType; LSS.Mark("ident or [")
END
END Type0;
PROCEDURE TypeDeclaration;
VAR obj: LSB.Object; utyp: LSB.UnitType;
BEGIN
IF sym = LSS.ident THEN
obj := NewObj(LSB.typ); LSS.Get(sym);
IF (sym = LSS.becomes) OR (sym = LSS.eql) THEN LSS.Get(sym) ELSE LSS.Mark(":= ?") END ;
IF sym = LSS.module THEN
LSS.Get(sym); NEW(utyp); Unit(utyp.firstobj); obj.type := utyp; obj.type.typobj := obj
ELSE Type0(obj.type)
END ;
IF sym = LSS.semicolon THEN LSS.Get(sym) ELSE LSS.Mark("semicolon ?") END
ELSE LSS.Mark("ident ?")
END
END TypeDeclaration;
PROCEDURE VarList(kind: INTEGER; clk: LSB.Item);
VAR first, new, obj: LSB.Object; type: LSB.Type;
BEGIN obj := NIL;
WHILE sym = LSS.ident DO
new := NewObj(LSB.var); new.name := LSS.id; new.val := kind; first := new; LSS.Get(sym);
IF sym = LSS.comma THEN LSS.Get(sym) ELSIF sym = LSS.ident THEN LSS.Mark("comma missing") END ;
WHILE sym = LSS.ident DO
new := NewObj(LSB.var); new.name := LSS.id; new.val := kind; LSS.Get(sym);
IF sym = LSS.comma THEN LSS.Get(sym) ELSIF sym = LSS.ident THEN LSS.Mark("comma missing") END
END ;
IF sym = LSS.colon THEN
LSS.Get(sym); Type0(type); obj := first;
WHILE obj # bot DO obj.type := type; obj.a := clk; obj := obj.next END
ELSE LSS.Mark("colon ?")
END ;
IF sym = LSS.semicolon THEN LSS.Get(sym)
ELSIF sym # LSS.rparen THEN LSS.Mark("semicolon or rparen missing")
END
END
END VarList;
PROCEDURE ParamList;
VAR kind: INTEGER;
BEGIN
IF sym = LSS.in THEN LSS.Get(sym); kind := 6
ELSIF sym = LSS.out THEN LSS.Get(sym);
IF sym = LSS.reg THEN LSS.Get(sym); kind := 4 ELSE kind := 3 END
ELSIF sym = LSS.inout THEN LSS.Get(sym); kind := 5
END ;
VarList(kind, NIL)
END ParamList;
PROCEDURE Traverse(x: LSB.Item);
BEGIN
IF x # NIL THEN
IF x IS LSB.Object THEN
IF (x.tag = LSB.var) & (x.val >= 2) THEN (*not reg*)
IF x(LSB.Object).marked THEN (*loop*)
Texts.WriteString(W, x(LSB.Object).name); Texts.Write(W, " "); err := TRUE
ELSIF x.b # NIL THEN x(LSB.Object).marked := TRUE; Traverse(x.b)
END ;
x(LSB.Object).marked := FALSE
END
ELSE Traverse(x.a); Traverse(x.b)
END
END
END Traverse;
PROCEDURE Unit0(VAR locals: LSB.Object);
VAR obj, oldtop: LSB.Object; kind: INTEGER; clock: LSB.Item;
BEGIN oldtop := top.next; top.next := LSB.root; (*top is dummy*)
IF sym = LSS.lparen THEN LSS.Get(sym) ELSE LSS.Mark("lparen ?") END ;
WHILE (sym = LSS.in) OR (sym = LSS.out) OR (sym = LSS.inout) DO ParamList END ;
IF sym = LSS.rparen THEN LSS.Get(sym) ELSE LSS.Mark("rparen ?") END ;
IF sym = LSS.xor (*arrow*) THEN LSS.Get(sym); locals := top.next
ELSE
IF sym = LSS.semicolon THEN LSS.Get(sym) ELSE LSS.Mark("semicolon ?") END ;
IF sym = LSS.const THEN LSS.Get(sym);
WHILE sym = LSS.ident DO ConstDeclaration END
END ;
IF sym = LSS.type THEN LSS.Get(sym);
WHILE sym = LSS.ident DO TypeDeclaration END
END ;
WHILE (sym = LSS.var) OR (sym = LSS.reg) DO
IF sym = LSS.var THEN LSS.Get(sym);
WHILE sym = LSS.ident DO VarList(2, NIL) END
ELSE (*reg*) kind := 0; LSS.Get(sym);
IF sym = LSS.lparen THEN (*clock*)
LSS.Get(sym); expression(clock);
IF clock.type # LSB.bitType THEN LSS.Mark("clock must be bitType") END ;
IF (clock IS LSB.Object) & (clock(LSB.Object).name = "clk") THEN kind := 1; clock := NIL END ;
IF sym = LSS.rparen THEN LSS.Get(sym) ELSE LSS.Mark("rparen ?") END
ELSE LSS.Mark("lparen expected"); clock := undef
END ;
WHILE sym = LSS.ident DO VarList(kind, clock) END
END
END ;
locals := top.next;
IF sym = LSS.begin THEN LSS.Get(sym); StatSequence END ;
obj := locals; err := FALSE; (*find unassigned variables*)
WHILE obj # LSB.root DO
IF (obj.tag = LSB.var) & (obj.val < 5) THEN
IF (obj.b = NIL) & (obj.val < 4) THEN Texts.WriteString(W, obj.name); Texts.Write(W, " "); err := TRUE
ELSIF obj.b = undef THEN obj.b := NIL
END
END ;
obj := obj.next
END ;
IF err THEN Texts.WriteString(W, " unassigned"); Texts.WriteLn(W)
ELSE obj := locals; err := FALSE; (*find combinatorial loops*)
WHILE obj # LSB.root DO
IF obj.tag = LSB.var THEN obj.marked := TRUE; Traverse(obj.b); obj.marked := FALSE END ;
obj := obj.next
END ;
IF err THEN Texts.WriteString(W, "in loop"); Texts.WriteLn(W) END
END
END ;
IF err THEN Texts.Append(Oberon.Log, W.buf) END ;
top.next := oldtop
END Unit0;
PROCEDURE Module(T: Texts.Text; pos: LONGINT);
VAR root: LSB.Object; modname: ARRAY 32 OF CHAR;
BEGIN Texts.WriteString(W, "compiling Lola: ");
bot := LSB.root; top.next := bot; LSS.Init(T, pos); LSS.Get(sym);
IF sym = LSS.module THEN
LSS.Get(sym);
IF sym = LSS.ident THEN
modname := LSS.id; Texts.WriteString(W, LSS.id); LSS.Get(sym);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
ELSE LSS.Mark("ident ?")
END ;
Unit(root);
IF sym = LSS.ident THEN LSS.Get(sym);
IF LSS.id # modname THEN LSS.Mark("no match") END
END ;
IF sym # LSS.period THEN LSS.Mark("period ?") END ;
IF ~LSS.error THEN LSB.Register(modname, root)
ELSE Texts.WriteString(W, "compilation failed"); Texts.WriteLn(W); LSB.Register("", LSB.root)
END
ELSE LSS.Mark("module ?")
END ;
Texts.Append(Oberon.Log, W.buf)
END Module;
PROCEDURE Compile*;
VAR beg, end, time: LONGINT;
S: Texts.Scanner; T: Texts.Text;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Char THEN
IF S.c = "*" THEN
ELSIF S.c = "@" THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Module(T, beg) END
END
ELSIF S.class = Texts.Name THEN
NEW(T); Texts.Open(T, S.s); Module(T, 0)
END ;
Oberon.Par.pos := Texts.Pos(S);
Texts.Append(Oberon.Log, W.buf)
END Compile;
BEGIN Texts.OpenWriter(W);
Texts.WriteString(W, "Lola compiler; NW 6.7.2015"); Texts.WriteLn(W);
NEW(top); bot := LSB.root; NEW(undef); undef.tag := 2; undef.type := LSB.bitType;
Unit := Unit0; factor := factor0; expression := expression0;
END LSC.

View file

@ -0,0 +1,16 @@
/* voc 1.2 [2016/06/16] for gcc LP64 on cygwin xtpka */
#ifndef LSC__h
#define LSC__h
#define LARGE
#include "SYSTEM.h"
import void LSC_Compile (void);
import void *LSC__init(void);
#endif

165
src/test/confidence/lola/LSS.Mod Executable file
View file

@ -0,0 +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.

View file

@ -0,0 +1,25 @@
/* voc 1.2 [2016/06/16] for gcc LP64 on cygwin xtpka */
#ifndef LSS__h
#define LSS__h
#define LARGE
#include "SYSTEM.h"
#include "Texts.h"
typedef
CHAR LSS_Ident[32];
import LONGINT LSS_val;
import LSS_Ident LSS_id;
import BOOLEAN LSS_error;
import void LSS_Get (INTEGER *sym);
import void LSS_Init (Texts_Text T, LONGINT pos);
import void LSS_Mark (CHAR *msg, LONGINT msg__len);
import void *LSS__init(void);
#endif

238
src/test/confidence/lola/LSV.Mod Executable file
View file

@ -0,0 +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.

View file

@ -0,0 +1,16 @@
/* voc 1.2 [2016/06/16] for gcc LP64 on cygwin xtpka */
#ifndef LSV__h
#define LSV__h
#define LARGE
#include "SYSTEM.h"
import void LSV_List (void);
import void *LSV__init(void);
#endif

View file

@ -0,0 +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.

View file

@ -0,0 +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

View file

@ -0,0 +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.

View file

@ -0,0 +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

View file

@ -0,0 +1,4 @@
. ../testenv.sh
voc LSS.Mod LSB.Mod LSC.Mod LSV.Mod lola.Mod -m
./Lola RISC5.Lola result
. ../testresult.sh

View file

@ -0,0 +1 @@
Signal 2

View file

@ -0,0 +1 @@
Signal 2

View file

@ -0,0 +1,51 @@
(* Test that interrupt and quit are handled correctly. *)
MODULE SignalTest;
IMPORT Console, Platform, Files;
VAR result: Files.File; rider: Files.Rider;
PROCEDURE ws(s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE (i < LEN(s)) & (s[i] # 0X) DO Files.Write(rider, s[i]); INC(i) END
END ws;
PROCEDURE wl;
BEGIN Files.Write(rider, 0AX) END wl;
PROCEDURE wi(i: LONGINT);
VAR s: ARRAY 30 OF CHAR; j: INTEGER;
BEGIN
j := 0;
IF i<0 THEN s[0] := '-'; INC(j) END;
s[j] := CHR(i MOD 10 + 48); INC(j); i := i DIV 10;
WHILE i > 0 DO s[j] := CHR(i MOD 10 + 48); INC(j); i := i DIV 10 END;
WHILE j > 0 DO DEC(j); Files.Write(rider, s[j]) END
END wi;
PROCEDURE handle(signal: INTEGER);
BEGIN
Console.Ln; Console.String("Signal: "); Console.Int(signal,1); Console.Ln;
ws("Signal "); wi(signal); wl;
(*Platform.Delay(1000)*)
END handle;
PROCEDURE Take5(i: INTEGER);
BEGIN
WHILE i > 0 DO
Console.Int(i,2); Console.Flush(); Platform.Delay(1000); DEC(i)
END;
Console.Ln;
END Take5;
BEGIN
result := Files.New("result");
Files.Set(rider, result, 0);
IF Platform.ArgCount > 1 THEN
Platform.SetInterruptHandler(handle);
Platform.SetQuitHandler(handle)
END;
Take5(4);
Files.Register(result);
END SignalTest.

View file

@ -0,0 +1,7 @@
. ../testenv.sh
voc signal.mod -m
./SignalTest x &
sleep 1
kill -2 $!
wait
. ../testresult.sh

10
src/test/confidence/testenv.sh Executable file
View file

@ -0,0 +1,10 @@
## '.' this file from individual test.sh files.
#set -e
if which cygpath >/dev/null
then export PATH="$(cygpath "$1")/bin":$PATH
else export PATH="$1/bin":$PATH
fi
# Set ibrary paths for darwin and termux(android)
export DYLD_LIBRARY_PATH=$1/lib:$DYLD_LIBRARY_PATH
export LD_LIBRARY_PATH=$1/lib:$LD_LIBRARY_PATH
rm -f *.o *.obj *.exe *.sym *.c *.h result

View file

@ -0,0 +1,5 @@
# '.' this from indiviual test.sh files
if diff -b expected result
then printf "PASSED: $PWD\n\n"
else printf "FAILED: $PWD\n\n"; exit 1
fi