{-# LANGUAGE PartialTypeSignatures , FlexibleContexts, StrictData, DeriveGeneric, StandaloneDeriving #-}
{-# OPTIONS_HADDOCK prune  #-}

{-|
Module      : NASM
Description : A datastructure for storing NASM code.
-}



module OutputGeneration.NASM.NASM where

import Base
import Data.X86.Opcode
import Data.X86.Instruction
import Data.Symbol
import Data.Size
import Data.JumpTarget
import Binary.Generic
import Data.X86.Register


import GHC.Generics
import qualified Data.Serialize as Cereal hiding (get,put,encode)
import Data.Aeson

import qualified Data.Set as S
import Data.Word
import Data.List
import Data.Bits (testBit)
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.ByteString.Internal (w2c)










-- | NASM contains external symbols, sections, and a footer
data NASM = NASM {
  NASM -> Set String
nasm_externals :: S.Set String,
  NASM -> Set String
nasm_globals   :: S.Set String,
  NASM -> [NASM_Section]
nasm_sections  :: [NASM_Section],
  NASM -> [String]
nasm_footer    :: [String]
 }
 deriving ((forall x. NASM -> Rep NASM x)
-> (forall x. Rep NASM x -> NASM) -> Generic NASM
forall x. Rep NASM x -> NASM
forall x. NASM -> Rep NASM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM -> Rep NASM x
from :: forall x. NASM -> Rep NASM x
$cto :: forall x. Rep NASM x -> NASM
to :: forall x. Rep NASM x -> NASM
Generic)

-- | A NASM label is either a string, or a macro. The latter is used when referring to addresses within data sections.
-- For example:
--
--    Macro "" ".data" 0x4000 0x23
--
-- refers to segment "", and the section ".data" that starts at immediate address 0x4000. So the real adress was 0x4023.
data NASM_Label = 
    Label Word64 String -- ^ Normal label
  | Macro String String Word64 Word64 -- ^ Macro into data section (segment, section, a0, offset)
 deriving (NASM_Label -> NASM_Label -> Bool
(NASM_Label -> NASM_Label -> Bool)
-> (NASM_Label -> NASM_Label -> Bool) -> Eq NASM_Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NASM_Label -> NASM_Label -> Bool
== :: NASM_Label -> NASM_Label -> Bool
$c/= :: NASM_Label -> NASM_Label -> Bool
/= :: NASM_Label -> NASM_Label -> Bool
Eq,Eq NASM_Label
Eq NASM_Label =>
(NASM_Label -> NASM_Label -> Ordering)
-> (NASM_Label -> NASM_Label -> Bool)
-> (NASM_Label -> NASM_Label -> Bool)
-> (NASM_Label -> NASM_Label -> Bool)
-> (NASM_Label -> NASM_Label -> Bool)
-> (NASM_Label -> NASM_Label -> NASM_Label)
-> (NASM_Label -> NASM_Label -> NASM_Label)
-> Ord NASM_Label
NASM_Label -> NASM_Label -> Bool
NASM_Label -> NASM_Label -> Ordering
NASM_Label -> NASM_Label -> NASM_Label
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NASM_Label -> NASM_Label -> Ordering
compare :: NASM_Label -> NASM_Label -> Ordering
$c< :: NASM_Label -> NASM_Label -> Bool
< :: NASM_Label -> NASM_Label -> Bool
$c<= :: NASM_Label -> NASM_Label -> Bool
<= :: NASM_Label -> NASM_Label -> Bool
$c> :: NASM_Label -> NASM_Label -> Bool
> :: NASM_Label -> NASM_Label -> Bool
$c>= :: NASM_Label -> NASM_Label -> Bool
>= :: NASM_Label -> NASM_Label -> Bool
$cmax :: NASM_Label -> NASM_Label -> NASM_Label
max :: NASM_Label -> NASM_Label -> NASM_Label
$cmin :: NASM_Label -> NASM_Label -> NASM_Label
min :: NASM_Label -> NASM_Label -> NASM_Label
Ord,(forall x. NASM_Label -> Rep NASM_Label x)
-> (forall x. Rep NASM_Label x -> NASM_Label) -> Generic NASM_Label
forall x. Rep NASM_Label x -> NASM_Label
forall x. NASM_Label -> Rep NASM_Label x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Label -> Rep NASM_Label x
from :: forall x. NASM_Label -> Rep NASM_Label x
$cto :: forall x. Rep NASM_Label x -> NASM_Label
to :: forall x. Rep NASM_Label x -> NASM_Label
Generic)


-- | A NASM section is either a NASM text section or NASM data section
data NASM_Section = NASM_Section_Text NASM_TextSection | NASM_Section_Data [NASM_DataSection]
  deriving (forall x. NASM_Section -> Rep NASM_Section x)
-> (forall x. Rep NASM_Section x -> NASM_Section)
-> Generic NASM_Section
forall x. Rep NASM_Section x -> NASM_Section
forall x. NASM_Section -> Rep NASM_Section x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Section -> Rep NASM_Section x
from :: forall x. NASM_Section -> Rep NASM_Section x
$cto :: forall x. Rep NASM_Section x -> NASM_Section
to :: forall x. Rep NASM_Section x -> NASM_Section
Generic

-- | An annotation consists of an address that is being symbolized to a label and an offset.
-- The offset will often be 0.
-- For example:
--   0x1016 --> L1000_2
--   0x4028 --> L_.bss_0x4020 + 0x8
-- Annotations translate to NASM comments, and have no effect on the actual NASM itself.
type Annot = [(Word64,NASM_Label,Word64)]

-- | A NASM text section contains a name and an **ordered** list of basic blocks.
-- Each basic block has an ID and a list of lines.
data NASM_TextSection = NASM_TextSection  {
  NASM_TextSection -> String
nasm_function_name  :: String,
  NASM_TextSection -> [(Int, [NASM_Line])]
nasm_blocks         :: [(Int,[NASM_Line])], -- ^ A mapping of blockIDs to instructions
  NASM_TextSection -> IntMap IntSet
nasm_cfg            :: IM.IntMap (IS.IntSet)
 }
  deriving (forall x. NASM_TextSection -> Rep NASM_TextSection x)
-> (forall x. Rep NASM_TextSection x -> NASM_TextSection)
-> Generic NASM_TextSection
forall x. Rep NASM_TextSection x -> NASM_TextSection
forall x. NASM_TextSection -> Rep NASM_TextSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_TextSection -> Rep NASM_TextSection x
from :: forall x. NASM_TextSection -> Rep NASM_TextSection x
$cto :: forall x. Rep NASM_TextSection x -> NASM_TextSection
to :: forall x. Rep NASM_TextSection x -> NASM_TextSection
Generic


-- | A NASM line is either a comment, an instruction or a label
data NASM_Line = 
    NASM_Comment Int String    -- ^ A comment with an indentation level (number of spaces)
  | NASM_Line NASM_Instruction -- ^ An instruction with an annotation
  | NASM_Label NASM_Label      -- ^ A label
 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
$c== :: NASM_Line -> NASM_Line -> Bool
== :: NASM_Line -> NASM_Line -> Bool
$c/= :: NASM_Line -> NASM_Line -> Bool
/= :: NASM_Line -> NASM_Line -> Bool
Eq,(forall x. NASM_Line -> Rep NASM_Line x)
-> (forall x. Rep NASM_Line x -> NASM_Line) -> Generic NASM_Line
forall x. Rep NASM_Line x -> NASM_Line
forall x. NASM_Line -> Rep NASM_Line x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Line -> Rep NASM_Line x
from :: forall x. NASM_Line -> Rep NASM_Line x
$cto :: forall x. Rep NASM_Line x -> NASM_Line
to :: forall x. Rep NASM_Line x -> NASM_Line
Generic)


-- | An instruction consists of a prefix, an opcode, a list of operands, a comment (possibly empty) and an annotation (possibly empty).
data NASM_Instruction = NASM_Instruction
  {
    NASM_Instruction -> Maybe Prefix
nasm_prefix   :: Maybe Prefix
  , NASM_Instruction -> Maybe Opcode
nasm_mnemonic :: Maybe Opcode
  , NASM_Instruction -> [NASM_Operand]
nasm_operands :: [NASM_Operand]
  , NASM_Instruction -> String
nasm_comment  :: String
  , NASM_Instruction -> Annot
nasm_annot    :: Annot
  }
 deriving (NASM_Instruction -> NASM_Instruction -> Bool
(NASM_Instruction -> NASM_Instruction -> Bool)
-> (NASM_Instruction -> NASM_Instruction -> Bool)
-> Eq NASM_Instruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NASM_Instruction -> NASM_Instruction -> Bool
== :: NASM_Instruction -> NASM_Instruction -> Bool
$c/= :: NASM_Instruction -> NASM_Instruction -> Bool
/= :: NASM_Instruction -> NASM_Instruction -> Bool
Eq,(forall x. NASM_Instruction -> Rep NASM_Instruction x)
-> (forall x. Rep NASM_Instruction x -> NASM_Instruction)
-> Generic NASM_Instruction
forall x. Rep NASM_Instruction x -> NASM_Instruction
forall x. NASM_Instruction -> Rep NASM_Instruction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Instruction -> Rep NASM_Instruction x
from :: forall x. NASM_Instruction -> Rep NASM_Instruction x
$cto :: forall x. Rep NASM_Instruction x -> NASM_Instruction
to :: forall x. Rep NASM_Instruction x -> NASM_Instruction
Generic)


-- | A size directive for a memory operand in bytes. For example (4,True) is the size directive for a 4-byte memory operand.
-- It can be `False` to indicate that the operand should not be rendered (e.g, in case of an LEA instruction).
type NASM_SizeDir = (Int,Bool)

data NASM_Operand = 
    NASM_Operand_Address NASM_Address
  | NASM_Operand_EffectiveAddress NASM_Address
  | NASM_Operand_Reg Register
  | NASM_Operand_Memory NASM_SizeDir NASM_Address
  | NASM_Operand_Immediate Immediate
 deriving (NASM_Operand -> NASM_Operand -> Bool
(NASM_Operand -> NASM_Operand -> Bool)
-> (NASM_Operand -> NASM_Operand -> Bool) -> Eq NASM_Operand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NASM_Operand -> NASM_Operand -> Bool
== :: NASM_Operand -> NASM_Operand -> Bool
$c/= :: NASM_Operand -> NASM_Operand -> Bool
/= :: NASM_Operand -> NASM_Operand -> Bool
Eq,(forall x. NASM_Operand -> Rep NASM_Operand x)
-> (forall x. Rep NASM_Operand x -> NASM_Operand)
-> Generic NASM_Operand
forall x. Rep NASM_Operand x -> NASM_Operand
forall x. NASM_Operand -> Rep NASM_Operand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Operand -> Rep NASM_Operand x
from :: forall x. NASM_Operand -> Rep NASM_Operand x
$cto :: forall x. Rep NASM_Operand x -> NASM_Operand
to :: forall x. Rep NASM_Operand x -> NASM_Operand
Generic)


-- | An address can either be a computation or some symbol.
data NASM_Address = NASM_Addr_Compute NASM_Address_Computation | NASM_Addr_Symbol Symbol | NASM_Addr_Label NASM_Label (Maybe Word64) | NASM_JumpTarget ResolvedJumpTarget
 deriving (NASM_Address -> NASM_Address -> Bool
(NASM_Address -> NASM_Address -> Bool)
-> (NASM_Address -> NASM_Address -> Bool) -> Eq NASM_Address
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NASM_Address -> NASM_Address -> Bool
== :: NASM_Address -> NASM_Address -> Bool
$c/= :: NASM_Address -> NASM_Address -> Bool
/= :: NASM_Address -> NASM_Address -> Bool
Eq,(forall x. NASM_Address -> Rep NASM_Address x)
-> (forall x. Rep NASM_Address x -> NASM_Address)
-> Generic NASM_Address
forall x. Rep NASM_Address x -> NASM_Address
forall x. NASM_Address -> Rep NASM_Address x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_Address -> Rep NASM_Address x
from :: forall x. NASM_Address -> Rep NASM_Address x
$cto :: forall x. Rep NASM_Address x -> NASM_Address
to :: forall x. Rep NASM_Address x -> NASM_Address
Generic)


-- | An address computation within an operand. The computation is: segment + [base + index*scale + disp]
data NASM_Address_Computation = NASM_Address_Computation
  {
    NASM_Address_Computation -> Maybe Register
nasm_segment  :: Maybe Register
  , NASM_Address_Computation -> Maybe Register
nasm_index    :: Maybe Register
  , NASM_Address_Computation -> Word64
nasm_scale    :: Word64
  , NASM_Address_Computation -> Maybe Register
nasm_base     :: Maybe Register
  , NASM_Address_Computation -> Maybe Word64
nasm_displace :: Maybe Word64
  }
 deriving (NASM_Address_Computation -> NASM_Address_Computation -> Bool
(NASM_Address_Computation -> NASM_Address_Computation -> Bool)
-> (NASM_Address_Computation -> NASM_Address_Computation -> Bool)
-> Eq NASM_Address_Computation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NASM_Address_Computation -> NASM_Address_Computation -> Bool
== :: NASM_Address_Computation -> NASM_Address_Computation -> Bool
$c/= :: NASM_Address_Computation -> NASM_Address_Computation -> Bool
/= :: NASM_Address_Computation -> NASM_Address_Computation -> Bool
Eq,(forall x.
 NASM_Address_Computation -> Rep NASM_Address_Computation x)
-> (forall x.
    Rep NASM_Address_Computation x -> NASM_Address_Computation)
-> Generic NASM_Address_Computation
forall x.
Rep NASM_Address_Computation x -> NASM_Address_Computation
forall x.
NASM_Address_Computation -> Rep NASM_Address_Computation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NASM_Address_Computation -> Rep NASM_Address_Computation x
from :: forall x.
NASM_Address_Computation -> Rep NASM_Address_Computation x
$cto :: forall x.
Rep NASM_Address_Computation x -> NASM_Address_Computation
to :: forall x.
Rep NASM_Address_Computation x -> NASM_Address_Computation
Generic)



-- | A data section consists of a list of data section entries.
-- Each DataEntry stores its address and a value.
data NASM_DataEntry =
    DataEntry_Byte Word64 Word8                   -- ^ A single byte
  | DataEntry_String Word64 [Word8]               -- ^ A string of characters (Word8) 
  | DataEntry_Pointer Word64 (NASM_Address,Annot) -- ^ A pointer (a label or external symbol)
  | DataEntry_BSS Int                             -- ^ A BSS section with a given size in bytes
 deriving ((forall x. NASM_DataEntry -> Rep NASM_DataEntry x)
-> (forall x. Rep NASM_DataEntry x -> NASM_DataEntry)
-> Generic NASM_DataEntry
forall x. Rep NASM_DataEntry x -> NASM_DataEntry
forall x. NASM_DataEntry -> Rep NASM_DataEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_DataEntry -> Rep NASM_DataEntry x
from :: forall x. NASM_DataEntry -> Rep NASM_DataEntry x
$cto :: forall x. Rep NASM_DataEntry x -> NASM_DataEntry
to :: forall x. Rep NASM_DataEntry x -> NASM_DataEntry
Generic)

-- | A data section then consists of:
data NASM_DataSection = NASM_DataSection {
  NASM_DataSection -> (String, String, Word64)
nasm_data_section :: (String,String,Word64),              -- ^ (segment,section,address)
  NASM_DataSection -> Int
nasm_data_section_align :: Int,                           -- ^ The alignment (0 if unknown)
  NASM_DataSection -> IntMap (Set NASM_Label)
nasm_data_section_labels :: IM.IntMap (S.Set NASM_Label), -- ^ Used internally only
  NASM_DataSection -> [NASM_DataEntry]
nasm_data_section_data :: [NASM_DataEntry]                -- ^ A list of DataEntries
}
 deriving ((forall x. NASM_DataSection -> Rep NASM_DataSection x)
-> (forall x. Rep NASM_DataSection x -> NASM_DataSection)
-> Generic NASM_DataSection
forall x. Rep NASM_DataSection x -> NASM_DataSection
forall x. NASM_DataSection -> Rep NASM_DataSection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NASM_DataSection -> Rep NASM_DataSection x
from :: forall x. NASM_DataSection -> Rep NASM_DataSection x
$cto :: forall x. Rep NASM_DataSection x -> NASM_DataSection
to :: forall x. Rep NASM_DataSection x -> NASM_DataSection
Generic)



instance Cereal.Serialize NASM_Label
instance Cereal.Serialize NASM_Section
instance Cereal.Serialize NASM_TextSection
instance Cereal.Serialize NASM_Line
instance Cereal.Serialize NASM_Instruction
instance Cereal.Serialize NASM_Operand
instance Cereal.Serialize NASM_Address
instance Cereal.Serialize NASM_Address_Computation
instance Cereal.Serialize NASM_DataEntry
instance Cereal.Serialize NASM_DataSection
instance Cereal.Serialize NASM






label_to_operand :: NASM_Label -> NASM_Operand
label_to_operand NASM_Label
l = NASM_Address -> NASM_Operand
NASM_Operand_Address (NASM_Address -> NASM_Operand) -> NASM_Address -> NASM_Operand
forall a b. (a -> b) -> a -> b
$ NASM_Label -> Maybe Word64 -> NASM_Address
NASM_Addr_Label NASM_Label
l Maybe Word64
forall a. Maybe a
Nothing
label_to_mem_operand :: NASM_SizeDir -> NASM_Label -> NASM_Operand
label_to_mem_operand NASM_SizeDir
sizedir NASM_Label
l = NASM_SizeDir -> NASM_Address -> NASM_Operand
NASM_Operand_Memory NASM_SizeDir
sizedir (NASM_Address -> NASM_Operand) -> NASM_Address -> NASM_Operand
forall a b. (a -> b) -> a -> b
$ NASM_Label -> Maybe Word64 -> NASM_Address
NASM_Addr_Label NASM_Label
l Maybe Word64
forall a. Maybe a
Nothing
label_to_eff_operand :: NASM_Label -> NASM_Operand
label_to_eff_operand NASM_Label
l = NASM_Address -> NASM_Operand
NASM_Operand_EffectiveAddress (NASM_Address -> NASM_Operand) -> NASM_Address -> NASM_Operand
forall a b. (a -> b) -> a -> b
$ NASM_Label -> Maybe Word64 -> NASM_Address
NASM_Addr_Label NASM_Label
l Maybe Word64
forall a. Maybe a
Nothing


mk_nasm_instr :: Opcode -> [NASM_Operand] -> NASM_Instruction
mk_nasm_instr Opcode
m [NASM_Operand]
ops = Maybe Prefix
-> Maybe Opcode
-> [NASM_Operand]
-> String
-> Annot
-> NASM_Instruction
NASM_Instruction Maybe Prefix
forall a. Maybe a
Nothing (Opcode -> Maybe Opcode
forall a. a -> Maybe a
Just Opcode
m) [NASM_Operand]
ops String
"" []


empty_address :: NASM_Address_Computation
empty_address =  Maybe Register
-> Maybe Register
-> Word64
-> Maybe Register
-> Maybe Word64
-> NASM_Address_Computation
NASM_Address_Computation Maybe Register
forall a. Maybe a
Nothing Maybe Register
forall a. Maybe a
Nothing Word64
1 Maybe Register
forall a. Maybe a
Nothing Maybe Word64
forall a. Maybe a
Nothing



(withAnnot :: NASM_Instruction -> Annot -> NASM_Instruction
withAnnot) NASM_Instruction
instr Annot
annot = NASM_Instruction
instr { nasm_annot = nasm_annot instr ++ annot }
(withComment :: NASM_Instruction -> String -> NASM_Instruction
withComment) NASM_Instruction
instr String
comment = NASM_Instruction
instr {nasm_comment = nasm_comment instr ++ comment }




-- Pretty printing
instance Show NASM_DataSection where
  show :: NASM_DataSection -> String
show (NASM_DataSection (String
seg,String
sec,Word64
a0) Int
align IntMap (Set NASM_Label)
labels [NASM_DataEntry]
entries) = String
"section " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sec String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall {a}. (Eq a, Num a, Show a) => a -> String
show_align Int
align String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [NASM_DataEntry] -> String
show_data Int
0 [NASM_DataEntry]
entries
   where
    show_data :: Int -> [NASM_DataEntry] -> String
show_data Int
n []     = Int -> String
show_label Int
n
    show_data Int
n (NASM_DataEntry
e:[NASM_DataEntry]
es) = Int -> String
show_label Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_DataEntry -> String
show_entry NASM_DataEntry
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> [NASM_DataEntry] -> String
show_data (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ NASM_DataEntry -> Int
entry_length NASM_DataEntry
e) [NASM_DataEntry]
es 

    entry_length :: NASM_DataEntry -> Int
entry_length (DataEntry_Byte Word64
_ Word8
_)      = Int
1
    entry_length (DataEntry_String Word64
_ [Word8]
str)  = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
str Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    entry_length (DataEntry_Pointer Word64
_ (NASM_Address, Annot)
_)   = Int
8
    entry_length (DataEntry_BSS Int
sz)        = Int
sz

    show_label :: Int -> String
show_label Int
n =
      case Int -> IntMap (Set NASM_Label) -> Maybe (Set NASM_Label)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
n IntMap (Set NASM_Label)
labels of
        Maybe (Set NASM_Label)
Nothing     -> String
""
        Just Set NASM_Label
labels -> (NASM_Label -> String) -> [NASM_Label] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\NASM_Label
l -> NASM_Label -> String
forall a. Show a => a -> String
show NASM_Label
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n") ([NASM_Label] -> String) -> [NASM_Label] -> String
forall a b. (a -> b) -> a -> b
$ Set NASM_Label -> [NASM_Label]
forall a. Set a -> [a]
S.toList Set NASM_Label
labels

    show_entry :: NASM_DataEntry -> String
show_entry (DataEntry_Byte Word64
_ Word8
b)              = String
"db 0" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall {a}. Integral a => a -> String
showHex Word8
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"h"
    show_entry (DataEntry_String Word64
_ [Word8]
str)          = String
"db `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
word8s_to_string [Word8]
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", 0"
    show_entry (DataEntry_Pointer Word64
_ (NASM_Address
ptr,Annot
annot)) = String
"dq " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
ptr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Annot -> String
render_annot Annot
annot
    show_entry (DataEntry_BSS Int
sz)                = String
"resb " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sz

    show_align :: a -> String
show_align a
0 = String
""
    show_align a
n = String
" align=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n

word8s_to_string :: [Word8] -> String
word8s_to_string = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char -> String
escape (Char -> String) -> (Word8 -> Char) -> Word8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Char
w2c) 
 where
  escape :: Char -> String
