|
@@ -1,4 +1,4 @@
|
|
|
-MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*)
|
|
|
+MODULE ORP; (*N. Wirth 1.7.97 / 15.4.2016 Oberon compiler for RISC in Oberon-07*)
|
|
|
IMPORT Texts, Oberon, ORS, ORB, ORG;
|
|
|
(*Author: Niklaus Wirth, 2014.
|
|
|
Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
|
|
@@ -169,9 +169,11 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
|
|
|
p0 := t0.dsc; p1 := t1.dsc;
|
|
|
WHILE p0 # NIL DO
|
|
|
- IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN
|
|
|
- IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ;
|
|
|
- p0 := p0.next; p1 := p1.next
|
|
|
+ IF (p0.class = p1.class) & (p0.rdo = p1.rdo) &
|
|
|
+ ((p0.type = p1.type) OR
|
|
|
+ (p0.type.form = ORB.Array) & (p1.type.form = ORB.Array) & (p0.type.len = p1.type.len) & (p0.type.base = p1.type.base) OR
|
|
|
+ (p0.type.form = ORB.Proc) & (p1.type.form = ORB.Proc) & EqualSignatures(p0.type, p1.type))
|
|
|
+ THEN p0 := p0.next; p1 := p1.next
|
|
|
ELSE p0 := NIL; com := FALSE
|
|
|
END
|
|
|
END
|
|
@@ -180,16 +182,14 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
RETURN com
|
|
|
END EqualSignatures;
|
|
|
|
|
|
- BEGIN (*Compatible Types*)
|
|
|
+ BEGIN (*check for assignment compatibility*)
|
|
|
RETURN (t0 = t1)
|
|
|
- OR (t0.form = ORB.Array) & (t1.form = ORB.Array) &
|
|
|
- ((t0.len = t1.len) OR (t1.len = -1)) & CompTypes(t0.base, t1.base, varpar)
|
|
|
- OR (t0.form = ORB.Pointer) & (t1.form = ORB.Pointer) & IsExtension(t0.base, t1.base)
|
|
|
- OR (t0.form = ORB.Record) & (t1.form = ORB.Record) & IsExtension(t0, t1)
|
|
|
- OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
|
|
|
- OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp)
|
|
|
- OR (t0.form = ORB.NilTyp) & (t1.form IN {ORB.Pointer, ORB.Proc})
|
|
|
- OR ~varpar & (t0.form = ORB.Int) & (t1.form = ORB.Int)
|
|
|
+ OR (t0.form = ORB.Array) & (t1.form = ORB.Array) & (t0.len = t1.len) & (t0.base = t1.base)
|
|
|
+ OR (t0.form = ORB.Record) & (t1.form = ORB.Record) & IsExtension(t0, t1)
|
|
|
+ OR ~varpar &
|
|
|
+ ((t0.form = ORB.Pointer) & (t1.form = ORB.Pointer) & IsExtension(t0.base, t1.base)
|
|
|
+ OR (t0.form = ORB.Proc) & (t1.form = ORB.Proc) & EqualSignatures(t0, t1)
|
|
|
+ OR (t0.form IN {ORB.Pointer, ORB.Proc}) & (t1.form = ORB.NilTyp))
|
|
|
END CompTypes;
|
|
|
|
|
|
PROCEDURE Parameter(par: ORB.Object);
|
|
@@ -203,16 +203,16 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
IF ~par.rdo THEN CheckReadOnly(x) END ;
|
|
|
ORG.VarParam(x, par.type)
|
|
|
END
|
|
|
- ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN
|
|
|
- ORG.ValueParam(x)
|
|
|
- ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
|
|
|
- ORG.StrToChar(x); ORG.ValueParam(x)
|
|
|
ELSIF (x.type.form = ORB.Array) & (par.type.form = ORB.Array) &
|
|
|
- (x.type.base.form = par.type.base.form) & (par.type.len < 0) THEN
|
|
|
- ORG.OpenArrayParam(x);
|
|
|
+ (x.type.base = par.type.base) & (par.type.len < 0) THEN
|
|
|
+ ORG.OpenArrayParam(x)
|
|
|
ELSIF (x.type.form = ORB.String) & varpar & par.rdo & (par.type.form = ORB.Array) &
|
|
|
(par.type.base.form = ORB.Char) & (par.type.len < 0) THEN ORG.StringParam(x)
|
|
|
- ELSIF (par.type.form = ORB.Array) & (par.type.base.form = ORB.Int) & (par.type.size = x.type.size) THEN
|
|
|
+ ELSIF ~varpar & (par.type.form = ORB.Int) & (x.type.form = ORB.Int) THEN ORG.ValueParam(x) (*BYTE*)
|
|
|
+ ELSIF (x.type.form = ORB.String) & (x.b = 2) & (par.class = ORB.Var) & (par.type.form = ORB.Char) THEN
|
|
|
+ ORG.StrToChar(x); ORG.ValueParam(x)
|
|
|
+ ELSIF (par.type.form = ORB.Array) & (par.type.base = ORB.byteType) &
|
|
|
+ (par.type.len > 0) & (par.type.size = x.type.size) THEN
|
|
|
ORG.VarParam(x, par.type)
|
|
|
ELSE ORS.Mark("incompatible parameters")
|
|
|
END
|
|
@@ -384,17 +384,20 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
BEGIN SimpleExpression(x);
|
|
|
IF (sym >= ORS.eql) & (sym <= ORS.geq) THEN
|
|
|
rel := sym; ORS.Get(sym); SimpleExpression(y); xf := x.type.form; yf := y.type.form;
|
|
|
- IF CompTypes(x.type, y.type, FALSE) OR
|
|
|
- (xf = ORB.Pointer) & (yf = ORB.Pointer) & IsExtension(y.type.base, x.type.base) THEN
|
|
|
+ IF x.type = y.type THEN
|
|
|
IF (xf IN {ORB.Char, ORB.Int}) THEN ORG.IntRelation(rel, x, y)
|
|
|
ELSIF xf = ORB.Real THEN ORG.RealRelation(rel, x, y)
|
|
|
- ELSIF xf = ORB.Set THEN ORG.SetRelation(rel, x, y)
|
|
|
- ELSIF (xf IN {ORB.Pointer, ORB.Proc, ORB.NilTyp, ORB.Bool}) THEN
|
|
|
+ ELSIF (xf IN {ORB.Set, ORB.Pointer, ORB.Proc, ORB.NilTyp, ORB.Bool}) THEN
|
|
|
IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
|
|
|
- ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) OR (xf = ORB.String) THEN
|
|
|
- ORG.StringRelation(rel, x, y)
|
|
|
+ ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) THEN ORG.StringRelation(rel, x, y)
|
|
|
ELSE ORS.Mark("illegal comparison")
|
|
|
END
|
|
|
+ ELSIF (xf IN {ORB.Pointer, ORB.Proc}) & (yf = ORB.NilTyp)
|
|
|
+ OR (yf IN {ORB.Pointer, ORB.Proc}) & (xf = ORB.NilTyp) THEN
|
|
|
+ IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
|
|
|
+ ELSIF (xf = ORB.Pointer) & (yf = ORB.Pointer) &
|
|
|
+ (IsExtension(x.type.base, y.type.base) OR IsExtension(y.type.base, x.type.base)) THEN
|
|
|
+ IF rel <= ORS.neq THEN ORG.IntRelation(rel, x, y) ELSE ORS.Mark("only = or #") END
|
|
|
ELSIF (xf = ORB.Array) & (x.type.base.form = ORB.Char) &
|
|
|
((yf = ORB.String) OR (yf = ORB.Array) & (y.type.base.form = ORB.Char))
|
|
|
OR (yf = ORB.Array) & (y.type.base.form = ORB.Char) & (xf = ORB.String) THEN
|
|
@@ -403,14 +406,12 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
ORG.StrToChar(y); ORG.IntRelation(rel, x, y)
|
|
|
ELSIF (yf = ORB.Char) & (xf = ORB.String) & (x.b = 2) THEN
|
|
|
ORG.StrToChar(x); ORG.IntRelation(rel, x, y)
|
|
|
+ ELSIF (xf = ORB.Int) & (yf = ORB.Int) THEN ORG.IntRelation(rel, x, y) (*BYTE*)
|
|
|
ELSE ORS.Mark("illegal comparison")
|
|
|
END ;
|
|
|
x.type := ORB.boolType
|
|
|
ELSIF sym = ORS.in THEN
|
|
|
- ORS.Get(sym); SimpleExpression(y);
|
|
|
- IF (x.type.form = ORB.Int) & (y.type.form = ORB.Set) THEN ORG.In(x, y)
|
|
|
- ELSE ORS.Mark("illegal operands of IN")
|
|
|
- END ;
|
|
|
+ ORS.Get(sym); CheckInt(x); SimpleExpression(y); CheckSet(y); ORG.In(x, y) ;
|
|
|
x.type := ORB.boolType
|
|
|
ELSIF sym = ORS.is THEN
|
|
|
ORS.Get(sym); qualident(obj); TypeTest(x, obj.type, FALSE) ;
|
|
@@ -493,14 +494,16 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
ELSE selector(x);
|
|
|
IF sym = ORS.becomes THEN (*assignment*)
|
|
|
ORS.Get(sym); CheckReadOnly(x); expression(y);
|
|
|
- IF CompTypes(x.type, y.type, FALSE) OR (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN
|
|
|
+ IF CompTypes(x.type, y.type, FALSE) THEN
|
|
|
IF (x.type.form <= ORB.Pointer) OR (x.type.form = ORB.Proc) THEN ORG.Store(x, y)
|
|
|
- ELSIF y.type.size # 0 THEN ORG.StoreStruct(x, y)
|
|
|
+ ELSE ORG.StoreStruct(x, y)
|
|
|
END
|
|
|
+ ELSIF (x.type.form = ORB.Int) & (y.type.form = ORB.Int) THEN ORG.Store(x, y) (*BYTE*)
|
|
|
ELSIF (x.type.form = ORB.Char) & (y.type.form = ORB.String) & (y.b = 2) THEN
|
|
|
ORG.StrToChar(y); ORG.Store(x, y)
|
|
|
- ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) &
|
|
|
- (y.type.form = ORB.String) THEN ORG.CopyString(y, x)
|
|
|
+ ELSIF (x.type.form = ORB.Array) & (x.type.base.form = ORB.Char) & ( (y.type.form = ORB.String)
|
|
|
+ OR (y.type.form = ORB.Array) & (y.type.base.form = ORB.Char) & (y.type.len = -1)) THEN
|
|
|
+ ORG.CopyString(x, y)
|
|
|
ELSE ORS.Mark("illegal assignment")
|
|
|
END
|
|
|
ELSIF sym = ORS.eql THEN ORS.Mark("should be :="); ORS.Get(sym); expression(y)
|
|
@@ -608,14 +611,14 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
BEGIN NEW(typ); typ.form := ORB.NoTyp;
|
|
|
expression(x);
|
|
|
IF (x.mode = ORB.Const) & (x.type.form = ORB.Int) & (x.a >= 0) THEN len := x.a
|
|
|
- ELSE len := 0; ORS.Mark("not a valid length")
|
|
|
+ ELSE len := 1; ORS.Mark("not a valid length")
|
|
|
END ;
|
|
|
IF sym = ORS.of THEN ORS.Get(sym); Type(typ.base);
|
|
|
IF (typ.base.form = ORB.Array) & (typ.base.len < 0) THEN ORS.Mark("dyn array not allowed") END
|
|
|
ELSIF sym = ORS.comma THEN ORS.Get(sym); ArrayType(typ.base)
|
|
|
ELSE ORS.Mark("missing OF"); typ.base := ORB.intType
|
|
|
END ;
|
|
|
- typ.size := (len * typ.base.size + 3) DIV 4 * 4 ;
|
|
|
+ typ.size := (len * typ.base.size + 3) DIV 4 * 4;
|
|
|
typ.form := ORB.Array; typ.len := len; type := typ
|
|
|
END ArrayType;
|
|
|
|
|
@@ -696,9 +699,10 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
ptype.nofpar := nofpar; parblksize := size;
|
|
|
IF sym = ORS.colon THEN (*function*)
|
|
|
ORS.Get(sym);
|
|
|
- IF sym = ORS.ident THEN qualident(obj);
|
|
|
- IF (obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc}) THEN ptype.base := obj.type
|
|
|
- ELSE ORS.Mark("illegal function type")
|
|
|
+ IF sym = ORS.ident THEN
|
|
|
+ qualident(obj); ptype.base := obj.type;
|
|
|
+ IF ~((obj.class = ORB.Typ) & (obj.type.form IN {ORB.Byte .. ORB.Pointer, ORB.Proc})) THEN
|
|
|
+ ORS.Mark("illegal function type")
|
|
|
END
|
|
|
ELSE ORS.Mark("type identifier expected")
|
|
|
END
|
|
@@ -983,7 +987,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 7.3.2016 Oberon compiler for RISC in Oberon-07*
|
|
|
Oberon.Collect(0)
|
|
|
END Compile;
|
|
|
|
|
|
-BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 7.3.2016");
|
|
|
+BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 15..4.2016");
|
|
|
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
|
|
|
NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
|
|
|
expression := expression0; Type := Type0; FormalType := FormalType0
|