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.