(***********************************************************************) (* *) (* OCaml *) (* *) (* Fabrice Le Fessant, projet Gallium, INRIA Rocquencourt *) (* *) (* Copyright 2014 Institut National de Recherche en Informatique et *) (* en Automatique. All rights reserved. This file is distributed *) (* under the terms of the Q Public License version 1.0. *) (* *) (***********************************************************************) open X86_ast type system = (* 32 bits and 64 bits *) | S_macosx | S_gnu | S_cygwin (* 32 bits only *) | S_solaris | S_win32 | S_linux_elf | S_bsd_elf | S_beos | S_mingw (* 64 bits only *) | S_win64 | S_linux | S_mingw64 | S_unknown let system = match Config.system with | "macosx" -> S_macosx | "solaris" -> S_solaris | "win32" -> S_win32 | "linux_elf" -> S_linux_elf | "bsd_elf" -> S_bsd_elf | "beos" -> S_beos | "gnu" -> S_gnu | "cygwin" -> S_cygwin | "mingw" -> S_mingw | "mingw64" -> S_mingw64 | "win64" -> S_win64 | "linux" -> S_linux | _ -> S_unknown let string_of_string_literal s = let b = Buffer.create (String.length s + 2) in let last_was_escape = ref false in for i = 0 to String.length s - 1 do let c = s.[i] in if c >= '0' && c <= '9' then if !last_was_escape then Printf.bprintf b "\\%o" (Char.code c) else Buffer.add_char b c else if c >= ' ' && c <= '~' && c <> '"' (* '"' *) && c <> '\\' then begin Buffer.add_char b c; last_was_escape := false end else begin Printf.bprintf b "\\%o" (Char.code c); last_was_escape := true end done; Buffer.contents b let string_of_symbol prefix s = let spec = ref false in for i = 0 to String.length s - 1 do match String.unsafe_get s i with | 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' -> () | _ -> spec := true; done; if not !spec then if prefix = "" then s else prefix ^ s else let b = Buffer.create (String.length s + 10) in Buffer.add_string b prefix; String.iter (function | ('A'..'Z' | 'a'..'z' | '0'..'9' | '_') as c -> Buffer.add_char b c | c -> Printf.bprintf b "$%02x" (Char.code c) ) s; Buffer.contents b let buf_bytes_directive b directive s = let pos = ref 0 in for i = 0 to String.length s - 1 do if !pos = 0 then begin if i > 0 then Buffer.add_char b '\n'; Buffer.add_char b '\t'; Buffer.add_string b directive; Buffer.add_char b '\t'; end else Buffer.add_char b ','; Printf.bprintf b "%d" (Char.code s.[i]); incr pos; if !pos >= 16 then begin pos := 0 end done let string_of_reg64 = function | RAX -> "rax" | RBX -> "rbx" | RDI -> "rdi" | RSI -> "rsi" | RDX -> "rdx" | RCX -> "rcx" | RBP -> "rbp" | RSP -> "rsp" | R8 -> "r8" | R9 -> "r9" | R10 -> "r10" | R11 -> "r11" | R12 -> "r12" | R13 -> "r13" | R14 -> "r14" | R15 -> "r15" let string_of_reg8l = function | RAX -> "al" | RBX -> "bl" | RCX -> "cl" | RDX -> "dl" | RSP -> "spl" | RBP -> "bpl" | RSI -> "sil" | RDI -> "dil" | R8 -> "r8b" | R9 -> "r9b" | R10 -> "r10b" | R11 -> "r11b" | R12 -> "r12b" | R13 -> "r13b" | R14 -> "r14b" | R15 -> "r15b" let string_of_reg8h = function | AH -> "ah" | BH -> "bh" | CH -> "ch" | DH -> "dh" let string_of_reg16 = function | RAX -> "ax" | RBX -> "bx" | RCX -> "cx" | RDX -> "dx" | RSP -> "sp" | RBP -> "bp" | RSI -> "si" | RDI -> "di" | R8 -> "r8w" | R9 -> "r9w" | R10 -> "r10w" | R11 -> "r11w" | R12 -> "r12w" | R13 -> "r13w" | R14 -> "r14w" | R15 -> "r15w" let string_of_reg32 = function | RAX -> "eax" | RBX -> "ebx" | RCX -> "ecx" | RDX -> "edx" | RSP -> "esp" | RBP -> "ebp" | RSI -> "esi" | RDI -> "edi" | R8 -> "r8d" | R9 -> "r9d" | R10 -> "r10d" | R11 -> "r11d" | R12 -> "r12d" | R13 -> "r13d" | R14 -> "r14d" | R15 -> "r15d" let string_of_registerf = function | XMM n -> Printf.sprintf "xmm%d" n | TOS -> Printf.sprintf "tos" | ST n -> Printf.sprintf "st(%d)" n let string_of_condition = function | E -> "e" | AE -> "ae" | A -> "a" | GE -> "ge" | G -> "g" | NE -> "ne" | B -> "b" | BE -> "be" | L -> "l" | LE -> "le" | NP -> "np" | P -> "p" | NS -> "ns" | S -> "s" | NO -> "no" | O -> "o" let string_of_rounding = function | RoundDown -> "roundsd.down" | RoundUp -> "roundsd.up" | RoundTruncate -> "roundsd.trunc" | RoundNearest -> "roundsd.near" (* These hooks can be used to insert optimization passes on the assembly code. *) let assembler_passes = ref ([] : (asm_program -> asm_program) list) let internal_assembler = ref None let register_internal_assembler f = internal_assembler := Some f (* Which asm conventions to use *) let masm = match system with | S_win32 | S_win64 -> true | _ -> false (* Shall we use an external assembler command ? If [binary_content] contains some data, we can directly save it. Otherwise, we have to ask an external command. *) let binary_content = ref None let compile infile outfile = if masm then Ccomp.command (Config.asm ^ Filename.quote outfile ^ " " ^ Filename.quote infile ^ (if !Clflags.verbose then "" else ">NUL")) else Ccomp.command (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) let assemble_file infile outfile = match !binary_content with | None -> compile infile outfile | Some content -> content outfile; binary_content := None; 0 let asm_code = ref [] let directive dir = asm_code := dir :: !asm_code let emit ins = directive (Ins ins) let reset_asm_code () = asm_code := [] let generate_code asm = let instrs = List.rev !asm_code in let instrs = List.fold_left (fun instrs pass -> pass instrs) instrs !assembler_passes in begin match asm with | Some f -> f instrs | None -> () end; begin match !internal_assembler with | Some f -> binary_content := Some (f instrs) | None -> binary_content := None end