source: Deliverables/D2.2/8051/src/ERTL/ERTLPrinter.ml @ 1572

Last change on this file since 1572 was 1572, checked in by tranquil, 8 years ago
  • corrected previous bug
  • finished propagating immediates
File size: 5.9 KB
Line 
1
2(** This module provides a function to print [ERTL] 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 reg_set_to_list rs =
18  let f r l = l @ [r] in
19  Register.Set.fold f rs []
20
21let print_reg_list first last sep f rl =
22  Printf.sprintf "%s%s%s"
23    first (MiscPottier.string_of_list sep f rl) last
24
25let print_arg = function
26  | RTL.Imm i -> string_of_int i
27  | RTL.Reg r -> Register.print r
28
29let print_ptr rl = print_reg_list "[" "]" " ; " Register.print rl
30
31let print_args rl = print_reg_list "(" ")" ", " Register.print rl
32
33let print_return rl = print_reg_list "[" "]" " ; " print_arg rl
34
35let print_params rl = print_reg_list "(" ")" ", " Register.print rl
36
37let print_locals rs =
38  let rl = reg_set_to_list rs in
39  Printf.sprintf "%s" (print_reg_list "" "" ", " Register.print rl)
40
41let print_result rl = print_reg_list "[" "]" " ; " Register.print rl
42
43let print_statement = function
44  | ERTL.St_skip lbl -> "--> " ^ lbl
45  | ERTL.St_comment (s, lbl) ->
46    Printf.sprintf "*** %s *** --> %s" s lbl
47  | ERTL.St_cost (cost_lbl, lbl) ->
48    let cost_lbl = CostLabel.string_of_cost_label ~pretty:true cost_lbl in
49    Printf.sprintf "emit %s --> %s" cost_lbl lbl
50  | ERTL.St_ind_0 (i, lbl) ->
51    Printf.sprintf "index %d --> %s" i lbl
52  | ERTL.St_ind_inc (i, lbl) ->
53    Printf.sprintf "increment %d --> %s" i lbl
54  | ERTL.St_get_hdw (r1, r2, lbl) ->
55    Printf.sprintf "move %s, %s --> %s"
56      (Register.print r1) (I8051.print_register r2) lbl
57  | ERTL.St_set_hdw (r1, r2, lbl) ->
58    Printf.sprintf "move %s, %s --> %s"
59      (I8051.print_register r1) (print_arg r2) lbl
60  | ERTL.St_hdw_to_hdw (r1, r2, lbl) ->
61    Printf.sprintf "move %s, %s --> %s"
62      (I8051.print_register r1) (I8051.print_register r2) lbl
63  | ERTL.St_newframe lbl ->
64    Printf.sprintf "newframe --> %s" lbl
65  | ERTL.St_delframe lbl ->
66    Printf.sprintf "delframe --> %s" lbl
67  | ERTL.St_framesize (r, lbl) ->
68    Printf.sprintf "imm %s, FRAMESIZE --> %s" (Register.print r) lbl
69  | ERTL.St_pop (r, lbl) ->
70    Printf.sprintf "pop %s --> %s" (Register.print r) lbl
71  | ERTL.St_push (r, lbl) ->
72    Printf.sprintf "push %s --> %s" (print_arg r) lbl
73  | ERTL.St_addrH (dstr, id, lbl) ->
74    Printf.sprintf "addrH %s, %s --> %s" (Register.print dstr) id lbl
75  | ERTL.St_addrL (dstr, id, lbl) ->
76    Printf.sprintf "addrL %s, %s --> %s" (Register.print dstr) id lbl
77  (* | ERTL.St_int (dstr, i, lbl) -> *)
78  (*   Printf.sprintf "imm %s, %d --> %s" (Register.print dstr) i lbl *)
79  | ERTL.St_move (dstr, srcr, lbl) ->
80    Printf.sprintf "move %s, %s --> %s"
81      (Register.print dstr) (print_arg srcr) lbl
82  | ERTL.St_opaccsA (opaccs, dstr, srcr1, srcr2, lbl) ->
83    Printf.sprintf "%sA %s, %s, %s --> %s"
84      (I8051.print_opaccs opaccs)
85      (Register.print dstr)
86      (print_arg srcr1)
87      (print_arg srcr2)
88      lbl
89  | ERTL.St_opaccsB (opaccs, dstr, srcr1, srcr2, lbl) ->
90    Printf.sprintf "%sB %s, %s, %s --> %s"
91      (I8051.print_opaccs opaccs)
92      (Register.print dstr)
93      (print_arg srcr1)
94      (print_arg srcr2)
95      lbl
96  | ERTL.St_op1 (op1, dstr, srcr, lbl) ->
97    Printf.sprintf "%s %s, %s --> %s"
98      (I8051.print_op1 op1)
99      (Register.print dstr)
100      (Register.print srcr)
101      lbl
102  | ERTL.St_op2 (op2, dstr, srcr1, srcr2, lbl) ->
103    Printf.sprintf "%s %s, %s, %s --> %s"
104      (I8051.print_op2 op2)
105      (Register.print dstr)
106      (print_arg srcr1)
107      (print_arg srcr2)
108      lbl
109  | ERTL.St_clear_carry lbl ->
110    Printf.sprintf "clear CARRY --> %s" lbl
111  | ERTL.St_set_carry lbl ->
112    Printf.sprintf "set CARRY --> %s" lbl
113  | ERTL.St_load (dstr, addr1, addr2, lbl) ->
114    Printf.sprintf "load %s, (%s, %s) --> %s"
115      (Register.print dstr)
116      (print_arg addr1)
117      (print_arg addr2)
118      lbl
119  | ERTL.St_store (addr1, addr2, srcr, lbl) ->
120    Printf.sprintf "store (%s, %s), %s --> %s"
121      (print_arg addr1)
122      (print_arg addr2)
123      (print_arg srcr)
124      lbl
125  | ERTL.St_call_id (f, nb_args, lbl) ->
126    Printf.sprintf "call \"%s\", %d --> %s" f nb_args lbl
127  | ERTL.St_call_ptr (f1, f2, nb_args, lbl) ->
128    Printf.sprintf "call_ptr [%s ; %s], %d --> %s"
129      (Register.print f1)
130      (Register.print f2)
131      nb_args
132      lbl
133(*
134  | ERTL.St_tailcall_id (f, nb_args) ->
135    Printf.sprintf "tailcall \"%s\", %d"
136      f
137      nb_args
138  | ERTL.St_tailcall_ptr (f, args) ->
139    Printf.sprintf "tailcall_ptr %s, %s"
140      (print_ptr f)
141      (print_args args)
142*)
143  | ERTL.St_cond (srcr, lbl_true, lbl_false) ->
144    Printf.sprintf "branch %s <> 0 --> %s, %s"
145      (Register.print srcr) lbl_true lbl_false
146  | ERTL.St_return ret_regs ->
147    Printf.sprintf "return %s" (print_return ret_regs)
148
149
150let print_graph n c entry =
151  let f lbl stmt s =
152    Printf.sprintf "%s%s: %s\n%s"
153      (n_spaces n)
154      lbl
155      (print_statement stmt)
156      s in
157  ERTLUtilities.dfs_fold f c entry ""
158  (* Label.Map.fold f c "" *)
159
160
161let print_internal_decl n f def =
162
163  Printf.sprintf
164    "%s\"%s\" %d\n%slocals: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
165    (n_spaces n)
166    f
167    def.ERTL.f_params
168    (n_spaces (n+2))
169    (print_locals def.ERTL.f_locals)
170    (n_spaces (n+2))
171    def.ERTL.f_stacksize
172    (n_spaces (n+2))
173    def.ERTL.f_entry
174    (n_spaces (n+2))
175    def.ERTL.f_exit
176    (print_graph (n+2) def.ERTL.f_graph def.ERTL.f_entry)
177
178
179let print_external_decl n f def =
180  Printf.sprintf "%sextern \"%s\": %s\n"
181    (n_spaces n)
182    f
183    (Primitive.print_sig def.AST.ef_sig)
184
185
186let print_fun_decl n (f, def) = match def with
187  | ERTL.F_int def -> print_internal_decl n f def
188  | ERTL.F_ext def -> print_external_decl n f def
189
190let print_fun_decls n functs =
191  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
192    functs
193
194
195let print_program p =
196  Printf.sprintf "program:\n\n\n%s\n\n%s"
197    (print_globals 2 p.ERTL.vars)
198    (print_fun_decls 2 p.ERTL.functs)
Note: See TracBrowser for help on using the repository browser.