diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,1 @@ +# Changelog for hw-simd diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright John Ky (c) 2018 + +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 John Ky 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,3 @@ +# hw-simd +[![CircleCI](https://circleci.com/gh/haskell-works/hw-simd.svg?style=svg)](https://circleci.com/gh/haskell-works/hw-simd) +[![Travis](https://travis-ci.org/haskell-works/hw-simd.svg?branch=master)](https://travis-ci.org/haskell-works/hw-simd) 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/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,45 @@ +module Main where + +import Control.Monad +import Criterion.Main +import Data.Char +import Data.List +import Data.Semigroup ((<>)) +import Data.Word +import HaskellWorks.Data.Vector.AsVector64s + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Simd.Capabilities as CAP +import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2 +import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK +import qualified System.Directory as IO + +runCmpeq8Avx2 :: FilePath -> IO [DVS.Vector Word64] +runCmpeq8Avx2 filePath = do + bs <- LBS.readFile filePath + let vs = asVector64s 64 bs + return $ if CAP.avx2Enabled + then AVX2.cmpeq8s (fromIntegral (ord '8')) <$> vs + else [] + +runCmpeq8Stock :: FilePath -> IO [DVS.Vector Word64] +runCmpeq8Stock filePath = do + bs <- LBS.readFile filePath + let vs = asVector64s 64 bs + return $ STOCK.cmpeq8s (fromIntegral (ord '8')) <$> vs + +benchCmpeq8 :: IO [Benchmark] +benchCmpeq8 = do + entries <- IO.listDirectory "data/bench" + let files = ("data/bench/" ++) <$> (".csv" `isSuffixOf`) `filter` entries + benchmarks <- forM files $ \file -> return $ mempty + <> [bench ("hw-simd/cmpeq8/avx2/" <> file) (nfIO (runCmpeq8Avx2 file))] + <> [bench ("hw-simd/cmpeq8/stock/" <> file) (nfIO (runCmpeq8Stock file))] + return (join benchmarks) + +main :: IO () +main = do + benchmarks <- (mconcat <$>) $ sequence $ mempty + <> [benchCmpeq8] + defaultMain benchmarks diff --git a/cbits/simd.c b/cbits/simd.c new file mode 100644 --- /dev/null +++ b/cbits/simd.c @@ -0,0 +1,112 @@ +#include "simd.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +typedef uint8_t v32si __attribute__ ((vector_size (32))); +typedef uint8_t v16si __attribute__ ((vector_size (16))); + +void print_bits_16(uint16_t word) { + size_t i; + + putc('|', stdout); + + for (i = 0; i < 16; ++i) { + putc((word & (1L << i)) ? '1' : '0', stdout); + } + printf("|\n"); +} + +void system_memcpy( + char *target, + char *source, + size_t len) { + memcpy(target, source, len); +} + +void avx2_memcpy( + uint8_t *target, + uint8_t *source, + size_t len) { +#if defined(AVX2_ENABLED) + size_t aligned_len = (len / 32) * 32; + size_t remaining_len = len - aligned_len; + + size_t i; + + for (i = 0; i < aligned_len; i += 32) { + __m128i v0 = *(__m128i*)(source + i ); + __m128i v1 = *(__m128i*)(source + i + 16); + + *(__m128i*)(target + i ) = v0; + *(__m128i*)(target + i + 16 ) = v1; + } + + memcpy(target + aligned_len, source + aligned_len, remaining_len); +#endif +} + + +void sse_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source) { + uint16_t *target16 = (uint16_t *)target; + + __m128i v_comparand = _mm_set1_epi8(byte); + + uint16_t *out_mask = (uint16_t*)target; + size_t i; + + for (i = 0; i < target_length * 4; ++i) { + __m128i v_data_a = *(__m128i*)(source + (i * 16)); + __m128i v_results_a = _mm_cmpeq_epi8(v_data_a, v_comparand); + uint16_t mask = (uint16_t)_mm_movemask_epi8(v_results_a); + target16[i] = mask; + } +} + +void avx2_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source) { +#if defined(AVX2_ENABLED) + uint32_t *target32 = (uint32_t *)target; + + __m256 v_comparand = _mm256_set1_epi8(byte); + + uint32_t *out_mask = (uint32_t*)target; + + size_t i; + + for (i = 0; i < target_length * 2; ++i) { + __m256 v_data_a = *(__m256*)(source + (i * 32)); + __m256 v_results_a = _mm256_cmpeq_epi8(v_data_a, v_comparand); + uint32_t mask = (uint32_t)_mm256_movemask_epi8(v_results_a); + target32[i] = mask; + } +#endif +} + +int example_main() { + uint8_t source[32] = "01234567890123456789012345678901"; + uint8_t target[33]; + avx2_memcpy(target, source, 32); + target[32] = 0; + printf("%s\n", target); + + // uint8_t source2[64] = "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"; + // uint64_t target2[1] = {0}; + // avx2_cmpeq8('0', target2, 1, source2); + // printf("%llu\n", target2[0]); + + return 0; +} diff --git a/cbits/simd.h b/cbits/simd.h new file mode 100644 --- /dev/null +++ b/cbits/simd.h @@ -0,0 +1,13 @@ +#include +#include + +void avx2_memcpy( + uint8_t *target, + uint8_t *source, + size_t len); + +void avx2_cmpeq8( + uint8_t byte, + uint64_t *target, + size_t target_length, + uint8_t *source); diff --git a/hw-simd.cabal b/hw-simd.cabal new file mode 100644 --- /dev/null +++ b/hw-simd.cabal @@ -0,0 +1,186 @@ +-- This file has been generated from package.yaml by hpack version 0.20.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: d4e6b647bff1de25a793f93a5adb597bbbc16d00285948adf0c1aa4f8e3c542f + +name: hw-simd +version: 0.0.0.2 +synopsis: SIMD library +description: Please see the README on Github at +category: Text, Web, CSV +homepage: https://github.com/haskell-works/hw-simd#readme +bug-reports: https://github.com/haskell-works/hw-simd/issues +author: John Ky +maintainer: newhoggy@gmail.com +copyright: 2018 John Ky +license: BSD3 +license-file: LICENSE +tested-with: GHC == 8.4.3, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3 +build-type: Simple +cabal-version: >= 1.10 + +extra-source-files: + cbits/simd.h + ChangeLog.md + README.md + +source-repository head + type: git + location: https://github.com/haskell-works/hw-simd + +flag avx2 + description: Enable avx2 instruction set + manual: False + default: False + +flag bmi2 + description: Enable bmi2 instruction set + manual: False + default: False + +flag sse42 + description: Enable SSE 4.2 optimisations. + manual: False + default: True + +library + hs-source-dirs: + src + ghc-options: -O2 -Wall + include-dirs: + cbits + c-sources: + cbits/simd.c + build-depends: + base >=4.7 && <5 + , bits-extra >=0.0.1.2 && <0.1 + , bytestring >=0.10 && <0.11 + , deepseq >=1.4 && <1.5 + , hw-bits >=0.7.0.2 && <0.8 + , hw-prim >=0.6.2.0 && <0.7 + , hw-rankselect >=0.12.0.2 && <0.13 + , hw-rankselect-base >=0.3.2.0 && <0.4 + , vector >=0.12.0.1 && <0.13 + build-tools: + c2hs + if flag(sse42) + ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED + if (flag(bmi2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED + if (impl(ghc >=8.0.1)) + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + if (!impl(ghc >=8.0.1)) + build-depends: + semigroups >=0.8.4 && <0.19 + , transformers >=0.4 && <0.6 + exposed-modules: + HaskellWorks.Data.Simd.Capabilities + HaskellWorks.Data.Simd.Comparison + HaskellWorks.Data.Simd.Comparison.Avx2 + HaskellWorks.Data.Simd.Comparison.Stock + HaskellWorks.Data.Simd.Internal.Bits + HaskellWorks.Data.Simd.Internal.Broadword + HaskellWorks.Data.Simd.Internal.ByteString + HaskellWorks.Data.Simd.Internal.ByteString.Lazy + HaskellWorks.Data.Simd.Internal.Foreign + other-modules: + Paths_hw_simd + default-language: Haskell2010 + +test-suite hw-simd-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: + test + ghc-options: -O2 -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , bits-extra >=0.0.1.2 && <0.1 + , bytestring >=0.10 && <0.11 + , deepseq >=1.4 && <1.5 + , directory >=1.2.2 && <1.4 + , hedgehog >=0.5 && <0.7 + , hspec >=2.4 && <3 + , hw-bits >=0.7.0.2 && <0.8 + , hw-hspec-hedgehog >=0.1.0.4 && <0.2 + , hw-prim >=0.6.2.0 && <0.7 + , hw-rankselect >=0.12.0.2 && <0.13 + , hw-rankselect-base >=0.3.2.0 && <0.4 + , hw-simd + , text >=1.2.2 && <2.0 + , vector >=0.12.0.1 && <0.13 + if flag(sse42) + ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED + if (flag(bmi2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED + if (impl(ghc >=8.0.1)) + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + if (!impl(ghc >=8.0.1)) + build-depends: + semigroups >=0.8.4 && <0.19 + , transformers >=0.4 && <0.6 + other-modules: + HaskellWorks.Data.Simd.BroadwordSpec + Paths_hw_simd + default-language: Haskell2010 + +benchmark bench + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: + bench + ghc-options: -O2 -Wall -msse4.2 + build-depends: + base >=4.7 && <5 + , bits-extra >=0.0.1.2 && <0.1 + , bytestring >=0.10 && <0.11 + , cassava >=0.5.1.0 && <0.6 + , containers + , criterion >=1.4.1.0 && <1.5 + , deepseq >=1.4 && <1.5 + , directory >=1.3.1.5 && <1.4 + , hw-bits >=0.7.0.2 && <0.8 + , hw-prim >=0.6.2.0 && <0.7 + , hw-rankselect >=0.12.0.2 && <0.13 + , hw-rankselect-base >=0.3.2.0 && <0.4 + , hw-simd + , mmap >=0.5.9 && <0.6 + , vector >=0.12.0.1 && <0.13 + if flag(sse42) + ghc-options: -msse4.2 + cc-options: -msse4.2 + if flag(bmi2) + cc-options: -mbmi2 -DBMI2_ENABLED + if (flag(bmi2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + if flag(avx2) + cc-options: -mavx2 -DAVX2_ENABLED + if (flag(avx2)) && (impl(ghc >=8.4.1)) + ghc-options: -mbmi2 -msse4.2 + cpp-options: -DBMI2_ENABLED -DAVX2_ENABLED + if (impl(ghc >=8.0.1)) + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + if (!impl(ghc >=8.0.1)) + build-depends: + semigroups >=0.8.4 && <0.19 + , transformers >=0.4 && <0.6 + other-modules: + Paths_hw_simd + default-language: Haskell2010 diff --git a/src/HaskellWorks/Data/Simd/Capabilities.hs b/src/HaskellWorks/Data/Simd/Capabilities.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Capabilities.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module HaskellWorks.Data.Simd.Capabilities where + +requireAvx2 :: a -> a +requireAvx2 a = if avx2Enabled then a else error "AVX2 not enabled" +{-# INLINE requireAvx2 #-} + +avx2Enabled :: Bool +#if defined(AVX2_ENABLED) +avx2Enabled = True +#else +avx2Enabled = False +#endif +{-# INLINE avx2Enabled #-} diff --git a/src/HaskellWorks/Data/Simd/Comparison.hs b/src/HaskellWorks/Data/Simd/Comparison.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Comparison.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE MultiWayIf #-} + +module HaskellWorks.Data.Simd.Comparison where + +import Data.Word +import HaskellWorks.Data.Simd.Capabilities + +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Simd.Comparison.Avx2 as AVX2 +import qualified HaskellWorks.Data.Simd.Comparison.Stock as STOCK + +cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64 +cmpeq8s w bs = if + | avx2Enabled -> AVX2.cmpeq8s w bs + | True -> STOCK.cmpeq8s w bs +{-# INLINE cmpeq8s #-} diff --git a/src/HaskellWorks/Data/Simd/Comparison/Avx2.hs b/src/HaskellWorks/Data/Simd/Comparison/Avx2.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Comparison/Avx2.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} + +module HaskellWorks.Data.Simd.Comparison.Avx2 where + +import Data.Monoid ((<>)) +import Data.Word + +import qualified Data.Vector.Storable as DVS +import qualified Foreign.ForeignPtr as F +import qualified Foreign.Marshal.Unsafe as F +import qualified Foreign.Ptr as F +import qualified HaskellWorks.Data.Simd.Internal.Foreign as F + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} + +cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64 +cmpeq8s w8 v = case DVS.unsafeCast v :: DVS.Vector Word8 of + u -> case DVS.unsafeToForeignPtr u of + (srcFptr, srcOffset, srcLength) -> if disalignment == 0 + then F.unsafeLocalState $ do + targetFptr <- F.mallocForeignPtrBytes srcLength + F.withForeignPtr srcFptr $ \srcPtr -> do + F.withForeignPtr targetFptr $ \targetPtr -> do + _ <- F.avx2Cmpeq8 + (fromIntegral w8) + (F.castPtr targetPtr `F.plusPtr` srcOffset) + (fromIntegral w64sLen) + (F.castPtr srcPtr) + return $ DVS.unsafeFromForeignPtr targetFptr 0 w64sLen + else error $ "Unaligned byte string: " <> show disalignment + where w64sLen = srcLength `div` 64 + disalignment = srcLength - w64sLen * 64 +{-# INLINE cmpeq8s #-} diff --git a/src/HaskellWorks/Data/Simd/Comparison/Stock.hs b/src/HaskellWorks/Data/Simd/Comparison/Stock.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Comparison/Stock.hs @@ -0,0 +1,39 @@ +module HaskellWorks.Data.Simd.Comparison.Stock + ( cmpeq8s + ) where + +import Data.Monoid ((<>)) +import Data.Word +import HaskellWorks.Data.AtIndex +import HaskellWorks.Data.Bits.BitWise +import HaskellWorks.Data.Simd.Internal.Bits + +import qualified Data.Vector.Storable as DVS + +cmpeq8s :: Word8 -> DVS.Vector Word64 -> DVS.Vector Word64 +cmpeq8s w8 v = if disalignment == 0 + then DVS.constructN (DVS.length v) go + else error $ "Unaligned byte string: " <> show disalignment <> ", vLen: " <> show vLen + where vLen = DVS.length v + disalignment = vLen - (vLen `div` 8) * 8 + w64 = fromIntegral w8 * 0x0101010101010101 :: Word64 + go :: DVS.Vector Word64 -> Word64 + go u = comp w + where ui = fromIntegral $ DVS.length u + w0 = testWord8s ((u !!! (ui + 0)) .^. w64) + w1 = testWord8s ((u !!! (ui + 1)) .^. w64) + w2 = testWord8s ((u !!! (ui + 2)) .^. w64) + w3 = testWord8s ((u !!! (ui + 3)) .^. w64) + w4 = testWord8s ((u !!! (ui + 4)) .^. w64) + w5 = testWord8s ((u !!! (ui + 5)) .^. w64) + w6 = testWord8s ((u !!! (ui + 6)) .^. w64) + w7 = testWord8s ((u !!! (ui + 7)) .^. w64) + w = (w7 .<. 56) .|. + (w6 .<. 48) .|. + (w5 .<. 40) .|. + (w4 .<. 32) .|. + (w3 .<. 24) .|. + (w2 .<. 16) .|. + (w1 .<. 8) .|. + w0 +{-# INLINE cmpeq8s #-} diff --git a/src/HaskellWorks/Data/Simd/Internal/Bits.hs b/src/HaskellWorks/Data/Simd/Internal/Bits.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Internal/Bits.hs @@ -0,0 +1,49 @@ +module HaskellWorks.Data.Simd.Internal.Bits where + +import Data.Bits.Pext +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +import qualified Data.Vector.Storable as DVS + +testWord8s :: Word64 -> Word64 +testWord8s w = let w8s = w + w4s = w8s .|. (w8s .>. 4) + w2s = w4s .|. (w4s .>. 2) + w1s = w2s .|. (w2s .>. 1) + in pext w1s 0x0101010101010101 +{-# INLINE testWord8s #-} + +zipOr :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipOr as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go + where go :: DVS.Vector Word64 -> Word64 + go u = + let ui = DVS.length u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .|. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipOr #-} + +zip2Or :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2Or (a:as) (b:bs) = zipOr a b:zip2Or as bs +zip2Or (a:as) [] = a:zip2Or as [] +zip2Or [] (b:bs) = b:zip2Or [] bs +zip2Or [] [] = [] +{-# INLINE zip2Or #-} + +zipAnd :: DVS.Vector Word64 -> DVS.Vector Word64 -> DVS.Vector Word64 +zipAnd as bs = DVS.constructN (DVS.length as `max` DVS.length bs) go + where go :: DVS.Vector Word64 -> Word64 + go u = + let ui = DVS.length u + in if ui < DVS.length as && ui < DVS.length bs + then DVS.unsafeIndex as ui .&. DVS.unsafeIndex bs ui + else error "Different sized vectors" +{-# INLINE zipAnd #-} + +zip2And :: [DVS.Vector Word64] -> [DVS.Vector Word64] -> [DVS.Vector Word64] +zip2And (a:as) (b:bs) = zipAnd a b:zip2And as bs +zip2And (a:as) [] = a:zip2And as [] +zip2And [] (b:bs) = b:zip2And [] bs +zip2And [] [] = [] +{-# INLINE zip2And #-} diff --git a/src/HaskellWorks/Data/Simd/Internal/Broadword.hs b/src/HaskellWorks/Data/Simd/Internal/Broadword.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Internal/Broadword.hs @@ -0,0 +1,19 @@ +module HaskellWorks.Data.Simd.Internal.Broadword where + +import Data.Bits.Pdep +import Data.Word +import HaskellWorks.Data.Bits.BitWise + +class FillWord64 a where + fillWord64 :: a -> Word64 + +instance FillWord64 Word8 where + fillWord64 w = 0x0101010101010101 * fromIntegral w + {-# INLINE fillWord64 #-} + +toggle64 :: Word64 -> Word64 -> Word64 +toggle64 carry w = + let c = carry .&. 0x1 + in let addend = pdep (0x5555555555555555 .<. c) w + in ((addend .<. 1) .|. c) + comp w +{-# INLINE toggle64 #-} diff --git a/src/HaskellWorks/Data/Simd/Internal/ByteString.hs b/src/HaskellWorks/Data/Simd/Internal/ByteString.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Internal/ByteString.hs @@ -0,0 +1,53 @@ +module HaskellWorks.Data.Simd.Internal.ByteString + ( toByteString + , rechunkAlignedAt + , rechunkPaddedAlignedAt + ) where + +import Data.Monoid ((<>)) +import Data.Word + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Internal as BS +import qualified Data.Vector.Storable as DVS + +toByteString :: DVS.Vector Word64 -> BS.ByteString +toByteString v = case DVS.unsafeToForeignPtr (DVS.unsafeCast v) of + (fptr, vOffset, vLength) -> BS.fromForeignPtr fptr vOffset vLength +{-# INLINE toByteString #-} + +rechunkAlignedAt :: Int -> [BS.ByteString] -> [BS.ByteString] +rechunkAlignedAt alignment = go + where go (bs:bss) = case BS.length bs of + bsLen -> if bsLen < alignment + then case alignment - bsLen of + bsNeed -> case bss of + (cs:css) -> case BS.length cs of + csLen | csLen > bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css) + csLen | csLen == bsNeed -> (bs <> cs ):go css + _ | otherwise -> go ((bs <> cs) :css) + [] -> [bs] + else case (bsLen `div` alignment) * alignment of + bsCroppedLen -> if bsCroppedLen == bsLen + then bs:go bss + else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss) + go [] = [] +{-# INLINE rechunkAlignedAt #-} + +rechunkPaddedAlignedAt :: Int -> [BS.ByteString] -> [BS.ByteString] +rechunkPaddedAlignedAt alignment = go + where go (bs:bss) = case BS.length bs of + bsLen -> if bsLen < alignment + then case alignment - bsLen of + bsNeed -> case bss of + (cs:css) -> case BS.length cs of + csLen | csLen > bsNeed -> (bs <> BS.take bsNeed cs ):go (BS.drop bsNeed cs:css) + csLen | csLen == bsNeed -> (bs <> cs ):go css + _ | otherwise -> go ((bs <> cs) :css) + [] -> [bs <> BS.replicate bsNeed 0] + else case (bsLen `div` alignment) * alignment of + bsCroppedLen -> if bsCroppedLen == bsLen + then bs:go bss + else BS.take bsCroppedLen bs:go (BS.drop bsCroppedLen bs:bss) + go [] = [] +{-# INLINE rechunkPaddedAlignedAt #-} diff --git a/src/HaskellWorks/Data/Simd/Internal/ByteString/Lazy.hs b/src/HaskellWorks/Data/Simd/Internal/ByteString/Lazy.hs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Internal/ByteString/Lazy.hs @@ -0,0 +1,11 @@ +module HaskellWorks.Data.Simd.Internal.ByteString.Lazy where + +import Data.Word + +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Vector.Storable as DVS +import qualified HaskellWorks.Data.Simd.Internal.ByteString as BS + +toByteString :: [DVS.Vector Word64] -> LBS.ByteString +toByteString vs = LBS.fromChunks $ BS.toByteString <$> vs +{-# INLINE toByteString #-} diff --git a/src/HaskellWorks/Data/Simd/Internal/Foreign.chs b/src/HaskellWorks/Data/Simd/Internal/Foreign.chs new file mode 100644 --- /dev/null +++ b/src/HaskellWorks/Data/Simd/Internal/Foreign.chs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} + +module HaskellWorks.Data.Simd.Internal.Foreign where + +import Foreign +import HaskellWorks.Data.Simd.Capabilities + +#include "../cbits/simd.h" + +type UInt8 = {#type uint8_t#} +type UInt64 = {#type uint64_t#} +type Size = {#type size_t#} + +avx2Memcpy :: Ptr UInt8 -> Ptr UInt8 -> Size -> IO () +avx2Memcpy target source len = requireAvx2 $ do + {#call unsafe avx2_memcpy as c_build_ibs#} target source len +{-# INLINE avx2Memcpy #-} + +avx2Cmpeq8 :: UInt8 -> Ptr UInt64 -> Size -> Ptr UInt8 -> IO () +avx2Cmpeq8 byte target targetLength source = requireAvx2 $ do + {#call unsafe avx2_cmpeq8 as c_cmpeq8#} byte target targetLength source +{-# INLINE avx2Cmpeq8 #-} diff --git a/test/HaskellWorks/Data/Simd/BroadwordSpec.hs b/test/HaskellWorks/Data/Simd/BroadwordSpec.hs new file mode 100644 --- /dev/null +++ b/test/HaskellWorks/Data/Simd/BroadwordSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module HaskellWorks.Data.Simd.BroadwordSpec (spec) where + +import Data.Maybe (fromJust) +import Data.Word +import HaskellWorks.Data.Bits.BitRead +import HaskellWorks.Data.Bits.BitShow +import HaskellWorks.Data.Simd.Internal.Broadword +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} +{-# ANN module ("HLint: redundant bracket" :: String) #-} + +spec :: Spec +spec = describe "HaskellWorks.Data.Simd.BroadwordSpec" $ do + it "Case 0" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000000 00000000 00000000 00000000 00000000 00000000 00000000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111111 11111111 11111111 11111111 11111111 11111111 11111111" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 0 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "11000111 11111000 00000000 00000000 00000000 00000000 00000011 11110000" :: Word64 + bitShow actual === bitShow expected + it "Case 1" $ requireProperty $ do + let actual = toggle64 1 $ fromJust $ bitRead "00100100 00000100 00000000 00000000 00000000 00000000 00000010 00001000" :: Word64 + let expected = fromJust $ bitRead "00111000 00000111 11111111 11111111 11111111 11111111 11111100 00001111" :: Word64 + bitShow actual === bitShow expected + +{- + normal case + ----------- + 00100100 + 11011011 + + 00010000 + 11011011 + + + 11000111 + carry case + ----------- + 00100100 + 11011011 + | | + 10000010 + 11011011 + + 00111000 +-} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}