timed/src/Timed.m3


 Copyright 93 Digital Equipment Corporation.
   Digital Internal Use Only

MODULE Timed;

IMPORT Time, Thread, Word;

CONST TimeoutSlop = 0.1D0; (* No attempt is made to time out waits at a finer grain than this.

CONST MaxSleep = 60.0D0 * 60.0D0 * 24.0D0 * 365.0D0;
  (* 365 days *)

TYPE
  Entry = REF RECORD
                (* Protected by ts.mu *)
                next, prev  : Entry;
                timeout     : Time.T;
                onList      : BOOLEAN;
                broadcasting: BOOLEAN;

                (* Only for Timed.Fork *)
                thread: Thread.T;

                (* Only for Timed.Wait and AlertWait *)
                cond        : Thread.Condition;
                mu          : MUTEX;

                (* Protected by mu *)
                doneBroadcasting: BOOLEAN;
              END;

VAR
  ts := NEW(
          MUTEX OBJECT
            wakeUp: Time.T;
            (* When timer thread is scheduled to wake up. *)
            head  : Entry      := NIL;
            thread: Thread.T;
            free  : Entry      := NIL;
            minTimeout := MaxSleep;
            (* Minimum timeout specified during last Pause of timer thread *)
          END,
          wakeUp := Time.Now(),
          thread := Thread.Fork(NEW(Thread.Closure, apply := Timer)));

  stats: RECORD
           calls, broadcasts, wakeUps, races, stillOnList: INTEGER := 0;
         END;

<*INLINE*> PROCEDURE UnsINC (VAR v: INTEGER; inc: INTEGER := 1) =
  BEGIN
    v := Word.Plus(v, inc);
  END UnsINC;

PROCEDURE Timer (<*UNUSED*> closure: Thread.Closure): REFANY =
  VAR entry: Entry;
  BEGIN
    LOCK ts DO
      LOOP
        WITH now = Time.Now() DO
          IF ts.head # NIL AND ts.head.timeout <= now THEN
            entry := ts.head;

            IF entry.mu # NIL THEN
              entry.broadcasting := TRUE;
              UnsINC(stats.broadcasts);
              Thread.Release(ts);
              LOCK entry.mu DO
                Thread.Acquire(ts);
                <*ASSERT entry.onList *>
                Thread.Broadcast(entry.cond);
                entry.doneBroadcasting := TRUE
              END;
            ELSE
              Thread.Alert(entry.thread);
            END;
            DeleteEntry(entry);
          ELSE
            VAR wakeUp := MAX(TimeoutSlop, ts.minTimeout) + now;
            BEGIN
              IF ts.head # NIL THEN
                wakeUp := MIN(ts.head.timeout + TimeoutSlop, wakeUp);
              END;
              ts.wakeUp := wakeUp;
              ts.minTimeout := MaxSleep;
              TRY
                Thread.Release(ts);
                TRY
                  Thread.AlertPause(wakeUp - now);
                FINALLY
                  Thread.Acquire(ts);
                END;
                IF ts.wakeUp # wakeUp THEN
                  (* We've been alerted but haven't noticed it yet *)
                  EVAL Thread.TestAlert();
                END;
              EXCEPT
              | Thread.Alerted =>
              END;
            END;
          END;
        END;
      END;
    END;
  END Timer;

PROCEDURE InsertEntry (entry: Entry) =
  (* Called with ts held *)
  VAR prev, cur: Entry;
  BEGIN
    prev := NIL;
    cur := ts.head;
    WHILE cur # NIL AND cur.timeout < entry.timeout DO
      prev := cur;
      cur := cur.next;
    END;
    entry.next := cur;
    entry.prev := prev;
    IF prev = NIL THEN
      (* Insert at head *)
      ts.head := entry;
    ELSE
      prev.next := entry;
    END;
    IF cur # NIL THEN cur.prev := entry; END;
    entry.onList := TRUE;
    WITH now = Time.Now() DO
      ts.minTimeout := MIN(ts.minTimeout, entry.timeout - now);
      IF ts.wakeUp > ts.head.timeout + TimeoutSlop THEN
        UnsINC(stats.wakeUps);
        ts.wakeUp := now;
        Thread.Alert(ts.thread);
      END;
    END;
  END InsertEntry;

PROCEDURE DeleteEntry (entry: Entry) =
  (* Called with ts held *)
  BEGIN
    <* ASSERT entry.onList *>
    IF entry.prev = NIL THEN
      <*ASSERT ts.head = entry *>
      ts.head := entry.next;
    ELSE
      entry.prev.next := entry.next;
    END;
    IF entry.next # NIL THEN entry.next.prev := entry.prev; END;
    entry.onList := FALSE;
  END DeleteEntry;

PROCEDURE GenWait (alertable: BOOLEAN;
                   m        : Thread.Mutex;
                   c        : Thread.Condition;
                   timeout  : Time.T            ) RAISES {Thread.Alerted} =
  VAR entry: Entry;
  BEGIN
    LOCK ts DO
      UnsINC(stats.calls);
      IF ts.free # NIL THEN
        entry := ts.free;
        ts.free := entry.next;
      ELSE
        entry := NEW(Entry);
      END;
      entry.mu := m;
      entry.cond := c;
      entry.thread := NIL;
      entry.timeout := timeout;
      entry.broadcasting := FALSE;
      entry.doneBroadcasting := FALSE;
      InsertEntry(entry);
    END;
    TRY
      IF alertable THEN
        Thread.AlertWait(m, c);
      ELSE
        Thread.Wait(m, c);
      END;
    FINALLY
      LOCK ts DO
        IF entry.broadcasting AND NOT entry.doneBroadcasting THEN
          (* Timer thread is trying to get entry.mu so that it can
             broadcast the condition.  Wait for it to do its job. *)
          UnsINC(stats.races);
          <* ASSERT entry.onList *>
          Thread.Release(ts);
          TRY
            WHILE NOT entry.doneBroadcasting DO Thread.Wait(m, c); END;
          FINALLY
            Thread.Acquire(ts);
          END;
          <* ASSERT NOT entry.onList *>
        ELSIF entry.onList THEN
          <* ASSERT NOT entry.doneBroadcasting *>
          UnsINC(stats.stillOnList);
          DeleteEntry(entry);
        ELSE
          <*ASSERT entry.doneBroadcasting *>
        END;
        entry.next := ts.free;
        entry.prev := NIL;
        entry.mu := NIL;
        entry.cond := NIL;
        ts.free := entry;
      END;
    END;
  END GenWait;

PROCEDURE Wait (m: MUTEX; c: Thread.Condition; timeout: Time.T) =
  <*FATAL Thread.Alerted*>
  BEGIN
    GenWait(FALSE, m, c, timeout);
  END Wait;

PROCEDURE AlertWait (m: MUTEX; c: Thread.Condition; timeout: Time.T)
  RAISES {Thread.Alerted} =
  BEGIN
    GenWait(TRUE, m, c, timeout);
  END AlertWait;

TYPE
  MyClosure = Thread.Closure OBJECT
                userClosure: Thread.Closure;
                entry      : Entry
              OVERRIDES
                apply := MyApply
              END;

PROCEDURE Fork (closure: Thread.Closure; timeout: Time.T): Thread.T =
  VAR entry: Entry;
  BEGIN
    LOCK ts DO
      UnsINC(stats.calls);
      IF ts.free # NIL THEN
        entry := ts.free;
        ts.free := entry.next;
      ELSE
        entry := NEW(Entry);
      END;
      entry.cond := NIL;
      entry.mu := NIL;
      entry.timeout := timeout;
      WITH closure = NEW(MyClosure, entry := entry, userClosure := closure) DO
        entry.thread := Thread.Fork(closure);
      END;
      InsertEntry(entry);
      RETURN entry.thread;
    END;
  END Fork;

PROCEDURE MyApply (cl: MyClosure): REFANY =
  BEGIN
    WITH rv    = cl.userClosure.apply(),
         entry = cl.entry                DO
      LOCK ts DO
        IF entry.onList THEN
          UnsINC(stats.stillOnList);
          DeleteEntry(entry);
        END;
        entry.next := ts.free;
        entry.prev := NIL;
        entry.thread := NIL;
        ts.free := entry;
      END;
      RETURN rv;
    END;
  END MyApply;

BEGIN
END Timed.