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

PO 2013 compiler for Wirth's RISC processor now can be compiled with voc

Browse source 
Former-commit-id: edf0df4cbf
This commit is contained in:
Norayr Chilingarian 2014-01-24 17:12:26 +04:00
parent 0e5d1c3ca8
commit bc8c90fb84
6 changed files with 253 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

66
src/voc07R/ORB.Mod
View file

@ -1,5 +1,6 @@
MODULE ORB; (*NW 7.10.2013 in Oberon-07*) MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
IMPORT Files, ORS; IMPORT Files := OakFiles, ORS, S := SYSTEM;
TYPE BYTE = S.BYTE;
(*Definition of data types Object and Type, which together form the data structure (*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: called "symbol table". Contains procedures for creation of Objects, and for search:
NewObj, this, thisimport, thisfield (and OpenScope, CloseScope). NewObj, this, thisimport, thisfield (and OpenScope, CloseScope).
@ -145,8 +146,11 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
PROCEDURE Read(VAR R: Files.Rider; VAR x: INTEGER); PROCEDURE Read(VAR R: Files.Rider; VAR x: INTEGER);
VAR b: BYTE; VAR b: BYTE;
BEGIN Files.ReadByte(R, b); BEGIN
IF b < 80H THEN x := b ELSE x := b - 100H END (*Files.ReadByte(R, b);*)
Files.ReadBytes(R, b, 1);
(*IF b < 80H THEN x := b ELSE x := b - 100H END*)
IF S.VAL(SHORTINT, b) < 128 THEN x := S.VAL(SHORTINT, b) ELSE x := S.VAL(SHORTINT, b) - 100H END
END Read; END Read;
PROCEDURE InType(VAR R: Files.Rider; thismod: Object; VAR T: Type); PROCEDURE InType(VAR R: Files.Rider; thismod: Object; VAR T: Type);
@ -166,7 +170,8 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
InType(R, thismod, t.base); InType(R, thismod, t.base);
IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ; 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.len); (*TD adr/exno*)
Files.ReadNum(R, t.nofpar); (*ext level*) (*Files.ReadNum(R, t.nofpar);*) (*ext level*)
Files.ReadInt(R, t.nofpar); (*ext level*)
Files.ReadNum(R, t.size); Files.ReadNum(R, t.size);
Read(R, class); Read(R, class);
WHILE class # 0 DO (*fields*) WHILE class # 0 DO (*fields*)
@ -186,7 +191,8 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
END ; END ;
Files.ReadString(R, modname); Files.ReadString(R, modname);
IF modname[0] # 0X THEN (*re-import*) IF modname[0] # 0X THEN (*re-import*)
Files.ReadInt(R, key); Files.ReadString(R, name); (*Files.ReadInt(R, key); Files.ReadString(R, name);*)
Files.ReadNum(R, key); Files.ReadString(R, name);
mod := ThisModule(modname, modname, FALSE, key); mod := ThisModule(modname, modname, FALSE, key);
obj := mod.dsc; (*search type*) obj := mod.dsc; (*search type*)
WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ; WHILE (obj # NIL) & (obj.name # name) DO obj := obj.next END ;
@ -212,7 +218,10 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE thismod.lev := 0; thismod.dsc := system; thismod.rdo := TRUE
ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname); ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname);
IF F # NIL THEN IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadInt(R, key); Files.ReadInt(R, key); Files.ReadString(R, modname); Files.Set(R, F, 0);
(*Files.ReadInt(R, key); Files.ReadInt(R, key);*)
Files.ReadNum(R, key); Files.ReadNum(R, key);
Files.ReadString(R, modname);
thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE; thismod := ThisModule(modid, modid1, TRUE, key); thismod.rdo := TRUE;
Read(R, class); (*version key*) Read(R, class); (*version key*)
IF class # versionkey THEN ORS.Mark("wrong version") END ; IF class # versionkey THEN ORS.Mark("wrong version") END ;
@ -225,7 +234,12 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
WHILE k # 0 DO typtab[k].base := t; Read(R, k) END WHILE k # 0 DO typtab[k].base := t; Read(R, k) END
ELSE ELSE
IF class = Const THEN IF class = Const THEN
IF obj.type.form = Real THEN Files.ReadInt(R, obj.val) ELSE Files.ReadNum(R, obj.val) END IF obj.type.form = Real THEN
(*Files.ReadInt(R, obj.val) *)
Files.ReadNum(R, obj.val)
ELSE
Files.ReadNum(R, obj.val)
END
ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE ELSIF class = Var THEN Files.ReadNum(R, obj.val); obj.rdo := TRUE
END END
END ; END ;
@ -239,7 +253,9 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
(*-------------------------------- Export ---------------------------------*) (*-------------------------------- Export ---------------------------------*)
PROCEDURE Write(VAR R: Files.Rider; x: INTEGER); PROCEDURE Write(VAR R: Files.Rider; x: INTEGER);
BEGIN Files.WriteByte(R, x) (* -128 <= x < 128 *) BEGIN
(*Files.WriteByte(R, x)*) (* -128 <= x < 128 *)
Files.WriteByte(R, SHORT(x)) (* -128 <= x < 128 *)
END Write; END Write;
PROCEDURE OutType(VAR R: Files.Rider; t: Type); PROCEDURE OutType(VAR R: Files.Rider; t: Type);
@ -296,7 +312,10 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
IF (t.mno > 0) & (obj # NIL) THEN (*re-export, output name*) IF (t.mno > 0) & (obj # NIL) THEN (*re-export, output name*)
mod := topScope.next; mod := topScope.next;
WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ; 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) IF mod # NIL THEN Files.WriteString(R, mod.name);
(*Files.WriteInt(R, mod.val); *)
Files.WriteNum(R, mod.val);
Files.WriteString(R, obj.name)
ELSE ORS.Mark("re-export not found"); Write(R, 0) ELSE ORS.Mark("re-export not found"); Write(R, 0)
END END
ELSE Write(R, 0) ELSE Write(R, 0)
@ -330,7 +349,9 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
Write(R, 0) Write(R, 0)
ELSIF obj.class = Const THEN ELSIF obj.class = Const THEN
IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno) IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno)
ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val) ELSIF obj.type.form = Real THEN
(*Files.WriteInt(R, obj.val)*)
Files.WriteNum(R, obj.val)
ELSE Files.WriteNum(R, obj.val) ELSE Files.WriteNum(R, obj.val)
END END
ELSIF obj.class = Var THEN ELSIF obj.class = Var THEN
@ -345,12 +366,25 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0; REPEAT Write(R, 0) UNTIL Files.Length(F) MOD 4 = 0;
FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ; FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ;
Files.Set(R, F, 0); sum := 0; (* compute key (checksum) *) Files.Set(R, F, 0); sum := 0; (* compute key (checksum) *)
WHILE ~R.eof DO Files.ReadInt(R, x); sum := sum + x END ; WHILE ~R.eof DO
(*Files.ReadInt(R, x); *)
Files.ReadNum (R, x);
sum := sum + x
END ;
F1 := Files.Old(filename); (*sum is new key*) 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 F1 # NIL THEN
Files.Set(R1, F1, 4);
(*Files.ReadInt(R1, oldkey) *)
Files.ReadNum(R1, oldkey)
ELSE
oldkey := sum+1
END ;
IF sum # oldkey THEN IF sum # oldkey THEN
IF newSF THEN IF newSF THEN
key := sum; Files.Set(R, F, 4); Files.WriteInt(R, sum); Files.Register(F) (*insert checksum*) key := sum; Files.Set(R, F, 4);
(*Files.WriteInt(R, sum); *)
Files.WriteNum(R, sum);
Files.Register(F) (*insert checksum*)
ELSE ORS.Mark("new symbol file inhibited") ELSE ORS.Mark("new symbol file inhibited")
END END
ELSE newSF := FALSE; key := sum ELSE newSF := FALSE; key := sum
@ -369,7 +403,11 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*)
PROCEDURE enter(name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT); PROCEDURE enter(name: ARRAY OF CHAR; cl: INTEGER; type: Type; n: LONGINT);
VAR obj: Object; VAR obj: Object;
BEGIN NEW(obj); obj.name := name; obj.class := cl; obj.type := type; obj.val := n; obj.dsc := NIL; BEGIN
NEW(obj);
(*obj.name := name; *)
COPY(name, obj.name);
obj.class := cl; obj.type := type; obj.val := n; obj.dsc := NIL;
IF cl = Typ THEN type.typobj := obj END ; IF cl = Typ THEN type.typobj := obj END ;
obj.next := system; system := obj obj.next := system; system := obj
END enter; END enter;

