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

ported TimeConditions, Conditions fixed

Browse source
This commit is contained in:
Norayr Chilingarian 2013-11-04 16:07:40 +04:00
parent 4c7126816b
commit c9646a0f9f
3 changed files with 408 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

1
makefile
View file

@ -202,6 +202,7 @@ stage6:
$(VOCSTATIC) -sP ulmTimers.Mod
$(VOCSTATIC) -sP ulmConditions.Mod
$(VOCSTATIC) -sP ulmStreamConditions.Mod
$(VOCSTATIC) -sP ulmTimeConditions.Mod
#pow32 libs

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

@ -91,7 +91,7 @@ MODULE ulmConditions;
END;
BucketTable = ARRAY tags OF ConditionList;
ConditionSet = POINTER TO ConditionSetRec;
ConditionSet* = POINTER TO ConditionSetRec;
ConditionSetRec* =
RECORD
(Objects.ObjectRec)

406
src/lib/ulm/ulmTimeConditions.Mod Normal file
View file

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