vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 19:12:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

ulmConditions ported, ulmRelatedEvents fixed

Browse source
This commit is contained in:
Norayr Chilingarian 2013-11-04 15:12:20 +04:00
parent 418da2a304
commit 81e897f416
3 changed files with 969 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

1
makefile
View file

@ -200,6 +200,7 @@ stage6:
$(VOCSTATIC) -sP ulmTimes.Mod $(VOCSTATIC) -sP ulmTimes.Mod
$(VOCSTATIC) -sP ulmClocks.Mod $(VOCSTATIC) -sP ulmClocks.Mod
$(VOCSTATIC) -sP ulmTimers.Mod $(VOCSTATIC) -sP ulmTimers.Mod
#$(VOCSTATIC) -sP ulmConditions.Mod
#pow32 libs #pow32 libs

967
src/lib/ulm/ulmConditions.Mod Normal file
View file

@ -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.

2
src/lib/ulm/ulmRelatedEvents.Mod
View file

@ -80,7 +80,7 @@ MODULE ulmRelatedEvents;
object*: Object; object*: Object;
event*: Events.Event; event*: Events.Event;
END; END;
Queue = POINTER TO QueueRec; Queue* = POINTER TO QueueRec;
QueueRec* = QueueRec* =
RECORD RECORD
(Objects.ObjectRec) (Objects.ObjectRec)