timerevent.icl 2.7 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
implementation module timerevent


//	Clean Object I/O library, version 1.2


import	StdBool, StdClass
import	deviceevents, timeraccess
9
10
from	commondef	import FatalError, UContains, UCond
from	iostate		import PSt, IOSt, IOStHasDevice, IOStGetDevice, IOStSetDevice, IOStGetIOId
Peter Achten's avatar
Peter Achten committed
11
12
13
from	StdPSt		import accPIO


14
15
16
17
18
timereventFatalError :: String String -> .x
timereventFatalError function error
	= FatalError function "timerevent" error


Peter Achten's avatar
Peter Achten committed
19
20
21
22
23
24
/*	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.
*/
25
timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
26
27
28
29
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"
Peter Achten's avatar
Peter Achten committed
30
	| otherwise
31
		= timerEvent schedulerEvent pState
Peter Achten's avatar
Peter Achten committed
32
where
33
	timerEvent :: !SchedulerEvent !(PSt .l) -> (!Bool,!Maybe DeviceEvent,!SchedulerEvent,!PSt .l)
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
64
65
	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
Peter Achten's avatar
Peter Achten committed
66
		= (False,Nothing,schedulerEvent,pState)