{-# LANGUAGE PartialTypeSignatures , FlexibleContexts, Strict #-}
{-# OPTIONS_HADDOCK prune  #-}

{-|
Module      : L0ToNASM
Description : Lift the L0 representation of the binary to symbolized and recompilable NASM.


-}



module NASM.L0ToNASM (lift_L0_to_NASM, render_NASM, __gmon_start_implementation, NASM) where


import Base
import Config

import OutputGeneration.Retrieval

import Analysis.Context
import Analysis.FunctionNames
import Analysis.ControlFlow

import X86.Conventions
import X86.Instruction (addressof,Instruction)
import X86.Opcode
import X86.Address
import X86.Register

import Generic.Binary
import Generic.SymbolicConstituents (operand_size)
import Instantiation.BinaryElf

import Data.JumpTarget

import qualified Generic.Instruction as Instr
import Generic.Instruction (GenericInstruction(..))
import Generic.Operand
import Generic.Address
import Generic.HasSize 


import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Set as S
import Data.Maybe (fromJust,catMaybes,mapMaybe)
import Data.List.Extra (firstJust,replace)
import Data.List 
import Data.Word
import Data.Foldable
import Data.Char 
import Data.Bits (testBit)
import Data.List.Split (splitOn)
import Data.ByteString.Internal (w2c)
import Data.Function (on)

import Control.Monad.State.Strict
import Data.Functor.Identity
import System.Directory (doesFileExist,createDirectoryIfMissing)
import System.Environment (getArgs)
import System.Exit (die)
import System.IO.Unsafe


import Debug.Trace

import GHC.Base hiding (Symbol)


-- | Each NASM line is either an instruction, a label, or a comment
data NASM_Line = 
    NASM_Instruction String -- ^ An instruction
  | NASM_Label String       -- ^ A label
  | NASM_Comment Int String -- ^ A comment with an indentation level (number of spaces)
  deriving NASM_Line -> NASM_Line -> Bool
(NASM_Line -> NASM_Line -> Bool)
-> (NASM_Line -> NASM_Line -> Bool) -> Eq NASM_Line
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NASM_Line -> NASM_Line -> Bool
$c/= :: NASM_Line -> NASM_Line -> Bool
== :: NASM_Line -> NASM_Line -> Bool
$c== :: NASM_Line -> NASM_Line -> Bool
Eq

-- | A NASM text section contains a header (usually just some comments), and a graph of basic blocks
data NASM_TextSection = NASM_TextSection  {
  NASM_TextSection -> String
nasm_section_header :: String,
  NASM_TextSection -> IntMap [NASM_Line]
nasm_blocks         :: IM.IntMap [NASM_Line], -- ^ A mapping of blockIDs to instructions
  NASM_TextSection -> IntMap IntSet
nasm_edges          :: IM.IntMap (IS.IntSet)  -- ^ A mapping of blockIDs to sets of blocKIDs
 }

-- | A NASM section is either a NASM text section or NASM data section
-- A NASM data section is simply a String
data NASM_Section = NASM_Section_Text NASM_TextSection | NASM_Section_Data String

-- | NASM contains external symbols, sections, and a footer
data NASM = NASM {
  NASM -> Set String
nasm_externals :: S.Set String,
  NASM -> [NASM_Section]
nasm_sections  :: [NASM_Section],
  NASM -> [String]
nasm_footer    :: [String]
 }


-- | Lift an L0 representation to position-independent NASM
lift_L0_to_NASM :: Context -> NASM
lift_L0_to_NASM Context
ctxt = Set String -> [NASM_Section] -> [String] -> NASM
NASM Set String
mk_externals [NASM_Section]
mk_sections ([String] -> NASM) -> [String] -> NASM
forall a b. (a -> b) -> a -> b
$ [String]
mk_jump_tables [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
mk_temp_storage]
 where
  mk_externals :: Set String
mk_externals       = Context -> Set String
externals Context
ctxt
  mk_sections :: [NASM_Section]
mk_sections        = [NASM_Section]
mk_text_sections [NASM_Section] -> [NASM_Section] -> [NASM_Section]
forall a. [a] -> [a] -> [a]
++ [NASM_Section
mk_ro_data_section, NASM_Section
mk_data_section, NASM_Section
mk_bss_section]
  mk_text_sections :: [NASM_Section]
mk_text_sections   = (Int -> NASM_Section) -> [Int] -> [NASM_Section]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> Int -> NASM_Section
entry_to_NASM Context
ctxt) ([Int] -> [NASM_Section]) -> [Int] -> [NASM_Section]
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
S.toList (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Context -> Set Int
ctxt_get_function_entries Context
ctxt

  mk_ro_data_section :: NASM_Section
mk_ro_data_section = String -> NASM_Section
NASM_Section_Data (String -> NASM_Section) -> String -> NASM_Section
forall a b. (a -> b) -> a -> b
$ Context -> String
ro_data_section Context
ctxt
  mk_data_section :: NASM_Section
mk_data_section    = String -> NASM_Section
NASM_Section_Data (String -> NASM_Section) -> String -> NASM_Section
forall a b. (a -> b) -> a -> b
$ Context -> String
data_section Context
ctxt
  mk_bss_section :: NASM_Section
mk_bss_section     = String -> NASM_Section
NASM_Section_Data (String -> NASM_Section) -> String -> NASM_Section
forall a b. (a -> b) -> a -> b
$ Context -> String
bss_data_section Context
ctxt
  
  mk_temp_storage :: String
mk_temp_storage    = String
"section .bss\nLtemp_storage_foxdec:\nresb 8"
  mk_jump_tables :: [String]
mk_jump_tables     = ((Int, CFG, (Int, Indirection)) -> String)
-> [(Int, CFG, (Int, Indirection))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Context -> (Int, CFG, (Int, Indirection)) -> String
forall a.
(Integral a, Show a) =>
Context -> (Int, CFG, (a, Indirection)) -> String
mk_jump_table Context
ctxt) ([(Int, CFG, (Int, Indirection))] -> [String])
-> [(Int, CFG, (Int, Indirection))] -> [String]
forall a b. (a -> b) -> a -> b
$ Context -> [(Int, CFG, (Int, Indirection))]
get_indirections_per_function Context
ctxt






-- | Rendering NASM to a String
render_NASM :: Context -> NASM -> String
render_NASM :: Context -> NASM -> String
render_NASM Context
ctxt (NASM Set String
exts [NASM_Section]
sections [String]
footer) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
render_block_mapping,String
render_externals] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"global _start", String
"default rel", Context -> String
mk_macros Context
ctxt] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
render_sections [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
footer
 where
  render_block_mapping :: String
render_block_mapping = String
"" -- show_block_mapping $ mk_block_mapping ctxt


  render_externals :: String
render_externals = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
"extern ") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Set String -> [String]
forall a. Set a -> [a]
S.toList Set String
exts
  render_sections :: [String]
render_sections  = (NASM_Section -> String) -> [NASM_Section] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NASM_Section -> String
render_section [NASM_Section]
sections

  render_section :: NASM_Section -> String
render_section (NASM_Section_Text (NASM_TextSection String
hdr IntMap [NASM_Line]
blocks IntMap IntSet
edges)) = String
hdr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" (((Int, [NASM_Line]) -> String) -> [(Int, [NASM_Line])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [NASM_Line]) -> String
forall a. (a, [NASM_Line]) -> String
render_block ([(Int, [NASM_Line])] -> [String])
-> [(Int, [NASM_Line])] -> [String]
forall a b. (a -> b) -> a -> b
$ IntMap [NASM_Line] -> [(Int, [NASM_Line])]
forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap [NASM_Line]
blocks) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
  render_section (NASM_Section_Data String
str) = String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"

  render_block :: (a, [NASM_Line]) -> String
render_block (a
blockID,[NASM_Line]
lines) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (NASM_Line -> String) -> [NASM_Line] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NASM_Line -> String
render_line [NASM_Line]
lines

  render_line :: NASM_Line -> String
render_line (NASM_Instruction String
str) = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
  render_line (NASM_Label String
str) = String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
  render_line (NASM_Comment Int
indent String
str) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
indent Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
comment String
str
  

-- making comments
comment :: String -> String
comment String
str = String
"; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

comment_block :: [String] -> String
comment_block [String]
strs =
   String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
comment_block_delim String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
comment [String]
strs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
comment_block_delim,String
""])
 where
  comment_block_delim :: String
comment_block_delim = String -> String
comment (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
max) Char
'-' 
  max :: String
max = (String -> String -> Ordering) -> [String] -> String
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy String -> String -> Ordering
forall (t :: * -> *) (t :: * -> *) a a.
(Foldable t, Foldable t) =>
t a -> t a -> Ordering
compare_lengths [String]
strs
  compare_lengths :: t a -> t a -> Ordering
compare_lengths t a
str0 t a
str1 = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
str0) (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
str1)






-- | get the external function symbols 
externals :: Context -> Set String
externals Context
ctxt = String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
S.insert String
"exit" (Set String -> Set String) -> Set String -> Set String
forall a b. (a -> b) -> a -> b
$ [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (Symbol -> String) -> [Symbol] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
strip_GLIBC (String -> String) -> (Symbol -> String) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String)
-> (Symbol -> Maybe String) -> Symbol -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> Maybe String
symbol_to_name) ([Symbol] -> [String]) -> [Symbol] -> [String]
forall a b. (a -> b) -> a -> b
$ (Symbol -> Bool) -> [Symbol] -> [Symbol]
forall a. (a -> Bool) -> [a] -> [a]
filter Symbol -> Bool
is_relocation ([Symbol] -> [Symbol]) -> [Symbol] -> [Symbol]
forall a b. (a -> b) -> a -> b
$ IntMap Symbol -> [Symbol]
forall a. IntMap a -> [a]
IM.elems (IntMap Symbol -> [Symbol]) -> IntMap Symbol -> [Symbol]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt
 where
  is_relocation :: Symbol -> Bool
is_relocation (Relocated_Function String
str) = String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""
  is_relocation (Relocated_Label String
str) = String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
""
  is_relocation Symbol
_ = Bool
False





-- | Creating labels
-- Given the entry address of the current function, the blockID of the current basic block,
-- map an address to a label.
-- First, try to see if it matches the _start symbol.
-- Then, try to map the address to a known internal synbol (unstripped binaries may have such symbols available)
-- Then, try to see if at the address a relocation is stored, and use that lavel if so.
-- Otherwise, make a new custom label.
block_label :: Context -> a -> Word64 -> a -> String
block_label Context
ctxt a
entry Word64
a a
blockID = (Maybe String
try_start_symbol Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Maybe String
try_internal  Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Maybe String
try_relocation_label) Maybe String -> String -> String
forall a. Eq a => Maybe a -> a -> a
`orElse` String
custom_label
 where
  -- For the entry point of the binary, introduce the _start label
  try_start_symbol :: Maybe String
try_start_symbol
    | Word64
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Context -> Int
ctxt_start Context
ctxt) = String -> Maybe String
forall a. a -> Maybe a
Just String
"_start"
    | Bool
otherwise = Maybe String
forall a. Maybe a
Nothing
  -- Try if the address matches a known internal symbol
  try_internal :: Maybe String
try_internal = do
    Symbol
sym  <- (Int -> IntMap Symbol -> Maybe Symbol
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a) (IntMap Symbol -> Maybe Symbol) -> IntMap Symbol -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ (Symbol -> Bool) -> IntMap Symbol -> IntMap Symbol
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter Symbol -> Bool
is_internal_symbol (IntMap Symbol -> IntMap Symbol) -> IntMap Symbol -> IntMap Symbol
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt)
    String
name <- Symbol -> Maybe String
symbol_to_name Symbol
sym
    if Config -> Bool
nasm_with_safe_labels (Context -> Config
ctxt_config Context
ctxt) then
      String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
    else
      String -> Maybe String
forall (m :: * -> *) a. Monad m => a -> m a
return String
name
  -- Try to see if the address stores a relocation
  try_relocation_label :: Maybe String
try_relocation_label = Relocation -> String
reloc_label (Relocation -> String) -> Maybe Relocation -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Relocation -> Bool) -> Set Relocation -> Maybe Relocation
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> Relocation -> Bool
reloc_for Word64
a) (Context -> Set Relocation
ctxt_relocs Context
ctxt)

  -- Make a new label based on the entry and blockID
  custom_label :: String
custom_label = String
"L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
blockID
  -- Make a label for relocation
  reloc_label :: Relocation -> String
reloc_label (Relocation Word64
a0 Word64
a1) = String
"L_reloc_0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a1


