-- 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 .
module Bindings.Bfd.Section (
-- * Types
Section
, SectionName
-- * Functions
-- ** Creating
, Bindings.Bfd.Section.mk
, Bindings.Bfd.Section.getContents
-- * Flags
, Bindings.Bfd.Section.getFlags
-- * SectionName
, Bindings.Bfd.Section.setName
, Bindings.Bfd.Section.getName
, getNext
-- * Section Size
, Bindings.Bfd.Section.getSize
, getRawsize
, getLimit
, Bindings.Bfd.Section.getOutputSection
, setOutputSection
, getRelocatedContents
, getRelocations
, Bindings.Bfd.Section.getSymbol
-- * Addressing
, setVma
, getVma
, getLma
, setAlignment
, getAlignment
-- ** Testing
, isAbsolute
, isCommon
, isExterns
, externsName
, isUndefined
-- * Internal
, Section'
) where
import Data.Bits
import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import {-# SOURCE #-} Bindings.Bfd
import Bindings.Bfd.LinkInfo as LinkInfo
import Bindings.Bfd.LinkOrder as LinkOrder
import Bindings.Bfd.Misc
import Bindings.Bfd.Relocation
import Bindings.Bfd.Section.Flags
import Bindings.Bfd.Symbol
import Bindings.Bfd.SymbolTable
#include
type SectionName = String
type Contents = String
type Contents' = Ptr CChar
type Section = Ptr Section'
data Section' = Name SectionName
| Next Section
| Flags Int
| Vma Vma
| Lma Vma
| Size Size
| Rawsize Int
| OutputSection Section
| AlignmentPower Int
| Symbol Symbol
deriving (Show)
instance Storable Section' where
sizeOf _ = #size struct bfd_section
alignment = sizeOf
peekByteOff buf off
| off == (#offset struct bfd_section, name) =
do
name <- (#peek struct bfd_section, name) buf
name' <- peekCString name
return $ Bindings.Bfd.Section.Name name'
| off == (#offset struct bfd_section, next) =
do
next <- (#peek struct bfd_section, next) buf
return $ Next next
| off == (#offset struct bfd_section, flags) =
do
flags <- (#peek struct bfd_section, flags) buf :: IO CUInt
return $ Bindings.Bfd.Section.Flags $ fromIntegral flags
| off == (#offset struct bfd_section, vma) =
do
vma <- (#peek struct bfd_section, vma) buf :: IO Vma'
return $ Vma $ fromIntegral vma
| off == (#offset struct bfd_section, lma) =
do
lma <- (#peek struct bfd_section, lma) buf :: IO Vma'
return $ Lma $ fromIntegral lma
| off == (#offset struct bfd_section, size) =
do
size <- (#peek struct bfd_section, size) buf :: IO Size'
return $ Size $ fromIntegral size
| off == (#offset struct bfd_section, rawsize) =
do
rawsize <- (#peek struct bfd_section, rawsize) buf :: IO Size'
return $ Rawsize $ fromIntegral rawsize
| off == (#offset struct bfd_section, alignment_power) =
do
ap <- (#peek struct bfd_section, alignment_power) buf
return $ AlignmentPower ap
| off == (#offset struct bfd_section, symbol) =
do
sym <- (#peek struct bfd_section, symbol) buf
return $ Bindings.Bfd.Section.Symbol sym
| otherwise = error $ "internal error: Bfd.Section'.peekByteOff " ++ show off
pokeByteOff buf off val
| off == (#offset struct bfd_section, name) =
do
cs <- newCString $ unSection'Name val
(#poke struct bfd_section, name) buf cs
| off == (#offset struct bfd_section, vma) =
(#poke struct bfd_section, vma) buf (unSection'Vma val)
| off == (#offset struct bfd_section, lma) =
(#poke struct bfd_section, lma) buf (unSection'Vma val)
| off == (#offset struct bfd_section, alignment_power) =
(#poke struct bfd_section, alignment_power) buf (unSection'AlignmentPower val)
| off == (#offset struct bfd_section, output_section) =
(#poke struct bfd_section, output_section) buf (unSection'OutputSection val)
| otherwise = error $ "internal error: Bfd.Section'.peekByteOff " ++ show off
mk
:: SectionName
-> Int
-> IO Section
mk name align =
do
sect <- malloc :: IO Section
Bindings.Bfd.Section.setName sect name
setAlignment sect align
setVma sect 0
return sect
getContents
:: Section
-> Bfd
-> FilePtr
-> Size
-> IO Contents
getContents sect bfd offset count = allocaArray count f
where
f p =
do
let
offset' = fromIntegral offset
count' = fromIntegral count
_ <- c_bfd_get_section_contents (ptr bfd) sect p offset' count' -- FIXME: if not ok, throw exception
peekCAStringLen (p, count)
-- -----------------------------------------------------------------------------
-- | Returns a list of the 'Section's 'Flags'.
getFlags
:: Section
-> IO [Flags]
getFlags sect =
do
flags <- peekByteOff sect (#offset struct bfd_section, flags)
let
flags' = filter f $ enumFrom Alloc
where
f e = unSection'Flags flags .&. (bit $ fromEnum e) /= 0
return flags'
-- -----------------------------------------------------------------------------
setName
:: Section
-> SectionName
-> IO ()
setName sect name = pokeByteOff sect (#offset struct bfd_section, name) (Bindings.Bfd.Section.Name name)
-- | Returns the 'SectionName'.
getName
:: Section
-> IO SectionName
getName sect =
do
n <- peekByteOff sect (#offset struct bfd_section, name)
return $ unSection'Name n
-- -----------------------------------------------------------------------------
getNext
:: Section
-> IO Section
getNext sect =
do
s <- peekByteOff sect (#offset struct bfd_section, next)
return $ unSection'Next s
-- -----------------------------------------------------------------------------
-- | Return the 'Size' of the 'Section'.
getSize
:: Section
-> IO Size
getSize sect =
do
s <- peekByteOff sect (#offset struct bfd_section, size)
return $ unSection'Size s
getRawsize
:: Section
-> IO Size
getRawsize sect =
do
rs <- peekByteOff sect (#offset struct bfd_section, rawsize)
return $ unSection'Rawsize rs
-- | If the raw size (see 'getRawSize') is not zero then return the raw size.
-- Otherwise return the division of the size (see 'getSize') by the octets per
-- byte (see 'getOctetsPerByte').
getLimit
:: Section
-> Bfd
-> IO Int
getLimit sect bfd =
do
rs <- getRawsize sect
case rs == 0 of
True ->
do
sz <- Bindings.Bfd.Section.getSize sect
opb <- getOctetsPerByte bfd
return $ sz `quot` opb
False -> return rs
-- -----------------------------------------------------------------------------
getOutputSection
:: Section
-> IO Section
getOutputSection sect =
do
os <- peekByteOff sect (#offset struct bfd_section, output_section)
return $ unSection'OutputSection os
setOutputSection
:: Section
-> Section
-> IO ()
setOutputSection sect1 sect2 = pokeByteOff sect1 (#offset struct bfd_section, output_section) (OutputSection sect2)
getRelocations
:: Section
-> Bfd
-> SymbolTable
-> IO [Relocation]
getRelocations sect bfd st =
do
bound <- c_bfd_get_reloc_upper_bound (ptr bfd) sect
let
ptrs = fromIntegral bound `quot` (#const sizeof(arelent *))
ppr <- mallocArray ptrs
count <- c_bfd_canonicalize_reloc (ptr bfd) sect ppr $ tablePtr st
prs <- peekArray (fromIntegral count) ppr
mapM peek prs
getRelocatedContents
:: Section
-> Bfd
-> SymbolTable
-> IO Contents
getRelocatedContents sect bfd syms =
do
count <- Bindings.Bfd.Section.getSize sect
allocaArray count (f count)
where
f count p =
do
let
li = nullPtr
isR = fromBool False
lo <- LinkOrder.mk sect
setOutputSection sect sect
buf <- c_bfd_get_relocated_section_contents (ptr bfd) li lo p isR $ tablePtr syms
case buf == nullPtr of
True -> error "bfd_get_relocated_section_contents failed"
False -> peekCAStringLen (buf, count)
getSymbol
:: Section
-> IO Symbol
getSymbol sect =
do
sym <- peekByteOff sect (#offset struct bfd_section, symbol)
return $ unSection'Symbol sym
-- -----------------------------------------------------------------------------
-- | Sets both the VMA and LMA of the 'Section' to the given 'Vma' and sets the
-- 'Section's /user_set_vma/ flag to 'True'.
setVma
:: Section
-> Vma
-> IO ()
setVma sect vma =
do
pokeByteOff sect (#offset struct bfd_section, vma) (Vma vma)
pokeByteOff sect (#offset struct bfd_section, lma) (Vma vma)
c__section_poke_user_set_vma sect 1
-- | Returns the 'Vma' of the 'Section'.
getVma
:: Section
-> IO Vma
getVma sect =
do
s <- peekByteOff sect (#offset struct bfd_section, vma)
return $ unSection'Vma s
-- | Returns the LMA of the 'Section'.
getLma
:: Section
-> IO Vma
getLma sect =
do
lma <- peekByteOff sect (#offset struct bfd_section, lma)
return $ unSection'Lma lma
-- | Sets the alignment power of the 'Section'.
setAlignment
:: Section
-> Int
-> IO ()
setAlignment sect align = pokeByteOff sect (#offset struct bfd_section, alignment_power) (AlignmentPower align)
-- | Returns the alignment power of the 'Section'.
getAlignment
:: Section
-> IO Int
getAlignment sect =
do
ap <- peekByteOff sect (#offset struct bfd_section, alignment_power)
return $ unSection'AlignmentPower ap
-- -----------------------------------------------------------------------------
isAbsolute
:: Section
-> Bool
isAbsolute sect = sect == c_bfd_abs_section
-- | Return 'True' if 'IsCommon' is found in the 'Section's 'Flags'.
isCommon
:: Section
-> IO Bool
isCommon sect =
do
flags <- Bindings.Bfd.Section.getFlags sect
return $ IsCommon `elem` flags
isExterns
:: Section
-> IO Bool
isExterns sect =
do
n <- Bindings.Bfd.Section.getName sect
return $ n == externsName
externsName
:: String
externsName = "externs"
isUndefined
:: Section
-> Bool
isUndefined sect = sect == c_bfd_und_section
-- Given a section
{-
createSection
:: Section
-> Vma
-> IO (Vma, (Section, Vma))
createSection sect vma =
do
origVma <- getVma sect
size <- Bindings.Bfd.Section.getSize sect
case origVma of
0 ->
do
align <- getAlignment sect
let
vma' = alignToPower vma align
setVma sect vma'
return (vma' + size, (sect, vma'))
_ -> return (origVma + size, (sect, origVma))
-}
unSection'Name
:: Section'
-> SectionName
unSection'Name (Bindings.Bfd.Section.Name n) = n
unSection'Name x = error $ "internal error: unSection'Name " ++ show x
unSection'Next
:: Section'
-> Section
unSection'Next (Next n) = n
unSection'Next x = error $ "internal error: unSection'Next " ++ show x
unSection'Flags
:: Section'
-> Int
unSection'Flags (Bindings.Bfd.Section.Flags f) = f
unSection'Flags x = error $ "internal error: unSection'Flags " ++ show x
unSection'Vma
:: Section'
-> Vma
unSection'Vma (Vma v) = v
unSection'Vma x = error $ "internal error: unSection'Vma " ++ show x
unSection'Lma
:: Section'
-> Vma
unSection'Lma (Lma l) = l
unSection'Lma _ = error "unSection'Lma"
unSection'Size
:: Section'
-> Size
unSection'Size (Size s) = s
unSection'Size x = error $ "internal error: unSection'Size " ++ show x
unSection'Rawsize
:: Section'
-> Size
unSection'Rawsize (Rawsize rs) = rs
unSection'Rawsize _ = error "unSection'Rawsize"
unSection'OutputSection
:: Section'
-> Section
unSection'OutputSection (OutputSection s) = s
unSection'OutputSection x = error $ "internal error: unSection'OutputSection " ++ show x
unSection'AlignmentPower
:: Section'
-> Int
unSection'AlignmentPower (AlignmentPower ap) = ap
unSection'AlignmentPower x = error $ "internal error: unSection'AlignmentPower " ++ show x
unSection'Symbol
:: Section'
-> Symbol
unSection'Symbol (Bindings.Bfd.Section.Symbol s) = s
unSection'Symbol x = error $ "internal error: unSection'Symbol " ++ show x
foreign import ccall unsafe "bfd.h bfd_get_section_contents" c_bfd_get_section_contents
:: Ptr Bfd'
-> Section
-> Contents'
-> FilePtr'
-> Size'
-> IO Bool
foreign import ccall unsafe "bfd.h bfd_get_reloc_upper_bound" c_bfd_get_reloc_upper_bound
:: Ptr Bfd'
-> Section
-> IO CLong
foreign import ccall unsafe "bfd.h bfd_canonicalize_reloc" c_bfd_canonicalize_reloc
:: Ptr Bfd'
-> Section
-> Ptr (Ptr Relocation)
-> Ptr Symbol
-> IO CLong
foreign import ccall unsafe "bfd.h bfd_get_relocated_section_contents" c_bfd_get_relocated_section_contents
:: Ptr Bfd'
-> LinkInfo
-> LinkOrder
-> Contents'
-> Bool'
-> Ptr Symbol
-> IO Contents'
foreign import ccall unsafe "bfd.h &bfd_und_section" c_bfd_und_section
:: Section
foreign import ccall unsafe "bfd.h &bfd_abs_section" c_bfd_abs_section
:: Section
foreign import ccall unsafe "section.h _section_poke_user_set_vma" c__section_poke_user_set_vma
:: Section
-> CInt
-> IO ()