From 7553b7f9d4dddc2235c137d41de8ce22547bebe3 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 1 Jul 2015 17:36:37 +0200
Subject: Initial commit

---
 timerevent.icl | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 timerevent.icl

(limited to 'timerevent.icl')

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)
-- 
cgit v1.2.3