source: driver/printer.ml @ 2901

Last change on this file since 2901 was 2901, checked in by sacerdot, 6 years ago
  1. backendPrinter renamed to printer
  2. Clight printing branched into the printer
File size: 9.9 KB
Line 
1let print_keyword =
2 function
3  | Extracted.Joint_printer.KwCOMMENT      -> "COMMENT"
4  | Extracted.Joint_printer.KwMOVE         -> "MOVE"
5  | Extracted.Joint_printer.KwPOP          -> "POP"
6  | Extracted.Joint_printer.KwPUSH         -> "PUSH"
7  | Extracted.Joint_printer.KwADDRESS      -> "ADDRESS"
8  | Extracted.Joint_printer.KwOPACCS       -> "OPACCS"
9  | Extracted.Joint_printer.KwOP1          -> "OP1"
10  | Extracted.Joint_printer.KwOP2          -> "OP2"
11  | Extracted.Joint_printer.KwCLEAR_CARRY  -> "CLEAR_CARRY"
12  | Extracted.Joint_printer.KwSET_CARRY    -> "SET_CARRY"
13  | Extracted.Joint_printer.KwLOAD         -> "LOAD"
14  | Extracted.Joint_printer.KwSTORE        -> "STORE"
15  | Extracted.Joint_printer.KwCOST_LABEL   -> "COST_LABEL"
16  | Extracted.Joint_printer.KwCOND         -> "COND"
17  | Extracted.Joint_printer.KwCALL         -> "CALL"
18  | Extracted.Joint_printer.KwGOTO         -> "GOTO"
19  | Extracted.Joint_printer.KwRETURN       -> "RETURN"
20  | Extracted.Joint_printer.KwTAILCALL     -> "TAILCALL"
21  | Extracted.Joint_printer.KwFCOND        -> "FCOND"
22
23let print_opAccs =
24 function
25  | Extracted.BackEndOps.Mul -> "Mul"
26  | Extracted.BackEndOps.DivuModu -> "DivModu"
27
28let print_op1 =
29 function
30  | Extracted.BackEndOps.Cmpl -> "Cmpl"
31  | Extracted.BackEndOps.Inc -> "Inc"
32  | Extracted.BackEndOps.Rl -> "Rl"
33
34let print_op2 =
35 function
36  | Extracted.BackEndOps.Add -> "Add"
37  | Extracted.BackEndOps.Addc -> "Addc"
38  | Extracted.BackEndOps.Sub -> "Sub"
39  | Extracted.BackEndOps.And -> "And"
40  | Extracted.BackEndOps.Or -> "Or"
41  | Extracted.BackEndOps.Xor -> "Xor"
42
43(* Duplicated, also in cerco.ml! *)
44let string_of_pos n = string_of_int (Extracted.Glue.int_of_matitapos n)
45
46let print_ident n = "fun_" ^ string_of_pos n
47
48let printing_pass_independent_params =
49 { Extracted.Joint_printer.print_String =
50    (fun Extracted.String.EmptyString -> "EmptyString")
51 ; print_keyword = print_keyword
52 ; print_concat = (fun s1 s2 -> s1 ^ " " ^ s2)
53 ; print_empty = ""
54 ; print_ident = print_ident
55 ; print_costlabel = (fun n -> "k_" ^ string_of_pos n)
56 ; print_label = (fun n -> "l_" ^ string_of_pos n)
57 ; print_OpAccs = print_opAccs
58 ; print_Op1 = print_op1
59 ; print_Op2 = print_op2
60 }
61
62let print_byte b = string_of_int (IntelHex.int_of_vect b)
63
64let print_argument print_arg =
65 function
66    Extracted.Joint.Imm b -> print_byte b
67  | Extracted.Joint.Reg x -> print_arg x
68
69let print_Register =
70 function
71  | Extracted.I8051.Register00     -> "Register00"
72  | Extracted.I8051.Register01     -> "Register01"
73  | Extracted.I8051.Register02     -> "Register02"
74  | Extracted.I8051.Register03     -> "Register03"
75  | Extracted.I8051.Register04     -> "Register04"
76  | Extracted.I8051.Register05     -> "Register05"
77  | Extracted.I8051.Register06     -> "Register06"
78  | Extracted.I8051.Register07     -> "Register07"
79  | Extracted.I8051.Register10     -> "Register10"
80  | Extracted.I8051.Register11     -> "Register11"
81  | Extracted.I8051.Register12     -> "Register12"
82  | Extracted.I8051.Register13     -> "Register13"
83  | Extracted.I8051.Register14     -> "Register14"
84  | Extracted.I8051.Register15     -> "Register15"
85  | Extracted.I8051.Register16     -> "Register16"
86  | Extracted.I8051.Register17     -> "Register17"
87  | Extracted.I8051.Register20     -> "Register20"
88  | Extracted.I8051.Register21     -> "Register21"
89  | Extracted.I8051.Register22     -> "Register22"
90  | Extracted.I8051.Register23     -> "Register23"
91  | Extracted.I8051.Register24     -> "Register24"
92  | Extracted.I8051.Register25     -> "Register25"
93  | Extracted.I8051.Register26     -> "Register26"
94  | Extracted.I8051.Register27     -> "Register27"
95  | Extracted.I8051.Register30     -> "Register30"
96  | Extracted.I8051.Register31     -> "Register31"
97  | Extracted.I8051.Register32     -> "Register32"
98  | Extracted.I8051.Register33     -> "Register33"
99  | Extracted.I8051.Register34     -> "Register34"
100  | Extracted.I8051.Register35     -> "Register35"
101  | Extracted.I8051.Register36     -> "Register36"
102  | Extracted.I8051.Register37     -> "Register37"
103  | Extracted.I8051.RegisterA      -> "RegisterA"
104  | Extracted.I8051.RegisterB      -> "RegisterB"
105  | Extracted.I8051.RegisterDPL    -> "RegisterDPL"
106  | Extracted.I8051.RegisterDPH    -> "RegisterDPH"
107  | Extracted.I8051.RegisterCarry  -> "RegisterCarry"
108
109let print_registers_move =
110 function
111  | Extracted.Joint_LTL_LIN.From_acc (reg,_unit) ->
112     print_Register reg ^ " " ^ "ACC_A"
113  | Extracted.Joint_LTL_LIN.To_acc (_unit,reg) ->
114     "ACC_A " ^ print_Register reg
115  | Extracted.Joint_LTL_LIN.Int_to_reg (reg,byte) ->
116     print_Register reg ^ " " ^ print_byte byte
117  | Extracted.Joint_LTL_LIN.Int_to_acc (_unit,byte) ->
118     "ACC_A " ^ print_byte byte
119
120let print_register n = "r_" ^ string_of_pos n
121
122let rTL_printing_params =
123 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
124 ; print_acc_a_reg = Obj.magic print_register
125 ; print_acc_b_reg = Obj.magic print_register
126 ; print_acc_a_arg = Obj.magic (print_argument print_register)
127 ; print_acc_b_arg = Obj.magic (print_argument print_register)
128 ; print_dpl_reg = Obj.magic print_register
129 ; print_dph_reg = Obj.magic print_register
130 ; print_dpl_arg = Obj.magic (print_argument print_register)
131 ; print_dph_arg = Obj.magic (print_argument print_register)
132 ; print_snd_arg = Obj.magic (print_argument print_register)
133 ; print_pair_move = Obj.magic
134    (fun {Extracted.Types.fst = reg; snd = arg} ->
135      print_register reg ^ " " ^ print_argument print_register arg)
136 ; print_call_args = Obj.magic
137    (fun l -> String.concat " " (List.map (print_argument print_register) l))
138 ; print_call_dest = Obj.magic
139    (fun l -> String.concat " " (List.map print_register l))
140 ; print_ext_seq = (fun rtl_seq -> assert false )
141 }
142
143let print_move_dst =
144 function
145    Extracted.ERTL.PSD reg -> print_register reg
146  | Extracted.ERTL.HDW reg -> print_Register reg
147
148let eRTL_printing_params =
149 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
150 ; print_acc_a_reg = Obj.magic print_register
151 ; print_acc_b_reg = Obj.magic print_register
152 ; print_acc_a_arg = Obj.magic (print_argument print_register)
153 ; print_acc_b_arg = Obj.magic (print_argument print_register)
154 ; print_dpl_reg = Obj.magic print_register
155 ; print_dph_reg = Obj.magic print_register
156 ; print_dpl_arg = Obj.magic (print_argument print_register)
157 ; print_dph_arg = Obj.magic (print_argument print_register)
158 ; print_snd_arg = Obj.magic (print_argument print_register)
159 ; print_pair_move = Obj.magic
160    (fun {Extracted.Types.fst = dst; snd = src} ->
161      print_move_dst dst ^ " " ^ print_argument print_move_dst src )
162 ; print_call_args =
163    Obj.magic (fun n -> string_of_int (Extracted.Glue.int_of_matitanat n))
164 ; print_call_dest = (fun _ -> "")
165 ; print_ext_seq = (fun ertl_seq -> "TODO" )
166 }
167
168let eRTLptr_printing_params =
169 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
170 ; print_acc_a_reg = Obj.magic print_register
171 ; print_acc_b_reg = Obj.magic print_register
172 ; print_acc_a_arg = Obj.magic (print_argument print_register)
173 ; print_acc_b_arg = Obj.magic (print_argument print_register)
174 ; print_dpl_reg = Obj.magic print_register
175 ; print_dph_reg = Obj.magic print_register
176 ; print_dpl_arg = Obj.magic (print_argument print_register)
177 ; print_dph_arg = Obj.magic (print_argument print_register)
178 ; print_snd_arg = Obj.magic (print_argument print_register)
179 ; print_pair_move = Obj.magic
180    (fun {Extracted.Types.fst = dst; snd = src} ->
181      print_move_dst dst ^ " " ^ print_argument print_move_dst src )
182 ; print_call_args =
183    Obj.magic (fun n -> string_of_int (Extracted.Glue.int_of_matitanat n))
184 ; print_call_dest = (fun _ -> "")
185 ; print_ext_seq = (fun ertl_seq -> "TODO")
186 }
187
188let joint_LTL_LIN_printing_params =
189 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
190 ; print_acc_a_reg = (fun _ -> "ACC_A")
191 ; print_acc_b_reg = (fun _ -> "ACC_B")
192 ; print_acc_a_arg = (fun _ -> "ACC_A")
193 ; print_acc_b_arg = (fun _ -> "ACC_B")
194 ; print_dpl_reg = (fun _ -> "DPL")
195 ; print_dph_reg = (fun _ -> "DPH")
196 ; print_dpl_arg = (fun _ -> "DPL")
197 ; print_dph_arg = (fun _ -> "DPH")
198 ; print_snd_arg = (fun hdw_arg -> print_argument print_Register (Obj.magic hdw_arg))
199 ; print_pair_move = Obj.magic print_registers_move
200 ; print_call_args =
201    (fun n ->string_of_int (Extracted.Glue.int_of_matitanat (Obj.magic n)))
202 ; print_call_dest = (fun _ -> "")
203 ; print_ext_seq = (fun ltl_lin_seq -> "TO BE IMPLEMENTED" )
204 }
205
206let rec list_of_matitalist =
207 function
208    Extracted.List.Nil -> []
209  | Extracted.List.Cons (hd,tl) -> hd :: list_of_matitalist tl
210
211let print_graph l =
212 let l = list_of_matitalist l in
213  String.concat "\n\n"
214   (List.map
215     (fun {Extracted.Types.fst=ident; snd=commands} ->
216       let commands = list_of_matitalist commands in
217       print_ident ident ^ ":\n" ^
218       String.concat "\n" (List.rev commands)
219     )
220    l)
221
222let print_program pass (program : Extracted.Preamble.__) =
223 let beprint pcs =
224  print_graph (pcs (Extracted.Types.fst (Obj.magic program))) in
225 let lines =
226  match pass with
227   | Extracted.Compiler.Clight_pass
228   | Extracted.Compiler.Clight_switch_removed_pass
229   | Extracted.Compiler.Clight_label_pass
230   | Extracted.Compiler.Clight_simplified_pass ->
231      ClightPrinter.print_program ClightPrinter.Cost_plain (Obj.magic program)
232   | Extracted.Compiler.Rtl_separate_pass ->
233      beprint (Extracted.RTL_printer.print_RTL_program rTL_printing_params)
234   | Extracted.Compiler.Rtl_uniq_pass ->
235      beprint (Extracted.RTL_printer.print_RTL_program rTL_printing_params)
236   | Extracted.Compiler.Ertl_pass ->
237      beprint (Extracted.ERTL_printer.print_ERTL_program eRTL_printing_params)
238   | Extracted.Compiler.Ertlptr_pass ->
239      beprint
240       (Extracted.ERTLptr_printer.print_ERTLptr_program eRTLptr_printing_params)
241   | Extracted.Compiler.Ltl_pass ->
242      beprint
243       (Extracted.LTL_printer.print_LTL_program joint_LTL_LIN_printing_params)
244   | Extracted.Compiler.Object_code_pass ->
245      ASMPrinter.print_program (Extracted.ASM.oc (Obj.magic program))
246   | _ -> ""
247 in
248  "\n" ^ lines ^ "\n"
Note: See TracBrowser for help on using the repository browser.