ðmOberon10.Scn.FntOberon10i.Scn.Fntý|4ïMODULE Compiler; (* rc, js 5.11.96 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Z…rich. All Rights Reserved. * Oberon is a trademark of Institut f…r Computersysteme, ETH Z…rich. *---------------------------------------------------------*) (*-- Object Model --*) IMPORT Texts, TextFrames, Viewers, Oberon, OPP := HOPP, OPB := HOPB, OPV := HOPV, OPT := HOPT, OPL := HOPL, OPM := HOPM; CONST OptionChar = "\"; SignOnMessage = "Compiler (PA-RISC 1.1) RC, JS. Version 2.2b"; (* compiler options: *) inxchk = 0; (* index check on *) ovflchk = 1; (* overflow check on *) ranchk = 2; (* range check on *) typchk = 3; (* type check on *) newsf = 4; (* generation of new symbol file allowed *) ptrinit = 5; (* pointer initialization *) intprinf = 6; (* inter-procedural information about register allocation used *) assert = 7; (* assert evaluation *) findpc = 8; (* find text position of breakpc *) extsf = 9; (* extension of old symbol file allowed *) cendian = 10; (* generation of big(little) endian code on a little(big) endian machine *) nilchk = 11; (* nil check on *) xtype = 12; (* extended type informations NYI *) defopt = {inxchk, typchk, ptrinit, assert}; (* default options *) VAR (* global because of the GC call on Ceres *) source: Texts.Text; sourceR: Texts.Reader; S: Texts.Scanner; v: Viewers.Viewer; W: Texts.Writer; PROCEDURE Module*(source: Texts.Reader; options: ARRAY OF CHAR; breakpc: LONGINT; log: Texts.Text; VAR error: BOOLEAN); VAR opt: SET; ch: CHAR; i: INTEGER; ext, new: BOOLEAN; p: OPT.Node; BEGIN 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 = "r" THEN opt := opt / {ranchk} ELSIF ch = "t" THEN opt := opt / {typchk} ELSIF ch = "s" THEN opt := opt / {newsf} ELSIF ch = "p" THEN opt := opt / {ptrinit} ELSIF ch = "i" THEN opt := opt / {intprinf} ELSIF ch = "a" THEN opt := opt / {assert} ELSIF ch = "f" THEN opt := opt / {findpc} ELSIF ch = "e" THEN opt := opt / {extsf} ELSIF ch = "c" THEN opt := opt / {cendian} ELSIF ch = "n" THEN opt := opt / {nilchk} ELSIF ch = "d" THEN opt := opt / {xtype} END UNTIL ch = 0X; OPM.Init(source, log); OPP.Module(p, opt); IF OPM.noerr THEN OPV.Init(opt, breakpc); OPV.Allocate; OPT.Export(ext, new); IF OPM.noerr THEN OPV.Module(p); IF OPM.noerr THEN IF new OR ext OR OPM.doSym THEN OPM.RegisterNewSym END ; IF new THEN OPM.LogWStr(" new symbol file") ELSIF ext THEN OPM.LogWStr(" extended symbol file") ELSIF OPM.doSym THEN OPM.LogWStr(" symbol file forced") END ; OPM.LogWNum(4*LONG(OPL.pc), 8); OPM.LogWNum(OPL.dsize, 8); ELSE OPM.DeleteNewSym END END ; OPL.Close END ; OPT.Close; OPM.LogWLn; error := ~OPM.noerr END Module; PROCEDURE Compile*; VAR 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) END 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) 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 ; Oberon.Collect(0) END Compile; BEGIN OPB.typSize := OPV.TypeSize; OPT.typSize := OPV.TypeSize; Texts.OpenWriter(W); Texts.WriteString(W, SignOnMessage); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END Compiler.