1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
implementation module timerevent
import StdBool, StdClass
import deviceevents, timeraccess
from commondef import fatalError, ucontains, :: UCond
from iostate import :: PSt{..}, :: IOSt, ioStHasDevice, ioStGetDevice, ioStSetDevice, ioStGetIOId
from StdPSt import accPIO
timereventFatalError :: String String -> .x
timereventFatalError function error
= fatalError function "timerevent" error
/* The timerEvent function determines whether the given SchedulerEvent can be applied
to a timer of this process. These are the following cases:
* ScheduleTimerEvent: the timer event belongs to this process and device
* ScheduleMsgEvent: the message event belongs to this process and device
timerEvent assumes that it is not applied to an empty IOSt.
*/
timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
timerEvent schedulerEvent pState
# (hasDevice,pState) = accPIO (ioStHasDevice TimerDevice) pState
| not hasDevice // This condition should never occur: TimerDevice must have been 'installed'
= timereventFatalError "TimerFunctions.dEvent" "could not retrieve TimerSystemState from IOSt"
| otherwise
= timerEvent schedulerEvent pState
where
timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
timerEvent schedulerEvent=:(ScheduleTimerEvent te=:{teLoc}) pState=:{io=ioState}
# (ioid,ioState) = ioStGetIOId ioState
| teLoc.tlIOId<>ioid || teLoc.tlDevice<>TimerDevice
= (False,Nothing,schedulerEvent,{pState & io=ioState})
# (_,timer,ioState) = ioStGetDevice TimerDevice ioState
# timers = timerSystemStateGetTimerHandles timer
(found,timers) = lookForTimer teLoc.tlParentId timers
# ioState = ioStSetDevice (TimerSystemState timers) ioState
# pState = {pState & io=ioState}
| found
#! deviceEvent = TimerEvent te
= (True,Just deviceEvent,schedulerEvent,pState)
| otherwise
= (False,Nothing,schedulerEvent,pState)
where
lookForTimer :: !Id !(TimerHandles .pst) -> (!Bool,!TimerHandles .pst)
lookForTimer parent timers=:{tTimers=tHs}
# (found,tHs) = ucontains (identifyTimerStateHandle parent) tHs
= (found,{timers & tTimers=tHs})
timerEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState
# (ioid,pState) = accPIO ioStGetIOId pState
recloc = case msgEvent of
(QASyncMessage {qasmRecLoc}) -> qasmRecLoc
(ASyncMessage { asmRecLoc}) -> asmRecLoc
(SyncMessage { smRecLoc}) -> smRecLoc
| ioid==recloc.rlIOId && TimerDevice==recloc.rlDevice
= (True,Just (ReceiverEvent msgEvent),schedulerEvent,pState)
| otherwise
= (False,Nothing,schedulerEvent,pState)
timerEvent schedulerEvent pState
= (False,Nothing,schedulerEvent,pState)
|
