diff options
| author | Camil Staps | 2015-07-01 17:36:37 +0200 |
|---|---|---|
| committer | Camil Staps | 2015-07-01 17:36:37 +0200 |
| commit | 7553b7f9d4dddc2235c137d41de8ce22547bebe3 (patch) | |
| tree | 34f8fb4b36640317d728a60586424f67f9befbe7 /timerevent.icl | |
| parent | gitignore (diff) | |
Initial commit
Diffstat (limited to 'timerevent.icl')
| -rw-r--r-- | timerevent.icl | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/timerevent.icl b/timerevent.icl new file mode 100644 index 0000000..8c70e62 --- /dev/null +++ b/timerevent.icl @@ -0,0 +1,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)
|