Commits

Paweł Wieczorek committed d48574e

Added Machines

Comments (0)

Files changed (13)

source/Machine_Common.mlpack

-Types
-Formatter

source/Machine_Common/Formatter.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-
-include StringPainter.Prioritized
-open Batteries
-open Types
-
-(*********************************************************************************************************************
- * String painters for types
- ********************************************************************************************************************)
-
-let paint_symbol = psp_label % string_of_symbol 
-
-

source/Machine_Common/Types.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-type symbol = Symbol of string
-
-(*********************************************************************************************************************
- * 
- ********************************************************************************************************************)
-
- let make_symbol x = Symbol x
-
- let string_of_symbol (Symbol x) = x

source/Machine_X86.mlpack

-Assembler
-GasPrettyPrinter

source/Machine_X86/Assembler.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-
-include Machine_Common.Types
-
-(*********************************************************************************************************************
- * Register, Memory, etc
- ********************************************************************************************************************)
-
-type register32
-    = EAX
-    | EBX
-    | ECX
-    | EDX
-    | ESP
-    | EBP
-    | EDI
-    | ESI
-
-type immediate_byte32 = Int32.t
-
-type memory_address = immediate_byte32
-
-type value32
-    = VAL32_Immediate of immediate_byte32
-    | VAL32_Symbol of symbol
-
-type scale_factor
-    = SCALE_FACTOR_1
-    | SCALE_FACTOR_2
-    | SCALE_FACTOR_4
-    | SCALE_FACTOR_8
-
-type memory_location
-    = MEM_Symbol  of symbol
-    | MEM_Address of memory_address * register32 option * (register32 * scale_factor) option
-
-type location32
-    = LOC32_Register of register32
-    | LOC32_Memory of memory_location
-
-type location_or_value32
-    = LV32_Location of location32
-    | LV32_Value of value32
-
-(*********************************************************************************************************************
- * Instructions
- ********************************************************************************************************************)
-
-type instruction
-    = NOP
-
-    | ADDL of location_or_value32 * location32
-    | ANDL of location_or_value32 * location32
-    | DIVL of location_or_value32 * location32
-    | IDIVL of location_or_value32 * location32
-    | IMULL of location_or_value32 * location32
-    | MOVL of location_or_value32 * location32
-    | MULL of location_or_value32 * location32
-    | ORL of location_or_value32 * location32
-    | SALL of location_or_value32 * location32
-    | SARL of location_or_value32 * location32
-    | SHLL of location_or_value32 * location32
-    | SHRL of location_or_value32 * location32
-    | SUBL of location_or_value32 * location32
-    | TESTL of location_or_value32 * location32
-    | XORL of location_or_value32 * location32
-
-    | LEAL of memory_location * location32
-
-    | NOTL of location32
-    | NEGL of location32
-
-    | JMP of location32
-
-    | JE of location32
-    | JNE of location32
-
-    | JZ of location32
-    | JNZ of location32
-
-    | JL of location32
-    | JNL of location32
-
-    | JG of location32
-    | JNG of location32
-
-    | JGE of location32
-    | JNGE of location32
-
-    | JLE of location32
-    | JNLE of location32
-
-    | CALL of location32
-    | RET
-
-    | PUSHL of location_or_value32
-    | POPL of location32
-
-    | CMP of location_or_value32 * location32
-
-
-type memory_reservation
-    = Reservation_Int32 of immediate_byte32
-    | Reservation_AsciiZ of string
-
-(*********************************************************************************************************************
- * Emit and Assembly
- ********************************************************************************************************************)
-
-type emit
-    = EMIT_Instruction of instruction
-    | EMIT_Label of symbol
-    | EMIT_Comment of string
-    | EMIT_MemoryReservation of symbol * memory_reservation
-
-type block = emit list
-
-type section
-    = Section of string * block list
-
-type assembly
-    = Assembly of string list * section list * symbol list
-
-(*********************************************************************************************************************
- * Converters
- ********************************************************************************************************************)
-
-let int_of_scale_factor = function
-    | SCALE_FACTOR_1 -> 1
-    | SCALE_FACTOR_2 -> 2
-    | SCALE_FACTOR_4 -> 4
-    | SCALE_FACTOR_8 -> 8
-
-(*********************************************************************************************************************
- * Emit wrappers
- ********************************************************************************************************************)
-
-let emit_NOP = EMIT_Instruction (NOP )
-let emit_ADDL x y = EMIT_Instruction (ADDL (x, y))
-let emit_ANDL x y = EMIT_Instruction (ANDL (x, y))
-let emit_DIVL x y = EMIT_Instruction (DIVL (x, y))
-let emit_IDIVL x y = EMIT_Instruction (IDIVL (x, y))
-let emit_IMULL x y = EMIT_Instruction (IMULL (x, y))
-let emit_LEAL x y = EMIT_Instruction (LEAL (x, y))
-let emit_MOVL x y = EMIT_Instruction (MOVL (x, y))
-let emit_MULL x y = EMIT_Instruction (MULL (x, y))
-let emit_ORL x y = EMIT_Instruction (ORL (x, y))
-let emit_SALL x y = EMIT_Instruction (SALL (x, y))
-let emit_SARL x y = EMIT_Instruction (SARL (x, y))
-let emit_SHLL x y = EMIT_Instruction (SHLL (x, y))
-let emit_SHRL x y = EMIT_Instruction (SHRL (x, y))
-let emit_SUBL x y = EMIT_Instruction (SUBL (x, y))
-let emit_TESTL x y = EMIT_Instruction (TESTL (x, y))
-let emit_XORL x y = EMIT_Instruction (XORL (x, y))
-let emit_NOTL x = EMIT_Instruction (NOTL (x))
-let emit_NEGL x = EMIT_Instruction (NEGL (x))
-let emit_JMP x = EMIT_Instruction (JMP (x))
-let emit_JE x = EMIT_Instruction (JE (x))
-let emit_JNE x = EMIT_Instruction (JNE (x))
-let emit_JNZ x = EMIT_Instruction (JNZ (x))
-let emit_JZ x = EMIT_Instruction (JZ (x))
-let emit_JL x = EMIT_Instruction (JL (x))
-let emit_JLE x = EMIT_Instruction (JLE (x))
-let emit_JNL x = EMIT_Instruction (JNL (x))
-let emit_JNLE x = EMIT_Instruction (JNLE (x))
-let emit_JG x = EMIT_Instruction (JG (x))
-let emit_JGE x = EMIT_Instruction (JGE (x))
-let emit_JNG x = EMIT_Instruction (JNG (x))
-let emit_JNGE x = EMIT_Instruction (JNGE (x))
-let emit_CALL x = EMIT_Instruction (CALL (x))
-let emit_RET = EMIT_Instruction (RET )
-let emit_PUSHL x = EMIT_Instruction (PUSHL (x))
-let emit_POPL x = EMIT_Instruction (POPL (x))
-let emit_CMP x y = EMIT_Instruction (CMP (x, y))
-
-
-let emit_label x = EMIT_Label x
-let emit_comment x = EMIT_Comment x
-let emit_memory_reservation s x = EMIT_MemoryReservation(s, x)
-
-(*********************************************************************************************************************
- * LV32/LOC32/VAL32 wrappers
- ********************************************************************************************************************)
-
-let loc32_reg reg32 = LOC32_Register reg32
-let lv32_reg reg32 = LV32_Location (loc32_reg reg32)
-let loc32_symbol symbol = LOC32_Memory (MEM_Symbol symbol)
-let lv32_symbol symbol = LV32_Location (loc32_symbol symbol)
-let val32_imm imm32 = VAL32_Immediate imm32
-let lv32_imm imm32 = LV32_Value (val32_imm imm32)
-let lv32_symboladdr symbol = LV32_Value (VAL32_Symbol symbol)
-
-let loc32_is_memref = function
-    | LOC32_Register _ -> false
-    | LOC32_Memory _ -> true
-
-let lv32_is_memref = function
-    | LV32_Value _        -> false
-    | LV32_Location loc32 -> loc32_is_memref loc32

