ported ulmTimers

makefile

@@ -199,6 +199,7 @@ stage6:
 	$(VOCSTATIC) -sP ulmScales.Mod
 	$(VOCSTATIC) -sP ulmTimes.Mod
 	$(VOCSTATIC) -sP ulmClocks.Mod
+	$(VOCSTATIC) -sP ulmTimers.Mod
 	
 	
 	#pow32 libs

src/lib/ulm/ulmTimers.Mod

@@ -0,0 +1,336 @@
+(* Ulm's Oberon Library
+   Copyright (C) 1989-1994 by University of Ulm, SAI, D-89069 Ulm, Germany
+   ----------------------------------------------------------------------------
+   Ulm's Oberon Library is free software; you can redistribute it
+   and/or modify it under the terms of the GNU Library General Public
+   License as published by the Free Software Foundation; either version
+   2 of the License, or (at your option) any later version.
+
+   Ulm's Oberon Library is distributed in the hope that it will be
+   useful, but WITHOUT ANY WARRANTY; without even the implied warranty
+   of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+   Library General Public License for more details.
+
+   You should have received a copy of the GNU Library General Public
+   License along with this library; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+   ----------------------------------------------------------------------------
+   E-mail contact: oberon@mathematik.uni-ulm.de
+   ----------------------------------------------------------------------------
+   $Id: Timers.om,v 1.3 2001/04/30 14:58:18 borchert Exp $
+   ----------------------------------------------------------------------------
+   $Log: Timers.om,v $
+   Revision 1.3  2001/04/30 14:58:18  borchert
+   bug fix: recursion via Clocks.TimerOn was not possible
+
+   Revision 1.2  1994/07/18  14:21:51  borchert
+   bug fix: CreateQueue took uninitialized priority variable instead of
+            queue.priority
+
+   Revision 1.1  1994/02/22  20:11:37  borchert
+   Initial revision
+
+   ----------------------------------------------------------------------------
+   AFB 1/92
+   ----------------------------------------------------------------------------
+*)
+
+MODULE ulmTimers;
+
+   IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities,
+      SYS := ulmSYSTEM, SYSTEM, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Times := ulmTimes;
+
+   TYPE
+      Queue = POINTER TO QueueRec;
+      Timer* = POINTER TO TimerRec;
+      TimerRec* =
+	 RECORD
+	    (Objects.ObjectRec)
+	    valid: BOOLEAN;       (* a valid timer entry? *)
+	    queue: Queue;         (* timer belongs to this queue *)
+	    prev, next: Timer;    (* double-linked and sorted list *)
+	    time: Times.Time;     (* key *)
+	    event: Events.Event;  (* raise this event at the given time *)
+	 END;
+      QueueRec =
+	 RECORD
+	    (Disciplines.ObjectRec)
+	    clock: Clocks.Clock;           (* queue of this clock *)
+	    priority: Priorities.Priority; (* priority of the clock *)
+	    checkQueue: Events.EventType;  (* check queue on this event *)
+	    head, tail: Timer;             (* sorted list of timers *)
+	    lock: BOOLEAN;
+	 END;
+   TYPE
+      CheckQueueEvent = POINTER TO CheckQueueEventRec;
+      CheckQueueEventRec =
+	 RECORD
+	    (Events.EventRec)
+	    queue: Queue;
+	 END;
+   TYPE
+      ClockDiscipline = POINTER TO ClockDisciplineRec;
+      ClockDisciplineRec =
+	 RECORD
+	    (Disciplines.DisciplineRec)
+	    queue: Queue;
+	 END;
+   VAR
+      clockDisciplineId: Disciplines.Identifier;
+
+   CONST
+      invalidTimer* = 0; (* timer is no longer valid *)
+      queueLocked* = 1; (* the queue is currently locked *)
+      badClock* = 2; (* clock is unable to maintain a timer *)
+      errorcodes* = 3;
+   TYPE
+      ErrorEvent* = POINTER TO ErrorEventRec;
+      ErrorEventRec* =
+	 RECORD
+	    (Events.EventRec)
+	    errorcode*: SHORTINT;
+	 END;
+   VAR
+      errormsg*: ARRAY errorcodes OF Events.Message;
+      error*: Events.EventType;
+
+   PROCEDURE InitErrorHandling;
+   BEGIN
+      errormsg[invalidTimer] := "invalid timer given to Timers.Remove";
+      errormsg[queueLocked] := "the queue is currently locked";
+      errormsg[badClock] := "clock is unable to maintain a timer";
+      Events.Define(error); Events.SetPriority(error, Priorities.liberrors);
+   END InitErrorHandling;
+
+   PROCEDURE Error(errors: RelatedEvents.Object; code: SHORTINT);
+      VAR
+	 event: ErrorEvent;
+   BEGIN
+      NEW(event);
+      event.type := error;
+      event.message := errormsg[code];
+      event.errorcode := code;
+      RelatedEvents.Raise(errors, event);
+   END Error;
+
+   PROCEDURE CheckQueue(queue: Queue);
+      VAR
+	 currentTime: Times.Time;
+	 oldTimers: Timer;
+	 p, prev: Timer;
+	 checkQueueEvent: CheckQueueEvent;
+	 nextTimer: Timer;
+   BEGIN
+      IF queue.head = NIL THEN queue.lock := FALSE; RETURN END;
+
+      Clocks.GetTime(queue.clock, currentTime);
+
+      (* remove old timers from queue *)
+      oldTimers := queue.head;
+      p := queue.head; prev := NIL;
+      WHILE (p # NIL) & (Op.Compare(currentTime, p.time) >= 0) DO
+	 prev := p; p := p.next;
+      END;
+      IF p = NIL THEN
+	 queue.head := NIL; queue.tail := NIL;
+      ELSE
+	 queue.head := p;
+	 p.prev := NIL;
+      END;
+      IF prev = NIL THEN
+	 oldTimers := NIL;
+      ELSE
+	 prev.next := NIL;
+      END;
+
+      (* set up next check-queue-event, if necessary *)
+      nextTimer := queue.head;
+      queue.lock := FALSE;
+	 (* unlock queue now to allow recursion via Clocks.TimerOn *)
+      IF nextTimer # NIL THEN
+	 NEW(checkQueueEvent);
+	 checkQueueEvent.type := queue.checkQueue;
+	 checkQueueEvent.message := "check queue of timer";
+	 checkQueueEvent.queue := queue;
+	 Clocks.TimerOn(queue.clock, nextTimer.time, checkQueueEvent);
+      ELSE
+	 Clocks.TimerOff(queue.clock);
+      END;
+
+      (* process old timers *)
+      p := oldTimers;
+      WHILE p # NIL DO
+	 p.valid := FALSE;
+	 Events.Raise(p.event);
+	 p := p.next;
+      END;
+   END CheckQueue;
+
+   PROCEDURE CatchCheckQueueEvents(event: Events.Event);
+   BEGIN
+      WITH event: CheckQueueEvent DO
+	 IF ~SYS.TAS(event.queue.lock) THEN
+	    CheckQueue(event.queue);
+	    (* event.queue.lock := FALSE; (* done by CheckQueue *) *)
+	 END;
+      END;
+   END CatchCheckQueueEvents;
+
+   PROCEDURE CreateQueue(errors: RelatedEvents.Object;
+			 VAR queue: Queue; clock: Clocks.Clock) : BOOLEAN;
+      VAR
+	 clockDiscipline: ClockDiscipline;
+   BEGIN
+      IF ~(Clocks.timer IN Clocks.Capabilities(clock)) THEN
+	 Error(errors, badClock); RETURN FALSE
+      END;
+
+      NEW(queue);
+      queue.clock := clock;
+      queue.head := NIL; queue.tail := NIL;
+      queue.lock := FALSE;
+      Events.Define(queue.checkQueue);
+      Events.Handler(queue.checkQueue, CatchCheckQueueEvents);
+      Clocks.GetPriority(clock, queue.priority);
+      IF queue.priority > Priorities.base THEN
+	 Events.SetPriority(queue.checkQueue, queue.priority + 1);
+      ELSE
+	 queue.priority := Priorities.default;
+      END;
+
+      NEW(clockDiscipline); clockDiscipline.id := clockDisciplineId;
+      clockDiscipline.queue := queue;
+      Disciplines.Add(clock, clockDiscipline);
+      RETURN TRUE
+   END CreateQueue;
+
+   PROCEDURE Add*(clock: Clocks.Clock; time: Times.Time; event: Events.Event;
+		 VAR timer: Timer);
+      VAR
+	 queue: Queue;
+	 clockDiscipline: ClockDiscipline;
+	 p: Timer;
+	 absTime: Times.Time;
+   BEGIN
+      IF Disciplines.Seek(clock, clockDisciplineId, SYSTEM.VAL(Disciplines.Discipline, clockDiscipline)) THEN
+	 queue := clockDiscipline.queue;
+      ELSIF ~CreateQueue(clock, queue, clock) THEN
+	 RETURN
+      END;
+
+      IF SYS.TAS(queue.lock) THEN
+	 Error(clock, queueLocked); RETURN
+      END;
+      Events.AssertPriority(queue.priority);
+
+      IF Scales.IsRelative(time) THEN
+	 (* take relative time to be relative to the current time *)
+	 Clocks.GetTime(clock, absTime);
+	 Op.Add2(SYSTEM.VAL(Op.Operand, absTime), time);
+      ELSE
+	 (* create a copy of time *)
+	 absTime := NIL; Op.Assign(SYSTEM.VAL(Op.Operand, absTime), time);
+      END;
+      time := absTime;
+      NEW(timer); timer.time := time; timer.event := event;
+      timer.queue := queue; timer.valid := TRUE;
+
+      (* look for the insertion point *)
+      p := queue.head;
+      WHILE (p # NIL) & (Op.Compare(time, p.time) > 0) DO
+	 p := p.next;
+      END;
+
+      (* insert timer in front of p *)
+      timer.next := p;
+      IF p = NIL THEN
+	 (* append timer at the end of the queue *)
+	 timer.prev := queue.tail;
+	 IF queue.tail = NIL THEN
+	    queue.head := timer;
+	 ELSE
+	    queue.tail.next := timer;
+	 END;
+	 queue.tail := timer;
+      ELSE
+	 timer.prev := p.prev;
+	 timer.next := p;
+	 IF p = queue.head THEN
+	    queue.head := timer;
+	 ELSE
+	    p.prev.next := timer;
+	 END;
+	 p.prev := timer;
+      END;
+
+      CheckQueue(queue);
+      (* queue.lock := FALSE; (* done by CheckQueue *) *)
+      Events.ExitPriority;
+   END Add;
+
+   PROCEDURE Remove*(timer: Timer);
+      VAR
+	 queue: Queue;
+   BEGIN
+      IF timer.valid THEN
+	 queue := timer.queue;
+	 IF SYS.TAS(queue.lock) THEN
+	    Error(queue.clock, queueLocked); RETURN
+	 END;
+	 Events.AssertPriority(queue.priority);
+	 timer.valid := FALSE;
+	 IF timer.prev = NIL THEN
+	    queue.head := timer.next;
+	 ELSE
+	    timer.prev.next := timer.next;
+	 END;
+	 IF timer.next = NIL THEN
+	    queue.tail := timer.prev;
+	 ELSE
+	    timer.next.prev := timer.prev;
+	 END;
+	 CheckQueue(queue);
+	 (* queue.lock := FALSE; (* done by CheckQueue *) *)
+	 Events.ExitPriority;
+      ELSE
+	 Error(timer.queue.clock, invalidTimer);
+      END;
+   END Remove;
+
+   PROCEDURE Schedule*(clock: Clocks.Clock;
+		      time: Times.Time; event: Events.Event);
+      VAR
+	 timer: Timer;
+   BEGIN
+      Add(clock, time, event, timer);
+   END Schedule;
+
+   PROCEDURE NextEvent*(clock: Clocks.Clock; VAR time: Times.Time) : BOOLEAN;
+      VAR
+	 rval: BOOLEAN;
+	 queue: Queue;
+	 clockDiscipline: ClockDiscipline;
+   BEGIN
+      IF ~Disciplines.Seek(clock, clockDisciplineId, SYSTEM.VAL(Disciplines.Discipline, clockDiscipline)) THEN
+	 RETURN FALSE
+      END;
+      queue := clockDiscipline.queue;
+
+      IF SYS.TAS(queue.lock) THEN
+	 Error(clock, queueLocked); RETURN FALSE
+      END;
+      CheckQueue(queue);
+      IF queue.head # NIL THEN
+	 time := queue.head.time;
+	 rval := TRUE;
+      ELSE
+	 rval := FALSE
+      END;
+      (* queue.lock := FALSE; (* done by CheckQueue *) *)
+      RETURN rval
+   END NextEvent;
+
+BEGIN
+   InitErrorHandling;
+   clockDisciplineId := Disciplines.Unique();
+END ulmTimers.