content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  
  module Data.Macaw.BinaryLoader.PPC.ELF
    ( parseTOC
    )
  where
  
  import           Control.Monad ( unless )
  import qualified Control.Monad.Catch as X
  import qualified Data.ByteString.Char8 as C8
  import qualified Data.ElfEdit as E
  import           Data.Foldable (toList)
  import qualified Data.Macaw.BinaryLoader.PPC.TOC as TOC
  import qualified Data.Macaw.Memory as MM
  import qualified Data.Map.Strict as M
  import           Data.Proxy ( Proxy(..) )
  import qualified Data.Serialize.Get as G
  import qualified Data.Word.Indexed as W
  import           GHC.TypeLits ( KnownNat, natVal )
  
  
  -- | Given an ELF file, extract a mapping from function entry points to the
  -- value of the TOC pointer (which is to be stored in r2) for that function.
  --
  -- The generated function is called from 'mkInitialAbsState' to set up the value
  -- of r2 at the entry point to each function, which will allow macaw to discover
  -- the values of loaded function pointers.
  --
  -- In the v1 PowerPC ABI (at least as generated by gcc), the entries are all
  -- stored in the @.opd@ section.  Each entry is three pointers, where the first
  -- entry is the function address and the second is the value of the TOC.  The
  -- third entry is unused in C programs (it is meant for Pascal).
  parseTOC :: forall w m
            . (KnownNat w,
               MM.MemWidth w,
               Integral (E.ElfWordType w),
               X.MonadThrow m)
           => E.ElfHeaderInfo w
           -> m (TOC.TOC w)
  parseTOC e = do
    shdrs <-
      case E.headerNamedShdrs e of
        Left _ -> X.throwM ((TOC.TOCParseError "Failed to parse section names.") :: TOC.TOCException w)
        Right r -> pure (toList r)
    case filter (\s -> E.shdrName s == C8.pack ".opd") shdrs of
      [sec] -> do
        let buffer = E.slice (E.shdrFileRange sec) (E.headerFileContents e)
        case G.runGet (parseFunctionDescriptors @w (fromIntegral ptrSize) (E.shdrAddr sec)) buffer of
          Left msg -> X.throwM ((TOC.TOCParseError msg) :: TOC.TOCException w)
          Right t -> return t
      _ -> X.throwM ((TOC.MissingTOCSection ".opd") :: TOC.TOCException w)
    where
      ptrSize = natVal (Proxy @w)
  
  -- | Parse the @.opd@ section as a Table of Contents (TOC)
  --
  -- We pass in the address of the TOC so that we can map symbol table entry
  -- addresses to actual function addresses (symbol table addresses point to TOC
  -- entries instead of function addresses).
  parseFunctionDescriptors :: (KnownNat w, MM.MemWidth w, Integral (E.ElfWordType w))
                           => Int
                           -> E.ElfWordType w
                           -> G.Get (TOC.TOC w)
  parseFunctionDescriptors ptrSize tocBaseAddr = do
    let recordBytes = (3 * ptrSize) `div` 8
    let recordParser entryAddr =
          case ptrSize of
            32 -> getFunctionDescriptor entryAddr G.getWord32be
            64 -> getFunctionDescriptor entryAddr G.getWord64be
            _ -> error ("Invalid pointer size: " ++ show ptrSize)
    totalBytes <- G.remaining
    unless (totalBytes `mod` recordBytes == 0) $ do
      fail "The .opd section is not divisible by the record size"
    let nRecords = totalBytes `div` recordBytes
    let tocBase = MM.absoluteAddr (fromIntegral tocBaseAddr)
    funcDescs <- mapM recordParser (map (toTOCEntryAddr recordBytes tocBase) [0..(nRecords - 1)])
    let tocPtrMap = M.fromList [ (funcAddr, tocValue) | (_, funcAddr, tocValue) <- funcDescs ]
    let symbolMapping = M.fromList [ (tocEntryAddr, funcAddr) | (tocEntryAddr, funcAddr, _) <- funcDescs ]
    return (TOC.toc tocPtrMap symbolMapping)
  
  toTOCEntryAddr :: (MM.MemWidth w)
                 => Int
                 -> MM.MemAddr w
                 -> Int
                 -> MM.MemAddr w
  toTOCEntryAddr recordBytes tocBaseAddr recordNum =
    MM.incAddr (toInteger (recordBytes * recordNum)) tocBaseAddr
  
  -- | Parse a function descriptor from the TOC
  --
  -- A function descriptor is three pointers:
  --
  -- 1. The address of the function
  -- 2. The address of the TOC that should be in the TOC pointer (usually a distinguished register)
  -- 3. Unused
  getFunctionDescriptor :: (KnownNat w, Integral a, MM.MemWidth w)
                        => MM.MemAddr w
                        -- ^ The entry address
                        -> G.Get a
                        -- ^ The parser for a pointer
                        -> G.Get (MM.MemAddr w, MM.MemAddr w, W.W w)
  getFunctionDescriptor tocEntryAddr ptrParser = do
    entryAddr <- ptrParser
    tocAddr <- ptrParser
    _ <- ptrParser
    let mso = MM.absoluteAddr (fromIntegral entryAddr)
    return (tocEntryAddr, mso, fromIntegral tocAddr)
  