source: Deliverables/D2.2/8051/src/RTL/RTLPrinter.ml

Last change on this file was 1589, checked in by tranquil, 8 years ago
  • turned to argument-less return statements for RTLabs and RTL (there was a hidden invariant, for which the arguments of return statements where equal to the f_result field of the function definition: they were useless and an optimization was breaking the compilation)
  • corrected a bug in liveness analysis I had introduced
File size: 5.1 KB
RevLine 
[486]1
2(** This module provides a function to print [RTL] programs. *)
3
4
5let n_spaces n = String.make n ' '
6
7
8let print_global n (x, size) =
9  Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
10
11let print_globals n globs =
12  Printf.sprintf "%sglobals:\n%s"
13    (n_spaces n)
14    (List.fold_left (fun s g -> s ^ (print_global (n+2) g) ^ "\n") "" globs)
15
16
17let print_reg = Register.print
18
[1568]19let print_arg = function
20  | RTL.Reg r -> print_reg r
21  | RTL.Imm i -> string_of_int i
22
[486]23let reg_set_to_list rs =
24  let f r l = l @ [r] in
25  Register.Set.fold f rs []
26
27let print_reg_list first last sep f rl =
28  Printf.sprintf "%s%s%s"
29    first (MiscPottier.string_of_list sep f rl) last
30
31let print_ptr rl = print_reg_list "[" "]" " ; " print_reg rl
32
[1572]33let print_args rl = print_reg_list "(" ")" ", " print_arg rl
[486]34
[1572]35let print_returned rl = print_reg_list "[" "]" " ; " print_reg rl
[486]36
[1572]37let print_return rl = print_reg_list "[" "]" " ; " print_arg rl
38
[486]39let print_params rl = print_reg_list "(" ")" ", " Register.print rl
40
41let print_locals rs =
42  let rl = reg_set_to_list rs in
43  Printf.sprintf "%s" (print_reg_list "" "" ", " Register.print rl)
44
45let print_result rl = print_reg_list "[" "]" " ; " Register.print rl
46
47
48let print_statement = function
49  | RTL.St_skip lbl -> "--> " ^ lbl
50  | RTL.St_cost (cost_lbl, lbl) ->
[1542]51    let cost_lbl = CostLabel.string_of_cost_label ~pretty:true cost_lbl in
[1568]52    Printf.sprintf "_emit %s --> %s" cost_lbl lbl
[1542]53  | RTL.St_ind_0 (i, lbl) ->
[1568]54    Printf.sprintf "_index %d --> %s" i lbl
[1542]55  | RTL.St_ind_inc (i, lbl) ->
[1568]56    Printf.sprintf "_increment %d --> %s" i lbl
[486]57  | RTL.St_addr (dstr1, dstr2, id, lbl) ->
[1568]58    Printf.sprintf "move (%s, %s), %s --> %s"
[486]59      (print_reg dstr1) (print_reg dstr2) id lbl
60  | RTL.St_stackaddr (dstr1, dstr2, lbl) ->
[1568]61    Printf.sprintf "move (%s, %s), STACK --> %s"
[486]62      (print_reg dstr1) (print_reg dstr2) lbl
[1568]63  (* | RTL.St_int (dstr, i, lbl) -> *)
64  (*   Printf.sprintf "imm %s, %d --> %s" (print_reg dstr) i lbl *)
[486]65  | RTL.St_move (dstr, srcr, lbl) ->
66    Printf.sprintf "move %s, %s --> %s"
[1568]67      (print_reg dstr) (print_arg srcr) lbl
[818]68  | RTL.St_opaccs (opaccs, dstr1, dstr2, srcr1, srcr2, lbl) ->
69    Printf.sprintf "%s (%s, %s) %s, %s --> %s"
[486]70      (I8051.print_opaccs opaccs)
[818]71      (print_reg dstr1)
72      (print_reg dstr2)
[1572]73      (print_arg srcr1)
74      (print_arg srcr2)
[486]75      lbl
76  | RTL.St_op1 (op1, dstr, srcr, lbl) ->
77    Printf.sprintf "%s %s, %s --> %s"
78      (I8051.print_op1 op1) (print_reg dstr) (print_reg srcr) lbl
79  | RTL.St_op2 (op2, dstr, srcr1, srcr2, lbl) ->
80    Printf.sprintf "%s %s, %s, %s --> %s"
81      (I8051.print_op2 op2)
82      (print_reg dstr)
[1572]83      (print_arg srcr1)
[1568]84      (print_arg srcr2)
[486]85      lbl
86  | RTL.St_clear_carry lbl ->
87    Printf.sprintf "clear CARRY --> %s" lbl
[818]88  | RTL.St_set_carry lbl ->
89    Printf.sprintf "set CARRY --> %s" lbl
[486]90  | RTL.St_load (dstr, addr1, addr2, lbl) ->
91    Printf.sprintf "load %s, (%s, %s) --> %s"
92      (print_reg dstr)
[1572]93      (print_arg addr1)
94      (print_arg addr2)
[486]95      lbl
96  | RTL.St_store (addr1, addr2, srcr, lbl) ->
97    Printf.sprintf "store (%s, %s), %s --> %s"
[1572]98      (print_arg addr1)
99      (print_arg addr2)
100      (print_arg srcr)
[486]101      lbl
102  | RTL.St_call_id (f, args, dstrs, lbl) ->
103    Printf.sprintf "call \"%s\", %s, %s --> %s"
104      f
105      (print_args args)
[1572]106      (print_returned dstrs)
[486]107      lbl
108  | RTL.St_call_ptr (f1, f2, args, dstrs, lbl) ->
109    Printf.sprintf "call_ptr [%s ; %s], %s, %s --> %s"
110      (print_reg f1)
111      (print_reg f2)
112      (print_args args)
[1572]113      (print_returned dstrs)
[486]114      lbl
115  | RTL.St_tailcall_id (f, args) ->
116    Printf.sprintf "tailcall \"%s\", %s"
117      f
118      (print_args args)
119  | RTL.St_tailcall_ptr (f1, f2, args) ->
120    Printf.sprintf "tailcall_ptr [%s ; %s], %s"
121      (print_reg f1)
122      (print_reg f2)
123      (print_args args)
[818]124  | RTL.St_cond (srcr, lbl_true, lbl_false) ->
[486]125    Printf.sprintf "branch %s <> 0 --> %s, %s"
126      (print_reg srcr) lbl_true lbl_false
[1589]127  | RTL.St_return ->
128    Printf.sprintf "return"
[486]129
130
[1580]131let print_graph n c entry =
[486]132  let f lbl stmt s =
133    Printf.sprintf "%s%s: %s\n%s"
134      (n_spaces n)
135      lbl
136      (print_statement stmt)
137      s in
[1580]138  let module U = GraphUtilities.Util(RTLGraph) in
139  U.dfs_fold f c entry ""
[486]140
141
142let print_internal_decl n f def =
143
144  Printf.sprintf
[1589]145    "%s\"%s\"%s\n%slocals: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
[486]146    (n_spaces n)
147    f
148    (print_params def.RTL.f_params)
149    (n_spaces (n+2))
150    (print_locals def.RTL.f_locals)
[1589]151    (* (n_spaces (n+2)) *)
152    (* (print_result def.RTL.f_result) *)
[486]153    (n_spaces (n+2))
154    def.RTL.f_stacksize
155    (n_spaces (n+2))
156    def.RTL.f_entry
157    (n_spaces (n+2))
158    def.RTL.f_exit
[1580]159    (print_graph (n+2) def.RTL.f_graph def.RTL.f_entry)
[486]160
161
162let print_external_decl n f def =
163  Printf.sprintf "%sextern \"%s\": %s\n"
164    (n_spaces n)
165    f
166    (Primitive.print_sig def.AST.ef_sig)
167
168
169let print_fun_decl n (f, def) = match def with
170  | RTL.F_int def -> print_internal_decl n f def
171  | RTL.F_ext def -> print_external_decl n f def
172
173let print_fun_decls n functs =
174  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
175    functs
176
177
178let print_program p =
179  Printf.sprintf "program:\n\n\n%s\n\n%s"
180    (print_globals 2 p.RTL.vars)
181    (print_fun_decls 2 p.RTL.functs)
Note: See TracBrowser for help on using the repository browser.