Oberon/ETH Oberon/2.3.7/Compiler.Mod
< Oberon | ETH Oberon
(* ETH Oberon, Copyright 1990-2003 Computer Systems Institute, ETH Zurich, CH-8092 Zurich.
Refer to the license.txt file provided with this distribution. *)
MODULE Compiler; (** portable, except where noted *)
IMPORT
OPP, OPB, OPV, OPT, OPS, OPC, OPL, OPO, OPM, Modules, Display, Oberon, Texts;
CONST
NoBreakPC = -1;
module = OPS.module; ident = OPS.ident; period = OPS.period; (* symbols *)
VAR
W: Texts.Writer;
PROCEDURE SignOn;
BEGIN
Texts.WriteString(W, "Oberon Portable Compiler / nw, rc, nm, tk, prk"); Texts.WriteLn(W);
Texts.WriteString(W, OPP.SignOnMessage); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END SignOn;
PROCEDURE GetOptions(VAR S: Texts.Scanner; VAR opts: ARRAY OF CHAR);
VAR i: LONGINT; ch: CHAR;
BEGIN
WHILE (S.class = Texts.Char) & (S.c = Oberon.OptionChar) DO
i := 0;
WHILE opts[i] # 0X DO INC(i) END;
ch := S.nextCh;
WHILE ch > " " DO
opts[i] := ch; INC(i); Texts.Read(S, ch)
END;
opts[i] := " "; INC(i);
opts[i] := 0X; S.nextCh := ch; Texts.Scan(S)
END;
END GetOptions;
PROCEDURE InOptions(VAR opt: ARRAY OF CHAR; ch: CHAR): BOOLEAN;
VAR i: LONGINT;
BEGIN
i := 0;
WHILE (opt[i] # 0X) & (opt[i] # ch) DO
IF (opt[i] = ".") OR (opt[i] = "P") THEN
REPEAT INC(i) UNTIL (opt[i] = 0X) OR (opt[i] = " ")
ELSE INC(i) END
END;
RETURN opt[i] = ch
END InOptions;
PROCEDURE Locate(F: Display.Frame; T: Texts.Text; pos: LONGINT);
VAR M: Oberon.CaretMsg; N: Oberon.ControlMsg;
BEGIN
IF pos < 0 THEN pos := 0
ELSIF pos > T.len THEN pos := T.len
END;
N.F := NIL; N.id := Oberon.neutralize; Display.Broadcast(N);
Oberon.FadeCursor(Oberon.Pointer);
M.id := Oberon.set; M.F := F; M.car := F; M.text := T; M.pos := pos; Display.Broadcast(M)
END Locate;
PROCEDURE GetBreakPC(): LONGINT;
VAR S: Texts.Scanner; t: Texts.Text; beg, end, time: LONGINT;
BEGIN
Oberon.GetSelection(t, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, t, beg); Texts.Scan(S);
end := S.line;
WHILE (S.class # Texts.Int) & (S.line = end) DO Texts.Scan(S) END;
END;
IF (time < 0) OR (S.class # Texts.Int) THEN
Texts.WriteString(W, " pc not selected"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
RETURN NoBreakPC
ELSE
RETURN S.i
END
END GetBreakPC;
PROCEDURE ParseOptions(VAR name, options, path, pref, extension: ARRAY OF CHAR; VAR codeOpt, parserOpt: SET);
VAR i, j, k: LONGINT; ch: CHAR;
BEGIN
codeOpt := OPM.DefaultCodeOpt; parserOpt := OPM.DefaultParserOpt;
i := 0; path[0] := 0X; pref[0] := 0X;
COPY(Modules.extension, extension);
LOOP
ch := options[i]; INC(i);
IF ch = 0X THEN EXIT
ELSIF ch = "x" THEN codeOpt := codeOpt / {OPM.inxchk}
ELSIF ch = "v" THEN codeOpt := codeOpt / {OPM.ovflchk}
ELSIF ch = "t" THEN codeOpt := codeOpt / {OPM.typchk}
ELSIF ch = "p" THEN codeOpt := codeOpt / {OPM.ptrinit}
ELSIF ch = "a" THEN codeOpt := codeOpt / {OPM.assert}
ELSIF ch = "z" THEN codeOpt := codeOpt / {OPM.fullstackinit}
ELSIF ch = "q" THEN codeOpt := codeOpt / {OPM.trace}
ELSIF ch = "s" THEN parserOpt := parserOpt / {OPM.newsf}
ELSIF ch = "S" THEN parserOpt := parserOpt / {OPM.systemchk}
ELSIF ch = "n" THEN parserOpt := parserOpt / {OPM.nofiles}
ELSIF ch = "e" THEN parserOpt := parserOpt / {OPM.extsf}
ELSIF ch = "f" THEN parserOpt := parserOpt / {OPM.findpc}
ELSIF ch = "w" THEN parserOpt := parserOpt / {OPM.warning}
ELSIF ch = "X" THEN parserOpt := parserOpt + {OPM.prefix}
ELSIF ch = "2" THEN parserOpt := parserOpt / {OPM.oberon2}
ELSIF ch = "1" THEN parserOpt := parserOpt / {OPM.oberon1}
ELSIF ch = "T" THEN parserOpt := parserOpt / {OPM.traceprocs} (* temp *)
ELSIF ch = "." THEN
j := 0;
WHILE (ch # 0X) & (ch # " ") DO
extension[j] := ch; ch := options[i];
INC(j); INC(i)
END;
extension[j] := 0X
ELSIF ch = "P" THEN
ch := options[i]; INC(i);
k := 0;
WHILE (ch # 0X) & (ch # " ") DO
path[k] := ch; INC(k);
ch := options[i]; INC(i)
END;
path[k] := 0X
ELSIF ch = "O" THEN (* mutually exclusive with "X" *)
ch := options[i]; INC(i);
k := 0;
WHILE (ch # 0X) & (ch # " ") DO
pref[k] := ch; INC(k);
ch := options[i]; INC(i)
END;
pref[k] := 0X
END
END;
IF OPM.prefix IN parserOpt THEN
i := -1; REPEAT INC(i); pref[i] := name[i] UNTIL (name[i] = 0X) OR (name[i] = ".");
IF name[i] # "." THEN i := 0 ELSE INC(i) END;
pref[i] := 0X
END
END ParseOptions;
PROCEDURE WriteMsg(source: Texts.Reader; log: Texts.Text);
VAR sym: SHORTINT;
BEGIN
Texts.WriteString(W, " compiling ");
OPM.Init({}, {}, source, log); OPS.Get(sym);
IF sym = module THEN
OPS.Get(sym);
IF sym = ident THEN
Texts.WriteString(W, OPM.outputPath);
Texts.WriteString(W, OPM.outputPrefix);
OPS.Get(sym); Texts.WriteString(W, OPS.name);
WHILE sym = period DO
Texts.Write(W, ".");
OPS.Get(sym);
IF sym = ident THEN Texts.WriteString(W, OPS.name); OPS.Get(sym) END;
END;
IF OPM.extension # Modules.extension THEN
Texts.WriteString(W, OPM.extension)
ELSIF (OPM.outputPath = "") & (OPM.outputPrefix = "") THEN (* not cross-compiling *)
IF Modules.FindMod(OPS.name) # NIL THEN
Texts.WriteString(W, " (in use) ")
END
ELSE
(* skip *)
END
END
END;
Texts.Append(log, W.buf)
END WriteMsg;
PROCEDURE Module*(source: Texts.Reader; name, options: ARRAY OF CHAR; breakpc: LONGINT;
log: Texts.Text; VAR error: BOOLEAN);
VAR codeOpt, parserOpt: SET; extSF, newSF: BOOLEAN; p: OPT.Node; modName: OPS.Name;
BEGIN
ParseOptions(name, options, OPM.outputPath, OPM.outputPrefix, OPM.extension, codeOpt, parserOpt);
WriteMsg(source, log);
OPM.Init(codeOpt, parserOpt, source, log); OPS.ch := " ";
OPB.typSize := OPV.TypSize; OPV.Init(breakpc);
newSF := OPM.newsf IN parserOpt; extSF := OPM.extsf IN parserOpt;
OPP.Module(p, modName);
IF OPM.noerr THEN
OPL.Init;
OPM.errpos := 0;
OPM.Begin(modName);
IF OPM.noerr THEN
OPT.Export(modName, newSF, extSF);
OPV.AdrAndSize(OPT.topScope);
IF newSF THEN OPM.LogWStr(" new symbol file")
ELSIF extSF THEN OPM.LogWStr(" extended symbol file")
END;
IF OPM.noerr THEN
OPM.errpos := 0;
OPC.Init;
OPV.Module(p);
IF OPM.noerr THEN
OPL.OutCode(modName);
IF OPM.noerr THEN
OPM.LogWStr (" "); OPM.LogWNum(OPO.pc, 1)
END
END
END;
OPL.Close
END
END;
OPT.CloseScope; OPT.Close;
OPM.LogWLn; error := ~OPM.noerr;
OPM.outputPath := "!"; OPM.outputPrefix := "!" (* invalid filename *)
END Module;
PROCEDURE CompileText(t: Texts.Text; pos: LONGINT; frame: Display.Frame; opt: ARRAY OF CHAR; VAR error: BOOLEAN);
VAR f: BOOLEAN; pc: LONGINT; r: Texts.Reader;
BEGIN
IF t # NIL THEN
Texts.OpenReader(r, t, pos);
f := InOptions(opt, "f");
IF f THEN
pc := GetBreakPC();
IF pc = NoBreakPC THEN RETURN END
END;
OPS.Init;
Module(r, "", opt, pc, Oberon.Log, error);
IF f & (frame # NIL) THEN
Locate(frame, t, OPM.breakpos)
END
ELSE
Texts.WriteString(W, "No text marked"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
error := TRUE
END
END CompileText;
PROCEDURE CompileFile*(name, opt: ARRAY OF CHAR; VAR error: BOOLEAN);
VAR t: Texts.Text; r: Texts.Reader; pc: LONGINT;
BEGIN
NEW(t); Texts.Open(t, name);
IF t.len # 0 THEN
Texts.OpenReader(r, t, 0);
IF InOptions(opt, "f") THEN
pc := GetBreakPC();
IF pc = NoBreakPC THEN RETURN END
END;
Texts.WriteString(W, name);
OPS.Init;
Module(r, name, opt, pc, Oberon.Log, error)
ELSE
Texts.WriteString(W, name); Texts.WriteString(W, " not found");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
error := TRUE
END
END CompileFile;
PROCEDURE Compile*;
VAR S: Texts.Scanner; globalOpt, localOpt: ARRAY 32 OF CHAR;
t: Texts.Text; pos, end, time: LONGINT; frame: Display.Frame;
name: ARRAY 64 OF CHAR; error: BOOLEAN;
BEGIN
error := FALSE;
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
globalOpt := ""; GetOptions(S, globalOpt);
IF (S.class = Texts.Char) & ((S.c = "*") OR (S.c = "@")) THEN
IF S.c = "*" THEN
t := Oberon.MarkedText(); pos := 0; frame := Oberon.MarkedFrame();
ELSE (* S.c = "@" *)
Oberon.GetSelection(t, pos, end, time); frame := NIL;
IF time < 0 THEN RETURN END
END;
Texts.Scan(S);
GetOptions(S, globalOpt);
CompileText(t, pos, frame, globalOpt, error);
ELSIF ((S.class = Texts.Char) & (S.c = "^")) OR (S.class = Texts.Name) THEN
IF (S.c = "^") THEN
Oberon.GetSelection(t, pos, end, time);
Texts.OpenScanner(S, t, pos); Texts.Scan(S)
ELSE
end := MAX(LONGINT)
END;
WHILE (S.class = Texts.Name) & (Texts.Pos(S) - S.len <= end) & ~error DO
COPY(S.s, name); COPY(globalOpt, localOpt);
Texts.Scan(S); GetOptions(S, localOpt);
CompileFile(name, localOpt, error)
END
END
END Compile;
BEGIN
Texts.OpenWriter(W); SignOn
END Compiler.
Compiler.Compile Test.Mod ~
Compiler.Compile Test.Mod\s ~
Compiler.Compile Test.Mod\sX.Obx ~
Compiler.Compile *
Compiler.Compile *\s
Compiler.Compile \.Obx Test.Mod Test.Mod\.Obf Test.Mod ~
Compiler.Compile @