Skip to content

Commit

Permalink
Merge pull request #170 from GaloisInc/vr/subword-without-aligned
Browse files Browse the repository at this point in the history
remove `Aligned` from `SubWord`
  • Loading branch information
Ptival authored Oct 13, 2021
2 parents dd7f25a + b1616a2 commit 4b2e006
Showing 1 changed file with 23 additions and 27 deletions.
50 changes: 23 additions & 27 deletions src/Data/LLVM/BitCode/GetBits.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,12 +13,11 @@ module Data.LLVM.BitCode.GetBits (

import Data.LLVM.BitCode.BitString

import Control.Applicative (Applicative(..),Alternative(..),(<$>))
import Control.Applicative (Alternative(..))
import Control.Arrow (first)
import Control.Monad (MonadPlus(..),when,replicateM_)
import Data.Bits (shiftR)
import Data.ByteString (ByteString)
import Data.Monoid (mempty,mappend)
import Data.Word (Word32)
import qualified Data.Serialize as C

Expand All @@ -34,7 +33,7 @@ newtype GetBits a = GetBits { unGetBits :: SubWord -> C.Get (a,SubWord) }
-- | Run a @GetBits@ action, returning its value, and the number of bits offset
-- into the next byte of the stream.
runGetBits :: GetBits a -> C.Get a
runGetBits m = fst `fmap` unGetBits m Aligned
runGetBits m = fst `fmap` unGetBits m aligned

instance Functor GetBits where
{-# INLINE fmap #-}
Expand Down Expand Up @@ -90,33 +89,34 @@ instance MonadPlus GetBits where
-- files get padded to a 32-bit boundary.
data SubWord
= SubWord !Int !Word32
| Aligned
deriving (Show)

splitWord :: Int -> Int -> Word32 -> (BitString,Either Int SubWord)
splitWord n l w = case compare n l of
LT -> (toBitString n (fromIntegral w), Right (SubWord (l - n) (w `shiftR` n)))
EQ -> (toBitString n (fromIntegral w), Right Aligned)
GT -> (toBitString l (fromIntegral w), Left (n - l))
aligned :: SubWord
aligned = SubWord 0 0

splitWord :: Int -> SubWord -> (BitString, Either Int SubWord)
splitWord n (SubWord l w)
| n <= l = (toBitString n (fromIntegral w), Right (SubWord (l - n) (w `shiftR` n)))
| otherwise = (toBitString l (fromIntegral w), Left (n - l))

-- | @getBitString n@ grabs a @BitString@ of length @n@ from the next incoming
-- word, yielding the remainder partial word. On @n@ = @0@, it does not
-- actually consume the next word. Should not be called to read more than one
-- 32-bit word at a time (will fail on @n@ > 32).
getBitString :: Int -> C.Get (BitString, SubWord)
getBitString 0 = return (mempty, Aligned)
getBitString 0 = return (mempty, aligned)
getBitString n | n > 32 =
fail $ "getBitString: refusing to read " ++ show n ++ " (> 32) bits."
getBitString n = getBitStringPartial n 32 =<< C.getWord32le

-- | @getBitStringPartial n l w@ returns a @BitString@ of length @n@ from either
-- the current subword @w@ (with @l@ bits available), potentially also reading
-- the next incoming word if @n@ > @l@. Should not be called to read more than
-- one 32-bit word at a time (will fail on @n@ > 32).
getBitStringPartial :: Int -> Int -> Word32 -> C.Get (BitString, SubWord)
getBitStringPartial n _ _ | n > 32 =
getBitString n = getBitStringPartial n . SubWord 32 =<< C.getWord32le

-- | @getBitStringPartial n sw@ returns a @BitString@ of length @n@ from either
-- the current subword @sw@ (with some @l@ bits available), potentially also
-- reading the next incoming word if @n@ > @l@. Should not be called to read
-- more than one 32-bit word at a time (will fail on @n@ > 32).
getBitStringPartial :: Int -> SubWord -> C.Get (BitString, SubWord)
getBitStringPartial n _ | n > 32 =
fail $ "getBitStringPartial: refusing to read " ++ show n ++ " (> 32) bits."
getBitStringPartial n l w = case splitWord n l w of
getBitStringPartial n sw = case splitWord n sw of
(bs, Right off) -> return (bs, off)
(bs, Left n') -> do
(rest, off) <- getBitString n'
Expand All @@ -129,32 +129,28 @@ skipZeroByte = do
when (x /= 0) $ fail "alignment padding was not zeros"

-- | Get a @ByteString@ of @n@ bytes, and then align to 32 bits.
getByteString :: Int -> C.Get (ByteString,SubWord)
getByteString :: Int -> C.Get (ByteString, SubWord)
getByteString n = do
bs <- C.getByteString n
replicateM_ ((- n) `mod` 4) skipZeroByte
return (bs, Aligned)
return (bs, aligned)


-- Basic Interface -------------------------------------------------------------

-- | Read zeros up to an alignment of 32-bits.
align32bits :: GetBits ()
align32bits = GetBits $ \ off -> case off of
Aligned -> return ((),Aligned)
SubWord _ 0 -> return ((),Aligned)
SubWord _ 0 -> return ((), aligned)
SubWord _ _ -> fail "alignment padding was not zeros"

-- | Read out n bits as a @BitString@.
fixed :: Int -> GetBits BitString
fixed n = GetBits $ \ off -> case off of
Aligned -> getBitString n
SubWord l w -> getBitStringPartial n l w
fixed n = GetBits $ getBitStringPartial n

-- | Read out n bytes as a @ByteString@, aligning to a 32-bit boundary before and after.
bytestring :: Int -> GetBits ByteString
bytestring n = GetBits $ \ off -> case off of
Aligned -> getByteString n
SubWord _ 0 -> getByteString n
SubWord _ _ -> fail "alignment padding was not zeros"

Expand Down

0 comments on commit 4b2e006

Please sign in to comment.