Info.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.Disassembler.Info where

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

import System.Posix.IO
import System.Posix.Types

import Bindings.Bfd.Misc

#include <dis-asm.h>


type FPrintfFn = FunPtr (File -> CString -> IO CInt)


data Info = Info Info0 Fd
     deriving (Eq)

type Info0 = Ptr Info'

data Info' = Machine{- {
                          fprintfFunc            :: FunPtr (Ptr Void, CString)
                        , stream                 :: Ptr Void
                        , flavour                :: Flavour
                        , arch                   :: Architecture
                        , mach                   :: Machine
                        , endian                 :: Endian
                        , endianCode             :: Endian
                        , insnSets               :: Void Ptr
                        , section                :: Maybe Section
                        , symbols                :: [Symbol]
                        , numSymbols             :: Int
                        , symtab                 :: [Symbol]
                        , symtabPos              :: Int
                        , symtabSize             :: Int
                        , flags                  :: Flags
                        , privateData            :: Ptr Void
                        , readMemoryFunc         :: FunPtr (CInt, Vma, Info)
                        , printAddressFunc       :: FunPtr (Vma, Info)
                        , symbolAtAddressFunc    :: FunPtr (Vma, Info)
                        , symbolIsValidFunc      :: FunPtr (Symbol, Info)
                        , buffer                 :: Ptr CChar
                        , bufferVma              :: Vma
                        , bufferLength           :: Int
                        , bytesPerLine           :: Int
                        , bytesPerChunk          :: Int
                        , displayEndian          :: Endian
                        , octetsPerByte          :: Int
                        , skipZeros              :: Int
                        , skipZerosAtEnd         :: Int
                        , disassemblerNeedRelocs :: Bool
                        , insnInfoValid          :: Bool
                        , branchDelayInsn        :: Int
                        , dataSize               :: Int
                        , insnType               :: Type
                        , target                 :: Vma
                        , target2                :: Vma
                        , disassemblerOptions    :: String

             }
-}

instance Storable Info' where
   sizeOf _ = #size struct disassemble_info
   alignment = sizeOf
   pokeByteOff buf off val
      | off == (#offset struct disassemble_info, print_address_func) =
            (#poke struct disassemble_info, print_address_func) buf val
      | off == (#offset struct disassemble_info, buffer       ) = 
            (#poke struct disassemble_info, buffer       ) buf val
      | off == (#offset struct disassemble_info, buffer_vma   ) = 
            (#poke struct disassemble_info, buffer_vma   ) buf val
      | off == (#offset struct disassemble_info, buffer_length) = 
            (#poke struct disassemble_info, buffer_length) buf val
      | off == (#offset struct disassemble_info, disassembler_options) =
            (#poke struct disassemble_info, disassembler_options) buf val 
   pokeByteOff _   off _ = error $ "Info.pokeByteOff: " ++ show off     
   peekByteOff _ _ = error $ "Info.peekByteOff undefined"

mk
   :: IO Info
mk =
   do
      (pipeRead, pipeWrite) <- createPipe
      setFdOption pipeRead NonBlockingRead True
      let
         pipeWrite' = fromIntegral pipeWrite
      mode <- newCString "w"
      fpWrite <- c_fdopen pipeWrite' mode
      i <- malloc :: IO Info0
      c_init_disassemble_info i fpWrite c_bfd_disassembler_info_fprintf -- structure zeroed here
      pokeByteOff i (#offset struct disassemble_info, print_address_func) c_bfd_disassembler_info_print_address
      return $ Info i pipeRead

setMachine
   :: Info
   -> Int
   -> IO ()
setMachine (Info info _) mach = pokeByteOff info (#offset disassemble_info, mach) mach

setBuffer 
   :: Info
   -> String
   -> Vma
   -> IO ()
setBuffer (Info info _) str vma =
   do
      str' <- newCAStringLen str
      pokeByteOff info (#offset disassemble_info, buffer) $ fst str'
      pokeByteOff info (#offset disassemble_info, buffer_length) $ snd str'
      pokeByteOff info (#offset disassemble_info, buffer_vma) vma

setOptions
   :: Info
   -> String
   -> IO ()
setOptions (Info info _) str =
   do
      str' <- newCString str
      pokeByteOff info (#offset disassemble_info, disassembler_options) str'

foreign import ccall unsafe "dis-asm.h init_disassemble_info" c_init_disassemble_info
   :: Info0
   -> File
   -> FPrintfFn
   -> IO ()

foreign import ccall unsafe "cbits/disassembler.h &_bfd_disassembler_info_fprintf" c_bfd_disassembler_info_fprintf
   :: FPrintfFn

foreign import ccall unsafe "cbits/disassembler.h &_bfd_disassembler_info_print_address" c_bfd_disassembler_info_print_address
   :: FunPtr (Vma' -> Info0 -> IO ())