unix-memory (empty) → 0.1.0
raw patch · 6 files changed
+333/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, mtl, test-framework, test-framework-hunit, test-framework-quickcheck2, unix, unix-memory
Files
- LICENSE +27/−0
- README.md +13/−0
- Setup.hs +2/−0
- System/Posix/Memory.hsc +190/−0
- tests/Tests.hs +61/−0
- unix-memory.cabal +40/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2013 Vincent Hanquez <vincent@snarc.org>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,13 @@+unix-memory+===========++Provide access to lowlevel syscalls for memory mapping. typically mmap, munmap, msync, mlock, mprotect, ..++Documentation: [unix-memory on hackage](http://hackage.haskell.org/package/unix-memory)++The goal is to fold the System.Posix.Memory module in the unix package. As the unix package+is tied to ghc, it's not convenient to upgrade the package, so this package can act as a+test ground, and a compatility module for older unix version.++Portability is inherently difficult, but the goal is to support every unixoid (Linux, BSD, MacOSX)+that have mmap style functions. Bug reports and pull requests to improve portability more than welcome.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ System/Posix/Memory.hsc view
@@ -0,0 +1,190 @@+-----------------------------------------------------------------------------+-- |+-- 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.+--+-----------------------------------------------------------------------------++#include <sys/mman.h>+#include <unistd.h>++{-# 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 = (#const PROT_NONE)+ toProt MemoryProtectionRead = (#const PROT_READ)+ toProt MemoryProtectionWrite = (#const PROT_WRITE)+ toProt MemoryProtectionExecute = (#const PROT_EXEC)++cvalueOfMemorySync :: [MemorySyncFlag] -> CInt+cvalueOfMemorySync = foldl (.|.) 0 . map toSync+ where toSync MemorySyncAsync = (#const MS_ASYNC)+ toSync MemorySyncSync = (#const MS_SYNC)+ toSync MemorySyncInvalidate = (#const MS_INVALIDATE)++-- | 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 = (#const MAP_ANONYMOUS)+ cMapFixed = (#const MAP_FIXED)++ toMapFlag MemoryMapShared = (#const MAP_SHARED)+ toMapFlag MemoryMapPrivate = (#const MAP_PRIVATE)++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 = (#const MADV_NORMAL)+ toAdvice MemoryAdviceRandom = (#const MADV_RANDOM)+ toAdvice MemoryAdviceSequential = (#const MADV_SEQUENTIAL)+ toAdvice MemoryAdviceWillNeed = (#const MADV_WILLNEED)+ toAdvice MemoryAdviceDontNeed = (#const MADV_DONTNEED)++-- | 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 (#const _SC_PAGESIZE)
+ tests/Tests.hs view
@@ -0,0 +1,61 @@+module Main where++import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Test.QuickCheck.Monadic (monadicIO, run)++import System.Posix.IO+import System.Posix.Memory++import Control.Monad+import Control.Exception (bracket)++import Foreign.C.Types+import Foreign.Storable++import Data.Word++psz :: CSize+psz = fromIntegral sysconfPageSize++-- create an anonymous private mapping of page-size size.+withDummyMapping f = do+ bracket (memoryMap Nothing psz [MemoryProtectionRead,MemoryProtectionWrite] MemoryMapPrivate Nothing 0)+ (\mem -> memoryUnmap mem psz)+ f++withDevZeroMapping f = withOpenFd "/dev/zero" $ \fd ->+ bracket (memoryMap Nothing psz [MemoryProtectionRead,MemoryProtectionWrite] MemoryMapPrivate (Just fd) 0)+ (\mem -> memoryUnmap mem psz)+ f+ where withOpenFd filename g = do + bracket (openFd filename ReadWrite Nothing defaultFileFlags)+ closeFd+ g++tests :: [Test]+tests =+ [ testProperty "page-size" $ sysconfPageSize > 0 && sysconfPageSize < (2^(20::Int))+ , testGroup "anonymous" $ runTestWithMapping withDummyMapping+ , testGroup "fd" $ runTestWithMapping withDevZeroMapping+ ]+ where runTestWithMapping mapF =+ [ testProperty "mmap-munmap" $ monadicIO $ run $ mapF $ \_ -> return True+ , testProperty "madvise" $ monadicIO $ run $ mapF $ \ptr ->+ memoryAdvise ptr psz MemoryAdviceRandom >> return True+ , testProperty "msync" $ monadicIO $ run $ mapF $ \ptr ->+ memorySync ptr psz [MemorySyncAsync] >> return True+ , testProperty "mlock-munlock" $ monadicIO $ run $ mapF $ \ptr -> do+ memoryLock ptr psz+ memoryUnlock ptr psz+ return True+ , testProperty "read" $ monadicIO $ run $ mapF $ \ptr -> do+ res <- forM [0..(sysconfPageSize-1)] $ \off -> do+ b <- peekElemOff ptr off :: IO Word8+ return (b == 0)+ return $ and res+ ]++main :: IO ()+main = defaultMain tests
+ unix-memory.cabal view
@@ -0,0 +1,40 @@+Name: unix-memory+Version: 0.1.0+Synopsis: Unix memory syscalls+Description: unix memory syscalls (mmap, munmap, madvise, msync, mlock)+License: BSD3+License-file: LICENSE+Copyright: Vincent Hanquez <vincent@snarc.org>+Author: Vincent Hanquez <vincent@snarc.org>+Maintainer: vincent@snarc.org+Category: System+Stability: experimental+Build-Type: Simple+Homepage: http://github.com/vincenthz/hs-unix-memory+Cabal-Version: >=1.8+data-files: README.md++Library+ Exposed-modules: System.Posix.Memory+ Build-depends: base >= 4 && < 5+ , unix+ ghc-options: -Wall -fwarn-tabs++Test-Suite test-memorymap+ type: exitcode-stdio-1.0+ hs-source-dirs: tests+ Main-is: Tests.hs+ Build-Depends: base >= 3 && < 5+ , mtl+ , QuickCheck >= 2+ , HUnit+ , test-framework+ , test-framework-quickcheck2+ , test-framework-hunit+ , unix+ , unix-memory+ ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures++source-repository head+ type: git+ location: git://github.com/vincenthz/hs-unix-memory