From 2d01ddf9bffb7be441e2cf1c7071240148839ab5 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 26 Oct 2018 03:52:01 -0400 Subject: Reorganizing layers. --- haskell/Data/Primitive/ByteArray/Util.hs | 21 ++++++++++++ haskell/Data/VCDIFF.hsc | 56 +++++--------------------------- xdelta.cabal | 1 + 3 files changed, 31 insertions(+), 47 deletions(-) diff --git a/haskell/Data/Primitive/ByteArray/Util.hs b/haskell/Data/Primitive/ByteArray/Util.hs index 1776286..de944e7 100644 --- a/haskell/Data/Primitive/ByteArray/Util.hs +++ b/haskell/Data/Primitive/ByteArray/Util.hs @@ -9,10 +9,16 @@ {-# LANGUAGE TypeOperators #-} module Data.Primitive.ByteArray.Util where +import GHC.Exts (Ptr(..)) import GHC.TypeLits import Control.Monad.Primitive +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import Data.Primitive.Addr import Data.Primitive.Types import Data.Primitive.ByteArray +import Data.Word +import Foreign.Ptr newtype Offset (n :: Nat) = Offset Int @@ -43,3 +49,18 @@ readAtByte :: forall a m n. ) => MutableByteArray (PrimState m) -> Offset n -> m a readAtByte buf (Offset offset) = readByteArray buf (div offset $ (sizeOf (undefined :: a))) {-# INLINE readAtByte #-} + +writeStringAt :: PrimMonad m => MutableByteArray s -> Int -> B.ByteString -> m (Ptr a) +writeStringAt src o bsname = do + (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return + let nptr = ptr (mutableByteArrayContents src) `plusPtr` o + copyAddr (adr nptr) (adr p) cnt + writeOffAddr (adr nptr) cnt (0 :: Word8) + return nptr + +ptr :: Addr -> Ptr a +ptr (Addr a) = Ptr a + +adr :: Ptr a -> Addr +adr (Ptr a) = Addr a + diff --git a/haskell/Data/VCDIFF.hsc b/haskell/Data/VCDIFF.hsc index 5e484e1..804b119 100644 --- a/haskell/Data/VCDIFF.hsc +++ b/haskell/Data/VCDIFF.hsc @@ -47,6 +47,7 @@ import GHC.Exts import GHC.TypeLits import Data.VCDIFF.Types +import Data.VCDIFF.XDelta #ifndef SIZEOF_SIZE_T #define SIZEOF_SIZE_T __SIZEOF_SIZE_T__ @@ -65,7 +66,7 @@ data Stream m = Stream -- to 'streamArray'. Don't use this pointer. -- This would be unnecessary if I could create a -- MutableByteArray with a finalizer attached. - , streamSource :: MutVar (PrimState m) (Maybe (MutableByteArray (PrimState m))) + , streamSource :: MutVar (PrimState m) (Maybe (Source m)) } foreign import ccall "xdelta3.h xd3_config_stream" xd3_config_stream :: Ptr Xd3Stream -> Ptr Config -> IO ErrorCode @@ -76,12 +77,6 @@ foreign import ccall "xdelta3.h xd3_abort_stream" xd3_abort_stream :: Ptr Xd3Str foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode -type instance SizeOf Usize_t = #const sizeof(usize_t) -type instance SizeOf (FunPtr a) = #const sizeof(void(*)()) -type instance SizeOf (Ptr a) = #const sizeof(void*) -type instance SizeOf #{type int} = #const sizeof(int) -type instance SizeOf #{type unsigned int} = #const sizeof(unsigned int) - writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m () @@ -102,12 +97,6 @@ writeMatcher c o sm = do writeAtByte c (o +. #{off xd3_smatcher, max_lazy }) (smMaxLazy sm) writeAtByte c (o +. #{off xd3_smatcher, long_enough }) (smLongEnough sm) -ptr :: Addr -> Ptr a -ptr (Addr a) = Ptr a - -adr :: Ptr a -> Addr -adr (Ptr a) = Addr a - -- The xd3_config structure is used to initialize a stream - all data -- is copied into stream so config may be a temporary variable. See -- the [documentation] or comments on the xd3_config structure. @@ -165,18 +154,9 @@ config_stream cfg = do XD3_SUCCESS -> return $ c `seq` Right stream ecode -> return $ Left ecode -writeStringAt :: PrimMonad m => MutableByteArray s -> Int -> B.ByteString -> m (Ptr a) -writeStringAt src o bsname = do - (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return - let nptr = ptr (mutableByteArrayContents src) `plusPtr` o - copyAddr (adr nptr) (adr p) cnt - writeOffAddr (adr nptr) cnt (0 :: Word8) - return nptr - -data Xd3Source - foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode + set_source :: PrimMonad m => Stream m -> String -- ^ name for debug/print purposes. -> Usize_t -- ^ block size @@ -184,21 +164,14 @@ set_source :: PrimMonad m => -- Rounds up to approx 16k. -> m () set_source stream nm blksz maxwinsz = do - let bsname = encodeUtf8 $ T.pack nm - src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)} - nptr <- writeStringAt src #{const sizeof(xd3_source)} bsname - writeAtByte src (#{off xd3_source, blksize }) blksz - writeAtByte src (#{off xd3_source, name }) nptr - writeAtByte src (#{off xd3_source, max_winsize}) maxwinsz - writeAtByte src (#{off xd3_source, curblkno }) (maxBound :: Xoff_t) + src <- newSource nm blksz maxwinsz {- writeAtByte (streamArray stream) #{offset xd3_stream, getblk} nullPtr -- xdelta3.h documents this as an internal field. -} let strm = ptr (mutableByteArrayContents $ streamArray stream) - srcptr = ptr (mutableByteArrayContents src) - unsafeIOToPrim (xd3_set_source strm srcptr) + unsafeIOToPrim (xd3_set_source strm $ sourcePtr src) writeMutVar (streamSource stream) (Just src) data XDeltaMethods m u = XDeltaMethods @@ -250,17 +223,10 @@ nextOut stream action = do writeAtByte (streamArray stream) (#{off xd3_stream, avail_out}) (0 :: Usize_t) return a - requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t) requestedBlockNumber stream = do msrc <- readMutVar $ streamSource stream - forM msrc $ \src -> readAtByte src (#{off xd3_source, getblkno}) - -data CurrentBlock = CurrentBlock - { blkno :: !Xoff_t -- ^ current block number - , blkSize :: !Usize_t -- ^ number of bytes on current block: must be >= 0 and <= 'srcBlockSize' - , blkPtr :: !(Ptr Word8) -- ^ current block array - } + forM msrc sourceRequestedBlocknumber -- -- declared static -- foreign import ccall "xdelta3.h xd3_errstring" xd3_errstring :: Ptr Xd3Stream -> IO CString @@ -275,13 +241,9 @@ errorString stream = do else return "" pokeCurrentBlock :: PrimMonad m => Stream m -> CurrentBlock -> m () -pokeCurrentBlock stream (CurrentBlock no sz ptr) = do +pokeCurrentBlock stream blk = do msrc <- readMutVar $ streamSource stream - forM_ msrc $ \src -> do - writeAtByte src (#{off xd3_source, curblkno}) no - writeAtByte src (#{off xd3_source, onblk}) sz - writeAtByte src (#{off xd3_source, curblk}) ptr - + forM_ msrc (`sourceWriteCurrentBlock` blk) withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a withByteString d act = @@ -319,7 +281,7 @@ xdelta x xxcode_input ds = do pokeCurrentBlock stream $ CurrentBlock n len p when (len < xBlockSize x) $ do Just src <- readMutVar $ streamSource stream - writeAtByte src (#{off xd3_source, eof_known}) (1 :: #{type int}) + sourceWriteEOFKnown src True act go2 withBlk' eof ds XD3_GOTHEADER -> go2 withBlk eof ds -- No diff --git a/xdelta.cabal b/xdelta.cabal index e75e761..6540559 100644 --- a/xdelta.cabal +++ b/xdelta.cabal @@ -15,6 +15,7 @@ extra-source-files: xdelta3/*.h xdelta3/*.c library exposed-modules: Data.VCDIFF.Types + , Data.VCDIFF.XDelta , Data.VCDIFF , Data.Primitive.ByteArray.Util -- cgit v1.2.3