module Bindings.Bfd (
Bfd (ptr)
, initialize
, targetsAndFormats
, open
, close
, closeAllDone
, checkFormat
, getDisasm
, getFilename
, Bindings.Bfd.getFlags
, getFormat
, getHasMap
, getIsCacheable
, getIsTargetDefaulted
, getIsThinArchive
, getMachine
, getMyArchive
, getOctetsPerByte
, getTarget
, getStartAddress
, getSymbolCount
, getSectionCount
, getSectionByName
, getSectionByVma
, getSections
, getSymbolTable
, getDynamicSymbolTable
, getDynamicRelocations
, demangle
, Bfd'
, Bindings.Bfd.mk
) where
import Control.Exception ( catch )
import Control.Monad ( foldM )
import Data.Bits ( (.&.), bit )
import Data.Word ( Word )
import Foreign.C ( CString, CInt, CUInt, newCString, peekCString
, withCString )
import Foreign.Marshal ( free, mallocArray, peekArray, toBool )
import Foreign.Ptr ( Ptr, nullPtr, wordPtrToPtr )
import Foreign.Storable ( Storable, alignment, peek, peekByteOff, poke, sizeOf )
import Prelude hiding ( catch )
import Bindings.Bfd.Disasm ( Disasm )
import Bindings.Bfd.Exception ( BfdException
, throwExceptionIfFalse
, throwExceptionIfNull )
import Bindings.Bfd.Flags as BfdFlags ( Flags ( HasReloc ) )
import Bindings.Bfd.Format ( Format ( Object ) )
import Bindings.Bfd.Misc ( Vma, Vma' )
import Bindings.Bfd.Relocation ( Relocation )
import Bindings.Bfd.Section as Section ( Section, SectionName
, getNext, getSize, getVma )
import Bindings.Bfd.SymbolTable as SymbolTable ( SymbolTable, mk, tablePtr )
import Bindings.Bfd.Target as Target ( Target, TargetName
, canonicalizeDynamicReloc
, canonicalizeDynamicSymtab
, canonicalizeSymtab
, getDynamicRelocUpperBound
, getDynamicSymtabUpperBound
, getName, getSymtabUpperBound
, listSupported )
data Bfd = Bfd {
ptr :: Ptr Bfd'
, filePath :: CString
, target :: CString
, mode :: CString
}
deriving (Show)
initialize
:: IO ()
initialize = c_bfd_init
targetsAndFormats
:: FilePath
-> IO [(TargetName, Format)]
targetsAndFormats file =
do
ts <- Target.listSupported
let
perms = [ (t,f) | t <- ts, f <- enumFrom Object ]
foldM g [] perms
where
g xs r@(t,f) =
do
bfd <- open file (Just t) "r"
xvec1 <- getTarget bfd
tn1 <- Target.getName xvec1
ok <- catch (checkFormat bfd f) ((\_ -> return False) :: BfdException -> IO Bool)
_ <- close bfd
case ok of
True ->
do
xvec2 <- getTarget bfd
tn2 <- Target.getName xvec2
if tn1 == tn2
then return $ r : xs
else return xs
False -> return xs
open
:: FilePath
-> Maybe TargetName
-> String
-> IO Bfd
open fp targ mode0 =
do
fp' <- newCString fp
targ' <-
case targ of
Just t -> newCString t
Nothing -> return nullPtr
mode' <- newCString mode0
let
cmd = c_bfd_fopen fp' targ' mode' (1)
bfd <- throwExceptionIfNull "open" fp (show targ) cmd
return $ Bfd bfd fp' targ' mode'
close
:: Bfd
-> IO Bool
close bfd =
do
r <- c_bfd_close $ ptr bfd
free $ filePath bfd
free $ target bfd
free $ mode bfd
return $ toBool r
closeAllDone
:: Bfd
-> IO Bool
closeAllDone bfd =
do
r <- c_bfd_close_all_done $ ptr bfd
free $ filePath bfd
free $ target bfd
free $ mode bfd
return $ toBool r
checkFormat
:: Bfd
-> Format
-> IO Bool
checkFormat bfd format =
do
res <- c_bfd_check_format (ptr bfd) $ fromIntegral $ fromEnum format
throwExceptionIfFalse "checkFormat" (show format) (return $ toBool res)
getDisasm
:: Bfd
-> IO Disasm
getDisasm bfd = c_disassembler $ ptr bfd
getFilename
:: Bfd
-> IO FilePath
getFilename bfd =
do
fn <- peekByteOff (ptr bfd) ((4))
return $ unBfd'Filename fn
getFlags
:: Bfd
-> IO [BfdFlags.Flags]
getFlags bfd =
do
flags <- peekByteOff (ptr bfd) ((52))
let
flags' = filter f $ enumFrom HasReloc
where
f e = unBfd'Flags flags .&. (bit $ fromEnum e) /= 0
return flags'
getFormat
:: Bfd
-> IO Format
getFormat bfd =
do
format <- peekByteOff (ptr bfd) ((44))
return $ unBfd'Format format
getHasMap
:: Bfd
-> IO Bool
getHasMap bfd =
do
hm <- c__bfd_peek_has_armap $ ptr bfd
return $ toBool hm
getIsCacheable
:: Bfd
-> IO Bool
getIsCacheable bfd =
do
c <- c__bfd_peek_cacheable $ ptr bfd
return $ toBool c
getIsTargetDefaulted
:: Bfd
-> IO Bool
getIsTargetDefaulted bfd =
do
td <- c__bfd_peek_target_defaulted $ ptr bfd
return $ toBool td
getIsThinArchive
:: Bfd
-> IO Bool
getIsThinArchive bfd =
do
ita <- c__bfd_peek_is_thin_archive $ ptr bfd
return $ toBool ita
getMachine
:: Bfd
-> IO Int
getMachine bfd =
do
m <- c_bfd_get_mach $ ptr bfd
return $ fromIntegral m
getMyArchive
:: Bfd
-> IO (Maybe Bfd)
getMyArchive bfd =
do
ma <- peekByteOff (ptr bfd) ((140))
return $ case unBfd'MyArchive ma == nullPtr of
True -> Nothing
False -> Just $ Bfd (unBfd'MyArchive ma) nullPtr nullPtr nullPtr
getOctetsPerByte
:: Bfd
-> IO Int
getOctetsPerByte bfd =
do
opb <- c_bfd_octets_per_byte $ ptr bfd
return $ fromIntegral opb
getTarget
:: Bfd
-> IO Target
getTarget bfd =
do
xv <- peekByteOff (ptr bfd) ((8))
return $ unBfd'XVec xv
getStartAddress
:: Bfd
-> IO Vma
getStartAddress bfd =
do
addr <- peekByteOff (ptr bfd) ((112))
return $ unBfd'StartAddress addr
getSymbolCount
:: Bfd
-> IO Int
getSymbolCount bfd =
do
sc <- peekByteOff (ptr bfd) ((120))
return $ unBfd'SymbolCount sc
getSectionCount
:: Bfd
-> IO Int
getSectionCount bfd =
do
c <- peekByteOff (ptr bfd) ((108))
return $ unBfd'SectionCount c
getSectionByName
:: Bfd
-> SectionName
-> IO Section
getSectionByName bfd sn = withCString sn (\s -> c_bfd_get_section_by_name (ptr bfd) s)
getSectionByVma
:: Bfd
-> Int
-> IO (Maybe Section)
getSectionByVma bfd vma =
do
sects <- getSections bfd
foldM f Nothing sects
where
f xs@(Just _ ) _ = return xs
f (Nothing) xi =
do
sectVma <- getVma xi
sectSize <- getSize xi
case vma >= sectVma && vma < sectVma + sectSize of
True -> return $ Just xi
False -> return $ Nothing
getSections
:: Bfd
-> IO [Section]
getSections bfd =
do
(Sections first) <- peekByteOff (ptr bfd) ((100))
getSections' first []
where
getSections' sect rs
| sect == nullPtr = return $ reverse rs
| otherwise =
do
next <- getNext sect
getSections' next (sect : rs)
getSymbolTable
:: Bfd
-> IO SymbolTable
getSymbolTable bfd =
do
xvec <- getTarget bfd
bound <- getSymtabUpperBound xvec bfd
let
ptrs = bound `quot` (4)
pps <- mallocArray ptrs
count <- canonicalizeSymtab xvec bfd pps
return $ SymbolTable.mk pps count
getDynamicSymbolTable
:: Bfd
-> IO SymbolTable
getDynamicSymbolTable bfd =
do
xvec <- getTarget bfd
bound <- getDynamicSymtabUpperBound xvec bfd
let
ptrs = fromIntegral bound `quot` (4)
pps <- mallocArray ptrs
count <- canonicalizeDynamicSymtab xvec bfd pps
return $ SymbolTable.mk pps count
getDynamicRelocations
:: Bfd
-> SymbolTable
-> IO [Relocation]
getDynamicRelocations bfd st =
do
xvec <- getTarget bfd
bound <- getDynamicRelocUpperBound xvec bfd
let
ptrs = fromIntegral bound `quot` (4)
ppr <- mallocArray ptrs
count <- canonicalizeDynamicReloc xvec bfd ppr $ tablePtr st
prs <- peekArray count ppr
mapM peek prs
demangle
:: Bfd
-> String
-> IO String
demangle bfd str =
do
s <- withCString str (\s -> c_bfd_demangle (ptr bfd) s 3)
case s == nullPtr of
True -> return ""
False ->
do
s' <- peekCString s
return s'
data Bfd' = Filename String
| XVec Target
| Format Format
| Flags Int
| Sections Section
| SectionCount Int
| StartAddress Int
| SymbolCount Int
| MyArchive (Ptr Bfd')
deriving (Show)
instance Storable Bfd' where
sizeOf _ = (180)
alignment = sizeOf
peekByteOff buf off
| off == ((4)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf :: IO CString
str <- peekCString val
return $ Filename str
| off == ((8)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf :: IO Word
return $ XVec $ wordPtrToPtr $ fromIntegral val
| off == ((44)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf :: IO CUInt
return $ Format $ toEnum $ fromIntegral val
| off == ((52)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) buf :: IO CUInt
return $ Bindings.Bfd.Flags $ fromIntegral val
| off == ((100)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 100)) buf
return $ Sections val
| off == ((108)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 108)) buf :: IO CUInt
return $ SectionCount $ fromIntegral val
| off == ((112)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 112)) buf :: IO Vma'
return $ StartAddress $ fromIntegral val
| off == ((120)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 120)) buf :: IO CUInt
return $ SymbolCount $ fromIntegral val
| off == ((140)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 140)) buf :: IO (Ptr Bfd')
return $ MyArchive val
| otherwise = error $ "internal error: Bfd.peekByteOff " ++ show off
poke _ _ = return ()
mk
:: Ptr Bfd'
-> Bfd
mk p = Bfd p nullPtr nullPtr nullPtr
unBfd'Filename
:: Bfd'
-> String
unBfd'Filename (Filename fn) = fn
unBfd'Filename _ = error "unBfd'Filename"
unBfd'XVec
:: Bfd'
-> Target
unBfd'XVec (XVec p) = p
unBfd'XVec _ = error "unBfd'XVec"
unBfd'Format
:: Bfd'
-> Format
unBfd'Format (Format f) = f
unBfd'Format _ = error "unBfd'Format"
unBfd'Flags
:: Bfd'
-> Int
unBfd'Flags (Bindings.Bfd.Flags m) = m
unBfd'Flags _ = error "unBfd'Flags"
unBfd'SectionCount
:: Bfd'
-> Int
unBfd'SectionCount (SectionCount c) = c
unBfd'SectionCount _ = error "unBfd'SectionCount"
unBfd'StartAddress
:: Bfd'
-> Vma
unBfd'StartAddress (StartAddress a) = a
unBfd'StartAddress _ = error "unBfd'StartAddress"
unBfd'SymbolCount
:: Bfd'
-> Int
unBfd'SymbolCount (SymbolCount c) = c
unBfd'SymbolCount _ = error "unBfd'SymbolCount"
unBfd'MyArchive
:: Bfd'
-> (Ptr Bfd')
unBfd'MyArchive (MyArchive ma) = ma
unBfd'MyArchive _ = error "unBfd'MyArchive"
foreign import ccall unsafe "bfd.h bfd_init" c_bfd_init
:: IO ()
foreign import ccall unsafe "bfd.h bfd_fopen" c_bfd_fopen
:: CString
-> CString
-> CString
-> CInt
-> IO (Ptr Bfd')
foreign import ccall unsafe "bfd.h bfd_close" c_bfd_close
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_close_all_done" c_bfd_close_all_done
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_check_format" c_bfd_check_format
:: Ptr Bfd'
-> CInt
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_get_mach" c_bfd_get_mach
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_octets_per_byte" c_bfd_octets_per_byte
:: Ptr Bfd'
-> IO CUInt
foreign import ccall unsafe "bfd.h bfd_get_section_by_name" c_bfd_get_section_by_name
:: Ptr Bfd'
-> CString
-> IO Section
foreign import ccall unsafe "bfd.h bfd_demangle" c_bfd_demangle
:: Ptr Bfd'
-> CString
-> CInt
-> IO CString
foreign import ccall unsafe "dis-asm.h disassembler" c_disassembler
:: Ptr Bfd'
-> IO Disasm
foreign import ccall unsafe "bfd.h _bfd_peek_target_defaulted" c__bfd_peek_target_defaulted
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h _bfd_peek_cacheable" c__bfd_peek_cacheable
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h _bfd_peek_has_armap" c__bfd_peek_has_armap
:: Ptr Bfd'
-> IO CInt
foreign import ccall unsafe "bfd.h _bfd_peek_is_thin_archive" c__bfd_peek_is_thin_archive
:: Ptr Bfd'
-> IO CInt