Commit 8df05b3f authored by Peter Achten's avatar Peter Achten
Browse files

(PA) Removed bugs wrt unbalanced IOStGetDevice

and IOStSetDevice.
parent 28d01b46
......@@ -475,6 +475,7 @@ getMenus ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found
= ([],ioState)
| otherwise
# mHs = MenuSystemStateGetMenuHandles mDevice
(idtypes,msHs) = AccessList getIdType mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
......@@ -493,6 +494,7 @@ getMenuPos id ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found
= (Nothing,ioState)
| otherwise
# mHs = MenuSystemStateGetMenuHandles mDevice
(optIndex,msHs) = getmenuindex id 0 mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
......@@ -504,7 +506,7 @@ where
| id==menu_id
= (Just index,[mH:mHs])
| otherwise
# (optIndex,mHs)= getmenuindex id (index+1) mHs
# (optIndex,mHs) = getmenuindex id (index+1) mHs
= (optIndex, [mH:mHs])
getmenuindex _ _ _
= (Nothing,[])
......
......@@ -106,6 +106,7 @@ closeTimer id ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok
= ioState
| otherwise
# (pid,ioState) = IOStGetIOId ioState
# (rt,ioState) = IOStGetReceiverTable ioState
# (tt,ioState) = IOStGetTimerTable ioState
......@@ -147,6 +148,7 @@ getTimers ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok
= ([],ioState)
| otherwise
# (idtypes,timers) = getidtypes tHs.tTimers
tHs = {tHs & tTimers=timers}
# ioState = IOStSetDevice (TimerSystemState tHs) ioState
......@@ -155,7 +157,7 @@ where
getidtypes :: ![TimerStateHandle .pst] -> (![(Id,TimerType)],![TimerStateHandle .pst])
getidtypes [TimerLSHandle tlsH=:{tHandle=tH}:tsHs]
# (idtype, tH) = getidtype tH
(idtypes,tsHs)= getidtypes tsHs
(idtypes,tsHs) = getidtypes tsHs
= ([idtype:idtypes],[TimerLSHandle {tlsH & tHandle=tH}:tsHs])
where
getidtype :: !(TimerHandle .ls .pst) -> ((Id,TimerType),!TimerHandle .ls .pst)
......
......@@ -467,8 +467,8 @@ where
| otherwise
#! dfuncs = removedevicefunctions device dfuncs
= [dfunc:dfuncs]
removedevicefunctions _ empty
= empty
removedevicefunctions _ _
= []
// Access to the DeviceSystemStates:
......@@ -477,7 +477,7 @@ IOStLastInteraction ioState
# (processes,ioState) = IOStGetCProcesses ioState
(empty,processes) = notodoRR processes
# ioState = IOStSetCProcesses processes ioState
= (not empty,ioState)
= (empty,ioState)
IOStHasDevice :: !Device !(IOSt .l) -> (!Bool,!IOSt .l)
IOStHasDevice d ioState=:{iounique=iounique=:{iodevices=ds}}
......
......@@ -84,7 +84,7 @@ menuClose pState=:{io=ioState}
(_,(rt,it)) = StateMap (disposeIds ioid) mHs (rt,it)
# ioState = IOStSetIdTable it ioState
# ioState = IOStSetReceiverTable rt ioState
# ioState = IOStRemoveDevice MenuDevice ioState
# ioState = IOStRemoveDevice MenuDevice ioState // PA: This is actually redundant, since IOStGetDevice already removed it
# ioState = IOStRemoveDeviceFunctions MenuDevice ioState
= {pState & io=ioState}
where
......
......@@ -7,7 +7,7 @@ implementation module receiverdevice
import StdBool, StdFunc, StdList, StdMisc, StdTuple
import StdReceiver
import devicefunctions, iostate, receiveraccess, receiverevent, receiverid
from commondef import FatalError, URemove, UCond
from commondef import FatalError, URemove, UCond, StrictSeq, StrictSeqList, AccessList
from StdPSt import appPIO, accPIO
......@@ -45,16 +45,17 @@ receiverClose pState=:{io=ioState}
# (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState
| not found
= {pState & io=ioState}
| otherwise
# rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers
rIds = map (\{rHandle={rId}}->rId) rHs
# (idtable,ioState) = IOStGetIdTable ioState
# ioState = IOStSetIdTable (snd (removeIdsFromIdTable rIds idtable)) ioState
# ioState = unbindRIds rIds ioState
# ioState = IOStRemoveDevice ReceiverDevice ioState
# ioState = IOStRemoveDevice ReceiverDevice ioState // PA: this is redundant, because IOStGetDevice already removed it
# ioState = IOStRemoveDeviceFunctions ReceiverDevice ioState
= {pState & io=ioState}
// MW11..
where
where
callReceiverCloseFunctions :: !(IOSt .l) -> (IOSt .l)
callReceiverCloseFunctions ioState
# (found,rDevice,ioState) = IOStGetDevice ReceiverDevice ioState
......@@ -62,12 +63,21 @@ receiverClose pState=:{io=ioState}
= ioState
| otherwise
# rHs = (ReceiverSystemStateGetReceiverHandles rDevice).rReceivers
= seq (map callCloseFunc rHs) ioState
# (funcs,rHs) = AccessList getCloseFunc rHs
# ioState = IOStSetDevice (ReceiverSystemState {rReceivers=rHs}) ioState
// PA = seq (map callCloseFunc rHs) ioState
= StrictSeq funcs ioState
where
callCloseFunc {rHandle={rInetInfo=Nothing, rConnected}} ioState
= seq (map closeReceiver rConnected) ioState
callCloseFunc {rHandle={rInetInfo=Just (_,_,_,closeFun), rConnected}} ioState
= appIOToolbox closeFun (seq (map closeReceiver rConnected) ioState)
getCloseFunc :: !(ReceiverStateHandle (PSt .l)) -> (!IdFun (IOSt .l),!ReceiverStateHandle (PSt .l))
getCloseFunc rsH=:{rHandle={rInetInfo=Nothing, rConnected}}
= (StrictSeq (map closeReceiver rConnected),rsH)
getCloseFunc rsH=:{rHandle={rInetInfo=Just (_,_,_,closeFun),rConnected}}
= (appIOToolbox closeFun o StrictSeq (map closeReceiver rConnected),rsH)
// .. MW11
/* The receiver handles three cases of message events (for the time being timers are not included in receivers):
......@@ -112,6 +122,7 @@ where
= [rsH:rsHs]
qMessage _ _ []
= []
receiverIO deviceEvent=:(ReceiverEvent (ASyncMessage event)) rsHs pState
= (deviceEvent,letOneReceiverDoIO rl rsHs pState)
where
......@@ -133,6 +144,7 @@ where
= ({rState=ls,rHandle={rH & rASMQ=tailQ}},pState)
letReceiverDoIO _ _
= receiverdeviceFatalError "letReceiverDoIO" "message queue of target receiver is empty"
receiverIO (ReceiverEvent (SyncMessage event)) rsHs pState
# (lastProcess,pState) = accPIO IOStLastInteraction pState
# (event,pState) = receiverSyncIO lastProcess event rsHs pState
......
......@@ -49,7 +49,7 @@ timerClose pState=:{io=ioState}
# ioState = IOStSetReceiverTable rt ioState
# ioState = IOStSetTimerTable tt ioState
# ioState = IOStSetIdTable idtable ioState
# ioState = IOStRemoveDevice TimerDevice ioState
# ioState = IOStRemoveDevice TimerDevice ioState // PA: this is redundant, because IOStGetDevice already removed it
# ioState = IOStRemoveDeviceFunctions TimerDevice ioState
= {pState & io=ioState}
where
......
......@@ -74,8 +74,8 @@ windowClose pState=:{io=ioState}
windows = WindowSystemStateGetWindowHandles wDevice
# (inputTrack,ioState) = IOStGetInputTrack ioState
# (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
(wsHs,windows) = (\windows=:{whsWindows}->(whsWindows,{windows & whsWindows=[]})) windows
# pState = {pState & io=IOStSetDevice (WindowSystemState windows) ioState}
# (disposeInfo,(inputTrack,pState,tb))
= StateMap (disposeWindowStateHandle` osdinfo) wsHs (inputTrack,pState,tb)
# ioState = setIOToolbox tb pState.io
......@@ -89,9 +89,8 @@ windowClose pState=:{io=ioState}
# (idtable,ioState) = IOStGetIdTable ioState
(_,idtable) = removeIdsFromIdTable (freeRIds++freeIds) idtable
# ioState = IOStSetIdTable idtable ioState
windows = (\windows=:{whsFinalModalLS=finalLS}->{windows & whsFinalModalLS=finalLS++finalLSs}) windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
// # ioState = IOStRemoveDeviceFunction WindowDevice ioState PA: it is not clear whether this should be done
// # ioState = IOStRemoveDeviceFunctions WindowDevice ioState // PA: it is not clear whether this should be done
# ioState = setFinalLS finalLSs ioState
# pState = {pState & io=ioState}
= pState
where
......@@ -104,6 +103,16 @@ where
handleOSEvent :: !OSEvent !(PSt .l) -> (![Int],!PSt .l)
handleOSEvent osEvent pState = accContext (handleContextOSEvent osEvent) pState
setFinalLS :: ![FinalModalLS] !(IOSt .l) -> IOSt .l
setFinalLS finalLSs ioState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= windowdeviceFatalError "WindowFunctions.dClose" "setFinalLS could not retrieve WindowSystemState from IOSt"
| otherwise
# windows = WindowSystemStateGetWindowHandles wDevice
# windows = {windows & whsFinalModalLS=windows.whsFinalModalLS++finalLSs}
= IOStSetDevice (WindowSystemState windows) ioState
/* windowIO handles the DeviceEvents that have been filtered by windowEvent.
*/
......@@ -206,6 +215,8 @@ where
# (osDelayEvents,ioState)= accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateControlEvent wids.wPtr info.ckfItemPtr])) ioState
# (osEvents,ioState) = IOStGetEvents ioState
# ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState
# windows = setWindowHandlesWindow wsH windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# pState = {pState & io=ioState}
= (deviceEvent,pState)
......@@ -299,6 +310,8 @@ where
= accIOToolbox (StrictSeqList (lostInputEvents ++ [createOSDeactivateWindowEvent wids.wPtr])) ioState
# (osEvents,ioState)= IOStGetEvents ioState
# ioState = IOStSetEvents (OSappendEvents osDelayEvents osEvents) ioState
# windows = setWindowHandlesWindow wsH windows
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# pState = {pState & io=ioState}
= (deviceEvent,pState)
......
......@@ -67,13 +67,14 @@ disposeWindow wid pState=:{io=ioState}
= dispose wids wsH windows {pState & io=ioState}
where
dispose :: !WIDS !(WindowStateHandle (PSt .l)) !(WindowHandles (PSt .l)) !(PSt .l) -> PSt .l
dispose wids=:{wId} wsH windows pState
# (disposeFun,pState) = accPIO IOStGetInitIO pState
# pState = disposeFun pState
dispose wids=:{wId} wsH windows pState=:{io=ioState}
# (_,_,windows) = removeWindowHandlesWindow (toWID wId) windows // Remove window placeholder
# (windows,ioState) = enableProperWindows windows ioState // PA: before disposing last modal window, the window and menu system should be enabled
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# (disposeFun,ioState) = IOStGetInitIO ioState
# pState = disposeFun {pState & io=ioState}
# (osdinfo,ioState) = IOStGetOSDInfo pState.io
# (inputTrack,ioState) = IOStGetInputTrack ioState
(_,_,windows) = removeWindowHandlesWindow (toWID wId) windows
# (windows,ioState) = enableProperWindows windows ioState // PA: before disposing last modal window, the window and menu system should be enabled
# (tb,ioState) = getIOToolbox ioState
# pState = {pState & io=ioState}
# ((rids,ids,delayinfo,finalLS,inputTrack),(_,pState),tb)
......@@ -84,8 +85,7 @@ where
# (idtable,ioState) = IOStGetIdTable ioState
(_,idtable) = removeIdsFromIdTable (rids++ids) idtable
# ioState = IOStSetIdTable idtable ioState
# windows = {windows & whsFinalModalLS=finalLS++windows.whsFinalModalLS}
# ioState = IOStSetDevice (WindowSystemState windows) ioState
# ioState = addFinalLS finalLS ioState
# ioState = bufferDelayedEvents delayinfo ioState
= {pState & io=ioState}
......@@ -98,6 +98,16 @@ where
| isJust modalWIDS = (windows,ioState)
| otherwise = (windows,IOStSetIOIsModal Nothing ioState)
addFinalLS :: ![FinalModalLS] !(IOSt .l) -> IOSt .l
addFinalLS finalLS ioState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= windowdisposeFatalError "disposeWindow" "could not restore final local window state"
| otherwise
# windows = WindowSystemStateGetWindowHandles wDevice
# windows = {windows & whsFinalModalLS=finalLS++windows.whsFinalModalLS}
= IOStSetDevice (WindowSystemState windows) ioState
/* disposeCursorInfo disposes all system resources associated with the given CursorInfo.
PA: not yet implemented
......
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