source/Machine_X86/GasPrettyPrinter.ml

-(*
- * Opifex
- *
- * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
- *)
-
-open Batteries
-open Assembler
-open Machine_Common.Formatter
-
-(*********************************************************************************************************************
- *
- ********************************************************************************************************************)
-
-let paint_register32 = function
-    | EAX -> psp_special "%eax"
-    | EBX -> psp_special "%ebx"
-    | ECX -> psp_special "%ecx"
-    | EDX -> psp_special "%edx"
-    | EBP -> psp_special "%ebp"
-    | ESP -> psp_special "%esp"
-    | EDI -> psp_special "%edx"
-    | ESI -> psp_special "%esx"
-
-let paint_immediate_byte32 byte =
-    psp_value (Printf.sprintf "$%li" byte)
-
-let paint_memory_address addr =
-    psp_value (Printf.sprintf "0x%lx" addr)
-
-let paint_memory_offset addr =
-    psp_value (Printf.sprintf "%li" addr)
-
-let paint_value32 = function
-    | VAL32_Immediate ib32 -> paint_immediate_byte32 ib32
-    | VAL32_Symbol symbol -> psp_label ("$" ^ string_of_symbol symbol)
-
-let paint_scale_factor scale_factor =
-    psp_value_int (int_of_scale_factor scale_factor)
-
-let paint_memory_location = function
-    | MEM_Symbol symbol ->
-        paint_symbol symbol
-
-    | MEM_Address (0l, None, Some (reg32, scale_factor)) -> psp_group
-        [ psp_word "("
-        ; psp_syntax ","
-        ; paint_register32 reg32
-        ; psp_syntax ","
-        ; paint_scale_factor scale_factor
-        ; psp_word ")"
-        ]
-
-    | MEM_Address (0l, Some reg32, None) -> psp_group
-        [ psp_word "("
-        ; paint_register32 reg32
-        ; psp_word ")"
-        ]
-
-    | MEM_Address (0l, Some reg32, Some (sreg32, scale_factor)) -> psp_group
-        [ psp_word "("
-        ; paint_register32 reg32
-        ; psp_syntax ","
-        ; paint_register32 sreg32
-        ; psp_syntax ","
-        ; paint_scale_factor scale_factor
-        ; psp_word ")"
-        ]
-
-    | MEM_Address (addr, None, None) -> 
-        paint_memory_address addr
-
-    | MEM_Address (addr, None, Some (reg32, scale_factor)) -> psp_group
-        [ paint_memory_offset addr
-        ; psp_word "("
-        ; psp_syntax ","
-        ; paint_register32 reg32
-        ; psp_syntax ","
-        ; paint_scale_factor scale_factor
-        ; psp_word ")"
-        ]
-
-    | MEM_Address (addr, Some reg32, None) -> psp_group
-        [ paint_memory_offset addr
-        ; psp_word "("
-        ; paint_register32 reg32
-        ; psp_word ")"
-        ]
-
-    | MEM_Address (addr, Some reg32, Some (sreg32, scale_factor)) -> psp_group
-        [ paint_memory_offset addr
-        ; psp_word "("
-        ; paint_register32 reg32
-        ; psp_syntax ","
-        ; paint_register32 sreg32
-        ; psp_syntax ","
-        ; paint_scale_factor scale_factor
-        ; psp_word ")"
-        ]
-
-
-let paint_location32 = function
-    | LOC32_Register reg -> paint_register32 reg
-    | LOC32_Memory memloc  -> paint_memory_location memloc
-
-let paint_location_or_value32 = function
-    | LV32_Location location -> paint_location32 location
-    | LV32_Value value -> paint_value32 value
-
-
-let get_instruction_mnemonic = function
-    | NOP   -> "nop"
-    | ADDL  _ -> "addl"
-    | ANDL  _ -> "andl"
-    | DIVL  _ -> "divl"
-    | IDIVL  _ -> "idivl"
-    | IMULL  _ -> "imull"
-    | LEAL  _ -> "leal"
-    | MOVL  _ -> "movl"
-    | MULL  _ -> "mull"
-    | ORL  _ -> "orl"
-    | SALL  _ -> "sall"
-    | SARL  _ -> "sarl"
-    | SHLL  _ -> "shll"
-    | SHRL  _ -> "shrl"
-    | SUBL  _ -> "subl"
-    | TESTL  _ -> "testl"
-    | XORL  _ -> "xorl"
-    | NOTL  _ -> "notl"
-    | NEGL  _ -> "negl"
-    | JMP  _ -> "jmp"
-    | JE  _ -> "je"
-    | JNE  _ -> "jne"
-    | JNZ  _ -> "jnz"
-    | JZ  _ -> "jz"
-    | JL  _ -> "jl"
-    | JG _ -> "jg"
-    | JNL _ -> "jnl"
-    | JNG _ -> "jng"
-    | JLE  _ -> "jle"
-    | JGE _ -> "jge"
-    | JNLE _ -> "jnle"
-    | JNGE _ -> "jnge"
-    | CALL  _ -> "call"
-    | RET  -> "ret"
-    | PUSHL  _ -> "pushl"
-    | POPL  _ -> "popl"
-    | CMP  _ -> "cmp"
-
-let paint_jump_location32 = function
-    | LOC32_Register reg -> psp_group
-        [ psp_operator "*"
-        ; paint_register32 reg
-        ]
-
-    | LOC32_Memory (MEM_Symbol symbol) -> psp_group
-        [ paint_symbol symbol
-        ]
-
-    | LOC32_Memory mem -> psp_group
-        [ psp_operator "*"
-        ; paint_memory_location mem
-        ]
-        
-
-let paint_instruction instr =
-    let mnemonic = get_instruction_mnemonic instr in
-    let psp_mnemonic = psp_operator in
-    match instr with
-    | RET
-    | NOP -> psp_group
-        [ psp_mnemonic mnemonic
-        ]
-
-
-    | JMP (l32)
-    | JE (l32)
-    | JNE (l32)
-    | JNZ (l32)
-    | JZ (l32)
-
-    | JG (l32)
-    | JNL (l32)
-    | JNG (l32)
-    | JLE (l32)
-    | JGE (l32)
-    | JNLE(l32)
-    | JNGE(l32)
-    | CALL (l32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_jump_location32 l32
-        ]
-
-
-    | NOTL (l32)
-    | NEGL (l32)
-    | POPL (l32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_location32 l32
-        ]
-
-    | POPL (l32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_location32 l32
-        ]
-
-    | PUSHL (lv32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_location_or_value32 lv32
-        ]
-
-    | LEAL (mloc, l32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_memory_location mloc
-        ; psp_syntax ","
-        ; paint_location32 l32
-        ]
-
-    | CMP (lv32, l32)
-    | ADDL (lv32, l32)
-    | ANDL (lv32, l32)
-    | DIVL (lv32, l32)
-    | IDIVL (lv32, l32)
-    | IMULL (lv32, l32)
-    | MOVL (lv32, l32)
-    | MULL (lv32, l32)
-    | ORL (lv32, l32)
-    | SALL (lv32, l32)
-    | SARL (lv32, l32)
-    | SHLL (lv32, l32)
-    | SHRL (lv32, l32)
-    | SUBL (lv32, l32)
-    | TESTL (lv32, l32)
-    | XORL (lv32, l32) -> psp_group
-        [ psp_mnemonic mnemonic
-        ; paint_location_or_value32 lv32
-        ; psp_syntax ","
-        ; paint_location32 l32
-        ]
-
-let paint_comment comment = psp_group
-        [ psp_syntax "#"
-        ; psp_syntax comment
-        ; psp_break
-        ]
-
-let paint_memory_reservation = function
-    | Reservation_Int32 imm32 -> psp_group 
-        [ psp_operator ".int"
-        ; paint_memory_offset imm32
-        ; psp_break
-        ]
-
-    | Reservation_AsciiZ str -> psp_group
-        [ psp_operator ".asciz"
-        ; psp_value ("\"" ^ str ^ "\"")
-        ; psp_break
-        ]
-
-let paint_command = function
-    | EMIT_Instruction instr -> psp_indent_group
-        [ paint_instruction instr
-        ; psp_break
-        ]
-    | EMIT_Label symbol -> psp_group
-        [ paint_symbol symbol
-        ; psp_syntax ":"
-        ; psp_break
-        ]
-
-    | EMIT_Comment comment -> 
-        psp_indent (paint_comment comment)
-
-    | EMIT_MemoryReservation (symbol, memory_reservation) -> psp_group
-        [ paint_symbol symbol
-        ; psp_syntax ":"
-        ; psp_break
-        ; psp_indent (paint_memory_reservation memory_reservation)
-        ; psp_break
-        ]
-
-let paint_export_symbol symbol = psp_group
-    [ psp_operator ".global"
-    ; paint_symbol symbol
-    ; psp_break
-    ]
-
-let paint_block (instrs) =
-    let commands = List.map paint_command (instrs) in
-    psp_group 
-        [ psp_group commands
-        ; psp_newline
-        ]
-    
-
-let paint_section (Section (name, blocks)) =
-    let painted_blocks  = List.map paint_block blocks in
-    psp_group
-        [ psp_operator ".section"
-        ; psp_word name
-        ; psp_newline
-        ; psp_newline
-        ; psp_group painted_blocks
-        ]
-
-
-let paint_assembly (Assembly (comments, sections, exported_symbols)) = 
-    let painted_comments  = List.map paint_comment comments in
-    let exporting_symbols = List.map paint_export_symbol exported_symbols in
-    let painted_sections  = List.map paint_section sections in
-    psp_group
-        [ psp_group painted_comments
-        ; psp_newline
-        ; psp_group exporting_symbols
-        ; psp_newline
-        ; psp_group painted_sections
-        ]

