source: Deliverables/D2.2/8051/src/RTLabs/RTLabsPrinter.ml @ 486

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

Deliverable D2.2

File size: 6.4 KB
Line 
1
2let n_spaces n = String.make n ' '
3
4
5let print_global n (x, size) =
6  Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
7
8let print_globals n globs =
9  Printf.sprintf "%sglobals:\n%s"
10    (n_spaces n)
11    (List.fold_left (fun s g -> s ^ (print_global (n+2) g) ^ "\n") "" globs)
12
13
14let print_reg_list rl =
15  Printf.sprintf "[%s]" (MiscPottier.string_of_list " ; " Register.print rl)
16
17let rec print_args args =
18  Printf.sprintf "[%s]" (MiscPottier.string_of_list ", " print_reg_list args)
19
20let print_result rl = print_reg_list rl
21
22let print_params rl =
23  Printf.sprintf "(%s)" (MiscPottier.string_of_list ", " print_reg_list rl)
24
25let print_locals rl =
26  Printf.sprintf "%s" (MiscPottier.string_of_list ", " print_reg_list rl)
27
28
29let print_memory_q = Memory.string_of_memory_q
30
31
32let print_cmp = function
33  | AST.Cmp_eq -> "eq"
34  | AST.Cmp_ne -> "ne"
35  | AST.Cmp_gt -> "gt"
36  | AST.Cmp_ge -> "ge"
37  | AST.Cmp_lt -> "lt"
38  | AST.Cmp_le -> "le"
39
40let print_cst = function
41  | AST.Cst_int i -> Printf.sprintf "imm_int %d" i
42  | AST.Cst_float f -> Printf.sprintf "imm_float %f" f
43  | AST.Cst_addrsymbol id -> Printf.sprintf "imm_addr \"%s\"" id
44  | AST.Cst_stackoffset off -> Printf.sprintf "imm_addr %d(STACK)" off
45
46let print_op1 = function
47  | AST.Op_cast8unsigned -> "cast8u"
48  | AST.Op_cast8signed -> "cast8"
49  | AST.Op_cast16unsigned -> "cast16u"
50  | AST.Op_cast16signed -> "cast16"
51  | AST.Op_negint -> "negint"
52  | AST.Op_notbool -> "notbool"
53  | AST.Op_notint -> "notint"
54  | AST.Op_negf -> "negf"
55  | AST.Op_absf -> "absf"
56  | AST.Op_singleoffloat -> "singleoffloat"
57  | AST.Op_intoffloat -> "intoffloat"
58  | AST.Op_intuoffloat -> "intuoffloat"
59  | AST.Op_floatofint -> "floatofint"
60  | AST.Op_floatofintu -> "floatofintu"
61  | AST.Op_id -> "mov"
62  | AST.Op_ptrofint -> "ptrofint"
63  | AST.Op_intofptr -> "intofptr"
64
65let print_op2 = function
66  | AST.Op_add -> "add"
67  | AST.Op_sub -> "sub"
68  | AST.Op_mul -> "mul"
69  | AST.Op_div -> "div"
70  | AST.Op_divu -> "divu"
71  | AST.Op_mod -> "mod"
72  | AST.Op_modu -> "modu"
73  | AST.Op_and -> "and"
74  | AST.Op_or -> "or"
75  | AST.Op_xor -> "xor"
76  | AST.Op_shl -> "shl"
77  | AST.Op_shr -> "shr"
78  | AST.Op_shru -> "shru"
79  | AST.Op_addf -> "addf"
80  | AST.Op_subf -> "subf"
81  | AST.Op_mulf -> "mulf"
82  | AST.Op_divf -> "divf"
83  | AST.Op_cmp cmp -> print_cmp cmp
84  | AST.Op_cmpu cmp -> (print_cmp cmp) ^ "u"
85  | AST.Op_cmpf cmp -> (print_cmp cmp) ^ "f"
86  | AST.Op_addp -> "addp"
87  | AST.Op_subp -> "subp"
88  | AST.Op_cmpp cmp -> (print_cmp cmp) ^ "p"
89
90
91let print_addressing = function
92  | RTLabs.Aindexed off -> Printf.sprintf "%d" off
93  | RTLabs.Aindexed2 -> "add"
94  | RTLabs.Aglobal (id, off) -> Printf.sprintf "%d(\"%s\")" off id
95  | RTLabs.Abased (id, off) -> Printf.sprintf "add, %d(\"%s\")" off id
96  | RTLabs.Ainstack off -> Printf.sprintf "%d(STACK)" off
97
98
99let rec print_table = function
100  | [] -> ""
101  | [lbl] -> lbl
102  | lbl :: tbl -> lbl ^ ", " ^ (print_table tbl)
103
104
105let print_statement = function
106  | RTLabs.St_skip lbl -> "--> " ^ lbl
107  | RTLabs.St_cost (cost_lbl, lbl) ->
108      Printf.sprintf "emit %s --> %s" cost_lbl lbl
109  | RTLabs.St_cst (dests, cst, lbl) ->
110      Printf.sprintf "imm %s, %s --> %s"
111        (print_reg_list dests)
112        (print_cst cst)
113        lbl
114  | RTLabs.St_op1 (op1, dests, srcs, lbl) ->
115      Printf.sprintf "%s %s, %s --> %s"
116        (print_op1 op1)
117        (print_reg_list dests)
118        (print_reg_list srcs)
119        lbl
120  | RTLabs.St_op2 (op2, dests, srcs1, srcs2, lbl) ->
121      Printf.sprintf "%s %s, %s, %s --> %s"
122        (print_op2 op2)
123        (print_reg_list dests)
124        (print_reg_list srcs1)
125        (print_reg_list srcs2)
126        lbl
127  | RTLabs.St_load (chunk, mode, args, dests, lbl) ->
128      Printf.sprintf "load %s, %s, %s, %s --> %s"
129        (print_memory_q chunk)
130        (print_addressing mode)
131        (print_args args)
132        (print_reg_list dests)
133        lbl
134  | RTLabs.St_store (chunk, mode, args, srcs, lbl) ->
135      Printf.sprintf "store %s, %s, %s, %s --> %s"
136        (print_memory_q chunk)
137        (print_addressing mode)
138        (print_args args)
139        (print_reg_list srcs)
140        lbl
141  | RTLabs.St_call_id (f, args, res, sg, lbl) ->
142      Printf.sprintf "call \"%s\", %s, %s: %s --> %s"
143        f
144        (print_params args)
145        (print_reg_list res)
146        (Primitive.print_sig sg)
147        lbl
148  | RTLabs.St_call_ptr (f, args, res, sg, lbl) ->
149      Printf.sprintf "call_ptr %s, %s, %s: %s --> %s"
150        (print_reg_list f)
151        (print_params args)
152        (print_reg_list res)
153        (Primitive.print_sig sg)
154        lbl
155  | RTLabs.St_tailcall_id (f, args, sg) ->
156      Printf.sprintf "tailcall \"%s\", %s: %s"
157        f
158        (print_params args)
159        (Primitive.print_sig sg)
160  | RTLabs.St_tailcall_ptr (f, args, sg) ->
161      Printf.sprintf "tailcall_ptr \"%s\", %s: %s"
162        (print_reg_list f)
163        (print_params args)
164        (Primitive.print_sig sg)
165  | RTLabs.St_condcst (cst, lbl_true, lbl_false) ->
166      Printf.sprintf "%s --> %s, %s"
167        (print_cst cst)
168        lbl_true
169        lbl_false
170  | RTLabs.St_cond1 (op1, srcs, lbl_true, lbl_false) ->
171      Printf.sprintf "%s %s --> %s, %s"
172        (print_op1 op1)
173        (print_reg_list srcs)
174        lbl_true
175        lbl_false
176  | RTLabs.St_cond2 (op2, srcs1, srcs2, lbl_true, lbl_false) ->
177      Printf.sprintf "%s %s, %s --> %s, %s"
178        (print_op2 op2)
179        (print_reg_list srcs1)
180        (print_reg_list srcs2)
181        lbl_true
182        lbl_false
183  | RTLabs.St_jumptable (rs, tbl) ->
184      Printf.sprintf "j_tbl %s --> %s"
185        (print_reg_list rs)
186        (print_table tbl)
187  | RTLabs.St_return rs -> Printf.sprintf "return %s" (print_reg_list rs)
188
189
190let print_graph n c =
191  let f lbl stmt s =
192    Printf.sprintf "%s%s: %s\n%s"
193      (n_spaces n)
194      lbl
195      (print_statement stmt)
196      s in
197  Label.Map.fold f c ""
198
199
200let print_internal_decl n f def =
201
202  Printf.sprintf
203    "%s\"%s\"%s: %s\n%slocals: %s\n%sresult: %s\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n%s"
204    (n_spaces n)
205    f
206    (print_params def.RTLabs.f_params)
207    (Primitive.print_sig def.RTLabs.f_sig)
208    (n_spaces (n+2))
209    (print_locals def.RTLabs.f_locals)
210    (n_spaces (n+2))
211    (print_result def.RTLabs.f_result)
212    (n_spaces (n+2))
213    def.RTLabs.f_stacksize
214    (n_spaces (n+2))
215    def.RTLabs.f_entry
216    (n_spaces (n+2))
217    def.RTLabs.f_exit
218    (print_graph (n+2) def.RTLabs.f_graph)
219
220
221let print_external_decl n f def =
222  Printf.sprintf "%sextern \"%s\": %s\n"
223    (n_spaces n)
224    f
225    (Primitive.print_sig def.AST.ef_sig)
226
227
228let print_fun_decl n (f, def) = match def with
229  | RTLabs.F_int def -> print_internal_decl n f def
230  | RTLabs.F_ext def -> print_external_decl n f def
231
232let print_fun_decls n functs =
233  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
234    functs
235
236
237let print_program p =
238  Printf.sprintf "program:\n\n\n%s\n\n%s"
239    (print_globals 2 p.RTLabs.vars)
240    (print_fun_decls 2 p.RTLabs.functs)
Note: See TracBrowser for help on using the repository browser.