source: Deliverables/D2.2/8051/src/LIN/LINPrinter.ml @ 1568

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