diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,1 @@
+You're on yer own until I get time to write this. Extremely alpha.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bindings-bfd.cabal b/bindings-bfd.cabal
new file mode 100644
--- /dev/null
+++ b/bindings-bfd.cabal
@@ -0,0 +1,60 @@
+name: bindings-bfd
+version: 0.1.3
+cabal-version: >= 1.4
+build-type: Simple
+license: LGPL-3
+license-file: LICENSE
+copyright: (c) 2009, 2010 Michael Nelson
+author: Michael Nelson
+maintainer: mcnster@gmail.com
+stability: alpha
+homepage: http://projects.haskell.org/bindings-bfd/
+bug-reports: mailto:mcnster@gmail.com
+package-url: http://projects.haskell.org/bindings-bfd/bindings-bfd.cabal
+synopsis: Bindings for libbfd, a component of the GNU `binutils'
+description: These are bindings for `libbfd', a component of the GNU
+ `binutils' package. The bindings lets a Haskell program
+ query the structure of any executable, object, or
+ library file format supported by the GNU Project.
+ It also has support for disassembly of code in these
+ files where appropriate.
+category: Bindings
+tested-with: GHC==6.12.3
+extra-source-files: README,
+ LICENSE,
+ src/cbits/disassembler.h
+library
+ exposed-modules: Bindings.Bfd
+ Bindings.Bfd.Disassembler
+ Bindings.Bfd.Disassembler.Info
+ Bindings.Bfd.Exception
+ Bindings.Bfd.Endian
+ Bindings.Bfd.Flags
+ Bindings.Bfd.Flavour
+ Bindings.Bfd.Format
+ Bindings.Bfd.LinkInfo
+ Bindings.Bfd.LinkOrder
+ Bindings.Bfd.Misc
+ Bindings.Bfd.Relocation
+ Bindings.Bfd.Section
+ Bindings.Bfd.Section.Flags
+ Bindings.Bfd.Symbol
+ Bindings.Bfd.Symbol.Flags
+ Bindings.Bfd.SymbolTable
+ Bindings.Bfd.Target
+ build-depends: base >= 4.1.0.0 && < 5,
+ containers >= 0.2.0.1,
+ unix >= 2.3.2.0
+ hs-source-dirs: src
+ extensions: CPP,
+ ForeignFunctionInterface
+ ghc-options: -Wall
+ build-tools: hsc2hs >= 0.67
+ includes: bfd.h,
+ dis-asm.h,
+ stdarg.h,
+ stdio.h
+ c-sources: src/cbits/disassembler.c
+ extra-libraries: bfd,
+ opcodes
+
diff --git a/src/Bindings/Bfd.hs-boot b/src/Bindings/Bfd.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd.hs-boot
@@ -0,0 +1,50 @@
+-- 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 .
+
+module Bindings.Bfd where
+
+import Foreign.Ptr
+import Foreign.Storable
+
+import Bindings.Bfd.Flavour
+import {-# SOURCE #-} Bindings.Bfd.Section
+import {-# SOURCE #-} Bindings.Bfd.Target
+
+
+type Bfd = Ptr Bfd'
+
+data Bfd'
+
+instance Storable Bfd'
+
+
+getFlavour
+ :: Bfd
+ -> IO Flavour
+
+getOctetsPerByte
+ :: Bfd
+ -> IO Int
+
+getTarget
+ :: Bfd
+ -> IO Target
+
+getSections
+ :: Bfd
+ -> IO [Section]
+
diff --git a/src/Bindings/Bfd.hsc b/src/Bindings/Bfd.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd.hsc
@@ -0,0 +1,550 @@
+-- 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 .
+
+module Bindings.Bfd (
+ -- * Types
+ Bfd
+ , Bfd'
+ , FileMode
+ -- * Functions
+ -- ** Initialization
+ , init
+ -- ** Files
+ , getTargetsAndFormats
+ , open
+ , close
+ -- ** Format
+ , checkFormat
+ -- ** Foo
+ , Bindings.Bfd.getByteorder
+ , Bindings.Bfd.getHeaderByteorder
+ , getDisassembler
+ , 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
+#if 0
+ , getSyntheticSymbolTable
+#endif
+ -- *** 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.Disassembler
+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
+
+#include
+
+
+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 _ = #size struct bfd
+ alignment = sizeOf
+ peekByteOff buf off
+ | off == (#offset struct bfd, filename) =
+ do
+ val <- (#peek struct bfd, filename) buf :: IO CString
+ str <- peekCString val
+ return $ Filename str
+ | off == (#offset struct bfd, xvec) =
+ do
+ val <- (#peek struct bfd, xvec) buf :: IO Word
+ return $ XVec $ wordPtrToPtr $ fromIntegral val
+ | off == (#offset struct bfd, format) =
+ do
+ val <- (#peek struct bfd, format) buf :: IO CUInt
+ return $ Format $ toEnum $ fromIntegral val
+ | off == (#offset struct bfd, flags) =
+ do
+ val <- (#peek struct bfd, flags) buf :: IO CUInt
+ return $ Bindings.Bfd.Flags $ fromIntegral val
+ | off == (#offset struct bfd, sections) =
+ do
+ val <- (#peek struct bfd, sections) buf
+ return $ Sections val
+ | off == (#offset struct bfd, my_archive) =
+ do
+ val <- (#peek struct bfd, my_archive) buf :: IO Bfd
+ 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
+
+getDisassembler
+ :: Bfd
+ -> IO Disassembler
+getDisassembler = c_disassembler
+
+getFilename
+ :: Bfd
+ -> IO String
+getFilename bfd =
+ do
+ fn <- peekByteOff bfd (#offset struct bfd, filename)
+ return $ unBfd'Filename fn
+
+getFlags
+ :: Bfd
+ -> IO [BfdFlags.Flags]
+getFlags bfd =
+ do
+ flags <- peekByteOff bfd (#offset struct bfd, flags)
+ 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 (#offset struct bfd, format)
+ 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 (#offset struct bfd, sections)
+ 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 (#offset struct bfd, xvec)
+ return $ unBfd'XVec xv
+
+getMyArchive
+ :: Bfd
+ -> IO (Maybe Bfd)
+getMyArchive bfd =
+ do
+ ma <- peekByteOff bfd (#offset struct bfd, my_archive)
+ 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` (#const sizeof(struct bfd_symbol *))
+ 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` (#const sizeof(struct bfd_symbol *))
+ pps <- mallocArray ptrs
+ count <- canonicalizeDynamicSymtab xvec bfd pps
+ return $ SymbolTable.mk pps count
+
+#if 0
+getSyntheticSymbolTable
+ :: Bfd
+ -> SymbolTable -- static
+ -> SymbolTable -- dynamic
+ -> IO SymbolTable
+getSyntheticSymbolTable bfd sst dst =
+ do
+ xvec <- getTarget bfd
+ ssyms <- malloc
+ count <- getSyntheticSymtab xvec bfd sst dst ssyms
+ return $ SymbolTable.mk ssyms count
+#endif
+
+getDynamicRelocations
+ :: Bfd
+ -> SymbolTable
+ -> IO [Relocation]
+getDynamicRelocations bfd st =
+ do
+ xvec <- getTarget bfd
+ bound <- getDynamicRelocUpperBound xvec bfd
+ let
+ ptrs = fromIntegral bound `quot` (#const sizeof(arelent *))
+ 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"
+
+#if 0
+createSections
+ :: Bfd
+ -> IO [(Section, Vma)]
+createSections bfd =
+ do
+ sects <- getSections bfd
+ extSect <- Section.mk "externs" 5
+ (_, sectList) <- foldM f (0,[]) $ sects ++ [extSect]
+ return $ reverse sectList
+ where
+ f (vma,xs') sect =
+ do
+ (vma',snvma) <- createSection sect vma
+ return (vma', snvma : xs')
+
+demangle
+ :: Bfd
+ -> String
+ -> IO String
+demangle bfd str =
+ do
+ s <- withCString str (\s -> c_bfd_demangle bfd s 3)
+ case s == nullPtr of
+ True -> return ""
+ False ->
+ do
+ s' <- peekCString s
+ return s'
+#endif
+
+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
+
+#if 0
+foreign import ccall unsafe "bfd.h bfd_demangle" c_bfd_demangle
+ :: Bfd
+ -> CString
+ -> CInt
+ -> IO CString
+#endif
+
+foreign import ccall unsafe "dis-asm.h disassembler" c_disassembler
+ :: Bfd
+ -> IO Disassembler
+
diff --git a/src/Bindings/Bfd/Disassembler.hs b/src/Bindings/Bfd/Disassembler.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Disassembler.hs
@@ -0,0 +1,52 @@
+-- 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 .
+
+module Bindings.Bfd.Disassembler where
+
+import Foreign.C
+import Foreign.Ptr
+
+import System.Posix.IO
+
+import Bindings.Bfd.Disassembler.Info
+import Bindings.Bfd.Misc
+
+
+type Disassembler = FunPtr Disassembler'
+
+type Disassembler' = Vma' -> Info0 -> IO CInt
+
+
+run
+ :: (Integral a)
+ => Disassembler
+ -> Info
+ -> a
+ -> IO (String, Int)
+run disasm (Info info fd) vma =
+ do
+ let
+ vma' = fromIntegral vma
+ f = d_run disasm vma' info
+
+ len <- f
+ (str,_) <- fdRead fd 80 -- arbitrarily longer than any possible assembler expression (we hope)
+
+ return (str, fromIntegral len :: Int)
+
+foreign import ccall unsafe "dynamic" d_run
+ :: Disassembler -> Disassembler'
diff --git a/src/Bindings/Bfd/Disassembler/Info.hsc b/src/Bindings/Bfd/Disassembler/Info.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Disassembler/Info.hsc
@@ -0,0 +1,152 @@
+-- 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 .
+
+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
+
+
+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 ())
diff --git a/src/Bindings/Bfd/Endian.hs b/src/Bindings/Bfd/Endian.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Endian.hs
@@ -0,0 +1,28 @@
+-- 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 .
+
+module Bindings.Bfd.Endian (
+ -- * Types
+ Endian(..)
+) where
+
+
+data Endian = Big
+ | Little
+ | Unknown
+ deriving (Enum, Eq, Show)
+
diff --git a/src/Bindings/Bfd/Exception.hs b/src/Bindings/Bfd/Exception.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Exception.hs
@@ -0,0 +1,152 @@
+-- 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 .
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Bindings.Bfd.Exception where
+
+import Control.Exception
+
+import Data.Typeable
+
+import Foreign.C
+import Foreign.Ptr
+
+import Bindings.Bfd.Target
+
+
+type FunctionName = String
+type FormatName = String
+type ErrorMsg = String
+
+data BfdException = NoError FunctionName FilePath TargetName
+ | SystemCall FunctionName FilePath TargetName ErrorMsg
+ | InvalidTarget FunctionName FilePath TargetName
+ | WrongFormat
+ | WrongObjectFormat
+ | InvalidOperation
+ | NoMemory
+ | NoSymbols
+ | NoArmap
+ | NoMoreArchivedFiles
+ | MalformedArchive
+ | FileNotRecognized FunctionName FormatName
+ | FileAmbiguouslyRecognized
+ | NoContents
+ | NonrepresentableSection
+ | NoDebugSection
+ | BadValue
+ | FileTruncated
+ | FileTooBig
+ | OnInput
+ | InvalidErrorCode
+ deriving (Typeable)
+
+instance Show BfdException where
+ show (NoError fn fp tn ) = fp ++ ": " ++ fn ++ ": '" ++ tn ++ "': no error (report this as a bug)"
+ show (SystemCall fn fp tn msg) = fp ++ ": " ++ fn ++ ": '" ++ tn ++ "': system call (" ++ msg ++ ")"
+ show (InvalidTarget fn fp tn ) = fp ++ ": " ++ fn ++ ": '" ++ tn ++ "': invalid target"
+ show (WrongFormat ) = "3"
+ show (WrongObjectFormat ) = "4"
+ show (InvalidOperation ) = "5"
+ show (NoMemory ) = "6"
+ show (NoSymbols ) = "7"
+ show (NoArmap ) = "8"
+ show (NoMoreArchivedFiles ) = "9"
+ show (MalformedArchive ) = "10"
+ show (FileNotRecognized fn ff ) = ff ++ ": " ++ fn ++ ": " ++ "file format not recognized"
+ show (FileAmbiguouslyRecognized ) = "12"
+ show (NoContents ) = "13"
+ show (NonrepresentableSection ) = "14"
+ show (NoDebugSection ) = "15"
+ show (BadValue ) = "16"
+ show (FileTruncated ) = "17"
+ show (FileTooBig ) = "18"
+ show (OnInput ) = "19"
+ show (InvalidErrorCode ) = "20"
+
+instance Exception BfdException where
+
+
+throwExceptionIfNull
+ :: FunctionName
+ -> FilePath
+ -> TargetName
+ -> IO (Ptr a)
+ -> IO (Ptr a)
+throwExceptionIfNull fn fp tn f =
+ do
+ res <- f
+ if res == nullPtr
+ then throwException fn fp tn
+ else return res
+
+throwExceptionIfFalse
+ :: FunctionName
+ -> FormatName
+ -> IO Bool
+ -> IO Bool
+throwExceptionIfFalse fn ff f =
+ do
+ res <- f
+ if res == False
+ then throwException fn ff ""
+ else return res
+
+throwException
+ :: String
+ -> String
+ -> String
+ -> IO a
+throwException s1 s2 s3 =
+ do
+ errNum <- c_bfd_get_error
+ errMsg <- peekCString (c_bfd_errmsg errNum)
+ let
+ e =
+ case errNum of
+ 0 -> NoError s1 s2 s3
+ 1 -> SystemCall s1 s2 s3 errMsg
+ 2 -> InvalidTarget s1 s2 s3
+ 3 -> WrongFormat
+ 4 -> WrongObjectFormat
+ 5 -> InvalidOperation
+ 6 -> NoMemory
+ 7 -> NoSymbols
+ 8 -> NoArmap
+ 9 -> NoMoreArchivedFiles
+ 10 -> MalformedArchive
+ 11 -> FileNotRecognized s1 s2
+ 12 -> FileAmbiguouslyRecognized
+ 13 -> NoContents
+ 14 -> NonrepresentableSection
+ 15 -> NoDebugSection
+ 16 -> BadValue
+ 17 -> FileTruncated
+ 18 -> FileTooBig
+ 19 -> OnInput
+ _ -> InvalidErrorCode
+ throwIO e
+
+
+foreign import ccall unsafe "bfd.h bfd_get_error" c_bfd_get_error
+ :: IO CInt
+
+foreign import ccall unsafe "bfd.h bfd_errmsg" c_bfd_errmsg
+ :: CInt
+ -> CString
+
diff --git a/src/Bindings/Bfd/Flags.hs b/src/Bindings/Bfd/Flags.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Flags.hs
@@ -0,0 +1,37 @@
+-- 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 .
+
+module Bindings.Bfd.Flags where
+
+
+data Flags = HasReloc
+ | ExecP
+ | HasLineNo
+ | HasDebug
+ | HasSyms
+ | HasLocals
+ | Dynamic
+ | WpText
+ | DPaged
+ | IsRelaxable
+ | TraditionalFormat
+ | InMemory
+ | HasLoadPage
+ | LinkerCreated
+ | DeterministicOutput
+ deriving (Enum, Show)
+
diff --git a/src/Bindings/Bfd/Flavour.hs b/src/Bindings/Bfd/Flavour.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Flavour.hs
@@ -0,0 +1,46 @@
+-- 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 .
+
+module Bindings.Bfd.Flavour where
+
+
+data Flavour = Unknown
+ | Aout
+ | Coff
+ | Ecoff
+ | Xcoff
+ | Elf
+ | Ieee
+ | Nlm
+ | Oasys
+ | Tekhex
+ | Srec
+ | Verilog
+ | Ihex
+ | Som
+ | Os9k
+ | Versados
+ | Msdos
+ | Ovax
+ | Evax
+ | Mmo
+ | MachO
+ | Pef
+ | PefXlib
+ | Sym
+ deriving (Enum, Eq, Show)
+
diff --git a/src/Bindings/Bfd/Format.hs b/src/Bindings/Bfd/Format.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Format.hs
@@ -0,0 +1,26 @@
+-- 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 .
+
+module Bindings.Bfd.Format where
+
+
+data Format = Unknown
+ | Object
+ | Archive
+ | Core
+ deriving (Enum, Eq, Show)
+
diff --git a/src/Bindings/Bfd/LinkInfo.hsc b/src/Bindings/Bfd/LinkInfo.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/LinkInfo.hsc
@@ -0,0 +1,25 @@
+-- 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 .
+
+module Bindings.Bfd.LinkInfo where
+
+import Foreign.Ptr
+
+
+type LinkInfo = Ptr LinkInfo'
+
+data LinkInfo' = LinkInfo'
diff --git a/src/Bindings/Bfd/LinkOrder.hsc b/src/Bindings/Bfd/LinkOrder.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/LinkOrder.hsc
@@ -0,0 +1,62 @@
+-- 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 .
+
+module Bindings.Bfd.LinkOrder where
+
+import Foreign.Marshal
+import Foreign.Ptr
+import Foreign.Storable
+
+import {-# SOURCE #-} Bindings.Bfd.Section
+
+#include
+#include
+
+
+type LinkOrder = Ptr LinkOrder'
+
+data LinkOrder' = Section Section
+
+instance Storable LinkOrder' where
+ sizeOf _ = (#size struct bfd_link_order)
+ alignment = sizeOf
+ pokeByteOff buf off val
+ | off == (#offset struct bfd_link_order, u.indirect.section) =
+ (#poke struct bfd_link_order, u.indirect.section) buf $ unLinkOrder'Section val
+ | otherwise = error "LinkOrder.pokeByteOff otherwise"
+
+unLinkOrder'Section
+ :: LinkOrder'
+ -> Section
+unLinkOrder'Section (Section s) = s
+
+
+mk
+ :: Section
+ -> IO LinkOrder
+mk sect =
+ do
+ p <- malloc :: IO LinkOrder
+ setSection p sect
+ return p
+
+
+setSection
+ :: LinkOrder
+ -> Section
+ -> IO ()
+setSection lo sect = pokeByteOff lo (#offset struct bfd_link_order, u.indirect.section) $ Section sect
diff --git a/src/Bindings/Bfd/Misc.hs b/src/Bindings/Bfd/Misc.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Misc.hs
@@ -0,0 +1,58 @@
+-- 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 .
+
+module Bindings.Bfd.Misc where
+
+import Data.Bits
+
+import Foreign.C
+import Foreign.Ptr
+
+
+type Bool' = CUInt
+
+type Vma = Int
+type Vma' = CULong
+
+type Size = Int
+type Size' = CULong
+
+type File = Ptr File'
+data File' = File'
+
+type FilePtr = Int
+type FilePtr' = CULong
+
+
+alignToPower
+ :: Vma
+ -> Int
+ -> Vma
+alignToPower vma power = (vma + mask) .&. (complement $ mask)
+ where
+ mask = shiftL 1 power - 1
+
+
+foreign import ccall unsafe "stdio.h fdopen" c_fdopen
+ :: CInt
+ -> CString
+ -> IO File
+
+foreign import ccall unsafe "stdio.h fflush" c_fflush
+ :: File
+ -> IO CInt
+
diff --git a/src/Bindings/Bfd/Relocation.hs-boot b/src/Bindings/Bfd/Relocation.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Relocation.hs-boot
@@ -0,0 +1,21 @@
+-- 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 .
+
+module Bindings.Bfd.Relocation where
+
+
+data Relocation
diff --git a/src/Bindings/Bfd/Relocation.hsc b/src/Bindings/Bfd/Relocation.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Relocation.hsc
@@ -0,0 +1,50 @@
+-- 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 .
+
+module Bindings.Bfd.Relocation where
+
+import Foreign.Ptr
+import Foreign.Storable
+
+import Bindings.Bfd.Symbol
+
+#include
+
+
+data Relocation = Relocation {
+ ptrSymbol :: Ptr Symbol
+ , address :: Int
+ , addend :: Int
+-- , howto :: ?
+ }
+ deriving Show
+
+instance Storable Relocation where
+ sizeOf _ = #size arelent
+ alignment = sizeOf
+ peek buf =
+ do
+ psym <- (#peek arelent, sym_ptr_ptr) buf
+ addr <- (#peek arelent, address ) buf
+ adde <- (#peek arelent, addend ) buf
+ return $ Relocation psym addr adde
+
+getSymbol
+ :: Relocation
+ -> IO Symbol
+getSymbol (Relocation ps _ _) = peek ps
+
diff --git a/src/Bindings/Bfd/Section.hs-boot b/src/Bindings/Bfd/Section.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Section.hs-boot
@@ -0,0 +1,55 @@
+-- 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 .
+
+module Bindings.Bfd.Section where
+
+import Foreign.Ptr
+import Foreign.Storable
+
+import Bindings.Bfd.Misc
+
+type SectionName = String
+type Section = Ptr Section'
+
+data Section'
+
+instance Storable Section'
+
+mk
+ :: SectionName
+ -> Int
+ -> IO Section
+
+getName
+ :: Section
+ -> IO SectionName
+
+getOutputSection
+ :: Section
+ -> IO Section
+
+getVma
+ :: Section
+ -> IO Vma
+
+isUndefined
+ :: Section
+ -> Bool
+
+isAbsolute
+ :: Section
+ -> Bool
diff --git a/src/Bindings/Bfd/Section.hsc b/src/Bindings/Bfd/Section.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Section.hsc
@@ -0,0 +1,478 @@
+-- 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 .
+
+module Bindings.Bfd.Section (
+ -- * Types
+ Section
+ , Section'
+ , SectionName
+ -- * Functions
+ -- ** Creating
+ , Bindings.Bfd.Section.mk
+ -- ** Reading\/Writing
+ , getAlignment
+ , setAlignment
+ , Bindings.Bfd.Section.getContents
+ , Bindings.Bfd.Section.getFlags
+ , getLimit
+ , getLma
+ , Bindings.Bfd.Section.getName
+ , Bindings.Bfd.Section.setName
+ , getNext
+ , getRawsize
+ , Bindings.Bfd.Section.getOutputSection
+ , setOutputSection
+ , getRelocatedContents
+ , getRelocations
+ , Bindings.Bfd.Section.getSize
+ , Bindings.Bfd.Section.getSymbol
+ , getVma
+ , setVma
+ -- ** Testing
+ , isAbsolute
+ , isCommon
+ , isExterns
+ , isUndefined
+) where
+
+import Data.Bits
+
+import Foreign.C
+import Foreign.Marshal
+import Foreign.Ptr
+import Foreign.Storable
+
+import {-# SOURCE #-} Bindings.Bfd
+import Bindings.Bfd.LinkInfo as LinkInfo
+import Bindings.Bfd.LinkOrder as LinkOrder
+import Bindings.Bfd.Misc
+import Bindings.Bfd.Relocation
+import Bindings.Bfd.Section.Flags
+import Bindings.Bfd.Symbol
+import Bindings.Bfd.SymbolTable
+
+#include
+
+
+type SectionName = String
+
+type Contents = String
+type Contents' = Ptr CChar
+
+type Section = Ptr Section'
+
+data Section' = Name SectionName
+ | Next Section
+ | Flags Int
+ | Vma Vma
+ | Lma Vma
+ | Size Size
+ | Rawsize Int
+ | OutputSection Section
+ | AlignmentPower Int
+ | Symbol Symbol
+ deriving (Show)
+
+instance Storable Section' where
+ sizeOf _ = #size struct bfd_section
+ alignment = sizeOf
+ peekByteOff buf off
+ | off == (#offset struct bfd_section, name) =
+ do
+ name <- (#peek struct bfd_section, name) buf
+ name' <- peekCString name
+ return $ Bindings.Bfd.Section.Name name'
+ | off == (#offset struct bfd_section, next) =
+ do
+ next <- (#peek struct bfd_section, next) buf
+ return $ Next next
+ | off == (#offset struct bfd_section, flags) =
+ do
+ flags <- (#peek struct bfd_section, flags) buf :: IO CUInt
+ return $ Bindings.Bfd.Section.Flags $ fromIntegral flags
+ | off == (#offset struct bfd_section, vma) =
+ do
+ vma <- (#peek struct bfd_section, vma) buf :: IO Vma'
+ return $ Vma $ fromIntegral vma
+ | off == (#offset struct bfd_section, lma) =
+ do
+ lma <- (#peek struct bfd_section, lma) buf :: IO Vma'
+ return $ Lma $ fromIntegral lma
+ | off == (#offset struct bfd_section, size) =
+ do
+ size <- (#peek struct bfd_section, size) buf :: IO Size'
+ return $ Size $ fromIntegral size
+ | off == (#offset struct bfd_section, rawsize) =
+ do
+ rawsize <- (#peek struct bfd_section, rawsize) buf :: IO Size'
+ return $ Rawsize $ fromIntegral rawsize
+ | off == (#offset struct bfd_section, alignment_power) =
+ do
+ ap <- (#peek struct bfd_section, alignment_power) buf
+ return $ AlignmentPower ap
+ | off == (#offset struct bfd_section, symbol) =
+ do
+ sym <- (#peek struct bfd_section, symbol) buf
+ return $ Bindings.Bfd.Section.Symbol sym
+ | otherwise = error $ "internal error: Bfd.Section'.peekByteOff " ++ show off
+ pokeByteOff buf off val
+ | off == (#offset struct bfd_section, name) =
+ do
+ cs <- newCString $ unSection'Name val
+ (#poke struct bfd_section, name) buf cs
+ | off == (#offset struct bfd_section, vma) =
+ (#poke struct bfd_section, vma) buf (unSection'Vma val)
+ | off == (#offset struct bfd_section, alignment_power) =
+ (#poke struct bfd_section, alignment_power) buf (unSection'AlignmentPower val)
+ | off == (#offset struct bfd_section, output_section) =
+ (#poke struct bfd_section, output_section) buf (unSection'OutputSection val)
+ | otherwise = error $ "internal error: Bfd.Section'.peekByteOff " ++ show off
+
+
+mk
+ :: SectionName
+ -> Int
+ -> IO Section
+mk name align =
+ do
+ sect <- malloc :: IO Section
+ Bindings.Bfd.Section.setName sect name
+ setAlignment sect align
+ setVma sect 0
+ return sect
+
+
+getAlignment
+ :: Section
+ -> IO Int
+getAlignment sect =
+ do
+ ap <- peekByteOff sect (#offset struct bfd_section, alignment_power)
+ return $ unSection'AlignmentPower ap
+
+setAlignment
+ :: Section
+ -> Int
+ -> IO ()
+setAlignment sect align = pokeByteOff sect (#offset struct bfd_section, alignment_power) (AlignmentPower align)
+
+getContents
+ :: Section
+ -> Bfd
+ -> FilePtr
+ -> Size
+ -> IO Contents
+getContents sect bfd offset count = allocaArray count f
+ where
+ f ptr =
+ do
+ let
+ offset' = fromIntegral offset
+ count' = fromIntegral count
+ _ <- c_bfd_get_section_contents bfd sect ptr offset' count' -- FIXME: if not ok, throw exception
+ peekCAStringLen (ptr, count)
+
+getFlags
+ :: Section
+ -> IO [Flags]
+getFlags sect =
+ do
+ flags <- peekByteOff sect (#offset struct bfd_section, flags)
+ let
+ flags' = filter f $ enumFrom Alloc
+ where
+ f e = unSection'Flags flags .&. (bit $ fromEnum e) /= 0
+ return flags'
+
+getLimit
+ :: Section
+ -> Bfd
+ -> IO Int
+getLimit sect bfd =
+ do
+ rs <- getRawsize sect
+ case rs == 0 of
+ True ->
+ do
+ sz <- Bindings.Bfd.Section.getSize sect
+ opb <- getOctetsPerByte bfd
+ return $ sz `quot` opb
+ False -> return rs
+
+getLma
+ :: Section
+ -> IO Vma
+getLma sect =
+ do
+ lma <- peekByteOff sect (#offset struct bfd_section, lma)
+ return $ unSection'Lma lma
+
+getName
+ :: Section
+ -> IO SectionName
+getName sect =
+ do
+ n <- peekByteOff sect (#offset struct bfd_section, name)
+ return $ unSection'Name n
+
+setName
+ :: Section
+ -> SectionName
+ -> IO ()
+setName sect name = pokeByteOff sect (#offset struct bfd_section, name) (Bindings.Bfd.Section.Name name)
+
+getNext
+ :: Section
+ -> IO Section
+getNext sect =
+ do
+ s <- peekByteOff sect (#offset struct bfd_section, next)
+ return $ unSection'Next s
+
+getRawsize
+ :: Section
+ -> IO Size
+getRawsize sect =
+ do
+ rs <- peekByteOff sect (#offset struct bfd_section, rawsize)
+ return $ unSection'Rawsize rs
+
+getOutputSection
+ :: Section
+ -> IO Section
+getOutputSection sect =
+ do
+ os <- peekByteOff sect (#offset struct bfd_section, output_section)
+ return $ unSection'OutputSection os
+
+setOutputSection
+ :: Section
+ -> Section
+ -> IO ()
+setOutputSection sect1 sect2 = pokeByteOff sect1 (#offset struct bfd_section, output_section) (OutputSection sect2)
+
+getRelocations
+ :: Section
+ -> Bfd
+ -> SymbolTable
+ -> IO [Relocation]
+getRelocations sect bfd st =
+ do
+ bound <- c_bfd_get_reloc_upper_bound bfd sect
+ let
+ ptrs = fromIntegral bound `quot` (#const sizeof(arelent *))
+
+ ppr <- mallocArray ptrs
+ count <- c_bfd_canonicalize_reloc bfd sect ppr $ tablePtr st
+ prs <- peekArray (fromIntegral count) ppr
+ mapM peek prs
+
+getRelocatedContents
+ :: Section
+ -> Bfd
+ -> SymbolTable
+ -> IO Contents
+getRelocatedContents sect bfd syms =
+ do
+ count <- Bindings.Bfd.Section.getSize sect
+ allocaArray count (f count)
+ where
+ f count ptr =
+ do
+ let
+ li = nullPtr
+ isR = fromBool False
+ lo <- LinkOrder.mk sect
+ setOutputSection sect sect
+ buf <- c_bfd_get_relocated_section_contents bfd li lo ptr isR $ tablePtr syms
+ case buf == nullPtr of
+ True -> error "bfd_get_relocated_section_contents failed"
+ False -> peekCAStringLen (buf, count)
+
+getSize
+ :: Section
+ -> IO Size
+getSize sect =
+ do
+ s <- peekByteOff sect (#offset struct bfd_section, size)
+ return $ unSection'Size s
+
+getSymbol
+ :: Section
+ -> IO Symbol
+getSymbol sect =
+ do
+ sym <- peekByteOff sect (#offset struct bfd_section, symbol)
+ return $ unSection'Symbol sym
+
+getVma
+ :: Section
+ -> IO Vma
+getVma sect =
+ do
+ s <- peekByteOff sect (#offset struct bfd_section, vma)
+ return $ unSection'Vma s
+
+setVma
+ :: Section
+ -> Vma
+ -> IO ()
+setVma sect vma = pokeByteOff sect (#offset struct bfd_section, vma) (Vma vma)
+
+
+isAbsolute
+ :: Section
+ -> Bool
+isAbsolute sect = sect == c_bfd_abs_section
+
+isCommon
+ :: Section
+ -> IO Bool
+isCommon sect =
+ do
+ flags <- Bindings.Bfd.Section.getFlags sect
+ return $ IsCommon `elem` flags
+
+isExterns
+ :: Section
+ -> IO Bool
+isExterns sect =
+ do
+ n <- Bindings.Bfd.Section.getName sect
+ return $ n == "externs"
+
+isUndefined
+ :: Section
+ -> Bool
+isUndefined sect = sect == c_bfd_und_section
+
+-- Given a section
+
+createSection
+ :: Section
+ -> Vma
+ -> IO (Vma, (Section, Vma))
+createSection sect vma =
+ do
+ origVma <- getVma sect
+ size <- Bindings.Bfd.Section.getSize sect
+ case origVma of
+ 0 ->
+ do
+ align <- getAlignment sect
+ let
+ vma' = alignToPower vma align
+ setVma sect vma'
+ return (vma' + size, (sect, vma'))
+ _ -> return (origVma + size, (sect, origVma))
+
+
+unSection'Name
+ :: Section'
+ -> SectionName
+unSection'Name (Bindings.Bfd.Section.Name n) = n
+unSection'Name x = error $ "internal error: unSection'Name " ++ show x
+
+unSection'Next
+ :: Section'
+ -> Section
+unSection'Next (Next n) = n
+unSection'Next x = error $ "internal error: unSection'Next " ++ show x
+
+unSection'Flags
+ :: Section'
+ -> Int
+unSection'Flags (Bindings.Bfd.Section.Flags f) = f
+unSection'Flags x = error $ "internal error: unSection'Flags " ++ show x
+
+unSection'Vma
+ :: Section'
+ -> Vma
+unSection'Vma (Vma v) = v
+unSection'Vma x = error $ "internal error: unSection'Vma " ++ show x
+
+unSection'Lma
+ :: Section'
+ -> Vma
+unSection'Lma (Lma l) = l
+unSection'Lma _ = error "unSection'Lma"
+
+unSection'Size
+ :: Section'
+ -> Size
+unSection'Size (Size s) = s
+unSection'Size x = error $ "internal error: unSection'Size " ++ show x
+
+unSection'Rawsize
+ :: Section'
+ -> Size
+unSection'Rawsize (Rawsize rs) = rs
+unSection'Rawsize _ = error "unSection'Rawsize"
+
+unSection'OutputSection
+ :: Section'
+ -> Section
+unSection'OutputSection (OutputSection s) = s
+unSection'OutputSection x = error $ "internal error: unSection'OutputSection " ++ show x
+
+unSection'AlignmentPower
+ :: Section'
+ -> Int
+unSection'AlignmentPower (AlignmentPower ap) = ap
+unSection'AlignmentPower x = error $ "internal error: unSection'AlignmentPower " ++ show x
+
+unSection'Symbol
+ :: Section'
+ -> Symbol
+unSection'Symbol (Bindings.Bfd.Section.Symbol s) = s
+unSection'Symbol x = error $ "internal error: unSection'Symbol " ++ show x
+
+
+foreign import ccall unsafe "bfd.h bfd_get_section_contents" c_bfd_get_section_contents
+ :: Bfd
+ -> Section
+ -> Contents'
+ -> FilePtr'
+ -> Size'
+ -> IO Bool
+
+foreign import ccall unsafe "bfd.h bfd_get_reloc_upper_bound" c_bfd_get_reloc_upper_bound
+ :: Bfd
+ -> Section
+ -> IO CLong
+
+foreign import ccall unsafe "bfd.h bfd_canonicalize_reloc" c_bfd_canonicalize_reloc
+ :: Bfd
+ -> Section
+ -> Ptr (Ptr Relocation)
+ -> Ptr Symbol
+ -> IO CLong
+
+foreign import ccall unsafe "bfd.h bfd_get_relocated_section_contents" c_bfd_get_relocated_section_contents
+ :: Bfd
+ -> LinkInfo
+ -> LinkOrder
+ -> Contents'
+ -> Bool'
+ -> Ptr Symbol
+ -> IO Contents'
+
+foreign import ccall unsafe "bfd.h &bfd_und_section" c_bfd_und_section
+ :: Section
+
+foreign import ccall unsafe "bfd.h &bfd_abs_section" c_bfd_abs_section
+ :: Section
diff --git a/src/Bindings/Bfd/Section/Flags.hs b/src/Bindings/Bfd/Section/Flags.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Section/Flags.hs
@@ -0,0 +1,58 @@
+-- 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 .
+
+module Bindings.Bfd.Section.Flags (
+ -- * Types
+ Flags(..)
+) where
+
+
+data Flags = NoFlags
+ | Alloc
+ | Load
+ | Reloc
+ | Readonly
+ | Code
+ | Data
+ | Rom
+ | Constructor
+ | HasContents
+ | NeverLoad
+ | ThreadLocal
+ | HasGotRef
+ | IsCommon
+ | Debugging
+ | InMemory
+ | Exclude
+ | SortEntries
+ | LinkOnce
+ | LinkDuplicates
+ | LinkDuplicatesDiscard
+ | LinkDuplicatesOneOnly
+ | LinkDuplicatesSameSize
+ | LinkerCreated
+ | Keep
+ | SmallData
+ | Merge
+ | Strings
+ | Group
+ | CoffSharedLibrary
+ | CoffShared
+ | Tic54xBlock
+ | Tic54xClink
+ deriving (Enum, Eq, Show)
+
diff --git a/src/Bindings/Bfd/Symbol.hs-boot b/src/Bindings/Bfd/Symbol.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Symbol.hs-boot
@@ -0,0 +1,28 @@
+-- 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 .
+
+module Bindings.Bfd.Symbol where
+
+import Foreign.Storable
+import Foreign.Ptr
+
+
+type Symbol = Ptr Symbol'
+
+data Symbol'
+
+instance Storable Symbol'
diff --git a/src/Bindings/Bfd/Symbol.hsc b/src/Bindings/Bfd/Symbol.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Symbol.hsc
@@ -0,0 +1,276 @@
+-- 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 .
+
+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
+
+
+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
+
diff --git a/src/Bindings/Bfd/Symbol/Flags.hs b/src/Bindings/Bfd/Symbol/Flags.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Symbol/Flags.hs
@@ -0,0 +1,49 @@
+-- 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 .
+
+module Bindings.Bfd.Symbol.Flags (
+ -- * Types
+ Flags(..)
+) where
+
+
+data Flags = NoFlags
+ | Local
+ | Global
+ | Debugging
+ | Function
+ | Undefined
+ | Keep
+ | KeepG
+ | Weak
+ | SectionSym
+ | OldCommon
+ | NotAtEnd
+ | Constructor
+ | Warning
+ | Indirect
+ | File
+ | Dynamic
+ | Object
+ | DebuggingReloc
+ | ThreadLocal
+ | Relc
+ | Srelc
+ | Synthetic
+ | GnuIndirectFunction
+ deriving (Enum, Eq, Show)
+
diff --git a/src/Bindings/Bfd/SymbolTable.hs b/src/Bindings/Bfd/SymbolTable.hs
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/SymbolTable.hs
@@ -0,0 +1,124 @@
+-- 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 .
+
+module Bindings.Bfd.SymbolTable where
+
+import Control.Monad
+
+import Data.Char
+import Data.List
+import qualified Data.Map as Map
+
+import Foreign.Marshal
+import Foreign.Ptr
+
+import Bindings.Bfd.Misc
+import {-# SOURCE #-} Bindings.Bfd.Section as Section
+import Bindings.Bfd.Symbol as Symbol
+
+
+data SymbolTable = SymbolTable {
+ tablePtr :: Ptr Symbol
+ , tableSize :: Int
+ }
+ deriving Show
+
+
+mk
+ :: Ptr Symbol
+ -> Int
+ -> SymbolTable
+mk = SymbolTable
+
+toList
+ :: SymbolTable
+ -> IO [Symbol]
+toList st = peekArray (tableSize st) (tablePtr st)
+
+uniqifyNames
+ :: SymbolTable
+ -> IO SymbolTable
+uniqifyNames symt =
+ do
+ x1 <- toList symt
+ x2 <- mapM (\s -> Symbol.getName s) x1
+ let
+ x3 = zip (x2 \\ nub x2) ([0..] :: [Int])
+ x4 = zip x2 ([0..] :: [Int])
+ x5 = sort $ intersectBy (\(a,_) (b,_) -> a == b) x4 x3
+ x6 = snd $ foldl f (("aa", ""),[]) x5
+ where
+ f ((post@(ch1:ch0:[]), match), xs) xi
+ | match == fst xi = ((post', match ), (fst xi ++ "_" ++ post, snd xi) : xs)
+ | otherwise = (("ab" , fst xi), (fst xi ++ "_aa" , snd xi) : xs)
+ where
+ post' =
+ case ch0 == 'z' of
+ True -> (chr $ ord ch1 + 1) : ['a' ]
+ False -> ch1 : [chr $ ord ch0 + 1]
+ f _ _ = error "f in uniqifyNames"
+ mapM_ (\(name,ix) -> setName (x1 !! ix) name) x6
+ return symt
+
+resolveExterns
+ :: SymbolTable
+ -> [(Section, Vma)]
+ -> IO SymbolTable
+resolveExterns symt sectList =
+ do
+ syms <- toList symt
+ undefs <- filterM getUndefs syms
+ let
+ (extSect, extVma) = last sectList
+ foldM_ pointToExtern (extSect, extVma) undefs
+ map' <- sectMap
+ mapM_ (sectSymValue map') syms
+ return symt
+ where
+ sectSymValue map0 sym =
+ do
+ sect <- getSection sym
+ case isAbsolute sect of
+ True -> return () -- absolute symbols are already absolute
+ False ->
+ do
+ name <- Section.getName sect
+ value <- getValue sym
+ let
+ t =
+ case Map.lookup name map0 of
+ Just v -> v
+ Nothing -> error $ "lookup on sect: " ++ show name ++ " " ++ show value ++ "\n" ++ show map0
+ setValue sym $ value + t
+ pointToExtern (es,ev) sym =
+ do
+ setValue sym ev
+ setSection sym es
+ return (es, ev + externSpacing)
+ getUndefs sym =
+ do
+ sect <- getSection sym
+ return $ isUndefined sect
+ sectMap =
+ do
+ sectList' <- mapM (\(s,v) -> Section.getName s >>= \n -> return (n,v)) sectList
+ return $ Map.fromList sectList'
+
+externSpacing
+ :: Int
+externSpacing = 8
+
diff --git a/src/Bindings/Bfd/SymbolTable.hs-boot b/src/Bindings/Bfd/SymbolTable.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/SymbolTable.hs-boot
@@ -0,0 +1,33 @@
+-- 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 .
+
+module Bindings.Bfd.SymbolTable where
+
+import Foreign.Ptr
+
+import {-# SOURCE #-} Bindings.Bfd.Symbol
+
+
+data SymbolTable
+
+tableSize
+ :: SymbolTable
+ -> Int
+
+tablePtr
+ :: SymbolTable
+ -> Ptr Symbol
diff --git a/src/Bindings/Bfd/Target.hs-boot b/src/Bindings/Bfd/Target.hs-boot
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Target.hs-boot
@@ -0,0 +1,30 @@
+-- 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 .
+
+module Bindings.Bfd.Target where
+
+import Foreign.Ptr
+import Foreign.Storable
+
+
+type TargetName = String
+
+type Target = Ptr Target'
+
+data Target'
+
+instance Storable Target'
diff --git a/src/Bindings/Bfd/Target.hsc b/src/Bindings/Bfd/Target.hsc
new file mode 100644
--- /dev/null
+++ b/src/Bindings/Bfd/Target.hsc
@@ -0,0 +1,437 @@
+-- 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 .
+
+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
+
+
+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 ())
diff --git a/src/cbits/disassembler.c b/src/cbits/disassembler.c
new file mode 100644
--- /dev/null
+++ b/src/cbits/disassembler.c
@@ -0,0 +1,48 @@
+/* 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 .
+ */
+
+#include
+#include
+
+#include
+
+#include "disassembler.h"
+
+
+int
+_bfd_disassembler_info_fprintf (void *fp,
+ const char *fmt,
+ ...)
+{
+ va_list ap;
+ int r;
+
+ va_start (ap, fmt);
+ r = vfprintf (fp, fmt, ap);
+ fflush (fp);
+ va_end (ap);
+
+ return r;
+}
+
+void
+_bfd_disassembler_info_print_address (bfd_vma vma,
+ struct disassemble_info *info)
+{
+ (*info->fprintf_func) (info->stream, ">0x%016x", vma);
+}
diff --git a/src/cbits/disassembler.h b/src/cbits/disassembler.h
new file mode 100644
--- /dev/null
+++ b/src/cbits/disassembler.h
@@ -0,0 +1,23 @@
+/* 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 .
+ */
+
+#include
+
+int _bfd_disassembler_info_fprintf (void *, const char *, ...);
+void _bfd_disassembler_info_print_address (bfd_vma, struct disassemble_info *);
+