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

Last change on this file since 486 was 486, checked in by ayache, 8 years ago

Deliverable D2.2

File size: 4.6 KB
Line 
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
19let reg_set_to_list rs =
20  let f r l = l @ [r] in
21  Register.Set.fold f rs []
22
23let print_reg_list first last sep f rl =
24  Printf.sprintf "%s%s%s"
25    first (MiscPottier.string_of_list sep f rl) last
26
27let print_ptr rl = print_reg_list "[" "]" " ; " print_reg rl
28
29let print_args rl = print_reg_list "(" ")" ", " print_reg rl
30
31let print_return rl = print_reg_list "[" "]" " ; " print_reg rl
32
33let print_params rl = print_reg_list "(" ")" ", " Register.print rl
34
35let print_locals rs =
36  let rl = reg_set_to_list rs in
37  Printf.sprintf "%s" (print_reg_list "" "" ", " Register.print rl)
38
39let print_result rl = print_reg_list "[" "]" " ; " Register.print rl
40
41
42let print_statement = function
43  | RTL.St_skip lbl -> "--> " ^ lbl
44  | RTL.St_cost (cost_lbl, lbl) ->
45    Printf.sprintf "emit %s --> %s" cost_lbl lbl
46  | RTL.St_addr (dstr1, dstr2, id, lbl) ->
47    Printf.sprintf "imm (%s, %s), %s --> %s"
48      (print_reg dstr1) (print_reg dstr2) id lbl
49  | RTL.St_stackaddr (dstr1, dstr2, lbl) ->
50    Printf.sprintf "imm (%s, %s), STACK --> %s"
51      (print_reg dstr1) (print_reg dstr2) lbl
52  | RTL.St_int (dstr, i, lbl) ->
53    Printf.sprintf "imm %s, %d --> %s" (print_reg dstr) i lbl
54  | RTL.St_move (dstr, srcr, lbl) ->
55    Printf.sprintf "move %s, %s --> %s"
56      (print_reg dstr) (print_reg srcr) lbl
57  | RTL.St_opaccs (opaccs, dstr, srcr1, srcr2, lbl) ->
58    Printf.sprintf "%s %s, %s, %s --> %s"
59      (I8051.print_opaccs opaccs)
60      (print_reg dstr)
61      (print_reg srcr1)
62      (print_reg srcr2)
63      lbl
64  | RTL.St_op1 (op1, dstr, srcr, lbl) ->
65    Printf.sprintf "%s %s, %s --> %s"
66      (I8051.print_op1 op1) (print_reg dstr) (print_reg srcr) lbl
67  | RTL.St_op2 (op2, dstr, srcr1, srcr2, lbl) ->
68    Printf.sprintf "%s %s, %s, %s --> %s"
69      (I8051.print_op2 op2)
70      (print_reg dstr)
71      (print_reg srcr1)
72      (print_reg srcr2)
73      lbl
74  | RTL.St_clear_carry lbl ->
75    Printf.sprintf "clear CARRY --> %s" lbl
76  | RTL.St_load (dstr, addr1, addr2, lbl) ->
77    Printf.sprintf "load %s, (%s, %s) --> %s"
78      (print_reg dstr)
79      (print_reg addr1)
80      (print_reg addr2)
81      lbl
82  | RTL.St_store (addr1, addr2, srcr, lbl) ->
83    Printf.sprintf "store (%s, %s), %s --> %s"
84      (print_reg addr1)
85      (print_reg addr2)
86      (print_reg srcr)
87      lbl
88  | RTL.St_call_id (f, args, dstrs, lbl) ->
89    Printf.sprintf "call \"%s\", %s, %s --> %s"
90      f
91      (print_args args)
92      (print_return dstrs)
93      lbl
94  | RTL.St_call_ptr (f1, f2, args, dstrs, lbl) ->
95    Printf.sprintf "call_ptr [%s ; %s], %s, %s --> %s"
96      (print_reg f1)
97      (print_reg f2)
98      (print_args args)
99      (print_return dstrs)
100      lbl
101  | RTL.St_tailcall_id (f, args) ->
102    Printf.sprintf "tailcall \"%s\", %s"
103      f
104      (print_args args)
105  | RTL.St_tailcall_ptr (f1, f2, args) ->
106    Printf.sprintf "tailcall_ptr [%s ; %s], %s"
107      (print_reg f1)
108      (print_reg f2)
109      (print_args args)
110  | RTL.St_condacc (srcr, lbl_true, lbl_false) ->
111    Printf.sprintf "branch %s <> 0 --> %s, %s"
112      (print_reg srcr) lbl_true lbl_false
113  | RTL.St_return regs ->
114    Printf.sprintf "return %s" (print_return regs)
115
116
117let print_graph n c =
118  let f lbl stmt s =
119    Printf.sprintf "%s%s: %s\n%s"
120      (n_spaces n)
121      lbl
122      (print_statement stmt)
123      s in
124  Label.Map.fold f c ""
125
126
127let print_internal_decl n f def =
128
129  Printf.sprintf
130    "%s\"%s\"%s: %s\n%slocals: %s\n%sresult: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
131    (n_spaces n)
132    f
133    (print_params def.RTL.f_params)
134    (Primitive.print_sig def.RTL.f_sig)
135    (n_spaces (n+2))
136    (print_locals def.RTL.f_locals)
137    (n_spaces (n+2))
138    (print_result def.RTL.f_result)
139    (n_spaces (n+2))
140    def.RTL.f_stacksize
141    (n_spaces (n+2))
142    def.RTL.f_entry
143    (n_spaces (n+2))
144    def.RTL.f_exit
145    (print_graph (n+2) def.RTL.f_graph)
146
147
148let print_external_decl n f def =
149  Printf.sprintf "%sextern \"%s\": %s\n"
150    (n_spaces n)
151    f
152    (Primitive.print_sig def.AST.ef_sig)
153
154
155let print_fun_decl n (f, def) = match def with
156  | RTL.F_int def -> print_internal_decl n f def
157  | RTL.F_ext def -> print_external_decl n f def
158
159let print_fun_decls n functs =
160  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
161    functs
162
163
164let print_program p =
165  Printf.sprintf "program:\n\n\n%s\n\n%s"
166    (print_globals 2 p.RTL.vars)
167    (print_fun_decls 2 p.RTL.functs)
Note: See TracBrowser for help on using the repository browser.