escape Char
'\\' = String
"\\\\"
  escape Char
'`'  = String
"\\`"
  escape Char
'\n'  = String
"\\n"
  escape Char
'\t'  = String
"\\t"
  escape Char
c    = [Char
c]

instance Show NASM_TextSection where
  show :: NASM_TextSection -> String
show (NASM_TextSection String
f [(Int, [NASM_Line])]
blocks IntMap IntSet
_) = [String] -> String
comment_block [String
"Function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f] 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}. Show a => (a, [a]) -> String
render_block [(Int, [NASM_Line])]
blocks) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
   where
    render_block :: (a, [a]) -> String
render_block (a
blockID,[a]
lines) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
lines

    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] -> String
forall {t :: * -> *} {t :: * -> *} {a}.
(Foldable t, Foldable t) =>
t (t a) -> String
comment_block_delim [String]
strs 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] -> String
forall {t :: * -> *} {t :: * -> *} {a}.
(Foldable t, Foldable t) =>
t (t a) -> String
comment_block_delim [String]
strs,String
""])
    comment_block_delim :: t (t a) -> String
comment_block_delim t (t a)
strs = String -> String
comment (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t a -> Int) -> t a -> Int
forall a b. (a -> b) -> a -> b
$ t (t a) -> t a
forall {t :: * -> *} {t :: * -> *} {a}.
(Foldable t, Foldable t) =>
t (t a) -> t a
max t (t a)
strs) Char
'-' 
    max :: t (t a) -> t a
