-- This file is part of Bindings-bfd.
--
-- Copyright (C) 2010,2011 Mick Nelso
--
-- Bindings-bfd is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Bindings-bfd is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
-- You should have received a copy of the GNU Lesser General Public License
-- along with Bindings-bfd. If not, see .
-- | The "Target" represents a particular back-end used to interpret the Binary
-- File Descriptor (BFD). A 'Bfd' handle will be associated with exactly one
-- 'Target' as set in the 'open' function.
module Bindings.Bfd.Target (
-- * Types
Target
, TargetName
-- * Platform
, listSupported
, find
, setDefault
-- * Attributes
, getFlavour
, getName
-- ** Byte Order
, getByteorder
, getHeaderByteorder
-- ** Flags
, getObjectFlags
, getSectionFlags
-- * Testing
, isCoffFamily
-- ** Byte Order
, isBigEndian
, isLittleEndian
, isHeaderBigEndian
, isHeaderLittleEndian
-- * Internal
, Target'
, unTarget'CanonicalizeDynamicReloc
, unTarget'CanonicalizeDynamicSymtab
, unTarget'CanonicalizeSymtab
, unTarget'GetDynamicRelocUpperBound
, unTarget'GetDynamicSymtabUpperBound
, unTarget'GetSymtabUpperBound
, unTarget'GetSyntheticSymtab
, unTarget'PrintSymbol
) where
import Data.Bits ( (.&.), bit )
import Data.Word ( Word )
import Foreign.C ( CInt, CLong, CString, CUInt, newCString, peekCString
, withCString )
import Foreign.Marshal ( free, peekArray0, toBool )
import Foreign.Ptr ( FunPtr, Ptr, castPtrToFunPtr, nullPtr, wordPtrToPtr )
import Foreign.Storable ( Storable, alignment, peekByteOff, sizeOf )
import {-# SOURCE #-} Bindings.Bfd ( Bfd, Bfd'
, ptr )
import Bindings.Bfd.Endian ( Endian(..) )
import Bindings.Bfd.Exception ( throwExceptionIfFalse)
import Bindings.Bfd.Flags as BfdFlags ( Flags(HasReloc) )
import Bindings.Bfd.Flavour ( Flavour(Coff, Xcoff) )
import Bindings.Bfd.Misc ( File )
import {-# SOURCE #-} Bindings.Bfd.Relocation ( Relocation )
import Bindings.Bfd.Section.Flags as SectionFlags ( Flags(Alloc) )
import {-# SOURCE #-} Bindings.Bfd.Symbol as Symbol ( Symbol )
#include
-- ### PUBLIC ##################################################################
-- === Types ===================================================================
type Target = Ptr Target'
type TargetName = String
-- --- Platform and Bfd ========================================================
-- | Returns the /Platform Target List/; that is, the target names that are
-- supported by the platform that /libbfd/ was compiled for.
listSupported
:: IO [TargetName]
listSupported =
do
let
pts = c_bfd_target_list
ps <- peekArray0 nullPtr pts
res <- mapM peekCString ps
free pts -- FIXME is this dodgy?
return res
-- | Returns a handle to the target named 'TargetName'. If /target/ is
-- 'Nothing', choose the one in the environment variable /GNUTARGET/; if that is
-- null or not defined, then choose the first entry in the /Platform Target List/
-- (see 'listSupported').
--
-- Passing the 'String' \"default\" as /target/ or setting the environment
-- variable to \"default\" will cause the /Default Target/ to be returned (see
-- 'setDefault'), and the fact that the target is defaulted will be set in the
-- BFD if /bfd/ isn't 'Nothing'. This will cause 'checkFormat' to loop over all
-- the targets to find the one that matches the file being read.
find
:: Maybe TargetName -- ^ target
-> Maybe Bfd -- ^ bfd
-> IO Target
find mbTarg mbBfd =
do
targ <- maybe (return nullPtr) (\t -> newCString t) mbTarg
let
bfd = maybe nullPtr (\b -> ptr b) mbBfd
r <- c_bfd_find_target targ bfd
free targ
return r
-- | Set the /Default Target/ for use when 'TargetName' is equal to \"default\"
-- or 'Nothing' in the 'find' and 'open' functions.
--
-- /Possible exceptions:/ 'InvalidTarget'
setDefault
:: TargetName
-> IO ()
setDefault tn =
do
r <- withCString tn (\s -> c_bfd_set_default_target s)
_ <- throwExceptionIfFalse "setDefault" tn (return $ toBool r)
return ()
-- === Attributes ==============================================================
getFlavour
:: Target
-> IO Flavour
getFlavour targ =
do
flav <- peekByteOff targ (#offset struct bfd_target, flavour)
return $ unTarget'Flavour flav
getName
:: Target
-> IO TargetName
getName targ =
do
tn <- peekByteOff targ (#offset struct bfd_target, name)
let
tn' = unTarget'Name tn
return tn'
-- Byte Order ------------------------------------------------------------------
getByteorder
:: Target
-> IO Endian
getByteorder targ =
do
bo <- peekByteOff targ (#offset struct bfd_target, byteorder)
return $ unTarget'Byteorder bo
getHeaderByteorder
:: Target
-> IO Endian
getHeaderByteorder targ =
do
bo <- peekByteOff targ (#offset struct bfd_target, header_byteorder)
return $ unTarget'HeaderByteorder bo
-- Flags -----------------------------------------------------------------------
getObjectFlags
:: Target
-> IO [BfdFlags.Flags]
getObjectFlags targ =
do
f <- peekByteOff targ (#offset struct bfd_target, object_flags)
return $ unTarget'ObjectFlags f
getSectionFlags
:: Target
-> IO [SectionFlags.Flags]
getSectionFlags targ =
do
f <- peekByteOff targ (#offset struct bfd_target, section_flags)
return $ unTarget'SectionFlags f
-- Testing =====================================================================
-- | Returns 'True' if the 'Flavour' of the 'Target' is either 'Coff' or 'Xcoff'.
-- Otherwise 'False'.
isCoffFamily
:: Target
-> IO Bool
isCoffFamily targ =
do
flav <- getFlavour targ
return $ flav == Coff || flav == Xcoff
-- Byte Order ------------------------------------------------------------------
-- | Returns 'True' if the 'Target's byte order (see 'getByteorder') is 'Big'.
-- Otherwise 'False'.
isBigEndian
:: Target
-> IO Bool
isBigEndian targ =
do
bo <- getByteorder targ
return $ bo == Big
-- | Returns 'True' if the 'Target's byte order (see 'getByteorder') is 'Little'.
-- Otherwise 'False'.
isLittleEndian
:: Target
-> IO Bool
isLittleEndian targ =
do
bo <- getByteorder targ
return $ bo == Little
-- | Returns 'True' if the 'Target's header byte order (see 'getHeaderByteOrder')
-- is 'Big'. Otherwise 'False'.
isHeaderBigEndian
:: Target
-> IO Bool
isHeaderBigEndian targ =
do
bo <- getHeaderByteorder targ
return $ bo == Big
-- | Returns 'True' if the 'Target's header byte order (see 'getHeaderByteOrder')
-- is 'Little'. Otherwise 'False'.
isHeaderLittleEndian
:: Target
-> IO Bool
isHeaderLittleEndian targ =
do
bo <- getHeaderByteorder targ
return $ bo == Little
-- Internal ====================================================================
data Target' = Name TargetName
| Flavour Flavour
| Byteorder Endian
| HeaderByteorder Endian
| ObjectFlags [BfdFlags.Flags]
| SectionFlags [SectionFlags.Flags]
| GetSymtabUpperBound (FunPtr (Ptr Bfd' -> IO CLong))
| CanonicalizeSymtab (FunPtr (Ptr Bfd' -> Ptr Symbol -> IO CLong))
| PrintSymbol (FunPtr (Ptr Bfd' -> File -> Symbol -> CUInt -> IO ()))
| GetDynamicSymtabUpperBound (FunPtr (Ptr Bfd' -> IO CLong))
| CanonicalizeDynamicSymtab (FunPtr (Ptr Bfd' -> Ptr Symbol -> IO CLong))
| GetSyntheticSymtab (FunPtr (Ptr Bfd' -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong))
| GetDynamicRelocUpperBound (FunPtr (Ptr Bfd' -> IO CLong))
| CanonicalizeDynamicReloc (FunPtr (Ptr Bfd' -> Ptr (Ptr Relocation) -> Ptr Symbol -> IO CLong))
deriving (Show)
instance Storable Target' where
sizeOf _ = #size struct bfd_target
alignment = sizeOf
peekByteOff buf off
| off == (#offset struct bfd_target, name) =
do
val <- (#peek struct bfd_target, name) buf
s <- peekCString val
return $ Bindings.Bfd.Target.Name s
| off == (#offset struct bfd_target, flavour) =
do
val <- (#peek struct bfd_target, flavour) buf :: IO CUInt
return $ Flavour $ toEnum $ fromIntegral val
| off == (#offset struct bfd_target, byteorder) =
do
val <- (#peek struct bfd_target, byteorder) buf :: IO CUInt
return $ Byteorder $ toEnum $ fromIntegral val
| off == (#offset struct bfd_target, header_byteorder) =
do
val <- (#peek struct bfd_target, header_byteorder) buf :: IO CUInt
return $ HeaderByteorder $ toEnum $ fromIntegral val
| off == (#offset struct bfd_target, object_flags) =
do
val <- (#peek struct bfd_target, object_flags) buf :: IO CUInt
let
flags = filter f $ enumFrom HasReloc
where
f e = val .&. (bit $ fromEnum e) /= 0
return $ ObjectFlags flags
| off == (#offset struct bfd_target, section_flags) =
do
val <- (#peek struct bfd_target, section_flags) buf :: IO CUInt
let
flags = filter f $ enumFrom Alloc
where
f e = val .&. (bit $ fromEnum e) /= 0
return $ SectionFlags flags
| off == (#offset struct bfd_target, _bfd_get_symtab_upper_bound) =
do
val <- (#peek struct bfd_target, _bfd_get_symtab_upper_bound) buf :: IO Word
return $ GetSymtabUpperBound $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_canonicalize_symtab) =
do
val <- (#peek struct bfd_target, _bfd_canonicalize_symtab) buf :: IO Word
return $ CanonicalizeSymtab $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_print_symbol) =
do
val <- (#peek struct bfd_target, _bfd_print_symbol) buf :: IO Word
return $ PrintSymbol $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_get_dynamic_symtab_upper_bound) =
do
val <- (#peek struct bfd_target, _bfd_get_dynamic_symtab_upper_bound) buf :: IO Word
return $ GetDynamicSymtabUpperBound $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_canonicalize_dynamic_symtab) =
do
val <- (#peek struct bfd_target, _bfd_canonicalize_dynamic_symtab) buf :: IO Word
return $ CanonicalizeDynamicSymtab $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_get_synthetic_symtab) =
do
val <- (#peek struct bfd_target, _bfd_get_synthetic_symtab) buf :: IO Word
return $ GetSyntheticSymtab $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_get_dynamic_reloc_upper_bound) =
do
val <- (#peek struct bfd_target, _bfd_get_dynamic_reloc_upper_bound) buf :: IO Word
return $ GetDynamicRelocUpperBound $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd_target, _bfd_canonicalize_dynamic_reloc) =
do
val <- (#peek struct bfd_target, _bfd_canonicalize_dynamic_reloc) buf :: IO Word
return $ CanonicalizeDynamicReloc $ castPtrToFunPtr $ wordPtrToPtr $ fromIntegral val
| otherwise = error $ "internal error: Bfd.Target.peekByteOff " ++ show off
unTarget'CanonicalizeDynamicReloc
:: Target'
-> FunPtr (Ptr Bfd' -> Ptr (Ptr Relocation) -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeDynamicReloc (CanonicalizeDynamicReloc fn) = fn
unTarget'CanonicalizeDynamicReloc _ = error "unTarget'CanonicalizeDynamicReloc"
unTarget'CanonicalizeDynamicSymtab
:: Target'
-> FunPtr (Ptr Bfd' -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeDynamicSymtab (CanonicalizeDynamicSymtab fn) = fn
unTarget'CanonicalizeDynamicSymtab _ = error "unTarget'CanonicalizeDynamicSymtab"
unTarget'CanonicalizeSymtab
:: Target'
-> FunPtr (Ptr Bfd' -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeSymtab (CanonicalizeSymtab fn) = fn
unTarget'CanonicalizeSymtab _ = error "unTarget'CanonicalizeSymtab"
unTarget'GetDynamicRelocUpperBound
:: Target'
-> FunPtr (Ptr Bfd' -> IO CLong)
unTarget'GetDynamicRelocUpperBound (GetDynamicRelocUpperBound fn) = fn
unTarget'GetDynamicRelocUpperBound _ = error "unTarget'GetDynamicRelocUpperBound"
unTarget'GetDynamicSymtabUpperBound
:: Target'
-> FunPtr (Ptr Bfd' -> IO CLong)
unTarget'GetDynamicSymtabUpperBound (GetDynamicSymtabUpperBound fn) = fn
unTarget'GetDynamicSymtabUpperBound _ = error "unTarget'GetDynamicSymtabUpperBound"
unTarget'GetSymtabUpperBound
:: Target'
-> FunPtr (Ptr Bfd' -> IO CLong)
unTarget'GetSymtabUpperBound (GetSymtabUpperBound fn) = fn
unTarget'GetSymtabUpperBound _ = error "unTarget'GetSymtabUpperBound"
unTarget'GetSyntheticSymtab
:: Target'
-> FunPtr (Ptr Bfd' -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong)
unTarget'GetSyntheticSymtab (GetSyntheticSymtab fn) = fn
unTarget'GetSyntheticSymtab _ = error "unTarget'GetSyntheticSymtab"
unTarget'PrintSymbol
:: Target'
-> FunPtr (Ptr Bfd' -> File -> Symbol -> CUInt -> IO ())
unTarget'PrintSymbol (PrintSymbol fn) = fn
unTarget'PrintSymbol x = error $ "internal error: unXVec2 " ++ show x
-- PRIVATE #####################################################################
unTarget'Name
:: Target'
-> TargetName
unTarget'Name (Bindings.Bfd.Target.Name s) = s
unTarget'Name _ = error "unTarget'Name"
unTarget'Flavour
:: Target'
-> Flavour
unTarget'Flavour (Flavour f) = f
unTarget'Flavour _ = error "unTarget'Flavour"
unTarget'Byteorder
:: Target'
-> Endian
unTarget'Byteorder (Byteorder b) = b
unTarget'Byteorder _ = error "unTarget'Byteorder"
unTarget'HeaderByteorder
:: Target'
-> Endian
unTarget'HeaderByteorder (HeaderByteorder b) = b
unTarget'HeaderByteorder _ = error "unTarget'HeaderByteorder"
unTarget'ObjectFlags
:: Target'
-> [BfdFlags.Flags]
unTarget'ObjectFlags (ObjectFlags b) = b
unTarget'ObjectFlags _ = error "unTarget'ObjectFlags"
unTarget'SectionFlags
:: Target'
-> [SectionFlags.Flags]
unTarget'SectionFlags (SectionFlags b) = b
unTarget'SectionFlags _ = error "unTarget'SectionFlags"
-- Foreign ---------------------------------------------------------------------
foreign import ccall unsafe "bfd.h bfd_target_list" c_bfd_target_list
:: Ptr CString
foreign import ccall unsafe "bfd.h bfd_find_target" c_bfd_find_target
:: CString
-> Ptr Bfd'
-> IO Target
foreign import ccall unsafe "bfd.h bfd_set_default_target" c_bfd_set_default_target
:: CString
-> IO CInt