MODULE Builder;
IMPORT AtomList, FmtTime, IntRefTbl, Pathname;
IMPORT Quake, QMachine, QValue, Text, Thread, Time, Wr;
IMPORT ConfigItem, BrowserDB, BuildCache, Default, ErrLog, HTML, ID;
IMPORT LineWr, Node, Pkg, Text2, Wx;
TYPE
CI = ConfigItem.T;
TYPE
State = REF RECORD
proc : CI;
cmd : TEXT;
arg1, arg2 : TEXT;
root : Pkg.T;
active : Port;
attaching : Port;
buffer : Port;
buf_wx : Wx.T;
cache : Node.T;
mu : MUTEX;
changed : Thread.Condition;
n_live : INTEGER := 0; (* # of active ports with non-NIL wxs *)
done : BOOLEAN := FALSE;
abort : BOOLEAN := FALSE;
key : ID.T := ID.NoID;
END;
TYPE
Port = REF RECORD
next : Port := NIL;
wx : Wx.T := NIL;
wr_error : AtomList.T := NIL;
END;
PROCEDURE NewState (ci: CI; arg1, arg2: TEXT; root: Pkg.T; wx: Wx.T): State =
VAR s := NEW (State);
BEGIN
s.proc := ci;
s.cmd := ConfigItem.Desc[ci].name;
s.arg1 := arg1;
s.arg2 := arg2;
s.root := root;
s.active := NEW (Port, wx := wx);
s.attaching := NIL;
s.buffer := NIL;
s.buf_wx := NIL;
s.cache := NIL;
s.mu := NIL;
s.changed := NIL;
s.n_live := 1;
s.done := FALSE;
s.abort := FALSE;
s.key := ID.NoID;
RETURN s;
END NewState;
VAR
ongoing_mu := NEW (MUTEX);
ongoing := NEW (IntRefTbl.Default).init ();
PROCEDURE Build (root: Pkg.T; pkg_dir: Pathname.T; args: TEXT; wx: Wx.T)
RAISES {Thread.Alerted, Wr.Failure} =
VAR
key := ID.Add (Node.FullPath (root));
ref: REFANY;
cl: BuildClosure;
self: Port;
buf_wx: Wx.T;
BEGIN
LOCK ongoing_mu DO
IF ongoing.get (key, ref) THEN
(* join an existing build by listening in *)
cl := ref;
self := NEW (Port, wx := wx, next := cl.s.attaching);
cl.s.attaching := self;
ELSE
(* start a new build *)
cl := NEW (BuildClosure);
cl.s := NewState (CI.Build_package, pkg_dir, args, root, wx);
cl.s.cache := BuildCache.New (root, pkg_dir);
cl.s.mu := NEW (MUTEX);
cl.s.changed := NEW (Thread.Condition);
cl.s.key := key;
(* create the writer that'll buffer stuff for the build cache *)
self := cl.s.active;
buf_wx := NEW (Wx.T).init (NIL);
cl.s.buffer := NEW (Port, wx := buf_wx, next := self);
cl.s.active := cl.s.buffer;
cl.s.buf_wx := buf_wx;
INC (cl.s.n_live);
(* initialize the cache buffer *)
HTML.Begin (cl.s.root, buf_wx);
buf_wx.put ("<P><STRONG>Directory:</STRONG> <TT>", cl.s.arg1, "</TT>\n");
Put (cl.s, "<BR><STRONG>Build time:</STRONG> <TT>");
Put (cl.s, FmtTime.Short (Time.Now()));
Put (cl.s, "</TT>\n<P>\n");
Put (cl.s, "<FORM method=get action=\"./[interrupt]\">");
Put (cl.s, "<INPUT TYPE=submit VALUE=\"Interrupt build\"></FORM>\n<P>\n");
(* finally, let'er rip... *)
cl.handler := Thread.Fork (cl);
EVAL ongoing.put (key, cl);
END;
END;
(* wait until we're done, or the thread's TCP connection breaks *)
LOCK cl.s.mu DO
WHILE (NOT cl.s.done) AND (self.wr_error = NIL) DO
Thread.AlertWait (cl.s.mu, cl.s.changed);
END;
END;
IF (self.wr_error # NIL) THEN
RAISE Wr.Failure (self.wr_error);
END;
END Build;
PROCEDURE InterruptBuild (root: Pkg.T) =
VAR
key := ID.Add (Node.FullPath (root));
ref: REFANY;
cl: BuildClosure;
BEGIN
LOCK ongoing_mu DO
IF NOT ongoing.get (key, ref) THEN RETURN; END;
cl := NARROW (ref, BuildClosure);
cl.s.abort := TRUE;
END;
(* give the builder a chance to quit on its own... *)
Thread.Pause (10.0d0);
IF NOT cl.s.done THEN
(* too late, we're blowing him away! *)
Thread.Alert (cl.handler);
END;
END InterruptBuild;
TYPE
BuildClosure = Thread.Closure OBJECT
s : State;
handler : Thread.T;
OVERRIDES
apply := DoBuild;
END;
PROCEDURE DoBuild (cl: BuildClosure): REFANY =
VAR buf := cl.s.buffer; wx := cl.s.buf_wx; ref: REFANY;
BEGIN
TRY
RunCmd (cl.s);
Flush (cl.s);
IF (cl.s.root # NIL) THEN
wx.put ("<P>\n");
BrowserDB.ScanOne (ID.ToText (cl.s.root.arcname ()), cl.s.root.parent, wx);
END;
HTML.End (wx);
Flush (cl.s);
EXCEPT
| Wr.Failure (ec) => buf.wr_error := ec;
| Thread.Alerted => (* ignore, since we're almost done anyway... *)
END;
BuildCache.AttachBody (cl.s.cache, wx.toText ());
LOCK ongoing_mu DO
IF ongoing.get (cl.s.key, ref) AND (ref = cl) THEN
EVAL ongoing.delete (cl.s.key, ref);
END;
END;
SignalDone (cl.s);
RETURN NIL;
END DoBuild;
PROCEDURE Clean (root: Pkg.T; pkg_dir: Pathname.T; wx: Wx.T)
RAISES {Thread.Alerted, Wr.Failure} =
BEGIN
RunCmd (NewState (CI.Clean_package, pkg_dir, NIL, root, wx));
END Clean;
PROCEDURE Ship (root: Pkg.T; pkg_dir: Pathname.T; wx: Wx.T)
RAISES {Thread.Alerted, Wr.Failure} =
BEGIN
RunCmd (NewState (CI.Ship_package, pkg_dir, NIL, root, wx));
END Ship;
PROCEDURE Run (root: Pkg.T; prog, wd: Pathname.T; wx: Wx.T)
RAISES {Thread.Alerted, Wr.Failure} =
BEGIN
RunCmd (NewState (CI.Run_program, wd, prog, root, wx));
END Run;
PROCEDURE RunCmd (s: State)
RAISES {Thread.Alerted, Wr.Failure} =
VAR
mach : Quake.Machine;
proc : QValue.T;
mach_wr : LineWr.T := LineWr.New (ProcessLine, s);
saved_wr : Wr.T;
saved_echo : BOOLEAN;
n_args : INTEGER := 0;
arg_txt : TEXT;
BEGIN
Put(s, "<P>");
IF (s.arg1 # NIL) AND (s.arg2 # NIL) THEN
arg_txt := "(\"" & s.arg1 & "\", \"" & s.arg2 & "\")";
ELSIF (s.arg1 # NIL) THEN
arg_txt := "(\"" & s.arg1 & "\")";
ELSIF (s.arg2 # NIL) THEN
arg_txt := "(\"" & s.arg2 & "\")";
ELSE
arg_txt := "()";
END;
ErrLog.Msg ("calling ", s.cmd, arg_txt);
Flush (s);
Default.GetConfigProc (s.proc, mach, proc);
IF (mach # NIL) THEN
TRY
saved_echo := mach.exec_echo (ConfigItem.X[ConfigItem.T.Verbose_log].bool);
saved_wr := mach.cur_wr ();
mach.set_wr (mach_wr);
mach.start_call (proc);
IF (s.arg1 # NIL) THEN
QMachine.PushText (mach, s.arg1); INC (n_args);
END;
IF (s.arg2 # NIL) THEN
QMachine.PushText (mach, s.arg2); INC (n_args);
END;
mach.call_proc (n_args, isFunc := FALSE);
mach.set_wr (saved_wr);
EVAL mach.exec_echo (saved_echo);
EXCEPT Quake.Error (msg) =>
Wr.PutText (mach_wr, msg);
LineWr.Clear (mach_wr);
ErrLog.Msg ("** error while running " & s.cmd, arg_txt, " **");
ErrLog.Msg (msg);
END;
END;
(* process any remaining output *)
LineWr.Clear (mach_wr);
Put (s, "\n<P><STRONG>Done.</STRONG><BR>\n");
Flush (s);
END RunCmd;
TYPE
LineInfo = RECORD
header : TEXT;
output : TEXT;
log : TEXT;
END;
PROCEDURE ProcessLine (ref: REFANY; line: TEXT)
RAISES {Wr.Failure, Thread.Alerted} =
VAR s: State := ref; info: LineInfo;
BEGIN
IF s.abort THEN
Put (s, "<P><STRONG>Build aborted.</STRONG><BR>\n");
RAISE Thread.Alerted;
END;
ParseLine (s, line, info);
IF info.log # NIL THEN
ErrLog.Msg (info.log);
END;
IF info.header # NIL THEN
Put (s, info.header);
Put (s, "<BR>\n");
END;
IF info.output # NIL THEN
Put (s, "<TT>");
Put (s, info.output);
Put (s, "</TT><BR>\n");
END;
Flush (s);
END ProcessLine;
PROCEDURE ParseLine (s: State; line: TEXT; VAR(*OUT*) info: LineInfo)
RAISES {Wr.Failure, Thread.Alerted} =
BEGIN
info.output := line;
info.log := NIL;
info.header := NIL;
IF (line # NIL) AND (Text.Length (line) > 1) THEN
CASE Text.GetChar (line, 0) OF
| '/' => ParseCmd (line, info); (* "/usr/local/bin/stubgen ..." *)
| ' ' => ParseMisc (line, info); (* " -> linking" ? *)
| '\"' => ParseError (s, line, info); (* "../src/foobar.i3"... *)
ELSE ParseCompileStep (line, info); (* "stale -> compiling foo.i3" *)
END;
END;
END ParseLine;
PROCEDURE ParseCmd (line: TEXT; VAR info: LineInfo) =
(* expecting: /foo/baz/command arg0 arg1 ... *)
VAR cmd, stmt: TEXT; space := Text.FindChar (line, ' ');
BEGIN
IF space = -1 THEN RETURN END;
cmd := Pathname.Last (Text.Sub (line, 0, space));
IF Text.Equal (cmd, "m3bundle") THEN
stmt := "Bundling resources";
ELSIF Text.Equal (cmd, "stubgen") THEN
stmt := "Preprocessing for Network Objects";
ELSIF Text.Equal (cmd, "stablegen") THEN
stmt := "Preprocessing for Stable Objects";
ELSE
stmt := "Running " & cmd;
END;
info.log := stmt;
info.header := stmt;
END ParseCmd;
PROCEDURE ParseMisc (line: TEXT; VAR info: LineInfo) =
VAR len := Text.Length (line);
BEGIN
IF (len > 2) AND (Text.GetChar (line, 1) = '-') THEN
(* something like: " -> linking ..." *)
WITH space = Text.FindChar (line, ' ', 1) + 1,
what = Text.Sub (line, space) DO
info.log := what;
info.header := what;
info.output := NIL;
END;
END;
END ParseMisc;
PROCEDURE ParseError (s: State; line: TEXT; VAR info: LineInfo)
RAISES {Wr.Failure, Thread.Alerted} =
CONST Tag = ARRAY BOOLEAN OF TEXT { "error", "warn" };
VAR x0, x1, x2, x3: INTEGER; file, err_line, msg: TEXT; n: Node.T;
BEGIN
(* extract the file name *)
x0 := Text.FindChar (line, '\"', 1);
IF (x0 < 2) THEN RETURN END;
file := Text.Sub (line, 1, x0-1);
(* find the line number *)
x1 := Text2.FindSubstring (line, "line ");
x2 := Text.FindChar (line, ':', x1+5);
IF (x1 > 0) AND (x2 > x1)
THEN err_line := Text.Sub (line, x1+5, x2 - x1 - 5);
ELSE err_line := "1";
END;
(* is it an error or warning? *)
x3 := Text2.FindSubstring (line, "warning:");
IF (x3 >= 0) THEN msg := Text.Sub (line, x3);
ELSIF (x2 >= 0) THEN msg := Text.Sub (line, x2 + 1);
ELSE msg := Text.Sub (line, x0 + 3);
END;
IF (s.cache # NIL) THEN
n := BuildCache.AddError (s.cache, file, err_line, msg, x3 >= 0);
PutImg (s, Tag [x3 >= 0]);
Put (s, " <TT>");
PutRef (s, n, "ERROR-LINE-" & err_line);
Put (s, Text.Sub (line, x0+3));
Put (s, "</A> ");
PutActionRef (s, n, "edit." & err_line, "ERROR-LINE-" & err_line);
Put (s, "[edit]"); (** PutImg (s, "edit"); **)
Put (s, "</A>");
Put (s, "</TT><BR>\n");
info.output := NIL;
ELSE
info.output := line;
END;
END ParseError;
PROCEDURE ParseCompileStep (line: TEXT; VAR info: LineInfo) =
VAR arrow, space: INTEGER; file, reason, unit: TEXT; ch: CHAR;
BEGIN
arrow := Text2.FindSubstring (line, " -> ");
IF (arrow < 0) THEN RETURN; END;
space := Text.FindCharR (line, ' ');
file := Text.Sub (line, space+1);
reason := Text.Sub (line, 0, arrow);
unit := Pathname.Last (file);
ch := Text.GetChar (unit, Text.Length (unit) - 1);
IF (ch = '3') OR (ch = 'g') THEN
(* mumble.{i3,m3,ig,mg} *)
info.header := "Compiling <B>" & file & "</B> (" & reason & ")";
ELSE
info.header := Text.Sub (line, arrow+4);
END;
info.log := "Compiling " & file & " (" & reason & ")";
info.output := NIL;
END ParseCompileStep;
PROCEDURE NoteAttachments (s: State)
RAISES {Wr.Failure, Thread.Alerted} =
VAR txt: TEXT; p: Port;
BEGIN
LOCK ongoing_mu DO
IF (s.attaching # NIL) THEN
(* grab a copy of what's been produced so far *)
txt := s.buf_wx.toText ();
TRY s.buf_wx.put (txt);
EXCEPT Wr.Failure (ec) => KillPort (s, s.buffer, ec);
END;
(* and push it out to each of the new ports as they become active *)
WHILE (s.attaching # NIL) DO
p := s.attaching; s.attaching := p.next;
p.next := s.active; s.active := p;
INC (s.n_live);
TRY p.wx.put (txt);
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
END;
END;
END NoteAttachments;
PROCEDURE Put (s: State; txt: TEXT)
RAISES {Wr.Failure, Thread.Alerted} =
VAR p: Port;
BEGIN
IF (s.attaching # NIL) THEN NoteAttachments (s); END;
p := s.active;
WHILE (p # NIL) DO
IF (p.wx # NIL) THEN
TRY p.wx.put (txt);
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
p := p.next;
END;
END Put;
PROCEDURE PutImg (s: State; icon: TEXT)
RAISES {Wr.Failure, Thread.Alerted} =
VAR p: Port;
BEGIN
IF (s.attaching # NIL) THEN NoteAttachments (s); END;
p := s.active;
WHILE (p # NIL) DO
IF (p.wx # NIL) THEN
TRY HTML.PutImg (icon, p.wx);
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
p := p.next;
END;
END PutImg;
PROCEDURE PutRef (s: State; node: Node.T; tag: TEXT)
RAISES {Wr.Failure, Thread.Alerted} =
VAR p: Port;
BEGIN
IF (s.attaching # NIL) THEN NoteAttachments (s); END;
p := s.active;
WHILE (p # NIL) DO
IF (p.wx # NIL) THEN
TRY HTML.GenRef (node, p.wx, tag);
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
p := p.next;
END;
END PutRef;
PROCEDURE PutActionRef (s: State; node: Node.T; action, tag: TEXT)
RAISES {Wr.Failure, Thread.Alerted} =
VAR p: Port;
BEGIN
IF (s.attaching # NIL) THEN NoteAttachments (s); END;
p := s.active;
WHILE (p # NIL) DO
IF (p.wx # NIL) THEN
TRY HTML.GenActionRef (node, p.wx, action, tag);
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
p := p.next;
END;
END PutActionRef;
PROCEDURE Flush (s: State)
RAISES {Wr.Failure, Thread.Alerted} =
VAR p: Port;
BEGIN
IF (s.attaching # NIL) THEN NoteAttachments (s); END;
p := s.active;
WHILE (p # NIL) DO
IF (p.wx # NIL) THEN
TRY p.wx.flush ();
EXCEPT Wr.Failure (ec) => KillPort (s, p, ec);
END;
END;
p := p.next;
END;
END Flush;
PROCEDURE KillPort (s: State; p: Port; ec: AtomList.T)
RAISES {Wr.Failure} =
BEGIN
IF (p.wx # NIL) THEN
p.wx := NIL;
p.wr_error := ec;
DEC (s.n_live);
END;
IF (s.n_live <= 0) THEN RAISE Wr.Failure (ec); END;
END KillPort;
PROCEDURE SignalDone (s: State) =
BEGIN
LOCK s.mu DO s.done := TRUE; END;
Thread.Broadcast (s.changed);
END SignalDone;
BEGIN
END Builder.