diff --git a/dwarf-el.cabal b/dwarf-el.cabal --- a/dwarf-el.cabal +++ b/dwarf-el.cabal @@ -1,5 +1,5 @@ Name: dwarf-el -Version: 0.2.1.1 +Version: 0.3 License: BSD3 License-file: LICENSE Category: Data @@ -8,15 +8,13 @@ Maintainer: Eyal Lotem Stability: unstable Cabal-Version: >= 1.6 -Build-Depends: base Build-Type: Simple Synopsis: Parser for DWARF debug format. Description: Parser for DWARF debug format. library build-depends: base >= 2 && < 5, transformers >= 0.3, - bytestring, containers, binary, - utf8-string >= 0.3.7 + bytestring, containers, binary, text, text-show hs-source-dirs: src exposed-modules: Data.Dwarf other-modules: Data.Dwarf.Types, @@ -29,7 +27,7 @@ Data.Dwarf.OP, Data.Dwarf.TAG, Data.Dwarf.CFA - ghc-options: -Wall + ghc-options: -Wall -Widentities -Wmissing-home-modules -Wincomplete-patterns -Wnoncanonical-monad-instances -Wsemigroup -Wincomplete-record-updates -Wredundant-constraints source-repository head type: git diff --git a/src/Data/Dwarf.hs b/src/Data/Dwarf.hs --- a/src/Data/Dwarf.hs +++ b/src/Data/Dwarf.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Parses the DWARF 2 and DWARF 3 specifications at http://www.dwarfstd.org given -- the debug sections in ByteString form. @@ -34,35 +36,44 @@ , DW_DSC(..), dw_dsc ) where -import Control.Applicative (Applicative(..), (<$>), (<$)) -import Control.Arrow ((&&&), (***)) -import Control.Monad ((<=<)) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Writer (WriterT(..)) -import Data.Binary (Get) -import Data.Binary.Get (getWord8, getByteString) -import Data.Dwarf.AT -import Data.Dwarf.ATE -import Data.Dwarf.Form -import Data.Dwarf.LNI -import Data.Dwarf.OP -import Data.Dwarf.TAG -import Data.Dwarf.CFA -import Data.Dwarf.Reader -import Data.Dwarf.Types -import Data.Dwarf.Utils -import Data.Int (Int64) -import Data.Maybe (listToMaybe) -import Data.Traversable (traverse) -import Data.Word (Word64) +import Control.Applicative (Applicative(..), (<$>), (<$)) +import Control.Arrow ((&&&), (***)) +import Control.Monad ((<=<)) +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Writer (WriterT(..)) import qualified Control.Monad.Trans.Writer as Writer +import Data.Binary (Get) +import Data.Binary.Get (getWord8, getByteString) import qualified Data.Binary.Get as Get import qualified Data.ByteString as B +import Data.Dwarf.AT +import Data.Dwarf.ATE +import Data.Dwarf.CFA +import Data.Dwarf.Form +import Data.Dwarf.LNI +import Data.Dwarf.OP +import Data.Dwarf.Reader +import Data.Dwarf.TAG +import Data.Dwarf.Types +import Data.Dwarf.Utils +import Data.Int (Int64) import qualified Data.Map as M +import Data.Maybe (listToMaybe) +import Data.String (IsString(..)) +import Data.Text (Text) +import qualified Data.Text as Text +import Data.Traversable (traverse) +import Data.Word (Word64) +import GHC.Generics (Generic) +import Numeric (showHex) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) newtype CUOffset = CUOffset Word64 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow CUOffset where showbPrec = genericShowbPrec + -- Don't export a constructor, so users can only read DieID's, not -- create fake ones, which is slightly safer. dieID :: DieID -> Word64 @@ -88,8 +99,10 @@ -- Abbreviation and form parsing --------------------------------------------------------------------------------------------------------------------------------------------------------------- newtype AbbrevId = AbbrevId Word64 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow AbbrevId where showbPrec = genericShowbPrec + data DW_ABBREV = DW_ABBREV { abbrevId :: AbbrevId , abbrevTag :: DW_TAG @@ -133,7 +146,7 @@ pure $ if offset == 0 then Nothing else Just offset -- Section 7.19 - Name Lookup Tables -getNameLookupEntries :: Reader -> CUOffset -> Get [(String, [DieID])] +getNameLookupEntries :: Reader -> CUOffset -> Get [(Text, [DieID])] getNameLookupEntries dr cu_offset = whileJust $ traverse getEntry =<< getNonZeroOffset dr where @@ -151,24 +164,24 @@ cu_offset <- drGetOffset dr return (dr, CUOffset cu_offset) -getNameLookupTable :: TargetSize -> EndianReader -> Get [M.Map String [DieID]] +getNameLookupTable :: TargetSize -> EndianReader -> Get [M.Map Text [DieID]] getNameLookupTable target64 der = getWhileNotEmpty $ do (dr, cu_offset) <- getTableHeader target64 der _debug_info_length <- drGetOffset dr M.fromListWith (++) <$> getNameLookupEntries dr cu_offset -parsePubSection :: Endianess -> TargetSize -> B.ByteString -> M.Map String [DieID] +parsePubSection :: Endianess -> TargetSize -> B.ByteString -> M.Map Text [DieID] parsePubSection endianess target64 section = M.unionsWith (++) $ strictGet (getNameLookupTable target64 der) section where der = endianReader endianess -- | Parses the .debug_pubnames section (as ByteString) into a map from a value name to a DieID -parsePubnames :: Endianess -> TargetSize -> B.ByteString -> M.Map String [DieID] +parsePubnames :: Endianess -> TargetSize -> B.ByteString -> M.Map Text [DieID] parsePubnames = parsePubSection -- | Parses the .debug_pubtypes section (as ByteString) into a map from a type name to a DieID -parsePubtypes :: Endianess -> TargetSize -> B.ByteString -> M.Map String [DieID] +parsePubtypes :: Endianess -> TargetSize -> B.ByteString -> M.Map Text [DieID] parsePubtypes = parsePubSection align :: Integral a => a -> Get () @@ -179,8 +192,10 @@ data Range = Range { rangeBegin :: !Word64 , rangeEnd :: !Word64 - } deriving (Eq, Ord, Read, Show) + } deriving (Eq, Ord, Read, Show, Generic) +instance TextShow Range where showbPrec = genericShowbPrec + -- Section 7.20 - Address Range Table -- Returns the ranges that belong to a CU getAddressRangeTable :: TargetSize -> EndianReader -> Get [([Range], CUOffset)] @@ -206,17 +221,19 @@ let dr = endianReader endianess in strictGet (getAddressRangeTable target64 dr) aranges_section -{-# ANN module "HLint: ignore Use camelCase" #-} +{-# ANN module ("HLint: ignore Use camelCase"::String) #-} -- Section 7.21 - Macro Information data DW_MACINFO - = DW_MACINFO_define Word64 String -- ^ Line number and defined symbol with definition - | DW_MACINFO_undef Word64 String -- ^ Line number and undefined symbol + = DW_MACINFO_define Word64 Text -- ^ Line number and defined symbol with definition + | DW_MACINFO_undef Word64 Text -- ^ Line number and undefined symbol | DW_MACINFO_start_file Word64 Word64 -- ^ Marks start of file with the line where the file was included from and a source file index | DW_MACINFO_end_file -- ^ Marks end of file - | DW_MACINFO_vendor_ext Word64 String -- ^ Implementation defined - deriving (Eq, Ord, Read, Show) + | DW_MACINFO_vendor_ext Word64 Text -- ^ Implementation defined + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow DW_MACINFO where showbPrec = genericShowbPrec + -- | Retrieves the macro information for a compilation unit from a given substring of the .debug_macinfo section. The offset -- into the .debug_macinfo section is obtained from the DW_AT_macro_info attribute of a compilation unit DIE. parseMacInfo :: B.ByteString -> [DW_MACINFO] @@ -236,7 +253,7 @@ data DW_CIEFDE = DW_CIE - { cieAugmentation :: String + { cieAugmentation :: Text , cieCodeAlignmentFactor :: Word64 , cieDataAlignmentFactor :: Int64 , cieReturnAddressRegister :: Word64 @@ -248,8 +265,10 @@ , fdeAddressRange :: Word64 , fdeInstructions :: [DW_CFA] } - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow DW_CIEFDE where showbPrec = genericShowbPrec + getCIEFDE :: Endianess -> TargetSize -> Get DW_CIEFDE getCIEFDE endianess target64 = do let der = endianReader endianess @@ -328,7 +347,7 @@ , dieRefsSiblingLeft :: Maybe DieID -- ^ Unique identifier of the left sibling , dieRefsSiblingRight :: Maybe DieID -- ^ Unique identifier of the right sibling , dieRefsDIE :: DIE - } deriving (Show) + } deriving (Show, Generic) type DIEMap = M.Map DieID DIERefs type DIECollector = WriterT DIEMap @@ -343,12 +362,17 @@ , dieChildren :: [DIE] , dieReader :: Reader -- ^ Decoder used to decode this entry. May be needed to further parse attribute values. } -instance Show DIE where - show (DIE (DieID i) tag attrs children _) = - concat $ ["DIE@", show i, "{", show tag, " (", show (length children), " children)"] ++ concat - [ [" ", show attr, "=(", show val, ")"] - | (attr, val) <- attrs - ] ++ ["}"] +instance Show DIE where show = Text.unpack . showt +instance TextShow DIE where + showb (DIE (DieID i) tag attrs children _) = + mconcat $ mconcat + [ [ "DIE@", fromString (showHex i ""), "{", showb tag, " (", showb (length children), " children)"] + , mconcat + [ [" ", showb attr, "=(", showb val, ")"] + | (attr, val) <- attrs + ] + , [ "}" ] + ] addRefs :: Maybe DieID -> [DIE] -> [DIERefs] addRefs mParent = go Nothing @@ -373,7 +397,7 @@ cuContext@CUContext { cuReader = dr, cuOffset = cu, cuSections = dc } form = case form of - DW_FORM_addr -> DW_ATVAL_UINT . fromIntegral <$> drGetTargetAddress dr + DW_FORM_addr -> DW_ATVAL_UINT <$> drGetTargetAddress dr DW_FORM_block1 -> DW_ATVAL_BLOB <$> getByteStringLen getWord8 DW_FORM_block2 -> DW_ATVAL_BLOB <$> getByteStringLen (drGetW16 dr) DW_FORM_block4 -> DW_ATVAL_BLOB <$> getByteStringLen (drGetW32 dr) @@ -381,7 +405,7 @@ DW_FORM_data1 -> DW_ATVAL_UINT . fromIntegral <$> getWord8 DW_FORM_data2 -> DW_ATVAL_UINT . fromIntegral <$> drGetW16 dr DW_FORM_data4 -> DW_ATVAL_UINT . fromIntegral <$> drGetW32 dr - DW_FORM_data8 -> DW_ATVAL_UINT . fromIntegral <$> drGetW64 dr + DW_FORM_data8 -> DW_ATVAL_UINT <$> drGetW64 dr DW_FORM_udata -> DW_ATVAL_UINT <$> getULEB128 DW_FORM_sdata -> DW_ATVAL_INT <$> getSLEB128 DW_FORM_flag -> DW_ATVAL_BOOL . (/= 0) <$> getWord8 @@ -395,10 +419,10 @@ DW_FORM_sec_offset -> DW_ATVAL_UINT <$> drGetOffset dr DW_FORM_exprloc -> DW_ATVAL_BLOB <$> getByteStringLen getULEB128 DW_FORM_flag_present -> pure $ DW_ATVAL_BOOL True - DW_FORM_ref_sig8 -> DW_ATVAL_UINT . fromIntegral <$> drGetW64 dr + DW_FORM_ref_sig8 -> DW_ATVAL_UINT <$> drGetW64 dr DW_FORM_indirect -> getForm cuContext . dw_form =<< getULEB128 DW_FORM_strp -> do - offset <- fromIntegral <$> drGetOffset dr + offset <- drGetOffset dr pure . DW_ATVAL_STRING . getAt getUTF8Str0 offset $ dsStrSection dc diff --git a/src/Data/Dwarf/AT.hs b/src/Data/Dwarf/AT.hs --- a/src/Data/Dwarf/AT.hs +++ b/src/Data/Dwarf/AT.hs @@ -1,19 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.AT where -import Data.Dwarf.Types -import Data.Int (Int64) -import Data.Word (Word64) import qualified Data.ByteString as B +import Data.Dwarf.Types +import Data.Int (Int64) +import Data.Text (Text) +import Data.Word (Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data DW_ATVAL = DW_ATVAL_INT Int64 | DW_ATVAL_UINT Word64 | DW_ATVAL_REF DieID - | DW_ATVAL_STRING String + | DW_ATVAL_STRING Text | DW_ATVAL_BLOB B.ByteString | DW_ATVAL_BOOL Bool - deriving (Eq, Ord, Show) + deriving (Eq, Ord, Show, Generic) +instance TextShow DW_ATVAL where showbPrec = genericShowbPrec + data DW_AT = DW_AT_sibling -- ^ reference | DW_AT_location -- ^ block, loclistptr @@ -107,9 +114,42 @@ | DW_AT_const_expr | DW_AT_enum_class | DW_AT_linkage_name + + -- DWARF 5 + | DW_AT_string_length_bit_size + | DW_AT_string_length_byte_size + | DW_AT_rank + | DW_AT_str_offsets_base + | DW_AT_addr_base + | DW_AT_rnglists_base + | DW_AT_dwo_name + | DW_AT_reference + | DW_AT_rvalue_reference + | DW_AT_macros + | DW_AT_call_all_calls + | DW_AT_call_all_source_calls + | DW_AT_call_all_tail_calls + | DW_AT_call_return_pc + | DW_AT_call_value + | DW_AT_call_origin + | DW_AT_call_parameter + | DW_AT_call_pc + | DW_AT_call_tail_call + | DW_AT_call_target + | DW_AT_call_target_clobbered + | DW_AT_call_data_location + | DW_AT_call_data_value + | DW_AT_noreturn + | DW_AT_alignment + | DW_AT_export_symbols + | DW_AT_deleted + | DW_AT_defaulted + | DW_AT_loclists_base | DW_AT_user Word64 -- ^ user extension - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow DW_AT where showbPrec = genericShowbPrec + dw_at :: Word64 -> DW_AT dw_at 0x01 = DW_AT_sibling dw_at 0x02 = DW_AT_location @@ -203,5 +243,34 @@ dw_at 0x6c = DW_AT_const_expr dw_at 0x6d = DW_AT_enum_class dw_at 0x6e = DW_AT_linkage_name +dw_at 0x6f = DW_AT_string_length_bit_size +dw_at 0x70 = DW_AT_string_length_byte_size +dw_at 0x71 = DW_AT_rank +dw_at 0x72 = DW_AT_str_offsets_base +dw_at 0x73 = DW_AT_addr_base +dw_at 0x74 = DW_AT_rnglists_base +dw_at 0x76 = DW_AT_dwo_name +dw_at 0x77 = DW_AT_reference +dw_at 0x78 = DW_AT_rvalue_reference +dw_at 0x79 = DW_AT_macros +dw_at 0x7a = DW_AT_call_all_calls +dw_at 0x7b = DW_AT_call_all_source_calls +dw_at 0x7c = DW_AT_call_all_tail_calls +dw_at 0x7d = DW_AT_call_return_pc +dw_at 0x7e = DW_AT_call_value +dw_at 0x7f = DW_AT_call_origin +dw_at 0x80 = DW_AT_call_parameter +dw_at 0x81 = DW_AT_call_pc +dw_at 0x82 = DW_AT_call_tail_call +dw_at 0x83 = DW_AT_call_target +dw_at 0x84 = DW_AT_call_target_clobbered +dw_at 0x85 = DW_AT_call_data_location +dw_at 0x86 = DW_AT_call_data_value +dw_at 0x87 = DW_AT_noreturn +dw_at 0x88 = DW_AT_alignment +dw_at 0x89 = DW_AT_export_symbols +dw_at 0x8a = DW_AT_deleted +dw_at 0x8b = DW_AT_defaulted +dw_at 0x8c = DW_AT_loclists_base dw_at n | 0x2000 <= n && n <= 0x3fff = DW_AT_user n dw_at n = error $ "Unrecognized DW_AT " ++ show n diff --git a/src/Data/Dwarf/ATE.hs b/src/Data/Dwarf/ATE.hs --- a/src/Data/Dwarf/ATE.hs +++ b/src/Data/Dwarf/ATE.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.ATE where import Data.Word (Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data DW_ATE = DW_ATE_address @@ -18,7 +22,10 @@ | DW_ATE_signed_fixed | DW_ATE_unsigned_fixed | DW_ATE_decimal_float - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_ATE where showbPrec = genericShowbPrec + dw_ate :: Word64 -> DW_ATE dw_ate 0x01 = DW_ATE_address dw_ate 0x02 = DW_ATE_boolean diff --git a/src/Data/Dwarf/CFA.hs b/src/Data/Dwarf/CFA.hs --- a/src/Data/Dwarf/CFA.hs +++ b/src/Data/Dwarf/CFA.hs @@ -1,13 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.CFA where -import Control.Applicative (Applicative(..)) -import Data.Binary.Get (getWord8, Get) -import Data.Bits (shiftR, (.&.)) -import Data.Dwarf.Reader -import Data.Dwarf.Utils -import Data.Int (Int64) -import Data.Word (Word8, Word16, Word32, Word64) +import Control.Applicative (Applicative(..)) +import Data.Binary.Get (getWord8, Get) +import Data.Bits (shiftR, (.&.)) import qualified Data.ByteString as B +import Data.Dwarf.Reader +import Data.Dwarf.Utils +import Data.Int (Int64) +import Data.Word (Word8, Word16, Word32, Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) -- Section 7.22 - Call Frame data DW_CFA @@ -37,7 +41,10 @@ | DW_CFA_val_offset Word64 Word64 | DW_CFA_val_offset_sf Word64 Int64 | DW_CFA_val_expression Word64 B.ByteString - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_CFA where showbPrec = genericShowbPrec + getDW_CFA :: Reader -> Get DW_CFA getDW_CFA dr = do tag <- getWord8 diff --git a/src/Data/Dwarf/Form.hs b/src/Data/Dwarf/Form.hs --- a/src/Data/Dwarf/Form.hs +++ b/src/Data/Dwarf/Form.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.Form where import Data.Word (Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data DW_FORM = DW_FORM_addr -- ^ address @@ -28,7 +32,10 @@ | DW_FORM_exprloc -- ^ (Dwarf 4) | DW_FORM_flag_present -- ^ (Dwarf 4) | DW_FORM_ref_sig8 -- ^ (Dwarf 4) - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_FORM where showbPrec = genericShowbPrec + dw_form :: Word64 -> DW_FORM dw_form 0x01 = DW_FORM_addr dw_form 0x03 = DW_FORM_block2 diff --git a/src/Data/Dwarf/LNI.hs b/src/Data/Dwarf/LNI.hs --- a/src/Data/Dwarf/LNI.hs +++ b/src/Data/Dwarf/LNI.hs @@ -1,16 +1,22 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Dwarf.LNI where -import Control.Applicative (Applicative(..), (<$>)) -import Control.Monad (replicateM) -import Data.Binary (Binary(..), Get) -import Data.Binary.Get (getWord8) -import Data.Dwarf.Reader -import Data.Dwarf.Utils -import Data.Int (Int8, Int64) -import Data.Traversable (traverse) -import Data.Word (Word8, Word64) +import Control.Applicative (Applicative(..), (<$>)) +import Control.Monad (replicateM) +import Data.Binary (Binary(..), Get) +import Data.Binary.Get (getWord8) import qualified Data.Binary.Get as Get import qualified Data.ByteString as B +import Data.Dwarf.Reader +import Data.Dwarf.Utils +import Data.Int (Int8, Int64) +import Data.Text (Text) +import Data.Traversable (traverse) +import Data.Word (Word8, Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) -- Section 7.21 - Line Number Information data DW_LNI @@ -29,10 +35,13 @@ | DW_LNS_set_isa Word64 | DW_LNE_end_sequence | DW_LNE_set_address Word64 - | DW_LNE_define_file String Word64 Word64 Word64 - deriving (Eq, Ord, Read, Show) + | DW_LNE_define_file Text Word64 Word64 Word64 + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_LNI where showbPrec = genericShowbPrec + getDW_LNI :: Reader -> Int64 -> Word8 -> Word8 -> Word64 -> Get DW_LNI -getDW_LNI dr line_base line_range opcode_base minimum_instruction_length = fromIntegral <$> getWord8 >>= getDW_LNI_ +getDW_LNI dr line_base line_range opcode_base minimum_instruction_length = getWord8 >>= getDW_LNI_ where getDW_LNI_ 0x00 = do rest <- getByteStringLen getULEB128 pure $ strictGet getDW_LNE rest @@ -125,9 +134,12 @@ , lnmPrologueEnd :: Bool , lnmEpilogueBegin :: Bool , lnmISA :: Word64 - , lnmFiles :: [(String, Word64, Word64, Word64)] - } deriving (Eq, Ord, Read, Show) -defaultLNE :: Bool -> [(String, Word64, Word64, Word64)] -> DW_LNE + , lnmFiles :: [(Text, Word64, Word64, Word64)] + } deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_LNE where showbPrec = genericShowbPrec + +defaultLNE :: Bool -> [(Text, Word64, Word64, Word64)] -> DW_LNE defaultLNE is_stmt files = DW_LNE { lnmAddress = 0 , lnmFile = 1 @@ -144,12 +156,12 @@ -- | Retrieves the line information for a DIE from a given substring of the .debug_line section. The offset -- into the .debug_line section is obtained from the DW_AT_stmt_list attribute of a DIE. -parseLNE :: Endianess -> TargetSize -> Word64 -> B.ByteString -> ([String], [DW_LNE]) +parseLNE :: Endianess -> TargetSize -> Word64 -> B.ByteString -> ([Text], [DW_LNE]) parseLNE endianess target64 offset bs = let dr = endianReader endianess in getAt (getLNE target64 dr) offset bs -getDebugLineFileNames :: Get [(String, Word64, Word64, Word64)] +getDebugLineFileNames :: Get [(Text, Word64, Word64, Word64)] getDebugLineFileNames = whileJust $ traverse entry =<< getNonEmptyUTF8Str0 where entry file_name = do @@ -158,7 +170,7 @@ file_length <- getULEB128 pure (file_name, dir_index, last_mod, file_length) -getLNE :: TargetSize -> EndianReader -> Get ([String], [DW_LNE]) +getLNE :: TargetSize -> EndianReader -> Get ([Text], [DW_LNE]) getLNE target64 der = do (desr, endPos) <- getUnitLength der let dr = reader target64 desr diff --git a/src/Data/Dwarf/OP.hs b/src/Data/Dwarf/OP.hs --- a/src/Data/Dwarf/OP.hs +++ b/src/Data/Dwarf/OP.hs @@ -1,12 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.OP where -import Control.Applicative (Applicative(..), (<$>)) -import Data.Binary.Get (getWord8, Get) -import Data.Dwarf.Reader -import Data.Dwarf.Utils -import Data.Int (Int8, Int16, Int32, Int64) -import Data.Word (Word8, Word16, Word32, Word64) +import Control.Applicative (Applicative(..), (<$>)) +import Data.Binary.Get (getWord8, Get) import qualified Data.ByteString as B +import Data.Dwarf.Reader +import Data.Dwarf.Utils +import Data.Int (Int8, Int16, Int32, Int64) +import Data.Word (Word8, Word16, Word32, Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data DW_OP = DW_OP_addr Word64 @@ -68,7 +72,10 @@ | DW_OP_form_tls_address | DW_OP_call_frame_cfa | DW_OP_bit_piece Word64 Word64 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_OP where showbPrec = genericShowbPrec + -- | Parse a ByteString into a DWARF opcode. This will be needed for further decoding of DIE attributes. parseDW_OP :: Reader -> B.ByteString -> DW_OP parseDW_OP = strictGet . getDW_OP @@ -78,11 +85,11 @@ getDW_OP_ :: Word8 -> Get DW_OP getDW_OP_ 0x03 = pure DW_OP_addr <*> drGetTargetAddress dr getDW_OP_ 0x06 = pure DW_OP_deref - getDW_OP_ 0x08 = pure DW_OP_const1u <*> fromIntegral <$> getWord8 + getDW_OP_ 0x08 = pure DW_OP_const1u <*> getWord8 getDW_OP_ 0x09 = pure DW_OP_const1s <*> fromIntegral <$> getWord8 - getDW_OP_ 0x0a = pure DW_OP_const2u <*> fromIntegral <$> drGetW16 dr + getDW_OP_ 0x0a = pure DW_OP_const2u <*> drGetW16 dr getDW_OP_ 0x0b = pure DW_OP_const2s <*> fromIntegral <$> drGetW16 dr - getDW_OP_ 0x0c = pure DW_OP_const4u <*> fromIntegral <$> drGetW32 dr + getDW_OP_ 0x0c = pure DW_OP_const4u <*> drGetW32 dr getDW_OP_ 0x0d = pure DW_OP_const4s <*> fromIntegral <$> drGetW32 dr getDW_OP_ 0x0e = pure DW_OP_const8u <*> drGetW64 dr getDW_OP_ 0x0f = pure DW_OP_const8s <*> fromIntegral <$> drGetW64 dr diff --git a/src/Data/Dwarf/Reader.hs b/src/Data/Dwarf/Reader.hs --- a/src/Data/Dwarf/Reader.hs +++ b/src/Data/Dwarf/Reader.hs @@ -1,17 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.Reader where -import Control.Applicative ((<$>), pure) -import Data.Binary.Get (getWord16be, getWord32be, getWord64be, getWord16le, getWord32le, getWord64le, Get) -import Data.Word (Word16, Word32, Word64) +import Control.Applicative ((<$>), pure) +import Data.Binary.Get (getWord16be, getWord32be, getWord64be, getWord16le, getWord32le, getWord64le, Get) import qualified Data.Binary.Get as Get +import Data.Word (Word16, Word32, Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data Endianess = LittleEndian | BigEndian - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow Endianess where showbPrec = genericShowbPrec + data Encoding = Encoding32 | Encoding64 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow Encoding where showbPrec = genericShowbPrec + data TargetSize = TargetSize32 | TargetSize64 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) +instance TextShow TargetSize where showbPrec = genericShowbPrec + endianReader :: Endianess -> EndianReader endianReader LittleEndian = EndianReader LittleEndian getWord16le getWord32le getWord64le endianReader BigEndian = EndianReader BigEndian getWord16be getWord32be getWord64be @@ -46,8 +58,6 @@ , derGetW32 :: Get Word32 , derGetW64 :: Get Word64 } -instance Show EndianReader where - show der = "EndianReader " ++ show (derEndianess der) -- Intermediate data structure for a partial Reader. data EndianSizeReader = EndianSizeReader @@ -56,8 +66,6 @@ , desrLargestOffset :: Word64 , desrGetOffset :: Get Word64 } -instance Show EndianSizeReader where - show desr = "EndianSizeReader " ++ show (desrEndianReader desr) ++ " " ++ show (desrEncoding desr) -- | Type containing functions and data needed for decoding DWARF information. data Reader = Reader @@ -66,8 +74,6 @@ , drLargestTargetAddress :: Word64 -- ^ Largest permissible target address. , drGetTargetAddress :: Get Word64 -- ^ Action for reading a pointer for the target machine. } -instance Show Reader where - show dr = "Reader " ++ show (drDesr dr) ++ " " ++ show (drTarget64 dr) -- Decode the DWARF size header entry, which specifies both the size of a DWARF subsection and whether this section uses DWARF32 or DWARF64. getUnitLength :: EndianReader -> Get (EndianSizeReader, Word64) diff --git a/src/Data/Dwarf/TAG.hs b/src/Data/Dwarf/TAG.hs --- a/src/Data/Dwarf/TAG.hs +++ b/src/Data/Dwarf/TAG.hs @@ -1,9 +1,13 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Dwarf.TAG where import Control.Applicative (pure) import Data.Binary.Get (Get) import Data.Dwarf.Utils import Data.Word (Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) data DW_TAG = DW_TAG_array_type @@ -64,7 +68,9 @@ | DW_TAG_condition | DW_TAG_shared_type | DW_TAG_user Word64 -- index into the user range of tags 0x4080 becomes 0 - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_TAG where showbPrec = genericShowbPrec getDW_TAG :: Get DW_TAG getDW_TAG = getULEB128 >>= dw_tag diff --git a/src/Data/Dwarf/Types.hs b/src/Data/Dwarf/Types.hs --- a/src/Data/Dwarf/Types.hs +++ b/src/Data/Dwarf/Types.hs @@ -1,20 +1,32 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Dwarf.Types where -import Data.Word (Word64) +import Data.Monoid ((<>)) +import qualified Data.Text as Text +import Data.Word (Word64) +import GHC.Generics (Generic) +import TextShow (TextShow(..)) +import TextShow.Generic (genericShowbPrec) newtype DieID = DieID Word64 deriving (Eq, Ord) -instance Show DieID where - show (DieID x) = "DIE@" ++ show x +instance TextShow DieID where + showb (DieID x) = "DIE@" <> showb x +instance Show DieID where show = Text.unpack . showt + data DW_DS = DW_DS_unsigned | DW_DS_leading_overpunch | DW_DS_trailing_overpunch | DW_DS_leading_separate | DW_DS_trailing_separate - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_DS where showbPrec = genericShowbPrec + dw_ds :: Word64 -> DW_DS dw_ds 0x01 = DW_DS_unsigned dw_ds 0x02 = DW_DS_leading_overpunch @@ -27,7 +39,10 @@ = DW_END_default | DW_END_big | DW_END_little - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_END where showbPrec = genericShowbPrec + dw_end :: Word64 -> DW_END dw_end 0x00 = DW_END_default dw_end 0x01 = DW_END_big @@ -38,7 +53,10 @@ = DW_ACCESS_public | DW_ACCESS_protected | DW_ACCESS_private - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_ACCESS where showbPrec = genericShowbPrec + dw_access :: Word64 -> DW_ACCESS dw_access 0x01 = DW_ACCESS_public dw_access 0x02 = DW_ACCESS_protected @@ -49,7 +67,10 @@ = DW_VIS_local | DW_VIS_exported | DW_VIS_qualified - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_VIS where showbPrec = genericShowbPrec + dw_vis :: Word64 -> DW_VIS dw_vis 0x01 = DW_VIS_local dw_vis 0x02 = DW_VIS_exported @@ -60,7 +81,10 @@ = DW_VIRTUALITY_none | DW_VIRTUALITY_virtual | DW_VIRTUALITY_return_virtual - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_VIRTUALITY where showbPrec = genericShowbPrec + dw_virtuality :: Word64 -> DW_VIRTUALITY dw_virtuality 0x00 = DW_VIRTUALITY_none dw_virtuality 0x01 = DW_VIRTUALITY_virtual @@ -88,7 +112,10 @@ | DW_LANG_UPC | DW_LANG_D | DW_LANG_User Int -- 0x8000..0xFFFF - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_LANG where showbPrec = genericShowbPrec + dw_lang :: Word64 -> DW_LANG dw_lang 0x0001 = DW_LANG_C89 dw_lang 0x0002 = DW_LANG_C @@ -120,7 +147,10 @@ | DW_ID_up_case | DW_ID_down_case | DW_ID_case_insensitive - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_ID where showbPrec = genericShowbPrec + dw_id :: Word64 -> DW_ID dw_id 0x00 = DW_ID_case_sensitive dw_id 0x01 = DW_ID_up_case @@ -132,7 +162,10 @@ = DW_CC_normal | DW_CC_program | DW_CC_nocall - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_CC where showbPrec = genericShowbPrec + dw_cc :: Word64 -> DW_CC dw_cc 0x01 = DW_CC_normal dw_cc 0x02 = DW_CC_program @@ -144,7 +177,10 @@ | DW_INL_inlined | DW_INL_declared_not_inlined | DW_INL_declared_inlined - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_INL where showbPrec = genericShowbPrec + dw_inl :: Word64 -> DW_INL dw_inl 0x00 = DW_INL_not_inlined dw_inl 0x01 = DW_INL_inlined @@ -155,7 +191,10 @@ data DW_ORD = DW_ORD_row_major | DW_ORD_col_major - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_ORD where showbPrec = genericShowbPrec + dw_ord :: Word64 -> DW_ORD dw_ord 0x00 = DW_ORD_row_major dw_ord 0x01 = DW_ORD_col_major @@ -164,7 +203,10 @@ data DW_DSC = DW_DSC_label | DW_DSC_range - deriving (Eq, Ord, Read, Show) + deriving (Eq, Ord, Read, Show, Generic) + +instance TextShow DW_DSC where showbPrec = genericShowbPrec + dw_dsc :: Word64 -> DW_DSC dw_dsc 0x00 = DW_DSC_label dw_dsc 0x01 = DW_DSC_range diff --git a/src/Data/Dwarf/Utils.hs b/src/Data/Dwarf/Utils.hs --- a/src/Data/Dwarf/Utils.hs +++ b/src/Data/Dwarf/Utils.hs @@ -1,14 +1,16 @@ module Data.Dwarf.Utils where -import Control.Applicative (Applicative(..), (<$>), (*>)) -import Data.Binary.Get (getByteString, getWord8, Get, runGet) -import Data.Bits ((.|.), shiftL, clearBit, testBit) -import Data.Int (Int64) -import Data.Word (Word64) +import Control.Applicative (Applicative(..), (<$>), (*>)) +import Data.Binary.Get (getByteString, getWord8, Get, runGet) import qualified Data.Binary.Get as Get +import Data.Bits ((.|.), shiftL, clearBit, testBit) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString.UTF8 as UTF8 +import Data.Int (Int64) +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding +import Data.Word (Word64) whileJust :: (Applicative m, Monad m) => m (Maybe a) -> m [a] whileJust act = go @@ -20,7 +22,7 @@ Just x -> (x :) <$> go -- Repeatedly perform the get operation until the boolean fails. -whileM :: (Applicative m, Monad m) => (a -> Bool) -> m a -> m [a] +whileM :: Monad m => (a -> Bool) -> m a -> m [a] whileM cond act = whileJust $ do res <- act pure $ @@ -42,13 +44,13 @@ getByteStringLen lenGetter = getByteString =<< fromIntegral <$> lenGetter -getUTF8Str0 :: Get String -getUTF8Str0 = UTF8.toString . B.pack <$> whileM (/= 0) getWord8 +getUTF8Str0 :: Get Text +getUTF8Str0 = Encoding.decodeUtf8 . B.pack <$> whileM (/= 0) getWord8 -getNonEmptyUTF8Str0 :: Get (Maybe String) +getNonEmptyUTF8Str0 :: Get (Maybe Text) getNonEmptyUTF8Str0 = do str <- getUTF8Str0 - pure $ if null str then Nothing else Just str + pure $ if Text.null str then Nothing else Just str -- Decode a signed little-endian base 128 encoded integer. getSLEB128 :: Get Int64 @@ -60,7 +62,7 @@ go temp (shift + 7) else if shift < 32 && testBit byte 6 then - pure $ fromIntegral $ temp .|. ((-1) `shiftL` shift) + pure $ fromIntegral $ temp .|. (maxBound `shiftL` shift) else pure $ fromIntegral temp in go 0 0