MODULE IOWatchDog;

IMPORT
  Rd, RdClass, RefList, Thread, Time, Wr, WrClass;

REVEAL
  Private = Thread.Closure BRANDED OBJECT END;

  T = Public BRANDED OBJECT
    thread: Thread.T;
    creator: Thread.T;
    mu: MUTEX;
    pollInterval: Time.T;
    expired: BOOLEAN;
    canceled: BOOLEAN;
    pollLimit: CARDINAL;
    pollCount: CARDINAL := 0;
    targets: RefList.T := NIL;
  OVERRIDES
    apply := Apply;
    alert := Alert;
    init := Init;
  END;

TYPE
  Target = OBJECT
    rdwr: REFANY;
    lastIndex: CARDINAL;
  END;

It doesn't really matter that we don't lock the readers and writers. The kinds of things that can go wrong don't make any difference to us.

PROCEDURE AddRd(wd: T;
                rd: Rd.T) =
  VAR
    target := NEW(Target, rdwr := rd);
  BEGIN
    IF rd.closed THEN RETURN END;
    target.lastIndex := rd.cur;

    LOCK wd.mu DO
      wd.targets := RefList.Cons(target, wd.targets);
    END;
  END AddRd;

PROCEDURE AddWr(wd: T;
                wr: Wr.T) =
  VAR
    target := NEW(Target, rdwr := wr);
  BEGIN
    IF wr.closed THEN RETURN END;
    target.lastIndex := wr.cur;

    LOCK wd.mu DO
      wd.targets := RefList.Cons(target, wd.targets);
    END;
  END AddWr;

PROCEDURE Alert(self: T) =
  BEGIN
    Thread.Alert(self.creator);
  END Alert;

PROCEDURE Apply(self: T): REFANY =
  VAR
    cur, prev: RefList.T;
    target: Target;
    closed: BOOLEAN;
    index: CARDINAL;
    madeProgress: BOOLEAN;
  BEGIN
    LOOP
      TRY Thread.AlertPause(self.pollInterval) EXCEPT Thread.Alerted => END;
      madeProgress := FALSE;
      prev := NIL;
      LOCK self.mu DO
	IF self.canceled THEN
	  RETURN NIL;
	END;
	cur := self.targets;
	WHILE cur # NIL DO
	  closed := FALSE;
	  target := cur.head;
	  TYPECASE target.rdwr OF
	  | Rd.T(rd) =>
	      IF rd.closed THEN closed := TRUE ELSE index := rd.cur END;
	  | Wr.T(wr) =>
	      IF wr.closed THEN closed := TRUE ELSE index := wr.cur END;
	  ELSE
	    <* ASSERT FALSE *>
	  END;
	  IF closed THEN  (* Remove it from the list. *)
	    IF prev # NIL THEN
	      prev.tail := cur.tail;
	    ELSE
	      self.targets := cur.tail;
	    END;
	  ELSE
	    IF index # target.lastIndex THEN
	      madeProgress := TRUE;
	      target.lastIndex := index;
	    END;
	    prev := cur;
	  END;
	  cur := cur.tail;
	END;
	IF madeProgress THEN
	  self.pollCount := 0;
	ELSE
	  INC(self.pollCount);
	  IF self.pollCount >= self.pollLimit THEN
	    self.expired := TRUE;
	    EXIT;
	  END;
	END;
      END;
    END;
    self.alert();
    RETURN NIL;
  END Apply;

PROCEDURE Cancel(wd: T) =
  BEGIN
    LOCK wd.mu DO
      wd.canceled := TRUE;
    END;
    Thread.Alert(wd.thread);
  END Cancel;

PROCEDURE Expired(wd: T): BOOLEAN =
  BEGIN
    LOCK wd.mu DO
      RETURN wd.expired;
    END;
  END Expired;

PROCEDURE Init(self: T;
               timeout: Time.T;
	       pollInterval: Time.T := 60.0d0): T =
  BEGIN
    self.mu := NEW(MUTEX);
    self.pollInterval := pollInterval;
    self.pollLimit := CEILING(timeout / pollInterval);
    self.creator := Thread.Self();
    self.expired := FALSE;
    self.canceled := FALSE;
    LOCK self.mu DO
      self.thread := Thread.Fork(self);
    END;
    RETURN self;
  END Init;

BEGIN
END IOWatchDog.