summaryrefslogtreecommitdiff
path: root/haskell/Data/VCDIFF.hsc
diff options
context:
space:
mode:
Diffstat (limited to 'haskell/Data/VCDIFF.hsc')
-rw-r--r--haskell/Data/VCDIFF.hsc56
1 files changed, 9 insertions, 47 deletions
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
47import GHC.TypeLits 47import GHC.TypeLits
48 48
49import Data.VCDIFF.Types 49import Data.VCDIFF.Types
50import Data.VCDIFF.XDelta
50 51
51#ifndef SIZEOF_SIZE_T 52#ifndef SIZEOF_SIZE_T
52#define SIZEOF_SIZE_T __SIZEOF_SIZE_T__ 53#define SIZEOF_SIZE_T __SIZEOF_SIZE_T__
@@ -65,7 +66,7 @@ data Stream m = Stream
65 -- to 'streamArray'. Don't use this pointer. 66 -- to 'streamArray'. Don't use this pointer.
66 -- This would be unnecessary if I could create a 67 -- This would be unnecessary if I could create a
67 -- MutableByteArray with a finalizer attached. 68 -- MutableByteArray with a finalizer attached.
68 , streamSource :: MutVar (PrimState m) (Maybe (MutableByteArray (PrimState m))) 69 , streamSource :: MutVar (PrimState m) (Maybe (Source m))
69 } 70 }
70 71
71foreign import ccall "xdelta3.h xd3_config_stream" xd3_config_stream :: Ptr Xd3Stream -> Ptr Config -> IO ErrorCode 72foreign 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
76 77
77foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode 78foreign import ccall "xdelta3.h xd3_close_stream" xd3_close_stream :: Ptr Xd3Stream -> IO ErrorCode
78 79
79type instance SizeOf Usize_t = #const sizeof(usize_t)
80type instance SizeOf (FunPtr a) = #const sizeof(void(*)())
81type instance SizeOf (Ptr a) = #const sizeof(void*)
82type instance SizeOf #{type int} = #const sizeof(int)
83type instance SizeOf #{type unsigned int} = #const sizeof(unsigned int)
84
85 80
86 81
87writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m () 82writeCompressorConfig :: (PrimMonad m, _) => MutableByteArray (PrimState m) -> Offset j -> CompressorConfig -> m ()
@@ -102,12 +97,6 @@ writeMatcher c o sm = do
102 writeAtByte c (o +. #{off xd3_smatcher, max_lazy }) (smMaxLazy sm) 97 writeAtByte c (o +. #{off xd3_smatcher, max_lazy }) (smMaxLazy sm)
103 writeAtByte c (o +. #{off xd3_smatcher, long_enough }) (smLongEnough sm) 98 writeAtByte c (o +. #{off xd3_smatcher, long_enough }) (smLongEnough sm)
104 99
105ptr :: Addr -> Ptr a
106ptr (Addr a) = Ptr a
107
108adr :: Ptr a -> Addr
109adr (Ptr a) = Addr a
110
111-- The xd3_config structure is used to initialize a stream - all data 100-- The xd3_config structure is used to initialize a stream - all data
112-- is copied into stream so config may be a temporary variable. See 101-- is copied into stream so config may be a temporary variable. See
113-- the [documentation] or comments on the xd3_config structure. 102-- the [documentation] or comments on the xd3_config structure.
@@ -165,18 +154,9 @@ config_stream cfg = do
165 XD3_SUCCESS -> return $ c `seq` Right stream 154 XD3_SUCCESS -> return $ c `seq` Right stream
166 ecode -> return $ Left ecode 155 ecode -> return $ Left ecode
167 156
168writeStringAt :: PrimMonad m => MutableByteArray s -> Int -> B.ByteString -> m (Ptr a)
169writeStringAt src o bsname = do
170 (p,cnt) <- unsafeIOToPrim $ B.unsafeUseAsCStringLen bsname return
171 let nptr = ptr (mutableByteArrayContents src) `plusPtr` o
172 copyAddr (adr nptr) (adr p) cnt
173 writeOffAddr (adr nptr) cnt (0 :: Word8)
174 return nptr
175
176data Xd3Source
177
178foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode 157foreign import ccall "xdelta3.h xd3_set_source" xd3_set_source :: Ptr Xd3Stream -> Ptr Xd3Source -> IO ErrorCode
179 158
159
180set_source :: PrimMonad m => 160set_source :: PrimMonad m =>
181 Stream m -> String -- ^ name for debug/print purposes. 161 Stream m -> String -- ^ name for debug/print purposes.
182 -> Usize_t -- ^ block size 162 -> Usize_t -- ^ block size
@@ -184,21 +164,14 @@ set_source :: PrimMonad m =>
184 -- Rounds up to approx 16k. 164 -- Rounds up to approx 16k.
185 -> m () 165 -> m ()
186set_source stream nm blksz maxwinsz = do 166set_source stream nm blksz maxwinsz = do
187 let bsname = encodeUtf8 $ T.pack nm 167 src <- newSource nm blksz maxwinsz
188 src <- newPinnedByteArray $ 1 + B.length bsname + #{const sizeof(xd3_source)}
189 nptr <- writeStringAt src #{const sizeof(xd3_source)} bsname
190 writeAtByte src (#{off xd3_source, blksize }) blksz
191 writeAtByte src (#{off xd3_source, name }) nptr
192 writeAtByte src (#{off xd3_source, max_winsize}) maxwinsz
193 writeAtByte src (#{off xd3_source, curblkno }) (maxBound :: Xoff_t)
194 {- 168 {-
195 writeAtByte (streamArray stream) 169 writeAtByte (streamArray stream)
196 #{offset xd3_stream, getblk} 170 #{offset xd3_stream, getblk}
197 nullPtr -- xdelta3.h documents this as an internal field. 171 nullPtr -- xdelta3.h documents this as an internal field.
198 -} 172 -}
199 let strm = ptr (mutableByteArrayContents $ streamArray stream) 173 let strm = ptr (mutableByteArrayContents $ streamArray stream)
200 srcptr = ptr (mutableByteArrayContents src) 174 unsafeIOToPrim (xd3_set_source strm $ sourcePtr src)
201 unsafeIOToPrim (xd3_set_source strm srcptr)
202 writeMutVar (streamSource stream) (Just src) 175 writeMutVar (streamSource stream) (Just src)
203 176
204data XDeltaMethods m u = XDeltaMethods 177data XDeltaMethods m u = XDeltaMethods
@@ -250,17 +223,10 @@ nextOut stream action = do
250 writeAtByte (streamArray stream) (#{off xd3_stream, avail_out}) (0 :: Usize_t) 223 writeAtByte (streamArray stream) (#{off xd3_stream, avail_out}) (0 :: Usize_t)
251 return a 224 return a
252 225
253
254requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t) 226requestedBlockNumber :: PrimMonad m => Stream m -> m (Maybe Xoff_t)
255requestedBlockNumber stream = do 227requestedBlockNumber stream = do
256 msrc <- readMutVar $ streamSource stream 228 msrc <- readMutVar $ streamSource stream
257 forM msrc $ \src -> readAtByte src (#{off xd3_source, getblkno}) 229 forM msrc sourceRequestedBlocknumber
258
259data CurrentBlock = CurrentBlock
260 { blkno :: !Xoff_t -- ^ current block number
261 , blkSize :: !Usize_t -- ^ number of bytes on current block: must be >= 0 and <= 'srcBlockSize'
262 , blkPtr :: !(Ptr Word8) -- ^ current block array
263 }
264 230
265-- -- declared static 231-- -- declared static
266-- foreign import ccall "xdelta3.h xd3_errstring" xd3_errstring :: Ptr Xd3Stream -> IO CString 232-- foreign import ccall "xdelta3.h xd3_errstring" xd3_errstring :: Ptr Xd3Stream -> IO CString
@@ -275,13 +241,9 @@ errorString stream = do
275 else return "" 241 else return ""
276 242
277pokeCurrentBlock :: PrimMonad m => Stream m -> CurrentBlock -> m () 243pokeCurrentBlock :: PrimMonad m => Stream m -> CurrentBlock -> m ()
278pokeCurrentBlock stream (CurrentBlock no sz ptr) = do 244pokeCurrentBlock stream blk = do
279 msrc <- readMutVar $ streamSource stream 245 msrc <- readMutVar $ streamSource stream
280 forM_ msrc $ \src -> do 246 forM_ msrc (`sourceWriteCurrentBlock` blk)
281 writeAtByte src (#{off xd3_source, curblkno}) no
282 writeAtByte src (#{off xd3_source, onblk}) sz
283 writeAtByte src (#{off xd3_source, curblk}) ptr
284
285 247
286withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a 248withByteString :: PrimBase m => B.ByteString -> (Ptr b -> Usize_t -> m a) -> m a
287withByteString d act = 249withByteString d act =
@@ -319,7 +281,7 @@ xdelta x xxcode_input ds = do
319 pokeCurrentBlock stream $ CurrentBlock n len p 281 pokeCurrentBlock stream $ CurrentBlock n len p
320 when (len < xBlockSize x) $ do 282 when (len < xBlockSize x) $ do
321 Just src <- readMutVar $ streamSource stream 283 Just src <- readMutVar $ streamSource stream
322 writeAtByte src (#{off xd3_source, eof_known}) (1 :: #{type int}) 284 sourceWriteEOFKnown src True
323 act 285 act
324 go2 withBlk' eof ds 286 go2 withBlk' eof ds
325 XD3_GOTHEADER -> go2 withBlk eof ds -- No 287 XD3_GOTHEADER -> go2 withBlk eof ds -- No