From a69c12c79b440ad0fe31eacf53825f5e62848671 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Wed, 8 Oct 2014 17:57:07 +0200 Subject: Refactored the code of ia32/PrintAsm.ml by moving the functions depending on the target system in a seperate module. --- ia32/PrintAsm.ml | 358 ++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 220 insertions(+), 138 deletions(-) diff --git a/ia32/PrintAsm.ml b/ia32/PrintAsm.ml index 8828faa3..5c84af6b 100644 --- a/ia32/PrintAsm.ml +++ b/ia32/PrintAsm.ml @@ -22,58 +22,7 @@ open Asm module StringSet = Set.Make(String) -(* Recognition of target ABI and asm syntax *) - -type target = ELF | MacOS | Cygwin - -let target = - match Configuration.system with - | "macosx" -> MacOS - | "linux" -> ELF - | "bsd" -> ELF - | "cygwin" -> Cygwin - | _ -> invalid_arg ("System " ^ Configuration.system ^ " not supported") - -(* On-the-fly label renaming *) - -let next_label = ref 100 - -let new_label() = - let lbl = !next_label in incr next_label; lbl - -let current_function_labels = (Hashtbl.create 39 : (label, int) Hashtbl.t) - -let transl_label lbl = - try - Hashtbl.find current_function_labels lbl - with Not_found -> - let lbl' = new_label() in - Hashtbl.add current_function_labels lbl lbl'; - lbl' - -(* Basic printing functions *) - -let coqint oc n = - fprintf oc "%ld" (camlint_of_coqint n) - -let raw_symbol oc s = - match target with - | ELF -> fprintf oc "%s" s - | MacOS | Cygwin -> fprintf oc "_%s" s - -let symbol oc symb = - raw_symbol oc (extern_atom symb) - -let symbol_offset oc (symb, ofs) = - symbol oc symb; - if ofs <> 0l then fprintf oc " + %ld" ofs - -let label oc lbl = - match target with - | ELF -> fprintf oc ".L%d" lbl - | MacOS | Cygwin -> fprintf oc "L%d" lbl - -let comment = "#" +(* Basic printing functions used in definition of the systems *) let int_reg_name = function | EAX -> "%eax" | EBX -> "%ebx" | ECX -> "%ecx" | EDX -> "%edx" @@ -106,6 +55,194 @@ let preg oc = function | FR r -> freg oc r | _ -> assert false + +(* System dependend printer functions *) +module type SYSTEM= + sig + val raw_symbol: out_channel -> string -> unit + val symbol: out_channel -> P.t -> unit + val label: out_channel -> int -> unit + val name_of_section: section_name -> string + val stack_alignment: int + val print_align: out_channel -> int -> unit + val print_mov_ra: out_channel -> ireg -> ident -> unit + val print_fun_info: out_channel -> P.t -> unit + val print_var_info: out_channel -> P.t -> unit + val print_epilogue: out_channel -> unit + end + +(* Printer functions for cygwin *) +module Cygwin_System = + (struct + + let raw_symbol oc s = + fprintf oc "_%s" s + + let symbol oc symb = + fprintf oc "%s" (extern_atom symb) + + let label oc lbl = + fprintf oc "L%d" lbl + + let name_of_section = function + | Section_text -> ".text" + | Section_data _ | Section_small_data _ -> ".data" + | Section_const | Section_small_const -> ".section .rdata,\"dr\"" + | Section_string -> ".section .rdata,\"dr\"" + | Section_literal -> ".section .rdata,\"dr\"" + | Section_jumptable -> ".text" + | Section_user(s, wr, ex) -> + sprintf ".section \"%s\", \"%s\"\n" + s (if ex then "xr" else if wr then "d" else "dr") + + let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *) + + let print_align oc n = + fprintf oc " .align %d\n" n + + let print_mov_ra oc rd id = + fprintf oc " movl $%a, %a\n" symbol id ireg rd + + let print_fun_info _ _ = () + + let print_var_info _ _ = () + + let print_epilogue _ = () + end:SYSTEM) + +(* Printer functions for ELF *) +module ELF_System = + (struct + + let raw_symbol oc s = + fprintf oc "%s" s + + let symbol oc symb = + fprintf oc "%s" (extern_atom symb) + + let label oc lbl = + fprintf oc ".L%d" lbl + + let name_of_section = function + | Section_text -> ".text" + | Section_data i | Section_small_data i -> if i then ".data" else "COMM" + | Section_const | Section_small_const -> ".section .rodata" + | Section_string -> ".section .rodata" + | Section_literal -> ".section .rodata.cst8,\"aM\",@progbits,8" + | Section_jumptable -> ".text" + | Section_user(s, wr, ex) -> + sprintf ".section \"%s\",\"a%s%s\",@progbits" + s (if wr then "w" else "") (if ex then "x" else "") + + let stack_alignment = 8 (* minimum is 4, 8 is better for perfs *) + + let print_align oc n = + fprintf oc " .align %d\n" n + + let print_mov_ra oc rd id = + fprintf oc " movl $%a, %a\n" symbol id ireg rd + + let print_fun_info oc name = + fprintf oc " .type %a, @function\n" symbol name; + fprintf oc " .size %a, . - %a\n" symbol name symbol name + + let print_var_info oc name = + fprintf oc " .type %a, @object\n" symbol name; + fprintf oc " .size %a, . - %a\n" symbol name symbol name + + let print_epilogue _ = () + end:SYSTEM) + +(* Printer functions for MacOS *) +module MacOS_System = + (struct + + let raw_symbol oc s = + fprintf oc "_%s" s + + let symbol oc symb = + fprintf oc "%s" (extern_atom symb) + + let label oc lbl = + fprintf oc "L%d" lbl + + let name_of_section = function + | Section_text -> ".text" + | Section_data _ | Section_small_data _ -> ".data" + | Section_const | Section_small_const -> ".const" + | Section_string -> ".const" + | Section_literal -> ".literal8" + | Section_jumptable -> ".const" + | Section_user(s, wr, ex) -> + sprintf ".section \"%s\", %s, %s" + (if wr then "__DATA" else "__TEXT") s + (if ex then "regular, pure_instructions" else "regular") + + let stack_alignment = 16 (* mandatory *) + + (* Base-2 log of a Caml integer *) + let rec log2 n = + assert (n > 0); + if n = 1 then 0 else 1 + log2 (n lsr 1) + + let print_align oc n = + fprintf oc " .align %d\n" (log2 n) + + let indirect_symbols : StringSet.t ref = ref StringSet.empty + + let print_mov_ra oc rd id = + let id = extern_atom id in + indirect_symbols := StringSet.add id !indirect_symbols; + fprintf oc " movl L%a$non_lazy_ptr, %a\n" raw_symbol id ireg rd + + let print_fun_info _ _ = () + + let print_var_info _ _ = () + + let print_epilogue oc = + fprintf oc " .section __IMPORT,__pointers,non_lazy_symbol_pointers\n"; + StringSet.iter + (fun s -> + fprintf oc "L%a$non_lazy_ptr:\n" raw_symbol s; + fprintf oc " .indirect_symbol %a\n" raw_symbol s; + fprintf oc " .long 0\n") + !indirect_symbols + + end:SYSTEM) + + +module AsmPrinter(Target: SYSTEM) = + (struct + open Target +(* On-the-fly label renaming *) + +let next_label = ref 100 + +let new_label() = + let lbl = !next_label in incr next_label; lbl + +let current_function_labels = (Hashtbl.create 39 : (label, int) Hashtbl.t) + +let transl_label lbl = + try + Hashtbl.find current_function_labels lbl + with Not_found -> + let lbl' = new_label() in + Hashtbl.add current_function_labels lbl lbl'; + lbl' + + +(* basic printing functions *) + +let comment = "#" + +let symbol_offset oc (symb, ofs) = + symbol oc symb; + if ofs <> 0l then fprintf oc " + %ld" ofs + +let coqint oc n = + fprintf oc "%ld" (camlint_of_coqint n) + let addressing oc (Addrmode(base, shift, cst)) = begin match cst with | Coq_inl n -> @@ -136,58 +273,13 @@ let name_of_neg_condition = function | Cond_l -> "ge" | Cond_le -> "g" | Cond_ge -> "l" | Cond_g -> "le" | Cond_p -> "np" | Cond_np -> "p" -(* Names of sections *) - -let name_of_section_ELF = function - | Section_text -> ".text" - | Section_data i | Section_small_data i -> if i then ".data" else "COMM" - | Section_const | Section_small_const -> ".section .rodata" - | Section_string -> ".section .rodata" - | Section_literal -> ".section .rodata.cst8,\"aM\",@progbits,8" - | Section_jumptable -> ".text" - | Section_user(s, wr, ex) -> - sprintf ".section \"%s\",\"a%s%s\",@progbits" - s (if wr then "w" else "") (if ex then "x" else "") - -let name_of_section_MacOS = function - | Section_text -> ".text" - | Section_data _ | Section_small_data _ -> ".data" - | Section_const | Section_small_const -> ".const" - | Section_string -> ".const" - | Section_literal -> ".literal8" - | Section_jumptable -> ".const" - | Section_user(s, wr, ex) -> - sprintf ".section \"%s\", %s, %s" - (if wr then "__DATA" else "__TEXT") s - (if ex then "regular, pure_instructions" else "regular") - -let name_of_section_Cygwin = function - | Section_text -> ".text" - | Section_data _ | Section_small_data _ -> ".data" - | Section_const | Section_small_const -> ".section .rdata,\"dr\"" - | Section_string -> ".section .rdata,\"dr\"" - | Section_literal -> ".section .rdata,\"dr\"" - | Section_jumptable -> ".text" - | Section_user(s, wr, ex) -> - sprintf ".section \"%s\", \"%s\"\n" - s (if ex then "xr" else if wr then "d" else "dr") - -let name_of_section = - match target with - | ELF -> name_of_section_ELF - | MacOS -> name_of_section_MacOS - | Cygwin -> name_of_section_Cygwin +(* Names of sections *) let section oc sec = fprintf oc " %s\n" (name_of_section sec) (* SP adjustment to allocate or free a stack frame *) -let stack_alignment = - match target with - | ELF | Cygwin -> 8 (* minimum is 4, 8 is better for perfs *) - | MacOS -> 16 (* mandatory *) - let int32_align n a = if n >= 0l then Int32.logand (Int32.add n (Int32.of_int (a-1))) (Int32.of_int (-a)) @@ -209,11 +301,6 @@ let rec log2 n = (* Emit a align directive *) -let print_align oc n = - match target with - | ELF | Cygwin -> fprintf oc " .align %d\n" n - | MacOS -> fprintf oc " .align %d\n" (log2 n) - let need_masks = ref false (* Emit .file / .loc debugging directives *) @@ -562,12 +649,7 @@ let print_instruction oc = function | Pmov_ri(rd, n) -> fprintf oc " movl $%ld, %a\n" (camlint_of_coqint n) ireg rd | Pmov_ra(rd, id) -> - if target = MacOS then begin - let id = extern_atom id in - indirect_symbols := StringSet.add id !indirect_symbols; - fprintf oc " movl L%a$non_lazy_ptr, %a\n" raw_symbol id ireg rd - end else - fprintf oc " movl $%a, %a\n" symbol id ireg rd + print_mov_ra oc rd id | Pmov_rm(rd, a) | Pmov_rm_a(rd, a) -> fprintf oc " movl %a, %a\n" addressing a ireg rd | Pmov_mr(a, r1) | Pmov_mr_a(a, r1) -> @@ -841,10 +923,7 @@ let print_function oc name fn = cfi_startproc oc; List.iter (print_instruction oc) fn.fn_code; cfi_endproc oc; - if target = ELF then begin - fprintf oc " .type %a, @function\n" symbol name; - fprintf oc " .size %a, . - %a\n" symbol name symbol name - end; + print_fun_info oc name; if !float64_literals <> [] || !float32_literals <> [] then begin section oc lit; print_align oc 8; @@ -913,10 +992,7 @@ let print_var oc name v = fprintf oc " .globl %a\n" symbol name; fprintf oc "%a:\n" symbol name; print_init_data oc name v.gvar_init; - if target = ELF then begin - fprintf oc " .type %a, @object\n" symbol name; - fprintf oc " .size %a, . - %a\n" symbol name symbol name - end + print_var_info oc name end else begin let sz = match v.gvar_init with [Init_space sz] -> sz | _ -> assert false in @@ -933,31 +1009,37 @@ let print_globdef oc (name, gdef) = | Gfun(Internal code) -> print_function oc name code | Gfun(External ef) -> () | Gvar v -> print_var oc name v +end) + +type target = ELF | MacOS | Cygwin + let print_program oc p = - PrintAnnot.print_version_and_options oc comment; - need_masks := false; - indirect_symbols := StringSet.empty; - Hashtbl.clear filename_num; - List.iter (print_globdef oc) p.prog_defs; - if !need_masks then begin - section oc Section_const; (* not Section_literal because not 8-bytes *) - print_align oc 16; + let target = + match Configuration.system with + | "macosx" -> MacOS + | "linux" -> ELF + | "bsd" -> ELF + | "cygwin" -> Cygwin + | _ -> invalid_arg ("System " ^ Configuration.system ^ " not supported") in + let module Target = (val (match target with + | MacOS -> (module MacOS_System:SYSTEM) + | ELF -> (module ELF_System:SYSTEM) + | Cygwin -> (module Cygwin_System:SYSTEM)):SYSTEM) in + let module Printer = AsmPrinter(Target) in + PrintAnnot.print_version_and_options oc Printer.comment; + Printer.need_masks := false; + Hashtbl.clear Printer.filename_num; + List.iter (Printer.print_globdef oc) p.prog_defs; + if !Printer.need_masks then begin + Printer.section oc Section_const; (* not Section_literal because not 8-bytes *) + Target.print_align oc 16; fprintf oc "%a: .quad 0x8000000000000000, 0\n" - raw_symbol "__negd_mask"; + Target.raw_symbol "__negd_mask"; fprintf oc "%a: .quad 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF\n" - raw_symbol "__absd_mask"; + Target.raw_symbol "__absd_mask"; fprintf oc "%a: .long 0x80000000, 0, 0, 0\n" - raw_symbol "__negs_mask"; + Target.raw_symbol "__negs_mask"; fprintf oc "%a: .long 0x7FFFFFFF, 0xFFFFFFFF, 0xFFFFFFFF, 0xFFFFFFFF\n" - raw_symbol "__abss_mask" - end; - if target = MacOS then begin - fprintf oc " .section __IMPORT,__pointers,non_lazy_symbol_pointers\n"; - StringSet.iter - (fun s -> - fprintf oc "L%a$non_lazy_ptr:\n" raw_symbol s; - fprintf oc " .indirect_symbol %a\n" raw_symbol s; - fprintf oc " .long 0\n") - !indirect_symbols + Target.raw_symbol "__abss_mask" end -- cgit