source: Deliverables/D2.2/8051/src/cminor/cminorPrinter.ml @ 740

Last change on this file since 740 was 740, checked in by ayache, 10 years ago

New memory model and bug fixes in 8051 branch. Added primitive operations in interpreters from Clight to LIN.

File size: 7.0 KB
Line 
1open AST
2
3let print_type = function
4  | Sig_int -> "int"
5  | Sig_float -> "float"
6  | Sig_ptr -> "ptr"
7
8let print_ret_type = function
9  | Type_ret t -> print_type t
10  | Type_void -> "void"
11
12let print_sig sg =
13  let rec aux = function
14    | [] -> ""
15    | [t] -> (print_type t) ^ " -> "
16    | t :: sg -> (print_type t) ^ " -> " ^ (aux sg)
17  in
18  (aux sg.args) ^ (print_ret_type sg.res)
19
20
21let print_data = function
22  | Data_reserve n -> Printf.sprintf "[%d]" n
23  | Data_int8 i -> Printf.sprintf "(int8) %d" i
24  | Data_int16 i -> Printf.sprintf "(int16) %d" i
25  | Data_int32 i -> Printf.sprintf "%d" i
26  | Data_float32 f -> Printf.sprintf "%f" f
27  | Data_float64 f -> Printf.sprintf "(float64) %f" f
28
29let print_datas init =
30  let rec aux = function
31    | [] -> ""
32    | [data] -> print_data data
33    | data :: datas -> Printf.sprintf "%s, %s" (print_data data) (aux datas)
34  in
35  Printf.sprintf "{%s}" (aux init)
36
37let print_var (id, init) =
38  Printf.sprintf "var \"%s\" %s\n" id (print_datas init)
39
40let print_vars = List.fold_left (fun s v -> s ^ (print_var v)) ""
41
42let print_constant = function
43  | Cst_int i -> string_of_int i
44  | Cst_float f -> string_of_float f
45  | Cst_addrsymbol id -> "\"" ^ id ^ "\""
46  | Cst_stackoffset off -> "&" ^ (string_of_int off)
47
48let print_cmp = function
49  | Cmp_eq -> "=="
50  | Cmp_ne -> "!="
51  | Cmp_gt -> ">"
52  | Cmp_ge -> ">="
53  | Cmp_lt -> "<"
54  | Cmp_le -> "<="
55
56let print_op1 = function
57  | Op_cast8unsigned -> "int8u"
58  | Op_cast8signed -> "int8s"
59  | Op_cast16unsigned -> "int16u"
60  | Op_cast16signed -> "int16s"
61  | Op_negint -> "-"
62  | Op_notbool -> "!"
63  | Op_notint -> "~"
64  | Op_negf -> "-f"
65  | Op_absf -> "absf"
66  | Op_singleoffloat -> "float32"
67  | Op_intoffloat -> "intoffloat"
68  | Op_intuoffloat -> "intuoffloat"
69  | Op_floatofint -> "floatofint"
70  | Op_floatofintu -> "floatofintu"
71  | Op_id -> ""
72  | Op_intofptr -> "intofptr"
73  | Op_ptrofint -> "ptrofint"
74
75let print_op2 = function
76  | Op_add -> "+"
77  | Op_sub -> "-"
78  | Op_mul -> "*"
79  | Op_div -> "/"
80  | Op_divu -> "/u"
81  | Op_mod -> "%"
82  | Op_modu -> "%u"
83  | Op_and -> "&&"
84  | Op_or -> "||"
85  | Op_xor -> "^"
86  | Op_shl -> "<<"
87  | Op_shr -> ">>"
88  | Op_shru -> ">>u"
89  | Op_addf -> "+f"
90  | Op_subf -> "-f"
91  | Op_mulf -> "*f"
92  | Op_divf -> "/f"
93  | Op_cmp cmp -> print_cmp cmp
94  | Op_cmpu cmp -> (print_cmp cmp) ^ "u"
95  | Op_cmpf cmp -> (print_cmp cmp) ^ "f"
96  | Op_addp -> "+p"
97  | Op_subp -> "-p"
98  | Op_cmpp cmp -> (print_cmp cmp) ^ "p"
99
100let rec print_expression = function
101  | Cminor.Id id -> id
102  | Cminor.Cst cst -> print_constant cst
103  | Cminor.Op1 (op1, e) ->
104      Printf.sprintf "%s%s" (print_op1 op1) (add_parenthesis e)
105  | Cminor.Op2 (op2, e1, e2) ->
106      Printf.sprintf "%s %s %s"
107        (add_parenthesis e1)
108        (print_op2 op2)
109        (add_parenthesis e2)
110  | Cminor.Mem (q, e) ->
111      Printf.sprintf "%s[%s]" (Memory.string_of_quantity q) (print_expression e)
112  | Cminor.Cond (e1, e2, e3) ->
113      Printf.sprintf "%s ? %s : %s"
114        (add_parenthesis e1)
115        (add_parenthesis e2)
116        (add_parenthesis e3)
117  | Cminor.Exp_cost (lab, e) ->
118      Printf.sprintf "/* %s */ %s" lab (print_expression e)
119and add_parenthesis e = match e with
120  | Cminor.Id _ | Cminor.Cst _ | Cminor.Mem _ -> print_expression e
121  | _ -> Printf.sprintf "(%s)" (print_expression e)
122
123
124let rec print_args = function
125  | [] -> ""
126  | [e] -> print_expression e
127  | e :: args -> (print_expression e) ^ ", " ^ (print_args args)
128
129
130let n_spaces n = String.make n ' '
131
132
133let print_locals vars =
134  (MiscPottier.string_of_list ", " (fun x -> x) vars ^
135   (if vars = [] then "" else ";"))
136
137
138let print_table n =
139  let f s (case, exit) =
140    Printf.sprintf "%s%scase %d: exit %d;\n" s (n_spaces n) case exit
141  in
142  List.fold_left f ""
143
144
145let rec print_body n = function
146  | Cminor.St_skip -> ""
147  | Cminor.St_assign (id, e) ->
148      Printf.sprintf "%s%s = %s;\n" (n_spaces n) id (print_expression e)
149  | Cminor.St_store (q, e1, e2) ->
150      Printf.sprintf "%s%s[%s] = %s;\n"
151        (n_spaces n)
152        (Memory.string_of_quantity q)
153        (print_expression e1)
154        (print_expression e2)
155  | Cminor.St_call (None, f, args, sg) ->
156      Printf.sprintf "%s%s(%s) : %s;\n"
157        (n_spaces n)
158        (print_expression f)
159        (print_args args)
160        (print_sig sg)
161  | Cminor.St_call (Some id, f, args, sg) ->
162      Printf.sprintf "%s%s = %s(%s) : %s;\n"
163        (n_spaces n)
164        id
165        (print_expression f)
166        (print_args args)
167        (print_sig sg)
168  | Cminor.St_tailcall (f, args, sg) ->
169      Printf.sprintf "%stailcall %s(%s) : %s;\n"
170        (n_spaces n)
171        (print_expression f)
172        (print_args args)
173        (print_sig sg)
174  | Cminor.St_seq (s1, s2) -> (print_body n s1) ^ (print_body n s2)
175  | Cminor.St_ifthenelse (e, s1, s2) ->
176      Printf.sprintf "%sif (%s) {\n%s%s}\n%selse {\n%s%s}\n"
177        (n_spaces n)
178        (print_expression e)
179        (print_body (n+2) s1)
180        (n_spaces n)
181        (n_spaces n)
182        (print_body (n+2) s2)
183        (n_spaces n)
184  | Cminor.St_loop s ->
185      Printf.sprintf "%sloop {\n%s%s}\n"
186        (n_spaces n)
187        (print_body (n+2) s)
188        (n_spaces n)
189  | Cminor.St_block s ->
190      Printf.sprintf "%sblock {\n%s%s}\n"
191        (n_spaces n)
192        (print_body (n+2) s)
193        (n_spaces n)
194  | Cminor.St_exit i ->
195      Printf.sprintf "%sexit %d;\n" (n_spaces n) i
196  | Cminor.St_switch (e, tbl, dflt) ->
197      Printf.sprintf "%sswitch (%s) {\n%s%sdefault: exit %d;\n%s}\n"
198        (n_spaces n)
199        (print_expression e)
200        (print_table ( n+2) tbl)
201        (n_spaces (n+2))
202        dflt
203        (n_spaces n)
204  | Cminor.St_return None -> Printf.sprintf "%sreturn;\n" (n_spaces n)
205  | Cminor.St_return (Some e) ->
206      Printf.sprintf "%sreturn %s;\n" (n_spaces n) (print_expression e)
207  | Cminor.St_label (lbl, s) ->
208      Printf.sprintf "%s%s:\n%s" (n_spaces n) lbl (print_body n s)
209  | Cminor.St_goto lbl ->
210      Printf.sprintf "%sgoto %s;\n" (n_spaces n) lbl
211  | Cminor.St_cost (lbl, s) ->
212      Printf.sprintf "%s%s:\n%s"
213        (n_spaces n) lbl (print_body n s)
214
215let print_internal f_name f_def =
216  Printf.sprintf "\"%s\" (%s) : %s {\n\n  stack %d;\n\n  vars: %s\n  pointers: %s\n\n%s}\n\n\n"
217    f_name
218    (print_args (List.map (fun id -> Cminor.Id id) f_def.Cminor.f_params))
219    (print_sig f_def.Cminor.f_sig)
220    f_def.Cminor.f_stacksize
221    (print_locals f_def.Cminor.f_vars)
222    (print_locals f_def.Cminor.f_ptrs)
223    (print_body 2 f_def.Cminor.f_body)
224
225
226let print_external f_name f_def =
227  Printf.sprintf "extern \"%s\" : %s\n\n\n"
228    f_name
229    (print_sig f_def.ef_sig)
230
231
232let print_funct (f_name, f_def) = match f_def with
233  | Cminor.F_int f_def -> print_internal f_name f_def
234  | Cminor.F_ext f_def -> print_external f_name f_def
235
236let print_functs = List.fold_left (fun s f -> s ^ (print_funct f)) ""
237
238let print_program p =
239  Printf.sprintf "\n%s\n\n%s"
240    (print_vars p.Cminor.vars)
241    (print_functs p.Cminor.functs)
242
243let string_of_statement s = match s with
244    Cminor.St_skip -> "skip"
245  | Cminor.St_assign(_,_) -> "assign"
246  | Cminor.St_store(_,_,_) -> "store"
247  | Cminor.St_call(_,_,_,_) -> "call"
248  | Cminor.St_tailcall(_,_,_) -> "tailcall"
249  | Cminor.St_seq(_,_) -> "seq"
250  | Cminor.St_ifthenelse(_,_,_) -> "ifthenelse"
251  | Cminor.St_loop(_) -> "loop"
252  | Cminor.St_block(_) -> "block"
253  | Cminor.St_exit(_) -> "exit"
254  | Cminor.St_switch(_,_,_) -> "switch"
255  | Cminor.St_return(_) -> "return"
256  | Cminor.St_label(_,_) -> "label"
257  | Cminor.St_goto(_) -> "goto"
258  | Cminor.St_cost(_,_) -> "cost"
Note: See TracBrowser for help on using the repository browser.