diff options
Diffstat (limited to 'ia32')
-rw-r--r-- | ia32/AsmToJSON.ml | 2 | ||||
-rw-r--r-- | ia32/Asmexpand.ml | 54 | ||||
-rw-r--r-- | ia32/TargetPrinter.ml | 52 |
3 files changed, 65 insertions, 43 deletions
diff --git a/ia32/AsmToJSON.ml b/ia32/AsmToJSON.ml index de39cb9d..3214491f 100644 --- a/ia32/AsmToJSON.ml +++ b/ia32/AsmToJSON.ml @@ -10,7 +10,7 @@ (* *) (* *********************************************************************) -(* Simple functions to serialize powerpc Asm to JSON *) +(* Simple functions to serialize ia32 Asm to JSON *) (* Dummy function *) let p_program oc prog = diff --git a/ia32/Asmexpand.ml b/ia32/Asmexpand.ml index baf0523e..4f02e633 100644 --- a/ia32/Asmexpand.ml +++ b/ia32/Asmexpand.ml @@ -387,36 +387,46 @@ let expand_instruction instr = end | _ -> emit instr -let expand_function fn = - try - set_current_function fn; - List.iter expand_instruction fn.fn_code; - Errors.OK (get_current_function ()) - with Error s -> - Errors.Error (Errors.msg (coqstring_of_camlstring s)) +let int_reg_to_dwarf = function + | EAX -> 0 + | EBX -> 3 + | ECX -> 1 + | EDX -> 2 + | ESI -> 6 + | EDI -> 7 + | EBP -> 5 + | ESP -> 4 -let expand_fundef = function - | Internal f -> - begin match expand_function f with - | Errors.OK tf -> Errors.OK (Internal tf) - | Errors.Error msg -> Errors.Error msg - end - | External ef -> - Errors.OK (External ef) +let float_reg_to_dwarf = function + | XMM0 -> 21 + | XMM1 -> 22 + | XMM2 -> 23 + | XMM3 -> 24 + | XMM4 -> 25 + | XMM5 -> 26 + | XMM6 -> 27 + | XMM7 -> 28 -let expand_program (p: Asm.program) : Asm.program Errors.res = - AST.transform_partial_program expand_fundef p -let expand_function fn = +let preg_to_dwarf = function + | IR r -> int_reg_to_dwarf r + | FR r -> float_reg_to_dwarf r + | _ -> assert false + + +let expand_function id fn = try set_current_function fn; - List.iter expand_instruction fn.fn_code; + if !Clflags.option_g then + expand_debug id 4 preg_to_dwarf expand_instruction fn.fn_code + else + List.iter expand_instruction fn.fn_code; Errors.OK (get_current_function ()) with Error s -> Errors.Error (Errors.msg (coqstring_of_camlstring s)) -let expand_fundef = function +let expand_fundef id = function | Internal f -> - begin match expand_function f with + begin match expand_function id f with | Errors.OK tf -> Errors.OK (Internal tf) | Errors.Error msg -> Errors.Error msg end @@ -424,4 +434,4 @@ let expand_fundef = function Errors.OK (External ef) let expand_program (p: Asm.program) : Asm.program Errors.res = - AST.transform_partial_program expand_fundef p + AST.transform_partial_ident_program expand_fundef p diff --git a/ia32/TargetPrinter.ml b/ia32/TargetPrinter.ml index 439dd2b0..95de40ca 100644 --- a/ia32/TargetPrinter.ml +++ b/ia32/TargetPrinter.ml @@ -20,6 +20,7 @@ open AST open Memdata open Asm open PrintAsmaux +open Fileinfo module StringSet = Set.Make(String) @@ -101,8 +102,10 @@ module Cygwin_System : SYSTEM = | Section_user(s, wr, ex) -> sprintf ".section \"%s\", \"%s\"\n" s (if ex then "xr" else if wr then "d" else "dr") - | Section_debug_info - | Section_debug_abbrev -> "" (* Dummy value *) + | Section_debug_info _ -> ".section .debug_info,\"dr\"" + | Section_debug_loc -> ".section .debug_loc,\"dr\"" + | Section_debug_line _ -> ".section .debug_line,\"dr\"" + | Section_debug_abbrev -> ".section .debug_abbrev,\"dr\"" (* Dummy value *) let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *) @@ -150,8 +153,10 @@ module ELF_System : SYSTEM = | Section_user(s, wr, ex) -> sprintf ".section \"%s\",\"a%s%s\",@progbits" s (if wr then "w" else "") (if ex then "x" else "") - | Section_debug_info - | Section_debug_abbrev -> "" (* Dummy value *) + | Section_debug_info _ -> ".section .debug_info,\"\",@progbits" + | Section_debug_loc -> ".section .debug_loc,\"\",@progbits" + | Section_debug_line _ -> ".section .debug_line,\"\",@progbits" + | Section_debug_abbrev -> ".section .debug_abbrev,\"\",@progbits" let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *) @@ -202,8 +207,11 @@ module MacOS_System : SYSTEM = sprintf ".section \"%s\", %s, %s" (if wr then "__DATA" else "__TEXT") s (if ex then "regular, pure_instructions" else "regular") - | Section_debug_info - | Section_debug_abbrev -> "" (* Dummy value *) + | Section_debug_info _ -> ".section __DWARF,__debug_info,regular,debug" + | Section_debug_loc -> ".section __DWARF,__debug_loc,regular,debug" + | Section_debug_line _ -> ".section __DWARF,__debug_line,regular,debug" + | Section_debug_abbrev -> ".section __DWARF,__debug_abbrev,regular,debug" (* Dummy value *) + let stack_alignment = 16 (* mandatory *) @@ -741,9 +749,16 @@ module Target(System: SYSTEM):TARGET = let print_var_info = print_var_info - let print_prologue _ = - need_masks := false - + let print_prologue oc = + need_masks := false; + if !Clflags.option_g then begin + section oc Section_text; + let low_pc = new_label () in + Debug.add_compilation_section_start ".text" low_pc; + fprintf oc "%a:\n" elf_label low_pc; + fprintf oc " .cfi_sections .debug_frame\n" + end + let print_epilogue oc = if !need_masks then begin section oc (Section_const true); @@ -758,25 +773,22 @@ module Target(System: SYSTEM):TARGET = fprintf oc "%a: .long 0x7FFFFFFF, 0xFFFFFFFF, 0xFFFFFFFF, 0xFFFFFFFF\n" raw_symbol "__abss_mask" end; - System.print_epilogue oc + System.print_epilogue oc; + if !Clflags.option_g then begin + let high_pc = new_label () in + Debug.add_compilation_section_end ".text" high_pc; + Debug.compute_gnu_file_enum (fun f -> ignore (print_file oc f)); + section oc Section_text; + fprintf oc "%a:\n" elf_label high_pc + end let comment = comment let default_falignment = 16 - let get_start_addr () = -1 (* Dummy constant *) - - let get_end_addr () = -1 (* Dummy constant *) - - let get_stmt_list_addr () = -1 (* Dummy constant *) - - module DwarfAbbrevs = DwarfUtil.DefaultAbbrevs (* Dummy Abbrev types *) - let label = label let new_label = new_label - - let print_file_loc _ _ = () (* Dummy function *) end |