max t (t a)
strs = (t a -> t a -> Ordering) -> t (t a) -> t a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy t a -> t a -> Ordering
forall {t :: * -> *} {t :: * -> *} {a} {a}.
(Foldable t, Foldable t) =>
t a -> t a -> Ordering
compare_lengths t (t a)
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 a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
str0) (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
str1)



instance Show NASM_Line where
  show :: NASM_Line -> String
show (NASM_Line NASM_Instruction
i) = String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Instruction -> String
forall a. Show a => a -> String
show NASM_Instruction
i
  show (NASM_Label NASM_Label
str) = NASM_Label -> String
forall a. Show a => a -> String
show NASM_Label
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
  show (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 -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str


instance Show NASM_Instruction where
  show :: NASM_Instruction -> String
show (NASM_Instruction Maybe Prefix
pre Maybe Opcode
m [NASM_Operand]
ops String
comment Annot
annot) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) String
"") [ Maybe Prefix -> String
show_prefix Maybe Prefix
pre, Maybe Opcode -> String
show_mnemonic Maybe Opcode
m, [NASM_Operand] -> String
show_ops [NASM_Operand]
ops]
    , String
mk_comment
    ]
   where
    show_prefix :: Maybe Prefix -> String
show_prefix Maybe Prefix
Nothing  = String
""
    show_prefix (Just Prefix
PrefixRep) = String
"REPZ"
    show_prefix (Just Prefix
PrefixRepNE) = String
"REPNE"
    show_prefix (Just Prefix
p) = Prefix -> String
forall a. Show a => a -> String
show Prefix
p

    show_mnemonic :: Maybe Opcode -> String
