1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
| fastLoadInto :: Handle -> LRNCacheRef -> IO (Either String ())
fastLoadInto h (RCR { rrefStripes = refs, rrefLastId = idmv }) =
fmap (either (\(e::CheckpointLoadException) -> Left $ show e) Right) . Exc.try $ do
let !bufsz = recsz * 1000000
!recsz = wsize * 2
!wsize = sizeOf (undefined :: Word64)
(!lastseq,!svcount,!blockcount) <- loadHeader h
!oldlastseq <- takeMVar idmv
F.allocaBytes bufsz $ \(ptr :: Ptr Word64) -> do
stripes <- fmap V.fromList . forM (V.toList refs) $ \ref -> takeMVar (lcrefLongMV ref) >> takeMVar (lcrefCacheMV ref)
let restoremvs = do
forM_ [0..stripeNumber 1] $ \stripenum ->
let ref = V.unsafeIndex refs stripenum in do
putMVar (lcrefCacheMV ref) $! V.unsafeIndex stripes stripenum
putMVar (lcrefLongMV ref) ()
tryPutMVar idmv oldlastseq
flip Exc.finally restoremvs $ do
let go !itemnum = do
done <- hIsEOF h
if done
then do
when (fromIntegral itemnum /= svcount + blockcount) $ Exc.throw $ CheckpointLoadException "Incorrect number of items loaded."
return ()
else do
bsz <- hGetBuf h ptr bufsz
let !recs = bsz `div` recsz
when (recs * recsz /= bsz) $ Exc.throw $ CheckpointLoadException "Could not load full record"
forM_ [0, 2 .. (recs * 2) 2] $ \(!offs) -> do
let inum = fromIntegral $ itemnum + (offs `div` 2) + 1
isblocks = inum > svcount
maxkey | isblocks = 7999999
| otherwise = 7999999999
!k <- peekElemOff ptr offs
!lrn <- fromIntegral <$> peekElemOff ptr (offs + 1)
let !bucket = stripeHash $ if isblocks then k * 1000 else k
lc = (V.!) stripes bucket
!j = if isblocks then lcJudyBlocks lc else lcJudyLRN lc
!ik = fromIntegral k
when (ik > maxkey) $ Exc.throw $ CheckpointLoadException $ "Corrupt file, entry out of range"
if lrn /= 0 then J.insert ik lrn j else J.delete ik j
go $! itemnum + recs
in do go 0
putMVar idmv $! lastseq
fastSaveTo :: Handle -> LRNCacheRef -> IO (Either String ())
fastSaveTo h (RCR { rrefStripes = refs, rrefLastId = idmv }) =
fmap (either (\(e::CheckpointLoadException) -> Left $ show e) Right) . Exc.try $ do
let !bufsz = recsz * bufitems
!bufitems = 1000000
!bufwords = bufsz `div` wsize
!recsz = wsize * 2
!wsize = sizeOf (undefined :: Word64)
!lastseq <- takeMVar idmv
F.allocaBytes bufsz $ \(ptr :: Ptr Word64) -> do
stripes <- fmap V.fromList . forM (V.toList refs) $ \ref -> takeMVar (lcrefLongMV ref) >> takeMVar (lcrefCacheMV ref)
let restoremvs = do
forM_ [0..stripeNumber 1] $ \stripenum ->
let ref = V.unsafeIndex refs stripenum in do
putMVar (lcrefCacheMV ref) $! V.unsafeIndex stripes stripenum
putMVar (lcrefLongMV ref) ()
tryPutMVar idmv lastseq
flip Exc.finally restoremvs $ do
let f (!sumsv,!sumblocks) (!numsv,!numblocks) = (sumsv + numsv, sumblocks + numblocks)
sumf LRNCache { lcJudyLRN = jlrn, lcJudyBlocks = jblocks } = do
szsv <- J.size jlrn
szblocks <- J.size jblocks
return $! (szsv,szblocks)
flushbuf !cnt = hPutBuf h ptr $ wsize * cnt
savestripes extractjf = do
remain <- foldM savejudy 0 . map extractjf $ V.toList stripes
when (remain > 0) $ flushbuf remain
savejudy !bufpos j = do
!curpos <- if bufpos == bufwords then flushbuf bufpos >> return 0 else return bufpos
J.foldIOPtr go curpos j
go !bufpos k vptr = do
!curpos <- if bufpos == bufwords then flushbuf bufpos >> return 0 else return bufpos
pokeElemOff ptr curpos $ fromIntegral k
peek vptr >>= (pokeElemOff ptr (curpos + 1) . fromIntegral)
return $! curpos + 2
hPutStr h $ "DIPCACHE" ++ [chr $ fromIntegral checkpointVersion]
(!svcount,!blockcount) <- foldl' f (0,0) <$> mapM sumf (V.toList stripes)
pokeElemOff ptr 0 lastseq
pokeElemOff ptr 1 $ fromIntegral svcount
pokeElemOff ptr 2 $ fromIntegral blockcount
hPutBuf h ptr $ wsize * 3
savestripes lcJudyLRN
savestripes lcJudyBlocks
return ()
|