{-# LINE 1 "libraries\\Win32\\System\\Win32\\FileMapping.hsc" #-}
{-# LINE 2 "libraries\\Win32\\System\\Win32\\FileMapping.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "libraries\\Win32\\System\\Win32\\FileMapping.hsc" #-}
module System.Win32.FileMapping
( mapFile
, MappedObject(..)
, withMappedFile
, withMappedArea
, ProtectSectionFlags
, sEC_COMMIT
, sEC_IMAGE
, sEC_NOCACHE
, sEC_RESERVE
, FileMapAccess
, fILE_MAP_ALL_ACCESS
, fILE_MAP_COPY
, fILE_MAP_READ
, fILE_MAP_WRITE
, fILE_SHARE_WRITE
, createFileMapping
, openFileMapping
, mapViewOfFileEx
, mapViewOfFile
, unmapViewOfFile
) where
import System.Win32.FileMapping.Internal
import System.Win32.Types ( HANDLE, BOOL, SIZE_T, withTString
, failIf, failIfNull, DDWORD, ddwordToDwords
, iNVALID_HANDLE_VALUE )
import System.Win32.Mem
import System.Win32.File
import System.Win32.Info
import Control.Exception ( mask_, bracket )
import Foreign ( Ptr, nullPtr, plusPtr, maybeWith
, ForeignPtr, newForeignPtr )
#include "windows_cconv.h"
mapFile :: FilePath -> IO (ForeignPtr a, Int)
mapFile path = do
bracket
(createFile path gENERIC_READ fILE_SHARE_READ Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing)
(closeHandle)
$ \fh -> bracket
(createFileMapping (Just fh) pAGE_READONLY 0 Nothing)
(closeHandle)
$ \fm -> do
fi <- getFileInformationByHandle fh
fp <- mask_ $ do
ptr <- mapViewOfFile fm fILE_MAP_READ 0 0
newForeignPtr c_UnmapViewOfFileFinaliser ptr
return (fp, fromIntegral $ bhfiSize fi)
withMappedFile
:: FilePath
-> Bool
-> Maybe Bool
-> (Integer -> MappedObject -> IO a)
-> IO a
withMappedFile path write share act =
bracket
(createFile path access share' Nothing oPEN_EXISTING fILE_ATTRIBUTE_NORMAL Nothing)
(closeHandle)
$ \fh -> bracket
(createFileMapping (Just fh) page 0 Nothing)
(closeHandle)
$ \fm -> do
bhfi <- getFileInformationByHandle fh
act (fromIntegral $ bhfiSize bhfi) (MappedObject fh fm mapaccess)
where
access = if write then gENERIC_READ+gENERIC_WRITE else gENERIC_READ
page = if write then pAGE_READWRITE else pAGE_READONLY
mapaccess = if write then fILE_MAP_ALL_ACCESS else fILE_MAP_READ
share' = case share of
Nothing -> fILE_SHARE_NONE
Just False -> fILE_SHARE_READ
Just True -> fILE_SHARE_READ + fILE_SHARE_WRITE
withMappedArea
:: MappedObject
-> Integer
-> Int
-> (Ptr a -> IO b)
-> IO b
withMappedArea (MappedObject _ mh access) pos size act = do
si <- getSystemInfo
let gran = fromIntegral $ siAllocationGranularity si
(blocks, offset) = divMod pos gran
start = blocks*gran
size' = fromIntegral $ size + fromIntegral (pos - start)
bracket
(mapViewOfFileEx mh access (fromIntegral start) size' nullPtr)
(unmapViewOfFile)
(act . flip plusPtr (fromIntegral offset))
createFileMapping :: Maybe HANDLE -> ProtectFlags -> DDWORD -> Maybe String -> IO HANDLE
createFileMapping mh flags mosize name =
maybeWith withTString name $ \c_name ->
failIf (==nullPtr) "createFileMapping: CreateFileMapping" $ c_CreateFileMapping handle nullPtr flags moshi moslow c_name
where
(moshi,moslow) = ddwordToDwords mosize
handle = maybe iNVALID_HANDLE_VALUE id mh
openFileMapping :: FileMapAccess -> BOOL -> Maybe String -> IO HANDLE
openFileMapping access inherit name =
maybeWith withTString name $ \c_name ->
failIf (==nullPtr) "openFileMapping: OpenFileMapping" $
c_OpenFileMapping access inherit c_name
mapViewOfFileEx :: HANDLE -> FileMapAccess -> DDWORD -> SIZE_T -> Ptr a -> IO (Ptr b)
mapViewOfFileEx h access offset size base =
failIfNull "mapViewOfFile(Ex): c_MapViewOfFileEx" $
c_MapViewOfFileEx h access ohi olow size base
where
(ohi,olow) = ddwordToDwords offset
mapViewOfFile :: HANDLE -> FileMapAccess -> DDWORD -> SIZE_T -> IO (Ptr a)
mapViewOfFile h a o s = mapViewOfFileEx h a o s nullPtr
unmapViewOfFile :: Ptr a -> IO ()
unmapViewOfFile v = c_UnmapViewOfFile v >> return ()