show_mnemonic Maybe Opcode
Nothing  = String
""
    -- NOT NEEDED, JUST FOR EASY DIFF
    show_mnemonic (Just Opcode
JZ) = String
"JE"
    show_mnemonic (Just Opcode
JNZ) = String
"JNE"
    show_mnemonic (Just Opcode
SETNBE) = String
"SETA"
    show_mnemonic (Just Opcode
CMOVZ) = String
"CMOVE"
    show_mnemonic (Just Opcode
CMOVNZ) = String
"CMOVNE"
    show_mnemonic (Just Opcode
SETNLE) = String
"SETG"
    show_mnemonic (Just Opcode
p) = Opcode -> String
forall a. Show a => a -> String
show Opcode
p
 
    show_ops :: [NASM_Operand] -> String
show_ops = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> ([NASM_Operand] -> [String]) -> [NASM_Operand] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NASM_Operand -> String) -> [NASM_Operand] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map NASM_Operand -> String
show_op

    mk_comment :: String
mk_comment =
      let str :: String
str = Annot -> String
render_annot Annot
annot in
        if String
comment String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
&& String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] then String
""
        else if String
comment String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then String
" ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
comment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
        else if String
comment String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== [] then String
"    ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
        else String
" ; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
comment

    instr_op_size :: ByteSize
