    {-# LINE 1 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Foundation.Foreign.MemoryMap.Posix
    -- 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.
    --
    -----------------------------------------------------------------------------

    {-# LANGUAGE ForeignFunctionInterface #-}
    {-# LANGUAGE CPP #-}
    module Foundation.Foreign.MemoryMap.Posix
        ( memoryMap
        , memoryUnmap
        , memoryAdvise
        , memoryLock
        , memoryUnlock
        , memoryProtect
        , memorySync
        -- * Flags types
        , MemoryMapFlag(..)
        , MemoryProtection(..)
        , MemoryAdvice(..)
        , MemorySyncFlag(..)
        -- * system page size
        , sysconfPageSize
        -- * High level
        , fileMapRead
        ) where

    import Basement.Compat.Base
    import Basement.Compat.C.Types
    import Basement.Types.OffsetSize
    import System.Posix.Types
    import Foreign.Ptr
    import Foreign.C.Error
    import Data.Bits

    import Foundation.Collection.Foldable
    import Foundation.VFS
    import qualified Prelude (fromIntegral)
    import Foundation.Foreign.MemoryMap.Types
    import Control.Exception

    import           GHC.IO.FD
    import           GHC.IO.IOMode
    import qualified GHC.IO.Device as IO

    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

    {-# LINE 69 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
    foreign import ccall unsafe "posix_madvise"
        c_madvise :: Ptr a -> CSize -> CInt -> IO CInt

    {-# LINE 75 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    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

    {-# LINE 83 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
    foreign import ccall unsafe "mlock"
        c_mlock :: Ptr a -> CSize -> IO CInt

    {-# LINE 89 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    {-# LINE 91 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
    foreign import ccall unsafe "munlock"
        c_munlock :: Ptr a -> CSize -> IO CInt

    {-# LINE 97 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    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,Eq)

    -- | Memory protection
    data MemoryProtection =
          MemoryProtectionNone
        | MemoryProtectionRead
        | MemoryProtectionWrite
        | MemoryProtectionExecute
        deriving (Show,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,Eq)

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

    cvalueOfMemoryProts :: [MemoryProtection] -> CInt
    cvalueOfMemoryProts = foldl' (.|.) 0 . fmap toProt
      where toProt :: MemoryProtection -> CInt
            toProt MemoryProtectionNone    = (0)
    {-# LINE 137 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toProt MemoryProtectionRead    = (1)
    {-# LINE 138 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toProt MemoryProtectionWrite   = (2)
    {-# LINE 139 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toProt MemoryProtectionExecute = (4)
    {-# LINE 140 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    cvalueOfMemorySync :: [MemorySyncFlag] -> CInt
    cvalueOfMemorySync = foldl' (.|.) 0 . fmap toSync
      where toSync MemorySyncAsync      = (1)
    {-# LINE 144 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toSync MemorySyncSync       = (4)
    {-# LINE 145 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toSync MemorySyncInvalidate = (2)
    {-# LINE 146 "Foundation/Foreign/MemoryMap/Posix.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

    {-# LINE 172 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            cMapAnon  = (32)
    {-# LINE 173 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    {-# LINE 174 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            cMapFixed = (16)
    {-# LINE 175 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

            toMapFlag MemoryMapShared  = (1)
    {-# LINE 177 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toMapFlag MemoryMapPrivate = (2)
    {-# LINE 178 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    -- | Unmap pages of memory
    --
    -- use 'munmap'
    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

    {-# LINE 192 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toAdvice MemoryAdviceNormal = (0)
    {-# LINE 193 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toAdvice MemoryAdviceRandom = (1)
    {-# LINE 194 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toAdvice MemoryAdviceSequential = (2)
    {-# LINE 195 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toAdvice MemoryAdviceWillNeed = (3)
    {-# LINE 196 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}
            toAdvice MemoryAdviceDontNeed = (4)
    {-# LINE 197 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    {-# LINE 204 "Foundation/Foreign/MemoryMap/Posix.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 does not 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 = Prelude.fromIntegral $ c_sysconf (30)
    {-# LINE 237 "Foundation/Foreign/MemoryMap/Posix.hsc" #-}

    --------------------------------------------------------------------------------

    fileSizeToCSize :: FileSize -> CSize
    fileSizeToCSize (FileSize sz) = Prelude.fromIntegral sz

    fileSizeFromInteger :: Integer -> FileSize
    fileSizeFromInteger = FileSize . Prelude.fromIntegral

    fileMapRead :: FileMapReadF
    fileMapRead fp = bracket (openFile (filePathToLString fp) ReadMode True) (IO.close . fst) $ \(fd,_) -> do
        sz   <- fileSizeFromInteger `fmap` IO.getSize fd
        let csz = fileSizeToCSize sz
        p    <- memoryMap Nothing csz [MemoryProtectionRead] MemoryMapPrivate (Just $ Fd $ fdFD fd) 0
        return $ FileMapping p sz (memoryUnmap p csz)