From ed57314640d3147e2d0b9d3ae0fb1147d919595c Mon Sep 17 00:00:00 2001 From: Norayr Chilingarian Date: Mon, 4 Nov 2013 16:07:40 +0400 Subject: [PATCH] ported TimeConditions, Conditions fixed Former-commit-id: c9646a0f9fbc5c85f79e525d69ba4a5eb18740d1 --- makefile | 1 + src/lib/ulm/ulmConditions.Mod | 2 +- src/lib/ulm/ulmTimeConditions.Mod | 406 ++++++++++++++++++++++++++++++ 3 files changed, 408 insertions(+), 1 deletion(-) create mode 100644 src/lib/ulm/ulmTimeConditions.Mod diff --git a/makefile b/makefile index c4abd100..4cb7d7ac 100644 --- a/makefile +++ b/makefile @@ -202,6 +202,7 @@ stage6: $(VOCSTATIC) -sP ulmTimers.Mod $(VOCSTATIC) -sP ulmConditions.Mod $(VOCSTATIC) -sP ulmStreamConditions.Mod + $(VOCSTATIC) -sP ulmTimeConditions.Mod #pow32 libs diff --git a/src/lib/ulm/ulmConditions.Mod b/src/lib/ulm/ulmConditions.Mod index 2b8ab7c9..2b983470 100644 --- a/src/lib/ulm/ulmConditions.Mod +++ b/src/lib/ulm/ulmConditions.Mod @@ -91,7 +91,7 @@ MODULE ulmConditions; END; BucketTable = ARRAY tags OF ConditionList; - ConditionSet = POINTER TO ConditionSetRec; + ConditionSet* = POINTER TO ConditionSetRec; ConditionSetRec* = RECORD (Objects.ObjectRec) diff --git a/src/lib/ulm/ulmTimeConditions.Mod b/src/lib/ulm/ulmTimeConditions.Mod new file mode 100644 index 00000000..fb39b10d --- /dev/null +++ b/src/lib/ulm/ulmTimeConditions.Mod @@ -0,0 +1,406 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-2004 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: TimeConditi.om,v 1.5 2004/04/05 16:23:37 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: TimeConditi.om,v $ + Revision 1.5 2004/04/05 16:23:37 borchert + bug fix: Test must not call anything which causes directly or + indirectly WaitFor to be called; hence we schedule + a timer event in all cases where this is possible; + the only exception remains Clocks.system where we + take it for granted that the clock operations are + that simple that they do not lead to WaitFor + (was necessary to get RemoteClocks working again) + + Revision 1.4 2004/02/19 15:23:10 borchert + - Init added to support extensions of TimeConditions.Condition + - using Clocks.Passed instead of Clocks.GetTime in some instances + to reduce the number of system calls needed + - Timers event is only generated now if strictly needed, + i.e. if SendEvent has been called + + Revision 1.3 2001/04/30 15:25:12 borchert + several improvements / bug fixes in context of domain-oriented + condition handling + + Revision 1.2 1995/04/06 14:36:16 borchert + fixes due to changed if & semantics of Conditions + + Revision 1.1 1994/02/22 20:11:18 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 1/92 + ---------------------------------------------------------------------------- +*) + +MODULE ulmTimeConditions; + + IMPORT Clocks := ulmClocks, Conditions := ulmConditions, Disciplines := ulmDisciplines, Events := ulmEvents, Op := ulmOperations, + Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM; + + TYPE + Domain = POINTER TO DomainRec; + DomainRec = + RECORD + (Conditions.DomainRec) + clock: Clocks.Clock; + alarm: Events.EventType; + event: Events.Event; (* event of SendEvent *) + END; + Condition = POINTER TO ConditionRec; + ConditionRec* = + RECORD + (Conditions.ConditionRec) + time: Times.Time; + passed: BOOLEAN; (* becomes TRUE if the time has passed *) + scheduled: BOOLEAN; (* Timer event scheduled? *) + domain: Domain; + END; + + TYPE + (* this discpline will be attached to clocks *) + Discipline = POINTER TO DisciplineRec; + DisciplineRec = + RECORD + (Disciplines.DisciplineRec) + domain: Domain; + END; + VAR + disciplineId: Disciplines.Identifier; + + TYPE + WakeupEvent = POINTER TO WakeupEventRec; + WakeupEventRec = + RECORD + (Events.EventRec) + condition: Condition; + awaked: BOOLEAN; (* set to true by Wakeup event handler *) + END; + + VAR + if: Conditions.Interface; + + PROCEDURE FixTime(VAR time: Times.Time; + currentTime: Times.Time; + clock: Clocks.Clock); + (* convert relative time measures into absolute time specs *) + BEGIN + IF Scales.IsRelative(time) THEN + Clocks.GetTime(clock, currentTime); + Op.Add3(SYSTEM.VAL(Op.Operand, time), currentTime, time); + END; + END FixTime; + + PROCEDURE Wakeup(event: Events.Event); + (* note that we strictly rely on the capability of the + underlying clock to raise this event at the appropriate + time; we are unable to verify it because that could + deadlock us in case of remote clocks + *) + VAR + condevent: Events.Event; (* event requested by SendEvent *) + BEGIN + WITH event: WakeupEvent DO + event.awaked := TRUE; + IF event.condition # NIL THEN + event.condition.passed := TRUE; + event.condition.scheduled := FALSE; + condevent := event.condition.domain.event; + IF condevent # NIL THEN + event.condition.domain.event := NIL; + Events.Raise(condevent); + END; + END; + END; + END Wakeup; + + PROCEDURE ScheduleEvent(condition: Condition); + VAR + wakeup: WakeupEvent; + domain: Domain; + BEGIN + IF ~condition.scheduled THEN + domain := condition.domain; + ASSERT(domain.alarm # NIL); + NEW(wakeup); wakeup.type := domain.alarm; + wakeup.awaked := FALSE; wakeup.condition := condition; + condition.scheduled := TRUE; + Timers.Schedule(domain.clock, condition.time, wakeup); + END; + END ScheduleEvent; + + PROCEDURE Init*(condition: Condition; clock: Clocks.Clock; time: Times.Time); + (* like Create but without NEW *) + VAR + clockDisc: Discipline; + domain: Domain; + desc: Conditions.Description; + priorityOfClock: Priorities.Priority; + currentTime: Times.Time; + BEGIN + IF Disciplines.Seek(clock, disciplineId, SYSTEM.VAL(Disciplines.Discipline, clockDisc)) THEN + domain := clockDisc.domain; + ELSE + (* create new domain *) + NEW(desc); desc.caps := {}; desc.internal := TRUE; + IF clock = Clocks.system THEN + desc.caps := desc.caps + + {Conditions.timelimit, Conditions.timecond}; + END; + IF Clocks.timer IN Clocks.Capabilities(clock) THEN + Clocks.GetPriority(clock, priorityOfClock); + IF priorityOfClock > Priorities.base THEN + desc.caps := desc.caps + {Conditions.select, Conditions.async}; + desc.internal := priorityOfClock < Priorities.interrupts; + END; + END; + NEW(domain); Conditions.InitDomain(domain, if, desc); + domain.clock := clock; + IF Clocks.timer IN Clocks.Capabilities(clock) THEN + Events.Define(domain.alarm); + Events.SetPriority(domain.alarm, priorityOfClock + 1); + Events.Handler(domain.alarm, Wakeup); + ELSE + domain.alarm := NIL; + END; + NEW(clockDisc); clockDisc.id := disciplineId; + clockDisc.domain := domain; + Disciplines.Add(clock, clockDisc); + domain.event := NIL; + END; + Conditions.Init(condition, domain); + FixTime(time, currentTime, clock); condition.time := time; + condition.domain := domain; + condition.passed := Clocks.Passed(clock, time); + condition.scheduled := FALSE; + IF ~condition.passed & + (domain.alarm # NIL) & (clock # Clocks.system) THEN + ScheduleEvent(condition); + END; + END Init; + + PROCEDURE Create*(VAR condition: Conditions.Condition; + clock: Clocks.Clock; time: Times.Time); + (* create and initialize a time condition: + is the current time of the clock greater than or + equal to `time'; + if time is relative then it is taken relative to the current time + *) + VAR + timeCond: Condition; + BEGIN + NEW(timeCond); + Init(timeCond, clock, time); + condition := timeCond; + END Create; + + (* ======== interface procedures ================================ *) + + PROCEDURE GetTime(clock: Clocks.Clock; + VAR currentTime: Times.Time; + errors: RelatedEvents.Object) : BOOLEAN; + (* get the current time of clock and check for errors *) + VAR + oldEvents, newEvents: RelatedEvents.Queue; + BEGIN + RelatedEvents.GetQueue(clock, oldEvents); + Clocks.GetTime(clock, currentTime); + RelatedEvents.GetQueue(clock, newEvents); + IF newEvents # NIL THEN + RelatedEvents.AppendQueue(errors, newEvents); + END; + IF oldEvents # NIL THEN + RelatedEvents.AppendQueue(clock, oldEvents); + END; + IF newEvents # NIL THEN + RelatedEvents.AppendQueue(clock, newEvents); + END; + RETURN newEvents = NIL + END GetTime; + + PROCEDURE Passed(clock: Clocks.Clock; + time: Times.Time; + VAR passed: BOOLEAN; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + oldEvents, newEvents: RelatedEvents.Queue; + BEGIN + RelatedEvents.GetQueue(clock, oldEvents); + passed := Clocks.Passed(clock, time); + RelatedEvents.GetQueue(clock, newEvents); + IF newEvents # NIL THEN + RelatedEvents.AppendQueue(errors, newEvents); + END; + IF oldEvents # NIL THEN + RelatedEvents.AppendQueue(clock, oldEvents); + END; + IF newEvents # NIL THEN + RelatedEvents.AppendQueue(clock, newEvents); + END; + RETURN newEvents = NIL + END Passed; + + PROCEDURE Test(domain: Conditions.Domain; condition: Conditions.Condition; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + currentTime: Times.Time; + BEGIN + WITH domain: Domain DO WITH condition: Condition DO + IF condition.passed THEN RETURN TRUE END; + IF condition.domain.event # NIL THEN RETURN FALSE END; + IF condition.scheduled THEN RETURN FALSE END; + IF ~Passed(domain.clock, condition.time, + condition.passed, errors) THEN + condition.passed := TRUE; + RETURN TRUE + END; + RETURN condition.passed + END; END; + END Test; + + PROCEDURE GetMinTime(conditionSet: Conditions.ConditionSet; + VAR minTime: Times.Time; + VAR minCond: Condition); + VAR + condition: Condition; + BEGIN + minTime := NIL; + Conditions.ExamineConditions(conditionSet); + WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO + IF (minTime = NIL) OR (Op.Compare(condition.time, minTime) < 0) THEN + minTime := condition.time; minCond := condition; + END; + END; + Op.Assign(SYSTEM.VAL(Op.Operand, minTime), minTime); (* take a copy *) + END GetMinTime; + + PROCEDURE Select(domain: Conditions.Domain; + conditionSet: Conditions.ConditionSet; + time: Times.Time; + VAR setOfTrueConditions: Conditions.ConditionSet; + errors: RelatedEvents.Object; + retry: BOOLEAN; + VAR interrupted: BOOLEAN) : BOOLEAN; + VAR + minTime: Times.Time; + minCond: Condition; + currentTime: Times.Time; (* of Clocks.system *) + condition: Condition; + wakeup: WakeupEvent; + anythingTrue: BOOLEAN; + + PROCEDURE Failure; + (* we are unable to retrieve the time; + so we have to mark all conditions as passed + and to return the whole set + *) + VAR + condition: Condition; + BEGIN + Conditions.CreateSet(setOfTrueConditions); + Conditions.ExamineConditions(conditionSet); + WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO + condition.passed := TRUE; + Conditions.Incl(setOfTrueConditions, condition); + END; + END Failure; + + BEGIN (* Select *) + WITH domain: Domain DO + GetMinTime(conditionSet, minTime, minCond); + + (* block current process, if necessary *) + interrupted := FALSE; + IF time # NIL THEN + Clocks.GetTime(Clocks.system, currentTime); + FixTime(time, currentTime, Clocks.system); + NEW(wakeup); wakeup.type := domain.alarm; + wakeup.condition := NIL; wakeup.awaked := FALSE; + Timers.Schedule(Clocks.system, time, wakeup); + END; + IF ~GetTime(domain.clock, currentTime, errors) THEN + Failure; RETURN TRUE + END; + + IF ~minCond.passed THEN + LOOP (* goes only into loop if retry = TRUE & we get interrupted *) + Process.Pause; + IF wakeup.awaked THEN EXIT END; + interrupted := ~minCond.passed; + IF ~interrupted THEN EXIT END; + IF ~retry THEN RETURN FALSE END; + END; + END; + + anythingTrue := FALSE; + Conditions.CreateSet(setOfTrueConditions); + Conditions.ExamineConditions(conditionSet); + WHILE Conditions.GetNextCondition(conditionSet, SYSTEM.VAL(Conditions.Condition, condition)) DO + IF condition.passed THEN + Conditions.Incl(setOfTrueConditions, condition); + anythingTrue := TRUE; + END; + END; + RETURN anythingTrue + END; + END Select; + + PROCEDURE SendEvent(domain: Conditions.Domain; + condition: Conditions.Condition; + event: Events.Event; + errors: RelatedEvents.Object) : BOOLEAN; + BEGIN + WITH domain: Domain DO WITH condition: Condition DO + IF condition.passed THEN + RETURN FALSE + ELSE + domain.event := event; + ScheduleEvent(condition); + RETURN TRUE + END; + END; END; + END SendEvent; + + PROCEDURE GetNextTime(domain: Conditions.Domain; + conditionSet: Conditions.ConditionSet; + VAR nextTime: Times.Time; + VAR nextCond: Conditions.Condition; + errors: RelatedEvents.Object); + VAR + condition: Condition; + BEGIN + GetMinTime(conditionSet, nextTime, condition); + nextCond := condition; + END GetNextTime; + + PROCEDURE InitInterface; + BEGIN + NEW(if); + if.test := Test; + if.select := Select; + if.sendevent := SendEvent; + if.gettime := GetNextTime; + END InitInterface; + +BEGIN + disciplineId := Disciplines.Unique(); + InitInterface; +END ulmTimeConditions.