source: Deliverables/D2.2/8051-indexed-labels-branch/src/LIN/LINPrinter.ml @ 1392

Last change on this file since 1392 was 1392, checked in by tranquil, 9 years ago

fiddling with Cminor: elimination of loops, blocks and exits

File size: 5.1 KB
Line 
1
2(** This module provides a function to print [LIN] programs. *)
3
4
5let n_spaces ?stmt n = 
6        let n = match stmt with
7                | Some (LIN.St_label _) | Some (LIN.St_cost _) -> n - 2
8                | _ -> n in 
9        String.make n ' '
10
11
12let print_global n (x, size) =
13  Printf.sprintf "%s\"%s\" [%d]" (n_spaces n) x size
14
15let print_globals n globs =
16  Printf.sprintf "%sglobals:\n%s"
17    (n_spaces n)
18    (List.fold_left (fun s g -> s ^ (print_global (n+2) g) ^ "\n") "" globs)
19
20
21let print_reg = I8051.print_register
22
23let print_a = print_reg I8051.a
24
25
26let print_statement = function
27  | LIN.St_goto lbl -> "goto " ^ lbl
28  | LIN.St_label lbl -> lbl ^ ":"
29  | LIN.St_comment s ->
30    Printf.sprintf "*** %s ***" s
31  | LIN.St_cost cost_lbl ->
32    let cost_lbl = CostLabel.string_of_cost_label ~pretty:true cost_lbl in
33                Printf.sprintf "emit %s" cost_lbl
34  | LIN.St_ind_0 i ->
35    Printf.sprintf "index %d" i
36  | LIN.St_ind_inc i ->
37    Printf.sprintf "increment %d" i
38  | LIN.St_int (dstr, i) ->
39    Printf.sprintf "imm %s, %d" (print_reg dstr) i
40  | LIN.St_pop ->
41    Printf.sprintf "pop %s" print_a
42  | LIN.St_push ->
43    Printf.sprintf "push %s" print_a
44  | LIN.St_addr id ->
45    Printf.sprintf "addr DPTR, %s" id
46  | LIN.St_from_acc dstr ->
47    Printf.sprintf "move %s, %s" (print_reg dstr) print_a
48  | LIN.St_to_acc srcr ->
49    Printf.sprintf "move %s, %s" print_a (print_reg srcr)
50  | LIN.St_opaccs opaccs ->
51    Printf.sprintf "%s %s, %s"
52      (I8051.print_opaccs opaccs) print_a (print_reg I8051.b)
53  | LIN.St_op1 op1 ->
54    Printf.sprintf "%s %s" (I8051.print_op1 op1) print_a
55  | LIN.St_op2 (op2, srcr) ->
56    Printf.sprintf "%s %s, %s"
57      (I8051.print_op2 op2) print_a (print_reg srcr)
58  | LIN.St_clear_carry -> "clear CARRY"
59  | LIN.St_set_carry -> "set CARRY"
60  | LIN.St_load ->
61    Printf.sprintf "movex %s, @DPTR" print_a
62  | LIN.St_store ->
63    Printf.sprintf "movex @DPTR, %s" print_a
64  | LIN.St_call_id f -> Printf.sprintf "call \"%s\"" f
65  | LIN.St_condacc lbl_true ->
66    Printf.sprintf "branch %s <> 0, %s" print_a lbl_true
67  | LIN.St_return -> "return"
68
69
70let print_code n c =
71  let f s stmt =
72    Printf.sprintf "%s\n%s%s" s (n_spaces ~stmt:stmt n) (print_statement stmt) in
73  List.fold_left f "" c
74
75
76let print_internal_decl n f def =
77
78  Printf.sprintf
79    "%s\"%s\"\n\n%s"
80    (n_spaces n)
81    f
82    (print_code (n+2) def)
83
84
85let print_external_decl n f def =
86  Printf.sprintf "%sextern \"%s\": %s\n"
87    (n_spaces n)
88    f
89    (Primitive.print_sig def.AST.ef_sig)
90
91
92let print_fun_decl n (f, def) = match def with
93  | LIN.F_int def -> print_internal_decl n f def
94  | LIN.F_ext def -> print_external_decl n f def
95
96let print_fun_decls n functs =
97  List.fold_left (fun s f -> s ^ (print_fun_decl n f) ^ "\n\n") ""
98    functs
99
100
101let print_program p =
102  Printf.sprintf "program:\n\n\n%s\n\n%s"
103    (print_globals 2 p.LIN.vars)
104    (print_fun_decls 2 p.LIN.functs)
105
106(*
107(* Adapted from Pottier's PP compiler *)
108
109open Printf
110open PrintPottier
111open LIN
112
113let reg () r =
114  sprintf "$%s" (MIPS.print r)
115
116(*
117let slo () = function
118  | SlotLocal o ->
119      sprintf "local(%ld)" o
120  | SlotIncoming o ->
121      sprintf "in(%ld)" o
122  | SlotOutgoing o ->
123      sprintf "out(%ld)" o
124*)
125
126let load_op () = function
127  | AST.Byte -> "lb "
128  | AST.HalfWord -> "lhw"
129  | AST.Word -> "lw "
130
131let store_op () = function
132  | AST.Byte -> "sb "
133  | AST.HalfWord -> "shw"
134  | AST.Word -> "sw "
135
136let instruction () i =
137
138  match i with
139    | INewFrame ->
140        sprintf "newframe"
141    | IDeleteFrame ->
142        sprintf "delframe"
143(*
144    | IGetStack (destr, slot) ->
145        sprintf "gets  %a, %a" reg destr slo slot
146    | ISetStack (slot, sourcer) ->
147        sprintf "sets  %a, %a" slo slot reg sourcer
148*)
149    | IConst (r, i) ->
150        sprintf "li    %a, %ld" reg r i
151    | IUnOp (op, destr, sourcer) ->
152        sprintf "%a" (PrintOps.unop reg) (op, destr, sourcer)
153    | IBinOp (op, destr, sourcer1, sourcer2) ->
154        sprintf "%s %a, %a, %a" (PrintOps.binop op) reg destr reg sourcer1 reg sourcer2
155    | ILoadAddr (r, f) ->
156        sprintf "la    %a, %s" reg r f
157    | ICall rf ->
158        sprintf "call  %a" reg rf
159    | ITailCall rf ->
160        sprintf "tail  %a" reg rf
161    | ILoad (size, destr, sourcer, offset) ->
162        sprintf "%a   %a, %ld(%a)" load_op size reg destr offset reg sourcer
163    | IStore (size, addressr, offset, valuer) ->
164        sprintf "%a   %a, %ld(%a)" store_op size reg valuer offset reg addressr
165    | IGoto l ->
166        sprintf "j     %s" l
167    | IUnBranch (cond, sourcer, l) ->
168        sprintf "%a, %s" (PrintOps.uncon reg) (cond, sourcer) l
169    | IBinBranch (cond, sourcer1, sourcer2, l) ->
170        sprintf "%s %a, %a, %s" (PrintOps.bincon cond) reg sourcer1 reg sourcer2 l
171    | IReturn ->
172        sprintf "jr    $ra"
173    | ILabel l ->
174        sprintf "%s:" l
175    | ICost l ->
176        sprintf "%s:" l
177
178let proc () (name, proc) = match proc with
179  | LIN.F_int proc ->
180      sprintf "procedure %s(%ld)\nvar %ld\n%a"
181        name
182        proc.formals
183        proc.locals
184        (seplist nl instruction) proc.code
185  | LIN.F_ext proc ->
186      sprintf "extern %s: %s\n" name (Primitive.print_sig proc.AST.ef_sig)
187
188let map_to_association_list map =
189  let f k v l = (k, v) :: l in
190  StringTools.Map.fold f map []
191
192let print_program () p =
193  sprintf "program\n\nglobals %ld\n\n%a"
194    p.globals
195    (termlist nlnl proc) (map_to_association_list p.defs)
196*)
Note: See TracBrowser for help on using the repository browser.