formsvbt/src/FormsCache.m3


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.