-- Make a label for the start of a section
section_label :: String -> String -> a -> String
section_label String
segment String
section a
addr =  String
"L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
segment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
section String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
addr 
-- Make a label for the end of a section
end_of_section_label :: (String, String, c, d) -> String
end_of_section_label (String
segment,String
section,c
a0,d
sz) = String
"L" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
segment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
section String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_END"  
-- Make a macro name
macro_name :: String -> String -> a -> String
macro_name String
segment String
section a
a0 =  String
"RELA" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
segment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
section String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a0





-- | Information on sections
-- TODO: get from Binary interface
is_ro_data_section :: (String, String, c, d) -> Bool
is_ro_data_section (String
"",String
".rodata",c
_,d
_) = Bool
True
is_ro_data_section (String
"",String
".init_array",c
_,d
_) = Bool
True
is_ro_data_section (String
"",String
".fini_array",c
_,d
_) = Bool
True
is_ro_data_section (String
"",String
".data.rel.ro",c
_,d
_) = Bool
True
is_ro_data_section (String
"__DATA",String
"__const",c
_,d
_) = Bool
True
is_ro_data_section (String, String, c, d)
_ = Bool
False

is_data_section :: (String, String, c, d) -> Bool
is_data_section (String
"__DATA",String
"__data",c
_,d
_) = Bool
True
is_data_section (String
"",String
".data",c
_,d
_) = Bool
True
is_data_section (String, String, c, d)
_ = Bool
False

is_bss_data_section :: (String, String, c, d) -> Bool
is_bss_data_section (String
"__DATA",String
"__bss",c
_,d
_) = Bool
True
is_bss_data_section (String
"__DATA",String
"__common",c
_,d
_) = Bool
True
is_bss_data_section (String
"",String
".bss",c
_,d
_) = Bool
True
is_bss_data_section (String, String, c, d)
_ = Bool
False






-- | convert a given function entry to a NASM text section
entry_to_NASM :: Context -> Int -> NASM_Section
entry_to_NASM Context
ctxt Int
entry = NASM_TextSection -> NASM_Section
NASM_Section_Text (NASM_TextSection -> NASM_Section)
-> NASM_TextSection -> NASM_Section
forall a b. (a -> b) -> a -> b
$ String -> IntMap [NASM_Line] -> IntMap IntSet -> NASM_TextSection
NASM_TextSection String
mk_header IntMap [NASM_Line]
mk_blocks IntMap IntSet
mk_edges
 where
  mk_header :: String
mk_header     = [String] -> String
comment_block [String
"Function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Context -> Int -> String
function_name_of_entry Context
ctxt Int
entry]
  mk_blocks :: IntMap [NASM_Line]
mk_blocks     = [(Int, [NASM_Line])] -> IntMap [NASM_Line]
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int, [NASM_Line])]
cfg_to_NASM
  mk_edges :: IntMap IntSet
mk_edges      = CFG -> IntMap IntSet
cfg_edges CFG
cfg
  Just CFG
cfg      = Int -> IntMap CFG -> Maybe CFG
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
entry (Context -> IntMap CFG
ctxt_cfgs Context
ctxt)
  cfg_to_NASM :: [(Int, [NASM_Line])]
cfg_to_NASM   = Context -> Int -> CFG -> [Int] -> [(Int, [NASM_Line])]
cfg_blocks_to_NASM Context
ctxt Int
entry CFG
cfg ([Int] -> [(Int, [NASM_Line])]) -> [Int] -> [(Int, [NASM_Line])]
forall a b. (a -> b) -> a -> b
$ IntMap [Int] -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap [Int] -> [Int]) -> IntMap [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Int]
cfg_blocks CFG
cfg


show_block_mapping :: IM.IntMap [(Word64, String)] -> String
show_block_mapping :: IntMap [(Word64, String)] -> String
show_block_mapping = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n\n" ([String] -> String)
-> (IntMap [(Word64, String)] -> [String])
-> IntMap [(Word64, String)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, [(Word64, String)]) -> String)
-> [(Int, [(Word64, String)])] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [(Word64, String)]) -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
(a, [(a, String)]) -> String
show_entry ([(Int, [(Word64, String)])] -> [String])
-> (IntMap [(Word64, String)] -> [(Int, [(Word64, String)])])
-> IntMap [(Word64, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap [(Word64, String)] -> [(Int, [(Word64, String)])]
forall a. IntMap a -> [(Int, a)]
IM.toList
 where
  show_entry :: (a, [(a, String)]) -> String
show_entry (a
entry,[(a, String)]
blocks) = String
"Entry: 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((a, String) -> String) -> [(a, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (a, String) -> String
forall a. (Integral a, Show a) => (a, String) -> String
show_block [(a, String)]
blocks)
  show_block :: (a, String) -> String
show_block (a
a,String
label)      = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label

mk_block_mapping :: Context -> IM.IntMap [(Word64, String)]
mk_block_mapping :: Context -> IntMap [(Word64, String)]
mk_block_mapping Context
ctxt = [(Int, [(Word64, String)])] -> IntMap [(Word64, String)]
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, [(Word64, String)])] -> IntMap [(Word64, String)])
-> [(Int, [(Word64, String)])] -> IntMap [(Word64, String)]
forall a b. (a -> b) -> a -> b
$ (Int -> (Int, [(Word64, String)]))
-> [Int] -> [(Int, [(Word64, String)])]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Int, [(Word64, String)])
mk_block_mapping_for_entry) ([Int] -> [(Int, [(Word64, String)])])
-> [Int] -> [(Int, [(Word64, String)])]
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
S.toList (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Context -> Set Int
ctxt_get_function_entries Context
ctxt
 where
  mk_block_mapping_for_entry :: Int -> (Int, [(Word64, String)])
mk_block_mapping_for_entry Int
entry = 
    let cfg :: CFG
cfg = Context -> IntMap CFG
ctxt_cfgs Context
ctxt IntMap CFG -> Int -> CFG
forall a. IntMap a -> Int -> a
IM.! Int
entry in
      (Int
entry,(Int -> (Word64, String)) -> [Int] -> [(Word64, String)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CFG -> Int -> (Word64, String)
forall a.
(Integral a, Show a) =>
a -> CFG -> Int -> (Word64, String)
mk_block_mapping_for_block Int
entry CFG
cfg) (IntMap [Int] -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap [Int] -> [Int]) -> IntMap [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ CFG -> IntMap [Int]
cfg_blocks CFG
cfg))

  mk_block_mapping_for_block :: a -> CFG -> Int -> (Word64, String)
mk_block_mapping_for_block a
entry CFG
cfg Int
blockID = 
    let a :: Word64
a = GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Word64)
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
head ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> GenericInstruction AddressWord64 Register Prefix Opcode Int)
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a b. (a -> b) -> a -> b
$ CFG
-> Int
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
get_block_instrs CFG
cfg Int
blockID in
      (Word64
a, Context -> a -> Word64 -> Int -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt a
entry Word64
a Int
blockID)
  get_block_instrs :: CFG