instr_op_size =
      case (NASM_Operand -> Bool)
-> [NASM_Operand] -> ([NASM_Operand], [NASM_Operand])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition NASM_Operand -> Bool
isImmediate [NASM_Operand]
ops of
        ([NASM_Operand]
_,(NASM_Operand
op:[NASM_Operand]
_))  -> NASM_Operand -> ByteSize
operand_size NASM_Operand
op
        ([NASM_Operand
imm],[])  -> NASM_Operand -> ByteSize
operand_size NASM_Operand
imm

    isImmediate :: NASM_Operand -> Bool
isImmediate (NASM_Operand_Immediate Immediate
_) = Bool
True
    isImmediate NASM_Operand
_                          = Bool
False

    show_op :: NASM_Operand -> String
show_op (NASM_Operand_Reg Register
r)              = Register -> String
forall a. Show a => a -> String
show Register
r
    show_op (NASM_Operand_Address NASM_Address
a)          = NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a
    show_op (NASM_Operand_EffectiveAddress NASM_Address
a) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    show_op (NASM_Operand_Memory NASM_SizeDir
sizedir NASM_Address
a)   = NASM_SizeDir -> String
forall {a}. (Eq a, Num a) => (a, Bool) -> String
show_nasm_sizedir NASM_SizeDir
sizedir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    show_op (NASM_Operand_Immediate (Immediate (BitSize Int
si) Word64
imm)) = 
      case (ByteSize
instr_op_size,Int
si) of
        (ByteSize Int
16,Int
64) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
16,Int
32) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
16,Int
16) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
16, Int
8) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm

        (ByteSize Int
8,Int
64) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
8,Int
32) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_32_64 Word64
imm)
        (ByteSize Int
8,Int
16) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_16_64 Word64
imm)
        (ByteSize Int
8, Int
8) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_8_64 Word64
imm)

        (ByteSize Int
4, Int
64) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
4, Int
32) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
4, Int
16) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_16_32 Word64
imm)
        (ByteSize Int
4,  Int
8) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_8_32 Word64
imm)

        (ByteSize Int
2, Int
64) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
2, Int
32) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
2, Int
16) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
2,  Int
8) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_8_16 Word64
imm)

        (ByteSize Int
1,  Int
64) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
1,  Int
32) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
1,  Int
16) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
        (ByteSize Int
1,   Int
8) -> String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm


        (ByteSize Int
si0,Int
si1) -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
si0,Int
si1)

    operand_size :: NASM_Operand -> ByteSize
