mirror of https://github.com/voidlizard/hbs2
Move bytestring-mmap inside repo and add compatiblity layer
This commit is contained in:
parent
86ce779306
commit
5e8dd6cd46
17
flake.lock
17
flake.lock
|
@ -1,21 +1,5 @@
|
|||
{
|
||||
"nodes": {
|
||||
"bytestring-mmap": {
|
||||
"flake": false,
|
||||
"locked": {
|
||||
"lastModified": 1727193872,
|
||||
"narHash": "sha256-L39kMCMry/BNJngt0+yvSIMnJJzWR9ZoyXbEyniEfwU=",
|
||||
"owner": "ivanovs-4",
|
||||
"repo": "bytestring-mmap",
|
||||
"rev": "f43e5e06718ed904487f17e7725c12098773c12f",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
"owner": "ivanovs-4",
|
||||
"repo": "bytestring-mmap",
|
||||
"type": "github"
|
||||
}
|
||||
},
|
||||
"db-pipe": {
|
||||
"inputs": {
|
||||
"haskell-flake-utils": [
|
||||
|
@ -294,7 +278,6 @@
|
|||
},
|
||||
"root": {
|
||||
"inputs": {
|
||||
"bytestring-mmap": "bytestring-mmap",
|
||||
"db-pipe": "db-pipe",
|
||||
"flake-utils": "flake-utils",
|
||||
"fuzzy": "fuzzy",
|
||||
|
|
16
flake.nix
16
flake.nix
|
@ -38,11 +38,6 @@ inputs = {
|
|||
flake = false;
|
||||
};
|
||||
|
||||
bytestring-mmap = {
|
||||
url = "github:ivanovs-4/bytestring-mmap";
|
||||
flake = false;
|
||||
};
|
||||
|
||||
};
|
||||
|
||||
outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
||||
|
@ -80,8 +75,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
|||
|
||||
defaultOverlay = final: prev:
|
||||
(prev.lib.composeManyExtensions
|
||||
[
|
||||
overlay
|
||||
[ overlay
|
||||
inputs.suckless-conf.overlays.default
|
||||
inputs.db-pipe.overlays.default
|
||||
]) final prev;
|
||||
|
@ -117,7 +111,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
|||
overrides = new: old: with pkgs.haskell.lib;
|
||||
{
|
||||
scotty = new.callHackage "scotty" "0.21" {};
|
||||
bytestring-mmap = jailbreakUnbreak old.bytestring-mmap; # old.callCabal2nix "bytestring-mmap" inputs.bytestring-mmap {};
|
||||
bytestring-mmap = old.callCabal2nix "bytestring-mmap" "${self}/miscellaneous/bytestring-mmap" {};
|
||||
skylighting-lucid = new.callHackage "skylighting-lucid" "1.0.4" { };
|
||||
wai-app-file-cgi = dontCoverage (dontCheck (jailbreakUnbreak old.wai-app-file-cgi));
|
||||
saltine = old.callCabal2nix "saltine" inputs.saltine { inherit (pkgs) libsodium; };
|
||||
|
@ -134,13 +128,11 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
|||
(_name: packagePostOverrides) # we can't apply overrides inside our overlay because it will remove linking info
|
||||
(pkgs.lib.getAttrs packageNames pkgs.haskellPackages);
|
||||
|
||||
# dynamic packages don't work at the moment, because
|
||||
# ivanovs-4/bytestring-mmap doesn't compile with ghc 9.4
|
||||
# and bytestring-mmap doesn't compire with ghc > 9.6
|
||||
packagesDynamic = makePackages pkgs;
|
||||
packagesStatic = makePackages pkgs.pkgsStatic;
|
||||
in {
|
||||
legacyPackages = pkgs;
|
||||
overlays.default = defaultOverlay;
|
||||
|
||||
packages =
|
||||
packagesDynamic //
|
||||
|
@ -157,7 +149,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
|
|||
};
|
||||
};
|
||||
|
||||
devShell.default = pkgs.haskellPackages.shellFor {
|
||||
devShells.default = pkgs.haskellPackages.shellFor {
|
||||
packages = _: pkgs.lib.attrsets.attrVals packageNames pkgs.haskellPackages;
|
||||
# withHoogle = true;
|
||||
buildInputs = (
|
||||
|
|
|
@ -0,0 +1,27 @@
|
|||
Copyright (c) Don Stewart
|
||||
|
||||
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 AUTHORS ``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.
|
|
@ -0,0 +1,2 @@
|
|||
Fork of https://hackage.haskell.org/package/bytestring-mmap since original repo
|
||||
is not available at http://code.haskell.org/~dons/code/bytestring-mmap/
|
|
@ -0,0 +1,3 @@
|
|||
#!/usr/bin/env runhaskell
|
||||
> import Distribution.Simple
|
||||
> main = defaultMain
|
|
@ -0,0 +1,114 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
--------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.IO.Posix.MMap
|
||||
-- Copyright : (c) Galois, Inc. 2007
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer: Don Stewart <dons@galois.com>
|
||||
-- Stability : provisional
|
||||
-- Portability: non-portable -- posix only
|
||||
--
|
||||
-- mmap a file or device into memory as a strict ByteString.
|
||||
--
|
||||
module System.IO.Posix.MMap (
|
||||
|
||||
-- $mmap_intro
|
||||
-- $mmap_unmap
|
||||
|
||||
-- * Memory mapped files
|
||||
unsafeMMapFile -- :: FilePath -> IO ByteString
|
||||
|
||||
-- $mmap_intro
|
||||
--
|
||||
-- 'unsafeMMapFile' mmaps a file or device into memory as a strict
|
||||
-- 'ByteString'. The file is not actually copied strictly into memory,
|
||||
-- but instead pages from the file will be loaded into the address
|
||||
-- space on demand.
|
||||
--
|
||||
-- We can consider mmap as lazy IO pushed into the virtual memory
|
||||
-- subsystem.
|
||||
--
|
||||
-- The file is mapped using MAP_SHARED: modifications to the file
|
||||
-- will be immediately shared with any other process accessing the
|
||||
-- file. This has no effect from the Haskell point of view, since
|
||||
-- ByteStrings are treated as immutable values.
|
||||
--
|
||||
-- However, if the file is written to by any other process on the
|
||||
-- system while it is in use in Haskell, those changes will be
|
||||
-- immediately reflected on the Haskell side, destroying referential
|
||||
-- transparency.
|
||||
--
|
||||
-- It is only safe to mmap a file if you know you are the sole user.
|
||||
--
|
||||
-- For more details about mmap, and its consequences, see:
|
||||
--
|
||||
-- * <http://opengroup.org/onlinepubs/009695399/functions/mmap.html>
|
||||
--
|
||||
-- * <http://www.gnu.org/software/libc/manual/html_node/Memory_002dmapped-I_002fO.html>
|
||||
--
|
||||
|
||||
-- $mmap_unmap
|
||||
--
|
||||
-- When the entire file is out of scope, the Haskell storage manager
|
||||
-- will call munmap to free the file, using a finaliser. Until then, as
|
||||
-- much of the file as you access will be allocated.
|
||||
--
|
||||
-- Note that the Haskell storage manager doesn't know how large a
|
||||
-- resource is associated with an mmapped file. If you allocate many
|
||||
-- such files, the garbage collector will only see the 'ForeignPtr's
|
||||
-- that have been allocated, not the corresponding ByteArrays. The
|
||||
-- result will be that the GC runs less often that you hoped, as it
|
||||
-- looks like only a few bytes have been allocated on the Haskell heap.
|
||||
--
|
||||
-- Use of 'performGC' or 'finalizeForeignPtr' when you know that
|
||||
-- the object is going out of scope can ensure that resources are
|
||||
-- released appropriately.
|
||||
--
|
||||
|
||||
) where
|
||||
|
||||
import System.IO.Posix.MMap.Internal
|
||||
|
||||
-- import System.IO
|
||||
-- import qualified System.IO as IO
|
||||
import Foreign.Ptr
|
||||
|
||||
import Control.Exception
|
||||
import Data.ByteString
|
||||
|
||||
import System.Posix hiding (openFd)
|
||||
import System.Posix.IO.Compat (openFd)
|
||||
|
||||
-- | The 'unsafeMMapFile' function maps a file or device into memory,
|
||||
-- returning a strict 'ByteString' that accesses the mapped file.
|
||||
-- If the mmap fails for some reason, an error is thrown.
|
||||
--
|
||||
-- Memory mapped files will behave as if they were read lazily --
|
||||
-- pages from the file will be loaded into memory on demand.
|
||||
--
|
||||
-- The storage manager is used to free the mapped memory. When
|
||||
-- the garbage collector notices there are no further references to the
|
||||
-- mapped memory, a call to munmap is made. It is not necessary to do
|
||||
-- this yourself. In tight memory situations, it may be profitable to
|
||||
-- use 'performGC' or 'finalizeForeignPtr' to force an unmap.
|
||||
--
|
||||
-- Note: this operation may break referential transparency! If
|
||||
-- any other process on the system changes the file when it is mapped
|
||||
-- into Haskell, the contents of your 'ByteString' will change.
|
||||
--
|
||||
unsafeMMapFile :: FilePath -> IO ByteString
|
||||
unsafeMMapFile f = do
|
||||
fd <- openFd f ReadOnly defaultFileFlags
|
||||
always (closeFd fd) $ do
|
||||
stat <- getFdStatus fd
|
||||
let size = fromIntegral (fileSize stat)
|
||||
if size <= 0
|
||||
then return empty -- BSD mmap won't accept a length of zero
|
||||
else do
|
||||
ptr <- c_mmap size (fromIntegral fd)
|
||||
if ptr == nullPtr
|
||||
then error "System.IO.Posix.MMap.mmapFile: unable to mmap file"
|
||||
else unsafePackMMapPtr ptr size
|
||||
|
||||
where always = flip finally
|
|
@ -0,0 +1,54 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
--------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.IO.Posix.MMap.Internal
|
||||
-- Copyright : (c) Galois, Inc. 2007
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer: Don Stewart <dons@galois.com>
|
||||
-- Stability : provisional
|
||||
-- Portability: non-portable -- posix only
|
||||
--
|
||||
-- Low level mmap access.
|
||||
--
|
||||
module System.IO.Posix.MMap.Internal (
|
||||
|
||||
-- * Converting an mmapped pointer to a 'ByteString'
|
||||
unsafePackMMapPtr, -- :: Ptr Word8 -> CSize -> IO ByteString
|
||||
|
||||
-- * Low level bindings
|
||||
c_mmap, -- :: CSize -> CInt -> IO (Ptr Word8)
|
||||
c_munmap -- :: Ptr Word8 -> CSize -> IO CInt
|
||||
|
||||
) where
|
||||
|
||||
import System.IO
|
||||
import qualified System.IO as IO
|
||||
import Foreign.C.Types
|
||||
import Foreign.Ptr
|
||||
import qualified Foreign.Concurrent as FC
|
||||
|
||||
import Control.Monad
|
||||
import Data.Word
|
||||
import Data.ByteString.Internal
|
||||
-- import Data.ByteString
|
||||
|
||||
-- | Create a bytestring from a memory mapped Ptr.
|
||||
-- A finalizer will be associated with the resource, that will call
|
||||
-- munmap when the storage manager detects that the resource is no longer
|
||||
-- in use.
|
||||
unsafePackMMapPtr :: Ptr Word8 -> CSize -> IO ByteString
|
||||
unsafePackMMapPtr p s = do
|
||||
fp <- FC.newForeignPtr p $ do
|
||||
v <- c_munmap p s
|
||||
when (v == -1) $ IO.hPutStrLn stderr $
|
||||
"System.IO.Posix.MMap: warning, failed to unmap "
|
||||
++ show s ++" bytes at "++show p
|
||||
return (fromForeignPtr fp 0 (fromIntegral s))
|
||||
{-# INLINE unsafePackMMapPtr #-}
|
||||
|
||||
foreign import ccall unsafe "hs_bytestring_mmap.h hs_bytestring_mmap"
|
||||
c_mmap :: CSize -> CInt -> IO (Ptr Word8)
|
||||
|
||||
foreign import ccall unsafe "hs_bytestring_mmap.h munmap"
|
||||
c_munmap :: Ptr Word8 -> CSize -> IO CInt
|
|
@ -0,0 +1,130 @@
|
|||
{-# LANGUAGE CPP, BangPatterns, ForeignFunctionInterface #-}
|
||||
--------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : System.IO.Posix.MMap
|
||||
-- Copyright : (c) Galois, Inc. 2007
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer: Don Stewart <dons@galois.com>
|
||||
-- Stability : provisional
|
||||
-- Portability: non-portable -- posix only
|
||||
--
|
||||
-- Lazy, chunk-wise memory mapping.
|
||||
--
|
||||
-- Memory map a file as a lazy ByteString. Finalisers are associated
|
||||
-- cached-sized portions of the file, which will be deallocated as
|
||||
-- those chunks go out of scope.
|
||||
--
|
||||
-- Unlike strict Bytestrings, mmapFile for Lazy ByteStrings will
|
||||
-- deallocate chunks of the file.
|
||||
--
|
||||
-- The storage manager is used to free chunks of the mapped memory. When
|
||||
-- the garbage collector notices there are no further references to
|
||||
-- a chunk, a call to munmap is made.
|
||||
--
|
||||
-- In effect, the file is mmapped once, lazily, then covered with finalizers
|
||||
-- for each chunk. When any chunk goes out of scope, that part is
|
||||
-- deallocated. We must allocate the spine of the structure strictly
|
||||
-- though, to ensure finalizers are registered for the entire file.
|
||||
--
|
||||
-- The Haskell garbage collector decides when to run based on heap
|
||||
-- pressure, however the mmap stores memory outside the Haskell heap,
|
||||
-- so those resources are not counted when deciding to run the garbage
|
||||
-- collect. The result is that finalizers run less often than you might
|
||||
-- expect, and it is possible to write a lazy bytestring mmap program
|
||||
-- that never deallocates (and thus doesn't run in constant space).
|
||||
-- 'performGC' or 'finalizerForeignPtr' can be used to trigger collection
|
||||
-- at sensible points.
|
||||
--
|
||||
-- Note: this operation may break referential transparency! If
|
||||
-- any other process on the system changes the file when it is mapped
|
||||
-- into Haskell, the contents of your 'ByteString' will change.
|
||||
--
|
||||
module System.IO.Posix.MMap.Lazy (
|
||||
|
||||
unsafeMMapFile -- :: FilePath -> IO ByteString
|
||||
|
||||
) where
|
||||
|
||||
import System.IO.Posix.MMap.Internal
|
||||
|
||||
-- import System.IO
|
||||
import Foreign.C.Types
|
||||
import Foreign.Ptr
|
||||
-- import Control.Monad
|
||||
|
||||
import Control.Exception
|
||||
import Data.Word
|
||||
import Data.ByteString.Lazy.Internal
|
||||
|
||||
import System.Posix hiding (openFd)
|
||||
import System.Posix.IO.Compat (openFd)
|
||||
|
||||
--
|
||||
-- | The 'unsafeMMapFile' function maps a file or device into memory as
|
||||
-- a lazy ByteString, made of 64*pagesize unmappable chunks of bytes.
|
||||
--
|
||||
-- Memory mapped files will behave as if they were read lazily --
|
||||
-- pages from the file will be loaded into memory on demand.
|
||||
--
|
||||
-- The storage manager is used to free chunks that go out of scope,
|
||||
-- and unlike strict bytestrings, memory mapped lazy ByteStrings will
|
||||
-- be deallocated in chunks (so you can write traversals that run in
|
||||
-- constant space).
|
||||
--
|
||||
-- However, the size of the mmapped resource is not known by the Haskell
|
||||
-- GC, it appears only as a small ForeignPtr. This means that the
|
||||
-- Haskell GC may not not run as often as you'd like, leading to delays
|
||||
-- in unmapping chunks.
|
||||
--
|
||||
-- Appropriate use of performGC or finalizerForeignPtr may be required
|
||||
-- to ensure deallocation, as resources allocated by mmap are not
|
||||
-- tracked by the Haskell garbage collector.
|
||||
--
|
||||
-- For example, when writing out a lazy bytestring allocated with mmap,
|
||||
-- you may wish to finalizeForeignPtr when each chunk is written, as the
|
||||
-- chunk goes out of scope, rather than relying on the garbage collector
|
||||
-- to notice the chunk has gone.
|
||||
--
|
||||
-- This operation is unsafe: if the file is written to by any other
|
||||
-- process on the system, the 'ByteString' contents will change in
|
||||
-- Haskell.
|
||||
--
|
||||
unsafeMMapFile :: FilePath -> IO ByteString
|
||||
unsafeMMapFile path = do
|
||||
fd <- openFd path ReadOnly defaultFileFlags
|
||||
always (closeFd fd) $ do
|
||||
stat <- getFdStatus fd
|
||||
let size = fromIntegral (fileSize stat)
|
||||
ptr <- c_mmap size (fromIntegral fd)
|
||||
if ptr == nullPtr
|
||||
then error "System.IO.Posix.MMap.Lazy: unable to mmap file!"
|
||||
else chunks chunk_size ptr (fromIntegral size)
|
||||
where
|
||||
always = flip finally
|
||||
|
||||
-- must be page aligned.
|
||||
chunk_size = 64 * fromIntegral pagesize -- empircally derived
|
||||
|
||||
--
|
||||
-- Break the file up into chunks.
|
||||
-- Have separate munmap finalizers for each chunk.
|
||||
--
|
||||
chunks :: CSize -> Ptr Word8 -> CSize -> IO ByteString
|
||||
chunks chunk_size p bytes = loop p bytes
|
||||
#ifndef __HADDOCK__
|
||||
where
|
||||
loop !ptr !rest
|
||||
| rest <= 0 = return Empty
|
||||
| otherwise = let s = min chunk_size rest
|
||||
ptr' = ptr `plusPtr` fromIntegral s
|
||||
rest' = rest - s
|
||||
in do c <- unsafePackMMapPtr ptr s
|
||||
cs <- loop ptr' rest' -- need to be strict
|
||||
return (chunk c cs) -- to ensure we cover the whole file
|
||||
-- with finalizers
|
||||
#endif
|
||||
|
||||
foreign import ccall unsafe "unistd.h getpagesize"
|
||||
pagesize :: CInt
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
module System.Posix.IO.Compat where
|
||||
|
||||
import qualified System.Posix as Unix
|
||||
|
||||
|
||||
openFd :: FilePath -> Unix.OpenMode -> Unix.OpenFileFlags -> IO Unix.Fd
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
openFd = Unix.openFd
|
||||
#else
|
||||
openFd file openMode = Unix.openFd file openMode Nothing
|
||||
#endif
|
|
@ -0,0 +1,42 @@
|
|||
name: bytestring-mmap
|
||||
version: 0.2.3
|
||||
synopsis: mmap support for strict ByteStrings
|
||||
description:
|
||||
.
|
||||
This library provides a wrapper to mmap(2), allowing files or
|
||||
devices to be lazily loaded into memory as strict or lazy
|
||||
ByteStrings, using the virtual memory subsystem to do on-demand
|
||||
loading.
|
||||
.
|
||||
category: System
|
||||
homepage: http://code.haskell.org/~dons/code/bytestring-mmap/
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Don Stewart
|
||||
maintainer: Don Stewart <dons00@gmail.com>
|
||||
build-type: Simple
|
||||
cabal-version: >= 1.2
|
||||
|
||||
flag split-base
|
||||
description: Choose the new smaller, split-up base package.
|
||||
|
||||
library
|
||||
build-depends: unix
|
||||
if flag(split-base)
|
||||
build-depends: base >= 3 && < 6, bytestring >= 0.9
|
||||
else
|
||||
build-depends: base < 3
|
||||
extensions: CPP, ForeignFunctionInterface, BangPatterns
|
||||
|
||||
exposed-modules: System.IO.Posix.MMap
|
||||
System.IO.Posix.MMap.Lazy
|
||||
System.IO.Posix.MMap.Internal
|
||||
|
||||
other-modules: System.Posix.IO.Compat
|
||||
|
||||
ghc-options: -Wall -O2
|
||||
|
||||
c-sources: cbits/hs_bytestring_mmap.c
|
||||
include-dirs: include
|
||||
includes: hs_bytestring_mmap.h
|
||||
install-includes: hs_bytestring_mmap.h
|
|
@ -0,0 +1,22 @@
|
|||
/*
|
||||
* hs_bytestring_mmap.c
|
||||
*
|
||||
* License : BSD3
|
||||
*
|
||||
* Copyright (C) 2003 David Roundy
|
||||
* 2005-7 Don Stewart
|
||||
*
|
||||
* Maintainer: Don Stewart <dons@galois.com>
|
||||
*/
|
||||
#include "hs_bytestring_mmap.h"
|
||||
|
||||
/*
|
||||
* mmap len bytes from fd into memory, read only.
|
||||
*/
|
||||
unsigned char *hs_bytestring_mmap(size_t len, int fd) {
|
||||
void *result = mmap(0, len, PROT_READ, MAP_SHARED, fd, 0);
|
||||
if (result == MAP_FAILED)
|
||||
return (unsigned char *)0;
|
||||
else
|
||||
return (unsigned char *)result;
|
||||
}
|
|
@ -0,0 +1,15 @@
|
|||
/*
|
||||
* hs_bytestring_mmap.h
|
||||
*
|
||||
* License : BSD3
|
||||
*
|
||||
* Copyright (C) 2003 David Roundy
|
||||
* 2005-7 Don Stewart
|
||||
*
|
||||
* Maintainer: Don Stewart <dons@galois.com>
|
||||
*/
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/mman.h>
|
||||
|
||||
unsigned char *hs_bytestring_mmap(size_t len, int fd);
|
|
@ -0,0 +1,22 @@
|
|||
import qualified Data.ByteString.Lazy as L
|
||||
import System.IO.Posix.MMap.Lazy
|
||||
import Control.Monad
|
||||
import Text.Printf
|
||||
import System.Mem
|
||||
|
||||
main = do
|
||||
s <- unsafeMMapFile "/usr/obj/data/1G"
|
||||
go 0 s
|
||||
where
|
||||
go n s
|
||||
| L.null s = return ()
|
||||
| otherwise
|
||||
= do -- printf "%d\n"
|
||||
L.head s `seq` return ()
|
||||
when (n `mod` 1000 == 0) $ do
|
||||
performGC -- tune this value for when to run the GC
|
||||
go (n+1) (L.drop 4096 s)
|
||||
|
||||
|
||||
-- forM_ [0, (1024) .. L.length s-1] $ \n -> do
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
import qualified Data.ByteString as S
|
||||
import System.IO.Posix.MMap
|
||||
import Control.Monad
|
||||
import Text.Printf
|
||||
|
||||
main = do
|
||||
s <- unsafeMMapFile "/usr/obj/data/1G"
|
||||
print "This program should touch only 1 page per 100k"
|
||||
|
||||
forM_ [0, (1024) .. S.length s-1] $ \n -> do
|
||||
printf "n=%d := %d\n" n (S.index s n)
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
-- A non-copying cp based on mmap.
|
||||
|
||||
import System.IO.Posix.MMap
|
||||
import qualified Data.ByteString as S
|
||||
|
||||
import Text.Printf
|
||||
import Control.Exception
|
||||
import System.CPUTime
|
||||
import System.Cmd
|
||||
import System.Directory
|
||||
|
||||
import System.Environment
|
||||
|
||||
time :: IO t -> IO t
|
||||
time a = do
|
||||
start <- getCPUTime
|
||||
v <- a
|
||||
v `seq` return ()
|
||||
end <- getCPUTime
|
||||
let diff = (fromIntegral (end - start)) / (10^12)
|
||||
printf "Computation time: %0.3f sec\n" (diff :: Double)
|
||||
return v
|
||||
|
||||
main = do
|
||||
[f] <- getArgs
|
||||
|
||||
putStrLn "mmap copy"
|
||||
time $ S.writeFile "file-1" =<< unsafeMMapFile f
|
||||
putChar '\n'
|
||||
|
||||
putStrLn "lazy copy"
|
||||
time $ S.writeFile "file-2" =<< S.readFile f
|
||||
putChar '\n'
|
||||
|
||||
system $ "diff " ++ "file-1 " ++ "file-2"
|
||||
removeFile "file-1"
|
||||
removeFile "file-2"
|
|
@ -0,0 +1,29 @@
|
|||
import qualified System.IO.Posix.MMap.Lazy as L
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.ByteString.Lazy.Internal as L
|
||||
import qualified Data.ByteString.Internal as S
|
||||
import qualified Data.ByteString as S
|
||||
|
||||
import Foreign.ForeignPtr
|
||||
import System.Environment
|
||||
import System.IO
|
||||
import Control.Exception
|
||||
|
||||
main = do
|
||||
[f,g] <- getArgs
|
||||
writeFile' g =<< L.unsafeMMapFile f
|
||||
|
||||
--
|
||||
-- An implementation of writeFile for bytestrings that
|
||||
-- that finalises chunks as they go out the door.
|
||||
--
|
||||
writeFile' :: FilePath -> L.ByteString -> IO ()
|
||||
writeFile' f txt = bracket (openBinaryFile f WriteMode) hClose (\hdl -> hPut hdl txt)
|
||||
|
||||
hPut :: Handle -> L.ByteString -> IO ()
|
||||
hPut h cs = L.foldrChunks (\chunk rest -> do S.hPut h chunk
|
||||
unmap chunk
|
||||
rest)
|
||||
(return ()) cs
|
||||
|
||||
where unmap c = finalizeForeignPtr fp where (fp,_,_) = S.toForeignPtr c
|
|
@ -0,0 +1,46 @@
|
|||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import System.IO.Posix.MMap
|
||||
import qualified System.IO.Posix.MMap.Lazy as LM
|
||||
|
||||
import System.Directory
|
||||
import System.Posix.Files
|
||||
import System.IO
|
||||
import System.FilePath
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
import Text.Printf
|
||||
import System.Cmd
|
||||
import System.Exit
|
||||
import System.Mem
|
||||
import Control.Exception
|
||||
|
||||
main = do
|
||||
print "Testing Lazy.mmap == Strict.mmap == Strict.ByteString.readFile"
|
||||
system "find /home/dons/ghc/ -type f > files_to_read"
|
||||
always (removeFile "files_to_read") $ do
|
||||
fs <- lines <$> readFile "files_to_read"
|
||||
|
||||
{-
|
||||
ss <- getDirectoryContents dir
|
||||
fs <- filterM (\f -> do st <- getFileStatus (dir </> f)
|
||||
return (not $ isDirectory st)) ss
|
||||
-}
|
||||
|
||||
printf "Comparing %d files\n" (length fs)
|
||||
forM_ (zip [1..] fs) $ \(i,f) -> do
|
||||
t <- eq f
|
||||
if t
|
||||
then when (i `mod` 1000 == 0) $ putStr "Ok. " >> hFlush stdout
|
||||
else exitWith (ExitFailure 1)
|
||||
|
||||
print "All good."
|
||||
|
||||
where
|
||||
always = flip finally
|
||||
|
||||
eq f = do
|
||||
m <- unsafeMMapFile f
|
||||
lm <- LM.unsafeMMapFile f
|
||||
s <- S.readFile f
|
||||
return (m == s && L.fromChunks [m] == lm)
|
|
@ -0,0 +1,32 @@
|
|||
-- A non-copying cp based on mmap.
|
||||
|
||||
import System.IO.Posix.MMap
|
||||
import Control.Monad
|
||||
import System.Mem
|
||||
import qualified Data.ByteString as S
|
||||
import Text.Printf
|
||||
import Control.Exception
|
||||
import System.CPUTime
|
||||
|
||||
main = do
|
||||
|
||||
--should run in constant space, and be faster:
|
||||
time $ forM_ [0..1000] $ \_ -> do
|
||||
unsafeMMapFile "/usr/share/dict/words"
|
||||
|
||||
putStrLn "\nShould be faster than:\n"
|
||||
|
||||
--should run in constant space:
|
||||
time $ forM_ [0..1000] $ \_ -> do
|
||||
S.readFile "/usr/share/dict/words"
|
||||
|
||||
|
||||
time :: IO t -> IO t
|
||||
time a = do
|
||||
start <- getCPUTime
|
||||
v <- a
|
||||
v `seq` return ()
|
||||
end <- getCPUTime
|
||||
let diff = (fromIntegral (end - start)) / (10^12)
|
||||
printf "Computation time: %0.3f sec\n" (diff :: Double)
|
||||
return v
|
|
@ -0,0 +1,15 @@
|
|||
import System.Directory
|
||||
import System.IO.Posix.MMap
|
||||
import System.Posix.Files
|
||||
import System.FilePath
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
|
||||
main = do
|
||||
-- let dir = "/home/dons/lambdabot/_darcs/patches"
|
||||
-- ss <- getDirectoryContents dir
|
||||
-- fs <- filterM (\f -> do st <- getFileStatus (dir </> f)
|
||||
-- return (not $ isDirectory st)) ss
|
||||
|
||||
fs <- lines <$> readFile "/tmp/files"
|
||||
mapM_ unsafeMMapFile fs
|
|
@ -0,0 +1,19 @@
|
|||
#!/bin/sh
|
||||
|
||||
set -e
|
||||
|
||||
compile="ghc -no-recomp -O --make "
|
||||
|
||||
$compile files.hs && ./files
|
||||
rm files
|
||||
|
||||
$compile cp.hs && ./cp /usr/share/dict/cracklib-small ./words
|
||||
rm cp
|
||||
|
||||
$compile pressure.hs && ./pressure
|
||||
|
||||
#big-lazy.hs
|
||||
#big.hs
|
||||
#fast-cp.hs
|
||||
#pressure.hs
|
||||
#small.hs
|
Loading…
Reference in New Issue