{-# LINE 1 "System/Posix/Memory.hsc" #-}
-----------------------------------------------------------------------------
{-# LINE 2 "System/Posix/Memory.hsc" #-}
-- |
-- Module      :  System.Posix.Memory
-- Copyright   :  (c) Vincent Hanquez 2014
-- License     :  BSD-style
--
-- Maintainer  :  Vincent Hanquez
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- Functions defined by the POSIX standards for manipulating memory maps
--
-- When a function that calls an underlying POSIX function fails, the errno
-- code is converted to an 'IOError' using 'Foreign.C.Error.errnoToIOError'.
-- For a list of which errno codes may be generated, consult the POSIX
-- documentation for the underlying function.
--
-----------------------------------------------------------------------------


{-# LINE 21 "System/Posix/Memory.hsc" #-}

{-# LINE 22 "System/Posix/Memory.hsc" #-}

{-# LANGUAGE ForeignFunctionInterface #-}
module System.Posix.Memory (
    memoryMap,
    memoryUnmap,
    memoryAdvise,
    memoryLock,
    memoryUnlock,
    memoryProtect,
    memorySync,
    MemoryMapFlag(..),
    MemoryProtection(..),
    MemoryAdvice(..),
    MemorySyncFlag(..),
    sysconfPageSize
    ) where

import System.Posix.Types
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.Error
import Data.Bits

foreign import ccall unsafe "mmap"
    c_mmap :: Ptr a -> CSize -> CInt -> CInt -> CInt -> COff -> IO (Ptr a)

foreign import ccall unsafe "munmap"
    c_munmap :: Ptr a -> CSize -> IO CInt

foreign import ccall unsafe "madvise"
    c_madvise :: Ptr a -> CSize -> CInt -> IO CInt

foreign import ccall unsafe "msync"
    c_msync :: Ptr a -> CSize -> CInt -> IO CInt

foreign import ccall unsafe "mprotect"
    c_mprotect :: Ptr a -> CSize -> CInt -> IO CInt

foreign import ccall unsafe "mlock"
    c_mlock :: Ptr a -> CSize -> IO CInt

foreign import ccall unsafe "munlock"
    c_munlock :: Ptr a -> CSize -> IO CInt

foreign import ccall unsafe "sysconf"
    c_sysconf :: CInt -> CLong

-- | Mapping flag
data MemoryMapFlag =
      MemoryMapShared  -- ^ memory changes are shared between process
    | MemoryMapPrivate -- ^ memory changes are private to process
    deriving (Show,Read,Eq)

-- | Memory protection
data MemoryProtection =
      MemoryProtectionNone
    | MemoryProtectionRead
    | MemoryProtectionWrite
    | MemoryProtectionExecute
    deriving (Show,Read,Eq)

-- | Advice to put on memory.
--
-- only define the posix one.
data MemoryAdvice =
      MemoryAdviceNormal     -- ^ no specific advice, the default.
    | MemoryAdviceRandom     -- ^ Expect page references in random order. No readahead should occur.
    | MemoryAdviceSequential -- ^ Expect page references in sequential order. Page should be readahead aggressively.
    | MemoryAdviceWillNeed   -- ^ Expect access in the near future. Probably a good idea to readahead early
    | MemoryAdviceDontNeed   -- ^ Do not expect access in the near future.
    deriving (Show,Read,Eq)

-- | Memory synchronization flags
data MemorySyncFlag =
      MemorySyncAsync      -- ^ perform asynchronous write.
    | MemorySyncSync       -- ^ perform synchronous write.
    | MemorySyncInvalidate -- ^ invalidate cache data.
    deriving (Show,Read,Eq)

cvalueOfMemoryProts :: [MemoryProtection] -> CInt
cvalueOfMemoryProts = foldl (.|.) 0 . map toProt
  where toProt :: MemoryProtection -> CInt
        toProt MemoryProtectionNone    = (0)
{-# LINE 105 "System/Posix/Memory.hsc" #-}
        toProt MemoryProtectionRead    = (1)
{-# LINE 106 "System/Posix/Memory.hsc" #-}
        toProt MemoryProtectionWrite   = (2)
{-# LINE 107 "System/Posix/Memory.hsc" #-}
        toProt MemoryProtectionExecute = (4)
{-# LINE 108 "System/Posix/Memory.hsc" #-}

cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
cvalueOfMemorySync = foldl (.|.) 0 . map toSync
  where toSync MemorySyncAsync      = (1)
{-# LINE 112 "System/Posix/Memory.hsc" #-}
        toSync MemorySyncSync       = (4)
{-# LINE 113 "System/Posix/Memory.hsc" #-}
        toSync MemorySyncInvalidate = (2)
{-# LINE 114 "System/Posix/Memory.hsc" #-}

-- | Map pages of memory.
--
-- If fd is present, this memory will represent the file associated.
-- Otherwise, the memory will be an anonymous mapping.
--
-- use 'mmap'
memoryMap :: Maybe (Ptr a)      -- ^ The address to map to if MapFixed is used.
          -> CSize              -- ^ The length of the mapping
          -> [MemoryProtection] -- ^ the memory protection associated with the mapping
          -> MemoryMapFlag      -- ^ 
          -> Maybe Fd
          -> COff
          -> IO (Ptr a)
memoryMap initPtr sz prots flag mfd off =
    throwErrnoIf (== m1ptr) "mmap" (c_mmap (maybe nullPtr id initPtr) sz cprot cflags fd off)
  where m1ptr  = nullPtr `plusPtr` (-1)
        fd     = maybe (-1) (\(Fd v) -> v) mfd
        cprot  = cvalueOfMemoryProts prots
        cflags = maybe cMapAnon (const 0) mfd
             .|. maybe 0 (const cMapFixed) initPtr
             .|. toMapFlag flag

        cMapAnon  = (32)
{-# LINE 138 "System/Posix/Memory.hsc" #-}
        cMapFixed = (16)
{-# LINE 139 "System/Posix/Memory.hsc" #-}

        toMapFlag MemoryMapShared  = (1)
{-# LINE 141 "System/Posix/Memory.hsc" #-}
        toMapFlag MemoryMapPrivate = (2)
{-# LINE 142 "System/Posix/Memory.hsc" #-}

memoryUnmap :: Ptr a -> CSize -> IO ()
memoryUnmap ptr sz = throwErrnoIfMinus1_ "munmap" (c_munmap ptr sz)

-- | give advice to the operating system about use of memory
--
-- call 'madvise'
memoryAdvise :: Ptr a -> CSize -> MemoryAdvice -> IO ()
memoryAdvise ptr sz adv = throwErrnoIfMinus1_ "madvise" (c_madvise ptr sz cadv)
  where cadv = toAdvice adv

        toAdvice MemoryAdviceNormal = (0)
{-# LINE 154 "System/Posix/Memory.hsc" #-}
        toAdvice MemoryAdviceRandom = (1)
{-# LINE 155 "System/Posix/Memory.hsc" #-}
        toAdvice MemoryAdviceSequential = (2)
{-# LINE 156 "System/Posix/Memory.hsc" #-}
        toAdvice MemoryAdviceWillNeed = (3)
{-# LINE 157 "System/Posix/Memory.hsc" #-}
        toAdvice MemoryAdviceDontNeed = (4)
{-# LINE 158 "System/Posix/Memory.hsc" #-}

-- | lock a range of process address space
--
-- call 'mlock'
memoryLock :: Ptr a -> CSize -> IO ()
memoryLock ptr sz = throwErrnoIfMinus1_ "mlock" (c_mlock ptr sz)

-- | unlock a range of process address space
--
-- call 'munlock'
memoryUnlock :: Ptr a -> CSize -> IO ()
memoryUnlock ptr sz = throwErrnoIfMinus1_ "munlock" (c_munlock ptr sz)

-- | set protection of memory mapping
--
-- call 'mprotect'
memoryProtect :: Ptr a -> CSize -> [MemoryProtection] -> IO ()
memoryProtect ptr sz prots = throwErrnoIfMinus1_ "mprotect" (c_mprotect ptr sz cprot)
  where cprot = cvalueOfMemoryProts prots

-- | memorySync synchronize memory with physical storage.
--
-- On an anonymous mapping this function doesn't have any effect.
-- call 'msync'
memorySync :: Ptr a -> CSize -> [MemorySyncFlag] -> IO ()
memorySync ptr sz flags = throwErrnoIfMinus1_ "msync" (c_msync ptr sz cflags)
  where cflags = cvalueOfMemorySync flags

-- | Return the operating system page size.
-- 
-- call 'sysconf'
sysconfPageSize :: Int
sysconfPageSize = fromIntegral $ c_sysconf (30)
{-# LINE 191 "System/Posix/Memory.hsc" #-}