mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 23:22:25 +00:00
ported ulmTimers
This commit is contained in:
Norayr Chilingarian
parent
94ed5a801e
commit
418da2a304
2 changed files with 337 additions and 0 deletions
1
makefile
1
makefile
|
|
@ -199,6 +199,7 @@ stage6:
|
|||
$(VOCSTATIC) -sP ulmScales.Mod
|
||||
$(VOCSTATIC) -sP ulmTimes.Mod
|
||||
$(VOCSTATIC) -sP ulmClocks.Mod
|
||||
$(VOCSTATIC) -sP ulmTimers.Mod
|
||||
|
||||
|
||||
#pow32 libs
|
||||
|
|
|
|||
336
src/lib/ulm/ulmTimers.Mod
Normal file
336
src/lib/ulm/ulmTimers.Mod
Normal file
|
|
@ -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.
|
||||
Loading…
Add table
Add a link
Reference in a new issue