diff --git a/makefile b/makefile index 113a0a8a..1fe2c51f 100644 --- a/makefile +++ b/makefile @@ -199,6 +199,7 @@ stage6: $(VOCSTATIC) -sP ulmScales.Mod $(VOCSTATIC) -sP ulmTimes.Mod $(VOCSTATIC) -sP ulmClocks.Mod + $(VOCSTATIC) -sP ulmTimers.Mod #pow32 libs diff --git a/src/lib/ulm/ulmTimers.Mod b/src/lib/ulm/ulmTimers.Mod new file mode 100644 index 00000000..88ca1996 --- /dev/null +++ b/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.