Syntax10.Scn.Fnt
StampElems
Alloc
26 May 95
MODULE Compiler;
(* Compiler for Oberon-2 on Sun-3 workstations.
 Diplomarbeit Samuel Urech
 Programming language: Oberon-2 on Ceres-1.
 Date: 3.11.92   Current version: 
 IMPORT
  Texts, TextFrames, Viewers, Oberon,
  OPP, OPB, OPV, OPT, OPS, OPC, OPL, OPM;
 CONST
  OptionChar = "\";
  ShowCommand = "OPdump.Show";
  SignOnMessage = "Compiler  SU 26.5.95";
  (* 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 *)
  nilchk = 9; (* NIL check *)
  defopt = {inxchk, typchk, ptrinit, assert, nilchk}; (* default options *)
  prog*: OPT.Node;
  showTree, watch: BOOLEAN;
  (* 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 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 = "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 = "n" THEN opt := opt / {nilchk}
   END
  UNTIL ch = 0X;
  OPM.Init(source, log); OPS.Init; OPT.Init; OPB.typSize := OPV.TypSize;
  newSF := newsf IN opt;
  OPT.OpenScope(0, NIL);
  OPP.Module(p, modName);
  IF OPM.noerr THEN
   OPL.Init(opt);
   OPV.Init(opt, breakpc);
   OPV.AdrAndSize;
   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.Module(p);
    IF OPM.noerr THEN
     OPL.OutCode(modName, key);
     IF OPM.noerr THEN
      OPM.CloseRefObj;
      OPM.LogWNum(OPL.pc, 8);
      OPM.LogWNum(OPL.dsize, 8);
     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 beg, end, time, pos: 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; pos := Texts.Pos(S); 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;
    pos := Texts.Pos(S); 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); pos := Texts.Pos(S); Texts.Scan(S); NEW(source); 
     WHILE (S.class = Texts.Name) & (pos < 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;
 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;
BEGIN
 (* HideTree; DontWatch; *) prog := NIL; Texts.OpenWriter(W);
 Texts.WriteString(W, SignOnMessage); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Compiler.