103
src/voc07R/ORG.Mod
View file

@ -1,5 +1,5 @@
MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*) MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
IMPORT SYSTEM, Files, ORS, ORB; IMPORT SYSTEM, Files := OakFiles, ORS, ORB;
(*Code generator for Oberon compiler for RISC processor. (*Code generator for Oberon compiler for RISC processor.
Procedural interface to Parser OSAP; result in array "code". Procedural interface to Parser OSAP; result in array "code".
Procedure Close writes code-files*) Procedure Close writes code-files*)
@ -513,20 +513,33 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
PROCEDURE Singleton*(VAR x: Item); (* x := {x} *) PROCEDURE Singleton*(VAR x: Item); (* x := {x} *)
BEGIN BEGIN
IF x.mode = ORB.Const THEN x.a := LSL(1, x.a) IF x.mode = ORB.Const THEN
ELSE load(x); Put1(Mov, RH, 0, 1); Put0(Lsl, x.r, RH, x.r) (*x.a := LSL(1, x.a)*) (* o7 -> o2 *)
x.a := ASH(1, x.a)
ELSE
load(x); Put1(Mov, RH, 0, 1); Put0(Lsl, x.r, RH, x.r)
END END
END Singleton; END Singleton;
PROCEDURE Set*(VAR x, y: Item); (* x := {x .. y} *) PROCEDURE Set*(VAR x, y: Item); (* x := {x .. y} *)
BEGIN BEGIN
IF (x.mode = ORB.Const) & ( y.mode = ORB.Const) THEN IF (x.mode = ORB.Const) & ( y.mode = ORB.Const) THEN
IF x.a <= y.a THEN x.a := LSL(2, y.a) - LSL(1, x.a) ELSE x.a := 0 END IF x.a <= y.a THEN
(*x.a := LSL(2, y.a) - LSL(1, x.a)*) (* o7 -> o2 *)
x.a := ASH(2, y.a) - ASH(1, x.a)
ELSE ELSE
IF (x.mode = ORB.Const) & (x.a < 10H) THEN x.a := LSL(-1, x.a) x.a := 0
END
ELSE
IF (x.mode = ORB.Const) & (x.a < 10H) THEN
(*x.a := LSL(-1, x.a)*) (* o7 -> o2 *)
x.a := ASH(-1, x.a)
ELSE load(x); Put1(Mov, RH, 0, -1); Put0(Lsl, x.r, RH, x.r) ELSE load(x); Put1(Mov, RH, 0, -1); Put0(Lsl, x.r, RH, x.r)
END ; END ;
IF (y.mode = ORB.Const) & (y.a < 10H) THEN Put1(Mov, RH, 0, LSL(-2, y.a)); y.mode := Reg; y.r := RH; INC(RH) IF (y.mode = ORB.Const) & (y.a < 10H) THEN
(*Put1(Mov, RH, 0, LSL(-2, y.a)); *) (* o7 -> o2 *)
Put1(Mov, RH, 0, ASH(-2, y.a));
y.mode := Reg; y.r := RH; INC(RH)
ELSE load(y); Put1(Mov, RH, 0, -2); Put0(Lsl, y.r, RH, y.r) ELSE load(y); Put1(Mov, RH, 0, -2); Put0(Lsl, y.r, RH, y.r)
END ; END ;
IF x.mode = ORB.Const THEN IF x.mode = ORB.Const THEN
@ -842,11 +855,15 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
VAR zr: LONGINT; VAR zr: LONGINT;
BEGIN loadAdr(x); zr := RH; Put2(Ldr, RH, x.r, 0); incR; BEGIN loadAdr(x); zr := RH; Put2(Ldr, RH, x.r, 0); incR;
IF inorex = 0 THEN (*include*) IF inorex = 0 THEN (*include*)
IF y.mode = ORB.Const THEN Put1(Ior, zr, zr, LSL(1, y.a)) IF y.mode = ORB.Const THEN
(*Put1(Ior, zr, zr, LSL(1, y.a))*) (* o7 -> o2 *)
Put1(Ior, zr, zr, ASH(1, y.a))
ELSE load(y); Put1(Mov, RH, 0, 1); Put0(Lsl, y.r, RH, y.r); Put0(Ior, zr, zr, y.r); DEC(RH) ELSE load(y); Put1(Mov, RH, 0, 1); Put0(Lsl, y.r, RH, y.r); Put0(Ior, zr, zr, y.r); DEC(RH)
END END
ELSE (*exclude*) ELSE (*exclude*)
IF y.mode = ORB.Const THEN Put1(And, zr, zr, -LSL(1, y.a)-1) IF y.mode = ORB.Const THEN
(*Put1(And, zr, zr, -LSL(1, y.a)-1)*) (* o7 -> o2 *)
Put1(And, zr, zr, - ASH(1, y.a)-1)
ELSE load(y); Put1(Mov, RH, 0, 1); Put0(Lsl, y.r, RH, y.r); Put1(Xor, y.r, y.r, -1); Put0(And, zr, zr, y.r); DEC(RH) ELSE load(y); Put1(Mov, RH, 0, 1); Put0(Lsl, y.r, RH, y.r); Put1(Xor, y.r, y.r, -1); Put0(And, zr, zr, y.r); DEC(RH)
END END
END ; END ;
@ -1037,7 +1054,9 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
PROCEDURE FindPtrs(VAR R: Files.Rider; typ: ORB.Type; adr: LONGINT); PROCEDURE FindPtrs(VAR R: Files.Rider; typ: ORB.Type; adr: LONGINT);
VAR fld: ORB.Object; i, s: LONGINT; VAR fld: ORB.Object; i, s: LONGINT;
BEGIN BEGIN
IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN Files.WriteInt(R, adr) IF (typ.form = ORB.Pointer) OR (typ.form = ORB.NilTyp) THEN
(*Files.WriteInt(R, adr)*) (* o7 -> o2 *)
Files.WriteNum(R, adr)
ELSIF typ.form = ORB.Record THEN ELSIF typ.form = ORB.Record THEN
fld := typ.dsc; fld := typ.dsc;
WHILE fld # NIL DO FindPtrs(R, fld.type, fld.val + adr); fld := fld.next END WHILE fld # NIL DO FindPtrs(R, fld.type, fld.val + adr); fld := fld.next END
@ -1070,41 +1089,70 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4; (*varsize includes type descriptors*) size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4; (*varsize includes type descriptors*)
ORB.MakeFileName(name, modid, ".rsc"); (*write code file*) ORB.MakeFileName(name, modid, ".rsc"); (*write code file*)
F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteInt(R, key); Files.WriteByte(R, version); F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid);
Files.WriteInt(R, size); (*Files.WriteInt(R, key); *) (* o7 -> o2 *)
Files.WriteNum(R, key);
(*Files.WriteByte(R, version);*)
Files.WriteByte(R, SHORT(version));
(*Files.WriteInt(R, size);*)
Files.WriteNum(R, size);
obj := ORB.topScope.next; obj := ORB.topScope.next;
WHILE (obj # NIL) & (obj.class = ORB.Mod) DO (*imports*) WHILE (obj # NIL) & (obj.class = ORB.Mod) DO (*imports*)
IF obj.dsc # ORB.system THEN Files.WriteString(R, obj(ORB.Module).orgname); Files.WriteInt(R, obj.val) END ; IF obj.dsc # ORB.system THEN
Files.WriteString(R, obj(ORB.Module).orgname);
(*Files.WriteInt(R, obj.val) *)
Files.WriteNum(R, obj.val)
END ;
obj := obj.next obj := obj.next
END ; END ;
Files.Write(R, 0X); Files.Write(R, 0X);
Files.WriteInt(R, tdx*4); (*Files.WriteInt(R, tdx*4);*)
Files.WriteNum(R, tdx*4);
i := 0; i := 0;
WHILE i < tdx DO Files.WriteInt(R, data[i]); INC(i) END ; (*type descriptors*) WHILE i < tdx DO
Files.WriteInt(R, varsize - tdx*4); (*data*) (*Files.WriteInt(R, data[i]); *)
Files.WriteInt(R, strx); Files.WriteNum(R, data[i]);
INC(i)
END ; (*type descriptors*)
(*Files.WriteInt(R, varsize - tdx*4);*) (*data*)
Files.WriteNum(R, varsize - tdx*4); (*data*)
(*Files.WriteInt(R, strx);*)
Files.WriteNum(R, strx);
FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ; (*strings*) FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ; (*strings*)
Files.WriteInt(R, pc); (*code len*) (*Files.WriteInt(R, pc);*) (*code len*)
FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]) END ; (*program*) Files.WriteNum(R, pc); (*code len*)
FOR i := 0 TO pc-1 DO
(*Files.WriteInt(R, code[i]) *)
Files.WriteNum(R, code[i])
END ; (*program*)
obj := ORB.topScope.next; obj := ORB.topScope.next;
WHILE obj # NIL DO (*commands*) WHILE obj # NIL DO (*commands*)
IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) & IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) &
(obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN
Files.WriteString(R, obj.name); Files.WriteInt(R, obj.val) Files.WriteString(R, obj.name);
(*Files.WriteInt(R, obj.val)*)
Files.WriteNum(R, obj.val)
END ; END ;
obj := obj.next obj := obj.next
END ; END ;
Files.Write(R, 0X); Files.Write(R, 0X);
Files.WriteInt(R, nofent); Files.WriteInt(R, entry); (*Files.WriteInt(R, nofent);*)
Files.WriteNum(R, nofent);
(*Files.WriteInt(R, entry);*)
Files.WriteNum(R, entry);
obj := ORB.topScope.next; obj := ORB.topScope.next;
WHILE obj # NIL DO (*entries*) WHILE obj # NIL DO (*entries*)
IF obj.exno # 0 THEN IF obj.exno # 0 THEN
IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN
Files.WriteInt(R, obj.val) (*Files.WriteInt(R, obj.val)*)
Files.WriteNum(R, obj.val)
ELSIF obj.class = ORB.Typ THEN ELSIF obj.class = ORB.Typ THEN
IF obj.type.form = ORB.Record THEN Files.WriteInt(R, obj.type.len MOD 10000H) IF obj.type.form = ORB.Record THEN
(*Files.WriteInt(R, obj.type.len MOD 10000H)*)
Files.WriteNum(R, obj.type.len MOD 10000H)
ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN
Files.WriteInt(R, obj.type.base.len MOD 10000H) (*Files.WriteInt(R, obj.type.base.len MOD 10000H)*)
Files.WriteNum(R, obj.type.base.len MOD 10000H)
END END
END END
END ; END ;
@ -1116,7 +1164,14 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*)
obj := obj.next obj := obj.next
END ; END ;
Files.WriteInt(R, -1); Files.WriteInt(R, -1);
Files.WriteInt(R, fixorgP); Files.WriteInt(R, fixorgD); Files.WriteInt(R, fixorgT); Files.WriteInt(R, entry); (*Files.WriteInt(R, fixorgP);*)
Files.WriteNum(R, fixorgP);
(*Files.WriteInt(R, fixorgD);*)
Files.WriteNum(R, fixorgD);
(*Files.WriteInt(R, fixorgT);*)
Files.WriteNum(R, fixorgT);
(*Files.WriteInt(R, entry);*)
Files.WriteNum(R, entry);
Files.Write(R, "O"); Files.Register(F) Files.Write(R, "O"); Files.Register(F)
END Close; END Close;

