Oberon/ETH Oberon/2.3.7/Compiler.Mod

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