-> Int
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
get_block_instrs CFG
cfg Int
blockID = CFG
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
cfg_instrs CFG
cfg IntMap
  [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Int
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall a. IntMap a -> Int -> a
IM.! Int
blockID 




-- | convert a list of basic blocks to NASM instructions
-- Note that the order dictates if additional jumps need to be inserted
cfg_blocks_to_NASM :: Context -> Int -> CFG -> [Int] -> [(Int, [NASM_Line])]
cfg_blocks_to_NASM Context
ctxt Int
entry CFG
cfg []                             = []
cfg_blocks_to_NASM Context
ctxt Int
entry CFG
cfg [Int
blockID0]                     = [(Int
blockID0,Context -> Int -> CFG -> Int -> Maybe Int -> [NASM_Line]
cfg_block_to_NASM Context
ctxt Int
entry CFG
cfg Int
blockID0 (Maybe Int -> [NASM_Line]) -> Maybe Int -> [NASM_Line]
forall a b. (a -> b) -> a -> b
$ Maybe Int
forall a. Maybe a
Nothing)]
cfg_blocks_to_NASM Context
ctxt Int
entry CFG
cfg (Int
blockID0:blocks :: [Int]
blocks@(Int
blockID1:[Int]
_)) = (Int
blockID0,Context -> Int -> CFG -> Int -> Maybe Int -> [NASM_Line]
cfg_block_to_NASM Context
ctxt Int
entry CFG
cfg Int
blockID0 (Maybe Int -> [NASM_Line]) -> Maybe Int -> [NASM_Line]
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
blockID1) (Int, [NASM_Line]) -> [(Int, [NASM_Line])] -> [(Int, [NASM_Line])]
forall a. a -> [a] -> [a]
: Context -> Int -> CFG -> [Int] -> [(Int, [NASM_Line])]
cfg_blocks_to_NASM Context
ctxt Int
entry CFG
cfg [Int]
blocks


-- | convert a single basic block to NASM instructions
-- A block is translated to a header and its instructions
cfg_block_to_NASM :: Context -> Int -> CFG -> Int -> Maybe Int -> [NASM_Line]
cfg_block_to_NASM Context
ctxt Int
entry CFG
cfg Int
blockID Maybe Int
blockID1 = NASM_Line
block_header NASM_Line -> [NASM_Line] -> [NASM_Line]
forall a. a -> [a] -> [a]
: [NASM_Line]
mk_block
 where
  -- header
  block_header :: NASM_Line
block_header          = Int -> String -> NASM_Line
NASM_Comment Int
0 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Entry " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Integral a, Show a) => a -> String
showHex Int
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; block " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
blockID String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; address " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex (GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Word64)
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
head [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs)
  -- instructions: the label and the body
  mk_block :: [NASM_Line]
mk_block              = [NASM_Line]
block_label' [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [NASM_Line]
block_body 

  -- the label
  block_label' :: [NASM_Line]
block_label'          = [String -> NASM_Line
NASM_Label (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ Context -> Int -> Word64 -> Int -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt Int
entry (GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Word64)
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
head [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) Int
blockID] 
  -- the body:
  --   in case of a block ending in a jump table, instructions are inserted at beginning and end of the block
  --   in case of a block ending in an indirection resolved to a single target, translate the last instruction accordingly
  --   in case of a block ending in an unresolved indirection resolved to a single target, translate as normal but annotate
  --   in case of no indirection, translate normally but insert an extra jump to the next block if neccessary
  block_body :: [NASM_Line]
block_body =
    case [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Maybe Indirection
forall prefix opcode storage annotation.
(Eq prefix, Eq opcode, Eq storage, Eq annotation) =>
[GenericInstruction AddressWord64 storage prefix opcode annotation]
-> Maybe Indirection
try_indirect_block [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs of
      Just (Indirection_JumpTable tbl :: JumpTable
tbl@(JumpTable Operand
index Int
_ Operand
_ IntMap Word64
_)) -> 
        let si :: Int
si   = Operand -> Int
forall a. HasSize a => GenericOperand a -> Int
operand_size Operand
index
            reg :: Register
reg  = Register -> Int -> Register
forall a. (Eq a, Num a, Show a) => Register -> a -> Register
reg_of_size ([Register]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Register
find_unused_register [Register]
register_set [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) Int
si
            reg' :: Register
reg' = Register -> Integer -> Register
forall a. (Eq a, Num a, Show a) => Register -> a -> Register
reg_of_size ([Register]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Register
find_unused_register [ Register
r | Register
r <- [Register]
register_set, Register -> Register
real Register
r Register -> Register -> Bool
forall a. Eq a => a -> a -> Bool
/= Register -> Register
real Register
reg] [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) Integer
8 in
          JumpTable
-> Register
-> Register
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
forall storage prefix opcode annotation.
JumpTable
-> Register
-> Register
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> [NASM_Line]
jmp_table_init JumpTable
tbl Register
reg Register
reg' ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
last [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
mk_block_instrs ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall a. [a] -> [a]
init [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ JumpTable
-> Register
-> Register
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
jmp_table_end JumpTable
tbl Register
reg Register
reg' ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
last [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs)
      Just (Indirection_Resolved Set ResolvedJumpTarget
trgts) -> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
mk_block_instrs ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall a. [a] -> [a]
init [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [ResolvedJumpTarget]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
resolved_jump (Set ResolvedJumpTarget -> [ResolvedJumpTarget]
forall a. Set a -> [a]
S.toList Set ResolvedJumpTarget
trgts) ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
last [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
forall label prefix storage annotation.
(Eq label, Eq prefix, Eq storage, Eq annotation) =>
[GenericInstruction label storage prefix Opcode annotation]
-> [NASM_Line]
block_end [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs
      Just (Indirection
Indirection_Unresolved)     -> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
mk_block_instrs [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [NASM_Line]
unresolved_end [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
forall label prefix storage annotation.
(Eq label, Eq prefix, Eq storage, Eq annotation) =>
[GenericInstruction label storage prefix Opcode annotation]
-> [NASM_Line]
block_end [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs
      Maybe Indirection
Nothing                           -> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
mk_block_instrs [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
forall label prefix storage annotation.
(Eq label, Eq prefix, Eq storage, Eq annotation) =>
[GenericInstruction label storage prefix Opcode annotation]
-> [NASM_Line]
block_end [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs


  -- if the block ends in an indirection, retrieve that indirection
  try_indirect_block :: [GenericInstruction AddressWord64 storage prefix opcode annotation]
-> Maybe Indirection
try_indirect_block [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs
    | [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs [GenericInstruction AddressWord64 storage prefix opcode annotation]
-> [GenericInstruction
      AddressWord64 storage prefix opcode annotation]
-> Bool
forall a. Eq a => a -> a -> Bool
== []  = Maybe Indirection
forall a. Maybe a
Nothing
    | Bool
is_unresolved = Indirection -> Maybe Indirection
forall a. a -> Maybe a
Just Indirection
Indirection_Unresolved
    | Bool
otherwise     = Int -> IntMap Indirection -> Maybe Indirection
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof (GenericInstruction AddressWord64 storage prefix opcode annotation
 -> Word64)
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> Word64
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 storage prefix opcode annotation]
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
forall a. [a] -> a
last [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs) (IntMap Indirection -> Maybe Indirection)
-> IntMap Indirection -> Maybe Indirection
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Indirection
ctxt_inds Context
ctxt
  is_unresolved :: Bool
is_unresolved = Context -> CFG -> Int -> NodeInfo
node_info_of Context
ctxt CFG
cfg Int
blockID NodeInfo -> NodeInfo -> Bool
forall a. Eq a => a -> a -> Bool
== NodeInfo
UnresolvedIndirection
  


  -- make a block of regular non-control-flow instructions
  mk_block_instrs :: [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
mk_block_instrs [GenericInstruction AddressWord64 Register Prefix Opcode Int]
instrs = (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> [NASM_Line])
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
instr_to_NASM Context
ctxt Int
entry CFG
cfg) ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> [NASM_Line])
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [NASM_Line]
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall label prefix storage annotation.
(Eq label, Eq prefix, Eq storage, Eq annotation) =>
[GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
filter_unnecessary_jumps [GenericInstruction AddressWord64 Register Prefix Opcode Int]
instrs

  -- for a normal (non-indirection) block, see if we need to insert an additional jump to the next block
  -- Necessary when that next block is not the next to be translated.
  block_end :: [GenericInstruction label storage prefix Opcode annotation]
-> [NASM_Line]
block_end [GenericInstruction label storage prefix Opcode annotation]
instrs
    | [GenericInstruction label storage prefix Opcode annotation]
instrs [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
-> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
    | Opcode -> Bool
is_proper_block_end_instruction (GenericInstruction label storage prefix Opcode annotation -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
Instr.opcode (GenericInstruction label storage prefix Opcode annotation
 -> Opcode)
-> GenericInstruction label storage prefix Opcode annotation
-> Opcode
forall a b. (a -> b) -> a -> b
$ [GenericInstruction label storage prefix Opcode annotation]
-> GenericInstruction label storage prefix Opcode annotation
forall a. [a] -> a
last [GenericInstruction label storage prefix Opcode annotation]
instrs) = []
    | Maybe Int
blockID1 Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Int
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Int -> IntMap IntSet -> Maybe IntSet
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
blockID (CFG -> IntMap IntSet
cfg_edges CFG
cfg) Maybe IntSet -> Maybe IntSet -> Bool
forall a. Eq a => a -> a -> Bool
== IntSet -> Maybe IntSet
forall a. a -> Maybe a
Just (Int -> IntSet
IS.singleton (Int -> IntSet) -> Int -> IntSet
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
blockID1) = []
    | Bool
otherwise = [NASM_Line]
mk_extra_jmp


  -- A jump table is implemented (TODO more comments)
  jmp_table_init :: JumpTable
-> Register
-> Register
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> [NASM_Line]
jmp_table_init t :: JumpTable
t@(JumpTable Operand
index Int
bound Operand
trgt IntMap Word64
tbl) Register
reg Register
reg' GenericInstruction AddressWord64 storage prefix opcode annotation
i =
      [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Resolved indirection:"
      , Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ JumpTable -> String
forall a. Show a => a -> String
show JumpTable
t
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_temp_storage Int
entry (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 storage prefix opcode annotation
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"], " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show (Register -> Register
real Register
reg)
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_temp_storage Int
entry (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 storage prefix opcode annotation
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + 8], " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show (Register -> Register
real Register
reg')
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
empty_instr Bool
False Operand
index ]
      [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++
      (if Register -> Int
forall a. HasSize a => a -> Int
sizeof Register
reg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then [String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOVZX " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show(Register -> Integer -> Register
forall a. (Eq a, Num a, Show a) => Register -> a -> Register
reg_of_size (Register -> Register
real Register
reg) Integer
4) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg] else [])
      [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++
      [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Start of block"  ]

  jmp_table_end :: JumpTable
-> Register
-> Register
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
jmp_table_end t :: JumpTable
t@(JumpTable Operand
index Int
bound Operand
trgt IntMap Word64
tbl) Register
reg Register
reg' GenericInstruction AddressWord64 Register Prefix Opcode Int
last_instr =
    [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"End of block"
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"LEA " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_redirect_data Int
entry (GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 Register Prefix Opcode Int
last_instr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"LEA " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + 8*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show(Register -> Integer -> Register
forall a. (Eq a, Num a, Show a) => Register -> a -> Register
reg_of_size (Register -> Register
real Register
reg) Integer
8) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
empty_instr Bool
False Operand
trgt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", qword [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show (Register -> Register
real Register
reg)  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_temp_storage Int
entry (GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 Register Prefix Opcode Int
last_instr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"MOV " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show (Register -> Register
real Register
reg') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Word64 -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_temp_storage Int
entry (GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 Register Prefix Opcode Int
last_instr) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + 8]"
    , Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Executing resolved indirect jump"
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_jmp_call_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
last_instr ]



  -- A resolved jump to a single known target
  resolved_jump :: [ResolvedJumpTarget]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
resolved_jump [External String
f] (Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot) =
    [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Resolved indirection: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Operand -> String
forall a. Show a => a -> String
show ([Operand] -> Operand
forall a. [a] -> a
head [Operand]
ops) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f 
    , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre, Opcode -> String
opcode_to_NASM Opcode
op, String
" ", String
f, String
" wrt ..plt" ]]
  resolved_jump [ImmediateAddress Word64
imm] i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot) = 
    [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Resolved indirection: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Operand -> String
forall a. Show a => a -> String
show ([Operand] -> Operand
forall a. [a] -> a
head [Operand]
ops) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
imm
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_jmp_call_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i]
  resolved_jump [ResolvedJumpTarget]
trgts i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot) =
    [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Resolved indirection: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Operand -> String
forall a. Show a => a -> String
show ([Operand] -> Operand
forall a. [a] -> a
head [Operand]
ops) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [ResolvedJumpTarget] -> String
forall a. Show a => a -> String
show [ResolvedJumpTarget]
trgts ]
    [NASM_Line] -> [NASM_Line] -> [NASM_Line]
forall a. [a] -> [a] -> [a]
++
    Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
instr_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i


  -- An unresolved indirection annotation
  unresolved_end :: [NASM_Line]
unresolved_end =
   [ Int -> String -> NASM_Line
NASM_Comment Int
2 (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"Unresolved indirection" ]

  filter_unnecessary_jumps :: [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
filter_unnecessary_jumps [GenericInstruction label storage prefix Opcode annotation]
instrs
    | [GenericInstruction label storage prefix Opcode annotation]
instrs [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
-> Bool
forall a. Eq a => a -> a -> Bool
== [] = []
    | Bool
otherwise    = ((GenericInstruction label storage prefix Opcode annotation -> Bool)
-> [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (GenericInstruction label storage prefix Opcode annotation
    -> Bool)
-> GenericInstruction label storage prefix Opcode annotation
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Opcode -> Bool
isJump (Opcode -> Bool)
-> (GenericInstruction label storage prefix Opcode annotation
    -> Opcode)
-> GenericInstruction label storage prefix Opcode annotation
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericInstruction label storage prefix Opcode annotation -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
Instr.opcode) ([GenericInstruction label storage prefix Opcode annotation]
 -> [GenericInstruction label storage prefix Opcode annotation])
-> [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
forall a b. (a -> b) -> a -> b
$ [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
forall a. [a] -> [a]
init [GenericInstruction label storage prefix Opcode annotation]
instrs) [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
-> [GenericInstruction label storage prefix Opcode annotation]
forall a. [a] -> [a] -> [a]
++ [[GenericInstruction label storage prefix Opcode annotation]
-> GenericInstruction label storage prefix Opcode annotation
forall a. [a] -> a
last [GenericInstruction label storage prefix Opcode annotation]
instrs]
  is_proper_block_end_instruction :: Opcode -> Bool
is_proper_block_end_instruction Opcode
i = Opcode -> Bool
isRet Opcode
i Bool -> Bool -> Bool
|| Opcode -> Bool
isJump Opcode
i 

  Just [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs = Int
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Maybe
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
blockID (IntMap
   [GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> Maybe
      [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Maybe
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall a b. (a -> b) -> a -> b
$ CFG
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
cfg_instrs CFG
cfg

  empty_instr :: Instruction
  empty_instr :: GenericInstruction AddressWord64 Register Prefix Opcode Int
empty_instr = AddressWord64
-> Maybe Prefix
-> Opcode
-> Maybe Operand
-> [Operand]
-> Maybe Int
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall label storage prefix opcode annotation.
label
-> Maybe prefix
-> opcode
-> Maybe (GenericOperand storage)
-> [GenericOperand storage]
-> Maybe annotation
-> GenericInstruction label storage prefix opcode annotation
Instruction (Word64 -> AddressWord64
AddressWord64 Word64
0) Maybe Prefix
forall a. Maybe a
Nothing Opcode
NOP Maybe Operand
forall a. Maybe a
Nothing [] Maybe Int
forall a. Maybe a
Nothing

  mk_extra_jmp :: [NASM_Line]
mk_extra_jmp =
    case IO
  (Either
     (Set
        (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
     [(Int, Bool)])
-> Either
     (Set
        (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
     [(Int, Bool)]
forall a. IO a -> a
unsafePerformIO (IO
   (Either
      (Set
         (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
      [(Int, Bool)])
 -> Either
      (Set
         (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
      [(Int, Bool)])
-> IO
     (Either
        (Set
           (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
        [(Int, Bool)])
-> Either
     (Set
        (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
     [(Int, Bool)]
forall a b. (a -> b) -> a -> b
$ Context
-> Int
-> Int
-> IO
     (Either
        (Set
           (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
        [(Int, Bool)])
stepA Context
ctxt Int
entry (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Word64)
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall a b. (a -> b) -> a -> b
$ [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall a. [a] -> a
last [GenericInstruction AddressWord64 Register Prefix Opcode Int]
block_instrs) of -- TODO maybe unnecessary, also TODO assumes fall through is last/second
      Right []        -> []
      Right [(Int
a,Bool
_)]   -> [String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"JMP " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) Bool
False (Word64 -> Maybe String) -> Word64 -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"     ; inserted"]
      Right [(Int, Bool)
_,(Int
a,Bool
_)] -> [String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"JMP " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) Bool
False (Word64 -> Maybe String) -> Word64 -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"     ; inserted"]
      Either
  (Set
     (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
  [(Int, Bool)]
x               -> [String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ String
"JMP ERROR CANNOT DETERMINE NEXT BLOCK" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Either
  (Set
     (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
  [(Int, Bool)]
-> String
forall a. Show a => a -> String
show Either
  (Set
     (GenericInstruction AddressWord64 Register Prefix Opcode Int, Int))
  [(Int, Bool)]
x]


label_jump_table_temp_storage :: a -> a -> String
label_jump_table_temp_storage  a
entry a
a = String
"L_jmp_tbl_temp_storage_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a
label_jump_table_redirect_data :: a -> a -> String
label_jump_table_redirect_data a
entry a
a = String
"L_jmp_tbl_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a



-- | convert an instruction to a NASM instruction
instr_to_NASM :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
instr_to_NASM Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot)
 | Opcode
op Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
NOP                                = []
 | Opcode
op Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
ENDBR64                            = []
 | Maybe Prefix -> Opcode -> Bool
forall a. Eq a => Maybe a -> Opcode -> Bool
no_ops Maybe Prefix
pre Opcode
op                            = [Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_normal_instr Context
ctxt Int
entry CFG
cfg (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> NASM_Line)
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
forall a b. (a -> b) -> a -> b
$ AddressWord64
-> Maybe Prefix
-> Opcode
-> Maybe Operand
-> [Operand]
-> Maybe Int
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall label storage prefix opcode annotation.
label
-> Maybe prefix
-> opcode
-> Maybe (GenericOperand storage)
-> [GenericOperand storage]
-> Maybe annotation
-> GenericInstruction label storage prefix opcode annotation
Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
forall a. Maybe a
Nothing [] Maybe Int
annot]
 | Opcode -> Bool
is_cf Opcode
op                                 = [Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_jmp_call_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i]
 | Context
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [Operand]
-> Bool
forall (t :: * -> *) storage prefix opcode annotation.
(Foldable t,
 HasSize
   (GenericInstruction
      AddressWord64 storage prefix opcode annotation)) =>
Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> t Operand
-> Bool
some_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 Register Prefix Opcode Int
i [Operand]
ops  = Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
mk_GOT_entry_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i
 | Bool
otherwise                                = [Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_normal_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i]
 where
  is_cf :: Opcode -> Bool
is_cf Opcode
op      = Opcode -> Bool
isCall Opcode
op Bool -> Bool -> Bool
|| Opcode -> Bool
isJump Opcode
op Bool -> Bool -> Bool
|| Opcode -> Bool
isCondJump Opcode
op
  no_ops :: Maybe a -> Opcode -> Bool
no_ops Maybe a
pre Opcode
op = Opcode
op Opcode -> [Opcode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
STOSQ, Opcode
SCASB, Opcode
CMPSB, Opcode
STOSD] Bool -> Bool -> Bool
|| (Maybe a
pre Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Opcode
op Opcode -> [Opcode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
MOVSB, Opcode
MOVSW, Opcode
MOVSD, Opcode
MOVSQ])


-- Make a normal instruction
mk_normal_instr :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_normal_instr Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot) = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre
  , Opcode -> String
opcode_to_NASM Opcode
op
  , String
" "
  ,  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Operand -> String) -> [Operand] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
False) [Operand]
ops ]

-- Make a JUMP/CALL instruction
mk_jmp_call_instr :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_jmp_call_instr Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand
op1] Maybe Int
annot) = ((Symbol, String) -> NASM_Line
mk_external ((Symbol, String) -> NASM_Line)
-> Maybe (Symbol, String) -> Maybe NASM_Line
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operand -> Maybe (Symbol, String)
try_external Operand
op1) Maybe NASM_Line -> NASM_Line -> NASM_Line
forall a. Eq a => Maybe a -> a -> a
`orElse` NASM_Line
mk_call_to_imm 
 where
  try_external :: Operand -> Maybe (Symbol, String)
try_external (Memory GenericAddress Register
a Int
si) = do
    Word64
a_v <- GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register -> Maybe Word64
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
rip_relative_to_immediate GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a
     -- see if address matches a symbol
    Symbol
sym <- Int -> IntMap Symbol -> Maybe Symbol
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a_v) (IntMap Symbol -> Maybe Symbol) -> IntMap Symbol -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ (Symbol -> Bool) -> IntMap Symbol -> IntMap Symbol
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter Symbol -> Bool
is_external_symbol (IntMap Symbol -> IntMap Symbol) -> IntMap Symbol -> IntMap Symbol
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt
    String
name <- Symbol -> Maybe String
symbol_to_name Symbol
sym
    (Symbol, String) -> Maybe (Symbol, String)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Symbol, String) -> Maybe (Symbol, String))
-> (Symbol, String) -> Maybe (Symbol, String)
forall a b. (a -> b) -> a -> b
$ (Symbol
sym,String -> String
strip_GLIBC String
name)
  try_external Operand
_ = Maybe (Symbol, String)
forall a. Maybe a
Nothing

  mk_external :: (Symbol, String) -> NASM_Line
mk_external (Relocated_Label String
_,String
f)           = Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_normal_instr Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i
  mk_external (Relocated_Function String
_, String
"error") = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"CALL error wrt ..plt\n  CALL exit wrt ..plt ; inserted, to ensure error always terminates"]
  mk_external (Relocated_Function String
_,String
f)        = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre
    , Opcode -> String
opcode_to_NASM Opcode
op
    , String
" "
    , String
f
    , String
" wrt ..plt" ]


  mk_call_to_imm :: NASM_Line
mk_call_to_imm =  String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre
    , Opcode -> String
opcode_to_NASM Opcode
op
    , String
" "
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True Operand
op1 ]

-- Make an instruction with an operand reading a GOT entry
-- TODO MOV reg, [rip+imm] can be more efficient
mk_GOT_entry_instr :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
mk_GOT_entry_instr Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
Nothing [Operand]
ops Maybe Int
annot) = 
  let [String
f] = [String]
name_of_external_function
      r :: Register
r   = [Register]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Register
find_unused_register [Register]
register_set [GenericInstruction AddressWord64 Register Prefix Opcode Int
i] in
    [ Register -> NASM_Line
mov_reg_to_temp Register
r
    , Register -> String -> NASM_Line
lea_external_function Register
r String
f
    , Register -> NASM_Line
the_actual_instr Register
r
    , Register -> NASM_Line
mov_temp_to_reg Register
r ]
 where
  mov_reg_to_temp :: Register -> NASM_Line
mov_reg_to_temp Register
r = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"MOV qword [Ltemp_storage_foxdec], " 
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r
    , String
" ; inserted" ]

  lea_external_function :: Register -> String -> NASM_Line
lea_external_function Register
r String
f = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"LEA " 
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r
    , String
", [", String
f, String
" wrt ..plt]" ]

  the_actual_instr :: Register -> NASM_Line
the_actual_instr Register
r = Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> NASM_Line
mk_normal_instr Context
ctxt Int
entry CFG
cfg (AddressWord64
-> Maybe Prefix
-> Opcode
-> Maybe Operand
-> [Operand]
-> Maybe Int
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
forall label storage prefix opcode annotation.
label
-> Maybe prefix
-> opcode
-> Maybe (GenericOperand storage)
-> [GenericOperand storage]
-> Maybe annotation
-> GenericInstruction label storage prefix opcode annotation
Instruction AddressWord64
addr Maybe Prefix
pre Opcode
op Maybe Operand
forall a. Maybe a
Nothing (Register -> [Operand] -> [Operand]
forall t. t -> [GenericOperand t] -> [GenericOperand t]
replace_mem_op Register
r [Operand]
ops) Maybe Int
annot)

  mov_temp_to_reg :: Register -> NASM_Line
mov_temp_to_reg Register
r = String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String
"MOV " 
    , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r
    , String
", qword [Ltemp_storage_foxdec] ; inserted"]

  replace_mem_op :: t -> [GenericOperand t] -> [GenericOperand t]
replace_mem_op t
r (Memory GenericAddress t
a Int
si:[GenericOperand t]
ops) = t -> GenericOperand t
forall storage. storage -> GenericOperand storage
Storage t
r GenericOperand t -> [GenericOperand t] -> [GenericOperand t]
forall a. a -> [a] -> [a]
: [GenericOperand t]
ops
  replace_mem_op t
r (GenericOperand t
op:[GenericOperand t]
ops)          = GenericOperand t
opGenericOperand t -> [GenericOperand t] -> [GenericOperand t]
forall a. a -> [a] -> [a]
:t -> [GenericOperand t] -> [GenericOperand t]
replace_mem_op t
r [GenericOperand t]
ops

  name_of_external_function :: [String]
name_of_external_function = (Operand -> Maybe String) -> [Operand] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Operand
-> Maybe String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> Operand
-> Maybe String
try_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 Register Prefix Opcode Int
i) [Operand]
ops

-- TODO: this is only relevant when doing non-RIP-relative binaries and translating instructions of the form:
--mk_instr ctxt entry cfg i@(Instruction addr pre op@MOV Nothing ops@[dst,Immediate imm] annot)
--  | is_instruction_address ctxt imm = mk_fake_lea ctxt entry cfg i
--  | otherwise = [NASM_Instruction $ concat
--      [ prefix_to_NASM pre
--      , opcode_to_NASM op
--      , " "
--      ,  intercalate ", " $ map (operand_to_NASM ctxt entry cfg i False) ops ]]






some_operand_reads_GOT_entry :: Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> t Operand
-> Bool
some_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 storage prefix opcode annotation
i = (Operand -> Bool) -> t Operand -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Operand
op -> Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> Operand
-> Maybe String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> Operand
-> Maybe String
try_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 storage prefix opcode annotation
i Operand
op Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe String
forall a. Maybe a
Nothing)

try_operand_reads_GOT_entry :: Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> Operand
-> Maybe String
try_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 storage prefix opcode annotation
i (Memory GenericAddress Register
addr Int
si) =
  case GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
addr of
    Maybe Word64
Nothing -> Maybe String
forall a. Maybe a
Nothing
    Just Word64
a  -> Word64 -> Maybe String
forall a. Integral a => a -> Maybe String
find_relocated_function Word64
a
 where

  find_relocated_function :: a -> Maybe String
find_relocated_function a
a = 
    case ((Int, Symbol) -> Bool) -> [(Int, Symbol)] -> Maybe (Int, Symbol)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int -> (Int, Symbol) -> Bool
forall a. Eq a => a -> (a, Symbol) -> Bool
is_relocated_function (Int -> (Int, Symbol) -> Bool) -> Int -> (Int, Symbol) -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a) ([(Int, Symbol)] -> Maybe (Int, Symbol))
-> [(Int, Symbol)] -> Maybe (Int, Symbol)
forall a b. (a -> b) -> a -> b
$ IntMap Symbol -> [(Int, Symbol)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Symbol -> [(Int, Symbol)])
-> IntMap Symbol -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt of
      Just (Int
a',Relocated_Function String
str) -> String -> Maybe String
forall a. a -> Maybe a
Just String
str
      Maybe (Int, Symbol)
_ -> Maybe String
forall a. Maybe a
Nothing

  is_relocated_function :: a -> (a, Symbol) -> Bool
is_relocated_function a
a (a
a',Relocated_Function String
str) = a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a'
  is_relocated_function a
a (a, Symbol)
_                           = Bool
False
try_operand_reads_GOT_entry Context
ctxt GenericInstruction AddressWord64 storage prefix opcode annotation
i Operand
_ = Maybe String
forall a. Maybe a
Nothing

is_instruction_address :: Context -> Word64 -> Bool
is_instruction_address Context
ctxt Word64
a = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
  [ Context -> Word64 -> Bool
forall a. Integral a => Context -> a -> Bool
address_has_instruction Context
ctxt Word64
a
  , Word64
a Word64 -> Set Word64 -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Word64
all_instruction_addresses ]
 where
  all_instruction_addresses :: Set Word64
all_instruction_addresses = [Set Word64] -> Set Word64
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set Word64] -> Set Word64) -> [Set Word64] -> Set Word64
forall a b. (a -> b) -> a -> b
$ (CFG -> Set Word64) -> [CFG] -> [Set Word64]
forall a b. (a -> b) -> [a] -> [b]
map ([Word64] -> Set Word64
forall a. Ord a => [a] -> Set a
S.fromList ([Word64] -> Set Word64) -> (CFG -> [Word64]) -> CFG -> Set Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Word64)
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> [Word64])
-> (CFG
    -> [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> CFG
-> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GenericInstruction AddressWord64 Register Prefix Opcode Int]]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[GenericInstruction AddressWord64 Register Prefix Opcode Int]]
 -> [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> (CFG
    -> [[GenericInstruction AddressWord64 Register Prefix Opcode Int]])
-> CFG
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap
  [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [[GenericInstruction AddressWord64 Register Prefix Opcode Int]]
forall a. IntMap a -> [a]
IM.elems (IntMap
   [GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> [[GenericInstruction AddressWord64 Register Prefix Opcode Int]])
-> (CFG
    -> IntMap
         [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> CFG
-> [[GenericInstruction AddressWord64 Register Prefix Opcode Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CFG
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
cfg_instrs) ([CFG] -> [Set Word64]) -> [CFG] -> [Set Word64]
forall a b. (a -> b) -> a -> b
$ IntMap CFG -> [CFG]
forall a. IntMap a -> [a]
IM.elems (IntMap CFG -> [CFG]) -> IntMap CFG -> [CFG]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap CFG
ctxt_cfgs Context
ctxt



-- TODO: this is only relevant when doing non-RIP-relative binaries and translating instructions of the form:
--   MOV dst, imm
-- where imm is (maybe) an address
mk_fake_lea :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [NASM_Line]
mk_fake_lea Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre op :: Opcode
op@Opcode
MOV Maybe Operand
Nothing ops :: [Operand]
ops@[dst :: Operand
dst@(Storage Register
r),Immediate Word64
imm] Maybe Int
annot) =
    let l :: String
l = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) Bool
True Word64
imm in
      [String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre
        , String
"LEA "
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True Operand
dst
        , String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
        , String
" ; 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
imm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l ]]
mk_fake_lea Context
ctxt Int
entry CFG
cfg i :: GenericInstruction AddressWord64 Register Prefix Opcode Int
i@(Instruction AddressWord64
addr Maybe Prefix
pre op :: Opcode
op@Opcode
MOV Maybe Operand
Nothing ops :: [Operand]
ops@[dst :: Operand
dst@(Memory GenericAddress Register
a Int
si),Immediate Word64
imm] Maybe Int
annot) =
    let l :: String
l = Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) Bool
True Word64
imm
        r :: Register
r = [Register]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Register
find_unused_register [Register]
register_set [GenericInstruction AddressWord64 Register Prefix Opcode Int
i] in
      [ Int -> String -> NASM_Line
NASM_Comment Int
2 String
"inserted"
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"MOV qword [Ltemp_storage_foxdec], " 
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r ]
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ Maybe Prefix -> String
forall a. Show a => Maybe a -> String
prefix_to_NASM Maybe Prefix
pre
        , String
"LEA "
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r
        , String
", [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
        , String
" ; 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
imm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l ] 
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"MOV " 
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True Operand
dst
        , String
", "
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r ]
      , String -> NASM_Line
NASM_Instruction (String -> NASM_Line) -> String -> NASM_Line
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ String
"MOV qword " 
        , Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
True (Operand -> String) -> Operand -> String
forall a b. (a -> b) -> a -> b
$ Register -> Operand
forall storage. storage -> GenericOperand storage
Storage Register
r
        , String
", [Ltemp_storage_foxdec]"]
      , Int -> String -> NASM_Line
NASM_Comment Int
2 String
"done" ]




-- | convert an operand to a NASM operand
operand_to_NASM :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Bool
-> Operand
-> String
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
is_addr (Storage Register
r)          = Register -> String
forall a. Show a => a -> String
show Register
r
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
is_addr (EffectiveAddress GenericAddress Register
a) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register
-> String
symbolize_address Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
is_addr (Memory GenericAddress Register
a Int
si)        = GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Int -> String
forall a storage label prefix annotation.
(Eq a, Num a, Show a, Show storage, Show label, Show prefix,
 Show annotation) =>
GenericInstruction label storage prefix Opcode annotation
-> a -> String
size_directive_to_NASM GenericInstruction AddressWord64 Register Prefix Opcode Int
i Int
si String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register
-> String
symbolize_address Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
operand_to_NASM Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i Bool
is_addr (Immediate Word64
imm)
  | Bool
is_addr      = Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register
-> String
symbolize_address Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i (Word64 -> GenericAddress Register
forall storage. Word64 -> GenericAddress storage
AddressImm Word64
imm)
  | Bool
otherwise    = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
imm


-- | convert the address of an operand to a NASM address
address_to_NASM :: GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM GenericInstruction AddressWord64 storage prefix opcode annotation
i a :: GenericAddress Register
a@(AddressPlus (AddressStorage Register
r) GenericAddress Register
a') = if Register -> Bool
is_segment_register Register
r then Register -> String
forall a. Show a => a -> String
show Register
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM' GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a' else GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM' GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a 
address_to_NASM GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a                                     = GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM' GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a

address_to_NASM' :: GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM' GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a = 
  case GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a of
    Maybe Word64
Nothing  -> GenericAddress Register -> String
forall a. Show a => GenericAddress a -> String
address_to_NASM'' GenericAddress Register
a
    Just Word64
imm -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
imm
 where
  address_to_NASM'' :: GenericAddress a -> String
address_to_NASM'' (AddressStorage a
r) = a -> String
forall a. Show a => a -> String
show a
r
  address_to_NASM'' (AddressImm Word64
i) = Word64 -> String
forall a. Show a => a -> String
show Word64
i
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressImm Word64
i))  = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm Word64
i
  address_to_NASM'' (AddressMinus (AddressStorage a
r) (AddressImm Word64
i)) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm (Word64
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
i)
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressStorage a
r1)) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1
  address_to_NASM'' (AddressPlus (AddressPlus (AddressStorage a
r) (AddressStorage a
r1)) (AddressImm Word64
i)) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm Word64
i
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressPlus (AddressStorage a
r1) (AddressImm Word64
i))) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm Word64
i
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressMinus (AddressStorage a
r1) (AddressImm Word64
i))) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm (Word64
0Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
i)
  address_to_NASM'' (AddressPlus (AddressTimes (AddressStorage a
r) (AddressImm Word64
i)) (AddressImm Word64
i1)) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm Word64
i1
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressTimes (AddressStorage a
r1) (AddressImm Word64
i))) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressPlus (AddressTimes (AddressStorage a
r1) (AddressImm Word64
i)) (AddressImm Word64
i1))) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm Word64
i1
  address_to_NASM'' (AddressPlus (AddressStorage a
r) (AddressMinus (AddressTimes (AddressStorage a
r1) (AddressImm Word64
i)) (AddressImm Word64
i1))) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
r1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm (Word64
0Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
i1)
  address_to_NASM'' (AddressTimes (AddressStorage a
r) (AddressImm Word64
i))  = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i
  address_to_NASM'' (AddressMinus (AddressTimes (AddressStorage a
r) (AddressImm Word64
i)) (AddressImm Word64
i1)) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" * " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
show_nasm_address_plus_imm (Word64
0Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-Word64
i1)
  address_to_NASM'' GenericAddress a
a           = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"TODO: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenericAddress a -> String
forall a. Show a => a -> String
show GenericAddress a
a

  show_nasm_address_plus_imm :: a -> String
show_nasm_address_plus_imm a
i = if Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i::Word64) Int
63 then String
" - 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex (a
0 a -> a -> a
forall a. Num a => a -> a -> a
- a
i) else String
" + 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
i



-- | convert size directive of an operand to a NASM size directive
size_directive_to_NASM :: GenericInstruction label storage prefix Opcode annotation
-> a -> String
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
_ a
1  = String
"byte"
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
_ a
2  = String
"word"
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
_ a
4  = String
"dword"
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
i a
8  
  | GenericInstruction label storage prefix Opcode annotation -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode GenericInstruction label storage prefix Opcode annotation
i Opcode -> [Opcode] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opcode
ADDSD,Opcode
SUBSD,Opcode
DIVSD,Opcode
MULSD,Opcode
COMISD,Opcode
UCOMISD,Opcode
MINSD,Opcode
MAXSD] = String
"" -- NASM does not want size directives for these instructions
  | Bool
otherwise = String
"qword"
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
_ a
10 = String
"tword"
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
i a
16
  | GenericInstruction label storage prefix Opcode annotation -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode GenericInstruction label storage prefix Opcode annotation
i Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
COMISD = String
""
  | GenericInstruction label storage prefix Opcode annotation -> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
opcode GenericInstruction label storage prefix Opcode annotation
i Opcode -> Opcode -> Bool
forall a. Eq a => a -> a -> Bool
== Opcode
COMISS = String
""
  | Bool
otherwise          = String
"oword" -- BUG in Capstone
size_directive_to_NASM GenericInstruction label storage prefix Opcode annotation
i a
x  = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Unknown size directive " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in instruction: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenericInstruction label storage prefix Opcode annotation -> String
forall a. Show a => a -> String
show GenericInstruction label storage prefix Opcode annotation
i

-- | convert opcode to a NASM opcode
opcode_to_NASM :: Opcode -> String
opcode_to_NASM Opcode
MOVABS = String
"MOV"
opcode_to_NASM Opcode
opcode = Opcode -> String
forall a. Show a => a -> String
show Opcode
opcode

-- | convert prefix to a NASM prefix
prefix_to_NASM :: Maybe a -> String
prefix_to_NASM Maybe a
Nothing    = String
""
prefix_to_NASM (Just a
pre) = a -> String
forall a. Show a => a -> String
show a
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "







----- SYMBOLIZATION -----


----- TEXT SECTIONS -----
-- | Symbolization of an address of an operand
symbolize_address :: Context -> Int -> CFG -> Instruction -> Address -> String
symbolize_address :: Context
-> Int
-> CFG
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register
-> String
symbolize_address Context
ctxt Int
entry CFG
cfg GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a =
  case Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) (Opcode -> Bool
isCall (Opcode -> Bool) -> Opcode -> Bool
forall a b. (a -> b) -> a -> b
$ GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Opcode
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation -> opcode
Instr.opcode GenericInstruction AddressWord64 Register Prefix Opcode Int
i) (Word64 -> Maybe String)
-> (Word64 -> Word64) -> Word64 -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Maybe String) -> Maybe Word64 -> Maybe (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register -> Maybe Word64
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
rip_relative_to_immediate GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a of
    Just (Just String
str) -> String
str
    Maybe (Maybe String)
_               -> 
      case Context
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register
-> Maybe String
forall storage prefix opcode annotation storage.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> GenericAddress storage
-> Maybe String
try_symbolize_base_of_address Context
ctxt GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a of
        Just String
str -> String
str
        Maybe String
_        -> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> GenericAddress Register -> String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM GenericInstruction AddressWord64 Register Prefix Opcode Int
i GenericAddress Register
a


try_symbolize_base_of_address :: Context
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
-> GenericAddress storage
-> Maybe String
try_symbolize_base_of_address Context
ctxt GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress storage
addr = GenericAddress storage -> Maybe String
forall storage. GenericAddress storage -> Maybe String
find_base GenericAddress storage
addr
 where
  find_base :: GenericAddress storage -> Maybe String
find_base (AddressImm Word64
imm)                  = Context -> Bool -> Word64 -> Maybe String
try_symbolize_base Context
ctxt Bool
True Word64
imm
  --find_base (AddressPlus (AddressImm imm) a') = mk_add a' <$> (try_symbolize_base ctxt False imm)
  --find_base (AddressPlus a' (AddressImm imm)) = mk_add a' <$> (try_symbolize_base ctxt False imm)
  find_base GenericAddress storage
_                                 = Maybe String
forall a. Maybe a
Nothing

  mk_add :: GenericAddress Register -> String -> String
mk_add GenericAddress Register
a' String
str = String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + " String -> String -> String
forall a. [a] -> [a] -> [a]
++ GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
forall storage prefix opcode annotation.
HasSize
  (GenericInstruction
     AddressWord64 storage prefix opcode annotation) =>
GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> String
address_to_NASM' GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
a'

-- | Symbolization of an immediate value that is used as an address
symbolize_immediate :: Context -> Maybe (Int,CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate :: Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt Maybe (Int, CFG)
entry_cfg Bool
is_call Word64
a =
  Maybe String
first Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Maybe String
second Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Context -> Word64 -> Maybe String
relocatable_symbol Context
ctxt Word64
a Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Context -> Bool -> Word64 -> Maybe String
try_symbolize_base Context
ctxt Bool
True Word64
a
 where
  (Maybe String
first,Maybe String
second) 
    | Bool
is_call   = (Maybe String
find_outside_cfg,Maybe (Int, CFG) -> Maybe String
forall a. (Integral a, Show a) => Maybe (a, CFG) -> Maybe String
find_inside_cfg Maybe (Int, CFG)
entry_cfg)
    | Bool
otherwise = (Maybe (Int, CFG) -> Maybe String
forall a. (Integral a, Show a) => Maybe (a, CFG) -> Maybe String
find_inside_cfg Maybe (Int, CFG)
entry_cfg,Maybe String
find_outside_cfg)

  -- search for a block in the current cfg that starts at @a@, and if found, make a label for it
  find_inside_cfg :: Maybe (a, CFG) -> Maybe String
find_inside_cfg Maybe (a, CFG)
Nothing            = Maybe String
forall a. Maybe a
Nothing 
  find_inside_cfg (Just (a
entry,CFG
cfg)) = ((Context -> a -> Word64 -> Int -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt a
entry Word64
a (Int -> String)
-> ((Int,
     [GenericInstruction AddressWord64 Register Prefix Opcode Int])
    -> Int)
-> (Int,
    [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int,
 [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> Int
forall a b. (a, b) -> a
fst) ((Int,
  [GenericInstruction AddressWord64 Register Prefix Opcode Int])
 -> String)
-> Maybe
     (Int,
      [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int,
  [GenericInstruction AddressWord64 Register Prefix Opcode Int])
 -> Bool)
-> [(Int,
     [GenericInstruction AddressWord64 Register Prefix Opcode Int])]
-> Maybe
     (Int,
      [GenericInstruction AddressWord64 Register Prefix Opcode Int])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Int,
 [GenericInstruction AddressWord64 Register Prefix Opcode Int])
-> Bool
forall prefix opcode storage annotation a.
(Eq prefix, Eq opcode, Eq storage, Eq annotation) =>
(a,
 [GenericInstruction
    AddressWord64 storage prefix opcode annotation])
-> Bool
block_starts_at (IntMap
  [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [(Int,
     [GenericInstruction AddressWord64 Register Prefix Opcode Int])]
forall a. IntMap a -> [(Int, a)]
IM.toList (IntMap
   [GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> [(Int,
      [GenericInstruction AddressWord64 Register Prefix Opcode Int])])
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [(Int,
     [GenericInstruction AddressWord64 Register Prefix Opcode Int])]
forall a b. (a -> b) -> a -> b
$ CFG
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
cfg_instrs CFG
cfg))
  -- seach for a block outside of the current cfg
  find_outside_cfg :: Maybe String
find_outside_cfg  = ((\Word64
a -> Context -> Word64 -> Word64 -> Integer -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt Word64
a Word64
a Integer
0) (Word64 -> String) -> Maybe Word64 -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64 -> Bool) -> [Word64] -> Maybe Word64
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(==) Word64
a) ((Int -> Word64) -> [Int] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Word64]) -> [Int] -> [Word64]
forall a b. (a -> b) -> a -> b
$ IntMap FReturnBehavior -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap FReturnBehavior -> [Int])
-> IntMap FReturnBehavior -> [Int]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap FReturnBehavior
ctxt_calls Context
ctxt))

  block_starts_at :: (a,
 [GenericInstruction
    AddressWord64 storage prefix opcode annotation])
-> Bool
block_starts_at (a
blockId, [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs) = [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs [GenericInstruction AddressWord64 storage prefix opcode annotation]
-> [GenericInstruction
      AddressWord64 storage prefix opcode annotation]
-> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof ([GenericInstruction AddressWord64 storage prefix opcode annotation]
-> GenericInstruction
     AddressWord64 storage prefix opcode annotation
forall a. [a] -> a
head [GenericInstruction AddressWord64 storage prefix opcode annotation]
instrs) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a


-- | Symbolize (try to) an immediate address falling into the range of a section
try_symbolize_base :: Context -> Bool -> Word64 -> Maybe String
try_symbolize_base Context
ctxt Bool
not_part_of_larger_expression Word64
imm = Maybe String
within_section Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Word64 -> Maybe String
forall a. Integral a => a -> Maybe String
try_internal Word64
imm Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` Word64 -> Maybe String
try_at_end_of_section Word64
imm
 where
  within_section :: Maybe String
within_section    = Word64 -> (String, String, Word64, Word64) -> String
forall a d.
(Integral a, Show a) =>
a -> (String, String, a, d) -> String
show_section_relative Word64
imm ((String, String, Word64, Word64) -> String)
-> Maybe (String, String, Word64, Word64) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> Word64 -> Maybe (String, String, Word64, Word64)
find_section_for_address Context
ctxt Word64
imm

  show_section_relative :: a -> (String, String, a, d) -> String
show_section_relative a
a sec :: (String, String, a, d)
sec@(String
segment,String
section,a
a0,d
_)
    | Bool
not_part_of_larger_expression = String -> String -> a -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
macro_name String
segment String
section a
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    | Bool
otherwise                     = String -> String -> a -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
section_label String
segment String
section a
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex (a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a0)

  try_internal :: a -> Maybe String
try_internal a
a = (\(Internal_Label String
str) -> String
str) (Symbol -> String) -> Maybe Symbol -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IntMap Symbol -> Maybe Symbol
forall a. Int -> IntMap a -> Maybe a
IM.lookup (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a) (IntMap Symbol -> Maybe Symbol) -> IntMap Symbol -> Maybe Symbol
forall a b. (a -> b) -> a -> b
$ (Symbol -> Bool) -> IntMap Symbol -> IntMap Symbol
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter Symbol -> Bool
is_internal_symbol (IntMap Symbol -> IntMap Symbol) -> IntMap Symbol -> IntMap Symbol
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt)

  try_at_end_of_section :: Word64 -> Maybe String
try_at_end_of_section Word64
a = (String, String, Word64, Word64) -> String
forall c d. (String, String, c, d) -> String
end_of_section_label ((String, String, Word64, Word64) -> String)
-> Maybe (String, String, Word64, Word64) -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((String, String, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64)]
-> Maybe (String, String, Word64, Word64)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> (String, String, Word64, Word64) -> Bool
forall a a b. (Eq a, Num a) => a -> (a, b, a, a) -> Bool
is_end_of_section Word64
a) ([(String, String, Word64, Word64)]
 -> Maybe (String, String, Word64, Word64))
-> [(String, String, Word64, Word64)]
-> Maybe (String, String, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ SectionsInfo -> [(String, String, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64)])
-> SectionsInfo -> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Context -> SectionsInfo
ctxt_sections Context
ctxt)

  is_end_of_section :: a -> (a, b, a, a) -> Bool
is_end_of_section a
a (a
_,b
_,a
a0,a
sz) = a
a0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
sz a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a





-- see if address matches an external symbol loaded at linking time
relocatable_symbol :: Context -> Word64 -> Maybe String
relocatable_symbol Context
ctxt Word64
a = (Int -> IntMap Symbol -> Maybe Symbol
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a) (Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt) Maybe Symbol -> (Symbol -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Symbol -> Maybe String
mk_symbol) Maybe String -> Maybe String -> Maybe String
forall a. Eq a => Maybe a -> Maybe a -> Maybe a
`orTry` ((Relocation -> Bool) -> Set Relocation -> Maybe Relocation
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> Relocation -> Bool
reloc_for Word64
a) (Context -> Set Relocation
ctxt_relocs Context
ctxt) Maybe Relocation -> (Relocation -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Relocation -> Maybe String
mk_reloc)
 where
  mk_symbol :: Symbol -> Maybe String
mk_symbol (Relocated_Function String
str) = String -> Maybe String
forall a. HasCallStack => String -> a
error (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Reading GOT entry of address " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a
  mk_symbol (Relocated_Label String
str)    = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> String
strip_GLIBC String
str
  mk_symbol (Internal_Label String
a)       = Maybe String
forall a. Maybe a
Nothing

  mk_reloc :: Relocation -> Maybe String
mk_reloc (Relocation Word64
a0 Word64
a1) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Context -> Integer -> Word64 -> Integer -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt Integer
0 Word64
a0 Integer
0

reloc_for :: Word64 -> Relocation -> Bool
reloc_for Word64
a (Relocation Word64
a0 Word64
a1) = Word64
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
a0

rip_relative_to_immediate :: GenericInstruction AddressWord64 storage prefix opcode annotation
-> GenericAddress Register -> Maybe Word64
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i (AddressImm Word64
imm)                                     = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word64
imm
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i (AddressPlus  (AddressStorage Register
RIP) (AddressImm Word64
imm)) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Int
forall a. HasSize a => a -> Int
sizeof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
imm
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i (AddressMinus (AddressStorage Register
RIP) (AddressImm Word64
imm)) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Int
forall a. HasSize a => a -> Int
sizeof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
imm
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i (AddressPlus  (AddressImm Word64
imm) (AddressStorage Register
RIP)) = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericInstruction AddressWord64 storage prefix opcode annotation
-> Int
forall a. HasSize a => a -> Int
sizeof GenericInstruction AddressWord64 storage prefix opcode annotation
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
imm
rip_relative_to_immediate GenericInstruction AddressWord64 storage prefix opcode annotation
i GenericAddress Register
_                                                    = Maybe Word64
forall a. Maybe a
Nothing

is_segment_register :: Register -> Bool
is_segment_register Register
r = Register
r Register -> [Register] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Register
CS,Register
DS,Register
ES,Register
FS,Register
GS,Register
SS]






----- DATA SECTIONS -----
mk_macros :: Context -> String
mk_macros Context
ctxt = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
macros [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
internals
 where
  -- macros used to compute addresses relative to beginning of sections
  -- EXAMPLE:
  --    %define RELA_.rodata_0x11000(offset) (L_.rodata_0x11000 + offset)
  macros :: [String]
macros = ((String, String, Word64, Word64) -> String)
-> [(String, String, Word64, Word64)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Word64, Word64) -> String
forall a d.
(Integral a, Show a) =>
(String, String, a, d) -> String
mk_macro ([(String, String, Word64, Word64)] -> [String])
-> [(String, String, Word64, Word64)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_data_section ((String, String, Word64, Word64) -> Bool)
-> ((String, String, Word64, Word64) -> Bool)
-> (String, String, Word64, Word64)
-> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| (String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_ro_data_section ((String, String, Word64, Word64) -> Bool)
-> ((String, String, Word64, Word64) -> Bool)
-> (String, String, Word64, Word64)
-> Bool
forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
||| (String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_bss_data_section) ([(String, String, Word64, Word64)]
 -> [(String, String, Word64, Word64)])
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ SectionsInfo -> [(String, String, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64)])
-> SectionsInfo -> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Context -> SectionsInfo
ctxt_sections Context
ctxt
  -- internal symbols that are defined outside of existing sections
  -- EXAMPLE:
  --    %define __TMC_END__ RELA_.data_0x17000(0x4)
  internals :: [String]
internals = ((Int, Symbol) -> [String]) -> [(Int, Symbol)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Symbol) -> [String]
mk_internal ([(Int, Symbol)] -> [String]) -> [(Int, Symbol)] -> [String]
forall a b. (a -> b) -> a -> b
$ ((Int, Symbol) -> Bool) -> [(Int, Symbol)] -> [(Int, Symbol)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int, Symbol) -> Bool
forall a b. Integral a => (a, b) -> Bool
is_outside_section ([(Int, Symbol)] -> [(Int, Symbol)])
-> [(Int, Symbol)] -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ IntMap Symbol -> [(Int, Symbol)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Symbol -> [(Int, Symbol)])
-> IntMap Symbol -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ (Symbol -> Bool) -> IntMap Symbol -> IntMap Symbol
forall a. (a -> Bool) -> IntMap a -> IntMap a
IM.filter Symbol -> Bool
is_internal_symbol (IntMap Symbol -> IntMap Symbol) -> IntMap Symbol -> IntMap Symbol
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Symbol
ctxt_symbol_table Context
ctxt

  is_outside_section :: (a, b) -> Bool
is_outside_section (a
a,b
_) = Context -> Word64 -> Maybe (String, String, Word64, Word64)
find_section_for_address Context
ctxt (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a) Maybe (String, String, Word64, Word64)
-> Maybe (String, String, Word64, Word64) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (String, String, Word64, Word64)
forall a. Maybe a
Nothing

  mk_internal :: (Int,Symbol) -> [String]
  mk_internal :: (Int, Symbol) -> [String]
mk_internal (Int
a,Internal_Label String
sym) = 
    case Int -> Maybe (String, String, Word64, Word64)
forall a. Integral a => a -> Maybe (String, String, Word64, Word64)
find_preceding_section Int
a of
      Maybe (String, String, Word64, Word64)
Nothing -> []
      Just (String
segment,String
section,Word64
a0,Word64
si) -> [String
"%define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sym String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> Word64 -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
macro_name String
segment String
section Word64
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
a0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"]
    
  find_preceding_section :: a -> Maybe (String, String, Word64, Word64)
find_preceding_section a
a =
    case ((String, String, Word64, Word64)
 -> (String, String, Word64, Word64) -> Ordering)
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a
-> (String, String, Word64, Word64)
-> (String, String, Word64, Word64)
-> Ordering
forall a a a b a b.
(Integral a, Num a, Ord a) =>
a -> (a, b, a, a) -> (a, b, a, a) -> Ordering
distance a
a) ([(String, String, Word64, Word64)]
 -> [(String, String, Word64, Word64)])
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> (String, String, Word64, Word64) -> Bool
forall a a a b.
(Integral a, Num a, Ord a) =>
a -> (a, b, a, a) -> Bool
is_after a
a) (SectionsInfo -> [(String, String, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64)])
-> SectionsInfo -> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Context -> SectionsInfo
ctxt_sections Context
ctxt) of
      []      -> Maybe (String, String, Word64, Word64)
forall a. Maybe a
Nothing
      ((String, String, Word64, Word64)
sec:[(String, String, Word64, Word64)]
_) -> (String, String, Word64, Word64)
-> Maybe (String, String, Word64, Word64)
forall a. a -> Maybe a
Just (String, String, Word64, Word64)
sec

  distance :: a -> (a, b, a, a) -> (a, b, a, a) -> Ordering
distance a
a (a
_,b
_,a
a0,a
si) (a
_,b
_,a
a0',a
si') = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a0 a -> a -> a
forall a. Num a => a -> a -> a
- a
si) (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a a -> a -> a
forall a. Num a => a -> a -> a
- a
a0' a -> a -> a
forall a. Num a => a -> a -> a
- a
si')
  is_after :: a -> (a, b, a, a) -> Bool
is_after a
a (a
_,b
_,a
a0,a
si) = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
a0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
si



  mk_macro :: (String, String, a, d) -> String
mk_macro (String
segment,String
section,a
a0,d
sz) = String
"%define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> a -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
macro_name String
segment String
section a
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(offset) (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> a -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
section_label String
segment String
section a
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" + offset)"

-- TODO to Base
(|||) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
||| :: (a -> Bool) -> (a -> Bool) -> a -> Bool
(|||) a -> Bool
p a -> Bool
q a
a = a -> Bool
p a
a Bool -> Bool -> Bool
|| a -> Bool
q a
a
infixr 2 |||





ro_data_section :: Context -> String
ro_data_section Context
ctxt = Context
-> ((String, String, Word64, Word64) -> Bool)
-> (Binary -> Word64 -> Int -> Maybe [Word8])
-> String
forall t t.
(Num t, Num t) =>
Context
-> ((String, String, Word64, Word64) -> Bool)
-> (Binary -> t -> t -> Maybe [Word8])
-> String
generic_data_section Context
ctxt (String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_ro_data_section Binary -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data
data_section :: Context -> String
data_section Context
ctxt    = Context
-> ((String, String, Word64, Word64) -> Bool)
-> (Binary -> Word64 -> Int -> Maybe [Word8])
-> String
forall t t.
(Num t, Num t) =>
Context
-> ((String, String, Word64, Word64) -> Bool)
-> (Binary -> t -> t -> Maybe [Word8])
-> String
generic_data_section Context
ctxt (String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_data_section    Binary -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_data

generic_data_section :: Context
-> ((String, String, Word64, Word64) -> Bool)
-> (Binary -> t -> t -> Maybe [Word8])
-> String
generic_data_section Context
ctxt (String, String, Word64, Word64) -> Bool
pick_section Binary -> t -> t -> Maybe [Word8]
read_from = 
  ((String, String, Word64, Word64) -> String)
-> [(String, String, Word64, Word64)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String, Word64, Word64) -> String
mk_data_section ([(String, String, Word64, Word64)] -> String)
-> [(String, String, Word64, Word64)] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, String, Word64, Word64) -> Bool
pick_section ([(String, String, Word64, Word64)]
 -> [(String, String, Word64, Word64)])
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ SectionsInfo -> [(String, String, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64)])
-> SectionsInfo -> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Context -> SectionsInfo
ctxt_sections Context
ctxt
 where
  mk_data_section :: (String, String, Word64, Word64) -> String
mk_data_section (String
segment,String
section,Word64
a0,Word64
sz) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
   [ String
"section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
section
   , String -> String -> Word64 -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
section_label String
segment String
section Word64
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" ]
   [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
   Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries Word64
0 String
segment String
section Word64
a0 Word64
sz
   [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
   [String
"\n\n"] 

  mk_data_entries :: Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries Word64
offset String
segment String
section Word64
a0 Word64
sz 
    | Word64
offset Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
sz = []
    | Word64
offset Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
sz = [(String, String, Integer, Integer) -> String
forall c d. (String, String, c, d) -> String
end_of_section_label (String
segment,String
section,Integer
0,Integer
0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"]
    | Bool
otherwise = 
      case Word64 -> Word64 -> Word64 -> [String]
forall t. Integral t => t -> t -> t -> [String]
takeWhileString Word64
offset Word64
a0 Word64
sz of
        []  -> Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries_no_string Word64
offset String
segment String
section Word64
a0 Word64
sz
        [String]
str -> let offset' :: Word64
offset' = Word64
offset Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
str) in
                 if Word64
offset' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
sz Bool -> Bool -> Bool
&& Word64 -> Word64 -> Word8
forall a. Integral a => a -> a -> Word8
read_byte Word64
offset' Word64
a0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 then
                   [String
"db `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", 0"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries (Word64
offset' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) String
segment String
section Word64
a0 Word64
sz
                 else
                   Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries_no_string Word64
offset String
segment String
section Word64
a0 Word64
sz

  mk_data_entries_no_string :: Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries_no_string Word64
offset String
segment String
section Word64
a0 Word64
sz =
    case Word64 -> Word64 -> Maybe Relocation
forall a. Integral a => a -> a -> Maybe Relocation
find_reloc Word64
offset Word64
a0 of
      Just (Relocation Word64
_ Word64
a1) ->  [Word64 -> String
mk_reloc_label (Word64
a0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
offset) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"dq " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
try_symbolize_imm Word64
a1] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries (Word64
offsetWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
8) String
segment String
section Word64
a0 Word64
sz
      Maybe Relocation
_ -> [String
"db 0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. (Integral a, Show a) => a -> String
showHex (Word64 -> Word64 -> Word8
forall a. Integral a => a -> a -> Word8
read_byte Word64
offset Word64
a0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"h"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Word64 -> String -> String -> Word64 -> Word64 -> [String]
mk_data_entries (Word64
offsetWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1) String
segment String
section Word64
a0 Word64
sz


  mk_reloc_label :: Word64 -> String
mk_reloc_label Word64
a0 = Context -> Integer -> Word64 -> Integer -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt Integer
0 Word64
a0 Integer
0

  takeWhileString :: t -> t -> t -> [String]
takeWhileString t
offset t
a0 t
sz
    | t -> t -> Maybe Relocation
forall a. Integral a => a -> a -> Maybe Relocation
find_reloc t
offset t
a0 Maybe Relocation -> Maybe Relocation -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Relocation
forall a. Maybe a
Nothing        = []
    | t
offset t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
sz                           = []
    | Char -> Bool
valid_char (Word8 -> Char
w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ t -> t -> Word8
forall a. Integral a => a -> a -> Word8
read_byte t
offset t
a0) = [Char -> String
escape (Char -> String) -> Char -> String
forall a b. (a -> b) -> a -> b
$ Word8 -> Char
w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ t -> t -> Word8
forall a. Integral a => a -> a -> Word8
read_byte t
offset t
a0] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ t -> t -> t -> [String]
takeWhileString (t
offsett -> t -> t
forall a. Num a => a -> a -> a
+t
1) t
a0 t
sz
    | Bool
otherwise                              = []

  valid_char :: Char -> Bool
valid_char Char
c = Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"!@#$%^&*()_-+={}[]:;|/?<>,. ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890'\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
escape_chars

  escape_chars :: String
escape_chars = String
"`\\\n\t"

  escape :: Char -> String
escape Char
'\\' = String
"\\\\"
  escape Char
'`'  = String
"\\`"
  escape Char
'\n'  = String
"\\n"
  escape Char
'\t'  = String
"\\t"
  escape Char
c    = [Char
c]



  find_reloc :: a -> a -> Maybe Relocation
find_reloc a
offset a
a0 = (Relocation -> Bool) -> Set Relocation -> Maybe Relocation
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> Relocation -> Bool
reloc_for (Word64 -> Relocation -> Bool) -> Word64 -> Relocation -> Bool
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
a0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
offset)) (Set Relocation -> Maybe Relocation)
-> Set Relocation -> Maybe Relocation
forall a b. (a -> b) -> a -> b
$ Context -> Set Relocation
ctxt_relocs Context
ctxt
  read_byte :: a -> a -> Word8
read_byte  a
offset a
a0 = 
    case Binary -> t -> t -> Maybe [Word8]
read_from (Context -> Binary
ctxt_binary Context
ctxt) (a -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> t) -> a -> t
forall a b. (a -> b) -> a -> b
$ a
a0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
offset) t
1 of
      Just [Word8
v] -> Word8
v

  try_symbolize_imm :: a -> String
try_symbolize_imm a
a1 = 
    case Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt Maybe (Int, CFG)
forall a. Maybe a
Nothing Bool
False (Word64 -> Maybe String) -> Word64 -> Maybe String
forall a b. (a -> b) -> a -> b
$ a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a1 of
      Just String
str -> if String
"RELA_.text" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
str then String
"ERROR: UNTRANSLATED ENTRY ADDRESS " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a1 else String
str 
      Maybe String
Nothing  -> String
"ERROR: could not symbolize relocated immediate value 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a1

bss_data_section :: Context -> String
bss_data_section Context
ctxt = 
  ((String, String, Word64, Word64) -> String)
-> [(String, String, Word64, Word64)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String, Word64, Word64) -> String
forall t. (Integral t, Show t) => (String, String, t, t) -> String
mk_bss_data_section ([(String, String, Word64, Word64)] -> String)
-> [(String, String, Word64, Word64)] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, String, Word64, Word64) -> Bool
forall c d. (String, String, c, d) -> Bool
is_bss_data_section ([(String, String, Word64, Word64)]
 -> [(String, String, Word64, Word64)])
-> [(String, String, Word64, Word64)]
-> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ SectionsInfo -> [(String, String, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64)])
-> SectionsInfo -> [(String, String, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ Context -> SectionsInfo
ctxt_sections Context
ctxt
 where
  mk_bss_data_section :: (String, String, t, t) -> String
mk_bss_data_section (String
segment,String
section,t
a0,t
sz) = String
"section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
section String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> t -> String
forall a. (Integral a, Show a) => String -> String -> a -> String
section_label String
segment String
section t
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> t -> t -> String
forall t.
(Integral t, Show t) =>
String -> String -> t -> t -> String
mk_bss String
segment String
section t
a0 t
sz

  mk_bss :: String -> String -> t -> t -> String
mk_bss String
segment String
section t
a0 t
sz =
    case [Word64] -> [Word64]
forall a. Ord a => [a] -> [a]
sort ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (Relocation -> Word64) -> [Relocation] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Relocation -> Word64
get_addr ([Relocation] -> [Word64]) -> [Relocation] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (Relocation -> Bool) -> [Relocation] -> [Relocation]
forall a. (a -> Bool) -> [a] -> [a]
filter (t -> t -> Relocation -> Bool
forall a. Integral a => a -> a -> Relocation -> Bool
was_relocated_and_in t
a0 t
sz) ([Relocation] -> [Relocation]) -> [Relocation] -> [Relocation]
forall a b. (a -> b) -> a -> b
$ Set Relocation -> [Relocation]
forall a. Set a -> [a]
S.toList (Set Relocation -> [Relocation]) -> Set Relocation -> [Relocation]
forall a b. (a -> b) -> a -> b
$ Context -> Set Relocation
ctxt_relocs Context
ctxt of
      [] ->  String
"resb " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
sz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String, Integer, Integer) -> String
forall c d. (String, String, c, d) -> String
end_of_section_label (String
segment,String
section,Integer
0,Integer
0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
      (Word64
a:[Word64]
_) -> String
"resb " String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show (Word64 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a t -> t -> t
forall a. Num a => a -> a -> a
- t
a0) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
mk_reloc_label Word64
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> t -> t -> String
mk_bss String
segment String
section (Word64 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a) (t
sz t -> t -> t
forall a. Num a => a -> a -> a
+ t
a0 t -> t -> t
forall a. Num a => a -> a -> a
- Word64 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)

  mk_reloc_label :: Word64 -> String
mk_reloc_label Word64
a0 = Context -> Integer -> Word64 -> Integer -> String
forall a a.
(Show a, Integral a, Show a) =>
Context -> a -> Word64 -> a -> String
block_label Context
ctxt Integer
0 Word64
a0 Integer
0



  get_addr :: Relocation -> Word64
get_addr (Relocation Word64
a0 Word64
_) = Word64
a0
  was_relocated_and_in :: a -> a -> Relocation -> Bool
was_relocated_and_in a
a0 a
sz (Relocation Word64
a Word64
a1) = a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a0 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
a Bool -> Bool -> Bool
&& Word64
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
a0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
sz)-- TODO note strict inequality here



-- Get an overview of all indirections (entry,cfg,i) where entry is the entry-point of the function, cfg is the CFG of the function and i is an in instruction that performs an indirection
get_indirections_per_function :: Context -> [(Int, CFG, (Int, Indirection))]
get_indirections_per_function Context
ctxt = (Int -> [(Int, CFG, (Int, Indirection))])
-> [Int] -> [(Int, CFG, (Int, Indirection))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> [(Int, CFG, (Int, Indirection))]
get ([Int] -> [(Int, CFG, (Int, Indirection))])
-> [Int] -> [(Int, CFG, (Int, Indirection))]
forall a b. (a -> b) -> a -> b
$ Set Int -> [Int]
forall a. Set a -> [a]
S.toList (Set Int -> [Int]) -> Set Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Context -> Set Int
ctxt_get_function_entries Context
ctxt
 where
  get :: Int -> [(Int, CFG, (Int, Indirection))]
get Int
entry =
    let Just CFG
cfg = Int -> IntMap CFG -> Maybe CFG
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
entry (Context -> IntMap CFG
ctxt_cfgs Context
ctxt) in
      ((Int, Indirection) -> (Int, CFG, (Int, Indirection)))
-> [(Int, Indirection)] -> [(Int, CFG, (Int, Indirection))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int, Indirection)
i -> (Int
entry,CFG
cfg,(Int, Indirection)
i)) ([(Int, Indirection)] -> [(Int, CFG, (Int, Indirection))])
-> [(Int, Indirection)] -> [(Int, CFG, (Int, Indirection))]
forall a b. (a -> b) -> a -> b
$ ((Int, Indirection) -> Bool)
-> [(Int, Indirection)] -> [(Int, Indirection)]
forall a. (a -> Bool) -> [a] -> [a]
filter (CFG -> (Int, Indirection) -> Bool
forall a b. Integral a => CFG -> (a, b) -> Bool
indirection_in_cfg CFG
cfg) ([(Int, Indirection)] -> [(Int, Indirection)])
-> [(Int, Indirection)] -> [(Int, Indirection)]
forall a b. (a -> b) -> a -> b
$ IntMap Indirection -> [(Int, Indirection)]
forall a. IntMap a -> [(Int, a)]
IM.assocs (IntMap Indirection -> [(Int, Indirection)])
-> IntMap Indirection -> [(Int, Indirection)]
forall a b. (a -> b) -> a -> b
$ Context -> IntMap Indirection
ctxt_inds Context
ctxt
  indirection_in_cfg :: CFG -> (a, b) -> Bool
indirection_in_cfg CFG
cfg (a
a,b
_) = ([GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> Bool)
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> Bool)
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\GenericInstruction AddressWord64 Register Prefix Opcode Int
i -> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> Word64
forall storage prefix opcode annotation.
GenericInstruction AddressWord64 storage prefix opcode annotation
-> Word64
addressof GenericInstruction AddressWord64 Register Prefix Opcode Int
i Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)) (IntMap
   [GenericInstruction AddressWord64 Register Prefix Opcode Int]
 -> Bool)
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Bool
forall a b. (a -> b) -> a -> b
$ CFG
-> IntMap
     [GenericInstruction AddressWord64 Register Prefix Opcode Int]
cfg_instrs CFG
cfg



mk_jump_table :: Context -> (Int, CFG, (a, Indirection)) -> String
mk_jump_table Context
ctxt (Int
entry,CFG
cfg,(a
a,Indirection_JumpTable (JumpTable Operand
index Int
bnd Operand
trgt IntMap Word64
tbl))) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ 
  [ String
"; JUMP TABLE: entry == " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. (Integral a, Show a) => a -> String
showHex Int
entry String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", instr@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a
  , String
"section .bss"
  , Int -> a -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_temp_storage Int
entry a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
  , String
"resb 16"
  , String
"section .rodata"
  , Int -> a -> String
forall a a.
(Integral a, Integral a, Show a, Show a) =>
a -> a -> String
label_jump_table_redirect_data Int
entry a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"]
  [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
  ((Int, Word64) -> String) -> [(Int, Word64)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Word64) -> String
forall a. Show a => (a, Word64) -> String
mk_entry (((Int, Word64) -> (Int, Word64) -> Ordering)
-> [(Int, Word64)] -> [(Int, Word64)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, Word64) -> Int)
-> (Int, Word64)
-> (Int, Word64)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Word64) -> Int
forall a b. (a, b) -> a
fst) ([(Int, Word64)] -> [(Int, Word64)])
-> [(Int, Word64)] -> [(Int, Word64)]
forall a b. (a -> b) -> a -> b
$ IntMap Word64 -> [(Int, Word64)]
forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap Word64
tbl)
 where
  mk_entry :: (a, Word64) -> String
mk_entry (a
idx,Word64
trgt) = 
    case Context -> Maybe (Int, CFG) -> Bool -> Word64 -> Maybe String
symbolize_immediate Context
ctxt ((Int, CFG) -> Maybe (Int, CFG)
forall a. a -> Maybe a
Just (Int
entry,CFG
cfg)) Bool
False Word64
trgt of
      Just String
str -> String
"dq " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ; index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
idx
      Maybe String
Nothing  -> String
"ERROR: cannot symbolize jump target:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
trgt
mk_jump_table Context
ctxt (Int
entry,CFG
cfg,(a
a,Indirection
_)) = []








regs_of_ops :: [Operand] -> [Register]
regs_of_ops []                       = []
regs_of_ops (Storage Register
r:[Operand]
ops)          = Register -> Register
real Register
r Register -> [Register] -> [Register]
forall a. a -> [a] -> [a]
: [Operand] -> [Register]
regs_of_ops [Operand]
ops
regs_of_ops (Immediate Word64
_:[Operand]
ops)        = [Operand] -> [Register]
regs_of_ops [Operand]
ops
regs_of_ops (EffectiveAddress GenericAddress Register
a:[Operand]
ops) = GenericAddress Register -> [Register]
forall a. GenericAddress a -> [a]
regs_of_address GenericAddress Register
a [Register] -> [Register] -> [Register]
forall a. [a] -> [a] -> [a]
++ [Operand] -> [Register]
regs_of_ops [Operand]
ops
regs_of_ops (Memory GenericAddress Register
a Int
si:[Operand]
ops)        = GenericAddress Register -> [Register]
forall a. GenericAddress a -> [a]
regs_of_address GenericAddress Register
a [Register] -> [Register] -> [Register]
forall a. [a] -> [a] -> [a]
++ [Operand] -> [Register]
regs_of_ops [Operand]
ops

regs_of_address :: GenericAddress a -> [a]
regs_of_address (AddressPlus  GenericAddress a
a0 GenericAddress a
a1) = GenericAddress a -> [a]
regs_of_address GenericAddress a
a0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ GenericAddress a -> [a]
regs_of_address GenericAddress a
a1
regs_of_address (AddressMinus GenericAddress a
a0 GenericAddress a
a1) = GenericAddress a -> [a]
regs_of_address GenericAddress a
a0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ GenericAddress a -> [a]
regs_of_address GenericAddress a
a1
regs_of_address (AddressTimes GenericAddress a
a0 GenericAddress a
a1) = GenericAddress a -> [a]
regs_of_address GenericAddress a
a0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ GenericAddress a -> [a]
regs_of_address GenericAddress a
a1
regs_of_address (AddressImm Word64
_)       = []
regs_of_address (AddressStorage a
r)   = [a
r]


register_set :: [Register]
register_set = [Register
RAX,Register
RBX,Register
RCX,Register
RDX,Register
R8,Register
R9,Register
R10,Register
R11,Register
R12,Register
R13,Register
R14,Register
R15]

reg_of_size :: Register -> a -> Register
reg_of_size Register
RAX  a
8 = Register
RAX
reg_of_size Register
RBX  a
8 = Register
RBX
reg_of_size Register
RCX  a
8 = Register
RCX
reg_of_size Register
RDX  a
8 = Register
RDX
reg_of_size Register
R8   a
8 = Register
R8
reg_of_size Register
R9   a
8 = Register
R9
reg_of_size Register
R10  a
8 = Register
R10
reg_of_size Register
R11  a
8 = Register
R11
reg_of_size Register
R12  a
8 = Register
R12
reg_of_size Register
R13  a
8 = Register
R13
reg_of_size Register
R14  a
8 = Register
R14
reg_of_size Register
R15  a
8 = Register
R15
reg_of_size Register
RAX  a
4 = Register
EAX
reg_of_size Register
RBX  a
4 = Register
EBX
reg_of_size Register
RCX  a
4 = Register
ECX
reg_of_size Register
RDX  a
4 = Register
EDX
reg_of_size Register
R8   a
4 = Register
R8D
reg_of_size Register
R9   a
4 = Register
R9D
reg_of_size Register
R10  a
4 = Register
R10D
reg_of_size Register
R11  a
4 = Register
R11D
reg_of_size Register
R12  a
4 = Register
R12D
reg_of_size Register
R13  a
4 = Register
R13D
reg_of_size Register
R14  a
4 = Register
R14D
reg_of_size Register
R15  a
4 = Register
R15D
reg_of_size Register
RAX  a
1 = Register
AL
reg_of_size Register
RBX  a
1 = Register
BL
reg_of_size Register
RCX  a
1 = Register
CL
reg_of_size Register
RDX  a
1 = Register
DL
reg_of_size Register
R8   a
1 = Register
R8B
reg_of_size Register
R9   a
1 = Register
R9B
reg_of_size Register
R10  a
1 = Register
R10B
reg_of_size Register
R11  a
1 = Register
R11B
reg_of_size Register
R12  a
1 = Register
R12B
reg_of_size Register
R13  a
1 = Register
R13B
reg_of_size Register
R14  a
1 = Register
R14B
reg_of_size Register
R15  a
1 = Register
R15B

reg_of_size Register
reg a
si = String -> Register
forall a. HasCallStack => String -> a
error (String -> Register) -> String -> Register
forall a b. (a -> b) -> a -> b
$ String
"Make register " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Register -> String
forall a. Show a => a -> String
show Register
reg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
si 

find_element_not_in :: [p] -> t p -> p
find_element_not_in (p
a:[p]
as) t p
x = if p
a p -> t p -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t p
x then [p] -> t p -> p
find_element_not_in [p]
as t p
x else p
a


find_unused_register :: [Register] -> [Instruction] -> Register
find_unused_register :: [Register]
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> Register
find_unused_register [Register]
regs [GenericInstruction AddressWord64 Register Prefix Opcode Int]
instrs = 
  let used_regs :: [Register]
used_regs = (GenericInstruction AddressWord64 Register Prefix Opcode Int
 -> [Register])
-> [GenericInstruction AddressWord64 Register Prefix Opcode Int]
-> [Register]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Operand] -> [Register]
regs_of_ops ([Operand] -> [Register])
-> (GenericInstruction AddressWord64 Register Prefix Opcode Int
    -> [Operand])
-> GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [Register]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericInstruction AddressWord64 Register Prefix Opcode Int
-> [Operand]
forall label storage prefix opcode annotation.
GenericInstruction label storage prefix opcode annotation
-> [GenericOperand storage]
get_ops) [GenericInstruction AddressWord64 Register Prefix Opcode Int]
instrs in
    [Register] -> [Register] -> Register
forall (t :: * -> *) p. (Foldable t, Eq p) => [p] -> t p -> p
find_element_not_in [Register]
regs [Register]
used_regs
 where
  get_ops :: GenericInstruction label storage prefix opcode annotation
-> [GenericOperand storage]
get_ops i :: GenericInstruction label storage prefix opcode annotation
i@(Instruction label
addr Maybe prefix
pre opcode
op Maybe (GenericOperand storage)
Nothing [GenericOperand storage]
ops Maybe annotation
annot) = [GenericOperand storage]
ops




-- | There is one specific symbol frequently encountered for which we cannot find the appropiate library to load.
-- It is related to debugging information (the -g option of GCC).
-- We therefore pvodie our own implementation: just a dummy, which is what the real function seems to do as well.
__gmon_start_implementation :: String
__gmon_start_implementation = String
"void __gmon_start__ () { return; }"