93
src/voc07R/ORP.Mod
View file

@ -1,5 +1,5 @@
MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07*) MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07*)
IMPORT Texts, Oberon, ORS, ORB, ORG; IMPORT Args, Out := Console, Texts := CmdlnTexts, (*Oberon,*) ORS, ORB, ORG;
(*Author: Niklaus Wirth, 2011. (*Author: Niklaus Wirth, 2011.
Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens), Parser of Oberon-RISC compiler. Uses Scanner ORS to obtain symbols (tokens),
ORB for definition of data structures and for handling import and export, and ORB for definition of data structures and for handling import and export, and
@ -21,7 +21,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
modid: ORS.Ident; modid: ORS.Ident;
pbsList: PtrBase; (*list of names of pointer base types*) pbsList: PtrBase; (*list of names of pointer base types*)
dummy: ORB.Object; dummy: ORB.Object;
W: Texts.Writer; (*W: Texts.Writer;*)
PROCEDURE Check(s: INTEGER; msg: ARRAY OF CHAR); PROCEDURE Check(s: INTEGER; msg: ARRAY OF CHAR);
BEGIN BEGIN
@ -166,7 +166,8 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN IF (t0.base = t1.base) & (t0.nofpar = t1.nofpar) THEN
p0 := t0.dsc; p1 := t1.dsc; p0 := t0.dsc; p1 := t1.dsc;
WHILE p0 # NIL DO WHILE p0 # NIL DO
IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN (*IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (ORD(p0.rdo) = ORD(p1.rdo)) THEN*)
IF (p0.class = p1.class) & CompTypes(p0.type, p1.type, TRUE) & (p0.rdo = p1.rdo) THEN
IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ; IF p0.type.form >= ORB.Array THEN com := CompTypes(p0.type, p1.type, (p0.class = ORB.Par)) END ;
p0 := p0.next; p1 := p1.next p0 := p0.next; p1 := p1.next
ELSE p0 := NIL; com := FALSE ELSE p0 := NIL; com := FALSE
@ -767,7 +768,11 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
expression(x); expression(x);
IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END ; IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END ;
ORB.NewObj(obj, id, ORB.Const); obj.expo := expo; ORB.NewObj(obj, id, ORB.Const); obj.expo := expo;
IF x.mode = ORB.Const THEN obj.val := x.a; obj.lev := x.b; obj.type := x.type IF x.mode = ORB.Const THEN
obj.val := x.a;
(*obj.lev := x.b;*)
obj.lev := SHORT(x.b);
obj.type := x.type
ELSE ORS.Mark("expression not constant"); obj.type := ORB.intType ELSE ORS.Mark("expression not constant"); obj.type := ORB.intType
END; END;
Check(ORS.semicolon, "; missing") Check(ORS.semicolon, "; missing")
@ -870,14 +875,25 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
VAR key: LONGINT; VAR key: LONGINT;
obj: ORB.Object; obj: ORB.Object;
impid, impid1: ORS.Ident; impid, impid1: ORS.Ident;
BEGIN Texts.WriteString(W, " compiling "); ORS.Get(sym); BEGIN
(*Texts.WriteString(W, " compiling "); *)
Out.String(" compiling ");
ORS.Get(sym);
IF sym = ORS.module THEN IF sym = ORS.module THEN
ORS.Get(sym); ORS.Get(sym);
IF sym = ORS.times THEN version := 0; Texts.Write(W, "*"); ORS.Get(sym) ELSE version := 1 END ; IF sym = ORS.times THEN
version := 0;
(*Texts.Write(W, "*"); *)
Out.Char("*");
ORS.Get(sym)
ELSE
version := 1
END ;
ORB.Init; ORB.OpenScope; ORB.Init; ORB.OpenScope;
IF sym = ORS.ident THEN IF sym = ORS.ident THEN
ORS.CopyId(modid); ORS.Get(sym); ORS.CopyId(modid); ORS.Get(sym);
Texts.WriteString(W, modid); Texts.Append(Oberon.Log, W.buf) (*Texts.WriteString(W, modid); Texts.Append(Oberon.Log, W.buf)*)
Out.String(modid); Out.Ln
ELSE ORS.Mark("identifier expected") ELSE ORS.Mark("identifier expected")
END ; END ;
Check(ORS.semicolon, "no ;"); level := 0; dc := 0; exno := 1; key := 0; Check(ORS.semicolon, "no ;"); level := 0; dc := 0; exno := 1; key := 0;
@ -913,19 +929,28 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
IF sym # ORS.period THEN ORS.Mark("period missing") END ; IF sym # ORS.period THEN ORS.Mark("period missing") END ;
IF ORS.errcnt = 0 THEN IF ORS.errcnt = 0 THEN
ORB.Export(modid, newSF, key); ORB.Export(modid, newSF, key);
IF newSF THEN Texts.WriteLn(W); Texts.WriteString(W, "new symbol file ") END IF newSF THEN
(*Texts.WriteLn(W); Texts.WriteString(W, "new symbol file ") *)
Out.Ln; Out.String("new symbol file ")
END
END ; END ;
IF ORS.errcnt = 0 THEN IF ORS.errcnt = 0 THEN
ORG.Close(modid, key, exno); Texts.WriteLn(W); Texts.WriteString(W, "compilation done "); ORG.Close(modid, key, exno);
Texts.WriteInt(W, ORG.pc, 6); Texts.WriteInt(W, dc, 6) (*Texts.WriteLn(W); Texts.WriteString(W, "compilation done ");*)
ELSE Texts.WriteLn(W); Texts.WriteString(W, "compilation FAILED") Out.Ln; Out.String("compilation done ");
(*Texts.WriteInt(W, ORG.pc, 6); Texts.WriteInt(W, dc, 6)*)
Out.Int(ORG.pc, 6); Out.Int(dc, 6)
ELSE
(*Texts.WriteLn(W); Texts.WriteString(W, "compilation FAILED")*)
Out.Ln; Out.String("compilation FAILED")
END ; END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); (*Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);*)
Out.Ln;
ORB.CloseScope; pbsList := NIL ORB.CloseScope; pbsList := NIL
ELSE ORS.Mark("must start with MODULE") ELSE ORS.Mark("must start with MODULE")
END END
END Module; END Module;
(*
PROCEDURE Option(VAR S: Texts.Scanner); PROCEDURE Option(VAR S: Texts.Scanner);
BEGIN newSF := FALSE; BEGIN newSF := FALSE;
IF S.nextCh = "/" THEN IF S.nextCh = "/" THEN
@ -933,12 +958,23 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
IF (S.class = Texts.Name) & (S.s[0] = "s") THEN newSF := TRUE END IF (S.class = Texts.Name) & (S.s[0] = "s") THEN newSF := TRUE END
END END
END Option; END Option;
*)
PROCEDURE Option(VAR s: ARRAY OF CHAR);
BEGIN
newSF := FALSE;
IF s[0] = "-" THEN
IF s[1] = "s" THEN newSF := TRUE END
END
END Option;
PROCEDURE Compile*; PROCEDURE Compile*;
VAR beg, end, time: LONGINT; VAR beg, end, time: LONGINT;
T: Texts.Text; (*T: Texts.Text;
S: Texts.Scanner; S: Texts.Scanner;*)
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); s, name : ARRAY 32 OF CHAR;
T : Texts.Text;
BEGIN
(*Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
Texts.Scan(S); Texts.Scan(S);
IF S.class = Texts.Char THEN IF S.class = Texts.Char THEN
IF S.c = "@" THEN IF S.c = "@" THEN
@ -965,10 +1001,29 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07
END END
END ; END ;
Oberon.Collect(0) Oberon.Collect(0)
*)
IF Args.argc <= 1 THEN HALT(1) END;
Args.Get (1, s);
Option(s);
IF s[0] = "-" THEN
IF Args.argc < 3 THEN Out.String ("module name expected"); Out.Ln; HALT(1) END;
Args.Get(2, name);
ELSE
COPY(s, name);
END;
NEW(T);
Texts.Open(T, name);
IF T.len > 0 THEN
ORS.Init(T, 0); Module
ELSE
Out.String ("module not found"); Out.Ln
END;
END Compile; END Compile;
BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 5.11.2013"); BEGIN (*Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 5.11.2013");*)
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Out.String("OR Compiler 5.11.2013"); Out.Ln;
(*Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);*)
NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType; NEW(dummy); dummy.class := ORB.Var; dummy.type := ORB.intType;
expression := expression0; Type := Type0; FormalType := FormalType0 expression := expression0; Type := Type0; FormalType := FormalType0;
Compile;
END ORP. END ORP.

