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"
25 | Extracted.BackEndOps.Mul -> "Mul"
26 | Extracted.BackEndOps.DivuModu -> "DivModu"
30 | Extracted.BackEndOps.Cmpl -> "Cmpl"
31 | Extracted.BackEndOps.Inc -> "Inc"
32 | Extracted.BackEndOps.Rl -> "Rl"
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"
43 (* Duplicated, also in cerco.ml! *)
44 let string_of_pos n = string_of_int (Extracted.Glue.int_of_matitapos n)
46 let print_ident n = "fun_" ^ string_of_pos n
48 let 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)
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 ; print_nat = (fun n -> string_of_int (Extracted.Glue.int_of_matitanat n))
61 ; print_bitvector = (fun _ n -> string_of_int (Extracted.Glue.int_of_bitvector n))
64 let print_byte b = string_of_int (IntelHex.int_of_vect b)
66 let print_argument print_arg =
68 Extracted.Joint.Imm b -> print_byte b
69 | Extracted.Joint.Reg x -> print_arg x
73 | Extracted.I8051.Register00 -> "Register00"
74 | Extracted.I8051.Register01 -> "Register01"
75 | Extracted.I8051.Register02 -> "Register02"
76 | Extracted.I8051.Register03 -> "Register03"
77 | Extracted.I8051.Register04 -> "Register04"
78 | Extracted.I8051.Register05 -> "Register05"
79 | Extracted.I8051.Register06 -> "Register06"
80 | Extracted.I8051.Register07 -> "Register07"
81 | Extracted.I8051.Register10 -> "Register10"
82 | Extracted.I8051.Register11 -> "Register11"
83 | Extracted.I8051.Register12 -> "Register12"
84 | Extracted.I8051.Register13 -> "Register13"
85 | Extracted.I8051.Register14 -> "Register14"
86 | Extracted.I8051.Register15 -> "Register15"
87 | Extracted.I8051.Register16 -> "Register16"
88 | Extracted.I8051.Register17 -> "Register17"
89 | Extracted.I8051.Register20 -> "Register20"
90 | Extracted.I8051.Register21 -> "Register21"
91 | Extracted.I8051.Register22 -> "Register22"
92 | Extracted.I8051.Register23 -> "Register23"
93 | Extracted.I8051.Register24 -> "Register24"
94 | Extracted.I8051.Register25 -> "Register25"
95 | Extracted.I8051.Register26 -> "Register26"
96 | Extracted.I8051.Register27 -> "Register27"
97 | Extracted.I8051.Register30 -> "Register30"
98 | Extracted.I8051.Register31 -> "Register31"
99 | Extracted.I8051.Register32 -> "Register32"
100 | Extracted.I8051.Register33 -> "Register33"
101 | Extracted.I8051.Register34 -> "Register34"
102 | Extracted.I8051.Register35 -> "Register35"
103 | Extracted.I8051.Register36 -> "Register36"
104 | Extracted.I8051.Register37 -> "Register37"
105 | Extracted.I8051.RegisterA -> "RegisterA"
106 | Extracted.I8051.RegisterB -> "RegisterB"
107 | Extracted.I8051.RegisterDPL -> "RegisterDPL"
108 | Extracted.I8051.RegisterDPH -> "RegisterDPH"
109 | Extracted.I8051.RegisterCarry -> "RegisterCarry"
111 let print_registers_move =
113 | Extracted.Joint_LTL_LIN.From_acc (reg,_unit) ->
114 print_Register reg ^ " " ^ "ACC_A"
115 | Extracted.Joint_LTL_LIN.To_acc (_unit,reg) ->
116 "ACC_A " ^ print_Register reg
117 | Extracted.Joint_LTL_LIN.Int_to_reg (reg,byte) ->
118 print_Register reg ^ " " ^ print_byte byte
119 | Extracted.Joint_LTL_LIN.Int_to_acc (_unit,byte) ->
120 "ACC_A " ^ print_byte byte
122 let print_register n = "r_" ^ string_of_pos n
124 let rTL_printing_params =
125 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
126 ; print_acc_a_reg = Obj.magic print_register
127 ; print_acc_b_reg = Obj.magic print_register
128 ; print_acc_a_arg = Obj.magic (print_argument print_register)
129 ; print_acc_b_arg = Obj.magic (print_argument print_register)
130 ; print_dpl_reg = Obj.magic print_register
131 ; print_dph_reg = Obj.magic print_register
132 ; print_dpl_arg = Obj.magic (print_argument print_register)
133 ; print_dph_arg = Obj.magic (print_argument print_register)
134 ; print_snd_arg = Obj.magic (print_argument print_register)
135 ; print_pair_move = Obj.magic
136 (fun {Extracted.Types.fst = reg; snd = arg} ->
137 print_register reg ^ " " ^ print_argument print_register arg)
138 ; print_call_args = Obj.magic
139 (fun l -> String.concat " " (List.map (print_argument print_register) l))
140 ; print_call_dest = Obj.magic
141 (fun l -> String.concat " " (List.map print_register l))
144 match Obj.magic ext with
145 Extracted.RTL.Rtl_stack_address (reg1,reg2) ->
146 "Rtl_stack_address " ^ print_register reg1 ^ " " ^ print_register reg2)
151 Extracted.ERTL.PSD reg -> print_register reg
152 | Extracted.ERTL.HDW reg -> print_Register reg
154 let eRTL_printing_params =
155 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
156 ; print_acc_a_reg = Obj.magic print_register
157 ; print_acc_b_reg = Obj.magic print_register
158 ; print_acc_a_arg = Obj.magic (print_argument print_register)
159 ; print_acc_b_arg = Obj.magic (print_argument print_register)
160 ; print_dpl_reg = Obj.magic print_register
161 ; print_dph_reg = Obj.magic print_register
162 ; print_dpl_arg = Obj.magic (print_argument print_register)
163 ; print_dph_arg = Obj.magic (print_argument print_register)
164 ; print_snd_arg = Obj.magic (print_argument print_register)
165 ; print_pair_move = Obj.magic
166 (fun {Extracted.Types.fst = dst; snd = src} ->
167 print_move_dst dst ^ " " ^ print_argument print_move_dst src )
169 Obj.magic (fun n -> string_of_int (Extracted.Glue.int_of_matitanat n))
170 ; print_call_dest = (fun _ -> "")
172 (fun ext -> match Obj.magic ext with
173 | Extracted.ERTL.Ertl_new_frame -> "NEW FRAME"
174 | Extracted.ERTL.Ertl_del_frame -> "DEL FRAME"
175 | Extracted.ERTL.Ertl_frame_size r -> "FRAMESIZE " ^ print_register r)
178 let joint_LTL_LIN_printing_params =
179 { Extracted.Joint_printer.print_pass_ind = printing_pass_independent_params
180 ; print_acc_a_reg = (fun _ -> "ACC_A")
181 ; print_acc_b_reg = (fun _ -> "ACC_B")
182 ; print_acc_a_arg = (fun _ -> "ACC_A")
183 ; print_acc_b_arg = (fun _ -> "ACC_B")
184 ; print_dpl_reg = (fun _ -> "DPL")
185 ; print_dph_reg = (fun _ -> "DPH")
186 ; print_dpl_arg = (fun _ -> "DPL")
187 ; print_dph_arg = (fun _ -> "DPH")
188 ; print_snd_arg = (fun hdw_arg -> print_argument print_Register (Obj.magic hdw_arg))
189 ; print_pair_move = Obj.magic print_registers_move
191 (fun n ->string_of_int (Extracted.Glue.int_of_matitanat (Obj.magic n)))
192 ; print_call_dest = (fun _ -> "")
194 (fun ext -> match Obj.magic ext with
195 | Extracted.Joint_LTL_LIN.SAVE_CARRY -> "SAVE_CARRY"
196 | Extracted.Joint_LTL_LIN.RESTORE_CARRY -> "RESTORE_CARRY"
197 | Extracted.Joint_LTL_LIN.HIGH_ADDRESS l ->
198 Format.sprintf "HIGH_ADDRESS l_%d" (Extracted.Glue.int_of_matitapos l)
199 | Extracted.Joint_LTL_LIN.LOW_ADDRESS l ->
200 Format.sprintf "LOW_ADDRESS l_%d" (Extracted.Glue.int_of_matitapos l))
203 let rec list_of_matitalist =
205 Extracted.List.Nil -> []
206 | Extracted.List.Cons (hd,tl) -> hd :: list_of_matitalist tl
209 let l = list_of_matitalist l in
212 (fun {Extracted.Types.fst=ident; snd=commands} ->
213 let commands = list_of_matitalist commands in
214 print_ident ident ^ ":\n" ^
215 String.concat "\n" (List.rev commands)
219 let extension_of_pass =
221 | Extracted.Compiler.Clight_pass -> "clight"
222 | Extracted.Compiler.Clight_switch_removed_pass -> "clight_sr"
223 | Extracted.Compiler.Clight_label_pass -> "clight_l"
224 | Extracted.Compiler.Clight_simplified_pass -> "clight_s"
225 | Extracted.Compiler.Cminor_pass -> "cminor"
226 | Extracted.Compiler.Rtlabs_pass -> "rtlabs"
227 | Extracted.Compiler.Rtl_separate_pass -> "rtl"
228 | Extracted.Compiler.Rtl_uniq_pass -> "rtl_u"
229 | Extracted.Compiler.Ertl_pass -> "ertl"
230 | Extracted.Compiler.Ltl_pass -> "ltl"
231 | Extracted.Compiler.Lin_pass -> "lin"
232 | Extracted.Compiler.Assembly_pass -> "assembly"
233 | Extracted.Compiler.Object_code_pass -> "hex"
237 let print_program sourcename pass (program : Extracted.Preamble.__) =
239 print_graph (pcs (Extracted.Types.fst (Obj.magic program))) in
242 | Extracted.Compiler.Clight_pass
243 | Extracted.Compiler.Clight_switch_removed_pass
244 | Extracted.Compiler.Clight_label_pass
245 | Extracted.Compiler.Clight_simplified_pass ->
246 ClightPrinter.print_program ClightPrinter.Cost_plain (Obj.magic program)
247 | Extracted.Compiler.Rtlabs_pass ->
248 RTLabsPrinter.print_program (Obj.magic program)
249 | Extracted.Compiler.Rtl_separate_pass ->
250 beprint (Extracted.RTL_printer.print_RTL_program rTL_printing_params)
251 | Extracted.Compiler.Rtl_uniq_pass ->
252 beprint (Extracted.RTL_printer.print_RTL_program rTL_printing_params)
253 | Extracted.Compiler.Ertl_pass ->
254 beprint (Extracted.ERTL_printer.print_ERTL_program eRTL_printing_params)
255 | Extracted.Compiler.Ltl_pass ->
257 (Extracted.LTL_printer.print_LTL_program joint_LTL_LIN_printing_params)
258 | Extracted.Compiler.Lin_pass ->
260 (Extracted.LIN_printer.print_LIN_program joint_LTL_LIN_printing_params)
261 | Extracted.Compiler.Object_code_pass ->
262 ASMPrinter.print_program (Obj.magic program)
266 Filename.chop_extension sourcename ^ "." ^ extension_of_pass pass in
267 let och = open_out filename in
268 output_string och lines;