diff --git a/makefile b/makefile index 4bedd0f3..113a0a8a 100644 --- a/makefile +++ b/makefile @@ -198,6 +198,7 @@ stage6: $(VOCSTATIC) -sP ulmOperations.Mod $(VOCSTATIC) -sP ulmScales.Mod $(VOCSTATIC) -sP ulmTimes.Mod + $(VOCSTATIC) -sP ulmClocks.Mod #pow32 libs diff --git a/src/lib/ulm/ulmClocks.Mod b/src/lib/ulm/ulmClocks.Mod new file mode 100644 index 00000000..d0416cfb --- /dev/null +++ b/src/lib/ulm/ulmClocks.Mod @@ -0,0 +1,277 @@ +(* 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: Clocks.om,v 1.3 2004/02/19 15:21:17 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: Clocks.om,v $ + Revision 1.3 2004/02/19 15:21:17 borchert + Passed added including passed capability + + Revision 1.2 1996/01/04 16:50:25 borchert + clocks are now an extension of Services.Object + + Revision 1.1 1994/02/22 20:06:13 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 1/92 + ---------------------------------------------------------------------------- +*) + +MODULE ulmClocks; + + IMPORT Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, Priorities := ulmPriorities, + RelatedEvents := ulmRelatedEvents, Services := ulmServices, Times := ulmTimes; + + TYPE + Clock* = POINTER TO ClockRec; + + CONST + settime* = 0; timer* = 1; passed* = 2; + TYPE + CapabilitySet* = SET; (* OF [settime..passed] *) + TYPE + GetTimeProc* = PROCEDURE (clock: Clock; VAR time: Times.Time); + SetTimeProc* = PROCEDURE (clock: Clock; time: Times.Time); + PassedProc* = PROCEDURE (clock: Clock; time: Times.Time) : BOOLEAN; + TimerOnProc* = PROCEDURE (clock: Clock; time: Times.Time; + event: Events.Event); + TimerOffProc* = PROCEDURE (clock: Clock); + GetPriorityProc* = PROCEDURE (clock: Clock; + VAR priority: Priorities.Priority); + Interface* = POINTER TO InterfaceRec; + InterfaceRec* = + RECORD + (Objects.ObjectRec) + gettime*: GetTimeProc; + settime*: SetTimeProc; + passed*: PassedProc; + timeron*: TimerOnProc; + timeroff*: TimerOffProc; + getpriority*: GetPriorityProc; + END; + + TYPE + ClockRec* = + RECORD + (Services.ObjectRec) + if: Interface; + caps: CapabilitySet; + END; + VAR + clockType: Services.Type; + + TYPE + StaticClock = POINTER TO StaticClockRec; + StaticClockRec = + RECORD + (ClockRec) + time: Times.Time; + timerOn: BOOLEAN; + timer: Times.Time; + event: Events.Event; + END; + VAR + staticClockType: Services.Type; + + VAR + system*: Clock; (* the clock of the operating system *) + + CONST + cannotSetTime* = 0; (* SetTime not implemented *) + cannotSetTimer* = 1; (* timer not implemented *) + errorcodes* = 2; + TYPE + ErrorEvent* = POINTER TO ErrorEventRec; + ErrorEventRec* = + RECORD + (Events.EventRec) + errorcode*: SHORTINT; + END; + VAR + errormsg*: ARRAY errorcodes OF Events.Message; + error*: Events.EventType; + + PROCEDURE Error(clock: Clock; code: SHORTINT); + VAR + event: ErrorEvent; + BEGIN + NEW(event); + event.type := error; + event.message := errormsg[code]; + event.errorcode := code; + RelatedEvents.Raise(clock, event); + END Error; + + PROCEDURE InitErrorHandling; + BEGIN + errormsg[cannotSetTime] := "SetTime not implemented for this clock"; + errormsg[cannotSetTimer] := "timer not implemented for this clock"; + Events.Define(error); + Events.SetPriority(error, Priorities.liberrors); + END InitErrorHandling; + + PROCEDURE Init*(clock: Clock; if: Interface; caps: CapabilitySet); + VAR + type: Services.Type; + BEGIN + Services.GetType(clock, type); + ASSERT(type # NIL); + ASSERT(if.gettime # NIL); + ASSERT(~(passed IN caps) OR (if.passed # NIL)); + ASSERT(~(settime IN caps) OR (if.settime # NIL)); + IF timer IN caps THEN + ASSERT((if.timeron # NIL) & (if.timeroff # NIL) & + (if.getpriority # NIL)); + END; + clock.if := if; + clock.caps := caps; + RelatedEvents.QueueEvents(clock); + END Init; + + PROCEDURE Capabilities*(clock: Clock) : CapabilitySet; + BEGIN + RETURN clock.caps + END Capabilities; + + PROCEDURE GetTime*(clock: Clock; VAR time: Times.Time); + BEGIN + clock.if.gettime(clock, time); + END GetTime; + + PROCEDURE SetTime*(clock: Clock; time: Times.Time); + BEGIN + IF settime IN clock.caps THEN + clock.if.settime(clock, time); + ELSE + Error(clock, cannotSetTime); + END; + END SetTime; + + PROCEDURE Passed*(clock: Clock; time: Times.Time) : BOOLEAN; + VAR + currentTime: Times.Time; + BEGIN + IF passed IN clock.caps THEN + RETURN clock.if.passed(clock, time) + ELSE + GetTime(clock, currentTime); + RETURN Op.Compare(currentTime, time) >= 0 + END; + END Passed; + + PROCEDURE TimerOn*(clock: Clock; time: Times.Time; event: Events.Event); + BEGIN + IF timer IN clock.caps THEN + clock.if.timeron(clock, time, event); + ELSE + Error(clock, cannotSetTimer); + END; + END TimerOn; + + PROCEDURE TimerOff*(clock: Clock); + BEGIN + IF timer IN clock.caps THEN + clock.if.timeroff(clock); + ELSE + Error(clock, cannotSetTimer); + END; + END TimerOff; + + PROCEDURE GetPriority*(clock: Clock; VAR priority: Priorities.Priority); + (* return Priorities.base in case of static clocks *) + BEGIN + IF timer IN clock.caps THEN + clock.if.getpriority(clock, priority); + ELSE + Error(clock, cannotSetTimer); + END; + END GetPriority; + + (* ========= implementation of static clocks ========== *) + + PROCEDURE StaticGetTime(clock: Clock; VAR time: Times.Time); + BEGIN + time := clock(StaticClock).time; + END StaticGetTime; + + PROCEDURE StaticSetTime(clock: Clock; time: Times.Time); + BEGIN + WITH clock: StaticClock DO + clock.time := time; + IF clock.timerOn & (Op.Compare(clock.time, clock.timer) >= 0) THEN + clock.timerOn := FALSE; + Events.Raise(clock.event); + END; + END; + END StaticSetTime; + + PROCEDURE StaticTimerOn(clock: Clock; time: Times.Time; event: Events.Event); + BEGIN + WITH clock: StaticClock DO + IF Op.Compare(time, clock.time) < 0 THEN + Events.Raise(event); + ELSE + clock.timerOn := TRUE; + clock.timer := time; + clock.event := event; + END; + END; + END StaticTimerOn; + + PROCEDURE StaticTimerOff(clock: Clock); + BEGIN + WITH clock: StaticClock DO + clock.timerOn := FALSE; + END; + END StaticTimerOff; + + PROCEDURE StaticGetPriority(clock: Clock; VAR priority: Priorities.Priority); + BEGIN + priority := Priorities.base; + END StaticGetPriority; + + PROCEDURE CreateStaticClock*(VAR clock: Clock); + VAR + if: Interface; + staticClock: StaticClock; + BEGIN + NEW(staticClock); + Services.Init(staticClock, staticClockType); + Times.Create(staticClock.time, Times.absolute); + staticClock.timerOn := FALSE; + NEW(if); + if.gettime := StaticGetTime; + if.settime := StaticSetTime; + if.timeron := StaticTimerOn; + if.timeroff := StaticTimerOff; + if.getpriority := StaticGetPriority; + Init(staticClock, if, {settime, timer}); + clock := staticClock; + END CreateStaticClock; + +BEGIN + InitErrorHandling; + Services.CreateType(clockType, "Clocks.Clock", ""); + Services.CreateType(staticClockType, "Clocks.StaticClock", "Clocks.Clock"); + (* system is hopefully re-initialized by another module which interfaces + the real system clock + *) + CreateStaticClock(system); +END ulmClocks.