{-# LINE 1 "src/Bindings/Bfd/Section.hsc" #-}
-- This file is part of Bindings-bfd.
{-# LINE 2 "src/Bindings/Bfd/Section.hsc" #-}
--
-- Copyright (C) 2010 Michael Nelson
--
-- 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
   , Section'
   , SectionName
   -- * Functions
   -- ** Creating
   , Bindings.Bfd.Section.mk
   -- ** Reading\/Writing
   , getAlignment
   , setAlignment
   , Bindings.Bfd.Section.getContents
   , Bindings.Bfd.Section.getFlags
   , getLimit
   , getLma
   , Bindings.Bfd.Section.getName
   , Bindings.Bfd.Section.setName
   , getNext
   , getRawsize
   , Bindings.Bfd.Section.getOutputSection
   , setOutputSection
   , getRelocatedContents
   , getRelocations
   , Bindings.Bfd.Section.getSize
   , Bindings.Bfd.Section.getSymbol
   , getVma
   , setVma
   -- ** Testing
   , isAbsolute
   , isCommon
   , isExterns
   , isUndefined
) 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 69 "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 _ = (184)
{-# LINE 92 "src/Bindings/Bfd/Section.hsc" #-}
   alignment = sizeOf
   peekByteOff buf off
      | off == ((0)) =
{-# LINE 95 "src/Bindings/Bfd/Section.hsc" #-}
         do
            name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
{-# LINE 97 "src/Bindings/Bfd/Section.hsc" #-}
            name' <- peekCString name
            return $ Bindings.Bfd.Section.Name name'
      | off == ((12)) =
{-# LINE 100 "src/Bindings/Bfd/Section.hsc" #-}
         do
            next <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
{-# LINE 102 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Next next
      | off == ((20)) =
{-# LINE 104 "src/Bindings/Bfd/Section.hsc" #-}
         do
            flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) buf :: IO CUInt
{-# LINE 106 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Bindings.Bfd.Section.Flags $ fromIntegral flags
      | off == ((28)) =
{-# LINE 108 "src/Bindings/Bfd/Section.hsc" #-}
         do
            vma <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) buf :: IO Vma'
{-# LINE 110 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Vma $ fromIntegral vma
      | off == ((36)) =
{-# LINE 112 "src/Bindings/Bfd/Section.hsc" #-}
         do
            lma <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) buf :: IO Vma'
{-# LINE 114 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Lma $ fromIntegral lma
      | off == ((44)) =
{-# LINE 116 "src/Bindings/Bfd/Section.hsc" #-}
         do
            size <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf :: IO Size'
{-# LINE 118 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Size $ fromIntegral size 
      | off == ((52)) =
{-# LINE 120 "src/Bindings/Bfd/Section.hsc" #-}
         do
            rawsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) buf :: IO Size'
{-# LINE 122 "src/Bindings/Bfd/Section.hsc" #-}
            return $ Rawsize $ fromIntegral rawsize     
      | off == ((80)) =
{-# LINE 124 "src/Bindings/Bfd/Section.hsc" #-}
         do
            ap <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) buf
{-# LINE 126 "src/Bindings/Bfd/Section.hsc" #-}
            return $ AlignmentPower ap
      | off == ((168)) =
{-# LINE 128 "src/Bindings/Bfd/Section.hsc" #-}
         do
            sym <- ((\hsc_ptr -> peekByteOff hsc_ptr 168)) buf
{-# LINE 130 "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 134 "src/Bindings/Bfd/Section.hsc" #-}
         do
            cs <- newCString $ unSection'Name val
            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf cs
{-# LINE 137 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((28)) =
{-# LINE 138 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) buf (unSection'Vma val)
{-# LINE 139 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((80)) =
{-# LINE 140 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 80)) buf (unSection'AlignmentPower val)
{-# LINE 141 "src/Bindings/Bfd/Section.hsc" #-}
      | off == ((76)) =
{-# LINE 142 "src/Bindings/Bfd/Section.hsc" #-}
         ((\hsc_ptr -> pokeByteOff hsc_ptr 76)) buf (unSection'OutputSection val)
{-# LINE 143 "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


getAlignment
   :: Section
   -> IO Int
getAlignment sect =
   do
      ap <- peekByteOff sect ((80))
{-# LINE 165 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'AlignmentPower ap

setAlignment
   :: Section
   -> Int
   -> IO ()
setAlignment sect align = pokeByteOff sect ((80)) (AlignmentPower align)
{-# LINE 172 "src/Bindings/Bfd/Section.hsc" #-}

getContents
   :: Section
   -> Bfd
   -> FilePtr
   -> Size
   -> IO Contents
getContents sect bfd offset count = allocaArray count f
   where
      f ptr =
         do
            let
               offset' = fromIntegral offset
               count'  = fromIntegral count
            _ <- c_bfd_get_section_contents bfd sect ptr offset' count' -- FIXME: if not ok, throw exception
            peekCAStringLen (ptr, count)

getFlags
   :: Section
   -> IO [Flags]
getFlags sect =
   do
      flags <- peekByteOff sect ((20))
{-# LINE 195 "src/Bindings/Bfd/Section.hsc" #-}
      let
         flags' = filter f $ enumFrom Alloc
            where
               f e = unSection'Flags flags .&. (bit $ fromEnum e) /= 0
      return flags'

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

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

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

setName
   :: Section
   -> SectionName
   -> IO ()
setName sect name = pokeByteOff sect ((0)) (Bindings.Bfd.Section.Name name)
{-# LINE 237 "src/Bindings/Bfd/Section.hsc" #-}

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

getRawsize
   :: Section
   -> IO Size
getRawsize sect =
   do
      rs <- peekByteOff sect ((52))
{-# LINE 252 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Rawsize rs

getOutputSection
   :: Section
   -> IO Section
getOutputSection sect =
   do
      os <- peekByteOff sect ((76))
{-# LINE 260 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'OutputSection os

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

getRelocations
   :: Section
   -> Bfd
   -> SymbolTable
   -> IO [Relocation]
getRelocations sect bfd st =
   do
      bound <- c_bfd_get_reloc_upper_bound bfd sect
      let
         ptrs = fromIntegral bound `quot` (4)
{-# LINE 278 "src/Bindings/Bfd/Section.hsc" #-}

      ppr <- mallocArray ptrs
      count <- c_bfd_canonicalize_reloc 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 ptr = 
         do
            let
               li  = nullPtr
               isR = fromBool False
            lo <- LinkOrder.mk sect
            setOutputSection sect sect
            buf <- c_bfd_get_relocated_section_contents bfd li lo ptr isR $ tablePtr syms
            case buf == nullPtr of
               True  -> error "bfd_get_relocated_section_contents failed"
               False -> peekCAStringLen (buf, count)

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

getSymbol
   :: Section
   -> IO Symbol
getSymbol sect =
   do
      sym <- peekByteOff sect ((168))
{-# LINE 320 "src/Bindings/Bfd/Section.hsc" #-}
      return $ unSection'Symbol sym

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

setVma
   :: Section
   -> Vma
   -> IO ()
setVma sect vma = pokeByteOff sect ((28)) (Vma vma)
{-# LINE 335 "src/Bindings/Bfd/Section.hsc" #-}


isAbsolute
   :: Section
   -> Bool
isAbsolute sect = sect == c_bfd_abs_section

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 == "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
   :: Bfd
   -> Section
   -> Contents'
   -> FilePtr'
   -> Size'
   -> IO Bool

foreign import ccall unsafe "bfd.h bfd_get_reloc_upper_bound" c_bfd_get_reloc_upper_bound
   :: Bfd
   -> Section
   -> IO CLong

foreign import ccall unsafe "bfd.h bfd_canonicalize_reloc" c_bfd_canonicalize_reloc
   :: 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
   :: 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