Symbol.hsc

-- 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.Symbol (
   -- * Types
     Symbol
   , Symbol'
   , SymbolName
   -- * Foo
   , getBase
   , getBfd
   , getFlags
   , Bindings.Bfd.Symbol.getFlavour
   , Bindings.Bfd.Symbol.getName
   , setName
   , getSection
   , setSection
   , Bindings.Bfd.Symbol.getOutputSection
   , getSize
   , getValue
   , setValue
   , getValue'
   , Bindings.Bfd.Symbol.print
) where

import Data.Bits
import Data.Word

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

import System.Posix.IO

import {-# SOURCE #-} Bindings.Bfd              as Bfd
import                Bindings.Bfd.Flavour
import                Bindings.Bfd.Misc
import {-# SOURCE #-} Bindings.Bfd.Section      as Section
import                Bindings.Bfd.Symbol.Flags as SymbolFlags
import                Bindings.Bfd.Target

#include <bfd.h>


type SymbolName = String

type Symbol = Ptr Symbol'

data Symbol' = Bfd      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 Bfd
            return $ 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'
   -> Bfd
unSymbol'TheBfd (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"


getBase
   :: Symbol
   -> IO Vma
getBase sym =
   do
      sect <- getSection sym
      getVma sect

getBfd 
   :: Symbol
   -> IO Bfd
getBfd sym =
   do
      bfd <- peekByteOff sym (#offset struct bfd_symbol, the_bfd)
      return $ 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'

getFlavour
   :: Symbol
   -> IO Flavour
getFlavour sym =
   do
      flags <- getFlags sym
      case Synthetic `elem` flags of
         True  -> return Unknown
         False ->
            do
               bfd <- getBfd sym
               Bfd.getFlavour bfd

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

setName
   :: Symbol
   -> SymbolName
   -> IO ()
setName sym name =
   do
      cs <- newCString name
      pokeByteOff sym (#offset struct bfd_symbol, name) $ Bindings.Bfd.Symbol.Name cs

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

setSection
   :: Symbol
   -> Section
   -> IO ()
setSection sym sect = pokeByteOff sym (#offset struct bfd_symbol, section) $ Section sect

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

getValue
   :: Symbol
   -> IO Vma
getValue sym =
   do
      v <- peekByteOff sym (#offset struct bfd_symbol, value)
      return $ unSymbol'Value v

setValue
   :: Symbol
   -> Vma
   -> IO ()
setValue sym vma = pokeByteOff sym (#offset struct bfd_symbol, value) (Value vma)

getValue'
   :: Symbol
   -> IO Vma
getValue' sym =
   do
      base <- getBase  sym
      val  <- getValue sym
      return $ base + val

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

      xvec <- getTarget bfd
      f    <- getPrintSymbol xvec bfd fpWrite sym

      f
      _ <- c_fflush fpWrite

      (s,_) <- fdRead pipeRead 80

      closeFd pipeRead
      closeFd pipeWrite
      return s