14
src/voc07R/ORS.Mod
View file

@ -1,5 +1,5 @@
MODULE ORS; (* NW 19.9.93 / 10.10.2013 Scanner in Oberon-07*) MODULE ORS; (* NW 19.9.93 / 10.10.2013 Scanner in Oberon-07*)
IMPORT SYSTEM, Texts, Oberon; IMPORT SYSTEM, Texts := CmdlnTexts, Console, S := SYSTEM;
(* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is (* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is
sequence of symbols, i.e identifiers, numbers, strings, and special symbols. sequence of symbols, i.e identifiers, numbers, strings, and special symbols.
@ -60,8 +60,8 @@ MODULE ORS; (* NW 19.9.93 / 10.10.2013 Scanner in Oberon-07*)
VAR p: LONGINT; VAR p: LONGINT;
BEGIN p := Pos(); BEGIN p := Pos();
IF (p > errpos) & (errcnt < 25) THEN IF (p > errpos) & (errcnt < 25) THEN
Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " "); Console.Ln; Console.String(" pos "); Console.Int(p, 1); Console.Char(" ");
Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf) Console.String(msg)
END ; END ;
INC(errcnt); errpos := p + 4 INC(errcnt); errpos := p + 4
END Mark; END Mark;
@ -166,7 +166,8 @@ MODULE ORS; (* NW 19.9.93 / 10.10.2013 Scanner in Oberon-07*)
IF h < maxM THEN k := h ELSE Mark("too many digits*") END ; IF h < maxM THEN k := h ELSE Mark("too many digits*") END ;
DEC(e); Texts.Read(R, ch) DEC(e); Texts.Read(R, ch)
END ; END ;
x := FLT(k); (*x := FLT(k);*)
x := S.VAL(REAL, k);
IF (ch = "E") OR (ch = "D") THEN (*scale factor*) IF (ch = "E") OR (ch = "D") THEN (*scale factor*)
Texts.Read(R, ch); s := 0; Texts.Read(R, ch); s := 0;
IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch) IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch)
@ -272,7 +273,10 @@ MODULE ORS; (* NW 19.9.93 / 10.10.2013 Scanner in Oberon-07*)
END Init; END Init;
PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR); PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR);
BEGIN keyTab[k].id := name; keyTab[k].sym := sym; INC(k) BEGIN
(*keyTab[k].id := name; *)
COPY(name, keyTab[k].id);
keyTab[k].sym := sym; INC(k)
END EnterKW; END EnterKW;
BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0; BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0;

20
src/voc07R/makefile Normal file
View file

@ -0,0 +1,20 @@
SETPATH = MODULES=".:gnuc:gnuc/x86_64"
VOC0 = $(SETPATH) /opt/voc/bin/voc
all:
#$(VOC0) -s ORS.Mod
#$(VOC0) -s ORB.Mod
#$(VOC0) -s ORG.Mod
$(VOC0) -s ORS.Mod ORB.Mod ORG.Mod ORP.Mod -M
test:
./ORP -s test.Mod
clean:
rm *.sym
rm *.o
rm *.h
rm *.c

10
src/voc07R/test.Mod Normal file
View file

@ -0,0 +1,10 @@
MODULE test;
VAR b : BOOLEAN;
i : INTEGER;
BEGIN
b := FALSE;
i := ORD(b);
END test.