operand_size (NASM_Operand_Reg Register
r) = Register -> ByteSize
regSize Register
r
    operand_size (NASM_Operand_Address NASM_Address
a) = Int -> ByteSize
ByteSize Int
8
    operand_size (NASM_Operand_EffectiveAddress NASM_Address
a) = Int -> ByteSize
ByteSize Int
8
    operand_size (NASM_Operand_Memory (Int
si,Bool
_) NASM_Address
a) = Int -> ByteSize
ByteSize Int
si
    operand_size (NASM_Operand_Immediate (Immediate (BitSize Int
si) Word64
imm)) = Int -> ByteSize
ByteSize (Int -> ByteSize) -> Int -> ByteSize
forall a b. (a -> b) -> a -> b
$ Int
si Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

--"0x" ++ showHex imm
  --  show_op (NASM_Operand_Immediate (Immediate (BitSize 32) imm)) = "0x" ++ showHex imm -- showHex (sextend_32_64 imm)
   -- show_op (NASM_Operand_Immediate (Immediate (BitSize 16) imm)) = "0x" ++ showHex (sextend_16_64 imm)
    --show_op (NASM_Operand_Immediate (Immediate (BitSize 8)  imm)) = "0x" ++ showHex (sextend_8_64 imm)





render_annot :: Annot -> String
render_annot :: Annot -> String
render_annot [] = String
""
render_annot Annot
m  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," (((Word64, NASM_Label, Word64) -> String) -> Annot -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Word64, NASM_Label, Word64) -> String
forall {a} {a} {a}.
(Show a, Integral a, Integral a) =>
(a, a, a) -> String
render_annot_elmt Annot
m)
 where
  render_annot_elmt :: (a, a, a) -> String
render_annot_elmt (a
a,a
l,a
offset) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
a 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
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if a
offset a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then String
"" else String
" + 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
offset)
    


