vcache 0.2.1 → 0.2.2

raw patch · 3 files changed

+64/−12 lines, 3 files

Files

• hsrc_lib/Database/VCache/Read.hs +20/−6
• hsrc_lib/Database/VCache/VRef.hs +43/−5
• vcache.cabal +1/−1

@@ -2,12 +2,14 @@ module Database.VCache.Read     ( readAddrIO     , readRefctIO+    , withBytesIO     ) where  import Control.Monad import qualified Data.Map.Strict as Map import qualified Data.List as L import Control.Concurrent.MVar+import Data.Word import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc@@ -23,7 +25,11 @@ -- cache weight, or fails. This first tries reading the database, then -- falls back to reading from recent allocation frames.  readAddrIO :: VSpace -> Address -> VGet a -> IO (a, Int)-readAddrIO vc addr parser = +readAddrIO vc addr = withAddrValIO vc addr . readVal vc+{-# INLINE readAddrIO #-}++withAddrValIO :: VSpace -> Address -> (MDB_val -> IO a) -> IO a+withAddrValIO vc addr action =      alloca $ \ pAddr ->     poke pAddr addr >>     let vAddr = MDB_val { mv_data = castPtr pAddr@@ -31,18 +37,17 @@                         }     in     withRdOnlyTxn vc $ \ txn -> -    let db = vcache_db_memory vc in-    let rd = readVal vc parser in-    mdb_get' txn db vAddr >>= \ mbData ->+    mdb_get' txn (vcache_db_memory vc) vAddr >>= \ mbData ->     case mbData of-        Just vData -> rd vData -- found data in database (ideal)+        Just vData -> action vData -- found data in database (ideal)         Nothing -> -- since not in the database, try the allocator             let ff = Map.lookup addr . alloc_list in             readMVar (vcache_memory vc) >>= \ memory ->             let ac = mem_alloc memory in             case allocFrameSearch ff ac of-                Just an -> withByteStringVal (alloc_data an) rd -- found data in allocator+                Just an -> withByteStringVal (alloc_data an) action -- found data in allocator                 Nothing -> fail $ "VCache: address " ++ show addr ++ " is undefined!"+{-# NOINLINE withAddrValIO #-}  readVal :: VSpace -> VGet a -> MDB_val -> IO (a, Int) readVal vc p v = _vget (vgetFull p) s0 >>= retv where@@ -88,5 +93,14 @@     in     mdb_get' txn (vcache_db_refcts vc) vAddr >>= \ mbData ->     maybe (return 0) readRefctBytes mbData++-- | Zero-copy access to raw bytes for an address.+withBytesIO :: VSpace -> Address -> (Ptr Word8 -> Int -> IO a) -> IO a+withBytesIO vc addr action = +    withAddrValIO vc addr $ \ v -> +    action (mv_data v) (fromIntegral (mv_size v))+{-# INLINE withBytesIO #-}++  

@@ -1,4 +1,4 @@-+{-# LANGUAGE BangPatterns #-}  module Database.VCache.VRef     ( VRef@@ -9,11 +9,21 @@     , vref_space     , CacheMode(..)     , vrefc, derefc++    , withVRefBytes+    , unsafeVRefEncoding+     ) where  import Control.Monad import Data.IORef+import Data.Bits+import Data.Word+import Data.ByteString (ByteString)+import Foreign.Ptr+import Foreign.Storable import System.IO.Unsafe + import Database.VCache.Types import Database.VCache.Alloc import Database.VCache.Read@@ -69,10 +79,6 @@             (c', c' `seq` op) {-# NOINLINE derefc #-} ---- I've modified how VRefs are recorded -- -- | Dereference a VRef. This will read from the cache if the value -- is available, but will not update the cache. If the value is not -- cached, it will be read instead from the persistence layer.@@ -87,6 +93,38 @@         Cached r _ -> return r         NotCached -> liftM fst (readVRef v) {-# INLINABLE deref' #-}++-- | Specialized, zero-copy access to a `VRef ByteString`. Access to +-- the given ByteString becomes invalid after returning. This operation+-- may also block the writer if it runs much longer than a single+-- writer batch (though, writer batches are frequently large enough +-- that this shouldn't be a problem if you're careful).+--+withVRefBytes :: VRef ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a+withVRefBytes v action = unsafeVRefEncoding v $ \ p n ->+    -- valid ByteString encoding: varNat, bytes, 0 (children)+    readVarNat p 0 >>= \ (p', n') ->+    let bOK = (p' `plusPtr` n') == (p `plusPtr` (n-1)) in+    let eMsg = show v ++ " doesn't contain a ByteString" in+    unless bOK (fail $ "withVRefBytes: " ++ eMsg) >>+    action p' n'++readVarNat :: Ptr Word8 -> Int -> IO (Ptr Word8, Int)+readVarNat !p !n =+    peek p >>= \ w8 ->+    let p' = p `plusPtr` 1 in+    let n' = (n `shiftL` 7) + (fromIntegral $ w8 .&. 0x7f) in+    let bDone = (0 == (w8 .&. 0x80)) in+    if bDone then return (p', n') else+    readVarNat p' n'+    +-- | Zero-copy access to the raw encoding for any VRef. The given data+-- becomes invalid after returning. This is provided for mostly for+-- debugging purposes, i.e. so you can peek under the hood and see how+-- things are encoded or eyeball the encoding. +unsafeVRefEncoding :: VRef any -> (Ptr Word8 -> Int -> IO a) -> IO a+unsafeVRefEncoding v = withBytesIO (vref_space v) (vref_addr v)+{-# INLINE unsafeVRefEncoding #-}  -- | Each VRef has an numeric address in the VSpace. This address is -- non-deterministic, and essentially independent of the arguments to

@@ -1,5 +1,5 @@ Name: vcache-Version: 0.2.1+Version: 0.2.2 Synopsis: large, persistent, memcached values and structure sharing for Haskell  Category: Database Description: