From c89fa751d5cad7459b671da62c5de6ed5604dccd Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Sun, 28 Jun 2026 16:26:01 +0100 Subject: WIP stub znc parsing in C --- src/ZNC2.hs | 87 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 87 insertions(+) create mode 100644 src/ZNC2.hs (limited to 'src/ZNC2.hs') diff --git a/src/ZNC2.hs b/src/ZNC2.hs new file mode 100644 index 0000000..7a13f52 --- /dev/null +++ b/src/ZNC2.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +module ZNC2 where + +import Data.Array.Byte +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Short qualified as BSS +import Data.ByteString.Unsafe qualified as BS +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Encoding qualified as TE +import Foreign.C.Types +import Foreign.Ptr +import GHC.Exts +import GHC.IO (IO(IO)) +import GHC.Word +import System.IO.Unsafe (unsafePerformIO) + +import Util +import ZNC (Event(..)) + + +foreign import ccall unsafe "tirclogv_parse_znc_numevents" + c_parse_znc_numevents :: Ptr CChar -> CSize -> IO CSize + +foreign import ccall unsafe "tirclogv_parse_znc" + c_parse_znc :: MutableByteArray# RealWorld -> Ptr CChar -> CSize -> IO () + + +-- For each event: (total 28 bytes) +-- * 1 byte hour +-- * 1 byte minute +-- * 1 byte second +-- * 1 byte event kind +-- * 4 bytes text pointer 1 +-- * 4 bytes text length 1 +-- * 4 bytes text pointer 2 +-- * 4 bytes text length 2 +-- * 4 bytes text pointer 3 +-- * 4 bytes text length 3 +data Events = Events ByteArray# + +evRepSz :: Int +evRepSz = 28 + +parseLog :: ByteString -> [(HMS, Event)] +parseLog bs = + let !(Events ba#) = parseLogToEvents bs + nev = I# (sizeofByteArray# ba#) `quot` evRepSz + in [deserialise ba# i | i <- [0 .. nev-1]] + where + deserialise :: ByteArray# -> Int -> (HMS, Event) + deserialise ba# (I# i#) = + (HMS (byte 0) (byte 1) (byte 2) + ,case byte 3 of + 0 -> Join (textfield 0) (textfield 1)) + where + byte :: Int -> Word8 + byte (I# off#) = W8# (indexWord8Array# ba# (i# +# off#)) + + textfield :: Int -> Text + textfield (I# n#) = + let offset = W32# (indexWord32Array# ba# (i# +# 1# +# (2# *# n#))) + len = W32# (indexWord32Array# ba# (i# +# 2# +# (2# *# n#))) + -- slice = BS.unsafePackCStringLen -- safe because it's pinned + -- (Ptr (byteArrayContents# ba#) `plusPtr` fromIntegral @Word32 @Int offset + -- ,fromIntegral @Word32 @Int len) + in if BSS.isValidUtf8 (BSS.ShortByteString (ByteArray ba#)) + then _ else _ + +{-# NOINLINE parseLogToEvents #-} +parseLogToEvents :: ByteString -> Events +parseLogToEvents bs = unsafePerformIO $ + BS.unsafeUseAsCStringLen bs $ \(bsptr, bslen) -> do + let bslenCS = fromIntegral @Int @CSize bslen + numev <- c_parse_znc_numevents bsptr bslenCS + let !(I# numbytes#) = fromIntegral @CSize @Int numev * evRepSz + + MutableByteArray dst# <- + IO $ \s -> case newPinnedByteArray# numbytes# s of + (# s', mba# #) -> (# s', MutableByteArray mba# #) + c_parse_znc dst# bsptr bslenCS + IO $ \s -> case unsafeFreezeByteArray# dst# s of + (# s', ba# #) -> (# s', Events ba# #) -- cgit v1.3.1