]> matita.cs.unibo.it Git - pkg-cerco/acc.git/blob - src/LIN/LINPrinter.ml
Package description and copyright added.
[pkg-cerco/acc.git] / src / LIN / LINPrinter.ml
1
2 (** This module provides a function to print [LIN] programs. *)
3
4
5 let n_spaces n = String.make n ' '
6
7
8 let print_global n (x, size) =
9   Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
10
11 let print_globals eformat n globs =
12   Eformat.printf eformat "%sglobals:\n" (n_spaces n) ;
13   List.iter
14     (fun g -> Eformat.printf eformat "%s\n" (print_global (n+2) g)) globs
15
16
17 let print_reg = I8051.print_register
18
19 let print_a = print_reg I8051.a
20
21
22 let print_statement = function
23   | LIN.St_goto lbl -> "goto " ^ lbl
24   | LIN.St_label lbl -> lbl ^ ":"
25   | LIN.St_comment s ->
26     Printf.sprintf "*** %s ***" s
27   | LIN.St_cost cost_lbl ->
28     Printf.sprintf "emit %s" cost_lbl
29   | LIN.St_int (dstr, i) ->
30     Printf.sprintf "imm %s, %d" (print_reg dstr) i
31   | LIN.St_pop ->
32     Printf.sprintf "pop %s" print_a
33   | LIN.St_push ->
34     Printf.sprintf "push %s" print_a
35   | LIN.St_addr id ->
36     Printf.sprintf "addr DPTR, %s" id
37   | LIN.St_from_acc dstr ->
38     Printf.sprintf "move %s, %s" (print_reg dstr) print_a
39   | LIN.St_to_acc srcr ->
40     Printf.sprintf "move %s, %s" print_a (print_reg srcr)
41   | LIN.St_opaccs opaccs ->
42     Printf.sprintf "%s %s, %s"
43       (I8051.print_opaccs opaccs) print_a (print_reg I8051.b)
44   | LIN.St_op1 op1 ->
45     Printf.sprintf "%s %s" (I8051.print_op1 op1) print_a
46   | LIN.St_op2 (op2, srcr) ->
47     Printf.sprintf "%s %s, %s"
48       (I8051.print_op2 op2) print_a (print_reg srcr)
49   | LIN.St_clear_carry -> "clear CARRY"
50   | LIN.St_set_carry -> "set CARRY"
51   | LIN.St_load ->
52     Printf.sprintf "movex %s, @DPTR" print_a
53   | LIN.St_store ->
54     Printf.sprintf "movex @DPTR, %s" print_a
55   | LIN.St_call_id f -> Printf.sprintf "call \"%s\"" f
56   | LIN.St_call_ptr ->
57     Printf.sprintf "call_ptr DPTR"
58   | LIN.St_condacc lbl_true ->
59     Printf.sprintf "branch %s <> 0, %s" print_a lbl_true
60   | LIN.St_return -> "return"
61
62
63 let print_code eformat n c =
64   let f stmt =
65     Eformat.printf eformat "\n%s%s" (n_spaces n) (print_statement stmt) in
66   List.iter f c
67
68
69 let print_internal_decl eformat n f def =
70   Eformat.printf eformat "%s\"%s\"\n\n" (n_spaces n) f ;
71   print_code eformat (n+2) def
72
73
74 let print_external_decl eformat n f def =
75   Eformat.printf eformat "%sextern \"%s\": %s\n"
76     (n_spaces n)
77     f
78     (Primitive.print_sig def.AST.ef_sig)
79
80
81 let print_fun_decl eformat n (f, def) = match def with
82   | LIN.F_int def -> print_internal_decl eformat n f def
83   | LIN.F_ext def -> print_external_decl eformat n f def
84
85 let print_fun_decls eformat n functs =
86   List.iter
87     (fun f -> print_fun_decl eformat n f ; Eformat.printf eformat "\n\n") functs
88
89
90 let print_program p =
91   let eformat = Eformat.create () in
92   Eformat.printf eformat "program:\n\n\n" ;
93   print_globals eformat 2 p.LIN.vars ;
94   Eformat.printf eformat "\n\n" ;
95   print_fun_decls eformat 2 p.LIN.functs ;
96   Eformat.get eformat