-- This file is part of Bindings-bfd.
--
-- 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.Target (
   -- * Types
     Target
   , Target'
   , TargetName
   -- * Functions
   -- ** Platform
   , list
   , setDefault
   -- ** Target
   , getByteorder
   , getHeaderByteorder
   , getObjectFlags
   , getSectionFlags
   , Bindings.Bfd.Target.getFlavour
   , getName
   -- ** Symtabs
   , getSymtabUpperBound
   , canonicalizeSymtab
   , getDynamicSymtabUpperBound
   , canonicalizeDynamicSymtab
   , getSyntheticSymtab
   -- ** Relocations
   , getDynamicRelocUpperBound
   , canonicalizeDynamicReloc
   , getPrintSymbol
) where

import Data.Bits
import Data.Word

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

import {-# SOURCE #-} Bindings.Bfd
import                Bindings.Bfd.Endian
import                Bindings.Bfd.Flags         as BfdFlags
import                Bindings.Bfd.Flavour
import                Bindings.Bfd.Misc
import {-# SOURCE #-} Bindings.Bfd.Relocation
import                Bindings.Bfd.Section.Flags as SectionFlags
import {-# SOURCE #-} Bindings.Bfd.Symbol        as Symbol
import {-# SOURCE #-} Bindings.Bfd.SymbolTable

#include <bfd.h>


type TargetName = String

type Target = Ptr Target'

data Target' = Name                       TargetName
             | Flavour                    Flavour
             | Byteorder                  Endian
             | HeaderByteorder            Endian
             | ObjectFlags                [BfdFlags.Flags]
             | SectionFlags               [SectionFlags.Flags]
             | GetSymtabUpperBound        (FunPtr (Bfd -> IO CLong))
             | CanonicalizeSymtab         (FunPtr (Bfd -> Ptr Symbol -> IO CLong))
             | PrintSymbol                (FunPtr (Bfd -> File -> Symbol -> CUInt -> IO ()))
             | GetDynamicSymtabUpperBound (FunPtr (Bfd -> IO CLong))
             | CanonicalizeDynamicSymtab  (FunPtr (Bfd -> Ptr Symbol -> IO CLong))
             | GetSyntheticSymtab         (FunPtr (Bfd -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong))
             | GetDynamicRelocUpperBound  (FunPtr (Bfd -> IO CLong))
             | CanonicalizeDynamicReloc   (FunPtr (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


list
   :: IO [TargetName]
list = 
   do
      let
         pts = c_bfd_target_list
      ps <- peekArray0 nullPtr pts
      mapM peekCString ps

setDefault
   :: TargetName
   -> IO Bool
setDefault tn =
   do
      s <- newCString tn
      r <- c_bfd_set_default_target s
      return $ toBool r


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

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

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'


getSymtabUpperBound
   :: Target
   -> Bfd
   -> IO Int
getSymtabUpperBound targ bfd =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_get_symtab_upper_bound)
      r <- d_Bfd_CLong (unTarget'GetSymtabUpperBound fn) bfd
      return $ fromIntegral r

canonicalizeSymtab
   :: Target
   -> Bfd
   -> Ptr Symbol
   -> IO Int
canonicalizeSymtab targ bfd ps =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_canonicalize_symtab)
      r <- d_Bfd_PtrSymbol_CLong (unTarget'CanonicalizeSymtab fn) bfd ps
      return $ fromIntegral r

getDynamicSymtabUpperBound
   :: Target
   -> Bfd
   -> IO Int
getDynamicSymtabUpperBound targ bfd =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_get_dynamic_symtab_upper_bound)
      r <- d_Bfd_CLong (unTarget'GetDynamicSymtabUpperBound fn) bfd
      return $ fromIntegral r

canonicalizeDynamicSymtab
   :: Target
   -> Bfd
   -> Ptr Symbol
   -> IO Int
canonicalizeDynamicSymtab targ bfd ps =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_canonicalize_dynamic_symtab)
      r <- d_Bfd_PtrSymbol_CLong (unTarget'CanonicalizeDynamicSymtab fn) bfd ps
      return $ fromIntegral r

getSyntheticSymtab
   :: Target
   -> Bfd
   -> SymbolTable
   -> SymbolTable
   -> Ptr Symbol
   -> IO Int
getSyntheticSymtab targ bfd sst dst synth =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_get_synthetic_symtab)
      r <- d_Bfd_CLong_PtrSymbol_CLong_PtrSymbol_PtrSymbol_CLong (fn' fn) bfd sts stp dts dtp synth
      return $ fromIntegral r
   where
      fn' = unTarget'GetSyntheticSymtab
      sts = fromIntegral $ tableSize sst
      stp = tablePtr sst
      dts = fromIntegral $ tableSize dst
      dtp = tablePtr dst

getDynamicRelocUpperBound
   :: Target
   -> Bfd
   -> IO Int
getDynamicRelocUpperBound targ bfd =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_get_dynamic_reloc_upper_bound)
      r <- d_Bfd_CLong (unTarget'GetDynamicRelocUpperBound fn) bfd
      return $ fromIntegral r

canonicalizeDynamicReloc
   :: Target
   -> Bfd
   -> Ptr (Ptr Relocation)
   -> Ptr Symbol
   -> IO Int
canonicalizeDynamicReloc targ bfd rels syms =
   do
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_canonicalize_dynamic_reloc)
      r <- d_Bfd_PtrPtrRelocation_PtrSymbol_CLong (unTarget'CanonicalizeDynamicReloc fn) bfd rels syms
      return $ fromIntegral r


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"

unTarget'GetSymtabUpperBound
   :: Target'
   -> FunPtr (Bfd -> IO CLong)
unTarget'GetSymtabUpperBound (GetSymtabUpperBound fn) = fn
unTarget'GetSymtabUpperBound _                        = error "unTarget'GetSymtabUpperBound"

unTarget'CanonicalizeSymtab
   :: Target'
   -> FunPtr (Bfd -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeSymtab (CanonicalizeSymtab fn) = fn
unTarget'CanonicalizeSymtab _                       = error "unTarget'CanonicalizeSymtab"

unTarget'GetDynamicSymtabUpperBound
   :: Target'
   -> FunPtr (Bfd -> IO CLong)
unTarget'GetDynamicSymtabUpperBound (GetDynamicSymtabUpperBound fn) = fn
unTarget'GetDynamicSymtabUpperBound _                               = error "unTarget'GetDynamicSymtabUpperBound"

unTarget'CanonicalizeDynamicSymtab
   :: Target'
   -> FunPtr (Bfd -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeDynamicSymtab (CanonicalizeDynamicSymtab fn) = fn
unTarget'CanonicalizeDynamicSymtab _                              = error "unTarget'CanonicalizeDynamicSymtab"

unTarget'GetSyntheticSymtab
   :: Target'
   -> FunPtr (Bfd -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong)
unTarget'GetSyntheticSymtab (GetSyntheticSymtab fn) = fn
unTarget'GetSyntheticSymtab _                       = error "unTarget'GetSyntheticSymtab"

unTarget'GetDynamicRelocUpperBound
   :: Target'
   -> FunPtr (Bfd -> IO CLong)
unTarget'GetDynamicRelocUpperBound (GetDynamicRelocUpperBound fn) = fn
unTarget'GetDynamicRelocUpperBound _                              = error "unTarget'GetDynamicRelocUpperBound"

unTarget'CanonicalizeDynamicReloc
   :: Target'
   -> FunPtr (Bfd -> Ptr (Ptr Relocation) -> Ptr Symbol -> IO CLong)
unTarget'CanonicalizeDynamicReloc (CanonicalizeDynamicReloc fn) = fn
unTarget'CanonicalizeDynamicReloc _                             = error "unTarget'CanonicalizeDynamicReloc"

unXVec2
   :: Target'
   -> FunPtr (Bfd -> File -> Symbol -> CUInt -> IO ())
unXVec2 (PrintSymbol fn) = fn
unXVec2 x                = error $ "internal error: unXVec2 " ++ show x


getPrintSymbol
   :: Target
   -> Bfd
   -> File
   -> Symbol
   -> IO (IO ())
getPrintSymbol targ bfd file sym =
   do 
      fn <- peekByteOff targ (#offset struct bfd_target, _bfd_print_symbol)
      let
         f = d_Bfd_File_Symbol_CUInt_Void (unXVec2 fn) bfd file sym 2
      return f


foreign import ccall unsafe "bfd.h bfd_target_list" c_bfd_target_list
   :: Ptr CString

foreign import ccall unsafe "bfd.h bfd_set_default_target" c_bfd_set_default_target
   :: CString
   -> IO CInt

foreign import ccall unsafe "dynamic" d_Bfd_CLong
   :: FunPtr (Bfd -> IO CLong)
   -> (Bfd -> IO CLong)

foreign import ccall unsafe "dynamic" d_Bfd_CLong_PtrSymbol_CLong_PtrSymbol_PtrSymbol_CLong
   :: FunPtr (Bfd -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong) 
   -> (Bfd -> CLong -> Ptr Symbol -> CLong -> Ptr Symbol -> Ptr Symbol -> IO CLong)

foreign import ccall unsafe "dynamic" d_Bfd_PtrSymbol_CLong
   :: FunPtr (Bfd -> Ptr Symbol -> IO CLong)
   -> (Bfd -> Ptr Symbol -> IO CLong)

foreign import ccall unsafe "dynamic" d_Bfd_PtrPtrRelocation_PtrSymbol_CLong
   :: FunPtr (Bfd -> Ptr (Ptr Relocation) -> Ptr Symbol -> IO CLong) 
   -> (Bfd -> Ptr (Ptr Relocation) -> Ptr Symbol -> IO CLong)

foreign import ccall unsafe "dynamic" d_Bfd_File_Symbol_CUInt_Void
   :: FunPtr (Bfd -> File -> Symbol -> CUInt -> IO ()) 
   -> (Bfd -> File -> Symbol -> CUInt -> IO ())