2 (** This module provides a function to print [LTL] programs. *)
5 let n_spaces n = String.make n ' '
8 let print_global n (x, size) =
9 Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
11 let print_globals eformat n globs =
12 Eformat.printf eformat "%sglobals:\n" (n_spaces n) ;
14 (fun g -> Eformat.printf eformat "%s\n" (print_global (n+2) g)) globs
17 let print_reg = I8051.print_register
19 let print_a = print_reg I8051.a
22 let print_statement = function
23 | LTL.St_skip lbl -> "--> " ^ lbl
24 | LTL.St_comment (s, lbl) ->
25 Printf.sprintf "*** %s *** --> %s" s lbl
26 | LTL.St_cost (cost_lbl, lbl) ->
27 Printf.sprintf "emit %s --> %s" cost_lbl lbl
28 | LTL.St_int (dstr, i, lbl) ->
29 Printf.sprintf "imm %s, %d --> %s" (print_reg dstr) i lbl
31 Printf.sprintf "pop %s --> %s" print_a lbl
33 Printf.sprintf "push %s --> %s" print_a lbl
34 | LTL.St_addr (id, lbl) ->
35 Printf.sprintf "addr DPTR, %s --> %s" id lbl
36 | LTL.St_from_acc (dstr, lbl) ->
37 Printf.sprintf "move %s, %s --> %s" (print_reg dstr) print_a lbl
38 | LTL.St_to_acc (srcr, lbl) ->
39 Printf.sprintf "move %s, %s --> %s" print_a (print_reg srcr) lbl
40 | LTL.St_opaccs (opaccs, lbl) ->
41 Printf.sprintf "%s %s, %s --> %s"
42 (I8051.print_opaccs opaccs) print_a (print_reg I8051.b) lbl
43 | LTL.St_op1 (op1, lbl) ->
44 Printf.sprintf "%s %s --> %s" (I8051.print_op1 op1) print_a lbl
45 | LTL.St_op2 (op2, srcr, lbl) ->
46 Printf.sprintf "%s %s, %s --> %s"
47 (I8051.print_op2 op2) print_a (print_reg srcr) lbl
48 | LTL.St_clear_carry lbl ->
49 Printf.sprintf "clear CARRY --> %s" lbl
50 | LTL.St_set_carry lbl ->
51 Printf.sprintf "set CARRY --> %s" lbl
53 Printf.sprintf "movex %s, @DPTR --> %s" print_a lbl
55 Printf.sprintf "movex @DPTR, %s --> %s" print_a lbl
56 | LTL.St_call_id (f, lbl) -> Printf.sprintf "call \"%s\" --> %s" f lbl
57 | LTL.St_call_ptr lbl ->
58 Printf.sprintf "call_ptr DPTR --> %s" lbl
59 | LTL.St_condacc (lbl_true, lbl_false) ->
60 Printf.sprintf "branch %s <> 0 --> %s, %s" print_a lbl_true lbl_false
61 | LTL.St_return -> Printf.sprintf "return"
64 let print_graph eformat n c =
66 Eformat.printf eformat "%s%s: %s\n"
69 (print_statement stmt) in
73 let print_internal_decl eformat n f def =
74 Eformat.printf eformat
75 "%s\"%s\"\n%sstacksize: %d\n%sentry: %s\n%sexit: %s\n\n"
84 print_graph eformat (n+2) def.LTL.f_graph
87 let print_external_decl eformat n f def =
88 Eformat.printf eformat "%sextern \"%s\": %s\n"
91 (Primitive.print_sig def.AST.ef_sig)
94 let print_fun_decl eformat n (f, def) = match def with
95 | LTL.F_int def -> print_internal_decl eformat n f def
96 | LTL.F_ext def -> print_external_decl eformat n f def
98 let print_fun_decls eformat n functs =
100 (fun f -> print_fun_decl eformat n f ; Eformat.printf eformat "\n\n")
104 let print_program p =
105 let eformat = Eformat.create () in
106 Eformat.printf eformat "program:\n\n\n" ;
107 print_globals eformat 2 p.LTL.vars ;
108 Eformat.printf eformat "\n\n" ;
109 print_fun_decls eformat 2 p.LTL.functs ;