blackbox-linux-console/BlackBox/Dev/Mod/Compiler.txt

MODULE DevCompiler;

	(* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Dev/Mod/Compiler.odc *)
	(* DO NOT EDIT *)

	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.