MODULE DevCompiler;
(**
project = "BlackBox"
organization = "www.oberon.ch"
contributors = "Oberon microsystems"
version = "System/Rsrc/About"
copyright = "System/Rsrc/About"
license = "Docu/BB-License"
references = "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
changes = ""
issues = ""
**)
IMPORT Kernel,
Files, Views, Dialog, Controls,
TextModels, TextMappers, TextViews, TextControllers,
StdLog, StdDialog,
DevMarkers, DevCommanders, DevSelectors,
DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPV := DevCPV486;
CONST
(* compiler options: *)
checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5; srcpos = 6; reallib = 7; signatures = 8;
hint = 29; oberon = 30; errorTrap = 31;
defopt = {checks, assert, obj, ref, allref, srcpos, signatures};
(* additional scanner types *)
import = 100; module = 101; semicolon = 102; becomes = 103; comEnd = 104;
VAR
sourceR: TextModels.Reader;
s: TextMappers.Scanner;
str: Dialog.String;
found: BOOLEAN; (* DevComDebug was found -> DTC *)
PROCEDURE Module (source: TextModels.Reader; opt: SET; log: TextModels.Model; VAR error: BOOLEAN);
VAR ext, new: BOOLEAN; p: DevCPT.Node;
BEGIN
DevCPM.Init(source, log);
IF found THEN INCL(DevCPM.options, DevCPM.comAware) END;
IF errorTrap IN opt THEN INCL(DevCPM.options, DevCPM.trap) END;
IF oberon IN opt THEN INCL(DevCPM.options, DevCPM.oberon) END;
DevCPT.Init(opt);
DevCPB.typSize := DevCPV.TypeSize;
DevCPT.processor := DevCPV.processor;
DevCPP.Module(p);
IF DevCPM.noerr THEN
IF DevCPT.libName # "" THEN EXCL(opt, obj) END;
(*
IF errorTrap IN opt THEN DevCPDump.DumpTree(p) END;
*)
DevCPV.Init(opt); DevCPV.Allocate; DevCPT.Export(ext, new);
IF DevCPM.noerr & (obj IN opt) THEN
DevCPV.Module(p)
END;
DevCPV.Close
END;
IF DevCPM.noerr & (new OR ext) THEN DevCPM.RegisterNewSym
ELSE DevCPM.DeleteNewSym
END;
DevCPT.Close;
error := ~DevCPM.noerr;
DevCPM.Close;
p := NIL;
Kernel.FastCollect;
IF error THEN
DevCPM.InsertMarks(source.Base());
DevCPM.LogWLn; DevCPM.LogWStr(" ");
IF DevCPM.errors = 1 THEN
Dialog.MapString("#Dev:OneErrorDetected", str)
ELSE
DevCPM.LogWNum(DevCPM.errors, 0); Dialog.MapString("#Dev:ErrorsDetected", str)
END;
StdLog.String(str)
ELSE
IF hint IN opt THEN DevCPM.InsertMarks(source.Base()) END;
DevCPM.LogWStr(""); DevCPM.LogWNum(DevCPE.pc, 8);
DevCPM.LogWStr(""); DevCPM.LogWNum(DevCPE.dsize, 8)
END;
DevCPM.LogWLn
END Module;
PROCEDURE Scan (VAR s: TextMappers.Scanner);
BEGIN
s.Scan;
IF s.type = TextMappers.string THEN
IF s.string = "MODULE" THEN s.type := module END
ELSIF s.type = TextMappers.char THEN
IF s.char = "(" THEN
IF s.rider.char = "*" THEN
s.rider.Read;
REPEAT Scan(s) UNTIL (s.type = TextMappers.eot) OR (s.type = comEnd);
Scan(s)
END
ELSIF s.char = "*" THEN
IF s.rider.char = ")" THEN s.rider.Read; s.type := comEnd END
END
END
END Scan;
PROCEDURE Do (source, log: TextModels.Model; beg: INTEGER; opt: SET; VAR error: BOOLEAN);
VAR s: TextMappers.Scanner;
BEGIN
Dialog.MapString("#Dev:Compiling", str);
StdLog.String(str); StdLog.Char(" ");
s.ConnectTo(source); s.SetPos(beg);
Scan(s);
WHILE (s.type # TextMappers.eot) & (s.type # module) DO Scan(s) END;
IF s.type = module THEN
Scan(s);
IF s.type = TextMappers.string THEN
StdLog.Char('"'); StdLog.String(s.string); StdLog.Char('"')
END
END;
sourceR := source.NewReader(NIL); sourceR.SetPos(beg);
Module(sourceR, opt, log, error)
END Do;
PROCEDURE Open;
BEGIN
Dialog.ShowStatus("#Dev:Compiling");
StdLog.buf.Delete(0, StdLog.buf.Length())
END Open;
PROCEDURE Close;
BEGIN
StdLog.text.Append(StdLog.buf);
IF DevCPM.noerr THEN Dialog.ShowStatus("#Dev:Ok")
END;
sourceR := NIL;
Kernel.Cleanup
END Close;
PROCEDURE Compile*;
VAR t: TextModels.Model; error: BOOLEAN;
BEGIN
Open;
t := TextViews.FocusText();
IF t # NIL THEN
Do(t, StdLog.text, 0, defopt, error);
IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END Compile;
PROCEDURE CompileOpt* (opt: ARRAY OF CHAR);
VAR t: TextModels.Model; error: BOOLEAN; i: INTEGER; opts: SET;
BEGIN
i := 0; opts := defopt;
WHILE opt[i] # 0X DO
IF opt[i] = "-" THEN
IF srcpos IN opts THEN EXCL(opts, srcpos)
ELSIF allref IN opts THEN EXCL(opts, allref)
ELSIF ref IN opts THEN EXCL(opts, ref)
ELSE EXCL(opts, obj)
END
ELSIF opt[i] = "!" THEN
IF assert IN opts THEN EXCL(opts, assert)
ELSE EXCL(opts, checks)
END
ELSIF opt[i] = "+" THEN INCL(opts, allchecks)
ELSIF opt[i] = "?" THEN INCL(opts, hint)
ELSIF opt[i] = "@" THEN INCL(opts, errorTrap)
ELSIF opt[i] = "$" THEN INCL(opts, oberon)
END;
INC(i)
END;
Open;
t := TextViews.FocusText();
IF t # NIL THEN
Do(t, StdLog.text, 0, opts, error);
IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END CompileOpt;
PROCEDURE CompileText* (text: TextModels.Model; beg: INTEGER; OUT error: BOOLEAN);
BEGIN
ASSERT(text # NIL, 20); ASSERT((beg >= 0) & (beg < text.Length()), 21);
Open;
Do(text, StdLog.text, beg, defopt, error);
IF error THEN DevMarkers.ShowFirstError(text, TextViews.focusOnly) END;
Close
END CompileText;
PROCEDURE CompileAndUnload*;
VAR t: TextModels.Model; error: BOOLEAN; mod: Kernel.Module; n: ARRAY 256 OF CHAR;
BEGIN
Open;
t := TextViews.FocusText();
IF t # NIL THEN
Do(t, StdLog.text, 0, defopt, error);
IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly)
ELSE
mod := Kernel.ThisLoadedMod(DevCPT.SelfName);
IF mod # NIL THEN
Kernel.UnloadMod(mod);
n := DevCPT.SelfName$;
IF mod.refcnt < 0 THEN
Dialog.MapParamString("#Dev:Unloaded", n, "", "", str);
StdLog.String(str); StdLog.Ln;
Controls.Relink
ELSE
Dialog.MapParamString("#Dev:UnloadingFailed", n, "", "", str);
StdLog.String(str); StdLog.Ln
END
END
END
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END CompileAndUnload;
PROCEDURE CompileSelection*;
VAR c: TextControllers.Controller; t: TextModels.Model; beg, end: INTEGER; error: BOOLEAN;
BEGIN
Open;
c := TextControllers.Focus();
IF c # NIL THEN
t := c.text;
IF c.HasSelection() THEN
c.GetSelection(beg, end); Do(t, StdLog.text, beg, defopt, error);
IF error THEN DevMarkers.ShowFirstError(t, TextViews.focusOnly) END
ELSE Dialog.ShowMsg("#Dev:NoSelectionFound")
END
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END CompileSelection;
PROCEDURE CompileList (beg, end: INTEGER; c: TextControllers.Controller);
VAR v: Views.View; i: INTEGER; error, one: BOOLEAN; name: Files.Name; loc: Files.Locator;
t: TextModels.Model; opts: SET; title, entry: ARRAY 64 OF CHAR;
BEGIN
s.SetPos(beg); s.Scan; one := FALSE;
WHILE (s.start < end) & (s.type = TextMappers.string) & (s.len < LEN(name)) DO
s.Scan; one := TRUE;
WHILE (s.start < end) & (s.type = TextMappers.char) &
((s.char = "-") OR (s.char = "+") OR
(s.char = "!") OR (s.char = "*") OR (s.char = "?") OR (s.char = "^") OR (s.char = "("))
DO
IF s.char = "(" THEN
WHILE (s.start < end) & ((s.type # TextMappers.char) OR (s.char # ")")) DO s.Scan END
END;
s.Scan
END
END;
IF one & (s.start >= end) THEN
s.SetPos(beg); s.Scan; error := FALSE;
WHILE (s.start < end) & (s.type = TextMappers.string) & ~error DO
i := 0; WHILE i < LEN(name) DO name[i] := 0X; INC(i) END;
StdDialog.GetSubLoc(s.string, "Mod", loc, name);
t := NIL;
IF loc # NIL THEN
v := Views.OldView(loc, name);
IF v # NIL THEN
WITH v: TextViews.View DO t := v.ThisModel()
ELSE Dialog.ShowParamMsg("#Dev:NoTextFileFound", name, "", ""); error := TRUE
END
ELSE Dialog.ShowParamMsg("#Dev:CannotOpenFile", name, "", ""); error := TRUE
END
ELSE Dialog.ShowParamMsg("#System:FileNotFound", name, "", ""); error := TRUE
END;
s.Scan; opts := defopt;
WHILE (s.start < end) & (s.type = TextMappers.char) DO
IF s.char = "-" THEN
IF srcpos IN opts THEN EXCL(opts, srcpos)
ELSIF allref IN opts THEN EXCL(opts, allref)
ELSIF ref IN opts THEN EXCL(opts, ref)
ELSE EXCL(opts, obj)
END
ELSIF s.char = "!" THEN
IF assert IN opts THEN EXCL(opts, assert)
ELSE EXCL(opts, checks)
END
ELSIF s.char = "+" THEN INCL(opts, allchecks)
ELSIF s.char = "?" THEN INCL(opts, hint)
ELSIF s.char = "@" THEN INCL(opts, errorTrap)
ELSIF s.char = "$" THEN INCL(opts, oberon)
ELSIF s.char = "(" THEN
s.Scan;
WHILE (s.start < end) & (s.type = TextMappers.string) DO
title := s.string$; s.Scan;
IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ":") THEN
s.Scan;
IF (s.start < end) & (s.type = TextMappers.string) THEN
entry := s.string$; s.Scan;
IF t # NIL THEN DevSelectors.ChangeTo(t, title, entry) END
END
END;
IF (s.start < end) & (s.type = TextMappers.char) & (s.char = ",") THEN s.Scan END
END
END;
s.Scan
END;
IF t # NIL THEN
Do(t, StdLog.text, 0, opts, error)
END
END
ELSE Dialog.ShowMsg("#Dev:NotOnlyFileNames")
END;
s.ConnectTo(NIL);
IF error & (c # NIL) & c.HasSelection() & (s.start < end) THEN
c.SetSelection(s.start, end)
END;
IF error & (v # NIL) THEN
Views.Open(v, loc, name, NIL);
DevMarkers.ShowFirstError(t, TextViews.any)
END
END CompileList;
PROCEDURE CompileModuleList*;
VAR c: TextControllers.Controller; beg, end: INTEGER;
BEGIN
Open;
c := TextControllers.Focus();
IF c # NIL THEN
s.ConnectTo(c.text);
IF c.HasSelection() THEN c.GetSelection(beg, end)
ELSE beg := 0; end := c.text.Length()
END;
CompileList(beg, end, c)
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END CompileModuleList;
PROCEDURE CompileThis*;
VAR p: DevCommanders.Par; beg, end: INTEGER;
BEGIN
Open;
p := DevCommanders.par;
IF p # NIL THEN
DevCommanders.par := NIL;
s.ConnectTo(p.text); beg := p.beg; end := p.end;
CompileList(beg, end, NIL)
ELSE Dialog.ShowMsg("#Dev:NoTextViewFound")
END;
Close
END CompileThis;
PROCEDURE Init;
VAR loc: Files.Locator; f: Files.File;
BEGIN
loc := Files.dir.This("Dev"); loc := loc.This("Code");
f := Files.dir.Old(loc, "ComDebug.ocf", TRUE);
found := f # NIL;
IF f # NIL THEN f.Close END
END Init;
BEGIN
Init
END DevCompiler.