summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cbits/znc.c261
-rw-r--r--src/Index.hs39
-rw-r--r--src/Main.hs2
-rw-r--r--src/ZNC/Parser.hs139
-rw-r--r--src/ZNC/Slow.hs (renamed from src/ZNC.hs)2
-rw-r--r--src/ZNC2.hs129
-rw-r--r--tirclogv.cabal4
7 files changed, 287 insertions, 289 deletions
diff --git a/cbits/znc.c b/cbits/znc.c
index 5bac7fd..3647395 100644
--- a/cbits/znc.c
+++ b/cbits/znc.c
@@ -6,13 +6,12 @@
#include <assert.h>
#include <emmintrin.h>
-// TODO: this still setfaults
-// $ cre tirclogv
-// *Main> :m *ZNC2
-// *ZNC2> :seti -XOverloadedStrings
-// *ZNC2> parseLog "[12:34:56] <nick> hoi!"
-// Error: [Cabal-7125]
-// repl failed for exe:tirclogv from tirclogv-0.1.0.0. The build process segfaulted (i.e. SIGSEGV).
+#if 0
+#include <stdio.h>
+#define DEBUG(...) fprintf(stderr, "[znc2] " __VA_ARGS__)
+#else
+#define DEBUG(...)
+#endif
struct scanner {
@@ -22,17 +21,17 @@ struct scanner {
};
enum event_kind {
- JOIN = 0,
- PART = 1,
- QUIT = 2,
- RENICK = 3,
- TALK = 4,
- NOTICE = 5,
- ACT = 6,
- KICK = 7,
- MODE = 8,
- TOPIC = 9,
- PARSEERROR = 10,
+ PARSEERROR = 0,
+ JOIN = 1,
+ PART = 2,
+ QUIT = 3,
+ RENICK = 4,
+ TALK = 5,
+ NOTICE = 6,
+ ACT = 7,
+ KICK = 8,
+ MODE = 9,
+ TOPIC = 10,
};
#pragma pack(1)
@@ -43,6 +42,24 @@ struct event {
uint16_t len1, len2, len3;
};
+static inline bool isdigit_char(char c) {
+ return c >= '0' && c <= '9';
+}
+
+// Exists to avoid UB by strict aliasing rule
+static inline uint32_t load_uint32(const char *ptr) {
+ uint32_t val;
+ memcpy(&val, ptr, 4);
+ return val;
+}
+
+// Exists to avoid UB by strict aliasing rule
+static inline uint64_t load_uint64(const char *ptr) {
+ uint64_t val;
+ memcpy(&val, ptr, 8);
+ return val;
+}
+
// parses "[HH:MM:SS] " including the trailing space
static bool parse_hms(struct scanner *s, struct event *dest) {
const char *const loc = &s->buf[s->cur];
@@ -73,6 +90,15 @@ static inline bool eat_bytes(struct scanner *s, const char *tok, size_t toklen)
#define EAT_BYTES(scanner_, tok_) eat_bytes(scanner_, tok_, strlen(tok_))
+static void skip_until(struct scanner *s, char delim) {
+ const char *const buf = s->buf;
+ const size_t len = s->len;
+ const size_t cur = s->cur;
+ const char *p = memchr(buf + cur, delim, len - cur);
+ if (p == NULL) s->cur = len;
+ else s->cur = p - buf;
+}
+
static bool parse_nick(struct scanner *s, uint32_t *destptr, uint16_t *destlen) {
// Delimiter bytes:
// \t \n \v \r SP < >
@@ -88,14 +114,14 @@ static bool parse_nick(struct scanner *s, uint32_t *destptr, uint16_t *destlen)
const size_t startcur = s->cur;
size_t cur = startcur;
- while (cur + 4 <= len && (*(uint32_t*)&buf[cur] & 0x40404040U) == 0x40404040U) cur += 4;
- while (cur < len && (buf[cur] & 0x40) == 0) cur++;
+ while (cur < len && (buf[cur] & 0x40) == 0x40) cur++;
while (cur < len &&
buf[cur] != '\t' && buf[cur] != '\n' && buf[cur] != '\v' && buf[cur] != '\r' &&
buf[cur] != ' ' && buf[cur] != '<' && buf[cur] != '>')
cur++;
if (cur == startcur) return false;
+ if ((uint16_t)(cur - startcur) != cur - startcur) return false;
*destptr = startcur;
*destlen = cur - startcur;
s->cur = cur;
@@ -107,24 +133,15 @@ static bool parse_inside_parens(struct scanner *s, uint32_t *destptr, uint16_t *
const size_t len = s->len;
size_t cur = s->cur;
- if (cur + 2 >= len) return false;
+ if (cur + 1 >= len) return false;
if (buf[cur] != '(') return false;
cur++;
const size_t startcur = cur;
if (len - cur < 16) goto tail_loop;
- {
- const int nunaligned = (16 - (uintptr_t)(buf + cur) % 16) % 16;
- for (int i = 0; i < nunaligned; i++, cur++) {
- if (buf[cur] == ')') goto close_found;
- if (buf[cur] == '\n') return false;
- }
- }
-
- // now that we're aligned:
while (cur + 16 <= len) {
- const __m128i vec = _mm_load_si128((const __m128i*)(buf + cur));
+ const __m128i vec = _mm_loadu_si128((const __m128i*)(buf + cur));
if (_mm_movemask_epi8(_mm_cmpeq_epi8(vec, _mm_set1_epi8(')' ))) != 0) break;
if (_mm_movemask_epi8(_mm_cmpeq_epi8(vec, _mm_set1_epi8('\n'))) != 0) return false;
cur += 16;
@@ -138,6 +155,7 @@ tail_loop:
}
close_found:
+ if ((uint16_t)(cur - startcur) != cur - startcur) return false;
*destptr = startcur;
*destlen = cur - startcur;
s->cur = cur + 1; // skip the closing paren
@@ -151,19 +169,20 @@ static bool parse_enclose_tail(
const size_t len = s->len;
size_t cur = s->cur;
- if (cur + 2 >= len) return false;
+ if (cur + 1 >= len) return false;
if (buf[cur] != leftdelim) return false;
cur++;
const size_t startcur = cur;
const char *p = memchr(buf + cur, '\n', len - cur);
- if (p == NULL) return false;
- cur = p - (buf + cur);
+ if (p == NULL) cur = len;
+ else cur = p - buf;
if (cur == startcur) return false;
const size_t rightdelim_cur = cur - 1;
if (buf[rightdelim_cur] != rightdelim) return false;
+ if ((uint16_t)(rightdelim_cur - startcur) != rightdelim_cur - startcur) return false;
*destptr = startcur;
*destlen = rightdelim_cur - startcur;
s->cur = cur; // skip the rightdelim, point to the newline
@@ -180,8 +199,9 @@ static bool parse_remaining(struct scanner *s, uint32_t *destptr, uint16_t *dest
const size_t startcur = cur;
const char *p = memchr(buf + cur, '\n', len - cur);
if (p == NULL) return false;
- cur = p - (buf + cur);
+ cur = p - buf;
+ if ((uint16_t)(cur - startcur) != cur - startcur) return false;
*destptr = startcur;
*destlen = cur - startcur;
s->cur = cur;
@@ -191,18 +211,29 @@ static bool parse_remaining(struct scanner *s, uint32_t *destptr, uint16_t *dest
// Assumes the "Joins: " etc. prefix has already been consumed
static bool parse_useract(struct scanner *s, struct event *dest, bool withtail) {
if (!parse_nick(s, &dest->ptr1, &dest->len1)) return false;
+ DEBUG(" parse_useract nick\n");
if (!EAT_BYTES(s, " ")) return false;
+ DEBUG(" parse_useract space\n");
if (!parse_inside_parens(s, &dest->ptr2, &dest->len2)) return false;
- if (withtail)
+ DEBUG(" parse_useract parens\n");
+ if (withtail) {
+ if (!EAT_BYTES(s, " ")) return false;
+ DEBUG(" parse_useract space2\n");
if (!parse_enclose_tail(s, &dest->ptr3, &dest->len3, '(', ')')) return false;
+ DEBUG(" parse_useract tail\n");
+ }
return true;
}
static bool parse_eventdata(struct scanner *s, struct event *dest) {
+ DEBUG(" parse_eventdata cur=%zu\n", s->cur);
if (EAT_BYTES(s, "*** ")) {
if (EAT_BYTES(s, "Joins: ")) {
dest->kind = JOIN;
- return parse_useract(s, dest, false);
+ if (!parse_useract(s, dest, false)) return false;
+ // znc prints nickserv account name after parentheses since znc 1.9.0; skip it
+ skip_until(s, '\n');
+ return true;
}
if (EAT_BYTES(s, "Parts: ")) {
dest->kind = PART;
@@ -237,9 +268,12 @@ static bool parse_eventdata(struct scanner *s, struct event *dest) {
}
if (EAT_BYTES(s, "<")) {
+ // DEBUG(" Ate '<'\n");
dest->kind = TALK;
if (!parse_nick(s, &dest->ptr1, &dest->len1)) return false;
+ // DEBUG(" Nick %u %hu\n", dest->ptr1, dest->len1);
if (!EAT_BYTES(s, "> ")) return false;
+ // DEBUG(" Ate '> '\n");
return parse_remaining(s, &dest->ptr2, &dest->len2);
}
@@ -254,7 +288,7 @@ static bool parse_eventdata(struct scanner *s, struct event *dest) {
dest->ptr1 = ptr1;
dest->len1 = len1;
- if (!EAT_BYTES(s, "> ")) return false;
+ if (!EAT_BYTES(s, " ")) return false;
return parse_remaining(s, &dest->ptr2, &dest->len2);
}
@@ -268,133 +302,88 @@ static bool parse_eventdata(struct scanner *s, struct event *dest) {
return false;
}
-static size_t tirclogv_parse_znc_loop(uint8_t *events_, const char *buf, size_t len) {
+static size_t tirclogv_parse_znc_loop(
+ uint8_t *events_, size_t max_events, const char *buf, size_t len
+) {
+ // offsets are stored in a uint32_t, so the buffer can't be too large
+ if ((uint32_t)len != len) return 0;
+
assert(sizeof(struct event) == 22);
struct event *events = (struct event*)events_;
+ struct event dummyevent;
struct scanner s = (struct scanner){.buf = buf, .len = len, .cur = 0};
size_t numev = 0;
- while (len > 0) {
- if (!parse_hms(&s, &events[numev])) goto parseerror;
- if (!parse_eventdata(&s, &events[numev])) goto parseerror;
+ while (s.cur < s.len && numev < max_events) {
+ DEBUG("cur=%zu len=%zu\n", s.cur, s.len);
+ if (!parse_hms(&s, events ? &events[numev] : &dummyevent)) goto parseerror;
+ DEBUG(" hms\n");
+ if (!parse_eventdata(&s, events ? &events[numev] : &dummyevent)) goto parseerror;
+ DEBUG(" evdata cur=%zu len=%zu buf[cur]=%u\n", s.cur, s.len, (unsigned)s.buf[s.cur]);
if (s.cur != s.len && s.buf[s.cur] != '\n') goto parseerror;
+ s.cur++; // skip the newline
numev++;
continue;
parseerror:
- memset(&events[numev], 0, sizeof(struct event));
+ assert(PARSEERROR == 0);
+ if (events) memset(&events[numev], 0, sizeof(struct event));
numev++;
const char *p = memchr(buf + s.cur, '\n', len - s.cur);
if (p == NULL) break;
s.cur += (p + 1) - (buf + s.cur);
}
+ DEBUG("ret numev=%zu\n", numev);
return numev;
}
-size_t tirclogv_parse_znc_numevents(const char *buf, size_t len) {
- return tirclogv_parse_znc_loop(NULL, buf, len);
-}
-
-void tirclogv_parse_znc(uint8_t *events, const char *buf, size_t len) {
- tirclogv_parse_znc_loop(events, buf, len);
+// Assumes there is space for evs_allocated * sizeof(struct event) items in events.
+size_t tirclogv_parse_znc(uint8_t *events, size_t evs_allocated, const char *buf, size_t len) {
+ return tirclogv_parse_znc_loop(events, evs_allocated, buf, len);
}
+size_t tirclogv_count_lines(const char *buf, size_t len) {
+ size_t numln = 0;
-// UPBITS(3) = 0b1110'0000
-#define UPBITS(n) ((uint8_t)~((1 << (8 - n)) - 1))
-
-// If you're afraid of goto: don't worry, it's just a state machine
-static size_t tirclogv_fix_utf8_loop(char *out, const char *buf, size_t len) {
- const char *replacement_char = "\xef\xbf\xbd";
- const int replacement_length = 3;
-
- size_t cur = 0, block_start = 0;
- size_t multibyte_start = 0; // only valid if ncont > 0
- int ncont = 0; // number of continuation bytes expected now
- size_t out_cur = 0;
-
-restart: // At this label, ncont must be 0
- if (cur == len) return out_cur;
- if ((uintptr_t)(buf + cur) % 16 == 0) goto vect_loop_16;
+ if (len == 0) return 0;
+ if (buf[len - 1] == '\n') len--; // we actually count the number of '\n' below
-perbyte_untilalign: // supports ncont > 0
- {
- size_t ntogo = 16 - (uintptr_t)(buf + cur) % 16;
- if (len - cur < ntogo) ntogo = len - cur;
+ const int vecwidth = 16;
+ const int unrollcount = 2;
- if (ntogo >= 8 && ncont == 0) {
- if ((*(uint64_t*)(buf + cur) & 0x8080808080808080) == 0) {
- cur += 8;
- ntogo -= 8;
- }
- }
-
- // TODO: speed up checking of multi-byte characters
- for (size_t i = 0; i < ntogo; i++, cur++) {
- const char c = buf[cur];
- if ((c & UPBITS(1)) == 0) {
- if (ncont > 0) goto incorrect_byte;
- } else if ((c & UPBITS(2)) == UPBITS(1)) {
- if (ncont == 0) goto incorrect_byte;
- ncont--;
- } else if ((c & UPBITS(3)) == UPBITS(2)) {
- if (ncont > 0) goto incorrect_byte;
- multibyte_start = cur;
- ncont = 1;
- } else if ((c & UPBITS(4)) == UPBITS(3)) {
- if (ncont > 0) goto incorrect_byte;
- multibyte_start = cur;
- ncont = 2;
- } else if ((c & UPBITS(5)) == UPBITS(4)) {
- if (ncont > 0) goto incorrect_byte;
- multibyte_start = cur;
- ncont = 3;
- } else goto incorrect_byte;
- }
- }
+ while (len >= vecwidth * unrollcount) {
+ const int iter_size = vecwidth * unrollcount;
+ size_t niters = len / iter_size;
+ if (niters > 256) niters = 256; // make sure we're not overflowing the bytes
- if (cur == len) {
- if (ncont > 0) {
- if (out) memcpy(out + out_cur, buf + block_start, multibyte_start - block_start);
- out_cur += multibyte_start - block_start;
- if (out) memcpy(out + out_cur, replacement_char, replacement_length);
- out_cur += replacement_length;
- } else {
- if (out) memcpy(out + out_cur, buf + block_start, cur - block_start);
- out_cur += cur - block_start;
+ assert(unrollcount == 2);
+ __m128i acc0, acc1;
+ acc0 = acc1 = _mm_set1_epi8(0);
+ for (size_t i = 0; i < niters; i++) {
+ const __m128i vec0 = _mm_loadu_si128((const __m128i*)(buf + vecwidth * (unrollcount * i + 0)));
+ const __m128i vec1 = _mm_loadu_si128((const __m128i*)(buf + vecwidth * (unrollcount * i + 1)));
+ // since cmpeq returns 0xff/0x00 for true/false, "+= (eq == 0xff)" == "-= eq"
+ // (GCC is able to see that "+= (cmpeq(...) == 0xff)" can be optimised to
+ // "-= cmpeq(...)", but then proceeds to mess things up and generates
+ // bad, quirky code anyway, so we do the optimisation manually)
+ acc0 = _mm_sub_epi8(acc0, _mm_cmpeq_epi8(vec0, _mm_set1_epi8('\n')));
+ acc1 = _mm_sub_epi8(acc1, _mm_cmpeq_epi8(vec1, _mm_set1_epi8('\n')));
}
- return out_cur;
- }
+ acc0 = _mm_add_epi8(acc0, acc1);
-vect_loop_16: // requires buf+cur to be 16-byte aligned
- if (ncont > 0) goto perbyte_untilalign;
- for (; cur + 16 <= len; cur += 16) {
- const __m128i vec = _mm_load_si128((const __m128i*)(buf + cur));
- // movemask takes all the top bits, which is nicely the non-ascii bytes
- if (_mm_movemask_epi8(vec) != 0) goto perbyte_untilalign;
- }
- if (cur == len) return out_cur;
- goto perbyte_untilalign; // handle unaligned tail
+ uint8_t bytes[vecwidth];
+ memcpy(bytes, &acc0, vecwidth);
+#pragma GCC novector // the generated vector code is rather dumb (lots of punpck{l,h})
+ for (int i = 0; i < vecwidth; i++) numln += bytes[i];
-incorrect_byte: // requires buf[cur] is an incorrect byte (and thus cur < len);
- {
- const size_t good_until = ncont == 0 ? cur : multibyte_start;
- if (out) memcpy(out + out_cur, buf + block_start, good_until - block_start);
- out_cur += good_until - block_start;
+ buf += niters * iter_size;
+ len -= niters * iter_size;
}
- if (out) memcpy(out + out_cur, replacement_char, replacement_length);
- out_cur += replacement_length;
- cur += 1;
- ncont = 0;
- block_start = cur;
- goto restart;
-}
-size_t tirclogv_fix_utf8_length(const char *buf, size_t off, size_t len) {
- return tirclogv_fix_utf8_loop(NULL, buf + off, len);
-}
+#pragma GCC novector
+ for (size_t i = 0; i < len; i++)
+ numln += buf[i] == '\n';
-void tirclogv_fix_utf8(char *out, const char *buf, size_t off, size_t len) {
- tirclogv_fix_utf8_loop(out, buf + off, len);
+ return numln;
}
diff --git a/src/Index.hs b/src/Index.hs
index 221be78..d9a1379 100644
--- a/src/Index.hs
+++ b/src/Index.hs
@@ -26,7 +26,6 @@ import Control.Monad (forM, forM_, when, guard)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe
import Data.ByteString qualified as BS
-import Data.ByteString (ByteString)
import Data.Char (isDigit, chr, ord)
import Data.Functor ((<&>))
import Data.IORef
@@ -43,7 +42,6 @@ import Data.Vector.Generic qualified as VG
import Data.Vector.Generic.Mutable qualified as VGM
import Data.Vector.Unboxed qualified as VU
import Data.Vector.Unboxed.Base qualified as VU (Vector(V_2))
-import Data.Vector.Storable qualified as VS
import Data.Word
import System.Clock qualified as Clock
import System.Directory
@@ -59,7 +57,7 @@ import Config (Channel(..), prettyChannel)
import ImmutGrowVector qualified as IGV
import Mmap
import Util
-import ZNC
+import ZNC.Parser
-- This module keeps an index both for the full list of events, as well as a
@@ -136,7 +134,7 @@ ciEndDay ci =
-- simple data structure is fine.
data Index = Index !FilePath
!(Map Channel (IORef ChanIndex))
- !(Cache (Channel, YMD) (ByteString, VS.Vector Word32))
+ !(Cache (Channel, YMD) RawEvents)
type EventID = Text
@@ -287,8 +285,9 @@ indexUpdateImport index@(Index _ mp _) chan = do
dayidx = fromIntegral @Integer @Int (day `diffDays` ciStartDay ci)
loadDay index chan ymd >>= \case
- Just (bs, lineStarts) ->
- return (Just (dayidx, Counts (VS.length lineStarts) (countCompressed (map snd (parseLog bs)))))
+ Just raw ->
+ return (Just (dayidx, Counts (rawNumEvents raw)
+ (countCompressed (map snd (realiseEvents raw)))))
Nothing -> return Nothing
atomicPrint $ "Update import for " <> prettyChannel chan <> ": " <> T.show readCounts <> " (len = " <> T.show (IGV.length (ciCountUntil ci)) <> ")"
@@ -375,17 +374,17 @@ indexGetEventsLinear index@(Index _ mp _) chan kind from count = do
| otherwise = scan IGV.! dayidx - scan IGV.! (dayidx - 1)
rangeStart = if day == day1 then off1 else 0
rangeEnd = if day == day2 then off2 else neventsOnDay
- range = (rangeStart, Just (rangeEnd - rangeStart))
+ range = (rangeStart, rangeEnd)
ymd = ymdFromGregorian (toGregorian day)
in if neventsOnDay > 0
then loadDay index chan ymd <&> \case
- Just (bs, lineStarts) -> case kind of
+ Just raw -> case kind of
CKAll ->
- let events = parseLogRange range lineStarts bs
+ let events = realiseEventsRange raw range
in [(YMDHMS ymd hms, genEventID (YMDHMS ymd hms) off, ev)
| ((hms, ev), off) <- zip events [rangeStart ..]]
CKCompressed ->
- let events = parseLog bs
+ let events = realiseEvents raw
events' = take (rangeEnd - rangeStart) $ drop rangeStart $
compressEvents [((hms, off), ev) | ((hms, ev), off) <- zip events [0..]]
in [(YMDHMS ymd hms, genEventID (YMDHMS ymd hms) off, ev) | ((hms, off), ev) <- events']
@@ -429,16 +428,16 @@ findEventIDLinear index@(Index _ mp _) chan kind eid = runMaybeT $ do
ci <- lift $ readIORef (mp Map.! chan)
guard (ciStartDay ci <= day && day <= ciEndDay ci)
- (bs, lineStarts) <- MaybeT $ loadDay index chan ymd
+ raw <- MaybeT $ loadDay index chan ymd
let candidates = -- [(event offset, index in possibly compressed event list)]
map snd $
takeWhile ((== hms) . fst) $
dropWhile ((< hms) . fst) $
case kind of
- CKAll -> zip (parseLogTimesOnly lineStarts bs) (zip [0..] [0..])
+ CKAll -> zip (map fst (realiseEvents raw)) (zip [0..] [0..])
CKCompressed ->
let compressed = compressEvents [((hms', off), ev)
- | ((hms', ev), off) <- zip (parseLog bs) [0..]]
+ | ((hms', ev), off) <- zip (realiseEvents raw) [0..]]
in [(hms', (off, idx)) | (((hms', off), _ev), idx) <- zip compressed [0..]]
case candidates of
[] -> empty
@@ -473,8 +472,8 @@ indexGetEventsDay index@(Index _ mp _) chan kind day = do
if day < ciStartDay ci || day > ciEndDay ci
then return (firstlast, [])
else loadDay index chan ymd <&> \case
- Just (bs, _lineStarts) ->
- let events = parseLog bs
+ Just raw ->
+ let events = realiseEvents raw
events' = case kind of
CKAll ->
[(hms, genEventID (YMDHMS ymd hms) off, ev)
@@ -488,17 +487,17 @@ indexGetEventsDay index@(Index _ mp _) chan kind day = do
-- utilities
-loadDay :: Index -> Channel -> YMD -> IO (Maybe (ByteString, VS.Vector Word32))
+loadDay :: Index -> Channel -> YMD -> IO (Maybe RawEvents)
loadDay (Index basedir _ cache) chan@(Channel network channel) ymd = do
cacheLookup cache (chan, ymd) >>= \case
Nothing -> do
mapFile (basedir </> T.unpack network </> T.unpack channel </> toFileName ymd) >>= \case
Just bs -> do
- let lineStarts = preparseLog bs
- cacheAdd cache (chan, ymd) (bs, lineStarts)
- return (Just (bs, lineStarts))
+ let raw = parseLogRaw bs
+ cacheAdd cache (chan, ymd) raw
+ return (Just raw)
Nothing -> return Nothing -- file didn't exist
- Just (bs, lineStarts) -> return (Just (bs, lineStarts))
+ Just raw -> return (Just raw)
isImportant :: Event -> Bool
isImportant ReNick{} = True
diff --git a/src/Main.hs b/src/Main.hs
index a06aef8..e592fce 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -31,7 +31,7 @@ import Config
import Index
import Pages
import Util
-import ZNC
+import ZNC.Parser
sendHtml200 :: ByteString -> IO Response
diff --git a/src/ZNC/Parser.hs b/src/ZNC/Parser.hs
new file mode 100644
index 0000000..1a31840
--- /dev/null
+++ b/src/ZNC/Parser.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module ZNC.Parser (
+ Nick, Event(..),
+ parseLog,
+ RawEvents, rawNumEvents, realiseEvents, realiseEventsRange, parseLogRaw,
+) where
+
+import Data.Array.Byte
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Unsafe qualified as BSU
+import Data.Text (Text)
+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
+
+
+foreign import ccall unsafe "tirclogv_count_lines"
+ -- file buf length num events
+ c_count_lines :: Ptr CChar -> CSize -> IO CSize
+
+foreign import ccall unsafe "tirclogv_parse_znc"
+ -- events buffer evbufsz file buf length actual num events
+ c_parse_znc :: MutableByteArray# RealWorld -> CSize -> Ptr CChar -> CSize -> IO CSize
+
+
+type Nick = Text
+
+-- Adapted from clogparse by Keegan McAllister (BSD3) (https://hackage.haskell.org/package/clogparse).
+data Event
+ = Join Nick Text -- ^ User joined.
+ | Part Nick Text Text -- ^ User left the channel. (address, reason)
+ | Quit Nick Text Text -- ^ User quit the server. (address, reason)
+ | ReNick Nick Nick -- ^ User changed from one to another nick.
+ | Talk Nick Text -- ^ User spoke (@PRIVMSG@).
+ | Notice Nick Text -- ^ User spoke (@NOTICE@).
+ | Act Nick Text -- ^ User acted (@CTCP ACTION@).
+ | Kick Nick Nick Text -- ^ User was kicked by user. (kicked, kicker, reason)
+ | Mode Nick Text -- ^ User set mode on the channel.
+ | Topic Nick Text -- ^ Topic change.
+ | ParseError
+ | Compressed Text -- ^ Fake event generated when compressing multiple meta events in "Index"
+ deriving (Show)
+
+
+-- For each event: (`struct event` on the C sode; total 22 bytes)
+-- * 1 byte hour
+-- * 1 byte minute
+-- * 1 byte second
+-- * 1 byte event kind
+-- * 4 bytes text pointer 1
+-- * 4 bytes text pointer 2
+-- * 4 bytes text pointer 3
+-- * 2 bytes text length 1
+-- * 2 bytes text length 2
+-- * 2 bytes text length 3
+evRepSz :: Int
+evRepSz = 22
+
+-- | Retains the original ByteString.
+data RawEvents = RawEvents
+ ByteString -- original data parsed
+ Int -- actual number of events (may be smaller than allocated capacity in ByteArray#)
+ ByteArray# -- parsed array of `struct event`; pinned
+
+parseLog :: ByteString -> [(HMS, Event)]
+parseLog = realiseEvents . parseLogRaw
+
+rawNumEvents :: RawEvents -> Int
+rawNumEvents (RawEvents _ nev _) = nev
+
+-- | This is a good list producer.
+realiseEvents :: RawEvents -> [(HMS, Event)]
+realiseEvents raw@(RawEvents _ nev _) = realiseEventsRange raw (0, nev)
+
+-- | This is a good list producer. Range is (inclusive, exclusive).
+realiseEventsRange :: RawEvents -> (Int, Int) -> [(HMS, Event)]
+realiseEventsRange (RawEvents bs _ ba#) (startidx, endidx) =
+ [deserialise i | i <- [startidx .. endidx - 1]]
+ where
+ deserialise :: Int -> (HMS, Event)
+ deserialise i =
+ (HMS (byte 0) (byte 1) (byte 2)
+ ,case byte 3 of
+ 1 -> Join (textfield 0) (textfield 1)
+ 2 -> Part (textfield 0) (textfield 1) (textfield 2)
+ 3 -> Quit (textfield 0) (textfield 1) (textfield 2)
+ 4 -> ReNick (textfield 0) (textfield 1)
+ 5 -> Talk (textfield 0) (textfield 1)
+ 6 -> Notice (textfield 0) (textfield 1)
+ 7 -> Act (textfield 0) (textfield 1)
+ 8 -> Kick (textfield 0) (textfield 1) (textfield 2)
+ 9 -> Mode (textfield 0) (textfield 1)
+ 10 -> Topic (textfield 0) (textfield 1)
+ _ {- includes 0 -} -> ParseError
+ )
+ where
+ byte :: Int -> Word8
+ byte off = readWord8 (i * evRepSz + off)
+
+ textfield :: Int -> Text
+ textfield n =
+ let offset = fromIntegral @Word32 @Int (readWord32 (i * evRepSz + 4 + 4 * n))
+ len = fromIntegral @Word16 @Int (readWord16 (i * evRepSz + 16 + 2 * n))
+ in TE.decodeUtf8Lenient (BS.take len (BS.drop offset bs))
+
+ readWord32 :: Int -> Word32
+ readWord32 (I# i#) = W32# (indexWord8ArrayAsWord32# ba# i#)
+
+ readWord16 :: Int -> Word16
+ readWord16 (I# i#) = W16# (indexWord8ArrayAsWord16# ba# i#)
+
+ readWord8 :: Int -> Word8
+ readWord8 (I# i#) = W8# (indexWord8Array# ba# i#)
+
+-- | The 'ByteString' is retained inside the 'RawEvents'.
+{-# NOINLINE parseLogRaw #-}
+parseLogRaw :: ByteString -> RawEvents
+parseLogRaw bs = unsafePerformIO $
+ BSU.unsafeUseAsCStringLen bs $ \(bsptr, bslen) -> do
+ let bslenCS = fromIntegral @Int @CSize bslen
+ numev <- c_count_lines bsptr bslenCS
+ let !(I# numbytes#) = fromIntegral @CSize @Int numev * evRepSz
+
+ MutableByteArray dst# <-
+ IO $ \s -> case newPinnedByteArray# numbytes# s of
+ (# s', mba# #) -> (# s', MutableByteArray mba# #)
+ realnumev <- c_parse_znc dst# numev bsptr bslenCS
+ IO $ \s -> case unsafeFreezeByteArray# dst# s of
+ (# s', ba# #) -> (# s', RawEvents bs (fromIntegral @CSize @Int realnumev) ba# #)
diff --git a/src/ZNC.hs b/src/ZNC/Slow.hs
index 502b272..0d7666f 100644
--- a/src/ZNC.hs
+++ b/src/ZNC/Slow.hs
@@ -1,5 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
-module ZNC (
+module ZNC.Slow (
-- Log(..),
Nick, Event(..),
preparseLog,
diff --git a/src/ZNC2.hs b/src/ZNC2.hs
deleted file mode 100644
index bcd4fb3..0000000
--- a/src/ZNC2.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-module ZNC2 where
-
-import Data.Array.Byte
-import Data.ByteString (ByteString)
-import Data.ByteString.Unsafe qualified as BS
-import Data.Text (Text)
-import Data.Text.Internal qualified as TI
-import Data.Text.Internal.Validate (isValidUtf8ByteArray)
-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"
- -- file buf length num events
- c_parse_znc_numevents :: Ptr CChar -> CSize -> IO CSize
-
-foreign import ccall unsafe "tirclogv_parse_znc"
- -- events buffer file buf length
- c_parse_znc :: MutableByteArray# RealWorld -> Ptr CChar -> CSize -> IO ()
-
-foreign import ccall unsafe "tirclogv_fix_utf8_length"
- -- byte buf offset length length of fixed
- c_fix_utf8_length :: ByteArray# -> CSize -> CSize -> IO CSize
-
-foreign import ccall unsafe "tirclogv_fix_utf8"
- -- output buffer byte buf offset length
- c_fix_utf8 :: MutableByteArray# RealWorld -> ByteArray# -> CSize -> CSize -> IO ()
-
-
--- For each event: (total 22 bytes)
--- * 1 byte hour
--- * 1 byte minute
--- * 1 byte second
--- * 1 byte event kind
--- * 4 bytes text pointer 1
--- * 4 bytes text pointer 2
--- * 4 bytes text pointer 3
--- * 2 bytes text length 1
--- * 2 bytes text length 2
--- * 2 bytes text length 3
-data Events = Events ByteArray# -- pinned
-
-evRepSz :: Int
-evRepSz = 20
-
-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 =
- (HMS (byte 0) (byte 1) (byte 2)
- ,case byte 3 of
- 0 -> Join (textfield 0) (textfield 1)
- 1 -> Part (textfield 0) (textfield 1) (textfield 2)
- 2 -> Quit (textfield 0) (textfield 1) (textfield 2)
- 3 -> ReNick (textfield 0) (textfield 1)
- 4 -> Talk (textfield 0) (textfield 1)
- 5 -> Notice (textfield 0) (textfield 1)
- 6 -> Act (textfield 0) (textfield 1)
- 7 -> Kick (textfield 0) (textfield 1) (textfield 2)
- 8 -> Mode (textfield 0) (textfield 1)
- 9 -> Topic (textfield 0) (textfield 1)
- _ {- includes 10 -} -> ParseError
- )
- where
- byte :: Int -> Word8
- byte off = indexWord8Array ba# (i * evRepSz + off)
-
- textfield :: Int -> Text
- textfield n =
- let offset = fromIntegral @Word32 @Int (indexWord8ArrayAsWord32 ba# (i * evRepSz + 4 + 4 * n))
- len = fromIntegral @Word16 @Int (indexWord8ArrayAsWord16 ba# (i * evRepSz + 16 + 2 * n))
- in if isValidUtf8ByteArray (ByteArray ba#) offset len
- then TI.Text (ByteArray ba#) offset len
- else fixUtf8ByteArray ba# offset len
-
- indexWord8ArrayAsWord32 :: ByteArray# -> Int -> Word32
- indexWord8ArrayAsWord32 ba# (I# i#) = W32# (indexWord8ArrayAsWord32# ba# i#)
-
- indexWord8ArrayAsWord16 :: ByteArray# -> Int -> Word16
- indexWord8ArrayAsWord16 ba# (I# i#) = W16# (indexWord8ArrayAsWord16# ba# i#)
-
- indexWord8Array :: ByteArray# -> Int -> Word8
- indexWord8Array ba# (I# i#) = W8# (indexWord8Array# ba# i#)
-
-{-# 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# #)
-
--- | Returns an unpinned byte array
-{-# NOINLINE fixUtf8ByteArray #-}
-fixUtf8ByteArray :: ByteArray# -> Int -> Int -> Text
-fixUtf8ByteArray input# offset len = unsafePerformIO $ do
- let offCS = fromIntegral @Int @CSize offset
- lenCS = fromIntegral @Int @CSize len
- outlenCS <- c_fix_utf8_length input# offCS lenCS
-
- let !outlen@(I# outlen#) = fromIntegral @CSize @Int outlenCS
- MutableByteArray dst# <-
- IO $ \s -> case newByteArray# outlen# s of
- (# s', mba# #) -> (# s', MutableByteArray mba# #)
- c_fix_utf8 dst# input# offCS lenCS
- IO $ \s -> case unsafeFreezeByteArray# dst# s of
- (# s', ba# #) -> (# s', TI.Text (ByteArray ba#) 0 outlen #)
diff --git a/tirclogv.cabal b/tirclogv.cabal
index fe402e2..74b23f0 100644
--- a/tirclogv.cabal
+++ b/tirclogv.cabal
@@ -32,8 +32,8 @@ executable tirclogv
Pages
Pages.TH
Util
- ZNC
- ZNC2
+ -- ZNC.Slow
+ ZNC.Parser
build-depends:
base >= 4.20,
escapexml,
generated by cgit v1.3.1 (git 2.54.0) at 2026-08-07 09:21:04 +0200