instance Show NASM_Operand where
  show :: NASM_Operand -> String
show (NASM_Operand_Reg Register
r)              = Register -> String
forall a. Show a => a -> String
show Register
r
  show (NASM_Operand_Address NASM_Address
a)          = NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a
  show (NASM_Operand_EffectiveAddress NASM_Address
a) = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  show (NASM_Operand_Memory NASM_SizeDir
sizedir NASM_Address
a)   = NASM_SizeDir -> String
forall {a}. (Eq a, Num a) => (a, Bool) -> String
show_nasm_sizedir NASM_SizeDir
sizedir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ NASM_Address -> String
forall a. Show a => a -> String
show NASM_Address
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
  show (NASM_Operand_Immediate (Immediate (BitSize Int
64) Word64
imm)) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm
  show (NASM_Operand_Immediate (Immediate (BitSize Int
32) Word64
imm)) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
imm -- showHex (sextend_32_64 imm)
  show (NASM_Operand_Immediate (Immediate (BitSize Int
16) Word64
imm)) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_16_64 Word64
imm)
  show (NASM_Operand_Immediate (Immediate (BitSize Int
8)  Word64
imm)) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> Word64
forall {a}. (Bits a, Num a) => a -> a
sextend_8_64 Word64
imm)

show_nasm_sizedir :: (a, Bool) -> String
show_nasm_sizedir (a
_,Bool
False) = String
""
show_nasm_sizedir (a
1,Bool
_) = String
"byte"
show_nasm_sizedir (a
2,Bool
_) = String
"word"
show_nasm_sizedir (a
4,Bool
_) = String
"dword"
show_nasm_sizedir (a
8,Bool
_) = String
"qword"
show_nasm_sizedir (a
10,Bool
_) = String
"tword"
show_nasm_sizedir (a
16,Bool
_) = String
"oword"

instance Show NASM_Label where
  show :: NASM_Label -> String
show (Label Word64
_ String
str) = String
str
  show (Macro String
segment String
section Word64
a0 Word64
offset) = String -> String -> Word64 -> String
forall {a}. Integral a => String -> String -> a -> String
show_macro_name String
segment String
section Word64
a0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {p}. p -> String
show_offset Word64
offset
   where
    show_offset :: p -> String
show_offset p
n = String
"(0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex Word64
offset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

show_macro_name :: String -> String -> a -> String
show_macro_name String
segment String
section a
a0 = String
"RELA" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> a -> String
forall {a}. Integral a => String -> String -> a -> String
section_name String
segment String
section a
a0

section_name :: String -> String -> a -> String
section_name String
segment String
section a
a0 = 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 => a -> String
showHex a
a0

instance Show NASM_Address_Computation where
 show :: NASM_Address_Computation -> String
show (NASM_Address_Computation Maybe Register
Nothing Maybe Register
Nothing Word64
_ Maybe Register
Nothing (Just Word64
0)) = String
"ds:0" 
 show (NASM_Address_Computation Maybe Register
Nothing Maybe Register
Nothing Word64
_ Maybe Register
Nothing Maybe Word64
Nothing)  = String
"ds:0" 
 show (NASM_Address_Computation Maybe Register
seg Maybe Register
ind Word64
sc Maybe Register
base Maybe Word64
displ) = 
   let str0 :: String
str0 = Maybe Register -> String
forall {a}. Show a => Maybe a -> String
show_seg Maybe Register
seg
       str1 :: String
str1 = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" + " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) String
"") [Maybe Register -> String
forall {a}. Show a => Maybe a -> String
show_base Maybe Register
base, Maybe Register -> Word64 -> String
forall {a} {a}.
(Eq a, Num a, Show a, Show a) =>
Maybe a -> a -> String
show_index_scale Maybe Register
ind Word64
sc] 
       str2 :: String
str2 = String -> Maybe Word64 -> String
forall {a}. Integral a => String -> Maybe a -> String
show_displacement String
str1 Maybe Word64
displ in
     [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
str0,String
str1,String
str2]
  where
   show_seg :: Maybe a -> String
show_seg Maybe a
Nothing  = String
""
   show_seg (Just a
r) = a -> String
forall a. Show a => a -> String
show a
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"

   show_base :: Maybe a -> String
show_base Maybe a
Nothing = String
""
   show_base (Just a
r) = a -> String
forall a. Show a => a -> String
show a
r

   show_index_scale :: Maybe a -> a -> String
show_index_scale Maybe a
Nothing a
_ = String
""
   show_index_scale (Just a
r) a
0 = String
""
   show_index_scale (Just a
r) a
1 = a -> String
forall a. Show a => a -> String
show a
r
   show_index_scale (Just a
r) a
imm = 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
imm

show_displacement :: String -> Maybe a -> String
show_displacement String
_ Maybe a
Nothing     = String
""
show_displacement String
"" (Just a
0)   = String
""
show_displacement String
"" (Just a
imm) = String
"0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
imm
show_displacement String
_  (Just a
imm) 
  | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
imm::Word64) Int
63 = String
" - 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex (a
0 a -> a -> a
forall a. Num a => a -> a -> a
- a
imm)
  | Bool
otherwise =  String
" + 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Integral a => a -> String
showHex a
imm


instance Show NASM_Address where
  show :: NASM_Address -> String
