Commit 05711b8d authored by Peter Achten's avatar Peter Achten
Browse files

(PA) Improved performance of zero timers.

parent 87693c9d
...@@ -224,6 +224,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */ ...@@ -224,6 +224,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
/// ///
CcWmINETEVENT :== 140 /* MW11 */ CcWmINETEVENT :== 140 /* MW11 */
CcWmZEROTIMER :== 136 /* PA: new constant for sequence of zero timer events (generated only by Clean). */
CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */ CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */
CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */ CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */
CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */ CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */
......
...@@ -373,6 +373,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */ ...@@ -373,6 +373,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
/// ///
CcWmINETEVENT :== 140 /* MW11 */ CcWmINETEVENT :== 140 /* MW11 */
CcWmZEROTIMER :== 136 /* PA: new constant for sequence of zero timer events (generated only by Clean). */
CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */ CcWmLOSTKEY :== 135 /* PA: new constant for loosing keyboard input (generated only by Clean). */
CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */ CcWmLOSTMOUSE :== 134 /* PA: new constant for loosing mouse input (generated only by Clean). */
CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */ CcWmSPECIALBUTTON :== 133 /* PA: new constant for info about OK/CANCEL button selected. */
......
...@@ -5,14 +5,19 @@ definition module osevent ...@@ -5,14 +5,19 @@ definition module osevent
from StdInt import ^,- from StdInt import ^,-
from clCrossCall_12 import CrossCallInfo from clCrossCall_12 import CrossCallInfo
from ostoolbox import OSToolbox from ostoolbox import OSToolbox
from ostime import OSTime // PA: new
from ostypes import OSWindowPtr from ostypes import OSWindowPtr
from StdMaybe import Maybe, Just, Nothing
:: *OSEvents :: *OSEvents
OSnewEvents :: OSEvents OSnewEvents :: OSEvents
OScopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
OSappendEvents :: !*[OSEvent] !OSEvents -> OSEvents // OSappendEvents adds events at the end of the queue OSappendEvents :: !*[OSEvent] !OSEvents -> OSEvents // OSappendEvents adds events at the end of the queue
OSinsertEvents :: !*[OSEvent] !OSEvents -> OSEvents // OSinsertEvents adds events at the front of the queue OSinsertEvents :: !*[OSEvent] !OSEvents -> OSEvents // OSinsertEvents adds events at the front of the queue
OSisEmptyEvents :: !OSEvents -> (!Bool,!OSEvents)
OSremoveEvent :: !OSEvents -> (!OSEvent,!OSEvents)
:: OSEvent :: OSEvent
...@@ -31,14 +36,20 @@ OShandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) -> ...@@ -31,14 +36,20 @@ OShandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) ->
OSEventIsUrgent :: !OSEvent -> Bool OSEventIsUrgent :: !OSEvent -> Bool
setReplyInOSEvent :: ![Int] -> CrossCallInfo setReplyInOSEvent :: ![Int] -> CrossCallInfo
/* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */ /* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
/* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */ /* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
/* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */ /* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
getOSZeroTimerStartTime returns the registered time in the virtual event. Nothing is returned if wrong argument.
*/
createOSZeroTimerEvent :: !OSTime -> OSEvent // PA: new
getOSZeroTimerStartTime :: !OSEvent -> Maybe OSTime // PA: new
...@@ -3,8 +3,9 @@ implementation module osevent ...@@ -3,8 +3,9 @@ implementation module osevent
// Clean Object I/O library, version 1.2 // Clean Object I/O library, version 1.2
import StdBool, StdList, StdMisc, StdTuple import StdBool, StdList, StdMisc, StdTuple
import clCrossCall_12, ostoolbox, ostypes import clCrossCall_12, ostime, ostoolbox, ostypes
from commondef import HdTl, FatalError from commondef import HdTl, FatalError
from StdMaybe import Maybe, Just, Nothing
//import StdDebug, tracetypes //import StdDebug, tracetypes
...@@ -39,6 +40,14 @@ OSremoveEvent [osEvent:osEvents] ...@@ -39,6 +40,14 @@ OSremoveEvent [osEvent:osEvents]
OSremoveEvent [] OSremoveEvent []
= oseventFatalError "OSremoveEvent" "OSEvents argument is empty" = oseventFatalError "OSremoveEvent" "OSEvents argument is empty"
OScopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
OScopyEvents []
= ([],[])
OScopyEvents [e:es]
= ([e:es1],[e:es2])
where
(es1,es2) = OScopyEvents es
OSnewEvents :: OSEvents OSnewEvents :: OSEvents
OSnewEvents = [] OSnewEvents = []
...@@ -81,13 +90,13 @@ OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent ( ...@@ -81,13 +90,13 @@ OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (
with with
rccitoevent :: !(OSEvent -> .s -> ([Int],.s)) !OSEvent !.s !*OSToolbox -> (!OSEvent,!.s,!*OSToolbox) rccitoevent :: !(OSEvent -> .s -> ([Int],.s)) !OSEvent !.s !*OSToolbox -> (!OSEvent,!.s,!*OSToolbox)
rccitoevent handleOSEvent osEvent=:{ccMsg} state tb rccitoevent handleOSEvent osEvent=:{ccMsg} state tb
// # (reply,state) = handleOSEvent (trace_n ("CcRqDOMESSAGE-->"+++toString osEvent) osEvent) state // # (reply,state) = handleOSEvent (trace_n ("CcRqDOMESSAGE-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
# (reply,state) = handleOSEvent osEvent state # (reply,state) = handleOSEvent osEvent state
= (setReplyInOSEvent reply,state,tb) = (setReplyInOSEvent reply,state,tb)
| otherwise | otherwise
# (osEvent,osEvents) = OSremoveEvent osEvents # (osEvent,osEvents) = OSremoveEvent osEvents
# state = setOSEvents (osEvents,state) # state = setOSEvents (osEvents,state)
// # (_,state) = handleOSEvent (trace_n ("DelayedEvent-->"+++toString osEvent) osEvent) state // # (_,state) = handleOSEvent (trace_n ("DelayedEvent-->"+++toCleanCrossCallInfoString osEvent) osEvent) state
# (_,state) = handleOSEvent osEvent state # (_,state) = handleOSEvent osEvent state
= OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb) = OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
...@@ -114,26 +123,40 @@ OSEventIsUrgent {ccMsg} ...@@ -114,26 +123,40 @@ OSEventIsUrgent {ccMsg}
CcWmDRAWCLIPBOARD -> False // PA: in a future version, use this event to evaluate a clipboard callback function. CcWmDRAWCLIPBOARD -> False // PA: in a future version, use this event to evaluate a clipboard callback function.
CcWmIDLETIMER -> False CcWmIDLETIMER -> False
CcWmTIMER -> False CcWmTIMER -> False
CcWmZEROTIMER -> False
_ -> True _ -> True
/* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */ /* createOS(Dea/A)ctivateWindowEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSActivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSActivateWindowEvent wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb) createOSActivateWindowEvent wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb)
createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateWindowEvent wPtr tb = (Rq1Cci CcWmDEACTIVATE wPtr,tb) createOSDeactivateWindowEvent wPtr tb = (Rq1Cci CcWmDEACTIVATE wPtr,tb)
/* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */ /* createOS(Dea/A)ctivateControlEvent creates the event the platform would generate for a genuine (de)activate event. */
createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSActivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSActivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmSETFOCUS wPtr cPtr,tb) createOSActivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmSETFOCUS wPtr cPtr,tb)
createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSDeactivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmKILLFOCUS wPtr cPtr,tb) createOSDeactivateControlEvent wPtr cPtr tb = (Rq2Cci CcWmKILLFOCUS wPtr cPtr,tb)
/* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */ /* createOSLoose(Mouse/Key)Event creates the event for reporting loss of mouse/keyboard input (virtual event). */
createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSLooseMouseEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSLooseMouseEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTMOUSE wPtr cPtr,tb) createOSLooseMouseEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTMOUSE wPtr cPtr,tb)
createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox) createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
createOSLooseKeyEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTKEY wPtr cPtr,tb) createOSLooseKeyEvent wPtr cPtr tb = (Rq2Cci CcWmLOSTKEY wPtr cPtr,tb)
/* createOSZeroTimerEvent creates the event for reporting continued zero timer (virtual event).
getOSZeroTimerStartTime returns the registered time in the virtual event. Zero if wrong argument.
*/
createOSZeroTimerEvent :: !OSTime -> OSEvent
createOSZeroTimerEvent zeroStart = Rq1Cci CcWmZEROTIMER (toInt zeroStart)
getOSZeroTimerStartTime :: !OSEvent -> Maybe OSTime
getOSZeroTimerStartTime {ccMsg,p1}
| ccMsg==CcWmZEROTIMER
= Just (fromInt p1)
| otherwise
= Nothing
...@@ -25,5 +25,6 @@ OSGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox) ...@@ -25,5 +25,6 @@ OSGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
// OSGetCurrentTime returns current (year,month,day,day_of_week). // OSGetCurrentTime returns current (year,month,day,day_of_week).
instance - OSTime // Calculate difference between arg 1 and arg 2 instance - OSTime // Calculate difference between arg 1 and arg 2
instance < OSTime // True iff arg 1 < arg 2
instance toInt OSTime // Coerce OSTime to Integer (always positive or zero) instance toInt OSTime // Coerce OSTime to Integer (always positive or zero)
instance fromInt OSTime // Coerce Int to OSTime (Integer will be made zero if negative) instance fromInt OSTime // Coerce Int to OSTime (Integer will be made zero if negative)
...@@ -44,6 +44,11 @@ instance - OSTime where ...@@ -44,6 +44,11 @@ instance - OSTime where
= OSTime (new-old) = OSTime (new-old)
= OSTime (OSMaxTickCount-old+new) = OSTime (OSMaxTickCount-old+new)
instance < OSTime where
(<) :: !OSTime !OSTime -> Bool
(<) (OSTime t1) (OSTime t2)
= t1<t2
instance toInt OSTime where instance toInt OSTime where
toInt :: !OSTime -> Int toInt :: !OSTime -> Int
toInt (OSTime t) = t toInt (OSTime t) = t
......
...@@ -6,7 +6,7 @@ definition module oswindow ...@@ -6,7 +6,7 @@ definition module oswindow
import StdMaybe, StdOverloaded, StdString import StdMaybe, StdOverloaded, StdString
from osdocumentinterface import OSDInfo, OSMDInfo, OSSDInfo, OSInfo, OSToolbar, OSToolbarHandle, HMENU, HWND from osdocumentinterface import OSDInfo, OSMDInfo, OSSDInfo, OSInfo, OSToolbar, OSToolbarHandle, HMENU, HWND
from osevent import OSEvent, CrossCallInfo from osevent import OSEvents, OSEvent, CrossCallInfo
from osfont import Font from osfont import Font
from osrgn import OSRgnHandle from osrgn import OSRgnHandle
from ossystem import OSWindowMetrics from ossystem import OSWindowMetrics
...@@ -122,9 +122,11 @@ OScreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!I ...@@ -122,9 +122,11 @@ OScreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!I
!(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox))) !(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
!OSDInfo !OSWindowPtr !u:s !*OSToolbox !OSDInfo !OSWindowPtr !u:s !*OSToolbox
-> (![DelayActivationInfo],!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!OSDInfo,!u:s,!*OSToolbox) -> (![DelayActivationInfo],!OSWindowPtr,!OSWindowPtr,!OSWindowPtr,!OSDInfo,!u:s,!*OSToolbox)
OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(OSEvent -> u:s -> *([Int],u:s)) !u:s !*OSToolbox OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(u:s -> (OSEvents,u:s))
-> (!Bool,!u:s,!*OSToolbox) !((OSEvents,u:s)-> u:s)
!(OSEvent -> u:s -> *([Int],u:s))
!u:s !*OSToolbox
-> (!Bool,!u:s,!*OSToolbox)
// Mike // // Mike //
OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox) OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox)
......
...@@ -306,12 +306,13 @@ OScreateWindowCallback _ _ _ _ _ {ccMsg} s tb ...@@ -306,12 +306,13 @@ OScreateWindowCallback _ _ _ _ _ {ccMsg} s tb
/* PA: new function that creates modal dialog and handles events until termination. /* PA: new function that creates modal dialog and handles events until termination.
The Bool result is True iff no error occurred. The Bool result is True iff no error occurred.
*/ */
OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(OSEvent -> u:s -> *([Int],u:s)) !u:s !*OSToolbox OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(u:s -> (OSEvents,u:s)) !((OSEvents,u:s)-> u:s) !(OSEvent -> u:s -> *([Int],u:s))
-> (!Bool,!u:s,!*OSToolbox) !u:s !*OSToolbox
OScreateModalDialog isClosable title osdinfo currentActiveModal handleOSEvents s tb -> (!Bool,!u:s,!*OSToolbox)
OScreateModalDialog isClosable title osdinfo currentActiveModal getOSEvents setOSEvents handleOSEvents s tb
# (textPtr,tb) = WinMakeCString title tb # (textPtr,tb) = WinMakeCString title tb
createcci = Rq2Cci CcRqCREATEMODALDIALOG textPtr parentptr createcci = Rq2Cci CcRqCREATEMODALDIALOG textPtr parentptr
# (returncci,s,tb) = IssueCleanRequest (OScreateModalDialogCallback handleOSEvents) createcci s tb # (returncci,s,tb) = IssueCleanRequest (OScreateModalDialogCallback getOSEvents setOSEvents handleOSEvents) createcci s tb
# tb = WinReleaseCString textPtr tb # tb = WinReleaseCString textPtr tb
ok = case returncci.ccMsg of ok = case returncci.ccMsg of
CcRETURN1 -> returncci.p1==0 CcRETURN1 -> returncci.p1==0
...@@ -326,11 +327,19 @@ where ...@@ -326,11 +327,19 @@ where
) )
(fromJust currentActiveModal) (fromJust currentActiveModal)
OScreateModalDialogCallback :: !(OSEvent -> u:s -> *([Int],u:s)) !CrossCallInfo !u:s !*OSToolbox -> (!CrossCallInfo,!u:s,!*OSToolbox) OScreateModalDialogCallback :: !(u:s -> (OSEvents,u:s)) !((OSEvents,u:s)-> u:s) !(OSEvent -> u:s -> *([Int],u:s))
OScreateModalDialogCallback handleOSEvents osEvent s tb !CrossCallInfo !u:s !*OSToolbox
// # (replyToOS,s) = handleOSEvents (if (osEvent.ccMsg==CcWmIDLETIMER) osEvent (trace_n ("OScreateModalDialogCallback-->"+++toString osEvent) osEvent)) s -> (!CrossCallInfo,!u:s,!*OSToolbox)
# (replyToOS,s) = handleOSEvents osEvent s OScreateModalDialogCallback getOSEvents setOSEvents handleOSEvents osEvent s tb
= (setReplyInOSEvent replyToOS,s,tb) # (replyToOS,s) = handleOSEvents osEvent s
# (osEvents, s) = getOSEvents s
# (noDelayEvents,osEvents) = OSisEmptyEvents osEvents
| noDelayEvents
= (setReplyInOSEvent replyToOS,setOSEvents (osEvents,s),tb)
| otherwise
# (osEvent,osEvents) = OSremoveEvent osEvents
# s = setOSEvents (osEvents,s)
= OScreateModalDialogCallback getOSEvents setOSEvents handleOSEvents osEvent s tb
// Mike // // Mike //
OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox) OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox)
......
...@@ -8,7 +8,7 @@ import StdBool, StdFunc, StdList, StdMisc ...@@ -8,7 +8,7 @@ import StdBool, StdFunc, StdList, StdMisc
import commondef, devicefunctions, devicesystemstate, processstack, receivertable, timertable import commondef, devicefunctions, devicesystemstate, processstack, receivertable, timertable
import osdocumentinterface, ostime import osdocumentinterface, ostime
from osactivaterequests import OSActivateRequest from osactivaterequests import OSActivateRequest
from osevent import OSEvents, OSnewEvents from osevent import OSEvents, OScopyEvents, OSnewEvents
from osguishare import OSGUIShare from osguishare import OSGUIShare
from osmouse import OSGetDoubleClickTime from osmouse import OSGetDoubleClickTime
from ossystem import OSWindowMetrics, OSDefaultWindowMetrics from ossystem import OSWindowMetrics, OSDefaultWindowMetrics
...@@ -36,7 +36,7 @@ from roundrobin import RR, emptyRR, notodoRR ...@@ -36,7 +36,7 @@ from roundrobin import RR, emptyRR, notodoRR
:: *IOUnique l :: *IOUnique l
= { ioevents :: !*OSEvents // The event stream environment = { ioevents :: !*OSEvents // The event stream environment
, ioworld :: !*[*World] // The world environment , ioworld :: !*[*World] // The world environment
, ioprocesses :: *CProcesses // All other processes , ioprocesses :: !*CProcesses // All other processes
, ioinit :: !IdFun (PSt l) // The initialisation functions of the process , ioinit :: !IdFun (PSt l) // The initialisation functions of the process
, iotoolbox :: !*OSToolbox // The Mac continuation value , iotoolbox :: !*OSToolbox // The Mac continuation value
} }
...@@ -291,7 +291,10 @@ IOStSetActivateRequests ioReqs ioState=:{ioshare} = {ioState & ioshare={ioshare ...@@ -291,7 +291,10 @@ IOStSetActivateRequests ioReqs ioState=:{ioshare} = {ioState & ioshare={ioshare
// Access rules to the OSEvents environment: // Access rules to the OSEvents environment:
IOStGetEvents :: !(IOSt .l) -> (!*OSEvents, !IOSt .l) IOStGetEvents :: !(IOSt .l) -> (!*OSEvents, !IOSt .l)
IOStGetEvents ioState=:{iounique=unique=:{ioevents}} = (ioevents,{ioState & iounique={unique & ioevents=OSnewEvents}}) //IOStGetEvents ioState=:{iounique=unique=:{ioevents}} = (ioevents,{ioState & iounique={unique & ioevents=OSnewEvents}})
IOStGetEvents ioState=:{iounique=unique=:{ioevents=es}}
# (es1,es2) = OScopyEvents es
= (es1,{ioState & iounique={unique & ioevents=es2}})
IOStSetEvents :: !*OSEvents !(IOSt .l) -> IOSt .l IOStSetEvents :: !*OSEvents !(IOSt .l) -> IOSt .l
IOStSetEvents es ioState = {ioState & iounique={ioState.iounique & ioevents=es}} IOStSetEvents es ioState = {ioState & iounique={ioState.iounique & ioevents=es}}
......
...@@ -34,15 +34,15 @@ from StdProcessDef import ProcessInit, DocumentInterface, NDI, SDI, MDI ...@@ -34,15 +34,15 @@ from StdProcessDef import ProcessInit, DocumentInterface, NDI, SDI, MDI
} }
:: *Context :: *Context
= { cEnvs :: !*Environs // The global environments = { cEnvs :: !*Environs // The global environments
, cProcessStack :: ProcessStack // The global process stack , cProcessStack :: !ProcessStack // The global process stack
, cMaxIONr :: SystemId // The global maximum system number , cMaxIONr :: !SystemId // The global maximum system number
, cProcesses :: *CProcesses // All processes , cProcesses :: !*CProcesses // All processes
, cModalProcess :: Maybe SystemId // The SystemId of the interactive process that has a modal window , cModalProcess :: !Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: ReceiverTable // The global receiver-process table , cReceiverTable :: !ReceiverTable // The global receiver-process table
, cTimerTable :: TimerTable // The table of all currently active timers , cTimerTable :: !TimerTable // The table of all currently active timers
, cIdTable :: IdTable // The table of all bound Ids , cIdTable :: !IdTable // The table of all bound Ids
, cOSTime :: OSTime // The current OSTime , cOSTime :: !OSTime // The current OSTime
, cIdSeed :: Int // The global id generating number (actually the World) , cIdSeed :: !Int // The global id generating number (actually the World)
, cOSToolbox :: !*OSToolbox // The toolbox environment , cOSToolbox :: !*OSToolbox // The toolbox environment
} }
......
...@@ -6,6 +6,7 @@ implementation module scheduler ...@@ -6,6 +6,7 @@ implementation module scheduler
import StdBool, StdList, StdTuple import StdBool, StdList, StdTuple
import osevent, ostime import osevent, ostime
from ossystem import OStickspersecond
from ostoolbox import OSNewToolbox, OSInitToolbox from ostoolbox import OSNewToolbox, OSInitToolbox
import commondef, devicefunctions, iostate, processstack, roundrobin, timertable, world import commondef, devicefunctions, iostate, processstack, roundrobin, timertable, world
from StdProcessDef import ProcessInit from StdProcessDef import ProcessInit
...@@ -19,15 +20,15 @@ from StdProcessAttribute import isProcessKindAttribute ...@@ -19,15 +20,15 @@ from StdProcessAttribute import isProcessKindAttribute
} }
:: *Context :: *Context
= { cEnvs :: !*Environs // The global environments = { cEnvs :: !*Environs // The global environments
, cProcessStack :: ProcessStack // The global process stack , cProcessStack :: !ProcessStack // The global process stack
, cMaxIONr :: SystemId // The global maximum system number , cMaxIONr :: !SystemId // The global maximum system number
, cProcesses :: *CProcesses // All processes , cProcesses :: !*CProcesses // All processes
, cModalProcess :: Maybe SystemId // The SystemId of the interactive process that has a modal window , cModalProcess :: !Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: ReceiverTable // The global receiver-process table , cReceiverTable :: !ReceiverTable // The global receiver-process table
, cTimerTable :: TimerTable // The table of all currently active timers , cTimerTable :: !TimerTable // The table of all currently active timers
, cIdTable :: IdTable // The table of all bound Ids , cIdTable :: !IdTable // The table of all bound Ids
, cOSTime :: OSTime // The current OSTime , cOSTime :: !OSTime // The current OSTime
, cIdSeed :: Int // The global id generating number (actually the World) , cIdSeed :: !Int // The global id generating number (actually the World)
, cOSToolbox :: !*OSToolbox // The toolbox environment , cOSToolbox :: !*OSToolbox // The toolbox environment
} }
...@@ -52,14 +53,15 @@ ContextGetSleepTime :: !Context -> (!Int,!Context) ...@@ -52,14 +53,15 @@ ContextGetSleepTime :: !Context -> (!Int,!Context)
ContextGetSleepTime context=:{cTimerTable,cReceiverTable} ContextGetSleepTime context=:{cTimerTable,cReceiverTable}
# maybe_sleep = getTimeIntervalFromTimerTable cTimerTable # maybe_sleep = getTimeIntervalFromTimerTable cTimerTable
# maybe_receiver= getActiveReceiverTableEntry cReceiverTable # maybe_receiver= getActiveReceiverTableEntry cReceiverTable
sleep = if (isJust maybe_receiver) 0 // a receiver with a non-empty message queue exists sleep = if (isJust maybe_receiver) 0 // a receiver with a non-empty message queue exists
(if (isJust maybe_sleep) (fromJust maybe_sleep) // a timer with given interval is waiting (if (isJust maybe_sleep) (snd (fromJust maybe_sleep)) // a timer with given interval is waiting
OSLongSleep) // neither a receiver nor timer OSLongSleep) // neither a receiver nor timer
= (sleep,context) = (sleep,context)
ContextGetOSEvents :: !Context -> (!OSEvents,!Context) ContextGetOSEvents :: !Context -> (!OSEvents,!Context)
ContextGetOSEvents context=:{cEnvs=envs=:{envsEvents}} ContextGetOSEvents context=:{cEnvs=envs=:{envsEvents=es}}
= (envsEvents,{context & cEnvs={envs & envsEvents=OSnewEvents}}) # (es1,es2) = OScopyEvents es
= (es1,{context & cEnvs={envs & envsEvents=es2}})
ContextSetOSEvents :: !(!OSEvents,!Context) -> Context ContextSetOSEvents :: !(!OSEvents,!Context) -> Context
ContextSetOSEvents (osEvents,context=:{cEnvs=envs}) ContextSetOSEvents (osEvents,context=:{cEnvs=envs})
...@@ -171,16 +173,22 @@ where ...@@ -171,16 +173,22 @@ where
= (not continue,context) = (not continue,context)
handleContextOSEvent :: !OSEvent !Context -> (![Int],!Context) handleContextOSEvent :: !OSEvent !Context -> (![Int],!Context)
handleContextOSEvent osEvent context=:{cProcessStack,cProcesses,cReceiverTable,cTimerTable,cOSTime,cOSToolbox} handleContextOSEvent osEvent context=:{cEnvs=envs=:{envsEvents=osEvents},cProcessStack,cProcesses,cReceiverTable,cTimerTable,cOSTime,cOSToolbox}
// PA: shift the time in the timertable. // PA: shift the time in the timertable.
# (ostime,tb) = OSGetTime cOSToolbox # (ostime,tb) = OSGetTime cOSToolbox
timeshift = toInt (ostime-cOSTime) timeshift = toInt (ostime-cOSTime)
timertable = shiftTimeInTimerTable timeshift cTimerTable timertable = shiftTimeInTimerTable timeshift cTimerTable
// PA: determine whether a TimerEvent or ASyncMessage can be generated // PA: determine whether a TimerEvent or ASyncMessage can be generated
(schedulerEvent,receivertable,timertable) (schedulerEvent,receivertable,timertable,osEvents)
= toSchedulerEvent osEvent cReceiverTable timertable cOSTime = toSchedulerEvent osEvent cReceiverTable timertable cOSTime osEvents
processes = resetRR cProcesses processes = resetRR cProcesses
# context = {context & cProcesses=processes,cReceiverTable=receivertable,cTimerTable=timertable,cOSTime=ostime,cOSToolbox=tb} # context = {context & cEnvs = {envs & envsEvents=osEvents}
, cProcesses = processes
, cReceiverTable = receivertable
, cTimerTable = timertable
, cOSTime = ostime
, cOSToolbox = tb
}
# (schedulerEvent,context) = handleEventForContext False schedulerEvent context # (schedulerEvent,context) = handleEventForContext False schedulerEvent context
replyToOS = case schedulerEvent of replyToOS = case schedulerEvent of
(ScheduleOSEvent _ reply) -> reply (ScheduleOSEvent _ reply) -> reply
...@@ -201,46 +209,76 @@ handleContextOSEvent osEvent context=:{cProcessStack,cProcesses,cReceiverTable,c ...@@ -201,46 +209,76 @@ handleContextOSEvent osEvent context=:{cProcessStack,cProcesses,cReceiverTable,c
can be generated instead. If both a TimerEvent and an ASyncMessage are available, use the OSTime to can be generated instead. If both a TimerEvent and an ASyncMessage are available, use the OSTime to
decide which one to choose. decide which one to choose.
*/ */
toSchedulerEvent :: !OSEvent !ReceiverTable !TimerTable !OSTime -> (!SchedulerEvent,!ReceiverTable,!TimerTable) zerotimelimit :: OSTime
toSchedulerEvent osevent receivertable timertable osTime zerotimelimit =: fromInt (max 1 (OStickspersecond/20))
| OSEventIsUrgent osevent
= (schedulerEvent,receivertable,timertable) toSchedulerEvent :: !OSEvent !ReceiverTable !TimerTable !OSTime !*OSEvents -> (!SchedulerEvent,!ReceiverTable,!TimerTable,!*OSEvents)
| not sure_timer && not sure_receiver toSchedulerEvent osevent receivertable timertable osTime osEvents
= (schedulerEvent,receivertable,timertable) | eventIsUrgent
= (schedulerEvent,receivertable,timertable,osEvents)
| (not sure_timer) && not sure_receiver
= (schedulerEvent,receivertable,timertable,osEvents)
| sure_timer && sure_receiver | sure_timer && sure_receiver
| isEven (toInt osTime) | isEven (toInt osTime)
= (timerEvent,receivertable,timertable`) = (timerEvent,receivertable,timertable`,osEvents`)
// otherwise // otherwise
= (asyncEvent,receivertable`,timertable) = (asyncEvent,receivertable`,timertable,osEvents`)
| sure_timer | sure_timer
= (timerEvent,receivertable,timertable`) = (timerEvent,receivertable,timertable`,osEvents`)
| otherwise | otherwise
= (asyncEvent,receivertable`,timertable) = (asyncEvent,receivertable`,timertable,osEvents)
where where
eventIsUrgent = OSEventIsUrgent osevent