{-# LINE 1 "src/Bindings/Bfd.hsc" #-}
-- This file is part of Bindings-bfd.
{-# LINE 2 "src/Bindings/Bfd.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 (
   -- * Types
     Bfd
   , Bfd'
   , FileMode
   -- * Functions
   -- ** Initialization
   , init
   -- ** Files
   , getTargetsAndFormats
   , open
   , close
   -- ** Format
   , checkFormat
   -- ** Foo
   , Bindings.Bfd.getByteorder
   , Bindings.Bfd.getHeaderByteorder
   , getDisasm
   , getFilename
   , Bindings.Bfd.getFlags
   , Bindings.Bfd.getObjectFlags
   , Bindings.Bfd.getSectionFlags
   , Bindings.Bfd.getFlavour
   , getFormat
   , getMachine
   , getOctetsPerByte
   -- *** Sections
   , getSectionByName
   , getSections
   -- *** Target
   , getTarget
   -- *** Foo
   , getMyArchive
   -- *** Symbols
   , getSymbolTable
   , getDynamicSymbolTable

{-# LINE 57 "src/Bindings/Bfd.hsc" #-}
   -- *** Relocations
   , getDynamicRelocations
   -- ** Testing
   , isBigEndian
   , isLittleEndian
   , isHeaderBigEndian
   , isHeaderLittleEndian
   , isCoffFamily
) where

import Control.Exception
import Control.Monad

import Data.Bits
import Data.Maybe
import Data.Word

import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable

import Prelude hiding (catch, init)

import Bindings.Bfd.Disasm
import Bindings.Bfd.Endian
import Bindings.Bfd.Exception
import Bindings.Bfd.Flags         as BfdFlags
import Bindings.Bfd.Flavour
import Bindings.Bfd.Format
import Bindings.Bfd.Relocation
import Bindings.Bfd.Section       as Section
import Bindings.Bfd.Section.Flags as SectionFlags
import Bindings.Bfd.SymbolTable   as SymbolTable
import Bindings.Bfd.Target        as Target


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


type FileMode = String


type Bfd = Ptr Bfd'

data Bfd' = Filename  String
          | XVec      Target
          | Format    Format
          | Flags     Int
          | Sections  Section
          | MyArchive Bfd
     deriving (Show)

instance Storable Bfd' where
   sizeOf _ = (180)
{-# LINE 111 "src/Bindings/Bfd.hsc" #-}
   alignment = sizeOf
   peekByteOff buf off
      | off == ((4)) =
{-# LINE 114 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf :: IO CString
{-# LINE 116 "src/Bindings/Bfd.hsc" #-}
            str <- peekCString val
            return $ Filename str
      | off == ((8)) = 
{-# LINE 119 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf :: IO Word
{-# LINE 121 "src/Bindings/Bfd.hsc" #-}
            return $ XVec $ wordPtrToPtr $ fromIntegral val
      | off == ((44)) =
{-# LINE 123 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf :: IO CUInt
{-# LINE 125 "src/Bindings/Bfd.hsc" #-}
            return $ Format $ toEnum $ fromIntegral val
      | off == ((52)) =
{-# LINE 127 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) buf :: IO CUInt
{-# LINE 129 "src/Bindings/Bfd.hsc" #-}
            return $ Bindings.Bfd.Flags $ fromIntegral val
      | off == ((100)) =
{-# LINE 131 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 100)) buf
{-# LINE 133 "src/Bindings/Bfd.hsc" #-}
            return $ Sections val
      | off == ((140)) =
{-# LINE 135 "src/Bindings/Bfd.hsc" #-}
         do
            val <- ((\hsc_ptr -> peekByteOff hsc_ptr 140)) buf :: IO Bfd
{-# LINE 137 "src/Bindings/Bfd.hsc" #-}
            return $ MyArchive val
      | otherwise = error $ "internal error: Bfd.peekByteOff " ++ show off
   poke _ _ = return ()


init
   :: IO ()
-- ^ Initialize the library.  Call 'init' before making any other calls.
init = c_bfd_init


getTargetsAndFormats 
   :: FilePath                   -- ^ The file to query
   -> IO [(TargetName, Format)]
-- ^ Returns a 'List' of tuples representing the possible combinations of 
-- 'TargetName' and 'Format' valid for this 'FilePath'.
--
-- Possible Exceptions:  Same as 'open'.
getTargetsAndFormats file =
   do
      ts <- Target.list
      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)
            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          -- ^ File to open
   -> Maybe TargetName  -- ^ Target
   -> FileMode
   -> IO Bfd
-- ^ Opens a file with the given target and mode
-- and returns a bfd object on success.  If the target is 'Nothing' then
-- the file is opened with the default target.
--
-- Possible exceptions:  'NoMemory' (if any allocation fails), 'SystemCall' 
-- (if open failed), and 'InvalidTarget' (if supplied target is not supported).
--
-- /Note:/ 'open' does not validate that the supplied 'TargetName' is appropriate
-- for the supplied file.
open fp targ mode =
   do
      fp'   <- newCString fp
      targ' <- newCString targ0
      mode' <- newCString mode
      throwExceptionIfNull "open" fp targ0 (c_bfd_fopen fp' targ' mode' (-1))
   where
      targ0 = fromMaybe "default" targ

close
   :: Bfd
   -> IO Bool
close bfd = 
   do
      r <- c_bfd_close bfd
      return $ toBool r


checkFormat
   :: Bfd
   -> Format
   -> IO Bool
checkFormat bfd format =
   do
      res <- c_bfd_check_format bfd format'
      throwExceptionIfFalse "checkFormat" (show format) (return $ toBool res)
   where
      format' = fromIntegral $ fromEnum format


getByteorder
   :: Bfd
   -> IO Endian
getByteorder bfd =
   do
      xvec <- getTarget bfd
      Target.getByteorder xvec

getHeaderByteorder
   :: Bfd
   -> IO Endian
getHeaderByteorder bfd =
   do
      xvec <- getTarget bfd
      Target.getHeaderByteorder xvec

getDisasm
   :: Bfd
   -> IO Disasm
getDisasm = c_disassembler
     
getFilename
   :: Bfd
   -> IO String
getFilename bfd =
   do
      fn <- peekByteOff bfd ((4))
{-# LINE 249 "src/Bindings/Bfd.hsc" #-}
      return $ unBfd'Filename fn
 
getFlags
   :: Bfd
   -> IO [BfdFlags.Flags]
getFlags bfd =
   do
      flags <- peekByteOff bfd ((52))
{-# LINE 257 "src/Bindings/Bfd.hsc" #-}
      let
         flags' = filter f $ enumFrom HasReloc
            where
               f e = unBfd'Flags flags .&. (bit $ fromEnum e) /= 0
      return flags'

getObjectFlags
   :: Bfd
   -> IO [BfdFlags.Flags]
getObjectFlags bfd =
   do
      xvec <- getTarget bfd
      Target.getObjectFlags xvec

getSectionFlags
   :: Bfd
   -> IO [SectionFlags.Flags]
getSectionFlags bfd =
   do
      xvec <- getTarget bfd
      Target.getSectionFlags xvec

getFlavour
   :: Bfd
   -> IO Flavour
getFlavour bfd =
   do
      xvec <- getTarget bfd
      Target.getFlavour xvec

getFormat
   :: Bfd
   -> IO Format
getFormat bfd =
   do
      format <- peekByteOff bfd ((44))
{-# LINE 293 "src/Bindings/Bfd.hsc" #-}
      return $ unBfd'Format format

getMachine
   :: Bfd
   -> IO Int
getMachine bfd = 
   do
      m <- c_bfd_get_mach bfd
      return $ fromIntegral m

getOctetsPerByte
   :: Bfd
   -> IO Int
getOctetsPerByte bfd =
   do
      opb <- c_bfd_octets_per_byte bfd
      return $ fromIntegral opb

getSectionByName
   :: Bfd
   -> SectionName
   -> IO Section
getSectionByName bfd sn = withCString sn (\s -> c_bfd_get_section_by_name bfd s) 

getSections
   :: Bfd
   -> IO [Section]
getSections bfd =
   do
      (Sections first) <- peekByteOff bfd ((100))
{-# LINE 323 "src/Bindings/Bfd.hsc" #-}
      getSections' first []
   where
      getSections' sect rs
         | sect == nullPtr = return $ reverse rs
         | otherwise       =
              do
                 next <- getNext sect
                 getSections' next (sect : rs)

getTarget
   :: Bfd
   -> IO Target
getTarget bfd = 
   do
      xv <- peekByteOff bfd ((8))
{-# LINE 338 "src/Bindings/Bfd.hsc" #-}
      return $ unBfd'XVec xv

getMyArchive
   :: Bfd
   -> IO (Maybe Bfd)
getMyArchive bfd =
   do
      ma <- peekByteOff bfd ((140))
{-# LINE 346 "src/Bindings/Bfd.hsc" #-}
      return $ case unBfd'MyArchive ma == nullPtr of
         True  -> Nothing
         False -> Just $ unBfd'MyArchive ma

getSymbolTable
   :: Bfd
   -> IO SymbolTable
getSymbolTable bfd =
   do
      xvec  <- getTarget bfd
      bound <- getSymtabUpperBound xvec bfd
      let
         ptrs = bound `quot` (4)
{-# LINE 359 "src/Bindings/Bfd.hsc" #-}
      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)
{-# LINE 372 "src/Bindings/Bfd.hsc" #-}
      pps <- mallocArray ptrs
      count <- canonicalizeDynamicSymtab xvec bfd pps
      return $ SymbolTable.mk pps count


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

getDynamicRelocations
   :: Bfd
   -> SymbolTable
   -> IO [Relocation]
getDynamicRelocations bfd st =
   do
      xvec  <- getTarget bfd
      bound <- getDynamicRelocUpperBound xvec bfd
      let
         ptrs = fromIntegral bound `quot` (4)
{-# LINE 400 "src/Bindings/Bfd.hsc" #-}
      ppr <- mallocArray ptrs
      count <- canonicalizeDynamicReloc xvec bfd ppr $ tablePtr st
      prs <- peekArray count ppr
      mapM peek prs


isBigEndian
   :: Bfd
   -> IO Bool
isBigEndian bfd =
   do
      bo <- Bindings.Bfd.getByteorder bfd
      return $ bo == Big

isLittleEndian
   :: Bfd
   -> IO Bool
isLittleEndian bfd =
   do
      bo <- Bindings.Bfd.getByteorder bfd
      return $ bo == Little

isHeaderBigEndian
   :: Bfd
   -> IO Bool
isHeaderBigEndian bfd =
   do
      bo <- Bindings.Bfd.getHeaderByteorder bfd
      return $ bo == Big

isHeaderLittleEndian
   :: Bfd
   -> IO Bool
isHeaderLittleEndian bfd =
   do
      bo <- Bindings.Bfd.getHeaderByteorder bfd
      return $ bo == Little

isCoffFamily
   :: Bfd
   -> IO Bool
isCoffFamily bfd =
   do
      flav <- Bindings.Bfd.getFlavour bfd
      return $ flav == Coff || flav == Xcoff

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'MyArchive
   :: Bfd'
   -> Bfd
unBfd'MyArchive (MyArchive ma) = ma
unBfd'MyArchive _              = error "unBfd'MyArchive"


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

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 Bfd

foreign import ccall unsafe "bfd.h bfd_close" c_bfd_close
   :: Bfd
   -> IO CInt

foreign import ccall unsafe "bfd.h bfd_check_format" c_bfd_check_format
   :: Bfd
   -> CInt
   -> IO CInt

foreign import ccall unsafe "bfd.h bfd_get_mach" c_bfd_get_mach
   :: Bfd
   -> IO CInt

foreign import ccall unsafe "bfd.h bfd_octets_per_byte" c_bfd_octets_per_byte
   :: Bfd
   -> IO CUInt

foreign import ccall unsafe "bfd.h bfd_get_section_by_name" c_bfd_get_section_by_name
   :: Bfd
   -> CString
   -> IO Section


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

foreign import ccall unsafe "dis-asm.h disassembler" c_disassembler
   :: Bfd
   -> IO Disasm