Syntax10.Scn.Fntl ]ParcElemsAlloc Syntax8.Scn.Fnt ]Courier14.Scn.Fnt ]/ ] 0YX  ] / N|!MODULE Compiler; (* Copyright (c) ETH Zurich, 1989-95 / iOP2: RC, NM 6.3.89 / 12.1.94 *)(* FT 09.09.95 *) (* code generator for Intel i386, i387/ i486 - Diplomarbeit ETH-Zrich WS 92/93 by Niklaus Mannhart, 87-913-117I author's address: Himmelrich 22 6340 Baar, Switzerland e-mail: mannhart@inf.ethz.ch phone: +41 42 31 40 33 This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  To my parents enabling me to study at the ETH.  Acknowledgements Many thanks go to my "compiler construction" teacher Marc Brandis. He had the idea of writing such a compiler and answered many questions during the development. Mattias Hausner, developer of the WinOberon System, was patiently guiding me fixing the bugs. Without his support, the compiler would never have been finished - It was great pleasure to work with them. Niklaus Mannhart, December 1993  March the 2nd 1993 Release 12.12.93 / Release 1.0 Release 12.1.94 / Release 1.1 (fixed: bugs in iOPL.LoadProc and floating point compare (iOPL.FloadCmp)) Release 13.3.94 / Release 1.2 (fixed: bug in iOPC.Index) Release 23.6.94 / Release 1.3 (fixed: bug in iOPL.Load, iOPC.SYSgetputReg, floating point problem in iOPL.PushRegs); Release 30.8.94 / 1.4 (mh fixes: iOPC.Index, iOPC.NewSys, iOPL.OutRefs) Release 7.12.94 / 1.5 (fixed: iOPC.NewSys, iOPC.Convert (IntToInt) Release 8.5.95 / 1.6 (register allocator bug in iOPL.GenMul (i*j DIV k didn't work)) Release 22.1.96/ 1.7 (fixed imul bug, IF expr OR TRUE, IF expr & FALSE, ASH (...,0), changed NewArray because Kernel.NewArray uses different memory layout (I haven't checket that!) Known bugs: COPY (name, ptr.name[ptr.index]) To do: IF expr OR TRUE ....; IF expr & FALSE try to get rid of unecessary jumps try to get rid of additional load in COPY (name,ptr.name[ptr.index]) *) IMPORT Texts, TextFrames, Viewers, Oberon, OPP := iOPP, OPB := iOPB, OPV := iOPV, OPT := iOPT, OPS := iOPS, OPC := iOPC, OPL := iOPL, OPO := iOPO, OPM := iOPM; CONST OptionChar = "\"; ShowCommand = "OPdump.ShowProg"; SignOnMessage = "iOP2 RC/NM V1.7 22.1.1996"; (* compiler options: *) inxchk = 0; (* index check on *) ovflchk = 1; (* overflow check on *) typchk = 3; (* type check on *) newsf = 4; (* generation of new symbol file allowed *) ptrinit = 5; (* pointer initialization *) assert = 6; (* assert evaluation *) findpc = 7; (* find text position of breakpc *) debug = 8; (* create a list from the pair pc and corresponding source position *) (* FT 09.09.95 *) defopt = {inxchk, typchk, ptrinit, assert}; VAR prog*: OPT.Node; ModName*: ARRAY 32 OF CHAR; showTree, watch: BOOLEAN; (* global because of the GC call *) (* source: Texts.Text; sourceR: Texts.Reader; S: Texts.Scanner; v: Viewers.Viewer;*) W: Texts.Writer; mainMod*: OPT.Object; (* MAH 20.07.94 *) PROCEDURE Module*(source: Texts.Reader; options: ARRAY OF CHAR; breakpc: LONGINT; log: Texts.Text; VAR error: BOOLEAN); VAR key: LONGINT; opt: SET; ch: CHAR; newSF: BOOLEAN; p: OPT.Node; modName: OPS.Name; res, i: INTEGER; command: ARRAY 32 OF CHAR; BEGIN IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END ; opt := defopt; i := 0; REPEAT ch := options[i]; INC(i); IF ch = "x" THEN opt := opt / {inxchk} ELSIF ch = "v" THEN opt := opt / {ovflchk} ELSIF ch = "t" THEN opt := opt / {typchk} ELSIF ch = "s" THEN opt := opt / {newsf} ELSIF ch = "p" THEN opt := opt / {ptrinit} ELSIF ch = "a" THEN opt := opt / {assert} ELSIF ch = "f" THEN opt := opt / {findpc} ELSIF ch = "d" THEN opt := opt/{debug} (* FT 09.09.95 *) END UNTIL ch = 0X; OPM.Init(source, log); OPS.Init; OPT.Init; OPB.typSize := OPV.TypSize; newSF := newsf IN opt; OPT.OpenScope(0, NIL); IF (debug IN opt) THEN COPY("DEBUG", modName) END ; (* abuse the variable modName to know in module iOPP that the option debug is set FT 030.11.95 *) OPP.Module(p, modName); IF (debug IN opt) OR (findpc IN opt) THEN mainMod := OPT.topScope (* MAH 20.07.94 *)(* FT 09.09.95 *) ELSE mainMod := NIL END ; IF OPM.noerr THEN OPL.Init; OPV.AdrAndSize(OPT.topScope); OPM.errpos := 0; key := OPM.NewKey(); OPT.Export(modName, newSF, key); IF newSF THEN OPM.LogWStr(" new symbol file") END ; IF showTree THEN prog := p; command := ShowCommand; Oberon.Call(command, Oberon.Par, FALSE, res); prog := NIL END ; IF OPM.noerr THEN OPM.OpenRefObj(modName); OPC.Init(opt); OPV.Init(opt, breakpc); OPV.Module(p); IF OPM.noerr THEN OPL.OutCode(modName, key); IF OPM.noerr THEN IF ~(debug IN opt) THEN OPM.CloseRefObj END ; OPM.LogWStr (" "); OPM.LogWNum(OPO.pc, 1); END END END ; OPL.Close END ; OPT.CloseScope; OPT.Close; OPM.LogWLn; error := ~OPM.noerr; IF watch THEN command := "System.Watch"; Oberon.Call(command, Oberon.Par, FALSE, res) END END Module; PROCEDURE Compile*; VAR S: Texts.Scanner; source: Texts.Text; sourceR: Texts.Reader; v: Viewers.Viewer; beg, end, time: LONGINT; error: BOOLEAN; ch: CHAR; PROCEDURE Do(filename: ARRAY OF CHAR; beg: LONGINT); VAR S1: Texts.Scanner; line, i: INTEGER; options: ARRAY 32 OF CHAR; fbeg, fend, ftime, breakpc: LONGINT; ftext: Texts.Text; f: BOOLEAN; BEGIN Texts.WriteString(W, filename); Texts.WriteString(W, " compiling "); Texts.OpenScanner(S1, source, beg); Texts.Scan(S1); IF (S1.class = Texts.Name) & (S1.s = "MODULE") THEN Texts.Scan(S1); IF S1.class = Texts.Name THEN Texts.WriteString(W, S1.s); COPY (S1.s, ModName) END ELSE COPY (filename, ModName) END ; Texts.Append(Oberon.Log, W.buf); line := S.line; i := 0; f := FALSE; Texts.Scan(S); IF (S.line = line) & (S.class = Texts.Char) & (S.c = OptionChar) THEN ch := S.nextCh; WHILE ((ch >= "0") & (ch <= "9") OR (ch >= "a") & (ch <= "z")) & (i < LEN(options) - 1) DO options[i] := ch; INC(i); IF ch = "f" THEN f := ~f END ; Texts.Read(S, ch) END ; S.nextCh := ch; Texts.Scan(S) END ; options[i] := 0X; IF f THEN LOOP Oberon.GetSelection(ftext, fbeg, fend, ftime); IF ftime >= 0 THEN Texts.OpenScanner(S1, ftext, fbeg); Texts.Scan(S1); IF S1.class = Texts.Int THEN breakpc := S1.i; EXIT END END ; Texts.WriteString(W, " pc not selected"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE; RETURN END END ; Texts.OpenReader(sourceR, source, beg); Module(sourceR, options, breakpc, Oberon.Log, error); (*Kernel.GC*) END Do; BEGIN error := FALSE; Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF S.class = Texts.Char THEN IF S.c = "*" THEN v := Oberon.MarkedViewer(); IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN source := v.dsc.next(TextFrames.Frame).text; Do("", 0) END ELSIF S.c = "^" THEN Oberon.GetSelection(source, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(S, source, beg); Texts.Scan(S); NEW(source); WHILE (S.class = Texts.Name) & (Texts.Pos(S) - S.len <= end) & ~error DO Texts.Open(source, S.s); IF source.len # 0 THEN Do(S.s, 0) ELSE Texts.WriteString(W, S.s); Texts.WriteString(W, " not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE END END END ELSIF S.c = "@" THEN Oberon.GetSelection(source, beg, end, time); IF time >= 0 THEN Do("", beg) END END ELSE NEW(source); WHILE (S.class = Texts.Name) & ~error DO Texts.Open(source, S.s); IF source.len # 0 THEN Do(S.s, 0) ELSE Texts.WriteString(W, S.s); Texts.WriteString(W, " not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); error := TRUE END END END ; v := NIL; source := NIL END Compile; PROCEDURE ShowTree*; BEGIN showTree := TRUE END ShowTree; PROCEDURE HideTree*; BEGIN showTree := FALSE END HideTree; PROCEDURE DoWatch*; BEGIN watch := TRUE END DoWatch; PROCEDURE DontWatch*; BEGIN watch := FALSE END DontWatch; PROCEDURE ShowCode*; BEGIN OPV.dumpCode := TRUE END ShowCode; PROCEDURE HideCode*; BEGIN OPV.dumpCode := FALSE END HideCode; BEGIN HideTree; DontWatch; HideCode; prog := NIL; Texts.OpenWriter(W); Texts.WriteLn (W); Texts.WriteString(W, SignOnMessage); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END Compiler.