mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 18:02:25 +00:00
ulmConditions ported, ulmRelatedEvents fixed
Former-commit-id: 81e897f416
This commit is contained in:
Norayr Chilingarian
parent
f809c94a9d
commit
8664f0d400
3 changed files with 969 additions and 1 deletions
967
src/lib/ulm/ulmConditions.Mod
Normal file
967
src/lib/ulm/ulmConditions.Mod
Normal 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.
|
||||
|
|
@ -80,7 +80,7 @@ MODULE ulmRelatedEvents;
|
|||
object*: Object;
|
||||
event*: Events.Event;
|
||||
END;
|
||||
Queue = POINTER TO QueueRec;
|
||||
Queue* = POINTER TO QueueRec;
|
||||
QueueRec* =
|
||||
RECORD
|
||||
(Objects.ObjectRec)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue