diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Jacob Stanley + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * 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. + + * Neither the name of Jacob Stanley nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT +OWNER 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/layout.c b/cbits/layout.c new file mode 100644 --- /dev/null +++ b/cbits/layout.c @@ -0,0 +1,107 @@ +#include + +#define id(n) (n) + +#define bswap32 __builtin_bswap32 +#define bswap64 __builtin_bswap64 + +/* + * Unfortunately GCC does not have a __builtin_bswap16, but + * this should compile to pretty good assembly. + */ +inline static uint16_t bswap16(uint16_t n) +{ + return (n >> 8) | (n << 8); +} + +/* + * Defines an encode/decode case for the specified type + * and byte order. + * + * enc The memory area (src or dst) which contains or will + * contain the encoded data. During encoding this will + * be 'dst' and during decoding this will be 'src'. + * + * type The type of the values to copy. + * + * bswap The function to use to swap the byte order. Pass + * the identity function if no byte swapping is + * required. + */ +#define CASE(_enc,_type,_bswap) \ +case sizeof (_type): \ + /* repeat 'num_reps' times */ \ + for (r = 0; r < num_reps; ++r) { \ + /* skip 'offsets[0]' bytes */ \ + _enc += offsets[0]; \ + for (o = 1; o < num_offsets; ++o) { \ + /* copy 'num_values * sizeof (_type)' bytes */ \ + for (v = 0; v < num_values; v++) { \ + *(_type *)dst = _bswap(*(_type *)src); \ + dst += sizeof (_type); \ + src += sizeof (_type); \ + } \ + /* skip 'offsets[o]' bytes */ \ + _enc += offsets[o]; \ + } \ + } \ +break; + +#define OK 0 +#define ERROR 1 + +/* + * data_layout_encode / data_layout_decode + * + * Copies data from the second memory area (source) into the first + * memory area (destination) using the specified operations. + * + * dst destination memory area + * src source memory area + * num_reps number of times to repeat the decode + * num_offsets number of skip operations in 'offsets' + * offsets list with number of bytes to skip in between each copy + * num_values number of values to copy in between each skip + * value_size size of a single value in bytes + * swap_bytes non-zero to swap the byte order of values + * + * Returns zero on success, non-zero otherwise. + */ + +#define CODEC_FN(_name,_enc) \ +int data_layout_##_name \ + ( char *dst \ + , char *src \ + , int num_reps \ + , int num_offsets \ + , int *offsets \ + , int num_values \ + , int value_size \ + , int swap_bytes \ + ) \ +{ \ + int r, o, v; \ + \ + if (swap_bytes) { \ + switch (value_size) { \ + CASE (_enc, uint64_t, bswap64); \ + CASE (_enc, uint32_t, bswap32); \ + CASE (_enc, uint16_t, bswap16); \ + CASE (_enc, uint8_t, id); \ + default: return ERROR; \ + } \ + } else { \ + switch (value_size) { \ + CASE (_enc, uint64_t, id); \ + CASE (_enc, uint32_t, id); \ + CASE (_enc, uint16_t, id); \ + CASE (_enc, uint8_t, id); \ + default: return ERROR; \ + } \ + } \ + \ + return OK; \ +} + +CODEC_FN (encode, dst) +CODEC_FN (decode, src) diff --git a/data-layout.cabal b/data-layout.cabal new file mode 100644 --- /dev/null +++ b/data-layout.cabal @@ -0,0 +1,39 @@ +name: data-layout +version: 0.1.0.0 +synopsis: Read/write arbitrary binary layouts to a "Data.Vector.Storable". +homepage: http://github.com/jystic/data-layout +license: BSD3 +license-file: LICENSE +copyright: Jacob Stanley (c) 2012-2013 +author: Jacob Stanley +maintainer: Jacob Stanley +category: Data +build-type: Simple +cabal-version: >= 1.6 + +library + hs-source-dirs: src + + exposed-modules: + Data.Layout + Data.Layout.Language + Data.Layout.Vector + Data.Layout.Internal + + other-modules: + Data.Layout.ForeignPtr + + build-depends: + base == 4.* + , bytestring >= 0.10 + , vector >= 0.10 + + c-sources: cbits/layout.c + cc-options: -Wall -Werror -O3 + + ghc-options: + -O2 -Wall + -funbox-strict-fields + -fno-warn-unused-do-bind + -fno-warn-orphans + -fwarn-tabs diff --git a/src/Data/Layout.hs b/src/Data/Layout.hs new file mode 100644 --- /dev/null +++ b/src/Data/Layout.hs @@ -0,0 +1,15 @@ +-- | A DSL for describing data laid out in a regular fashion with +-- a combination of structures and arrays. + +module Data.Layout ( + Layout + , Bytes + , Reps + , ByteOrder(..) + , module Data.Layout.Language + , module Data.Layout.Vector + ) where + +import Data.Layout.Internal +import Data.Layout.Language +import Data.Layout.Vector diff --git a/src/Data/Layout/ForeignPtr.hs b/src/Data/Layout/ForeignPtr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Layout/ForeignPtr.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE CPP #-} + +module Data.Layout.ForeignPtr + ( mallocPlainForeignPtrBytes + ) where + +#if __GLASGOW_HASKELL__ >= 605 + +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) + +#else + +import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrBytes) + +mallocPlainForeignPtrBytes :: Int -> IO (ForeignPtr a) +mallocPlainForeignPtrBytes = mallocForeignPtrBytes + +#endif diff --git a/src/Data/Layout/Internal.hs b/src/Data/Layout/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/Layout/Internal.hs @@ -0,0 +1,51 @@ +-- | /Use the internal representation of layouts at your own risk./ +-- +-- The smart constructors in "Data.Layout.Language" enforce the +-- documented invariants for `Layout`. The library has undefined +-- behavior if these invariants are violated. +-- +-- The recommended way to use this library is to import "Data.Layout". + +module Data.Layout.Internal where + +-- | Size in bytes. +type Bytes = Int + +-- | Number of repetitions. +type Reps = Int + +-- | Describes the binary layout of a set of data. +data Layout = + -- | A value with a known format. + Value ValueFormat + + -- | Skip 'n' bytes in to a struct. + -- /The offset must be 1 or more bytes./ + | Offset Bytes Layout + + -- | A struct which is 'n' bytes in size. + -- /The size of the struct must be larger than that of the field layout it wraps./ + | Group Bytes Layout + + -- | An array with 'n' elements. + -- /An array must have 2 or more elements./ + | Repeat Reps Layout + deriving (Eq, Show) + +-- | The size and byte order of a value. +data ValueFormat = + Word8 -- ^ 8-bit word. + | Word16le -- ^ 16-bit word, little endian. + | Word32le -- ^ 32-bit word, little endian. + | Word64le -- ^ 64-bit word, little endian. + | Word16be -- ^ 16-bit word, big endian. + | Word32be -- ^ 32-bit word, big endian. + | Word64be -- ^ 64-bit word, big endian. + deriving (Eq, Show) + +-- | The byte order of a value. +data ByteOrder = + NoByteOrder -- ^ The word is only one byte in size. + | LittleEndian -- ^ The least significant byte is first in the word. + | BigEndian -- ^ The most significant byte is first in the word. + deriving (Eq, Show) diff --git a/src/Data/Layout/Language.hs b/src/Data/Layout/Language.hs new file mode 100644 --- /dev/null +++ b/src/Data/Layout/Language.hs @@ -0,0 +1,193 @@ +-- | A DSL for describing data laid out in a regular fashion with +-- a combination of structures and arrays. + +module Data.Layout.Language ( + -- * Combinators + repeat + , offset + , group + + -- * Value Formats + , word8 + , word16le + , word32le + , word64le + , word16be + , word32be + , word64be + + -- * Optimizations + , optimize + + -- * Utility + , size + , byteOrder + , valueSize1 + , valueSizeN + , valueCount + , chunk + + ) where + +import Prelude hiding (repeat) + +import Data.Layout.Internal + +------------------------------------------------------------------------ +-- Combinators + +-- | Repeat a layout 'n' times. +repeat :: Reps -> Layout -> Layout +repeat n | n > 1 = Repeat n + | n == 1 = id + | otherwise = invalid "repeat" "repetition must be at least 1" + +-- | Skip 'n' bytes before accessing the next part of the layout. +offset :: Bytes -> Layout -> Layout +offset n | n > 0 = Offset n + | n == 0 = id + | otherwise = invalid "offset" "must skip 0 or more bytes" + +-- | Wrap a layout with a group which is 'n' bytes in size. +group :: Bytes -> Layout -> Layout +group n xs | n <= 0 = invalid "group" "must contain 1 or more bytes" + | n < size xs = invalid "group" "cannot be smaller than the inner layout" + | otherwise = Group n xs + +invalid :: String -> String -> a +invalid fn msg = error ("Data.Layout.Language." ++ fn ++ ": " ++ msg) + + +------------------------------------------------------------------------ +-- Value Formats + +-- | 8-bit word. +word8 :: Layout +word8 = Value Word8 + +-- | 16-bit word, little endian. +word16le :: Layout +word16le = Value Word16le + +-- | 32-bit word, little endian. +word32le :: Layout +word32le = Value Word32le + +-- | 64-bit word, little endian. +word64le :: Layout +word64le = Value Word64le + +-- | 16-bit word, big endian. +word16be :: Layout +word16be = Value Word16be + +-- | 32-bit word, big endian. +word32be :: Layout +word32be = Value Word32be + +-- | 64-bit word, big endian. +word64be :: Layout +word64be = Value Word64be + +formatSize :: ValueFormat -> Bytes +formatSize Word8 = 1 +formatSize Word16le = 2 +formatSize Word32le = 4 +formatSize Word64le = 8 +formatSize Word16be = 2 +formatSize Word32be = 4 +formatSize Word64be = 8 + +formatByteOrder :: ValueFormat -> ByteOrder +formatByteOrder Word8 = NoByteOrder +formatByteOrder Word16le = LittleEndian +formatByteOrder Word32le = LittleEndian +formatByteOrder Word64le = LittleEndian +formatByteOrder Word16be = BigEndian +formatByteOrder Word32be = BigEndian +formatByteOrder Word64be = BigEndian + +------------------------------------------------------------------------ +-- Optimizations + +data GroupStatus = NoGroup | GotGroup + +-- | Removes redundant data groups. Grouping a set of data is only +-- sensible when the data can be repeated. If we find multiple +-- groupings without a repeat in the middle we can remove all but +-- the outer group. +optimizeGroups :: Layout -> Layout +optimizeGroups = go NoGroup + where + -- found a group, pass GotGroup to inner layout + go NoGroup (Group n xs) = Group n (go GotGroup xs) + + -- already got an outer group, drop this one as it is redundant + go GotGroup (Group _ xs) = go GotGroup xs + + -- reset group status, further grouping may be required for repeats + go _ (Repeat n xs) = Repeat n (go NoGroup xs) + + -- other configurations are uninteresting for this optimization + go status x = mapInner (go status) x + +-- | Folds adjancent data offset operations in to a single one. +optimizeOffsets :: Layout -> Layout +optimizeOffsets = go + where + go (Offset n (Offset m xs)) = go (Offset (n + m) xs) + go x = mapInner go x + +-- | Remove redundancies from a layout. +optimize :: Layout -> Layout +optimize = optimizeOffsets . optimizeGroups + + +------------------------------------------------------------------------ +-- Utility + +-- | Calculates the total size of the layout. +size :: Layout -> Int +size (Value x) = formatSize x +size (Offset x xs) = x + size xs +size (Group x _) = x +size (Repeat n xs) = n * size xs + +-- | Gets the format of a single value in the layout. +valueFormat :: Layout -> ValueFormat +valueFormat (Value fmt) = fmt +valueFormat (Offset _ xs) = valueFormat xs +valueFormat (Group _ xs) = valueFormat xs +valueFormat (Repeat _ xs) = valueFormat xs + +-- | Gets the byte order of the values in the layout. +byteOrder :: Layout -> ByteOrder +byteOrder = formatByteOrder . valueFormat + +-- | Calculates the size of a single value in the layout. +valueSize1 :: Layout -> Int +valueSize1 = formatSize . valueFormat + +-- | Calculates the total size of the values stored in the layout. +valueSizeN :: Layout -> Int +valueSizeN x = valueSize1 x * valueCount x + +-- | Counts the number of times a value is repeated in the layout. +valueCount :: Layout -> Int +valueCount (Value _) = 1 +valueCount (Offset _ xs) = valueCount xs +valueCount (Group _ xs) = valueCount xs +valueCount (Repeat n xs) = valueCount xs * n + +-- | Applys a transformation to the inner layout. +mapInner :: (Layout -> Layout) -> Layout -> Layout +mapInner _ (Value fmt) = Value fmt +mapInner f (Offset n xs) = Offset n (f xs) +mapInner f (Group n xs) = Group n (f xs) +mapInner f (Repeat n xs) = Repeat n (f xs) + +-- | Splits a repeated layout in to multiple layouts each with a maximum +-- of 'n' repetitions. +chunk :: Int -> Layout -> [Layout] +chunk n (Repeat m xs) = replicate (m `div` n) (Repeat n xs) ++ [Repeat (m `rem` n) xs] +chunk _ xs = [xs] diff --git a/src/Data/Layout/Vector.hs b/src/Data/Layout/Vector.hs new file mode 100644 --- /dev/null +++ b/src/Data/Layout/Vector.hs @@ -0,0 +1,319 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Layout.Vector ( + Codec + , compile + + , StorableVector (..) + , encodeVectors + , decodeVector + ) where + +import Control.Monad (when) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.ByteString.Internal (ByteString(..)) +import qualified Data.Vector.Storable as V +import Data.Word (Word8, Word32) +import Foreign.C (CInt (..)) +import Foreign.ForeignPtr () +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, castForeignPtr) +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr (Ptr, plusPtr, castPtr) +import Foreign.Storable (Storable, peek, poke, sizeOf) +import System.IO.Unsafe (unsafePerformIO) + +import Data.Layout.ForeignPtr (mallocPlainForeignPtrBytes) +import qualified Data.Layout.Language as L +import Data.Layout.Internal (Layout(..), ByteOrder(..)) + +------------------------------------------------------------------------ +-- Vector Encoding Operations + +-- | Abstracts over vectors of storable types to allow +-- calling `encodeVectors`. The `SV` constructor provides +-- proof that the `V.Vector` contains `Storable` elements. +data StorableVector where + SV :: Storable a => V.Vector a -> StorableVector + +-- | Creates a strict `ByteString` by interleaving multiple `V.Vector`s. +encodeVectors :: [(Codec, StorableVector)] -> ByteString +encodeVectors [] = B.empty +encodeVectors xs@((codec, SV vec):_) = unsafePerformIO $ do + -- allocate memory for the bytestring + bp <- mallocPlainForeignPtrBytes bstrBytes + + -- encode each vector + mapM_ (go (DstPtr bp 0)) xs + + -- return the bytestring + return (PS bp 0 bstrBytes) + where + bstrBytes = encodeReps codec vec * encodedSize codec + + go dp (c, SV v) = encodeVector c dp v + +encodeVector :: forall a. Storable a => Codec -> DstPtr -> V.Vector a -> IO () +encodeVector codec dstPtr vec = do + -- check that the vector type matches the codec + checkValueSize "encodeVector" codec vec + + -- get a pointer to the vector elements + let vp = castForeignPtr (fst (V.unsafeToForeignPtr0 vec)) + + -- encode the vector + encode codec n dstPtr (SrcPtr vp 0) + where + n = encodeReps codec vec + +encodeReps :: Storable a => Codec -> V.Vector a -> Int +encodeReps c v = repetitions "Vector" (vectorSize v) (decodedSize c) + +------------------------------------------------------------------------ +-- Vector Decoding Operations + +-- | Creates a `V.Vector` by decoding a strict `ByteString` +decodeVector :: forall a. Storable a => Codec -> ByteString -> V.Vector a +decodeVector codec bstr@(PS bp bpOff _) = unsafePerformIO $ do + -- check that the vector type matches the codec + checkValueSize "decodeVector" codec (V.empty :: V.Vector a) + + -- allocate memory for the vector + vp <- mallocPlainForeignPtrBytes vectorBytes + + -- decode the bytestring in to the vector + decode codec n (DstPtr vp 0) (SrcPtr bp bpOff) + + -- return the vector + return (V.unsafeFromForeignPtr0 (castForeignPtr vp) vectorElems) + where + n = repetitions "ByteString" (B.length bstr) (encodedSize codec) + + vectorBytes = n * decodedSize codec + vectorElems = n * valueCount codec + +------------------------------------------------------------------------ +-- Vector Utils + +vectorSize :: forall a. Storable a => V.Vector a -> Int +vectorSize v = V.length v * sizeOf (undefined :: a) + +-- | Ensures the value size of the codec matches the vector type. +checkValueSize :: forall a m. (Storable a, Monad m) + => String -> Codec -> V.Vector a -> m () +checkValueSize fn codec _ = + when (codecValueSize /= vectorElemSize) (error errorMsg) + where + codecValueSize = valueSize codec + vectorElemSize = sizeOf (undefined :: a) + + errorMsg = concat + [ "Data.Layout.Vector.", fn, ": " + , "Value size mismatch. The value size of a codec (" + , show codecValueSize, " bytes) did not match the size of " + , "individual elements (", show vectorElemSize, " bytes) in " + , "the corresponding vector. This means that the wrong type " + , "of vector is being used for a given codec." ] + +repetitions :: String -> Int -> Int -> Int +repetitions sourceName sourceBytes codecBytes = + if leftover /= 0 then error msg else n + where + (n, leftover) = sourceBytes `quotRem` codecBytes + + msg = concat + [ "Data.Layout.Vector.encodeReps: " + , "The source ", sourceName, " is not a multiple of " + , show codecBytes, " bytes, as required by the Codec. " + , show sourceBytes, " bytes were provided, which leaves " + , show leftover, " bytes unused." ] + + +------------------------------------------------------------------------ +-- Ptr Operations + +data DstPtr = DstPtr {-# UNPACK #-} !(ForeignPtr Word8) + {-# UNPACK #-} !Int + +data SrcPtr = SrcPtr {-# UNPACK #-} !(ForeignPtr Word8) + {-# UNPACK #-} !Int + +-- | Contains the information required to encode or decode a +-- `V.Vector` from its arbitrary layout in a strict `ByteString`. +data Codec = Codec + { encode :: Int -> DstPtr -> SrcPtr -> IO () + , decode :: Int -> DstPtr -> SrcPtr -> IO () + , encodedSize :: Int + , decodedSize :: Int + , valueCount :: Int + , valueSize :: Int + } + +-- | Compiles a data layout in to a codec capable of encoding +-- and decoding data stored in the layout. +compile :: Layout -> Codec +compile layout = Codec + { encode = runCodec copyInfo c_encode + , decode = runCodec copyInfo c_decode + , encodedSize = L.size layout + , decodedSize = L.valueSizeN layout + , valueCount = L.valueCount layout + , valueSize = L.valueSize1 layout + } + where + copyInfo = buildCopyInfo layout + +runCodec :: CopyInfo -> CodecFn -> Int -> DstPtr -> SrcPtr -> IO () +runCodec info c_codec_fn reps (DstPtr dstFP dstOff) (SrcPtr srcFP srcOff) = + -- unbox foreign pointers for use + withForeignPtr dstFP $ \dst0 -> do + withForeignPtr srcFP $ \src0 -> do + + -- add the offset + let dst = dst0 `plusPtr` dstOff + src = src0 `plusPtr` srcOff + + -- get a pointer to the offsets + V.unsafeWith (ciOffsets info) $ \offsets -> do + + -- decode the data + err <- c_codec_fn + dst src + (fromIntegral reps) + (ciNumOffsets info) + offsets + (ciNumValues info) + (ciValueSize info) + (ciSwapBytes info) + + -- check error code + case err of + 0 -> return () + 1 -> error ("runCodec: invalid value size: " ++ show (ciValueSize info)) + _ -> error "runCodec: unknown error" + + +------------------------------------------------------------------------ +-- CopyInfo + +data CopyInfo = CopyInfo + { ciOffsets :: V.Vector CInt + , ciNumValues :: CInt + , ciValueSize :: CInt + , ciSwapBytes :: CInt + } deriving (Show) + +ciNumOffsets :: CopyInfo -> CInt +ciNumOffsets = fromIntegral . V.length . ciOffsets + +type SkipCopyOp = CInt + +-- | Build copy instructions for the specified layout. +buildCopyInfo :: Layout -> CopyInfo +buildCopyInfo layout = + CopyInfo { ciOffsets, ciNumValues, ciValueSize, ciSwapBytes } + where + ciNumValues = copySize `quot` ciValueSize + ciValueSize = fromIntegral (L.valueSize1 layout) + ciSwapBytes = if needsByteSwap layout then 1 else 0 + + (copySize, ciOffsets) = (splitOps . optimize . toSkipCopyOps) layout + + -- convert from layout to skip/copy operations + toSkipCopyOps :: Layout -> V.Vector SkipCopyOp + toSkipCopyOps = go + where + go v@(Value _) = V.singleton (copyOp (L.valueSize1 v)) + go (Offset n xs) = skipOp n `V.cons` go xs + go (Repeat n xs) = V.concat (replicate n (go xs)) + go (Group n xs) = go xs `V.snoc` skipOp (n - L.size xs) + + -- positive number means skip 'n' bytes + skipOp = fromIntegral + + -- negative number means copy 'n' bytes + copyOp n = fromIntegral (-n) + + + -- squash copies and skips together, remove no-ops + optimize :: V.Vector SkipCopyOp -> V.Vector SkipCopyOp + optimize = skips + where + skips = sumWhile (> 0) copies + copies = sumWhile (<= 0) skips + + sumWhile p k xs + | V.null xs = V.empty + | otherwise = let (ys, zs) = V.span p xs + in case V.sum ys of + 0 -> k zs + s -> s `V.cons` k zs + + -- ensures first and last operations are skips or no-ops, + -- then strips all copies out returns a tuple of the form + -- (copy size, skip operations) + splitOps :: V.Vector SkipCopyOp -> (CInt, V.Vector CInt) + splitOps = split . head0 . last0 + where + head0 xs | V.head xs < 0 = 0 `V.cons` xs + | otherwise = xs + + last0 xs | V.last xs < 0 = xs `V.snoc` 0 + | otherwise = xs + + split :: V.Vector SkipCopyOp -> (CInt, V.Vector CInt) + split xs = (-copyOp, V.filter isSkip xs) + where + copyOp = V.head (V.dropWhile (>= 0) xs) + + isSkip x | x == copyOp = False -- remove + | x >= 0 = True -- keep + | otherwise = error $ + "buildCopyInfo: invalid copy operation " ++ + "(expected <" ++ show (-copyOp) ++ " bytes>," ++ + " actual <" ++ show (-x) ++ " bytes>)" + + +------------------------------------------------------------------------ +-- Endian check + +needsByteSwap :: Layout -> Bool +needsByteSwap x = case L.byteOrder x of + NoByteOrder -> False + LittleEndian -> hostIsBigEndian + BigEndian -> hostIsLittleEndian + +endianCheck :: Word8 +endianCheck = unsafePerformIO $ alloca $ \p -> do + poke p (0x01020304 :: Word32) + peek (castPtr p :: Ptr Word8) + +hostIsLittleEndian :: Bool +hostIsLittleEndian = endianCheck == 4 + +hostIsBigEndian :: Bool +hostIsBigEndian = endianCheck == 1 + + +------------------------------------------------------------------------ +-- FFI + +type CodecFn = + Ptr Word8 -- ^ destination memory area + -> Ptr Word8 -- ^ source memory area + -> CInt -- ^ number of times to repeat the encode/decode + -> CInt -- ^ number of skip operations in 'offsets' + -> Ptr CInt -- ^ offset / skip list + -> CInt -- ^ number of values to copy in between each skip + -> CInt -- ^ size of a single value in bytes + -> CInt -- ^ non-zero to swap the byte order of values + -> IO CInt -- ^ zero on success, non-zero otherwise + +foreign import ccall unsafe "data_layout_encode" + c_encode :: CodecFn + +foreign import ccall unsafe "data_layout_decode" + c_decode :: CodecFn