Copyright (C) 1994, Digital Equipment Corp.
<* PRAGMA LL *>
MODULE FormsCache;
IMPORT FormsVBT, RefList, Rd, RdUtils, Stdio, Text, Thread, TextRefTbl,
TextTextTbl, VBT, Wr;
TYPE
Worker = Thread.Closure OBJECT
handle: Thread.T;
name := "";
flush := FALSE;
OVERRIDES
apply := WorkerThread
END;
Closure = REF RECORD name: TEXT; END;
VAR
nonempty := NEW (Thread.Condition); (* synchronizes workers *)
mu := NEW (MUTEX);
<* LL = mu *>
threadCt := -1; (* number of worker threads *)
forms := NEW (TextRefTbl.T);
(* <name, RefList.T of FormsVBT.T> *)
bodies := NEW (TextTextTbl.T);
(* <name, body> iff Assoc(name,body) prev called *)
workers : RefList.T; (* of Worker *)
formsToPrep: RefList.T; (* of TEXT *)
PROCEDURE Resolve (v: VBT.T): Closure =
BEGIN
RETURN NARROW (VBT.GetProp (v, TYPECODE (Closure)), Closure);
END Resolve;
PROCEDURE ActiveThreads (ct: CARDINAL) =
<* LL = 0 *>
BEGIN
LOCK mu DO
ActiveThreadsWLock (ct);
END
END ActiveThreads;
PROCEDURE ActiveThreadsWLock (ct: CARDINAL) =
<* LL = mu *>
VAR worker: Worker;
BEGIN
IF threadCt = -1 THEN threadCt := 0 END;
IF ct > threadCt THEN
WHILE ct # threadCt DO
worker := NEW (Worker);
RefList.Push (workers, worker);
worker.handle := Thread.Fork (worker);
INC (threadCt);
END;
ELSIF ct < threadCt THEN
WHILE ct # threadCt DO
worker := RefList.Pop (workers);
Thread.Alert (worker.handle);
DEC (threadCt);
END;
END;
END ActiveThreadsWLock;
PROCEDURE WorkerThread (worker: Worker): REFANY =
<* LL = 0 *>
VAR
name: TEXT;
form: FormsVBT.T;
BEGIN
LOOP
TRY
name := Consume ()
EXCEPT
| Thread.Alerted => RETURN NIL;
END;
LOCK mu DO worker.name := name; END;
TRY
form := GenerateForm (name, FALSE);
LOCK mu DO
IF Thread.TestAlert () THEN RETURN NIL; END;
IF NOT worker.flush THEN
AddForm (worker.name, form);
END;
worker.name := "";
END;
EXCEPT
| FormsVBT.Error =>
END;
END;
END WorkerThread;
PROCEDURE Prepare (name: TEXT; copies: CARDINAL := 1) =
<* LL = 0 *>
BEGIN
LOCK mu DO
IF threadCt = -1 THEN
ActiveThreadsWLock (DefaultNumberOfWorkers)
END;
END;
WHILE copies > 0 DO Produce(name); DEC(copies); END;
END Prepare;
PROCEDURE Get (name: TEXT; restock: BOOLEAN := FALSE): FormsVBT.T
RAISES {FormsVBT.Error} =
<* LL = 0 *>
VAR
value: REFANY;
list : RefList.T;
fv : FormsVBT.T;
cl : Closure;
BEGIN
LOCK mu DO
IF forms.in (name, value) THEN
list := value;
fv := RefList.Pop (list);
IF list = NIL THEN
EVAL forms.delete (name, value);
ELSE
EVAL forms.put (name, list);
END;
ELSE
list := NIL;
IgnoreInWaiting (name);
IgnoreInProgress (name);
fv := GenerateForm (name);
END;
cl := NEW (Closure);
cl.name := name;
VBT.PutProp (fv, cl);
END;
IF list = NIL AND restock THEN Produce (name); END;
RETURN fv;
END Get;
PROCEDURE Assoc (name: TEXT; body: TEXT) =
<* LL = 0 *>
BEGIN
LOCK mu DO EVAL bodies.put(name, body); END;
END Assoc;
PROCEDURE Return (fv: FormsVBT.T) RAISES {BadForm} =
<* LL = 0 *>
VAR cl := Resolve (fv);
BEGIN
IF cl = NIL THEN RAISE BadForm; END;
LOCK mu DO AddForm (cl.name, fv); END;
END Return;
PROCEDURE Flush (name: TEXT := "") =
<* LL = 0 *>
VAR rest: RefList.T;
BEGIN
LOCK mu DO
IF NOT Text.Empty (name) THEN
Flush1 (name)
ELSE
rest :=
RefList.NoDuplicates (RefList.Append (forms.toKeyList (),
bodies.toKeyList ()));
WHILE rest # NIL DO
Flush1 (rest.first);
rest := rest.tail;
END;
END;
END;
END Flush;
PROCEDURE Flush1 (name: TEXT) =
<* LL = mu *>
VAR
body: TEXT;
form: REFANY;
BEGIN
Message ("Flushing ", name);
EVAL bodies.delete (name, body);
EVAL forms.delete (name, form);
IgnoreInWaiting (name);
IgnoreInProgress (name);
END Flush1;
PROCEDURE IgnoreInWaiting (name: TEXT) =
<* LL = mu *>
(* Remove all instances of name from the waiting list. *)
BEGIN
formsToPrep := RefList.Delete(formsToPrep, name);
END IgnoreInWaiting;
PROCEDURE IgnoreInProgress (name: TEXT) =
<* LL = mu *>
(* If any threads are currently working on name, then mark the
worker to ignore the results. *)
VAR
rest : RefList.T;
worker: Worker;
BEGIN
rest := workers;
WHILE rest # NIL DO
worker := RefList.Pop (rest);
IF Text.Equal (worker.name, name) THEN
worker.flush := TRUE;
END
END;
END IgnoreInProgress;
PROCEDURE GenerateForm (name: TEXT; locked := TRUE): FormsVBT.T
RAISES {FormsVBT.Error} =
(* IF locked THEN LL=mu ELSE LL=0 *)
VAR
found: BOOLEAN;
value: TEXT;
BEGIN
Message ("Generating ", name);
IF locked THEN
found := bodies.in (name, value);
ELSE
LOCK mu DO found := bodies.in (name, value); END;
END;
IF found THEN
RETURN NEW (FormsVBT.T).init (value)
ELSE
TRY
RETURN FormsVBT.NewFromFile (name)
EXCEPT
| Rd.Failure (ref) =>
RAISE FormsVBT.Error (RdUtils.FailureText (ref))
| Thread.Alerted => RAISE FormsVBT.Error ("Thread.Alerted")
END
END
END GenerateForm;
PROCEDURE AddForm (name: TEXT; fv: FormsVBT.T) =
<* LL = mu *>
VAR
value: REFANY;
list : RefList.T;
BEGIN
IF fv = NIL THEN RETURN END;
Message ("Adding ", name);
IF forms.in (name, value) THEN
list := value;
RefList.Push (list, fv)
ELSE
list := RefList.List1 (fv)
END;
EVAL forms.put (name, list)
END AddForm;
PROCEDURE Produce (name: TEXT) =
<* LL = 0 *>
BEGIN
LOCK mu DO
Message ("Producing", name);
RefList.Push (formsToPrep, name);
END;
Thread.Broadcast (nonempty);
END Produce;
PROCEDURE Consume (): TEXT RAISES {Thread.Alerted} =
<* LL = 0 *>
VAR name: TEXT;
BEGIN
LOCK mu DO
WHILE RefList.Length (formsToPrep) = 0 DO
Thread.AlertWait (mu, nonempty);
END;
IF Thread.TestAlert () THEN RAISE Thread.Alerted END;
name := RefList.Pop (formsToPrep);
Message ("Consuming ", name);
RETURN name;
END;
END Consume;
VAR
verbose := FALSE;
verboseMu := NEW (MUTEX);
PROCEDURE Message (t1, t2, t3, t4: TEXT := "") =
<* FATAL Wr.Failure, Thread.Alerted *>
BEGIN
IF verbose THEN
LOCK verboseMu DO
Wr.PutText (Stdio.stderr,
"FormsCache: " & t1 & t2 & t3 & t4 & "\n");
Wr.Flush (Stdio.stderr);
END
END
END Message;
BEGIN
END FormsCache.