-- 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 <http://www.gnu.org/licenses/>.

module Bindings.Bfd.Symbol (
   -- * Types
     Symbol
   , SymbolName
   -- * Addressing
   , getBase
   , setValue
   , getValue
   , getValue'
   , getBfd
   , getFlags
   , Bindings.Bfd.Symbol.getFlavour
   -- * SymbolName
   , setName
   , Bindings.Bfd.Symbol.getName
   -- * Sections
   , setSection
   , getSection
   , Bindings.Bfd.Symbol.getOutputSection
   , Bindings.Bfd.Symbol.getSize
   , Bindings.Bfd.Symbol.print
   -- * Internal
   , Symbol'
) where

import Data.Bits ( (.&.), bit )
import Data.Word ( Word )

import Foreign.C        ( CString, CUInt, newCString, peekCString )
import Foreign.Ptr      ( Ptr, wordPtrToPtr )
import Foreign.Storable ( Storable, alignment, peekByteOff, pokeByteOff, sizeOf )

import System.Posix.IO ( FdOption(NonBlockingRead), closeFd, createPipe, fdRead
                       , setFdOption )

import {-# SOURCE #-} Bindings.Bfd              as Bfd         ( Bfd, Bfd'
                                                               , getPrintSymbol
                                                               , getTarget, mk)
import                Bindings.Bfd.Flavour                     ( Flavour(Unknown) )
import                Bindings.Bfd.Misc                        ( Vma, c_fdopen
                                                               , c_fflush )
import {-# SOURCE #-} Bindings.Bfd.Section      as Section     ( Section
                                                               , getOutputSection
                                                               , getVma )
import                Bindings.Bfd.Symbol.Flags as SymbolFlags ( Flags(Local, Synthetic) )
import                Bindings.Bfd.Target       as Target      ( getFlavour )

#include <bfd.h>


type SymbolName = String

type Symbol = Ptr Symbol'

data Symbol' = Bfd      (Ptr Bfd')      
             | Name     CString
             | Value    Vma
             | Flags    Int
             | Section  Section
     deriving (Show)


