content: {-|
  Copyright   : Galois Inc, 2016-18
  Maintainer  : jhendrix@galois.com
  
  Operations for creating a view of memory from an elf file.
  -}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PatternGuards #-}
  {-# LANGUAGE PatternSynonyms #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TupleSections #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ViewPatterns #-}
  module Data.Macaw.Memory.ElfLoader
    ( memoryForElf
    , memoryForElf'
    , memoryForElfAllSymbols
    , memoryForElfSections
    , memoryForElfSegments
    , memoryForElfSegments'
    , SectionIndexMap
    , MemLoadWarning(..)
    , RelocationError
    , SectionName
    , resolveElfContents
    , elfAddrWidth
    , adjustedLoadRegionIndex
      -- * Symbols
    , MemSymbol(..)
    , SymbolResolutionError(..)
    , SymbolTable(..)
      -- * Re-exports
    , module Data.Macaw.Memory.LoadCommon
    , module Data.Macaw.Memory
    , module Data.Macaw.Memory.Symbols
    ) where
  
  import           Control.Lens
  import           Control.Monad (when)
  import           Control.Monad.Except (Except, ExceptT, MonadError(..), runExcept, runExceptT)
  import           Control.Monad.State.Strict (State, StateT(..), execStateT, gets, modify, runState)
  import           Data.Bits
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Char8 as BSC
  import           Data.ElfEdit.Prim
    ( ElfWidthConstraints
    , ElfWordType
    , ElfClass(..)
  
    , ElfSectionIndex(..)
    , ElfSectionFlags
    , ElfSegmentFlags
    )
  import qualified Data.ElfEdit.Prim as Elf
  import           Data.Foldable
  import           Data.IntervalMap.Strict (Interval(..), IntervalMap)
  import qualified Data.IntervalMap.Strict as IMap
  import           Data.Map.Strict (Map)
  import qualified Data.Map.Strict as Map
  import           Data.Maybe
  import           Data.Proxy (Proxy(..))
  import           Data.Set (Set)
  import qualified Data.Set as Set
  import qualified Data.Vector as V
  import           Data.Word
  import           GHC.TypeLits (KnownNat, natVal)
  import           Numeric (showHex)
  
  import           Data.Macaw.Memory
  import           Data.Macaw.Memory.LoadCommon
  import qualified Data.Macaw.Memory.Permissions as Perm
  import           Data.Macaw.Memory.Symbols
  
  -- | Return a subrange of a bytestring.
  slice :: Integral w => Elf.FileRange w -> BS.ByteString -> BS.ByteString
  slice (i,c) = BS.take (fromIntegral c) . BS.drop (fromIntegral i)
  
  -- | Return the addr width repr associated with an elf class
  elfAddrWidth :: ElfClass w -> AddrWidthRepr w
  elfAddrWidth ELFCLASS32 = Addr32
  elfAddrWidth ELFCLASS64 = Addr64
  
  ------------------------------------------------------------------------
  -- SectionIndexMap
  
  -- | Maps section indices that are loaded in memory to their associated base
  -- address and section contents.
  --
  -- The base address is expressed in terms of the underlying memory segment.
  type SectionIndexMap w = Map Word16 (MemSegmentOff w)
  
  ------------------------------------------------------------------------
  -- Flag conversion
  
  -- | Create Reopt flags from elf flags.
  flagsForSegmentFlags :: ElfSegmentFlags -> Perm.Flags
  flagsForSegmentFlags f
      =   flagIf Elf.pf_r Perm.read
      .|. flagIf Elf.pf_w Perm.write
      .|. flagIf Elf.pf_x Perm.execute
    where flagIf :: ElfSegmentFlags -> Perm.Flags -> Perm.Flags
          flagIf ef pf | f `Elf.hasPermissions` ef = pf
                       | otherwise = Perm.none
  
  -- | Convert elf section flags to a segment flags.
  flagsForSectionFlags :: forall w
                       .  (Num w, Bits w)
                       => ElfSectionFlags w
                       -> Perm.Flags
  flagsForSectionFlags f =
      Perm.read .|. flagIf Elf.shf_write Perm.write .|. flagIf Elf.shf_execinstr Perm.execute
    where flagIf :: ElfSectionFlags w -> Perm.Flags -> Perm.Flags
          flagIf ef pf = if f `Elf.hasPermissions` ef then pf else Perm.none
  
  ------------------------------------------------------------------------
  -- RelocationError
  
  data RelocationError
     = MissingSymbolTable
       -- ^ The file is missing a symbol table.
     | RelocationZeroSymbol
       -- ^ A relocation refers to the symbol index 0.
     | RelocationBadSymbolIndex !Int
       -- ^ A relocation entry referenced a bad symbol index.
     | RelocationUnsupportedType !String
       -- ^ We do not support this type of relocation.
     | RelocationFileUnsupported
       -- ^ We do not allow relocations to refer to the "file" as in Elf.
     | RelocationInvalidAddend !String !Integer !SymbolIdentifier
       -- ^ The relocation type given does not allow the adddend with the given value.
     | RelocationEvenAddend !String !Integer !BSC.ByteString !Integer
       -- ^ The relocation type must have an even addend.
     | RelocationDynamicError Elf.DynamicError
       -- ^ Parsing the dynamic section failed when resolving a symbol.
  
  instance Show RelocationError where
    show MissingSymbolTable =
      "Relocations cannot be applied due to missing symbol table."
    show RelocationZeroSymbol =
      "A relocation entry referred to invalid 0 symbol index."
    show (RelocationBadSymbolIndex idx) =
      "A relocation entry referred to invalid symbol index " ++ show idx ++ "."
    show (RelocationUnsupportedType tp) =
      "Unsupported relocation type " ++ tp
    show RelocationFileUnsupported =
      "Do not support relocations referring to file entry."
    show (RelocationEvenAddend tp addr sym addend) =
      let tgt = show sym ++ " + " ++ show addend
       in "The " ++ tp ++ " relocation applied to " ++ show addr
          ++ " with target " ++ tgt ++ " must have an even addend."
    show (RelocationInvalidAddend tp v sym) =
      "Do not support addend of " ++ show v ++ " with relocation type " ++ tp ++ " to " ++ show sym ++ "."
    show (RelocationDynamicError e) = show e
  
  ------------------------------------------------------------------------
  -- MemLoader
  
  type SectionName = BS.ByteString
  
  data MemLoadWarning
    = SectionNotAlloc !SectionName
    | MultipleSectionsWithName !SectionName
    | MultipleDynamicSegments
    | OverlappingLoadableSegments
    | UnsupportedSection !SectionName
    | UnknownDefinedSymbolBinding   !SymbolName Elf.ElfSymbolBinding
    | UnknownDefinedSymbolType      !SymbolName Elf.ElfSymbolType
    | UnknownUndefinedSymbolBinding !SymbolName Elf.ElfSymbolBinding
    | UnknownUndefinedSymbolType    !SymbolName Elf.ElfSymbolType
    | ExpectedSectionSymbolNameEmpty !SymbolName
    | ExpectedSectionSymbolLocal
    | InvalidSectionSymbolIndex !Elf.ElfSectionIndex
    | UnsupportedProcessorSpecificSymbolIndex !SymbolName !ElfSectionIndex
  
    | MultipleRelocationTables
      -- ^ Issued if the file contains multiple relocation tables.
    | RelocationParseFailure !String
    | DynamicTagsOutOfRange !Elf.ElfDynamicTag !Elf.ElfDynamicTag !Word64 !Word64
      -- ^ The range referenced by the dynamic tags was  range.
    | DynamicTagPairMismatch !Elf.ElfDynamicTag !Elf.ElfDynamicTag
      -- ^ We expected either both tags or neither.
    | DynamicMultipleTags !Elf.ElfDynamicTag
      -- ^ We expected at most a single value of the given tag, but failed multiple.
    | AndroidRelWithNonzeroAddend
      -- ^ The `DT_ANDROID_REL` section contains Android relocations with non-zero addends.
    | AndroidRelDecodingError !Elf.ElfDynamicTag !Elf.AndroidDecodeError
      -- ^ We could not decode the table identified by the given dynamic tag.
    | MultipleRelocationsAtAddr !Word64
      -- ^ Multiple relocations at the given offset
    | IgnoreRelocation !RelocationError
      -- ^ @IgnoreRelocation err@ warns we ignored a relocation.
    | ShdrPhdrOverlap
      -- ^ A section header overlaps with a program header.
  
  ppSymbol :: SymbolName -> String
  ppSymbol "" = "unnamed symbol"
  ppSymbol nm = "symbol " ++ BSC.unpack nm
  
  instance Show MemLoadWarning where
    show (SectionNotAlloc nm) =
      "Section " ++ BSC.unpack nm ++ " was not marked as allocated."
    show (MultipleSectionsWithName nm) =
      "Found multiple sections named " ++ BSC.unpack nm ++ "; arbitrarily choosing first one encountered."
    show MultipleDynamicSegments =
      "Found multiple dynamic segments; choosing first one."
    show OverlappingLoadableSegments =
      "File segments containing overlapping addresses; skipping relocations."
    show (UnsupportedSection nm) =
      "Do not support section " ++ BSC.unpack nm
    show (UnknownDefinedSymbolBinding nm bnd) =
      "Unsupported binding " ++ show bnd ++ " for defined " ++ ppSymbol nm
      ++ "; Treating as a strong symbol."
    show (UnknownDefinedSymbolType nm tp) =
      "Unsupported type " ++ show tp ++ " for defined " ++ ppSymbol nm
      ++ "; Treating as a strong symbol."
    show (UnknownUndefinedSymbolBinding nm bnd) =
      "Unsupported binding " ++ show bnd ++ " for undefined " ++ ppSymbol nm
      ++ "; Treating as a required symbol."
    show (UnknownUndefinedSymbolType nm tp) =
      "Unsupported type " ++ show tp ++ " for undefined " ++ ppSymbol nm
      ++ "; Treating as a strong symbol."
    show (ExpectedSectionSymbolNameEmpty nm) =
      "Expected section symbol to have empty name instead of " ++ ppSymbol nm ++ "."
    show ExpectedSectionSymbolLocal =
      "Expected section symbol to have local visibility."
    show (InvalidSectionSymbolIndex idx) =
      "Expected section symbol to have a valid index instead of " ++ show idx ++ "."
    show (UnsupportedProcessorSpecificSymbolIndex nm idx) =
      "Could not resolve symbol index " ++ show idx ++ " for symbol " ++ BSC.unpack nm ++ "."
    show MultipleRelocationTables =
      "File contains multiple relocation tables; these are being merged."
    show (RelocationParseFailure msg) =
      "Error parsing relocations: " ++ msg
    show (DynamicTagsOutOfRange offTag szTag off sz) =
      show offTag ++ " and " ++ show szTag ++ " referenced a range [" ++ show (toInteger off)
      ++ " to " ++ show (toInteger off + toInteger sz) ++ "that is outside the file bounds."
    show (DynamicTagPairMismatch foundTag notfoundTag) =
      "Found " ++ show foundTag ++ " but missing " ++ show notfoundTag ++ "."
    show (DynamicMultipleTags tag) =
      "Multiple values assigned to " ++ show tag ++ " in dynamic information."
    show AndroidRelWithNonzeroAddend =
      "The DT_ANDROID_REL region in the dynamic is ignoring relocations with non-zero addends."
    show (AndroidRelDecodingError tag nm) =
      "The " ++ show tag ++ " region generated decoding error: " ++ show nm
    show (MultipleRelocationsAtAddr addr) =
      "Multiple relocations modify " ++ showHex addr "."
    show (IgnoreRelocation err) =
      show err
    show ShdrPhdrOverlap =
      "Found section header that overlaps with program header."
  
  data MemLoaderState w = MLS { _mlsMemory :: !(Memory w)
                              , mlsEndianness :: !Endianness
                                -- ^ Endianness of elf file
                              , _mlsIndexMap :: !(SectionIndexMap w)
                              , mlsWarnings :: ![MemLoadWarning]
                              }
  
  mlsMemory :: Simple Lens (MemLoaderState w) (Memory w)
  mlsMemory = lens _mlsMemory (\s v -> s { _mlsMemory = v })
  
  -- | Map from elf section indices to their offset and section
  mlsIndexMap :: Simple Lens (MemLoaderState w) (SectionIndexMap w)
  mlsIndexMap = lens _mlsIndexMap (\s v -> s { _mlsIndexMap = v })
  
  addWarning :: MemLoadWarning -> MemLoader w ()
  addWarning w = modify $ \s -> s { mlsWarnings = w : mlsWarnings s }
  
  type MemLoader w = StateT (MemLoaderState w) (Except (LoadError w))
  
  -- || Error occured from loading
  data LoadError w
     = LoadInsertError !String !(InsertError w)
       -- ^ Error occurred in inserting a segment into memory.
     | UnsupportedArchitecture !String
       -- ^ Do not support relocations on given architecture.
     | FormatDynamicError !Elf.DynamicError
       -- ^ An error occured in parsing the dynamic segment.
  
  instance MemWidth w => Show (LoadError w) where
    show (LoadInsertError nm (OverlapSegment _ old)) =
      nm ++ " overlaps with memory segment: " ++ show (segmentOffset old)
    show (UnsupportedArchitecture arch) =
      "Dynamic libraries are not supported on " ++ arch ++ "."
    show (FormatDynamicError e) =
      "Elf parsing error: " ++ show e
  
  -- | This contains information needed to resolve elf symbol addresses.
  data SymbolAddrResolver w =
    SymbolAddrResolver { symSecCount :: Word16
                       , symResolver :: Word16 -> ElfWordType w -> Maybe (MemSegmentOff w)
                         -- ^ Given a section index and offset, this returns the memory addr
                         -- or nothing if that cannot be determined.
                       }
  
  mkSymbolAddrResolver :: (MemWidth w, Integral (ElfWordType w))
                       => V.Vector (Elf.Shdr Word32 (Elf.ElfWordType w))
                       -> SectionIndexMap w
                       -> SymbolAddrResolver w
  mkSymbolAddrResolver v m = do
    let resolveFn secIdx val = do
          case Map.lookup secIdx m of
            Just base
              | Just s <- v V.!? fromIntegral secIdx
              , Elf.shdrAddr s <= val && (val - Elf.shdrAddr s) < Elf.shdrSize s
              , off <- toInteger (val - Elf.shdrAddr s) ->
                incSegmentOff base off
            _ -> Nothing
     in SymbolAddrResolver { symSecCount = fromIntegral (V.length v)
                           , symResolver = resolveFn
                           }
  
  runMemLoader :: Endianness
               -> Memory  w
               -> MemLoader w ()
               -> Either String (Memory w, SectionIndexMap w, [MemLoadWarning])
  runMemLoader end mem m =
     let s = MLS { _mlsMemory = mem
                 , _mlsIndexMap = Map.empty
                 , mlsWarnings = []
                 , mlsEndianness = end
                 }
      in case runExcept $ execStateT m s of
           Left e -> Left $ addrWidthClass (memAddrWidth mem) (show e)
           Right mls -> do
             Right (mls^.mlsMemory, mls^.mlsIndexMap, reverse (mlsWarnings mls))
  
  -- | This adds a Macaw mem segment to the memory
  loadMemSegment :: MemWidth w => String -> MemSegment w -> MemLoader w ()
  loadMemSegment nm seg =
    StateT $ \mls ->
      case insertMemSegment seg (mls^.mlsMemory) of
        Left e ->
          throwError $ LoadInsertError nm e
        Right mem' ->
          pure ((), mls & mlsMemory .~ mem')
  
  -- | Maps file offsets to the elf section
  type ElfFileSectionMap v = IntervalMap v Word16
  
  ------------------------------------------------------------------------
  -- SymbolResolver
  
  type SymbolResolver a = ExceptT RelocationError (State [MemLoadWarning]) a
  
  runSymbolResolver :: SymbolResolver a -> MemLoader w (Either RelocationError a)
  runSymbolResolver m = do
    warn <- gets mlsWarnings
    let (er, warn') = runState (runExceptT m) warn
    modify $ \s -> s { mlsWarnings = warn' }
    pure er
  
  symbolWarning :: MemLoadWarning -> SymbolResolver ()
  symbolWarning w = modify $ \l -> w:l
  
  ------------------------------------------------------------------------
  -- SymbolTable
  
  -- | This wraps a callback function that lets users lookup symbol information by index
  -- from the Elf file.
  --
  -- It is implemented using a callback function as the Elf dynamic
  -- section doesn't provide an explicit number of symbol table
  -- elements, and we decided not to depend on meta data such as section
  -- names that could be stripped from executables/shared objects.
  data SymbolTable w
     = NoSymbolTable
     | StaticSymbolTable !(V.Vector (Elf.SymtabEntry BS.ByteString (Elf.ElfWordType w)))
     | DynamicSymbolTable !(Elf.DynamicSection w) !(Elf.VirtAddrMap w) !Elf.VersionDefMap !Elf.VersionReqMap
  
  -- | Take a symbol entry and symbol version and return the identifier.
  resolveSymbolId :: Elf.SymtabEntry BS.ByteString wtp
                  -> SymbolVersion
                  -> SymbolResolver SymbolIdentifier
  resolveSymbolId sym ver = do
    let nm = Elf.steName sym
    let idx = Elf.steIndex sym
    case Elf.steType sym of
      Elf.STT_SECTION
        | idx < Elf.SHN_LOPROC -> do
            when (nm /= "") $
              symbolWarning $ ExpectedSectionSymbolNameEmpty nm
            when (Elf.steBind sym /= Elf.STB_LOCAL) $
              symbolWarning ExpectedSectionSymbolLocal
            pure $ SectionIdentifier (Elf.fromElfSectionIndex idx)
        | otherwise -> do
            symbolWarning $ InvalidSectionSymbolIndex idx
            pure $ SymbolRelocation nm ver
      Elf.STT_FILE -> do
        throwError RelocationFileUnsupported
      _tp -> do
        when (idx >= Elf.SHN_LOPROC && idx `notElem` [Elf.SHN_ABS, Elf.SHN_COMMON]) $ do
          symbolWarning $ UnsupportedProcessorSpecificSymbolIndex nm idx
        pure $ SymbolRelocation nm ver
  
  resolveSymbol :: SymbolTable w
                -> Word32
                -> SymbolResolver
                    ( Elf.SymtabEntry BS.ByteString (Elf.ElfWordType w)
                    , SymbolVersion
                    )
  resolveSymbol NoSymbolTable _symIdx =
    throwError MissingSymbolTable
  resolveSymbol (StaticSymbolTable entries) symIdx = do
    when (symIdx == 0) $
      throwError RelocationZeroSymbol
    case entries V.!? fromIntegral symIdx of
      Nothing ->
        throwError $ RelocationBadSymbolIndex $ fromIntegral symIdx
      Just sym ->
        -- Look for '@' as it is used to separate symbol name from version information
        -- in object files.
        case BSC.findIndex (== '@') (Elf.steName sym) of
          Just i -> do
            let nm = Elf.steName sym
                    -- If "@@" appears in the symbol, this is a default versioned symbol
            let ver | i+1 < BSC.length nm, BSC.index nm (i+1) == '@' =
                        ObjectDefaultSymbol (BSC.drop (i+2) nm)
                    -- Otherwise "@" appears in the symbol, and this is a non-default symbol.
                    | otherwise =
                        ObjectNonDefaultSymbol (BSC.drop (i+1) nm)
            pure (sym { Elf.steName = BSC.take i nm }, ver)
          Nothing -> do
            pure (sym, UnversionedSymbol)
  resolveSymbol (DynamicSymbolTable ds virtMap verDefMap verReqMap) symIdx = do
    when (symIdx == 0) $
      throwError RelocationZeroSymbol
    case Elf.dynSymEntry ds virtMap verDefMap verReqMap symIdx of
      Left e -> throwError (RelocationDynamicError e)
      Right (sym, mverId) -> do
        let ver = case mverId of
                    Elf.VersionLocal -> UnversionedSymbol
                    Elf.VersionGlobal -> UnversionedSymbol
                    Elf.VersionSpecific elfVer -> VersionedSymbol (Elf.verFile elfVer) (Elf.verName elfVer)
        pure (sym, ver)
  
  ------------------------------------------------------------------------
  -- Relocations
  
  data RelFlag = IsRel | IsRela
    deriving (Eq, Ord, Show)
  
  -- | A function that resolves the architecture-specific relocation-type
  -- into a symbol reference.  The input
  type RelocationResolver tp
    =  Maybe SegmentIndex
       -- ^ Index of segment in which this relocation will be applied if this is
       -- a dynamic relocation, and `Nothing` otherwise.
    -> SymbolTable (Elf.RelocationWidth tp)
    -> Elf.RelEntry tp
       -- ^ Relocation information
    -> MemWord (Elf.RelocationWidth tp)
       -- ^ Addend to add to symbol.
    -> RelFlag
       -- ^ Flag to indicate if this is a rela and rel relocation
       --
       -- Added because some relocations (i.e. PLT ones) will ignore
       -- Rel relocation addends.
    -> SymbolResolver (Relocation (Elf.RelocationWidth tp))
  
  data SomeRelocationResolver w
    = forall tp
    . (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
    => SomeRelocationResolver (RelocationResolver tp)
  
  -- T is 1 if the target symbol S has type STT_FUNC and the symbol addresses a Thumb instruction; it is 0 otherwise.
  
  
  -- | This attempts to resolve an index in the symbol table to the
  -- identifier information needed to resolve its loaded address.
  resolveRelocationSym :: SymbolTable w
                        -- ^ A vector mapping symbol indices to the
                        -- associated symbol information.
                        -> Word32
                        -- ^ Index in the symbol table this refers to.
                        -> SymbolResolver SymbolIdentifier
  resolveRelocationSym symtab symIdx = do
    (symEntry, ver) <- resolveSymbol symtab symIdx
    resolveSymbolId symEntry ver
  
  
  -- | Attempt to resolve an X86_64 specific symbol.
  relaTargetX86_64 :: Maybe SegmentIndex
                   -> SymbolTable 64
                   -- ^ Symbol table to look up symbols in/
                   -> Elf.RelEntry Elf.X86_64_RelocationType
                   -> MemWord 64
                   -- ^ Addend to add to symbol.
                   -> RelFlag
                   -> SymbolResolver (Relocation 64)
  relaTargetX86_64 _ symtab rel addend _isRel =
    case Elf.relType rel of
      Elf.R_X86_64_64 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = addend
                          , relocationIsRel      = False
                          , relocationSize       = 8
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      Elf.R_X86_64_PC32 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = addend
                          , relocationIsRel      = True
                          , relocationSize       = 4
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      -- This is used for constructing relative jumps from a caller to the
      -- PLT stub for the function it is calling.  Such jumps typically modify
      -- a relative call instruction with four bytes for the distance, and so
      -- the distance must be an unsigned 4-byte value.
      Elf.R_X86_64_PLT32 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym    = sym
                          , relocationOffset = addend
                          , relocationIsRel  = True
                          , relocationSize   = 4
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = True
                          }
      -- R_X86_64_GLOB_DAT are used to update GOT entries with their
      -- target address.  They are similar to R_x86_64_64 except appear
      -- inside dynamically linked executables/libraries, and are often
      -- loaded lazily.  We just use the eager AbsoluteRelocation here.
      Elf.R_X86_64_GLOB_DAT -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = addend
                          , relocationIsRel      = False
                          , relocationSize       = 8
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      Elf.R_X86_64_JUMP_SLOT -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym = sym
                          , relocationOffset = addend
                          , relocationIsRel = False
                          , relocationSize  = 8
                          , relocationIsSigned = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot = True
                          }
      Elf.R_X86_64_RELATIVE -> do
        -- This relocation has the value B + A where
        -- - A is the addend for the relocation, and
        -- - B resolves to the difference between the
        --   address at which the segment defining the symbol was
        --   loaded and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        when (Elf.relSym rel /= 0) $ do
          throwError $ RelocationBadSymbolIndex (fromIntegral (Elf.relSym rel))
        pure $ Relocation { relocationSym        = LoadBaseAddr
                          , relocationOffset     = addend - fromIntegral linktimeAddr
                          , relocationIsRel      = False
                          , relocationSize       = 8
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      Elf.R_X86_64_32 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = addend
                          , relocationIsRel      = False
                          , relocationSize       = 4
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      Elf.R_X86_64_32S -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = addend
                          , relocationIsRel      = False
                          , relocationSize       = 4
                          , relocationIsSigned   = True
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      Elf.R_X86_64_COPY -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        when (addend /= 0) $ do
          throwError $ RelocationUnsupportedType (show (Elf.relType rel))
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = 0
                          , relocationIsRel      = False
                          , relocationSize       = 8
                          , relocationIsSigned   = False
                          , relocationEndianness = LittleEndian
                          , relocationJumpSlot   = False
                          }
      -- Jhx Note. These will be needed to support thread local variables.
      --   Elf.R_X86_64_TPOFF32 -> undefined
      --   Elf.R_X86_64_GOTTPOFF -> undefined
  
      tp -> throwError $ RelocationUnsupportedType (show tp)
  
  -- | Generate an absolute 32-bit relocation.
  relocARM32Abs :: Endianness
                -> SymbolTable 32 -- ^ Symbol table
                -> Elf.RelEntry Elf.ARM32_RelocationType -- ^ Relocation entry
                -> MemWord 32
                -> SymbolResolver (Relocation 32)
  relocARM32Abs end symtab rel addend = do
    (symEntry, ver) <- resolveSymbol symtab (Elf.relSym rel)
    sym <- resolveSymbolId symEntry ver
    -- These relocation relocations can apply to code or data, but we
    -- want to ensure relocations do not change the thumb bit
    -- of the symbol.
    when (Elf.steType symEntry == Elf.STT_FUNC && addend `testBit` 0) $ do
      let tp = show (Elf.relType rel)
      let addr = toInteger (Elf.relAddr rel)
      throwError $
        RelocationEvenAddend tp addr (Elf.steName symEntry) (toInteger addend)
    pure $! Relocation { relocationSym        = sym
                       , relocationOffset     = addend
                       , relocationIsRel      = False
                       , relocationSize       = 4
                       , relocationIsSigned   = False
                       , relocationEndianness = end
                       , relocationJumpSlot   = False
                       }
  
  -- | Attempt to resolve an X86_64 specific symbol.
  relaTargetARM32 :: Endianness
                   -- ^ Endianness of relocations
                  -> Maybe SegmentIndex
                  -- ^ Index of segment for dynamic relocations
                  -> SymbolTable 32 -- ^ Symbol table
                  -> Elf.RelEntry Elf.ARM32_RelocationType -- ^ Relocation entry
                  -> MemWord 32
                  -- ^ Addend of symbol
                  -> RelFlag
                  -> SymbolResolver (Relocation 32)
  relaTargetARM32 end msegIndex symtab rel addend relFlag =
    case Elf.relType rel of
      -- A static 32-bit absolute relocation
      Elf.R_ARM_ABS32 -> do
        relocARM32Abs end symtab rel addend
      -- A dynamic 32-bit absolute relocation that typically applies to data.
      Elf.R_ARM_GLOB_DAT -> do
        relocARM32Abs end symtab rel addend
      Elf.R_ARM_RELATIVE -> do
        -- This relocation has the value B(S) + A where
        -- - A is the addend for the relocation, and
        -- - B(S) with S ≠ 0 resolves to the difference between the
        --   address at which the segment defining the symbol S was
        --   loaded and the address at which it was linked.
        --  - B(S) with S = 0 resolves to the difference between the
        --    address at which the segment being relocated was loaded
        --    and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        -- Resolve the symbol using the index in the relocation.
        sym <-
          if Elf.relSym rel == 0 then do
            case msegIndex of
              Nothing -> do
                throwError $ RelocationZeroSymbol
              Just idx ->
                pure $! SegmentBaseAddr idx
          else do
            resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend - fromIntegral linktimeAddr
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_ARM_JUMP_SLOT -> do
        -- This is a PLT relocation
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        -- For rela entries, check that addend is 0
        -- N.B. Rel entries read from the target bits, and these typically point to the
        -- start of the PLT, but are otherwise ignored for relocation purposes.
        when (relFlag == IsRela && addend /= 0) $ do
          throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger addend) sym
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = 0
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = True
                           }
      Elf.R_ARM_COPY -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        when (addend /= 0) $ do
          throwError $ RelocationUnsupportedType (show (Elf.relType rel))
        pure $ Relocation { relocationSym        = sym
                          , relocationOffset     = 0
                          , relocationIsRel      = False
                          , relocationSize       = 4
                          , relocationIsSigned   = False
                          , relocationEndianness = end
                          , relocationJumpSlot   = False
                          }
      tp -> do
        throwError $ RelocationUnsupportedType (show tp)
  
  
  
  -- | Attempt to resolve an X86_64 specific symbol.
  relaTargetARM64 :: Endianness
                     -- ^ Endianness of relocations
                  -> Maybe SegmentIndex
                     -- ^ Index of segment for dynamic relocations
                  -> SymbolTable 64 -- ^ Symbol table
                  -> Elf.RelEntry Elf.AArch64_RelocationType -- ^ Relocaiton entry
                  -> MemWord 64
                     -- ^ Addend of symbol
                  -> RelFlag
                  -> SymbolResolver (Relocation 64)
  relaTargetARM64 end msegIndex symtab rel addend relFlag =
    case Elf.relType rel of
      Elf.R_AARCH64_ABS64 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_AARCH64_GLOB_DAT -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_AARCH64_RELATIVE -> do
        -- This relocation has the value B(S) + A where
        -- - A is the addend for the relocation, and
        -- - B(S) with S ≠ 0 resolves to the difference between the
        --   address at which the segment defining the symbol S was
        --   loaded and the address at which it was linked.
        --  - B(S) with S = 0 resolves to the difference between the
        --    address at which the segment being relocated was loaded
        --    and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        -- Resolve the symbol using the index in the relocation.
        sym <-
          if Elf.relSym rel == 0 then do
            case msegIndex of
              Nothing -> do
                throwError $ RelocationZeroSymbol
              Just idx ->
                pure $! SegmentBaseAddr idx
          else do
            resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend - fromIntegral linktimeAddr
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
  
      Elf.R_AARCH64_JUMP_SLOT -> do
        -- This is a PLT relocation
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        -- For rela entries, check that addend is 0
        -- N.B. Rel entries read from the target bits, and these typically point to the
        -- start of the PLT, but are otherwise ignored for relocation purposes.
        when (relFlag == IsRela && addend /= 0) $ do
          throwError $ RelocationInvalidAddend (show (Elf.relType rel)) (toInteger addend) sym
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = 0
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = True
                           }
      tp -> do
        throwError $ RelocationUnsupportedType (show tp)
  
  -- | Attempt to resolve a PPC32-specific symbol.
  relaTargetPPC32 :: Endianness
                  -- ^ Endianness of relocations
                  -> Maybe SegmentIndex
                  -- ^ Index of segment for dynamic relocations
                  -> SymbolTable 32 -- ^ Symbol table
                  -> Elf.RelEntry Elf.PPC32_RelocationType -- ^ Relocation entry
                  -> MemWord 32
                  -- ^ Addend of symbol
                  -> RelFlag
                  -> SymbolResolver (Relocation 32)
  relaTargetPPC32 end msegIndex symtab rel addend _relFlag =
    case Elf.relType rel of
      Elf.R_PPC_ADDR32 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC_GLOB_DAT -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC_RELATIVE -> do
        -- This relocation has the value B + A where
        -- - A is the addend for the relocation, and
        -- - B resolves to the difference between the
        --   address at which the segment defining the symbol was
        --   loaded and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        -- Resolve the symbol using the index in the relocation.
        sym <-
          if Elf.relSym rel == 0 then do
            case msegIndex of
              Nothing -> do
                throwError $ RelocationZeroSymbol
              Just idx ->
                pure $! SegmentBaseAddr idx
          else do
            resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend - fromIntegral linktimeAddr
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC_JMP_SLOT -> do
        -- This is a PLT relocation
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = True
                           }
      tp ->
        throwError $ RelocationUnsupportedType (show tp)
  
  -- | Attempt to resolve a PPC64-specific symbol.
  relaTargetPPC64 :: Endianness
                  -- ^ Endianness of relocations
                  -> Maybe SegmentIndex
                  -- ^ Index of segment for dynamic relocations
                  -> SymbolTable 64 -- ^ Symbol table
                  -> Elf.RelEntry Elf.PPC64_RelocationType -- ^ Relocation entry
                  -> MemWord 64
                  -- ^ Addend of symbol
                  -> RelFlag
                  -> SymbolResolver (Relocation 64)
  relaTargetPPC64 end msegIndex symtab rel addend _relFlag =
    case Elf.relType rel of
      Elf.R_PPC64_ADDR64 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC64_GLOB_DAT -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC64_RELATIVE -> do
        -- This relocation has the value B + A where
        -- - A is the addend for the relocation, and
        -- - B resolves to the difference between the
        --   address at which the segment defining the symbol was
        --   loaded and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        -- Resolve the symbol using the index in the relocation.
        sym <-
          if Elf.relSym rel == 0 then do
            case msegIndex of
              Nothing -> do
                throwError $ RelocationZeroSymbol
              Just idx ->
                pure $! SegmentBaseAddr idx
          else do
            resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend - fromIntegral linktimeAddr
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_PPC64_JMP_SLOT -> do
        -- This is a PLT relocation
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = True
                           }
      tp ->
        throwError $ RelocationUnsupportedType (show tp)
  
  -- | Attempt to resolve a RISC-V–specific symbol.
  relaTargetRISCV :: forall w
                   . (ElfWidthConstraints w, KnownNat w, MemWidth w)
                  => Endianness
                  -- ^ Endianness of relocations
                  -> Maybe SegmentIndex
                  -- ^ Index of segment for dynamic relocations
                  -> SymbolTable w -- ^ Symbol table
                  -> Elf.RelEntry (Elf.RISCV_RelocationType w) -- ^ Relocation entry
                  -> MemWord w
                  -- ^ Addend of symbol
                  -> RelFlag
                  -> SymbolResolver (Relocation w)
  relaTargetRISCV end msegIndex symtab rel addend _relFlag =
    let wordSize :: Int
        wordSize = fromInteger $ natVal (Proxy @w) `div` 8 in
    case Elf.relType rel of
      Elf.R_RISCV_32 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 4
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_RISCV_64 -> do
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = 8
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_RISCV_RELATIVE -> do
        -- This relocation has the value B + A where
        -- - A is the addend for the relocation, and
        -- - B resolves to the difference between the
        --   address at which the segment defining the symbol was
        --   loaded and the address at which it was linked.
        --
        -- Since the address at which it was linked is a constant, we
        -- create a non-relative address but subtract the link address
        -- from the offset.
  
        -- Get the address at which it was linked so we can subtract from offset.
        let linktimeAddr = Elf.relAddr rel
  
        -- Resolve the symbol using the index in the relocation.
        sym <-
          if Elf.relSym rel == 0 then do
            case msegIndex of
              Nothing -> do
                throwError $ RelocationZeroSymbol
              Just idx ->
                pure $! SegmentBaseAddr idx
          else do
            resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend - fromIntegral linktimeAddr
                           , relocationIsRel      = False
                           , relocationSize       = wordSize
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = False
                           }
      Elf.R_RISCV_JUMP_SLOT -> do
        -- This is a PLT relocation
        sym <- resolveRelocationSym symtab (Elf.relSym rel)
        pure $! Relocation { relocationSym        = sym
                           , relocationOffset     = addend
                           , relocationIsRel      = False
                           , relocationSize       = wordSize
                           , relocationIsSigned   = False
                           , relocationEndianness = end
                           , relocationJumpSlot   = True
                           }
      tp ->
        throwError $ RelocationUnsupportedType (show tp)
  
  toEndianness :: Elf.ElfData -> Endianness
  toEndianness Elf.ELFDATA2LSB = LittleEndian
  toEndianness Elf.ELFDATA2MSB = BigEndian
  
  -- | Creates a relocation map from the contents of a dynamic section.
  getRelocationResolver
    :: forall w
    .  Elf.ElfHeader w
    -> MemLoader w (SomeRelocationResolver w)
  getRelocationResolver hdr =
    case (Elf.headerClass hdr, Elf.headerMachine hdr) of
      (Elf.ELFCLASS64, Elf.EM_X86_64) ->
        pure $ SomeRelocationResolver relaTargetX86_64
      (Elf.ELFCLASS32, Elf.EM_ARM) ->
        pure $ SomeRelocationResolver $ relaTargetARM32 end
      (Elf.ELFCLASS64, Elf.EM_AARCH64) ->
        pure $ SomeRelocationResolver $ relaTargetARM64 end
      (Elf.ELFCLASS32, Elf.EM_PPC) ->
        pure $ SomeRelocationResolver $ relaTargetPPC32 end
      (Elf.ELFCLASS64, Elf.EM_PPC64) ->
        pure $ SomeRelocationResolver $ relaTargetPPC64 end
      (Elf.ELFCLASS32, Elf.EM_RISCV) ->
        pure $ SomeRelocationResolver $ relaTargetRISCV end
      (Elf.ELFCLASS64, Elf.EM_RISCV) ->
        pure $ SomeRelocationResolver $ relaTargetRISCV end
      (_,mach) -> throwError $ UnsupportedArchitecture (show mach)
    where
      end = toEndianness (Elf.headerData hdr)
  
  resolveRela :: ( MemWidth w
                 , Elf.RelocationWidth tp ~ w
                 , Elf.IsRelocationType tp
                 , Integral (Elf.ElfIntType w)
                 )
              => SymbolTable w
              -> RelocationResolver tp
              -> Integer -- ^ Index of relocation
              -> Elf.RelaEntry tp
              -> ResolveFn (MemLoader w) w
  resolveRela symtab resolver _relaIdx rela msegIdx _ = do
    er <- runSymbolResolver $
            resolver msegIdx symtab (Elf.relaToRel rela) (fromIntegral (Elf.relaAddend rela)) IsRela
    case er of
      Left e -> do
        addWarning (IgnoreRelocation e)
        pure Nothing
      Right r ->
        pure $ Just r
  
  resolveRel :: ( MemWidth w
                , Elf.RelocationWidth tp ~ w
                , Elf.IsRelocationType tp
                )
             => Endianness -- ^ Endianness of Elf file
             -> SymbolTable w -- ^ Symbol table
             -> RelocationResolver tp
             -> Integer -- ^ Index of relocation
             -> Elf.RelEntry tp
             -> ResolveFn (MemLoader w) w
  resolveRel end symtab resolver _relIdx rel msegIdx bytes = do
    -- Get the number of bits in the addend
    let bits = Elf.relocTargetBits (Elf.relType rel)
    -- Compute the addended by masking off the low order bits, and
    -- then sign extending them.
    let mask = (1 `shiftL` (bits - 1)) - 1
    let uaddend = bytesToInteger end bytes .&. mask
  
    -- Convert uaddend as signed by looking at most-significant bit.
    let saddend | uaddend `testBit` (bits - 1) =
                    uaddend - (1 `shiftL` bits)
                | otherwise =
                    uaddend
    -- Update the resolver.
    er <- runSymbolResolver $ resolver msegIdx symtab rel (fromInteger saddend) IsRel
    case er of
      Left e -> do
        addWarning (IgnoreRelocation e)
        pure Nothing
      Right r -> do
        pure $ Just r
  
  relocTargetBytes :: (Elf.IsRelocationType tp, MemWidth (Elf.RelocationWidth tp))
                   => tp
                   -> MemWord (Elf.RelocationWidth tp)
  relocTargetBytes tp = fromIntegral $ (Elf.relocTargetBits tp + 7) `shiftR` 3
  
  
  -- | Maps address that relocations apply to to the relocation information.
  type RelocMap w = Map (MemWord w) (RelocEntry (MemLoader w) w)
  
  -- | Add a relocation entry to the map.
  addRelocEntry :: RelocMap w
                -> MemWord w
                -> RelocEntry (MemLoader w) w
                -> MemLoader w (RelocMap w)
  addRelocEntry m addr e =
    case Map.insertLookupWithKey (\_k _new old -> old) addr e m of
      (Nothing, m') -> pure m'
      (Just _, _) -> do
        addWarning $ MultipleRelocationsAtAddr (memWordValue addr)
        pure m
  
  -- | Add a relocation entry to the map.
  addRelaEntry :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
              => SymbolTable w
              -> RelocationResolver tp
              -> (Integer, RelocMap w)
              -> Elf.RelaEntry tp
              -> MemLoader w (Integer, RelocMap w)
  addRelaEntry symtab resolver (idx,m) r = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $ do
      let addr = fromIntegral (Elf.relaAddr r)
          e =  RelocEntry { relocEntrySize = relocTargetBytes (Elf.relaType r)
                          , applyReloc = resolveRela symtab resolver idx r
                          }
      (idx+1,) <$> addRelocEntry m addr e
  
  addRelaEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
                => RelocMap w
                -> SymbolTable w
                -- ^ Map from symbol indices to associated symbol
                -> RelocationResolver tp
                   -- Resolver for relocations
                -> [Elf.RelaEntry tp]
                -- ^ Buffer containing relocation entries in Rel format
                -> MemLoader w (RelocMap w)
  addRelaEntries m symtab resolver entries = do
    snd <$> foldlM (addRelaEntry symtab resolver) (0,m) entries
  
  -- | Add rela relocation entries to map.
  addElfRelaEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
                    => RelocMap w
                    -> Elf.ElfData
                    -- ^ Endianness
                    -> RelocationResolver tp
                    -> SymbolTable w
                    -- ^ Map from symbol indices to associated symbol
                    -> Maybe BS.ByteString
                    -- ^ Buffer containing relocation entries in Rela format
                    -> MemLoader w (RelocMap w)
  addElfRelaEntries m _ _ _ Nothing =
    pure m
  addElfRelaEntries m dta resolver symtab (Just relaBuffer) = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $ do
      case Elf.decodeRelaEntries dta relaBuffer of
        Left msg -> do
          addWarning (RelocationParseFailure msg)
          pure m
        Right entries -> do
          addRelaEntries m symtab resolver entries
  
  -- | Add a relocation entry to the map.
  addRelEntry :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
              => Endianness
              -> SymbolTable w
              -> RelocationResolver tp
              -> (Integer, RelocMap w)
              -> Elf.RelEntry tp
              -> MemLoader w (Integer, RelocMap w)
  addRelEntry end symtab resolver (idx,m) r = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $ do
      let addr = fromIntegral (Elf.relAddr r)
          e =  RelocEntry { relocEntrySize = relocTargetBytes (Elf.relType r)
                          , applyReloc = resolveRel end symtab resolver idx r
                          }
      (idx+1,) <$> addRelocEntry m addr e
  
  addRelEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
                => RelocMap w
                -> Elf.ElfData
                -- ^ Endianness
                -> SymbolTable w
                -- ^ Map from symbol indices to associated symbol
                -> RelocationResolver tp
                   -- Resolver for relocations
                -> [Elf.RelEntry tp]
                -- ^ Buffer containing relocation entries in Rel format
                -> MemLoader w (RelocMap w)
  addRelEntries m dta symtab resolver entries =
    snd <$> foldlM (addRelEntry (toEndianness dta) symtab resolver) (0,m) entries
  
  -- | Add rel relocation entries to map.
  addElfRelEntries :: (Elf.IsRelocationType tp, w ~ Elf.RelocationWidth tp)
                   => RelocMap w
                   -> Elf.ElfData
                   -- ^ Endianness
                   -> RelocationResolver tp
                   -> SymbolTable w
                   -- ^ Map from symbol indices to associated symbol
                   -> Maybe BS.ByteString
                   -- ^ Buffer containing relocation entries in Rel format
                   -> MemLoader w (RelocMap w)
  addElfRelEntries m _ _ _ Nothing =
    pure m
  addElfRelEntries m dta resolver symtab (Just relBuffer) = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $ do
      case Elf.decodeRelEntries dta relBuffer of
        Left msg -> do
          addWarning (RelocationParseFailure msg)
          pure Map.empty
        Right entries -> do
          addRelEntries m dta symtab resolver entries
  
  -- | This checks a computation that returns a dynamic error or succeeds.
  runDynamic :: Either Elf.DynamicError a -> MemLoader w a
  runDynamic (Left e) = throwError (FormatDynamicError e)
  runDynamic (Right r) = pure r
  
  
  -- | Attempt to extract bytestring from region identified by two tags,
  -- and call a continuation if succesful or return a default value if not.
  withDynamicBytes :: Elf.DynamicMap w -- ^ Dynamic map
                   -> Elf.VirtAddrMap w -- ^ Virtual address map for loading files.
                   -> Elf.ElfDynamicTag -- ^ Offset
                   -> Elf.ElfDynamicTag -- ^ Size
                   -> a -- ^ Value to return if loading fails.
                   -> (BS.ByteString -> MemLoader w a)
                   -- ^ Continutation to run with bytes.
                   -> MemLoader w a
  withDynamicBytes dmap virtMap offTag sizeTag failVal cont = do
    case (Map.findWithDefault [] offTag dmap, Map.findWithDefault [] sizeTag dmap) of
      ([off], [sz]) -> do
        w <- uses mlsMemory memAddrWidth
        reprConstraints w $
          case Elf.lookupVirtAddrContents off virtMap of
            Just relocStartBytes
              | toInteger (BS.length relocStartBytes) >= toInteger sz ->
                  cont $ BS.take (fromIntegral sz) relocStartBytes
            _ -> do
              addWarning $ DynamicTagsOutOfRange offTag sizeTag (fromIntegral off) (fromIntegral sz)
              pure failVal
      (_:_:_, _) -> do
        addWarning $ DynamicMultipleTags offTag
        pure failVal
      (_, _:_:_) -> do
        addWarning $ DynamicMultipleTags sizeTag
        pure failVal
      ([_], []) -> do
        addWarning $ DynamicTagPairMismatch offTag sizeTag
        pure failVal
      ([], [_]) -> do
        addWarning $ DynamicTagPairMismatch sizeTag offTag
        pure failVal
      ([], []) ->
        pure failVal
  
  -- | Attempt to extract relocations in Android's compressed format
  -- from a region identified by two tags, and call a continuation if
  -- succesful or return a default value if not.
  withAndroidRelaEntries :: ( w ~ Elf.RelocationWidth tp
                            , Elf.IsRelocationType tp
                            )
                         => Elf.DynamicMap w -- ^ Dynamic map
                         -> Elf.VirtAddrMap w -- ^ Virtual address map for loading files.
                         -> Elf.ElfDynamicTag -- ^ Offset
                         -> Elf.ElfDynamicTag -- ^ Size
                         -> a -- ^ Value to return if loading fails.
                         -> (V.Vector (Elf.RelaEntry tp) -> MemLoader w a)
                         -- ^ Continutation to run with bytes.
                         -> MemLoader w a
  withAndroidRelaEntries dmap virtMap offTag sizeTag failVal cont =
    withDynamicBytes dmap virtMap offTag sizeTag failVal $ \bytes -> do
      w <- uses mlsMemory memAddrWidth
      reprConstraints w $
        case Elf.decodeAndroidRelaEntries bytes of
          Left e -> do
            addWarning $ AndroidRelDecodingError offTag e
            pure failVal
          Right v ->
            cont v
  
  -- | Create a relocation map from the dynamic loader information.
  dynamicRelocationMap :: Elf.ElfHeader w
                       -> V.Vector (Elf.Phdr w)
                       -> BS.ByteString -- ^ Contents of file.
                       -> MemLoader w (Map (MemWord w) (RelocEntry (MemLoader w) w))
  dynamicRelocationMap hdr phdrs contents = do
    let dynPhdrs = V.filter (\p -> Elf.phdrSegmentType p == Elf.PT_DYNAMIC) phdrs
    case toList dynPhdrs of
      [] -> pure $ Map.empty
      dynPhdr:dynRest -> do
        when (not (null dynRest)) $ do
          addWarning MultipleDynamicSegments
        w <- uses mlsMemory memAddrWidth
        reprConstraints w $ do
          -- Build virtual address map so that we can resolve
          -- elf virtual addresses to their program header offset.
          let phdrList = V.toList phdrs
          case Elf.virtAddrMap contents phdrList of
            Nothing -> do
              addWarning OverlappingLoadableSegments
              pure Map.empty
            Just virtMap -> do
              let dynContents = slice (Elf.phdrFileRange dynPhdr) contents
              -- Find the dynamic section from the contents.
              dynSection <- runDynamic $
                Elf.dynamicEntries (Elf.headerData hdr) (Elf.headerClass hdr) dynContents
              let dta = Elf.headerData hdr
              SomeRelocationResolver (resolver :: RelocationResolver tp) <- getRelocationResolver hdr
              verDefMap <- runDynamic $ Elf.dynVersionDefMap dynSection virtMap
              verReqMap <- runDynamic $ Elf.dynVersionReqMap dynSection virtMap
              let symtab = DynamicSymbolTable dynSection virtMap verDefMap verReqMap
              -- Parse relocations
              mRelaBuffer <- runDynamic $ Elf.dynRelaBuffer dynSection virtMap
              let rc0 = if isJust mRelaBuffer then 1 else 0
              relocs0 <- addElfRelaEntries Map.empty dta resolver symtab mRelaBuffer
  
              mRelBuffer  <- runDynamic $ Elf.dynRelBuffer  dynSection virtMap
              let rc1 = if isJust mRelBuffer then 1 else 0
              relocs1 <-addElfRelEntries  relocs0  dta resolver symtab mRelBuffer
  
              let dmap = Elf.dynMap dynSection
              (rc2,relocs2) <- do
                let relocMap = relocs1
                let offTag  = Elf.DT_ANDROID_RELA
                let sizeTag = Elf.DT_ANDROID_RELASZ
                withAndroidRelaEntries dmap virtMap offTag sizeTag (0,relocMap) $ \entryVec -> do
                  let entries = V.toList entryVec
                  relocMap' <- addRelaEntries relocMap symtab resolver entries
                  pure (1, relocMap')
              (rc3,relocs3) <- do
                let relocMap = relocs2
                let offTag  = Elf.DT_ANDROID_REL
                let sizeTag = Elf.DT_ANDROID_RELSZ
                withAndroidRelaEntries dmap virtMap offTag sizeTag (0,relocMap) $ \entryVec -> do
                  when (any (\r -> Elf.relaAddend r /= 0) entryVec) $ do
                    addWarning $ AndroidRelWithNonzeroAddend
                  let entries = V.toList $ Elf.relaToRel <$> entryVec
                  relocMap' <- addRelEntries relocMap dta symtab resolver entries
                  pure (1, relocMap')
              when (rc0 + rc1 + rc2 + rc3 > (1 :: Int)) $ do
                addWarning $ MultipleRelocationTables
  
              case Elf.dynPLTRel dynSection virtMap of
                Left e -> do
                  addWarning $ RelocationParseFailure (show e)
                  pure $! relocs1
                Right Elf.PLTEmpty ->
                  pure $! relocs1
                Right (Elf.PLTRel entries) ->
                  addRelEntries relocs3 dta symtab resolver entries
                Right (Elf.PLTRela entries) ->
                  addRelaEntries relocs3 symtab resolver entries
  
  ------------------------------------------------------------------------
  -- Elf segment loading
  
  reprConstraints :: AddrWidthRepr w
                  -> ((Bits (ElfWordType w)
                      , Bounded  (Elf.ElfIntType w)
                      , Integral (Elf.ElfIntType w)
                      , Bounded  (Elf.ElfWordType w)
                      , Integral (Elf.ElfWordType w)
                      , Show (ElfWordType w)
                      , MemWidth w) => a)
                  -> a
  reprConstraints Addr32 x = x
  reprConstraints Addr64 x = x
  
  -- | Load an elf file into memory.
  insertElfSegment :: RegionIndex
                      -- ^ Region for elf segment
                   -> Integer
                      -- ^ Amount to add to linktime virtual address for this memory.
                   -> ElfFileSectionMap (Elf.FileOffset (ElfWordType w))
                   -> BS.ByteString
                      -- ^ Contents of elf file
                   -> Map (MemWord w) (RelocEntry (MemLoader w) w)
                      -- ^ Relocations to apply when inserting segment.
                   -> Elf.Phdr w
                   -> MemLoader w ()
  insertElfSegment regIdx addrOff shdrMap contents relocMap phdr = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $
     when (Elf.phdrMemSize phdr > 0) $ do
      let segIdx = Elf.phdrSegmentIndex phdr
      seg <- do
        let linkBaseOff = fromIntegral (Elf.phdrSegmentVirtAddr phdr)
        let flags = flagsForSegmentFlags (Elf.phdrSegmentFlags phdr)
        let dta = slice (Elf.phdrFileRange phdr) contents
        let sz = fromIntegral $ Elf.phdrMemSize phdr
        memSegment relocMap regIdx addrOff (Just segIdx) linkBaseOff flags dta sz
      loadMemSegment ("Segment " ++ show segIdx) seg
      let phdrOffset = Elf.phdrFileStart phdr
      let phdrEnd = phdrOffset `Elf.incOffset` Elf.phdrFileSize phdr
      -- Add segment index to address mapping to memory object.
      mlsMemory %= memBindSegmentIndex segIdx seg
      -- Iterative through sections
      let l = IMap.toList $ IMap.intersecting shdrMap (IntervalCO phdrOffset phdrEnd)
      forM_ l $ \(i, elfIdx) -> do
        case i of
          IntervalCO shdr_start _
            | phdrOffset > shdr_start ->
                addWarning ShdrPhdrOverlap
            | otherwise -> do
                let sec_offset = fromIntegral $ shdr_start - phdrOffset
                addr <- case resolveSegmentOff seg sec_offset of
                          Just addr -> pure addr
                          Nothing -> error $ "insertElfSegment: Failed to resolve segment offset at "
                                          ++ show sec_offset
                mlsMemory   %= memBindSectionIndex elfIdx addr
                mlsIndexMap %= Map.insert elfIdx addr
          _ -> error "Unexpected shdr interval"
  
  -- | Load an elf file into memory by parsing segments.
  memoryForElfSegments'
    :: forall w
    .  RegionIndex
    -> Integer
    -> Elf.ElfHeaderInfo w
    -> Either String (Memory w -- Memory
                     , SectionIndexMap w -- Section index map
                     , [MemLoadWarning] -- Warnings from load
                     )
  memoryForElfSegments' regIndex addrOff elf = do
    let hdr = Elf.header elf
    let cl = Elf.headerClass hdr
    let w =  elfAddrWidth cl
    let contents = Elf.headerFileContents elf
    let phdrs = V.generate (fromIntegral (Elf.phdrCount elf)) $ \i ->
                  Elf.phdrByIndex elf (fromIntegral i)
  
    runMemLoader (toEndianness (Elf.headerData hdr)) (emptyMemory w) $ reprConstraints w $ do
        -- Create relocation map
        relocMap <- dynamicRelocationMap hdr phdrs contents
        let intervals :: ElfFileSectionMap (Elf.FileOffset (ElfWordType w))
            intervals = IMap.fromList $
              [ (IntervalCO (Elf.shdrOff shdr) end, idx-1)
              | idx <- [1..Elf.shdrCount elf]
              , let shdr = Elf.shdrByIndex elf (idx-1)
              , let end = Elf.incOffset (Elf.shdrOff shdr) (Elf.shdrFileSize shdr)
              ]
        forM_ phdrs $ \p -> do
          when (Elf.phdrSegmentType p == Elf.PT_LOAD) $ do
            insertElfSegment regIndex addrOff intervals contents relocMap p
  
  -- | Load an elf file into memory by parsing segments.
  memoryForElfSegments
    :: forall w
    .  LoadOptions
    -> Elf.ElfHeaderInfo w
    -> Either String (Memory w -- Memory
                     , SectionIndexMap w -- Section index map
                     , [MemLoadWarning] -- Warnings from load
                     )
  memoryForElfSegments opt elf = do
    let regIndex = adjustedLoadRegionIndex (Elf.headerType (Elf.header elf)) opt
    let addrOff = loadRegionBaseOffset opt
    memoryForElfSegments' regIndex addrOff elf
  
  ------------------------------------------------------------------------
  -- Elf section loading
  
  -- | Contains the name of a section we allocate and whether
  -- relocations are used.
  type AllocatedSectionInfo = (BS.ByteString, Bool)
  
  allocatedNames :: AllocatedSectionInfo -> [BS.ByteString]
  allocatedNames (nm,False) = [nm]
  allocatedNames (nm,True) = [nm, ".rela" <> nm]
  
  allocatedSectionInfo :: [AllocatedSectionInfo]
  allocatedSectionInfo =
    [ (,) ".text"     True
    , (,) ".eh_frame" True
    , (,) ".data"     True
    , (,) ".bss"      False
    , (,) ".rodata"   True
    ]
  
  allowedSectionNames :: Set BS.ByteString
  allowedSectionNames = Set.fromList
    $ concatMap allocatedNames allocatedSectionInfo
    ++ [ ""
       , ".text.hot"
       , ".text.unlikely"
       , ".tbss"
       , ".tdata", ".rela.tdata"
       , ".comment"
       , ".note.GNU-stack"
       , ".shstrtab"
       , ".symtab"
       , ".strtab"
       , ".llvm_addrsig"
       ]
  
  -- | Map from section names to index and section header.
  type ShdrNameMap w =  Map SectionName [(Word16, Elf.Shdr Word32 (ElfWordType w))]
  
  findShdr ::ShdrNameMap w
           -> SectionName
           -> MemLoader w (Maybe (Word16, Elf.Shdr Word32 (ElfWordType w)))
  findShdr shdrMap nm =
    case Map.lookup nm shdrMap of
      Nothing -> pure Nothing
      Just [] -> pure Nothing
      Just (s:rest) -> do
        when (not (null rest)) $ do
          addWarning $ MultipleSectionsWithName nm
        pure (Just s)
  
  shdrData :: Integral w => BS.ByteString -> Elf.Shdr nm w -> BS.ByteString
  shdrData contents shdr = slice (Elf.shdrFileRange shdr) contents
  
  -- | Add a section to the current memory
  insertAllocatedShdr :: Elf.ElfHeader w
                      -> BS.ByteString -- ^ File contents
                      -> SymbolTable w
                      -> ShdrNameMap w
                      -> RegionIndex
                         -- ^ Region for section (should be unique)
                      -> SectionName
                         -- ^ Name of section
                      -> MemLoader w ()
  insertAllocatedShdr hdr contents symtab shdrMap regIdx nm = do
    w <- uses mlsMemory memAddrWidth
    reprConstraints w $ do
     mshdr <- findShdr shdrMap nm
     case mshdr of
      Nothing -> pure ()
      Just (idx, shdr) -> do
        mRelBuffer  <- fmap (fmap (shdrData contents . snd)) $ findShdr shdrMap (".rel" <> nm)
        mRelaBuffer <- fmap (fmap (shdrData contents . snd)) $ findShdr shdrMap (".rela" <> nm)
        -- Build relocation map
        -- Get size of section
        let secSize = Elf.shdrSize shdr
        -- Check if we should load section
        when (not (Elf.shdrFlags shdr `Elf.hasPermissions` Elf.shf_alloc)) $ do
          addWarning $ SectionNotAlloc nm
        when (secSize > 0) $ do
          -- Get base address
          let base = Elf.shdrAddr shdr
          -- Get section flags
          let flags = flagsForSectionFlags (Elf.shdrFlags shdr)
          -- Get bytes in section
          let bytes = shdrData contents shdr
          -- Create memory segment
          SomeRelocationResolver resolver <- getRelocationResolver hdr
          when (isJust mRelBuffer && isJust mRelaBuffer) $ do
            addWarning $ MultipleRelocationTables
          relocMap <- do
            let dta = Elf.headerData hdr
            m1 <- addElfRelaEntries Map.empty dta resolver symtab mRelaBuffer
            addElfRelEntries        m1        dta resolver symtab mRelBuffer
          seg <-
            memSegment relocMap regIdx 0 Nothing (fromIntegral base) flags bytes (fromIntegral secSize)
          -- Load memory segment.
          loadMemSegment ("Section " ++ BSC.unpack nm) seg
          -- Add entry to map elf section index to start in segment.
          addr <- case resolveSegmentOff seg 0 of
                    Just addr -> pure addr
                    Nothing -> error "insertAllocatedShdr: Failed to resolve starting segment offset"
          mlsMemory   %= memBindSectionIndex idx addr
          mlsIndexMap %= Map.insert idx addr
  
  -- | Find and get static symbol table entries from an ELF binary.
  elfStaticSymbolTable :: Integral (ElfWordType w)
                       => Elf.ElfHeaderInfo w
                       -> Maybe (V.Vector (Elf.SymtabEntry BS.ByteString (ElfWordType w)))
  elfStaticSymbolTable elf = do
    case Elf.decodeHeaderSymtabLenient elf of
      Left _ -> Nothing
      Right mbSymtab -> Elf.symtabEntries <$> mbSymtab
  
  -- | Find and get dynamic symbol table entries from an ELF binary.
  elfDynamicSymbolTable :: Integral (ElfWordType w)
                        => Elf.ElfHeaderInfo w
                        -> Maybe (V.Vector (Elf.SymtabEntry BS.ByteString (ElfWordType w)))
  elfDynamicSymbolTable elf = do
    case Elf.decodeHeaderDynsymLenient elf of
      Left _ -> Nothing
      Right mbDynsym -> Elf.symtabEntries <$> mbDynsym
  
  -- | Load allocated Elf sections into memory.
  --
  -- This is only used for object files.
  memoryForElfSections :: forall w
                       .  Elf.ElfHeaderInfo w
                       -> Either String (Memory w, SectionIndexMap w, [MemLoadWarning])
  memoryForElfSections elf = reprConstraints (elfAddrWidth (Elf.headerClass (Elf.header elf))) $ do
    let hdr = Elf.header elf
    let contents = Elf.headerFileContents elf
    let shdrs = Elf.headerShdrs elf
  
    -- Get string table for section header table.
    let (_, shstrtab) = Elf.shstrtabRangeAndData elf
  
    let shdrMap :: ShdrNameMap w
        shdrMap = V.ifoldl' insSec Map.empty shdrs
          where insSec m idx shdr =
                  case Elf.lookupString (Elf.shdrName shdr) shstrtab of
                    Left _ -> m
                    Right nm ->
                      Map.insertWith (\new old -> old ++ new) nm [(fromIntegral idx, shdr)] m
  
    let symtab =
          case elfStaticSymbolTable elf of
            Nothing -> NoSymbolTable
            Just v -> StaticSymbolTable v
    -- Create memory for elf sections
    memoryForElfSections' hdr contents shdrMap symtab
  
  -- | Load allocated Elf sections into memory.
  --
  -- This is only used for object files.  This version uses low-level types
  -- for less complex parsing.
  memoryForElfSections' :: forall w
                        .  Elf.ElfHeader w -- ^ Header for elf
                        -> BS.ByteString
                        -> ShdrNameMap    w -- ^ Map from section names to section headers
                        -> SymbolTable w -- ^ Symbol table for names.
                        -> Either String (Memory w, SectionIndexMap w, [MemLoadWarning])
  memoryForElfSections' hdr contents shdrMap symtab =
    runMemLoader (toEndianness (Elf.headerData hdr)) (emptyMemory (elfAddrWidth (Elf.headerClass hdr))) $ do
      -- Insert sections
      forM_ (zip [1..] allocatedSectionInfo) $ \(idx, (nm,_)) -> do
        insertAllocatedShdr hdr contents symtab shdrMap idx nm
      -- TODO: Figure out what to do about .tdata and .tbss
      -- Check for other section names that we do not support."
      let unsupportedKeys = Map.keysSet shdrMap `Set.difference ` allowedSectionNames
      forM_ unsupportedKeys $ \k -> do
        addWarning $ UnsupportedSection k
  
  ------------------------------------------------------------------------
  -- Index for elf
  
  -- | Return default region index to use when loading.
  adjustedLoadRegionIndex :: Elf.ElfType -> LoadOptions -> RegionIndex
  adjustedLoadRegionIndex tp loadOpts =
    case loadOffset loadOpts of
      Just _ -> 0
      Nothing ->
        case tp of
          Elf.ET_REL -> 1
          -- This is only for non-position independent exectuables.
          Elf.ET_EXEC -> 0
          -- This is for shared libraries or position-independent executablkes.
          Elf.ET_DYN -> 1
          _ -> 0
  
  ------------------------------------------------------------------------
  -- Memory symbol
  
  -- | Type for representing a symbol that has a defined location in
  -- this memory.
  data MemSymbol w = MemSymbol { memSymbolName :: !BS.ByteString
                                 -- ^ Name of symbol
                               , memSymbolStart :: !(MemSegmentOff w)
                                 -- ^ Address that symbol starts up.
                               , memSymbolSize :: !(MemWord w)
                                 -- ^ Size of symbol as defined in table.
                               }
    deriving (Show)
  
  instance Eq (MemSymbol w) where
    x == y = memSymbolStart x == memSymbolStart y
          && memSymbolName  x == memSymbolName  y
          && memSymbolSize  x == memSymbolSize  y
  
  -- Sort by address, size, then name
  instance Ord (MemSymbol w) where
    compare x y
      =  compare (memSymbolStart x) (memSymbolStart y)
      <> compare (memSymbolSize  x) (memSymbolSize  y)
      <> compare (memSymbolName  x) (memSymbolName  y)
  
  ------------------------------------------------------------------------
  -- memoryForElf
  
  elfHeaderConstraints :: Elf.ElfHeaderInfo w
                       ->  ((Bits (ElfWordType w)
                            , Bounded  (Elf.ElfIntType w)
                            , Integral (Elf.ElfIntType w)
                            , Bounded  (Elf.ElfWordType w)
                            , Integral (Elf.ElfWordType w)
                            , Show (ElfWordType w)
                            , MemWidth w) => a)
                       -> a
  elfHeaderConstraints elf = reprConstraints (elfAddrWidth (Elf.headerClass (Elf.header elf)))
  
  {-# DEPRECATED memoryForElf' "Use memoryForElf" #-}
  memoryForElf' :: LoadOptions
                -> Elf.ElfHeaderInfo w
                -> (Elf.SymtabEntry BS.ByteString (ElfWordType w) -> Bool)
                -- ^ Filter on symbol table entries
                -> Either String  ( Memory w
                                  , [MemSymbol w] -- Function symbols
                                  , [MemLoadWarning]
                                  , [SymbolResolutionError]
                                  )
  memoryForElf' opt elf isRelevant = elfHeaderConstraints elf $ do
    let shdrs = Elf.headerShdrs elf
    -- Get the elf memory, section map, warnings based on type.
    (mem, secMap, warnings) <-
      case Elf.headerType (Elf.header elf) of
        -- We load object files by section
        Elf.ET_REL -> do
          when (isJust (loadOffset opt)) $ do
            Left $ "Object file sections have multiple offsets, and do not support loading at address."
          memoryForElfSections elf
        Elf.ET_EXEC ->
          memoryForElfSegments opt elf
        -- Dynamic include dynamic information
        _ ->
          memoryForElfSegments opt elf
    -- Get dynamic symbol table entries
    -- Resolve elf symbol table information
    let (symErrs, funcSymbols) = resolveElfFuncSymbols mem shdrs secMap isRelevant elf
    pure (mem, funcSymbols, warnings, symErrs)
  
  -- | Load allocated Elf sections into memory, using the section table
  -- information map.
  --
  -- Normally, Elf uses segments for loading, but the section
  -- information tends to be more precise.
  --
  -- The return value includes a list of all function symbols (STT_FUNC
  -- Symbol table entry types).
  memoryForElf :: LoadOptions
               -> Elf.ElfHeaderInfo w
               -> Either String ( Memory w
                                , [MemSymbol w] -- Function symbols
                                , [MemLoadWarning]
                                , [SymbolResolutionError]
                                )
  memoryForElf opt elf =
    let isRelevant ste = Elf.steType ste == Elf.STT_FUNC
     in memoryForElf' opt elf isRelevant
  
  -- | Load allocated Elf sections into memory, using the section table
  -- information map.
  --
  -- Normally, Elf uses segments for loading, but the section
  -- information tends to be more precise.
  --
  -- The return value includes a list of *all* symbols, whether they
  -- are functions or not.
  memoryForElfAllSymbols :: LoadOptions
                         -> Elf.ElfHeaderInfo w
                         -> Either String ( Memory w
                                          , [MemSymbol w] -- Function symbols
                                          , [MemLoadWarning]
                                          , [SymbolResolutionError]
                                          )
  memoryForElfAllSymbols opt elf = memoryForElf' opt elf (\_ -> True)
  
  ------------------------------------------------------------------------
  -- Elf symbol utilities
  
  -- | Error when resolving symbols.
  data SymbolResolutionError
     = EmptySymbolName !Int !Elf.ElfSymbolType
       -- ^ Symbol names must be non-empty
     | UndefSymbol !BSC.ByteString
       -- ^ Symbol was in the undefined section.
     | CouldNotResolveAddr !BSC.ByteString
       -- ^ Symbol address could not be resolved.
     | MultipleSymbolTables
       -- ^ The elf file contained multiple symbol tables
  
  instance Show SymbolResolutionError where
    show (EmptySymbolName idx tp ) =
      "Symbol Num " ++ show idx ++ " " ++ show tp ++ " has an empty name."
    show (UndefSymbol nm) = "Symbol " ++ BSC.unpack nm ++ " is in the text section."
    show (CouldNotResolveAddr sym) = "Could not resolve address of " ++ BSC.unpack sym ++ "."
    show MultipleSymbolTables = "Elf contains multiple symbol tables."
  
  
  -- | Map a symbol table entry in .symtab to the associated symbol information.
  --
  -- This drops undefined symbols by returning `Nothing, and returns
  -- either the symbol information or an error message if we cannot
  -- resolve the address.
  resolveElfSymbol :: Integral (ElfWordType w)
                   => Memory w -- ^ Memory object from Elf file.
                   -> SymbolAddrResolver w -- ^ Section index mp from memory
                   -> Int -- ^ Index of symbol
                   -> Elf.SymtabEntry BS.ByteString (ElfWordType w)
                   -> Maybe (Either SymbolResolutionError (MemSymbol w))
  resolveElfSymbol mem resolver idx ste
      -- Check symbol is defined
    | Elf.steIndex ste == Elf.SHN_UNDEF = Nothing
    -- Check symbol name is non-empty
    | Elf.steName ste == "" = Just $ Left $ EmptySymbolName idx (Elf.steType ste)
    -- Lookup absolute symbol
    | Elf.steIndex ste == Elf.SHN_ABS = reprConstraints (memAddrWidth mem) $ do
        let val = Elf.steValue ste
        case resolveAbsoluteAddr mem (fromIntegral val) of
          Just addr -> Just $ Right $
            MemSymbol { memSymbolName = Elf.steName ste
                      , memSymbolStart = addr
                      , memSymbolSize = fromIntegral (Elf.steSize ste)
                      }
          Nothing   -> Just $ Left $ CouldNotResolveAddr (Elf.steName ste)
    -- Lookup symbol stored in specific section
    | secIdx <- Elf.fromElfSectionIndex (Elf.steIndex ste)
    , secIdx < symSecCount resolver
    , Just addr <- symResolver resolver secIdx (Elf.steValue ste) = addrWidthClass (memAddrWidth mem) $
        Just $ Right $ MemSymbol { memSymbolName = Elf.steName ste
                                 , memSymbolStart = addr
                                 , memSymbolSize = fromIntegral (Elf.steSize ste)
                                 }
  
    | otherwise = Just $ Left $ CouldNotResolveAddr (Elf.steName ste)
  
  data ResolvedSymbols w = ResolvedSymbols { resolutionErrors :: ![SymbolResolutionError]
                                           , resolvedSymbols :: !(Set (MemSymbol w))
                                           }
  
  instance Semigroup (ResolvedSymbols w) where
    x <> y = ResolvedSymbols { resolutionErrors = resolutionErrors x <> resolutionErrors y
                             , resolvedSymbols   = resolvedSymbols x <> resolvedSymbols y
                             }
  
  instance Monoid (ResolvedSymbols w) where
    mempty = ResolvedSymbols { resolutionErrors = []
                             , resolvedSymbols = Set.empty
                             }
  
  resolutionError :: SymbolResolutionError -> ResolvedSymbols w
  resolutionError e = mempty { resolutionErrors = [e] }
  
  resolvedSymbol :: MemSymbol w -> ResolvedSymbols w
  resolvedSymbol s = mempty { resolvedSymbols = Set.singleton s }
  
  -- | Construct a resolve symbol entry.
  ofResolvedSymbol :: Maybe (Either SymbolResolutionError (MemSymbol w))
                   -> ResolvedSymbols w
  ofResolvedSymbol Nothing = mempty
  ofResolvedSymbol (Just (Left e)) = resolutionError e
  ofResolvedSymbol (Just (Right s)) = resolvedSymbol s
  
  -- | Resolve symbol table entries defined in this Elf file to
  -- a mem symbol.
  resolveElfFuncSymbols
    :: forall w
    .  (MemWidth w, Integral (ElfWordType w))
    => Memory w
       -- ^ Memory loaded
    -> V.Vector (Elf.Shdr Word32 (Elf.ElfWordType w))
       -- ^ Section headers for symbol table
    -> SectionIndexMap w
       -- ^ Map from s
    -> (Elf.SymtabEntry BS.ByteString (ElfWordType w) -> Bool)
       -- ^ Filter on symbol table entries
    -> Elf.ElfHeaderInfo w
       -- ^ elf header information
    -> ([SymbolResolutionError], [MemSymbol w])
  resolveElfFuncSymbols mem shdrs secMap p elf =
     let resolver = mkSymbolAddrResolver shdrs secMap
  
         staticEntries =
           case elfStaticSymbolTable elf of
             Nothing -> []
             Just v -> V.toList $ V.imap (\i s-> (i, s)) v
  
         dynamicEntries =
           case elfDynamicSymbolTable elf of
             Nothing -> []
             Just v -> V.toList $ V.imap (\i s-> (i, s)) v
  
         allEntries :: [(Int, Elf.SymtabEntry BS.ByteString (ElfWordType w))]
         allEntries = staticEntries ++ dynamicEntries
  
         r :: ResolvedSymbols w
         r = mconcat
           $ fmap (\(idx, s) -> ofResolvedSymbol (resolveElfSymbol mem resolver idx s))
           $ filter (\(_,s) -> p s) allEntries
  
     in (resolutionErrors r, Set.toList (resolvedSymbols r))
  
  ------------------------------------------------------------------------
  -- resolveElfContents
  
  -- | Return the segment offset of the elf file entry point or fail if undefined.
  getElfEntry ::  LoadOptions
              -> Memory w
              -> RegionIndex
              -> Elf.ElfHeader w
              -> ([String], Maybe (MemSegmentOff w))
  getElfEntry loadOpts mem regIdx hdr =  addrWidthClass (memAddrWidth mem) $ do
    Elf.elfClassInstances (Elf.headerClass hdr) $ do
      let adjAddr =
            case loadOffset loadOpts of
              Nothing -> toInteger (Elf.headerEntry hdr)
              Just o -> toInteger o + toInteger (Elf.headerEntry hdr)
      case resolveRegionOff mem regIdx (fromInteger adjAddr) of
        Nothing ->
          ( ["Could not resolve entry point: " ++ showHex (Elf.headerEntry hdr) ""]
          , Nothing
          )
        Just v  -> ([], Just v)
  
  -- | This interprets the Elf file to construct the initial memory,
  -- entry points, and functions symbols.
  --
  -- If it encounters a fatal error it returns the error message in the
  -- left value, and otherwise it returns the interpreted information as
  -- a 4-tuple of: warnings, the initial memory image, possible entry
  -- points (e.g. for an executable or shared library), and function
  -- symbols.
  resolveElfContents :: LoadOptions
                          -- ^ Options for loading contents
                     -> Elf.ElfHeaderInfo w
                     -> Either String
                               ( [String] -- Warnings
                               , Memory w -- Initial memory
                               , Maybe (MemSegmentOff w) -- Entry point(s)
                               , [MemSymbol w] -- Function symbols
                               )
  resolveElfContents loadOpts elf = do
    let hdr = Elf.header elf
    let regIdx = adjustedLoadRegionIndex (Elf.headerType hdr) loadOpts
    (mem, funcSymbols, warnings, symErrs) <- memoryForElf loadOpts elf
    let (entryWarn, mentry)
          | hasEntryPoint (Elf.headerType hdr)
          = getElfEntry loadOpts mem regIdx hdr
          | otherwise
          = ([], Nothing)
    pure (fmap show warnings ++ fmap show symErrs ++ entryWarn, mem, mentry, funcSymbols)
    where
      -- Does an ELF file's type have an entry point?
      hasEntryPoint :: Elf.ElfType -> Bool
      hasEntryPoint Elf.ET_EXEC = True
      hasEntryPoint Elf.ET_DYN = True
      hasEntryPoint _ = False
  