source/Machines/Machine_Common.mlpack

+Types
+Formatter

source/Machines/Machine_Common/Formatter.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+
+include StringPainter.Prioritized
+open Batteries
+open Types
+
+(*********************************************************************************************************************
+ * String painters for types
+ ********************************************************************************************************************)
+
+let paint_symbol = psp_label % string_of_symbol 
+
+

source/Machines/Machine_Common/Types.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+
+(*********************************************************************************************************************
+ *
+ ********************************************************************************************************************)
+
+type symbol = Symbol of string
+
+(*********************************************************************************************************************
+ * 
+ ********************************************************************************************************************)
+
+ let make_symbol x = Symbol x
+
+ let string_of_symbol (Symbol x) = x

source/Machines/Machine_X86.mlpack

+Assembler
+GasPrettyPrinter

source/Machines/Machine_X86/Assembler.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open Batteries
+
+include Machine_Common.Types
+
+(*********************************************************************************************************************
+ * Register, Memory, etc
+ ********************************************************************************************************************)
+
+type register32
+    = EAX
+    | EBX
+    | ECX
+    | EDX
+    | ESP
+    | EBP
+    | EDI
+    | ESI
+
+type immediate_byte32 = Int32.t
+
+type memory_address = immediate_byte32
+
+type value32
+    = VAL32_Immediate of immediate_byte32
+    | VAL32_Symbol of symbol
+
+type scale_factor
+    = SCALE_FACTOR_1
+    | SCALE_FACTOR_2
+    | SCALE_FACTOR_4
+    | SCALE_FACTOR_8
+
+type memory_location
+    = MEM_Symbol  of symbol
+    | MEM_Address of memory_address * register32 option * (register32 * scale_factor) option
+
+type location32
+    = LOC32_Register of register32
+    | LOC32_Memory of memory_location
+
+type location_or_value32
+    = LV32_Location of location32
+    | LV32_Value of value32
+
+(*********************************************************************************************************************
+ * Instructions
+ ********************************************************************************************************************)
+
+type instruction
+    = NOP
+
+    | ADDL of location_or_value32 * location32
+    | ANDL of location_or_value32 * location32
+    | DIVL of location_or_value32 * location32
+    | IDIVL of location_or_value32 * location32
+    | IMULL of location_or_value32 * location32
+    | MOVL of location_or_value32 * location32
+    | MULL of location_or_value32 * location32
+    | ORL of location_or_value32 * location32
+    | SALL of location_or_value32 * location32
+    | SARL of location_or_value32 * location32
+    | SHLL of location_or_value32 * location32
+    | SHRL of location_or_value32 * location32
+    | SUBL of location_or_value32 * location32
+    | TESTL of location_or_value32 * location32
+    | XORL of location_or_value32 * location32
+
+    | LEAL of memory_location * location32
+
+    | NOTL of location32
+    | NEGL of location32
+
+    | JMP of location32
+
+    | JE of location32
+    | JNE of location32
+
+    | JZ of location32
+    | JNZ of location32
+
+    | JL of location32
+    | JNL of location32
+
+    | JG of location32
+    | JNG of location32
+
+    | JGE of location32
+    | JNGE of location32
+
+    | JLE of location32
+    | JNLE of location32
+
+    | CALL of location32
+    | RET
+
+    | PUSHL of location_or_value32
+    | POPL of location32
+
+    | CMP of location_or_value32 * location32
+
+
+type memory_reservation
+    = Reservation_Int32 of immediate_byte32
+    | Reservation_AsciiZ of string
+
+(*********************************************************************************************************************
+ * Emit and Assembly
+ ********************************************************************************************************************)
+
+type emit
+    = EMIT_Instruction of instruction
+    | EMIT_Label of symbol
+    | EMIT_Comment of string
+    | EMIT_MemoryReservation of symbol * memory_reservation
+
+type block = emit list
+
+type section
+    = Section of string * block list
+
+type assembly
+    = Assembly of string list * section list * symbol list
+
+(*********************************************************************************************************************
+ * Converters
+ ********************************************************************************************************************)
+
+let int_of_scale_factor = function
+    | SCALE_FACTOR_1 -> 1
+    | SCALE_FACTOR_2 -> 2
+    | SCALE_FACTOR_4 -> 4
+    | SCALE_FACTOR_8 -> 8
+
+(*********************************************************************************************************************
+ * Emit wrappers
+ ********************************************************************************************************************)
+
+let emit_NOP = EMIT_Instruction (NOP )
+let emit_ADDL x y = EMIT_Instruction (ADDL (x, y))
+let emit_ANDL x y = EMIT_Instruction (ANDL (x, y))
+let emit_DIVL x y = EMIT_Instruction (DIVL (x, y))
+let emit_IDIVL x y = EMIT_Instruction (IDIVL (x, y))
+let emit_IMULL x y = EMIT_Instruction (IMULL (x, y))
+let emit_LEAL x y = EMIT_Instruction (LEAL (x, y))
+let emit_MOVL x y = EMIT_Instruction (MOVL (x, y))
+let emit_MULL x y = EMIT_Instruction (MULL (x, y))
+let emit_ORL x y = EMIT_Instruction (ORL (x, y))
+let emit_SALL x y = EMIT_Instruction (SALL (x, y))
+let emit_SARL x y = EMIT_Instruction (SARL (x, y))
+let emit_SHLL x y = EMIT_Instruction (SHLL (x, y))
+let emit_SHRL x y = EMIT_Instruction (SHRL (x, y))
+let emit_SUBL x y = EMIT_Instruction (SUBL (x, y))
+let emit_TESTL x y = EMIT_Instruction (TESTL (x, y))
+let emit_XORL x y = EMIT_Instruction (XORL (x, y))
+let emit_NOTL x = EMIT_Instruction (NOTL (x))
+let emit_NEGL x = EMIT_Instruction (NEGL (x))
+let emit_JMP x = EMIT_Instruction (JMP (x))
+let emit_JE x = EMIT_Instruction (JE (x))
+let emit_JNE x = EMIT_Instruction (JNE (x))
+let emit_JNZ x = EMIT_Instruction (JNZ (x))
+let emit_JZ x = EMIT_Instruction (JZ (x))
+let emit_JL x = EMIT_Instruction (JL (x))
+let emit_JLE x = EMIT_Instruction (JLE (x))
+let emit_JNL x = EMIT_Instruction (JNL (x))
+let emit_JNLE x = EMIT_Instruction (JNLE (x))
+let emit_JG x = EMIT_Instruction (JG (x))
+let emit_JGE x = EMIT_Instruction (JGE (x))
+let emit_JNG x = EMIT_Instruction (JNG (x))
+let emit_JNGE x = EMIT_Instruction (JNGE (x))
+let emit_CALL x = EMIT_Instruction (CALL (x))
+let emit_RET = EMIT_Instruction (RET )
+let emit_PUSHL x = EMIT_Instruction (PUSHL (x))
+let emit_POPL x = EMIT_Instruction (POPL (x))
+let emit_CMP x y = EMIT_Instruction (CMP (x, y))
+
+
+let emit_label x = EMIT_Label x
+let emit_comment x = EMIT_Comment x
+let emit_memory_reservation s x = EMIT_MemoryReservation(s, x)
+
+(*********************************************************************************************************************
+ * LV32/LOC32/VAL32 wrappers
+ ********************************************************************************************************************)
+
+let loc32_reg reg32 = LOC32_Register reg32
+let lv32_reg reg32 = LV32_Location (loc32_reg reg32)
+let loc32_symbol symbol = LOC32_Memory (MEM_Symbol symbol)
+let lv32_symbol symbol = LV32_Location (loc32_symbol symbol)
+let val32_imm imm32 = VAL32_Immediate imm32
+let lv32_imm imm32 = LV32_Value (val32_imm imm32)
+let lv32_symboladdr symbol = LV32_Value (VAL32_Symbol symbol)
+
+let loc32_is_memref = function
+    | LOC32_Register _ -> false
+    | LOC32_Memory _ -> true
+
+let lv32_is_memref = function
+    | LV32_Value _        -> false
+    | LV32_Location loc32 -> loc32_is_memref loc32

