{-# LINE 1 "src/Bindings/Bfd/Section.hsc" #-}
-- This file is part of Bindings-bfd.
{-# LINE 2 "src/Bindings/Bfd/Section.hsc" #-}
--
-- 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 <http://www.gnu.org/licenses/>.

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


{-# LINE 74 "src/Bindings/Bfd/Section.hsc" #-}


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 _ = (192)
{-# LINE 97 "src/Bindings/Bfd/Section.hsc" #-}
   alignment = sizeOf
   peekByteOff buf off
      | off == ((0)) =
{-# LINE 100 "src/Bindings/Bfd/Section.hsc" #-}
         do
            name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 102 "src/Bindings/Bfd/Section.hsc" #-}
            name' <- peekCString name
            return $ Bindings.Bfd.Section.Name name'
      | off == ((12)) =
{-# LINE 105 "src/Bindings/Bfd/Section.hsc" #-}
         do
            next <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
{-# LINE 107 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Next next
      | off == ((20)) =
{-# LINE 109 "src/Bindings/Bfd/Section.hsc" #-}
         do
            flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) buf :: IO CUInt
{-# LINE 111 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Bindings.Bfd.Section.Flags $ fromIntegral flags
      | off == ((28)) =
{-# LINE 113 "src/Bindings/Bfd/Section.hsc" #-}
         do
            vma <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) buf :: IO Vma'
{-# LINE 115 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Vma $ fromIntegral vma
      | off == ((36)) =
{-# LINE 117 "src/Bindings/Bfd/Section.hsc" #-}
         do
            lma <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) buf :: IO Vma'
{-# LINE 119 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Lma $ fromIntegral lma
      | off == ((44)) =
{-# LINE 121 "src/Bindings/Bfd/Section.hsc" #-}
         do
            size <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf :: IO Size'
{-# LINE 123 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Size $ fromIntegral size 
      | off == ((52)) =
{-# LINE 125 "src/Bindings/Bfd/Section.hsc" #-}
         do
            rawsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) buf :: IO Size'
{-# LINE 127 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Rawsize $ fromIntegral rawsize     
      | off == ((88)) =
{-# LINE 129 "src/Bindings/Bfd/Section.hsc" #-}
         do
            ap <- ((\hsc_ptr -> peekByteOff hsc_ptr 88)) buf
{-# LINE 131 "src/Bindings/Bfd/Section.hsc" #-}
            return $ AlignmentPower ap
      | off == ((176)) =
{-# LINE 133 "src/Bindings/Bfd/Section.hsc" #-}
         do
            sym <- ((\hsc_ptr -> peekByteOff hsc_ptr 176)) buf
{-# LINE 135 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Bindings.Bfd.Section.Symbol sym
      | otherwise = error $ "internal error: Bfd.Section'.peekByteOff " ++ show off
   pokeByteOff buf off val
      | off == ((0)) =
{-# LINE 139 "src/Bindings/Bfd/Section.hsc" #-}
         do
            cs <- newCString $ unSection'Name val
            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf cs
{-# LINE 142 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((28)) =
{-# LINE 143 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) buf (unSection'Vma val)
{-# LINE 144 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((36)) =
{-# LINE 145 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) buf (unSection'Vma val)
{-# LINE 146 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((88)) =
{-# LINE 147 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 88)) buf (unSection'AlignmentPower val)
{-# LINE 148 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((84)) =
{-# LINE 149 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 84)) buf (unSection'OutputSection val)
{-# LINE 150 "src/Bindings/Bfd/Section.hsc" #-}
      | 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 ((20))
{-# LINE 191 "src/Bindings/Bfd/Section.hsc" #-}
      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 ((0)) (Bindings.Bfd.Section.Name name)
{-# LINE 204 "src/Bindings/Bfd/Section.hsc" #-}

-- | Returns the 'SectionName'.
getName
   :: Section
   -> IO SectionName
getName sect =
   do
      n <- peekByteOff sect ((0))
{-# LINE 212 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Name n

-- -----------------------------------------------------------------------------

getNext
   :: Section
   -> IO Section
getNext sect =
   do
      s <- peekByteOff sect ((12))
{-# LINE 222 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Next s

-- -----------------------------------------------------------------------------

-- | Return the 'Size' of the 'Section'.
getSize
   :: Section
   -> IO Size
getSize sect = 
   do
      s <- peekByteOff sect ((44))
{-# LINE 233 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Size s

getRawsize
   :: Section
   -> IO Size
getRawsize sect =
   do
      rs <- peekByteOff sect ((52))
{-# LINE 241 "src/Bindings/Bfd/Section.hsc" #-}
      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 ((84))
{-# LINE 269 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'OutputSection os

setOutputSection
   :: Section
   -> Section
   -> IO ()
setOutputSection sect1 sect2 = pokeByteOff sect1 ((84)) (OutputSection sect2)
{-# LINE 276 "src/Bindings/Bfd/Section.hsc" #-}

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` (4)
{-# LINE 287 "src/Bindings/Bfd/Section.hsc" #-}

      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 ((176))
{-# LINE 321 "src/Bindings/Bfd/Section.hsc" #-}
      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 ((28)) (Vma vma)
{-# LINE 334 "src/Bindings/Bfd/Section.hsc" #-}
      pokeByteOff sect ((36)) (Vma vma)
{-# LINE 335 "src/Bindings/Bfd/Section.hsc" #-}
      c__section_poke_user_set_vma sect 1

-- | Returns the 'Vma' of the 'Section'.
getVma
   :: Section
   -> IO Vma
getVma sect =
   do
      s <- peekByteOff sect ((28))
{-# LINE 344 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Vma s

-- | Returns the LMA of the 'Section'.
getLma
   :: Section
   -> IO Vma
getLma sect =
   do
      lma <- peekByteOff sect ((36))
{-# LINE 353 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Lma lma

-- | Sets the alignment power of the 'Section'.
setAlignment
   :: Section
   -> Int
   -> IO ()
setAlignment sect align = pokeByteOff sect ((88)) (AlignmentPower align)
{-# LINE 361 "src/Bindings/Bfd/Section.hsc" #-}

-- | Returns the alignment power of the 'Section'.
getAlignment
   :: Section
   -> IO Int
getAlignment sect =
   do
      ap <- peekByteOff sect ((88))
{-# LINE 369 "src/Bindings/Bfd/Section.hsc" #-}
      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 ()