{-|
Module      : Conventions 
Description : In this file, we eumerate assumptions made on calling conventions and over external functions.
-}

module X86.Conventions where

import Base
import qualified Data.Map as M
import Debug.Trace
import X86.Register (Register(..))




-- | A list of function names of functions that never return.
is_exiting_function_call :: [Char] -> Bool
is_exiting_function_call [Char]
f =
  let f' :: [Char]
f' = [Char] -> [Char]
strip_GLIBC [Char]
f in 
    [Char]
f' [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [
      [Char]
"exit", [Char]
"_exit", [Char]
"__exit", [Char]
"___exit",
      [Char]
"error", [Char]
"_error",[Char]
"__error", 
      [Char]
"__stack_chk_fail", [Char]
"___stack_chk_fail",
      -- "__overflow", 
      [Char]
"abort", [Char]
"_abort",
      [Char]
"_fail",
      [Char]
"halt",
      [Char]
"_assert_fail", [Char]
"__assert_fail", [Char]
"___assert_fail", [Char]
"___assert_rtn",
      [Char]
"err", [Char]
"verr", [Char]
"errc", [Char]
"verrc", [Char]
"errx", [Char]
"verrx", 
      [Char]
"_err", [Char]
"_verr", [Char]
"_errc", [Char]
"_verrc", [Char]
"_errx", [Char]
"_verrx",
      [Char]
"obstack_alloc_failed_handler"
    ]

strip_GLIBC :: [Char] -> [Char]
strip_GLIBC = [Char] -> [Char] -> [Char]
takeUntilString [Char]
"@GLIBC" ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
takeUntilString [Char]
"@@GLIBC"



-- | Overview of sections with instructions.
sections_with_instructions :: [([Char], [Char])]
sections_with_instructions = [
   ([Char]
"__TEXT",[Char]
"__text"), -- TODO ELF
   ([Char]
"__TEXT",[Char]
"__stubs"),
   ([Char]
"__TEXT",[Char]
"__stub_helper"),
   ([Char]
"__DATA_CONST",[Char]
"__got"),
   ([Char]
"__DATA",[Char]
"__la_symbol_ptr"),
   ([Char]
"__DATA",[Char]
"__nl_symbol_ptr"),

   ([Char]
"",[Char]
".text"),
   ([Char]
"",[Char]
".init"),
   ([Char]
"",[Char]
".plt"),
   ([Char]
"",[Char]
".plt.got"),
   ([Char]
"",[Char]
".plt.sec"),
   ([Char]
"",[Char]
".fini")
 ]

-- | Sections in the following list are assumed not to be modifiable during execution, i.e., constant.
section_is_unwritable :: ([Char], [Char]) -> Bool
section_is_unwritable s :: ([Char], [Char])
s@([Char]
segname,[Char]
sect_name) = 
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
    [Char]
segname [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"__TEXT",[Char]
"__DATA_CONST"],
    ([Char], [Char])
s ([Char], [Char]) -> [([Char], [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ ([Char]
"__DATA",[Char]
"__got"), ([Char]
"__DATA",[Char]
"__const"), ([Char]
"",[Char]
".rodata") ],
    ([Char], [Char])
s ([Char], [Char]) -> [([Char], [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [([Char], [Char])]
sections_with_instructions
  ]



-- | A list if registers that are non-volatile, i.e., that must be preserved by a function (callee-saved)
callee_saved_registers :: [Register]
callee_saved_registers = [Register
RBX, Register
RBP, Register
RSP, Register
R12, Register
R13, Register
R14, Register
R15]


-- | A list of registers that may be used for return values
return_registers :: [Register]
return_registers = [Register
RAX]



-- | A list of registers used as parameters
parameter_registers :: [Register]
parameter_registers = [Register
RDI, Register
RSI, Register
RDX, Register
RCX, Register
R8, Register
R9]