source/Machines/Machine_X86/GasPrettyPrinter.ml

+(*
+ * Opifex
+ *
+ * Copyrights(C) 2012,2013 by Pawel Wieczorek <wieczyk at gmail>
+ *)
+
+open Batteries
+open Assembler
+open Machine_Common.Formatter
+
+(*********************************************************************************************************************
+ *
+ ********************************************************************************************************************)
+
+let paint_register32 = function
+    | EAX -> psp_special "%eax"
+    | EBX -> psp_special "%ebx"
+    | ECX -> psp_special "%ecx"
+    | EDX -> psp_special "%edx"
+    | EBP -> psp_special "%ebp"
+    | ESP -> psp_special "%esp"
+    | EDI -> psp_special "%edx"
+    | ESI -> psp_special "%esx"
+
+let paint_immediate_byte32 byte =
+    psp_value (Printf.sprintf "$%li" byte)
+
+let paint_memory_address addr =
+    psp_value (Printf.sprintf "0x%lx" addr)
+
+let paint_memory_offset addr =
+    psp_value (Printf.sprintf "%li" addr)
+
+let paint_value32 = function
+    | VAL32_Immediate ib32 -> paint_immediate_byte32 ib32
+    | VAL32_Symbol symbol -> psp_label ("$" ^ string_of_symbol symbol)
+
+let paint_scale_factor scale_factor =
+    psp_value_int (int_of_scale_factor scale_factor)
+
+let paint_memory_location = function
+    | MEM_Symbol symbol ->
+        paint_symbol symbol
+
+    | MEM_Address (0l, None, Some (reg32, scale_factor)) -> psp_group
+        [ psp_word "("
+        ; psp_syntax ","
+        ; paint_register32 reg32
+        ; psp_syntax ","
+        ; paint_scale_factor scale_factor
+        ; psp_word ")"
+        ]
+
+    | MEM_Address (0l, Some reg32, None) -> psp_group
+        [ psp_word "("
+        ; paint_register32 reg32
+        ; psp_word ")"
+        ]
+
+    | MEM_Address (0l, Some reg32, Some (sreg32, scale_factor)) -> psp_group
+        [ psp_word "("
+        ; paint_register32 reg32
+        ; psp_syntax ","
+        ; paint_register32 sreg32
+        ; psp_syntax ","
+        ; paint_scale_factor scale_factor
+        ; psp_word ")"
+        ]
+
+    | MEM_Address (addr, None, None) -> 
+        paint_memory_address addr
+
+    | MEM_Address (addr, None, Some (reg32, scale_factor)) -> psp_group
+        [ paint_memory_offset addr
+        ; psp_word "("
+        ; psp_syntax ","
+        ; paint_register32 reg32
+        ; psp_syntax ","
+        ; paint_scale_factor scale_factor
+        ; psp_word ")"
+        ]
+
+    | MEM_Address (addr, Some reg32, None) -> psp_group
+        [ paint_memory_offset addr
+        ; psp_word "("
+        ; paint_register32 reg32
+        ; psp_word ")"
+        ]
+
+    | MEM_Address (addr, Some reg32, Some (sreg32, scale_factor)) -> psp_group
+        [ paint_memory_offset addr
+        ; psp_word "("
+        ; paint_register32 reg32
+        ; psp_syntax ","
+        ; paint_register32 sreg32
+        ; psp_syntax ","
+        ; paint_scale_factor scale_factor
+        ; psp_word ")"
+        ]
+
+
+let paint_location32 = function
+    | LOC32_Register reg -> paint_register32 reg
+    | LOC32_Memory memloc  -> paint_memory_location memloc
+
+let paint_location_or_value32 = function
+    | LV32_Location location -> paint_location32 location
+    | LV32_Value value -> paint_value32 value
+
+
+let get_instruction_mnemonic = function
+    | NOP   -> "nop"
+    | ADDL  _ -> "addl"
+    | ANDL  _ -> "andl"
+    | DIVL  _ -> "divl"
+    | IDIVL  _ -> "idivl"
+    | IMULL  _ -> "imull"
+    | LEAL  _ -> "leal"
+    | MOVL  _ -> "movl"
+    | MULL  _ -> "mull"
+    | ORL  _ -> "orl"
+    | SALL  _ -> "sall"
+    | SARL  _ -> "sarl"
+    | SHLL  _ -> "shll"
+    | SHRL  _ -> "shrl"
+    | SUBL  _ -> "subl"
+    | TESTL  _ -> "testl"
+    | XORL  _ -> "xorl"
+    | NOTL  _ -> "notl"
+    | NEGL  _ -> "negl"
+    | JMP  _ -> "jmp"
+    | JE  _ -> "je"
+    | JNE  _ -> "jne"
+    | JNZ  _ -> "jnz"
+    | JZ  _ -> "jz"
+    | JL  _ -> "jl"
+    | JG _ -> "jg"
+    | JNL _ -> "jnl"
+    | JNG _ -> "jng"
+    | JLE  _ -> "jle"
+    | JGE _ -> "jge"
+    | JNLE _ -> "jnle"
+    | JNGE _ -> "jnge"
+    | CALL  _ -> "call"
+    | RET  -> "ret"
+    | PUSHL  _ -> "pushl"
+    | POPL  _ -> "popl"
+    | CMP  _ -> "cmp"
+
+let paint_jump_location32 = function
+    | LOC32_Register reg -> psp_group
+        [ psp_operator "*"
+        ; paint_register32 reg
+        ]
+
+    | LOC32_Memory (MEM_Symbol symbol) -> psp_group
+        [ paint_symbol symbol
+        ]
+
+    | LOC32_Memory mem -> psp_group
+        [ psp_operator "*"
+        ; paint_memory_location mem
+        ]
+        
+
+let paint_instruction instr =
+    let mnemonic = get_instruction_mnemonic instr in
+    let psp_mnemonic = psp_operator in
+    match instr with
+    | RET
+    | NOP -> psp_group
+        [ psp_mnemonic mnemonic
+        ]
+
+
+    | JMP (l32)
+    | JE (l32)
+    | JNE (l32)
+    | JNZ (l32)
+    | JZ (l32)
+
+    | JG (l32)
+    | JNL (l32)
+    | JNG (l32)
+    | JLE (l32)
+    | JGE (l32)
+    | JNLE(l32)
+    | JNGE(l32)
+    | CALL (l32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_jump_location32 l32
+        ]
+
+
+    | NOTL (l32)
+    | NEGL (l32)
+    | POPL (l32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_location32 l32
+        ]
+
+    | POPL (l32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_location32 l32
+        ]
+
+    | PUSHL (lv32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_location_or_value32 lv32
+        ]
+
+    | LEAL (mloc, l32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_memory_location mloc
+        ; psp_syntax ","
+        ; paint_location32 l32
+        ]
+
+    | CMP (lv32, l32)
+    | ADDL (lv32, l32)
+    | ANDL (lv32, l32)
+    | DIVL (lv32, l32)
+    | IDIVL (lv32, l32)
+    | IMULL (lv32, l32)
+    | MOVL (lv32, l32)
+    | MULL (lv32, l32)
+    | ORL (lv32, l32)
+    | SALL (lv32, l32)
+    | SARL (lv32, l32)
+    | SHLL (lv32, l32)
+    | SHRL (lv32, l32)
+    | SUBL (lv32, l32)
+    | TESTL (lv32, l32)
+    | XORL (lv32, l32) -> psp_group
+        [ psp_mnemonic mnemonic
+        ; paint_location_or_value32 lv32
+        ; psp_syntax ","
+        ; paint_location32 l32
+        ]
+
+let paint_comment comment = psp_group
+        [ psp_syntax "#"
+        ; psp_syntax comment
+        ; psp_break
+        ]
+
+let paint_memory_reservation = function
+    | Reservation_Int32 imm32 -> psp_group 
+        [ psp_operator ".int"
+        ; paint_memory_offset imm32
+        ; psp_break
+        ]
+
+    | Reservation_AsciiZ str -> psp_group
+        [ psp_operator ".asciz"
+        ; psp_value ("\"" ^ str ^ "\"")
+        ; psp_break
+        ]
+
+let paint_command = function
+    | EMIT_Instruction instr -> psp_indent_group
+        [ paint_instruction instr
+        ; psp_break
+        ]
+    | EMIT_Label symbol -> psp_group
+        [ paint_symbol symbol
+        ; psp_syntax ":"
+        ; psp_break
+        ]
+
+    | EMIT_Comment comment -> 
+        psp_indent (paint_comment comment)
+
+    | EMIT_MemoryReservation (symbol, memory_reservation) -> psp_group
+        [ paint_symbol symbol
+        ; psp_syntax ":"
+        ; psp_break
+        ; psp_indent (paint_memory_reservation memory_reservation)
+        ; psp_break
+        ]
+
+let paint_export_symbol symbol = psp_group
+    [ psp_operator ".global"
+    ; paint_symbol symbol
+    ; psp_break
+    ]
+
+let paint_block (instrs) =
+    let commands = List.map paint_command (instrs) in
+    psp_group 
+        [ psp_group commands
+        ; psp_newline
+        ]
+    
+
+let paint_section (Section (name, blocks)) =
+    let painted_blocks  = List.map paint_block blocks in
+    psp_group
+        [ psp_operator ".section"
+        ; psp_word name
+        ; psp_newline
+        ; psp_newline
+        ; psp_group painted_blocks
+        ]
+
+
+let paint_assembly (Assembly (comments, sections, exported_symbols)) = 
+    let painted_comments  = List.map paint_comment comments in
+    let exporting_symbols = List.map paint_export_symbol exported_symbols in
+    let painted_sections  = List.map paint_section sections in
+    psp_group
+        [ psp_group painted_comments
+        ; psp_newline
+        ; psp_group exporting_symbols
+        ; psp_newline
+        ; psp_group painted_sections
+        ]
 "Predefined": include
 "Languages" : include
 "Libraries" : include
+"Machines" : include