instance Storable Symbol' where
   sizeOf _ = (#size struct bfd_symbol)
   alignment = sizeOf
   peekByteOff buf off
      | off == (#offset struct bfd_symbol, the_bfd) =
         do
            val <- (#peek struct bfd_symbol, the_bfd) buf :: IO (Ptr Bfd')
            return $ Bindings.Bfd.Symbol.Bfd val
      | off == (#offset struct bfd_symbol, name) = 
         do
            val <- (#peek struct bfd_symbol, name) buf :: IO Word
            return $ Bindings.Bfd.Symbol.Name $ wordPtrToPtr $ fromIntegral val
      | off == (#offset struct bfd_symbol, value) =
         do 
            val <- (#peek struct bfd_symbol, value) buf
            return $ Value val
      | off == (#offset struct bfd_symbol, flags) =
         do
            val <- (#peek struct bfd_symbol, flags) buf :: IO CUInt
            return $ Bindings.Bfd.Symbol.Flags $ fromIntegral val
      | off == (#offset struct bfd_symbol, section) =
         do 
            val <- (#peek struct bfd_symbol, section) buf
            return $ Section val
      | otherwise = error $ "internal error: Bfd.Symbol.peekByteOffset " ++ show off
   pokeByteOff buf off val
      | off == (#offset struct bfd_symbol, name) =
           (#poke struct bfd_symbol, name) buf (unSymbol'Name val)
      | off == (#offset struct bfd_symbol, value) =
           (#poke struct bfd_symbol, value) buf (unSymbol'Value val)
      | off == (#offset struct bfd_symbol, section) =
           (#poke struct bfd_symbol, section) buf (unSymbol'Section val)
      | otherwise = error $ "internal error: Bfd.Symbol.pokeByteOff " ++ show off


unSymbol'TheBfd
   :: Symbol'
   -> Ptr Bfd'
unSymbol'TheBfd (Bindings.Bfd.Symbol.Bfd b) = b
unSymbol'TheBfd _       = error "unSymbol'TheBfd"

unSymbol'Name
   :: Symbol'
   -> CString
unSymbol'Name (Bindings.Bfd.Symbol.Name s) = s
unSymbol'Name _                            = error "unSymbol'Name"

unSymbol'Value
   :: Symbol'
   -> Vma
unSymbol'Value (Value v) = v
unSymbol'Value _         = error "unSymbol'Value"

unSymbol'Flags
   :: Symbol'
   -> Int
unSymbol'Flags (Bindings.Bfd.Symbol.Flags f) = f
unSymbol'Flags _                             = error "unSymbol'Flags"

unSymbol'Section
   :: Symbol'
   -> Section
unSymbol'Section (Section s) = s
unSymbol'Section _           = error "unSymbol'Section"


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

-- | Returns the 'Vma' of the 'Section' that the symbol belongs to.
getBase
   :: Symbol
   -> IO Vma
getBase sym =
   do
      sect <- getSection sym
      getVma sect

-- | Set the offset of the 'Symbol' within its 'Section'.
setValue
   :: Symbol
   -> Vma
   -> IO ()
setValue sym vma = pokeByteOff sym (#offset struct bfd_symbol, value) (Value vma)

-- | Returns the offset of the 'Symbol' within its 'Section'.
getValue
   :: Symbol
   -> IO Vma
getValue sym =
   do
      v <- peekByteOff sym (#offset struct bfd_symbol, value)
      return $ unSymbol'Value v

-- | Returns the absolute 'Vma' of the 'Symbol' (that is, its 'getBase' + 
-- 'getValue'.
getValue'
   :: Symbol
   -> IO Vma
getValue' sym =
   do
      base <- getBase  sym
      val  <- getValue sym
      return $ base + val

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

-- | Returns the 'Bfd' that the 'Symbol' belongs to.
--
-- /Note:/ If the returned 'Bfd' should not be passed to 'close' or 
-- 'closeAllDone' there will be memory leaks.
getBfd 
   :: Symbol
   -> IO Bfd
getBfd sym =
   do
      bfd <- peekByteOff sym (#offset struct bfd_symbol, the_bfd)
      return $ Bfd.mk $ unSymbol'TheBfd bfd

getFlags
   :: Symbol
   -> IO [SymbolFlags.Flags]
getFlags sym =
   do
      flags <- peekByteOff sym (#offset struct bfd_symbol, flags)
      let
         flags' = filter f $ enumFrom Local
            where
               f e = unSymbol'Flags flags .&. (bit $ fromEnum e) /= 0
      return flags'

-- | If the 'Symbol' has the 'Synthetic' flag set then return 'Unknown', 
-- otherwise returns 'getFlavour' on the 'Symbol's 'Bfd'\'s 'Target'.
getFlavour
   :: Symbol
   -> IO Flavour
getFlavour sym =
   do
      flags <- getFlags sym
      case Synthetic `elem` flags of
         True  -> return Unknown
         False ->
            do
               bfd <- getBfd sym
               targ <- getTarget bfd
               Target.getFlavour targ

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

-- | Sets the 'SymbolName' of the 'Symbol'.
--
-- /Note:/ The memory allocated to the 'SymbolName' is never freed.
setName
   :: Symbol
   -> SymbolName
   -> IO ()
setName sym name =
   do
      cs <- newCString name
      pokeByteOff sym (#offset struct bfd_symbol, name) $ Bindings.Bfd.Symbol.Name cs

-- | Returns the 'SymbolName' of the 'Symbol'.
getName
   :: Symbol
   -> IO SymbolName
getName sym =
   do
      s' <- peekByteOff sym (#offset struct bfd_symbol, name)
      peekCString $ unSymbol'Name s'

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

-- | Sets the 'Symbol's 'Section'.
setSection
   :: Symbol
   -> Section
   -> IO ()
setSection sym sect = pokeByteOff sym (#offset struct bfd_symbol, section) $ Section sect

-- | Returns the 'Symbol's 'Section'.
getSection
   :: Symbol
   -> IO Section
getSection sym =
   do
      sect <- peekByteOff sym (#offset struct bfd_symbol, section)
      return $ unSymbol'Section sect

-- | Returns the 'Symbol's output 'Section'.
getOutputSection
   :: Symbol
   -> IO Section
getOutputSection sym =
   do
      sect <- getSection sym
      Section.getOutputSection sect

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

getSize
   :: Symbol
   -> Bfd
   -> IO Int
getSize sym bfd =
   do
      str <- Bindings.Bfd.Symbol.print sym bfd
      let
         size = read $ "0x" ++ (head $ tail $ reverse $ words str)
      return size

print
   :: Symbol
   -> Bfd
   -> IO String
print sym bfd = 
   do
      (pipeRead, pipeWrite) <- createPipe
      setFdOption pipeRead NonBlockingRead False

      let
         pipeWrite' = fromIntegral pipeWrite
      mode <- newCString "w"
      fpWrite <- c_fdopen pipeWrite' mode

      f    <- getPrintSymbol bfd fpWrite sym

      f
      _ <- c_fflush fpWrite

      (s,_) <- fdRead pipeRead 80

      closeFd pipeRead
      closeFd pipeWrite
      return s