From edf0df4cbf9ba41f10649a49d95764c4c1b78e7c Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Fri, 24 Jan 2014 17:12:26 +0400 Subject: [PATCH] PO 2013 compiler for Wirth's RISC processor now can be compiled with voc --- src/voc07R/ORB.Mod | 66 +++++++++++++++++++----- src/voc07R/ORG.Mod | 121 ++++++++++++++++++++++++++++++++------------ src/voc07R/ORP.Mod | 93 +++++++++++++++++++++++++++------- src/voc07R/ORS.Mod | 14 +++-- src/voc07R/makefile | 20 ++++++++ src/voc07R/test.Mod | 10 ++++ 6 files changed, 253 insertions(+), 71 deletions(-) create mode 100644 src/voc07R/makefile create mode 100644 src/voc07R/test.Mod diff --git a/src/voc07R/ORB.Mod b/src/voc07R/ORB.Mod index b695526f..8c187603 100644 --- a/src/voc07R/ORB.Mod +++ b/src/voc07R/ORB.Mod @@ -1,5 +1,6 @@ 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 called "symbol table". Contains procedures for creation of Objects, and for search: 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); VAR b: BYTE; - BEGIN Files.ReadByte(R, b); - IF b < 80H THEN x := b ELSE x := b - 100H END + BEGIN + (*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; 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); IF t.base.form = NoTyp THEN t.base := NIL; obj := NIL ELSE obj := t.base.dsc END ; Files.ReadNum(R, t.len); (*TD adr/exno*) - Files.ReadNum(R, t.nofpar); (*ext level*) + (*Files.ReadNum(R, t.nofpar);*) (*ext level*) + Files.ReadInt(R, t.nofpar); (*ext level*) Files.ReadNum(R, t.size); Read(R, class); WHILE class # 0 DO (*fields*) @@ -186,7 +191,8 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*) END ; Files.ReadString(R, modname); 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); obj := mod.dsc; (*search type*) 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 ELSE MakeFileName(fname, modid1, ".smb"); F := Files.Old(fname); IF F # NIL THEN - Files.Set(R, F, 0); Files.ReadInt(R, key); Files.ReadInt(R, key); Files.ReadString(R, modname); + 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; Read(R, class); (*version key*) 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 ELSE 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 END END ; @@ -239,7 +253,9 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*) (*-------------------------------- Export ---------------------------------*) 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; 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*) mod := topScope.next; WHILE (mod # NIL) & (mod.lev # t.mno) DO mod := mod.next END ; - IF mod # NIL THEN Files.WriteString(R, mod.name); Files.WriteInt(R, mod.val); Files.WriteString(R, obj.name) + 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) END ELSE Write(R, 0) @@ -330,7 +349,9 @@ MODULE ORB; (*NW 7.10.2013 in Oberon-07*) Write(R, 0) ELSIF obj.class = Const THEN IF obj.type.form = Proc THEN Files.WriteNum(R, obj.exno) - ELSIF obj.type.form = Real THEN Files.WriteInt(R, obj.val) + ELSIF obj.type.form = Real THEN + (*Files.WriteInt(R, obj.val)*) + Files.WriteNum(R, obj.val) ELSE Files.WriteNum(R, obj.val) END 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; FOR Ref := Record+1 TO maxTypTab-1 DO typtab[Ref] := NIL END ; 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*) - 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 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") END 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); 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 ; obj.next := system; system := obj END enter; diff --git a/src/voc07R/ORG.Mod b/src/voc07R/ORG.Mod index d2f420ad..ce08c2fd 100644 --- a/src/voc07R/ORG.Mod +++ b/src/voc07R/ORG.Mod @@ -1,5 +1,5 @@ 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. Procedural interface to Parser OSAP; result in array "code". 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} *) BEGIN - IF x.mode = ORB.Const THEN x.a := LSL(1, x.a) - ELSE load(x); Put1(Mov, RH, 0, 1); Put0(Lsl, x.r, RH, x.r) + IF x.mode = ORB.Const 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) END END Singleton; PROCEDURE Set*(VAR x, y: Item); (* x := {x .. y} *) BEGIN 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 + x.a := 0 + END ELSE - IF (x.mode = ORB.Const) & (x.a < 10H) THEN x.a := LSL(-1, x.a) + 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) 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) END ; 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; BEGIN loadAdr(x); zr := RH; Put2(Ldr, RH, x.r, 0); incR; 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) END 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) 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); VAR fld: ORB.Object; i, s: LONGINT; 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 fld := typ.dsc; 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*) 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); - Files.WriteInt(R, size); + F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); + (*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; 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 ; - obj := obj.next - END ; - Files.Write(R, 0X); - Files.WriteInt(R, tdx*4); - i := 0; - WHILE i < tdx DO Files.WriteInt(R, data[i]); INC(i) END ; (*type descriptors*) - Files.WriteInt(R, varsize - tdx*4); (*data*) - Files.WriteInt(R, strx); - FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ; (*strings*) - Files.WriteInt(R, pc); (*code len*) - FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]) END ; (*program*) - obj := ORB.topScope.next; - WHILE obj # NIL DO (*commands*) - IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) & - (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN - Files.WriteString(R, obj.name); Files.WriteInt(R, obj.val) + 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 END ; Files.Write(R, 0X); - Files.WriteInt(R, nofent); Files.WriteInt(R, entry); + (*Files.WriteInt(R, tdx*4);*) + Files.WriteNum(R, tdx*4); + i := 0; + WHILE i < tdx DO + (*Files.WriteInt(R, data[i]); *) + 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*) + (*Files.WriteInt(R, pc);*) (*code len*) + 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; + WHILE obj # NIL DO (*commands*) + IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) & + (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN + Files.WriteString(R, obj.name); + (*Files.WriteInt(R, obj.val)*) + Files.WriteNum(R, obj.val) + END ; + obj := obj.next + END ; + Files.Write(R, 0X); + (*Files.WriteInt(R, nofent);*) + Files.WriteNum(R, nofent); + (*Files.WriteInt(R, entry);*) + Files.WriteNum(R, entry); obj := ORB.topScope.next; WHILE obj # NIL DO (*entries*) IF obj.exno # 0 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 - 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 - 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 ; @@ -1116,7 +1164,14 @@ MODULE ORG; (* NW 10.10.2013 code generator in Oberon-07 for RISC*) obj := obj.next END ; 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) END Close; diff --git a/src/voc07R/ORP.Mod b/src/voc07R/ORP.Mod index 1cfec152..b41b3100 100644 --- a/src/voc07R/ORP.Mod +++ b/src/voc07R/ORP.Mod @@ -1,5 +1,5 @@ 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. 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 @@ -21,7 +21,7 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07 modid: ORS.Ident; pbsList: PtrBase; (*list of names of pointer base types*) dummy: ORB.Object; - W: Texts.Writer; + (*W: Texts.Writer;*) PROCEDURE Check(s: INTEGER; msg: ARRAY OF CHAR); 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 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.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 ; p0 := p0.next; p1 := p1.next 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); IF (x.type.form = ORB.String) & (x.b = 2) THEN ORG.StrToChar(x) END ; 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 END; 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; obj: ORB.Object; 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 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; IF sym = ORS.ident THEN 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") END ; 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 ORS.errcnt = 0 THEN 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 ; IF ORS.errcnt = 0 THEN - ORG.Close(modid, key, exno); Texts.WriteLn(W); Texts.WriteString(W, "compilation done "); - Texts.WriteInt(W, ORG.pc, 6); Texts.WriteInt(W, dc, 6) - ELSE Texts.WriteLn(W); Texts.WriteString(W, "compilation FAILED") + ORG.Close(modid, key, exno); + (*Texts.WriteLn(W); Texts.WriteString(W, "compilation done ");*) + 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 ; - Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); + (*Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);*) + Out.Ln; ORB.CloseScope; pbsList := NIL ELSE ORS.Mark("must start with MODULE") END END Module; - +(* PROCEDURE Option(VAR S: Texts.Scanner); BEGIN newSF := FALSE; 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 END 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*; VAR beg, end, time: LONGINT; - T: Texts.Text; - S: Texts.Scanner; - BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); + (*T: Texts.Text; + S: Texts.Scanner;*) + s, name : ARRAY 32 OF CHAR; + 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 @@ -965,10 +1001,29 @@ MODULE ORP; (*N. Wirth 1.7.97 / 5.11.2013 Oberon compiler for RISC in Oberon-07 END END ; 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; -BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 5.11.2013"); - Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); +BEGIN (*Texts.OpenWriter(W); Texts.WriteString(W, "OR Compiler 5.11.2013");*) + 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; - expression := expression0; Type := Type0; FormalType := FormalType0 + expression := expression0; Type := Type0; FormalType := FormalType0; + Compile; END ORP. diff --git a/src/voc07R/ORS.Mod b/src/voc07R/ORS.Mod index 0538de01..8f7295f9 100644 --- a/src/voc07R/ORS.Mod +++ b/src/voc07R/ORS.Mod @@ -1,5 +1,5 @@ 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 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; BEGIN p := Pos(); IF (p > errpos) & (errcnt < 25) THEN - Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " "); - Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf) + Console.Ln; Console.String(" pos "); Console.Int(p, 1); Console.Char(" "); + Console.String(msg) END ; INC(errcnt); errpos := p + 4 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 ; DEC(e); Texts.Read(R, ch) END ; - x := FLT(k); + (*x := FLT(k);*) + x := S.VAL(REAL, k); IF (ch = "E") OR (ch = "D") THEN (*scale factor*) Texts.Read(R, ch); s := 0; 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; 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; BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0; diff --git a/src/voc07R/makefile b/src/voc07R/makefile new file mode 100644 index 00000000..d9b3c6bd --- /dev/null +++ b/src/voc07R/makefile @@ -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 + diff --git a/src/voc07R/test.Mod b/src/voc07R/test.Mod new file mode 100644 index 00000000..d97a7e52 --- /dev/null +++ b/src/voc07R/test.Mod @@ -0,0 +1,10 @@ +MODULE test; +VAR b : BOOLEAN; +i : INTEGER; +BEGIN +b := FALSE; +i := ORD(b); + +END test. + +