aboutsummaryrefslogtreecommitdiffstats
path: root/powerpc/TargetPrinter.ml
diff options
context:
space:
mode:
Diffstat (limited to 'powerpc/TargetPrinter.ml')
-rw-r--r--powerpc/TargetPrinter.ml128
1 files changed, 75 insertions, 53 deletions
diff --git a/powerpc/TargetPrinter.ml b/powerpc/TargetPrinter.ml
index 530e269d..73cb12f5 100644
--- a/powerpc/TargetPrinter.ml
+++ b/powerpc/TargetPrinter.ml
@@ -103,15 +103,15 @@ module Linux_System : SYSTEM =
let freg oc r =
output_string oc (float_reg_name r)
-
- let creg oc r =
+
+ let creg oc r =
fprintf oc "%d" r
-
+
let name_of_section = function
| Section_text -> ".text"
| Section_data i ->
if i then ".data" else "COMM"
- | Section_small_data i ->
+ | Section_small_data i ->
if i then ".section .sdata,\"aw\",@progbits" else "COMM"
| Section_const i ->
if i then ".rodata" else "COMM"
@@ -126,7 +126,11 @@ module Linux_System : SYSTEM =
| Section_debug_info _ -> ".section .debug_info,\"\",@progbits"
| Section_debug_abbrev -> ".section .debug_abbrev,\"\",@progbits"
| Section_debug_loc -> ".section .debug_loc,\"\",@progbits"
-
+ | Section_debug_line _ -> ".section .debug_line,\"\",@progbits"
+ | Section_debug_ranges -> ".section .debug_ranges,\"\",@progbits"
+ | Section_debug_str -> ".section .debug_str,\"MS\",@progbits,1"
+
+
let section oc sec =
let name = name_of_section sec in
assert (name <> "COMM");
@@ -135,40 +139,32 @@ module Linux_System : SYSTEM =
let print_file_line oc file line =
print_file_line oc comment file line
-
- (* Emit .cfi directives *)
+
+ (* Emit .cfi directives *)
let cfi_startproc = cfi_startproc
let cfi_endproc = cfi_endproc
-
+
let cfi_adjust = cfi_adjust
-
+
let cfi_rel_offset = cfi_rel_offset
- let print_prologue oc =
- if !Clflags.option_g then
- begin
- (* TODO print file *)
+ let print_prologue oc =
+ 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" label low_pc;
fprintf oc " .cfi_sections .debug_frame\n"
end
let 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" label high_pc
end
let debug_section _ _ = ()
end
-
+
module Diab_System : SYSTEM =
struct
@@ -188,7 +184,7 @@ module Diab_System : SYSTEM =
symbol_fragment oc s n "@sdax@l"
| Csymbol_rel_high(s, n) ->
symbol_fragment oc s n "@sdarx@ha"
-
+
let ireg oc r =
output_char oc 'r';
output_string oc (int_reg_name r)
@@ -196,10 +192,10 @@ module Diab_System : SYSTEM =
let freg oc r =
output_char oc 'f';
output_string oc (float_reg_name r)
-
+
let creg oc r =
fprintf oc "cr%d" r
-
+
let name_of_section = function
| Section_text -> ".text"
| Section_data i -> if i then ".data" else "COMM"
@@ -217,18 +213,26 @@ module Diab_System : SYSTEM =
| true, false -> 'd' (* data *)
| false, true -> 'c' (* text *)
| false, false -> 'r') (* const *)
- | Section_debug_info s -> sprintf ".section .debug_info%s,,n" (if s <> ".text" then s else "")
+ | Section_debug_info (Some s) ->
+ sprintf ".section .debug_info%s,,n" s
+ | Section_debug_info None ->
+ sprintf ".section .debug_info,,n"
| Section_debug_abbrev -> ".section .debug_abbrev,,n"
| Section_debug_loc -> ".section .debug_loc,,n"
+ | Section_debug_line (Some s) ->
+ sprintf ".section .debug_line.%s,,n\n" s
+ | Section_debug_line None ->
+ sprintf ".section .debug_line,,n\n"
+ | Section_debug_ranges
+ | Section_debug_str -> assert false (* Should not be used *)
let section oc sec =
let name = name_of_section sec in
assert (name <> "COMM");
match sec with
- | Section_debug_info s ->
+ | Section_debug_info (Some s) ->
fprintf oc " %s\n" name;
- if s <> ".text" then
- fprintf oc " .sectionlink .debug_info\n"
+ fprintf oc " .sectionlink .debug_info\n"
| _ ->
fprintf oc " %s\n" name
@@ -246,20 +250,21 @@ module Diab_System : SYSTEM =
let debug_section oc sec =
match sec with
- | Section_debug_abbrev
+ | Section_debug_abbrev
| Section_debug_info _
+ | Section_debug_str
| Section_debug_loc -> ()
| sec ->
let name = match sec with
| Section_user (name,_,_) -> name
| _ -> name_of_section sec in
- if not (Debug.exists_section name) then
+ if not (Debug.exists_section sec) then
let line_start = new_label ()
and low_pc = new_label ()
and debug_info = new_label () in
- Debug.add_diab_info name (line_start,debug_info,name_of_section sec);
- Debug.add_compilation_section_start name low_pc;
- let line_name = ".debug_line" ^(if name <> ".text" then name else "") in
+ Debug.add_diab_info sec line_start debug_info low_pc;
+ let line_name = ".debug_line" ^(if name <> ".text" then name else "") in
+ section oc (Section_debug_line (if name <> ".text" then Some name else None));
fprintf oc " .section %s,,n\n" line_name;
if name <> ".text" then
fprintf oc " .sectionlink .debug_line\n";
@@ -270,18 +275,18 @@ module Diab_System : SYSTEM =
fprintf oc " .d2_line_start %s\n" line_name
else
()
-
+
let print_prologue oc =
fprintf oc " .xopt align-fill-text=0x60000000\n";
debug_section oc Section_text
let print_epilogue oc =
- let end_label sec =
+ let end_label sec =
fprintf oc "\n";
- fprintf oc " %s\n" sec;
+ section oc sec;
let label_end = new_label () in
fprintf oc "%a:\n" label label_end;
- label_end
+ label_end
and entry_label f =
let label = new_label () in
fprintf oc ".L%d: .d2filenum \"%s\"\n" label f;
@@ -297,7 +302,7 @@ module Target (System : SYSTEM):TARGET =
(* Basic printing functions *)
let symbol = symbol
-
+
let raw_symbol oc s =
fprintf oc "%s" s
@@ -362,7 +367,7 @@ module Target (System : SYSTEM):TARGET =
let short_cond_branch tbl pc lbl_dest =
match PTree.get lbl_dest tbl with
| None -> assert false
- | Some pc_dest ->
+ | Some pc_dest ->
let disp = pc_dest - pc in -0x2000 <= disp && disp < 0x2000
(* Printing of instructions *)
@@ -483,6 +488,8 @@ module Target (System : SYSTEM):TARGET =
fprintf oc " extsb %a, %a\n" ireg r1 ireg r2
| Pextsh(r1, r2) ->
fprintf oc " extsh %a, %a\n" ireg r1 ireg r2
+ | Pextsw(r1, r2) ->
+ fprintf oc " extsw %a, %a\n" ireg r1 ireg r2
| Pfreeframe(sz, ofs) ->
assert false
| Pfabs(r1, r2) | Pfabss(r1, r2) ->
@@ -493,8 +500,18 @@ module Target (System : SYSTEM):TARGET =
fprintf oc " fadds %a, %a, %a\n" freg r1 freg r2 freg r3
| Pfcmpu(r1, r2) ->
fprintf oc " fcmpu %a, %a, %a\n" creg 0 freg r1 freg r2
+ | Pfcfi(r1, r2) ->
+ assert false
+ | Pfcfid(r1, r2) ->
+ fprintf oc " fcfid %a, %a\n" freg r1 freg r2
+ | Pfcfiu(r1, r2) ->
+ assert false
| Pfcti(r1, r2) ->
assert false
+ | Pfctidz(r1, r2) ->
+ fprintf oc " fctidz %a, %a\n" freg r1 freg r2
+ | Pfctiu(r1, r2) ->
+ assert false
| Pfctiw(r1, r2) ->
fprintf oc " fctiw %a, %a\n" freg r1 freg r2
| Pfctiwz(r1, r2) ->
@@ -530,11 +547,11 @@ module Target (System : SYSTEM):TARGET =
| Pfnmsub(r1, r2, r3, r4) ->
fprintf oc " fnmsub %a, %a, %a, %a\n" freg r1 freg r2 freg r3 freg r4
| Pfsqrt(r1, r2) ->
- fprintf oc " fsqrt %a, %a\n" freg r1 freg r2
+ fprintf oc " fsqrt %a, %a\n" freg r1 freg r2
| Pfrsqrte(r1, r2) ->
- fprintf oc " frsqrte %a, %a\n" freg r1 freg r2
+ fprintf oc " frsqrte %a, %a\n" freg r1 freg r2
| Pfres(r1, r2) ->
- fprintf oc " fres %a, %a\n" freg r1 freg r2
+ fprintf oc " fres %a, %a\n" freg r1 freg r2
| Pfsel(r1, r2, r3, r4) ->
fprintf oc " fsel %a, %a, %a, %a\n" freg r1 freg r2 freg r3 freg r4
| Pisel (r1,r2,r3,cr) ->
@@ -627,6 +644,9 @@ module Target (System : SYSTEM):TARGET =
fprintf oc " ori %a, %a, %a\n" ireg r1 ireg r2 constant c
| Poris(r1, r2, c) ->
fprintf oc " oris %a, %a, %a\n" ireg r1 ireg r2 constant c
+ | Prldicl(r1, r2, c1, c2) ->
+ fprintf oc " rldicl %a, %a, %ld, %ld\n"
+ ireg r1 ireg r2 (camlint_of_coqint c1) (camlint_of_coqint c2)
| Prlwinm(r1, r2, c1, c2) ->
let (mb, me) = rolm_mask (camlint_of_coqint c2) in
fprintf oc " rlwinm %a, %a, %ld, %d, %d %s 0x%lx\n"
@@ -649,6 +669,8 @@ module Target (System : SYSTEM):TARGET =
fprintf oc " stb %a, %a(%a)\n" ireg r1 constant c ireg r2
| Pstbx(r1, r2, r3) ->
fprintf oc " stbx %a, %a, %a\n" ireg r1 ireg r2 ireg r3
+ | Pstdu(r1, c, r2) ->
+ fprintf oc " stdu %a, %a(%a)\n" ireg r1 constant c ireg r2
| Pstfd(r1, c, r2) | Pstfd_a(r1, c, r2) ->
fprintf oc " stfd %a, %a(%a)\n" freg r1 constant c ireg r2
| Pstfdu(r1, c, r2) ->
@@ -703,13 +725,13 @@ module Target (System : SYSTEM):TARGET =
begin match ef with
| EF_annot(txt, targs) ->
fprintf oc "%s annotation: " comment;
- print_annot_text preg_annot "r1" oc (extern_atom txt) args
+ print_annot_text preg_annot "r1" oc (camlstring_of_coqstring txt) args
| EF_debug(kind, txt, targs) ->
print_debug_info comment print_file_line preg_annot "r1" oc
(P.to_int kind) (extern_atom txt) args
| EF_inline_asm(txt, sg, clob) ->
fprintf oc "%s begin inline assembly\n\t" comment;
- print_inline_asm preg oc (extern_atom txt) sg args res;
+ print_inline_asm preg oc (camlstring_of_coqstring txt) sg args res;
fprintf oc "%s end inline assembly\n" comment
| _ ->
assert false
@@ -797,10 +819,10 @@ module Target (System : SYSTEM):TARGET =
if Z.gt n Z.zero then
fprintf oc " .space %s\n" (Z.to_string n)
| Init_addrof(symb, ofs) ->
- fprintf oc " .long %a\n"
+ fprintf oc " .long %a\n"
symbol_offset (symb, ofs)
-
+
let print_fun_info = elf_print_fun_info
let emit_constants oc lit =
@@ -814,26 +836,26 @@ module Target (System : SYSTEM):TARGET =
let print_optional_fun_info _ = ()
- let get_section_names name =
+ let get_section_names name =
match C2C.atom_sections name with
| [t;l;j] -> (t, l, j)
| _ -> (Section_text, Section_literal, Section_jumptable)
-
+
let reset_constants = reset_constants
-
+
let print_var_info = elf_print_var_info
- let print_comm_symb oc sz name align =
+ let print_comm_symb oc sz name align =
fprintf oc " %s %a, %s, %d\n"
(if C2C.atom_is_static name then ".lcomm" else ".comm")
symbol name
(Z.to_string sz)
align
-
+
let print_align oc align =
fprintf oc " .balign %d\n" align
- let print_jumptable oc jmptbl =
+ let print_jumptable oc jmptbl =
let print_jumptable oc (lbl, tbl) =
fprintf oc "%a:" label lbl;
List.iter
@@ -848,7 +870,7 @@ module Target (System : SYSTEM):TARGET =
let default_falignment = 4
- let new_label = new_label
+ let new_label = new_label
let section oc sec =
section oc sec;
@@ -856,7 +878,7 @@ module Target (System : SYSTEM):TARGET =
end
let sel_target () =
- let module S = (val
+ let module S = (val
(match Configuration.system with
| "linux" -> (module Linux_System:SYSTEM)
| "diab" -> (module Diab_System:SYSTEM)