show (NASM_Addr_Compute NASM_Address_Computation
addr)               = NASM_Address_Computation -> String
forall a. Show a => a -> String
show NASM_Address_Computation
addr
  show (NASM_Addr_Symbol Symbol
sym)                 = Symbol -> String
show_symbol Symbol
sym
  show (NASM_JumpTarget (External String
sym))       = String
sym String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" wrt ..plt"
  show (NASM_JumpTarget (ExternalDeref String
sym))  = String
"[ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sym String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ]"
  show (NASM_Addr_Label NASM_Label
l Maybe Word64
displ)              = NASM_Label -> String
forall a. Show a => a -> String
show NASM_Label
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> Maybe Word64 -> String
forall {a}. Integral a => String -> Maybe a -> String
show_displacement (NASM_Label -> String
forall a. Show a => a -> String
show NASM_Label
l) Maybe Word64
displ


show_symbol :: Symbol -> String
show_symbol (PointerToLabel  String
l Bool
True)       = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" wrt ..plt"
show_symbol (PointerToLabel  String
l Bool
False)      = String
l
show_symbol (PointerToObject String
l Bool
True)       = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" wrt ..got"
show_symbol (PointerToObject String
l Bool
False)      = String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" wrt ..got"
show_symbol (AddressOfLabel  String
l Bool
_)          = String
l
show_symbol (AddressOfObject String
l Bool
_)          = String
l
show_symbol (Relocated_ResolvedObject String
l Word64
_) = String
l




-- RENDERING TO JSON
-- We build a list of functions, for each of which we stores the following information:
data JSON_NASM_Function = JSON_NASM_Function {
    JSON_NASM_Function -> String
name   :: String -- ^ The name of the function
  , JSON_NASM_Function -> [(Int, [String])]
blocks :: [(Int,[String])] -- ^ A mapping from blocKIDs to rendered instructions
  , JSON_NASM_Function -> IntMap IntSet
control_flow :: IM.IntMap (IS.IntSet) -- ^ A mapping from blockIDs to sets of blockIDs
 }
 deriving ((forall x. JSON_NASM_Function -> Rep JSON_NASM_Function x)
-> (forall x. Rep JSON_NASM_Function x -> JSON_NASM_Function)
-> Generic JSON_NASM_Function
forall x. Rep JSON_NASM_Function x -> JSON_NASM_Function
forall x. JSON_NASM_Function -> Rep JSON_NASM_Function x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JSON_NASM_Function -> Rep JSON_NASM_Function x
from :: forall x. JSON_NASM_Function -> Rep JSON_NASM_Function x
$cto :: forall x. Rep JSON_NASM_Function x -> JSON_NASM_Function
to :: forall x. Rep JSON_NASM_Function x -> JSON_NASM_Function
Generic)

instance ToJSON JSON_NASM_Function where
  toEncoding :: JSON_NASM_Function -> Encoding
toEncoding = Options -> JSON_NASM_Function -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> JSON_NASM_Function -> Encoding)
-> Options -> JSON_NASM_Function -> Encoding
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions --  { unwrapUnaryRecords = True }




render_NASM_to_JSON :: NASM -> ByteString
render_NASM_to_JSON (NASM Set String
externals Set String
globals [NASM_Section]
sections [String]
footer) = [JSON_NASM_Function] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([JSON_NASM_Function] -> ByteString)
-> [JSON_NASM_Function] -> ByteString
forall a b. (a -> b) -> a -> b
$ (NASM_Section -> [JSON_NASM_Function])
-> [NASM_Section] -> [JSON_NASM_Function]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NASM_Section -> [JSON_NASM_Function]
toJSON_section [NASM_Section]
sections

toJSON_section :: NASM_Section -> [JSON_NASM_Function]
toJSON_section (NASM_Section_Text NASM_TextSection
ts) = [NASM_TextSection -> JSON_NASM_Function
toJSON_text_section NASM_TextSection
ts]
toJSON_section (NASM_Section_Data [NASM_DataSection]
_ ) = []

toJSON_text_section :: NASM_TextSection -> JSON_NASM_Function
toJSON_text_section (NASM_TextSection String
name [(Int, [NASM_Line])]
blocks IntMap IntSet
cf) = String -> [(Int, [String])] -> IntMap IntSet -> JSON_NASM_Function
JSON_NASM_Function String
name (((Int, [NASM_Line]) -> (Int, [String]))
-> [(Int, [NASM_Line])] -> [(Int, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (Int, [NASM_Line]) -> (Int, [String])
forall {t :: * -> *} {a}.
Foldable t =>
(a, t NASM_Line) -> (a, [String])
render_block [(Int, [NASM_Line])]
blocks) IntMap IntSet
cf
 where
  render_block :: (a, t NASM_Line) -> (a, [String])
render_block (a
blockID,t NASM_Line
lines) = (a
blockID, (NASM_Line -> [String]) -> t NASM_Line -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NASM_Line -> [String]
toJSON_line t NASM_Line
lines)

toJSON_line :: NASM_Line -> [String]
toJSON_line (NASM_Comment Int
_ String
_) = []
toJSON_line (NASM_Line NASM_Instruction
i) = [(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Char
';') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ NASM_Instruction -> String
forall a. Show a => a -> String
show NASM_Instruction
i]
toJSON_line (NASM_Label NASM_Label
_) = []