Skip to content

GitLab

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

(PA) Improved performance of zero timers.

parent 87693c9d
Hide whitespace changes
Inline Side-by-side
libraries/ObjectIO/ObjectIO/OS Windows/clCrossCall_12.dcl
View file @ 05711b8d
......@@ -224,6 +224,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
///
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). */
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. */
......
libraries/ObjectIO/ObjectIO/OS Windows/clCrossCall_12.icl
View file @ 05711b8d
......@@ -373,6 +373,7 @@ CcWmGAMEKEYBOARD :== 500 /* Mike: keyboard input for game */
///
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). */
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. */
......
libraries/ObjectIO/ObjectIO/OS Windows/osevent.dcl
View file @ 05711b8d
......@@ -5,14 +5,19 @@ definition module osevent
from StdInt import ^,-
from clCrossCall_12 import CrossCallInfo
from ostoolbox import OSToolbox
from ostime import OSTime // PA: new
from ostypes import OSWindowPtr
from StdMaybe import Maybe, Just, Nothing
:: *OSEvents
OSnewEvents :: OSEvents
OScopyEvents :: !OSEvents -> (!OSEvents,!OSEvents)
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
OSisEmptyEvents :: !OSEvents -> (!Bool,!OSEvents)
OSremoveEvent :: !OSEvents -> (!OSEvent,!OSEvents)
:: OSEvent
......@@ -31,14 +36,20 @@ OShandleEvents :: !(.s -> (Bool,.s)) !(.s -> (OSEvents,.s)) !((OSEvents,.s) ->
OSEventIsUrgent :: !OSEvent -> Bool
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)
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)
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)
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
libraries/ObjectIO/ObjectIO/OS Windows/osevent.icl
View file @ 05711b8d
......@@ -3,8 +3,9 @@ implementation module osevent
// Clean Object I/O library, version 1.2
import StdBool, StdList, StdMisc, StdTuple
import clCrossCall_12, ostoolbox, ostypes
import clCrossCall_12, ostime, ostoolbox, ostypes
from commondef import HdTl, FatalError
from StdMaybe import Maybe, Just, Nothing
//import StdDebug, tracetypes
......@@ -39,6 +40,14 @@ OSremoveEvent [osEvent:osEvents]
OSremoveEvent []
= 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 = []
......@@ -81,13 +90,13 @@ OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (
with
rccitoevent :: !(OSEvent -> .s -> ([Int],.s)) !OSEvent !.s !*OSToolbox -> (!OSEvent,!.s,!*OSToolbox)
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
= (setReplyInOSEvent reply,state,tb)
| otherwise
# (osEvent,osEvents) = OSremoveEvent osEvents
# 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
= OShandleEvents isFinalState getOSEvents setOSEvents getSleepTime handleOSEvent (state,tb)
......@@ -114,26 +123,40 @@ OSEventIsUrgent {ccMsg}
CcWmDRAWCLIPBOARD -> False // PA: in a future version, use this event to evaluate a clipboard callback function.
CcWmIDLETIMER -> False
CcWmTIMER -> False
CcWmZEROTIMER -> False
_ -> 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 wPtr tb = (Rq1Cci CcWmACTIVATE wPtr,tb)
createOSDeactivateWindowEvent :: !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
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 wPtr cPtr tb = (Rq2Cci CcWmSETFOCUS wPtr cPtr,tb)
createOSDeactivateControlEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
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 wPtr cPtr tb = (Rq2Cci CcWmLOSTMOUSE wPtr cPtr,tb)
createOSLooseKeyEvent :: !OSWindowPtr !OSWindowPtr !*OSToolbox -> (!OSEvent,!*OSToolbox)
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
libraries/ObjectIO/ObjectIO/OS Windows/ostime.dcl
View file @ 05711b8d
......@@ -25,5 +25,6 @@ OSGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
// OSGetCurrentTime returns current (year,month,day,day_of_week).
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 fromInt OSTime // Coerce Int to OSTime (Integer will be made zero if negative)
libraries/ObjectIO/ObjectIO/OS Windows/ostime.icl
View file @ 05711b8d
......@@ -44,6 +44,11 @@ instance - OSTime where
= OSTime (new-old)
= OSTime (OSMaxTickCount-old+new)
instance < OSTime where
(<) :: !OSTime !OSTime -> Bool
(<) (OSTime t1) (OSTime t2)
= t1<t2
instance toInt OSTime where
toInt :: !OSTime -> Int
toInt (OSTime t) = t
......
libraries/ObjectIO/ObjectIO/OS Windows/oswindow.dcl
View file @ 05711b8d
......@@ -6,7 +6,7 @@ definition module oswindow
import StdMaybe, StdOverloaded, StdString
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 osrgn import OSRgnHandle
from ossystem import OSWindowMetrics
......@@ -122,9 +122,11 @@ OScreateWindow :: !OSWindowMetrics !Bool !ScrollbarInfo !ScrollbarInfo !(!Int,!I
!(OSWindowPtr->OSWindowPtr->OSPictContext->u:s->u:(*OSToolbox->*(u:s,*OSToolbox)))
!OSDInfo !OSWindowPtr !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
-> (!Bool,!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))
!u:s !*OSToolbox
-> (!Bool,!u:s,!*OSToolbox)
// Mike //
OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox)
......
libraries/ObjectIO/ObjectIO/OS Windows/oswindow.icl
View file @ 05711b8d
......@@ -306,12 +306,13 @@ OScreateWindowCallback _ _ _ _ _ {ccMsg} s tb
/* PA: new function that creates modal dialog and handles events until termination.
The Bool result is True iff no error occurred.
*/
OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(OSEvent -> u:s -> *([Int],u:s)) !u:s !*OSToolbox
-> (!Bool,!u:s,!*OSToolbox)
OScreateModalDialog isClosable title osdinfo currentActiveModal handleOSEvents s tb
OScreateModalDialog :: !Bool !String !OSDInfo !(Maybe OSWindowPtr) !(u:s -> (OSEvents,u:s)) !((OSEvents,u:s)-> u:s) !(OSEvent -> u:s -> *([Int],u:s))
!u:s !*OSToolbox
-> (!Bool,!u:s,!*OSToolbox)
OScreateModalDialog isClosable title osdinfo currentActiveModal getOSEvents setOSEvents handleOSEvents s tb
# (textPtr,tb) = WinMakeCString title tb
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
ok = case returncci.ccMsg of
CcRETURN1 -> returncci.p1==0
......@@ -326,11 +327,19 @@ where
)
(fromJust currentActiveModal)
OScreateModalDialogCallback :: !(OSEvent -> u:s -> *([Int],u:s)) !CrossCallInfo !u:s !*OSToolbox -> (!CrossCallInfo,!u:s,!*OSToolbox)
OScreateModalDialogCallback handleOSEvents osEvent s tb
// # (replyToOS,s) = handleOSEvents (if (osEvent.ccMsg==CcWmIDLETIMER) osEvent (trace_n ("OScreateModalDialogCallback-->"+++toString osEvent) osEvent)) s
# (replyToOS,s) = handleOSEvents osEvent s
= (setReplyInOSEvent replyToOS,s,tb)
OScreateModalDialogCallback :: !(u:s -> (OSEvents,u:s)) !((OSEvents,u:s)-> u:s) !(OSEvent -> u:s -> *([Int],u:s))
!CrossCallInfo !u:s !*OSToolbox
-> (!CrossCallInfo,!u:s,!*OSToolbox)
OScreateModalDialogCallback getOSEvents setOSEvents handleOSEvents osEvent 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 //
OScreateGameWindow :: !Bool !(!Int,!Int) !Int !*OSToolbox -> (![DelayActivationInfo],!OSWindowPtr,!*OSToolbox)
......
libraries/ObjectIO/ObjectIO/iostate.icl
View file @ 05711b8d
......@@ -8,7 +8,7 @@ import StdBool, StdFunc, StdList, StdMisc
import commondef, devicefunctions, devicesystemstate, processstack, receivertable, timertable
import osdocumentinterface, ostime
from osactivaterequests import OSActivateRequest
from osevent import OSEvents, OSnewEvents
from osevent import OSEvents, OScopyEvents, OSnewEvents
from osguishare import OSGUIShare
from osmouse import OSGetDoubleClickTime
from ossystem import OSWindowMetrics, OSDefaultWindowMetrics
......@@ -36,7 +36,7 @@ from roundrobin import RR, emptyRR, notodoRR
:: *IOUnique l
= { ioevents :: !*OSEvents // The event stream 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
, iotoolbox :: !*OSToolbox // The Mac continuation value
}
......@@ -291,7 +291,10 @@ IOStSetActivateRequests ioReqs ioState=:{ioshare} = {ioState & ioshare={ioshare
// Access rules to the OSEvents environment:
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 es ioState = {ioState & iounique={ioState.iounique & ioevents=es}}
......
libraries/ObjectIO/ObjectIO/scheduler.dcl
View file @ 05711b8d
......@@ -34,15 +34,15 @@ from StdProcessDef import ProcessInit, DocumentInterface, NDI, SDI, MDI
}
:: *Context
= { cEnvs :: !*Environs // The global environments
, cProcessStack :: ProcessStack // The global process stack
, cMaxIONr :: SystemId // The global maximum system number
, cProcesses :: *CProcesses // All processes
, cModalProcess :: Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: ReceiverTable // The global receiver-process table
, cTimerTable :: TimerTable // The table of all currently active timers
, cIdTable :: IdTable // The table of all bound Ids
, cOSTime :: OSTime // The current OSTime
, cIdSeed :: Int // The global id generating number (actually the World)
, cProcessStack :: !ProcessStack // The global process stack
, cMaxIONr :: !SystemId // The global maximum system number
, cProcesses :: !*CProcesses // All processes
, cModalProcess :: !Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: !ReceiverTable // The global receiver-process table
, cTimerTable :: !TimerTable // The table of all currently active timers
, cIdTable :: !IdTable // The table of all bound Ids
, cOSTime :: !OSTime // The current OSTime
, cIdSeed :: !Int // The global id generating number (actually the World)
, cOSToolbox :: !*OSToolbox // The toolbox environment
}
......
libraries/ObjectIO/ObjectIO/scheduler.icl
View file @ 05711b8d
......@@ -6,6 +6,7 @@ implementation module scheduler
import StdBool, StdList, StdTuple
import osevent, ostime
from ossystem import OStickspersecond
from ostoolbox import OSNewToolbox, OSInitToolbox
import commondef, devicefunctions, iostate, processstack, roundrobin, timertable, world
from StdProcessDef import ProcessInit
......@@ -19,15 +20,15 @@ from StdProcessAttribute import isProcessKindAttribute
}
:: *Context
= { cEnvs :: !*Environs // The global environments
, cProcessStack :: ProcessStack // The global process stack
, cMaxIONr :: SystemId // The global maximum system number
, cProcesses :: *CProcesses // All processes
, cModalProcess :: Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: ReceiverTable // The global receiver-process table
, cTimerTable :: TimerTable // The table of all currently active timers
, cIdTable :: IdTable // The table of all bound Ids
, cOSTime :: OSTime // The current OSTime
, cIdSeed :: Int // The global id generating number (actually the World)
, cProcessStack :: !ProcessStack // The global process stack
, cMaxIONr :: !SystemId // The global maximum system number
, cProcesses :: !*CProcesses // All processes
, cModalProcess :: !Maybe SystemId // The SystemId of the interactive process that has a modal window
, cReceiverTable :: !ReceiverTable // The global receiver-process table
, cTimerTable :: !TimerTable // The table of all currently active timers
, cIdTable :: !IdTable // The table of all bound Ids
, cOSTime :: !OSTime // The current OSTime
, cIdSeed :: !Int // The global id generating number (actually the World)
, cOSToolbox :: !*OSToolbox // The toolbox environment
}
......@@ -52,14 +53,15 @@ ContextGetSleepTime :: !Context -> (!Int,!Context)
ContextGetSleepTime context=:{cTimerTable,cReceiverTable}
# maybe_sleep = getTimeIntervalFromTimerTable cTimerTable
# maybe_receiver= getActiveReceiverTableEntry cReceiverTable
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
OSLongSleep) // neither a receiver nor timer
sleep = if (isJust maybe_receiver) 0 // a receiver with a non-empty message queue exists
(if (isJust maybe_sleep) (snd (fromJust maybe_sleep)) // a timer with given interval is waiting
OSLongSleep) // neither a receiver nor timer
= (sleep,context)
ContextGetOSEvents :: !Context -> (!OSEvents,!Context)
ContextGetOSEvents context=:{cEnvs=envs=:{envsEvents}}
= (envsEvents,{context & cEnvs={envs & envsEvents=OSnewEvents}})
ContextGetOSEvents context=:{cEnvs=envs=:{envsEvents=es}}
# (es1,es2) = OScopyEvents es
= (es1,{context & cEnvs={envs & envsEvents=es2}})
ContextSetOSEvents :: !(!OSEvents,!Context) -> Context
ContextSetOSEvents (osEvents,context=:{cEnvs=envs})
......@@ -171,16 +173,22 @@ where
= (not continue,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.
# (ostime,tb) = OSGetTime cOSToolbox
timeshift = toInt (ostime-cOSTime)
timertable = shiftTimeInTimerTable timeshift cTimerTable
// PA: determine whether a TimerEvent or ASyncMessage can be generated
(schedulerEvent,receivertable,timertable)
= toSchedulerEvent osEvent cReceiverTable timertable cOSTime
(schedulerEvent,receivertable,timertable,osEvents)
= toSchedulerEvent osEvent cReceiverTable timertable cOSTime osEvents
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
replyToOS = case schedulerEvent of
(ScheduleOSEvent _ reply) -> reply
......@@ -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
decide which one to choose.
*/
toSchedulerEvent :: !OSEvent !ReceiverTable !TimerTable !OSTime -> (!SchedulerEvent,!ReceiverTable,!TimerTable)
toSchedulerEvent osevent receivertable timertable osTime
| OSEventIsUrgent osevent
= (schedulerEvent,receivertable,timertable)
| not sure_timer && not sure_receiver
= (schedulerEvent,receivertable,timertable)
zerotimelimit :: OSTime
zerotimelimit =: fromInt (max 1 (OStickspersecond/20))
toSchedulerEvent :: !OSEvent !ReceiverTable !TimerTable !OSTime !*OSEvents -> (!SchedulerEvent,!ReceiverTable,!TimerTable,!*OSEvents)
toSchedulerEvent osevent receivertable timertable osTime osEvents
| eventIsUrgent
= (schedulerEvent,receivertable,timertable,osEvents)
| (not sure_timer) && not sure_receiver
= (schedulerEvent,receivertable,timertable,osEvents)
| sure_timer && sure_receiver
| isEven (toInt osTime)
= (timerEvent,receivertable,timertable`)
= (timerEvent,receivertable,timertable`,osEvents`)
// otherwise
= (asyncEvent,receivertable`,timertable)
= (asyncEvent,receivertable`,timertable,osEvents`)
| sure_timer
= (timerEvent,receivertable,timertable`)
= (timerEvent,receivertable,timertable`,osEvents`)
| otherwise
= (asyncEvent,receivertable`,timertable)
= (asyncEvent,receivertable`,timertable,osEvents)
where
eventIsUrgent = OSEventIsUrgent osevent
maybe_timer = getTimeIntervalFromTimerTable timertable
(zerotimer,interval) = fromJust maybe_timer
maybe_receiver = getActiveReceiverTableEntry receivertable
sure_timer = isJust maybe_timer && fromJust maybe_timer<=0
sure_timer = isJust maybe_timer && interval<=0
sure_receiver = isJust maybe_receiver
schedulerEvent = ScheduleOSEvent osevent []
(asyncEvent,receivertable`) = toASyncEvent (fromJust maybe_receiver) receivertable
(timerEvent,timertable`) = toTimerEvent timertable
// osEvents` = checkOSZeroTimerEvent zerotimer osTime osevent osEvents
osEvents` = checkOSZeroTimerEvent maybe_timer osTime osevent osEvents
// In case the original event is a virtual zero timer event:
// check if another should be inserted in the OSEvents to circumvent the event system call.
// In case the original event is a non urgent event:
// check if an initial virtual zero timer event must be inserted to start circumventing event system calls.
// checkOSZeroTimerEvent :: !Bool !OSTime !OSEvent !*OSEvents -> *OSEvents
checkOSZeroTimerEvent :: !(Maybe (Bool,Int)) !OSTime !OSEvent !*OSEvents -> *OSEvents
// checkOSZeroTimerEvent zerotimer osTime osevent osEvents
checkOSZeroTimerEvent maybe_timer osTime osevent osEvents
| isJust maybe_zerotimer_start && zerotimer
| osTime-zerotimer_start<=zerotimelimit
= OSinsertEvents [osevent] osEvents
// otherwise
= osEvents
| isNothing maybe_zerotimer_start && zerotimer
= OSinsertEvents [createOSZeroTimerEvent osTime] osEvents
| otherwise
= osEvents
where
(zerotimer,_) = fromJust maybe_timer
maybe_zerotimer_start = getOSZeroTimerStartTime osevent
zerotimer_start = fromJust maybe_zerotimer_start
// The receiver for which an ASyncMessage is generated is placed behind all other receivers,
// creating a round-robin order. Its asynchronous message queue length field is decreased.
// The receiver for which an ASyncMessage is generated is placed behind all other receivers,
// creating a round-robin order. Its asynchronous message queue length field is decreased.
toASyncEvent :: !Id !ReceiverTable -> (!SchedulerEvent,!ReceiverTable)
toASyncEvent rid receivertable
#! rte = fromJust (getReceiverTableEntry rid receivertable)
#! rte = {rte & rteASMCount=rte.rteASMCount-1}
#! receivertable = setReceiverTableEntry rte (snd (removeReceiverFromReceiverTable rid receivertable))
#! rte = fromJust (getReceiverTableEntry rid receivertable)
#! rte = {rte & rteASMCount=rte.rteASMCount-1}
#! receivertable = setReceiverTableEntry rte (snd (removeReceiverFromReceiverTable rid receivertable))
= (ScheduleMsgEvent (ASyncMessage {asmRecLoc=rte.rteLoc}),receivertable)
// The timer for which a TimerEvent is generated is determined by getActiveTimerInTable.
// This function already takes care of fairness using a round robin scheme.
// The timer for which a TimerEvent is generated is determined by getActiveTimerInTable.
// This function already takes care of fairness using a round robin scheme.
toTimerEvent :: !TimerTable -> (!SchedulerEvent,!TimerTable)
toTimerEvent timertable
# (maybeTimerEvent,timertable) = getActiveTimerInTimerTable timertable
= (ScheduleTimerEvent (fromJust maybeTimerEvent),timertable)
handleEventForContext :: !Bool !SchedulerEvent !Context -> (!SchedulerEvent,!Context)
handleEventForContext eventDone schedulerEvent context=:{cProcesses=processes}
# (notodo,processes) = notodoRR processes
......
libraries/ObjectIO/ObjectIO/timertable.dcl
View file @ 05711b8d
......@@ -52,8 +52,9 @@ shiftTimeInTimerTable :: !Int !TimerTable -> TimerTable
*/
getActiveTimerInTimerTable :: !TimerTable -> (!Maybe TimerEvent,!TimerTable)
/* getTimeIntervalFromTimerTable returns the (Just time) interval that can be waited for the next timer to
become active.
/* getTimeIntervalFromTimerTable returns the (Just (zerotimer,time)) interval that can be
waited for the next timer to become active. The Boolean zerotimer holds iff the time
returned belongs to a zero timer.
If there are no timers, then Nothing is returned.
*/
getTimeIntervalFromTimerTable :: !TimerTable -> Maybe Int
getTimeIntervalFromTimerTable :: !TimerTable -> Maybe (Bool,Int)
libraries/ObjectIO/ObjectIO/timertable.icl
View file @ 05711b8d
......@@ -128,22 +128,23 @@ getActiveTimerInTimerTable [tte=:{tteElapse,tteInterval,tteLoc}:ttes]
getActiveTimerInTimerTable _
= (Nothing,[])
/* getTimeIntervalFromTimerTable returns the (Just time) interval that can be waited for the next timer to
become active.
/* getTimeIntervalFromTimerTable returns the (Just (zerotimer,time)) interval that can be
waited for the next timer to become active. The Boolean zerotimer holds iff the time
returned belongs to a zero timer.
If there are no timers, then Nothing is returned.
*/
getTimeIntervalFromTimerTable :: !TimerTable -> Maybe Int
getTimeIntervalFromTimerTable :: !TimerTable -> Maybe (Bool,Int)
getTimeIntervalFromTimerTable timers=:[]
= Nothing
getTimeIntervalFromTimerTable timers
#! wait = getSleepTime (2^31-1) timers
= Just wait
where
getSleepTime :: !Int ![TimerTableEntry] -> Int
getSleepTime sleep [tte=:{tteElapse}:ttes]
getSleepTime :: !Int ![TimerTableEntry] -> (Bool,Int)
getSleepTime sleep [tte=:{tteElapse,tteInterval}:ttes]
| tteElapse<=0
= 0
= (tteInterval==0,0)
| otherwise
= getSleepTime (min sleep tteElapse) ttes
getSleepTime sleep _
= sleep
= (False,sleep)
libraries/ObjectIO/ObjectIO/windowcreate.icl
View file @ 05711b8d
......@@ -10,7 +10,7 @@ import StdBool, StdFunc, StdList, StdMisc, StdTuple
import osevent, ostypes, oswindow
from ostoolbox import OSNewToolbox
from StdMenu import enableMenuSystem, disableMenuSystem
from StdPSt import accPIO
from StdPSt import accPIO, appPIO
from StdWindowAttribute import isWindowInit, getWindowInitFun, isWindowClose, isWindowCursor, getWindowCursorAtt
import commondef, controlpos, iostate, scheduler, windowaccess
from controlcreate import createControls
......@@ -50,7 +50,8 @@ openmodalwindow wId {wlsState,wlsHandle} pState=:{io=ioState}
# (inputTrack,ioState) = IOStGetInputTrack ioState
# ioState = IOStSetInputTrack Nothing ioState // clear input track information
# pState = {pState & io=ioState}
# (noError,pState,_) = OScreateModalDialog closable title osdinfo (mapMaybe (\{wPtr}->wPtr) modalWIDS) handleOSEvent pState OSNewToolbox
# (noError,pState,_) = OScreateModalDialog closable title osdinfo (mapMaybe (\{wPtr}->wPtr) modalWIDS)
getOSEvent setOSEvent handleOSEvent pState OSNewToolbox
(delayMouse,delayKey) = case inputTrack of // after handling modal dialog, generate proper (Mouse/Key)Lost events
Nothing -> ([],[])
Just it=:{itWindow,itControl,itKind}
......@@ -67,6 +68,12 @@ where
handleOSEvent :: !OSEvent !(PSt .l) -> (![Int],!PSt .l)
handleOSEvent osEvent pState = accContext (handleContextOSEvent osEvent) pState
getOSEvent :: !(PSt .l) -> (!OSEvents,!PSt .l)
getOSEvent pState = accPIO IOStGetEvents pState
setOSEvent :: !(!OSEvents,!PSt .l) -> PSt .l
setOSEvent (osEvents,pState) = appPIO (IOStSetEvents osEvents) pState
/* getFinalModalDialogLS retrieves the final local state of the modal dialog. This value has been stored in the window handles.
This MUST have been done by disposeWindow (windowdispose).
*/
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment