1 files changed, 50 insertions, 0 deletions
diff --git a/src/Mmap.hs b/src/Mmap.hs
new file mode 100644
index 0000000..bfe6042
--- /dev/null
+++ b/src/Mmap.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+module Mmap where
+
+import Control.Exception
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Unsafe as BS
+import Foreign
+import Foreign.C.Types
+import System.Posix.IO
+import System.Posix.Types
+
+foreign import ccall "ircbrowse_mmap"
+  c_mmap :: CInt -> Ptr CSize -> IO (Ptr Word8)
+  --        fd      out length
+
+foreign import ccall "ircbrowse_munmap"
+  c_munmap :: Ptr Word8 -> CSize -> IO ()
+  --          addr         length
+
+mapFile :: FilePath -> IO ByteString
+mapFile path = mask_ $ do
+  -- open can fail without repercussions
+  Fd fd <- openFd path ReadOnly defaultFileFlags
+
+  -- do the mmap; if it fails, close the file, ignoring exceptions there
+  (addr, filelen) <-
+    catchNoPropagate @SomeException
+      (alloca $ \lengthp -> do
+        addr <- c_mmap fd lengthp
+        lengthval <- peek lengthp
+        return (addr, lengthval))
+      (\e -> do
+          catch @SomeException (closeFd (Fd fd))
+            (\_ -> return ())
+          rethrowIO e)
+
+  -- mmap succeeded, close the file
+  catchNoPropagate @SomeException (closeFd (Fd fd))
+    (\e -> do
+      -- putStrLn ("[munmap " ++ show addr ++ " as close(2) handler]")
+      c_munmap addr filelen
+      rethrowIO e)
+
+  -- close succeeded, we're safe now since bytestring construction will not
+  -- fail (and no exceptions are coming from outside as we're masked)
+  if addr == nullPtr
+    then fail "mapFile: could not mmap"
+    else BS.unsafePackCStringFinalizer addr (fromIntegral @CSize @Int filelen)
+            (do -- putStrLn ("[munmap " ++ show addr ++ "]")
+                c_munmap addr filelen)