Commit 8122c610 authored by Peter Achten's avatar Peter Achten

(PA) Removed bugs wrt unbalanced IOStGetDevice

and IOStSetDevice.
parent fcbfbbd6
......@@ -73,7 +73,7 @@ where
isToolbarOSEvent _ = False
menuEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
# (ioId,ioState) = IOStGetIOId ioState
# (ioId,ioState) = IOStGetIOId ioState
| ioId<>recLoc.rlIOId || recLoc.rlDevice<>MenuDevice
= (False,Nothing,schedulerEvent,{pState & io=ioState})
| otherwise
......
......@@ -76,7 +76,7 @@ where
isWindowOSEvent _ = False
windowEvent schedulerEvent=:(ScheduleMsgEvent msgEvent) pState=:{io=ioState}
# (ioId,ioState) = IOStGetIOId ioState
# (ioId,ioState) = IOStGetIOId ioState
| ioId<>recLoc.rlIOId || recLoc.rlDevice<>WindowDevice
= (False,Nothing,schedulerEvent,{pState & io=ioState})
| otherwise
......
......@@ -475,14 +475,15 @@ getMenus ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found
= ([],ioState)
# mHs = MenuSystemStateGetMenuHandles mDevice
(idtypes,msHs) = AccessList getIdType mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (tl idtypes,ioState)
| otherwise
# mHs = MenuSystemStateGetMenuHandles mDevice
(idtypes,msHs) = AccessList getIdType mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (tl idtypes,ioState)
where
getIdType :: !(MenuStateHandle .pst) -> *((Id,MenuType),!MenuStateHandle .pst)
getIdType msH
# (id,msH) = menuStateHandleGetMenuId msH
# (id,msH) = menuStateHandleGetMenuId msH
= ((id,"Menu"),msH)
......@@ -493,18 +494,19 @@ getMenuPos id ioState
# (found,mDevice,ioState) = IOStGetDevice MenuDevice ioState
| not found
= (Nothing,ioState)
# mHs = MenuSystemStateGetMenuHandles mDevice
(optIndex,msHs) = getmenuindex id 0 mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (optIndex,ioState)
| otherwise
# mHs = MenuSystemStateGetMenuHandles mDevice
(optIndex,msHs) = getmenuindex id 0 mHs.mMenus
# ioState = IOStSetDevice (MenuSystemState {mHs & mMenus=msHs}) ioState
= (optIndex,ioState)
where
getmenuindex :: !Id !Int ![MenuStateHandle .pst] -> (!Maybe Int,![MenuStateHandle .pst])
getmenuindex id index [mH:mHs]
# (menu_id,mH) = menuStateHandleGetMenuId mH
# (menu_id,mH) = menuStateHandleGetMenuId mH
| 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,[])
......
......@@ -103,20 +103,21 @@ eqTimerStateHandleId id tsH=:(TimerLSHandle {tHandle={tId}})
closeTimer :: !Id !(IOSt .l) -> IOSt .l
closeTimer id ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok
= ioState
# (pid,ioState) = IOStGetIOId ioState
# (rt,ioState) = IOStGetReceiverTable ioState
# (tt,ioState) = IOStGetTimerTable ioState
# (it,ioState) = IOStGetIdTable ioState
(rt,tt,it,tsHs) = closetimer id pid rt tt it tHs.tTimers
# ioState = IOStSetIdTable it ioState
# ioState = IOStSetReceiverTable rt ioState
# ioState = IOStSetTimerTable tt ioState
tHs = {tHs & tTimers=tsHs}
# ioState = IOStSetDevice (TimerSystemState tHs) ioState
= ioState
| otherwise
# (pid,ioState) = IOStGetIOId ioState
# (rt,ioState) = IOStGetReceiverTable ioState
# (tt,ioState) = IOStGetTimerTable ioState
# (it,ioState) = IOStGetIdTable ioState
(rt,tt,it,tsHs) = closetimer id pid rt tt it tHs.tTimers
# ioState = IOStSetIdTable it ioState
# ioState = IOStSetReceiverTable rt ioState
# ioState = IOStSetTimerTable tt ioState
tHs = {tHs & tTimers=tsHs}
# ioState = IOStSetDevice (TimerSystemState tHs) ioState
= ioState
where
closetimer :: !Id !SystemId !*ReceiverTable !*TimerTable !*IdTable ![TimerStateHandle .pst]
-> (!*ReceiverTable,!*TimerTable,!*IdTable,![TimerStateHandle .pst])
......@@ -144,18 +145,19 @@ where
getTimers :: !(IOSt .l) -> (![(Id,TimerType)],!IOSt .l)
getTimers ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
# (ok,tHs,ioState) = IOStGetTimerHandles ioState
| not ok
= ([],ioState)
# (idtypes,timers) = getidtypes tHs.tTimers
tHs = {tHs & tTimers=timers}
# ioState = IOStSetDevice (TimerSystemState tHs) ioState
= (idtypes,ioState)
| otherwise
# (idtypes,timers) = getidtypes tHs.tTimers
tHs = {tHs & tTimers=timers}
# ioState = IOStSetDevice (TimerSystemState tHs) ioState
= (idtypes,ioState)
where
getidtypes :: ![TimerStateHandle .pst] -> (![(Id,TimerType)],![TimerStateHandle .pst])
getidtypes [TimerLSHandle tlsH=:{tHandle=tH}:tsHs]
# (idtype, tH) = getidtype tH
(idtypes,tsHs)= getidtypes tsHs
# (idtype, tH) = getidtype tH
(idtypes,tsHs) = getidtypes tsHs
= ([idtype:idtypes],[TimerLSHandle {tlsH & tHandle=tH}:tsHs])
where
getidtype :: !(TimerHandle .ls .pst) -> ((Id,TimerType),!TimerHandle .ls .pst)
......
......@@ -1576,12 +1576,12 @@ getWindowCancel id ioState
# (found,wDevice,ioState) = IOStGetDevice WindowDevice ioState
| not found
= (Nothing,ioState)
# windows = WindowSystemStateGetWindowHandles wDevice
(found,wsH,windows) = getWindowHandlesWindow (toWID id) windows
# windows = WindowSystemStateGetWindowHandles wDevice
(found,wsH,windows) = getWindowHandlesWindow (toWID id) windows
| not found
= (Nothing,IOStSetDevice (WindowSystemState windows) ioState)
| otherwise
# (cancelId,wsH) = getWindowStateHandleCancelId wsH
# (cancelId,wsH) = getWindowStateHandleCancelId wsH
= (cancelId,IOStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
getWindowCursor :: !Id !(IOSt .l) -> (!Maybe CursorShape,!IOSt .l)
......
......@@ -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}}
......@@ -518,7 +518,7 @@ where
IOStRemoveDevice :: !Device !(IOSt .l) -> IOSt .l
IOStRemoveDevice d ioState=:{iounique=iounique=:{iodevices=ds}}
# ds = devicesRemoveDevice d ds
# ds = devicesRemoveDevice d ds
= {ioState & iounique={iounique & iodevices=ds}}
where
devicesRemoveDevice :: !Device !*[DeviceSystemState .pst] -> *[DeviceSystemState .pst]
......
......@@ -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}
# 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 = IOStRemoveDeviceFunctions ReceiverDevice ioState
= {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 // 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
where
# (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
......@@ -103,6 +102,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,25 +67,25 @@ 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)
= disposeWindowStateHandle osdinfo inputTrack handleOSEvent (wsH,pState) tb
# ioState = setIOToolbox tb pState.io
# ioState = IOStSetInputTrack inputTrack ioState
# ioState = unbindRIds rids ioState // When timers are part of windows, also unbind timers
# ioState = unbindRIds rids ioState // When timers are part of windows, also unbind timers
# (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}
......@@ -97,6 +97,16 @@ where
# (modalWIDS,windows) = getWindowHandlesActiveModalDialog windows
| 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.
......
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