{-# LINE 1 "System/Posix/Realtime/LockedMem.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "System/Posix/Realtime/LockedMem.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Realtime.LockedMem
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  William N. Halchin (vigalchin@gmail.com)
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX 1003.1b memory locking support.  See
-- <http://pubs.opengroup.org/onlinepubs/9699919799/basedefs/sys_mman.h.html>.
--
-----------------------------------------------------------------------------

module System.Posix.Realtime.LockedMem (
  LockAllFlags(..),
  lockMemory,
  unlockMemory,
  lockAllMemory,
  unlockAllMemory
  ) where


import System.IO
import System.IO.Error
import System.Posix.Types
import System.Posix.Error
import System.Posix.Internals

import Foreign
import Foreign.C
import Data.Bits


{-# LINE 37 "System/Posix/Realtime/LockedMem.hsc" #-}
import GHC.IO
import GHC.IO.Handle hiding (fdToHandle)
import qualified GHC.IO.Handle

{-# LINE 41 "System/Posix/Realtime/LockedMem.hsc" #-}


{-# LINE 46 "System/Posix/Realtime/LockedMem.hsc" #-}



{-# LINE 49 "System/Posix/Realtime/LockedMem.hsc" #-}

{-# LINE 50 "System/Posix/Realtime/LockedMem.hsc" #-}


data LockAllFlags = CURRENT | FUTURE


-- | lock a region of memory
lockMemory :: Ptr Word8 -> ByteCount -> IO ()
lockMemory mem len = do
  throwErrnoIfMinus1 "lockMemory" (c_mlock mem len)
  return ()

foreign import ccall unsafe "sys/mman.h mlock"
  c_mlock :: Ptr Word8 -> CSize -> IO CInt


-- | unlock a region of memory
unlockMemory :: Ptr Word8 -> ByteCount -> IO ()
unlockMemory mem len = do
  throwErrnoIfMinus1 "lockMemory" (c_mlock mem len)
  return ()

foreign import ccall unsafe "sys/mman.h mlock"
  c_munlock :: Ptr Word8 -> CSize -> IO CInt


-- | lock all of a prcocess's memory space
lockAllMemory :: LockAllFlags -> IO ()
lockAllMemory flags = do
  throwErrnoIfMinus1 "lockAllMemory" (c_mlockall cflags)
  return ()
    where
      cflags = case flags of
        CURRENT -> (1)
{-# LINE 83 "System/Posix/Realtime/LockedMem.hsc" #-}
        FUTURE   -> (2)
{-# LINE 84 "System/Posix/Realtime/LockedMem.hsc" #-}

foreign import ccall unsafe "sys/mman.h mlockall"
  c_mlockall :: CInt -> IO CInt


-- | unlock all mapped pages of a process
unlockAllMemory :: IO ()
unlockAllMemory = do
  throwErrnoIfMinus1 "unlockAllMemory" c_munlockall
  return ()

foreign import ccall unsafe "sys/mman.h munlockall"
  c_munlockall :: IO CInt