diff --git a/makefile b/makefile index 1fe2c51f..95797362 100644 --- a/makefile +++ b/makefile @@ -200,6 +200,7 @@ stage6: $(VOCSTATIC) -sP ulmTimes.Mod $(VOCSTATIC) -sP ulmClocks.Mod $(VOCSTATIC) -sP ulmTimers.Mod + #$(VOCSTATIC) -sP ulmConditions.Mod #pow32 libs diff --git a/src/lib/ulm/ulmConditions.Mod b/src/lib/ulm/ulmConditions.Mod new file mode 100644 index 00000000..a1fc8cfc --- /dev/null +++ b/src/lib/ulm/ulmConditions.Mod @@ -0,0 +1,967 @@ +(* Ulm's Oberon Library + Copyright (C) 1989-2005 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: Conditions.om,v 1.7 2005/02/09 09:53:25 borchert Exp $ + ---------------------------------------------------------------------------- + $Log: Conditions.om,v $ + Revision 1.7 2005/02/09 09:53:25 borchert + bug fix: we have to enter a busy loop even in case of interrupting + events as there is a window between setup and Process.Pause + + Revision 1.6 2005/02/06 22:26:59 borchert + bug fix: assure that the priority of asynchronous events exceeds + those of interrupting events + + Revision 1.5 2004/09/03 08:59:34 borchert + hash tab size for ConditionSet changed from 128 to 64 + + Revision 1.4 2004/09/01 13:32:18 borchert + performance improvement: condition sets are now based on hashes + + Revision 1.3 2001/05/18 21:59:01 borchert + SetupAsyncEvents checks now all conditions to add as much conditions + as possible to setOfTrueConditions + + Revision 1.2 1996/01/04 16:59:56 borchert + - conditions are now extensions of Disciplines.Object + - some renamings: timecond -> timelimit, hint -> timecond + - errors events have been replaced by assertions + - WaitForAndSelect has been renamed to WaitFor (the old version + of WaitFor vanished) + - conditions are now tagged to allow some optimizations of the + condition set operations + - optimized support of async capability + - redesign of blocking algorithm + + Revision 1.1 1994/02/22 20:06:25 borchert + Initial revision + + ---------------------------------------------------------------------------- + AFB 12/91 + ---------------------------------------------------------------------------- +*) + +MODULE ulmConditions; + + IMPORT Clocks := ulmClocks, Disciplines := ulmDisciplines, Events := ulmEvents, Objects := ulmObjects, Op := ulmOperations, + Priorities := ulmPriorities, Process := ulmProcess, RelatedEvents := ulmRelatedEvents, Scales := ulmScales, Timers := ulmTimers, Times := ulmTimes, SYSTEM; + + CONST + tags = 64; + TYPE + Tag = INTEGER; (* 0..tags-1 *) + (* tags are used for the hashs *) + VAR + nextTag: Tag; (* 0..tags-1, 0..tags-1, ... *) + + TYPE + Domain* = POINTER TO DomainRec; + Condition* = POINTER TO ConditionRec; + ConditionRec* = + RECORD + (Disciplines.ObjectRec) + domain: Domain; + tag: Tag; + waitingForEvent: BOOLEAN; + gotEvent: BOOLEAN; + END; + + (* disjunctive list of conditions *) + ConditionList = POINTER TO ConditionListRec; + ConditionListRec = + RECORD + cond: Condition; + next: ConditionList; + END; + + BucketTable = ARRAY tags OF ConditionList; + ConditionSet = POINTER TO ConditionSetRec; + ConditionSetRec* = + RECORD + (Objects.ObjectRec) + cardinality: INTEGER; + bucket: BucketTable; + (* for the iterator *) + next: ConditionList; i: INTEGER; + END; + + CONST + select* = 0; timelimit* = 1; async* = 2; timecond* = 3; preconditions* = 4; + TYPE + CapabilitySet* = SET; (* OF [select..preconditions] *) + TYPE + SelectProc* = PROCEDURE (domain: Domain; conditionSet: ConditionSet; + time: Times.Time; + VAR setOfTrueConditions: ConditionSet; + errors: RelatedEvents.Object; + retry: BOOLEAN; + VAR interrupted: BOOLEAN) : BOOLEAN; + (* needs only to be provided if select is in caps; + if timelimit isn't in caps then time is guaranteed to + be equal to NIL + *) + TestProc* = PROCEDURE (domain: Domain; condition: Condition; + errors: RelatedEvents.Object) : BOOLEAN; + SendEventProc* = PROCEDURE (domain: Domain; condition: Condition; + event: Events.Event; + errors: RelatedEvents.Object) : BOOLEAN; + (* sendevent needs only to be provided if async is in caps *) + GetTimeProc* = PROCEDURE (domain: Domain; conditionSet: ConditionSet; + VAR nextTime: Times.Time; + VAR nextCond: Condition; + errors: RelatedEvents.Object); + (* needs only to be provided if timecond is in caps *) + PreConditionsProc* = PROCEDURE (domain: Domain; condition: Condition; + VAR preconds: ConditionSet; + errors: RelatedEvents.Object) : BOOLEAN; + (* needs only to be provided if preconditions is in caps *) + + Interface* = POINTER TO InterfaceRec; + InterfaceRec* = + RECORD + (Objects.ObjectRec) + test*: TestProc; + select*: SelectProc; + sendevent*: SendEventProc; + gettime*: GetTimeProc; + preconditions*: PreConditionsProc; + END; + Description = POINTER TO DescriptionRec; + DescriptionRec* = + RECORD + (Objects.ObjectRec) + caps*: CapabilitySet; + internal*: BOOLEAN; (* value does not change during Process.Pause? *) + END; + + TYPE + DomainRec* = + RECORD + (Disciplines.ObjectRec) + if: Interface; + desc: Description; + END; + + TYPE + GetTimeOfNextTryProc* = PROCEDURE (iteration: INTEGER; + VAR time: Times.Time); + (* return a relative time measure *) + VAR + getTimeOfNextTry: GetTimeOfNextTryProc; + + TYPE + WakeupEvent = POINTER TO WakeupEventRec; + WakeupEventRec = + RECORD + (Events.EventRec) + condition: Condition; + END; + VAR + nodelay: Times.Time; + wakeupEventType: Events.EventType; (* used for busy loops only *) + + PROCEDURE WakeupHandler(event: Events.Event); + BEGIN + WITH event: WakeupEvent DO + event.condition.gotEvent := TRUE; + END; + END WakeupHandler; + + PROCEDURE SetGetTimeOfNextTryProc*(p: GetTimeOfNextTryProc); + BEGIN + getTimeOfNextTry := p; + END SetGetTimeOfNextTryProc; + + PROCEDURE GetTimeOfNextTry(iteration: INTEGER; VAR time: Times.Time); + BEGIN + Times.CreateAndSet(time, Times.relative, 0, 1, 0); + iteration := iteration DIV 5; + IF iteration > 8 THEN + iteration := 8; + END; + WHILE iteration > 0 DO + Op.Add2(SYSTEM.VAL(Op.Operand, time), time); + DEC(iteration); + END; + END GetTimeOfNextTry; + + PROCEDURE CreateSet*(VAR conditionSet: ConditionSet); + VAR + i: INTEGER; + cset: ConditionSet; + BEGIN + NEW(cset); + cset.cardinality := 0; + (* + commented out for reasons of efficiency + as NEW delivers 0-initialized areas anyway + + i := 0; + WHILE i < tags DO + conditionSet.bucket[i] := NIL; + INC(i); + END; + *) + cset.next := NIL; cset.i := 0; + conditionSet := cset; + END CreateSet; + + PROCEDURE Incl*(conditionSet: ConditionSet; condition: Condition); + VAR + listp: ConditionList; + new: ConditionList; + i: INTEGER; + BEGIN + (* check if condition is already present in conditionSet *) + i := condition.tag; + listp := conditionSet.bucket[i]; + WHILE (listp # NIL) & (listp.cond # condition) DO + listp := listp.next; + END; + IF listp # NIL THEN (* already in set *) RETURN END; + + NEW(new); new.cond := condition; + new.next := conditionSet.bucket[i]; + conditionSet.bucket[i] := new; + INC(conditionSet.cardinality); + END Incl; + + PROCEDURE Excl*(conditionSet: ConditionSet; condition: Condition); + VAR + prev, listp: ConditionList; + i: INTEGER; + BEGIN + i := condition.tag; + listp := conditionSet.bucket[i]; prev := NIL; + WHILE (listp # NIL) & (listp.cond # condition) DO + prev := listp; listp := listp.next; + END; + IF listp = NIL THEN (* condition not in set *) RETURN END; + + IF prev = NIL THEN + conditionSet.bucket[i] := listp.next; + ELSE + prev.next := listp.next; + END; + DEC(conditionSet.cardinality); + + (* make the iterator more robust *) + IF conditionSet.next = listp THEN + conditionSet.next := listp.next; + END; + END Excl; + + PROCEDURE In*(conditionSet: ConditionSet; condition: Condition) : BOOLEAN; + VAR + listp: ConditionList; + BEGIN + listp := conditionSet.bucket[condition.tag]; + WHILE (listp # NIL) & (listp.cond # condition) DO + listp := listp.next; + END; + RETURN listp # NIL + END In; + + PROCEDURE Union*(result: ConditionSet; set: ConditionSet); + VAR + listp: ConditionList; + newelem, newelems: ConditionList; + count: INTEGER; (* # of added elements in newelems *) + i: INTEGER; + BEGIN + count := 0; + i := 0; + WHILE i < tags DO + listp := set.bucket[i]; + newelems := result.bucket[i]; + IF newelems = NIL THEN + WHILE listp # NIL DO + NEW(newelem); newelem.cond := listp.cond; + newelem.next := newelems; + newelems := newelem; + INC(count); + listp := listp.next; + END; + ELSE + WHILE listp # NIL DO + IF ~In(result, listp.cond) THEN + NEW(newelem); newelem.cond := listp.cond; + newelem.next := newelems; + newelems := newelem; + INC(count); + END; + listp := listp.next; + END; + END; + result.bucket[i] := newelems; + INC(i); + END; + INC(result.cardinality, count); + END Union; + + PROCEDURE Union3*(VAR result: ConditionSet; set1, set2: ConditionSet); + BEGIN + CreateSet(result); Union(result, set1); Union(result, set2); + END Union3; + + PROCEDURE Card*(conditionSet: ConditionSet) : INTEGER; + BEGIN + RETURN conditionSet.cardinality + END Card; + + PROCEDURE ExamineConditions*(conditionSet: ConditionSet); + BEGIN + conditionSet.next := NIL; + conditionSet.i := 0; + END ExamineConditions; + + PROCEDURE GetNextCondition*(conditionSet: ConditionSet; + VAR condition: Condition) : BOOLEAN; + VAR + i: INTEGER; + BEGIN + IF conditionSet.next = NIL THEN + i := conditionSet.i; + WHILE (i < tags) & (conditionSet.bucket[i] = NIL) DO + INC(i); + END; + conditionSet.i := i + 1; + IF i >= tags THEN + RETURN FALSE + END; + conditionSet.next := conditionSet.bucket[i]; + END; + condition := conditionSet.next.cond; + conditionSet.next := conditionSet.next.next; + RETURN TRUE + END GetNextCondition; + + PROCEDURE InitDomain*(domain: Domain; if: Interface; desc: Description); + BEGIN + domain.if := if; + domain.desc := desc; + END InitDomain; + + PROCEDURE Init*(condition: Condition; domain: Domain); + BEGIN + condition.domain := domain; + condition.tag := nextTag; + nextTag := (nextTag + 1) MOD tags; + condition.waitingForEvent := FALSE; + condition.gotEvent := FALSE; + END Init; + + PROCEDURE Test*(condition: Condition; errors: RelatedEvents.Object) : BOOLEAN; + BEGIN + IF condition.waitingForEvent & ~condition.gotEvent THEN + RETURN FALSE + ELSE + RETURN condition.domain.if.test(condition.domain, condition, errors) + END; + END Test; + + PROCEDURE CommonDomain(cset: ConditionSet; + VAR domain: Domain) : BOOLEAN; + VAR + dom: Domain; + i: INTEGER; + listp: ConditionList; + BEGIN + dom := NIL; + i := 0; + WHILE i < tags DO + listp := cset.bucket[i]; + WHILE listp # NIL DO + IF dom = NIL THEN + dom := listp.cond.domain; + ELSIF dom # listp.cond.domain THEN + RETURN FALSE + END; + listp := listp.next; + END; + INC(i); + END; + domain := dom; + RETURN dom # NIL + END CommonDomain; + + PROCEDURE SimpleWaitForAndSelect( + conditionSet: ConditionSet; + VAR setOfTrueConditions: ConditionSet; + errors: RelatedEvents.Object); + (* simple means that we don't need to take care of preconditions *) + TYPE + List = POINTER TO ListRec; + Element = POINTER TO ElementRec; + ListRec = + RECORD + head: Element; + END; + Ring = POINTER TO RingRec; + RingRec = + RECORD + (ListRec) + tail: Element; + END; + ElementRec = + RECORD + next: Element; + domain: Domain; + cset: ConditionSet; + END; + VAR + domain: Domain; + interrupted: BOOLEAN; + ok: BOOLEAN; + + PROCEDURE SortConditions(VAR asyncList, timeList, others: List; + VAR ring: Ring; + VAR otherAreInternal: BOOLEAN); + (* sort conditions into several lists: + + ayncList: list of conditions for which we can setup an event; + after this setup we needn't to take care of them + timeList: list of time conditions (based on system clock) + ring: conditions which support select & timelimit + + otherAreInternal: + is set to TRUE if all other conditions which + are not put into one of the lists above remain + unaffected while pausing + *) + + VAR + listp: ConditionList; + i: INTEGER; + + PROCEDURE CreateList(VAR list: List); + BEGIN + NEW(list); list.head := NIL; + END CreateList; + + PROCEDURE CreateRing(VAR ring: Ring); + BEGIN + NEW(ring); ring.head := NIL; ring.tail := NIL; + END CreateRing; + + PROCEDURE Add(condition: Condition); + VAR + domain: Domain; + + PROCEDURE AddTo(list: List); + VAR + elp: Element; + BEGIN + elp := list.head; + WHILE (elp # NIL) & (elp.domain # domain) DO + elp := elp.next; + END; + IF elp = NIL THEN + NEW(elp); + elp.next := list.head; + elp.domain := condition.domain; + CreateSet(elp.cset); + list.head := elp; + IF list IS Ring THEN + WITH list: Ring DO + IF list.tail = NIL THEN + list.tail := elp; + END; + list.tail.next := list.head; + END; + END; + END; + Incl(elp.cset, condition); + END AddTo; + + BEGIN (* Add *) + domain := condition.domain; + IF timecond IN domain.desc.caps THEN + IF timeList = NIL THEN + CreateList(timeList); + END; + AddTo(timeList); + ELSIF async IN domain.desc.caps THEN + IF asyncList = NIL THEN + CreateList(asyncList); + END; + AddTo(asyncList); + ELSIF (select IN domain.desc.caps) & + (timelimit IN domain.desc.caps) THEN + IF ring = NIL THEN + CreateRing(ring); + END; + AddTo(ring); + ELSE + IF others = NIL THEN + CreateList(others); + END; + AddTo(others); + IF ~domain.desc.internal THEN + otherAreInternal := FALSE; + END; + END; + END Add; + + BEGIN (* SortConditions *) + asyncList := NIL; timeList := NIL; ring := NIL; + otherAreInternal := TRUE; + i := 0; + WHILE i < tags DO + listp := conditionSet.bucket[i]; + WHILE listp # NIL DO + Add(listp.cond); + listp := listp.next; + END; + INC(i); + END; + END SortConditions; + + PROCEDURE SetupEventHandling(condition: Condition; + VAR wakeupEvent: WakeupEvent); + VAR + wakeup: Events.EventType; + priority: Priorities.Priority; + BEGIN + Events.Define(wakeup); + priority := Events.GetPriority() + 1; + IF priority < Priorities.interrupts + 1 THEN + priority := Priorities.interrupts + 1; + END; + Events.SetPriority(wakeup, priority); + Events.Handler(wakeup, WakeupHandler); + NEW(wakeupEvent); wakeupEvent.type := wakeup; + wakeupEvent.condition := condition; + condition.waitingForEvent := TRUE; + condition.gotEvent := FALSE; + END SetupEventHandling; + + PROCEDURE SetupAsyncEvents(list: List) : BOOLEAN; + VAR + elp: Element; + listp: ConditionList; i: INTEGER; + wakeupEvent: WakeupEvent; + sendevent: SendEventProc; + anythingTrue: BOOLEAN; + BEGIN + anythingTrue := FALSE; + elp := list.head; + WHILE elp # NIL DO + sendevent := elp.domain.if.sendevent; + i := 0; + WHILE i < tags DO + listp := elp.cset.bucket[i]; + WHILE listp # NIL DO + IF ~listp.cond.waitingForEvent OR listp.cond.gotEvent THEN + SetupEventHandling(listp.cond, wakeupEvent); + IF ~sendevent(elp.domain, listp.cond, + wakeupEvent, errors) THEN + IF ~anythingTrue THEN + CreateSet(setOfTrueConditions); + END; + Incl(setOfTrueConditions, listp.cond); + listp.cond.waitingForEvent := FALSE; + anythingTrue := TRUE; + END; + END; + listp := listp.next; + END; + INC(i); + END; + elp := elp.next; + END; + RETURN ~anythingTrue + END SetupAsyncEvents; + + PROCEDURE Block; + (* block until one of the conditions becomes TRUE *) + VAR + asyncList: List; (* list of domains which supports async events *) + timeList: List; (* list of domains which supports timecond *) + ring: Ring; (* ring of domains which support select+timelimit *) + largeRing: BOOLEAN; (* >=2 ring members *) + ringMember: Element; (* current ring member *) + others: List; (* those which are not member of the other lists *) + otherAreInternal: BOOLEAN; + waitErrors: RelatedEvents.Object; + queue: RelatedEvents.Queue; (* queue of waitErrors *) + busyLoop: BOOLEAN; (* TRUE if we have to resort to a busy loop *) + wakeupEvent: Events.Event; (* iteration event for busy loops *) + loopCnt: INTEGER; (* number of iterations *) + nextTime: Times.Time; + minTime: Times.Time; + minTimeCond: Condition; + interrupted: BOOLEAN; (* interrupted select? *) + highPriority: BOOLEAN; (* priority >= Priorities.interrupt? *) + + PROCEDURE FixToRelTime(VAR time: Times.Time); + VAR + currentTime: Times.Time; + relTime: Times.Time; + BEGIN + Clocks.GetTime(Clocks.system, currentTime); + Op.Sub3(SYSTEM.VAL(Op.Operand, relTime), time, currentTime); + time := relTime; + END FixToRelTime; + + PROCEDURE GetMinTime(VAR nextTime: Times.Time; + VAR minCond: Condition); + VAR + elp: Element; + time: Times.Time; + condition: Condition; + + BEGIN (* GetMinTime *) + nextTime := NIL; minCond := NIL; + IF timeList # NIL THEN + elp := timeList.head; + WHILE elp # NIL DO + elp.domain.if.gettime(domain, elp.cset, + time, condition, waitErrors); + IF Scales.IsAbsolute(time) THEN + FixToRelTime(time); + END; + IF (nextTime = NIL) OR (Op.Compare(time, nextTime) < 0) THEN + nextTime := time; minCond := condition; + END; + elp := elp.next; + END; + END; + END GetMinTime; + + PROCEDURE UpdateMinTime(VAR nextTime: Times.Time; + VAR minCond: Condition); + VAR + set: ConditionSet; + time: Times.Time; + cond: Condition; + BEGIN + IF minCond = NIL THEN + nextTime := NIL; + ELSE + CreateSet(set); + Incl(set, minCond); + minCond.domain.if.gettime(minCond.domain, set, + time, cond, waitErrors); + IF Scales.IsAbsolute(time) THEN + FixToRelTime(time); + END; + nextTime := time; + END; + END UpdateMinTime; + + PROCEDURE TestNonRingMembers() : BOOLEAN; + + PROCEDURE TestList(list: List) : BOOLEAN; + VAR + domain: Domain; + element: Element; + selected: ConditionSet; + interrupted: BOOLEAN; + + PROCEDURE TestAndSelect(conditionSet: ConditionSet; + VAR setOfTrueConditions: ConditionSet; + errors: RelatedEvents.Object) : BOOLEAN; + VAR + listp: ConditionList; i: INTEGER; + condition: Condition; + anythingTrue: BOOLEAN; + BEGIN (* TestAndSelect *) + anythingTrue := FALSE; + CreateSet(setOfTrueConditions); + i := 0; + WHILE i < tags DO + listp := conditionSet.bucket[i]; + WHILE listp # NIL DO + condition := listp.cond; + IF domain.if.test(domain, condition, errors) THEN + Incl(setOfTrueConditions, condition); + anythingTrue := TRUE; + END; + listp := listp.next; + END; + INC(i); + END; + RETURN anythingTrue + END TestAndSelect; + + BEGIN (* TestList *) + IF list = NIL THEN RETURN FALSE END; + element := list.head; + WHILE element # NIL DO + domain := element.domain; + IF (select IN domain.desc.caps) & + (timelimit IN domain.desc.caps) THEN + IF domain.if.select(domain, element.cset, nodelay, + selected, waitErrors, FALSE, interrupted) THEN + ASSERT(Card(selected) > 0); + Union(setOfTrueConditions, selected); + RETURN TRUE + END; + ELSE + IF TestAndSelect(element.cset, selected, waitErrors) THEN + Union(setOfTrueConditions, selected); + RETURN TRUE + END; + END; + element := element.next; + END; + RETURN FALSE + END TestList; + + PROCEDURE TestAsyncList(list: List) : BOOLEAN; + VAR + element: Element; + listp: ConditionList; i: INTEGER; + condition: Condition; + anythingFound: BOOLEAN; + BEGIN + IF list = NIL THEN RETURN FALSE END; + anythingFound := FALSE; + element := list.head; + WHILE element # NIL DO + i := 0; + WHILE i < tags DO + listp := element.cset.bucket[i]; + WHILE listp # NIL DO + condition := listp.cond; + IF condition.gotEvent THEN + Incl(setOfTrueConditions, condition); + anythingFound := TRUE; + END; + listp := listp.next; + END; + INC(i); + END; + element := element.next; + END; + RETURN anythingFound + END TestAsyncList; + + BEGIN (* TestNonRingMembers *) + CreateSet(setOfTrueConditions); + RETURN TestAsyncList(asyncList) OR TestList(others) + END TestNonRingMembers; + + BEGIN (* Block *) + NEW(waitErrors); RelatedEvents.QueueEvents(waitErrors); + SortConditions(asyncList, timeList, others, ring, otherAreInternal); + IF asyncList # NIL THEN + (* set up asynchronous events for these conditions -- + this should be done before the first call of + TestNonRingMembers() to avoid redundant test calls + *) + IF ~SetupAsyncEvents(asyncList) THEN + (* one of them happened to be TRUE now *) + RETURN + END; + END; + IF TestNonRingMembers() THEN + RETURN + END; + (* check for deadlock *) + ASSERT((asyncList # NIL) OR (timeList # NIL) OR (ring # NIL) OR + ~otherAreInternal); + highPriority := Events.GetPriority() >= Priorities.interrupts; + IF ring # NIL THEN + ringMember := ring.head; + largeRing := ring.head # ring.head.next; + ELSE + ringMember := NIL; largeRing := FALSE; + END; + GetMinTime(minTime, minTimeCond); + busyLoop := largeRing OR ~otherAreInternal OR (asyncList # NIL); + + loopCnt := 0; + LOOP (* until one of the conditions becomes TRUE *) + (* determine timelimit parameter for select *) + IF busyLoop THEN + getTimeOfNextTry(loopCnt + 1, nextTime); + ASSERT(Op.Compare(nextTime, nodelay) > 0); + IF timeList # NIL THEN + IF Op.Compare(minTime, nextTime) < 0 THEN + nextTime := minTime; + END; + END; + ELSIF timeList # NIL THEN + nextTime := minTime; + ELSE + nextTime := NIL; minTime := NIL; minTimeCond := NIL; + END; + + IF (minTime # NIL) & (Op.Compare(minTime, nodelay) <= 0) THEN + CreateSet(setOfTrueConditions); + Incl(setOfTrueConditions, minTimeCond); + EXIT + END; + + IF ringMember = NIL THEN + ASSERT(~highPriority); + IF nextTime # NIL THEN + NEW(wakeupEvent); + wakeupEvent.type := wakeupEventType; + Events.SetPriority(wakeupEventType, Events.GetPriority() + 1); + Timers.Schedule(Clocks.system, nextTime, wakeupEvent); + END; + Process.Pause; + ELSE + IF ringMember.domain.if.select + (ringMember.domain, ringMember.cset, nextTime, + setOfTrueConditions, waitErrors, + (* retry = *) FALSE, interrupted) THEN + ASSERT(Card(setOfTrueConditions) > 0); + EXIT + END; + (* timelimit exceeded or interrupted *) + ASSERT(interrupted OR (nextTime # NIL)); + IF interrupted THEN + (* remove error event *) + RelatedEvents.GetQueue(waitErrors, queue); + ELSIF (minTimeCond # NIL) & ~busyLoop THEN + (* timelimit exceeded: minTimeCond is now TRUE *) + CreateSet(setOfTrueConditions); + Incl(setOfTrueConditions, minTimeCond); + EXIT + END; + END; + IF TestNonRingMembers() THEN + EXIT + END; + IF timeList # NIL THEN + UpdateMinTime(minTime, minTimeCond); + END; + INC(loopCnt); + END; + (* forward error events to error parameter of SimpleWaitForAndSelect *) + RelatedEvents.GetQueue(waitErrors, queue); + RelatedEvents.AppendQueue(errors, queue); + END Block; + + BEGIN (* SimpleWaitForAndSelect *) + IF CommonDomain(conditionSet, domain) & + (select IN domain.desc.caps) THEN + ok := domain.if.select + (domain, conditionSet, NIL, setOfTrueConditions, + errors, (* retry = *) TRUE, interrupted); + (* a return value of FALSE is only to be expected + if a time limit is given or if retry = FALSE + *) + ASSERT(ok); + ELSE + Block; + END; + END SimpleWaitForAndSelect; + + PROCEDURE WaitFor*(conditionSet: ConditionSet; + VAR setOfTrueConditions: ConditionSet; + errors: RelatedEvents.Object); + VAR + listp: ConditionList; i: INTEGER; + testSet: ConditionSet; + preconds: ConditionSet; + domain: Domain; + selected: ConditionSet; + anyPreconditions: BOOLEAN; + + PROCEDURE PretestClosure(testSet, preconds: ConditionSet); + VAR + listp: ConditionList; i: INTEGER; + domain: Domain; + morePreconditions: ConditionSet; + evenMorePreconditions: ConditionSet; + BEGIN + REPEAT + CreateSet(morePreconditions); + i := 0; + WHILE i < tags DO + listp := preconds.bucket[i]; + WHILE listp # NIL DO + domain := listp.cond.domain; + IF (preconditions IN domain.desc.caps) & + domain.if.preconditions(domain, listp.cond, + evenMorePreconditions, errors) & + (evenMorePreconditions # NIL) & + (Card(evenMorePreconditions) > 0) THEN + Union(morePreconditions, evenMorePreconditions); + ELSE + Incl(testSet, listp.cond); + END; + listp := listp.next; + END; + INC(i); + END; + preconds := morePreconditions; + UNTIL Card(preconds) = 0 + END PretestClosure; + + BEGIN (* WaitFor *) + ASSERT(conditionSet.cardinality > 0); + LOOP + CreateSet(testSet); + anyPreconditions := FALSE; + i := 0; + WHILE i < tags DO + listp := conditionSet.bucket[i]; + WHILE listp # NIL DO + domain := listp.cond.domain; + IF (preconditions IN domain.desc.caps) & + domain.if.preconditions(domain, + listp.cond, preconds, errors) & + (preconds # NIL) & (Card(preconds) > 0) THEN + PretestClosure(testSet, preconds); + anyPreconditions := TRUE; + ELSE + Incl(testSet, listp.cond); + END; + listp := listp.next; + END; + INC(i); + END; + + SimpleWaitForAndSelect(testSet, selected, errors); + IF ~anyPreconditions THEN + setOfTrueConditions := selected; + EXIT + END; + i := 0; + WHILE i < tags DO + listp := selected.bucket[i]; + WHILE listp # NIL DO + IF ~In(conditionSet, listp.cond) THEN + Excl(selected, listp.cond); + END; + listp := listp.next; + END; + INC(i); + END; + IF Card(selected) > 0 THEN + setOfTrueConditions := selected; + EXIT + END; + END; + ASSERT(Card(setOfTrueConditions) > 0); + END WaitFor; + +BEGIN + SetGetTimeOfNextTryProc(GetTimeOfNextTry); + Times.CreateAndSet(nodelay, Times.relative, 0, 0, 0); + nextTag := 0; + Events.Define(wakeupEventType); + Events.Handler(wakeupEventType, Events.NilHandler); +END ulmConditions. diff --git a/src/lib/ulm/ulmRelatedEvents.Mod b/src/lib/ulm/ulmRelatedEvents.Mod index c470312a..6f9a0c32 100644 --- a/src/lib/ulm/ulmRelatedEvents.Mod +++ b/src/lib/ulm/ulmRelatedEvents.Mod @@ -80,7 +80,7 @@ MODULE ulmRelatedEvents; object*: Object; event*: Events.Event; END; - Queue = POINTER TO QueueRec; + Queue* = POINTER TO QueueRec; QueueRec* = RECORD (Objects.ObjectRec)