source: Deliverables/D2.2/8051/src/LIN/LINToASM.ml

Last change on this file was 1580, checked in by tranquil, 8 years ago

implemented constant propagation in LTL
cleaned up translations in optimizations, a new module for translations is available

File size: 5.8 KB
Line 
1
2(** This module translates a [LIN] program into a [ASM] program. *)
3
4
5let error_prefix = "LIN to ASM"
6let error s = Error.global_error error_prefix s
7
8
9(* Translation environment *)
10
11type env =
12    { externals : AST.ident list ;
13      exit_lbl : Label.t ;
14      fresh : unit -> string }
15
16let make_env externals exit_lbl fresh =
17  { externals = externals ;
18    exit_lbl = exit_lbl ;
19    fresh = fresh }
20
21
22(* Fetch the labels found in a LIN program. *)
23
24let statement_labels = function
25  | LIN.St_goto lbl
26  | LIN.St_label lbl
27  | LIN.St_condacc lbl -> Label.Set.singleton lbl
28    (* taking the atom as a fresh prefix will be generated *)
29  | LIN.St_cost lbl -> Label.Set.singleton (lbl.CostLabel.name)
30  | _ -> Label.Set.empty
31
32let funct_labels (_, fun_def) = match fun_def with
33  | LIN.F_int stmts ->
34    let f labels stmt = Label.Set.union labels (statement_labels stmt) in
35    List.fold_left f Label.Set.empty stmts
36  | _ -> Label.Set.empty
37
38let prog_labels p =
39  let f labels funct = Label.Set.union labels (funct_labels funct) in
40  List.fold_left f Label.Set.empty p.LIN.functs
41
42
43let size_of_vect_size = function
44  | `Four -> 4
45  | `Seven -> 7
46  | `Eight -> 8
47  | `Eleven -> 11
48  | `Sixteen -> 16
49
50let vect_of_int i size =
51  let i' =
52    if i < 0 then (MiscPottier.pow 2 (size_of_vect_size size)) + i else i in
53  BitVectors.vect_of_int i' size
54
55let byte_of_int i = vect_of_int i `Eight
56let data_of_int i = `DATA (byte_of_int i)
57let reg_or_data = function
58  | LTL.Imm k -> data_of_int k
59  | LTL.Reg r -> I8051.reg_addr r
60let data16_of_int i = `DATA16 (vect_of_int i `Sixteen)
61let acc_addr = I8051.reg_addr I8051.a
62let dpl_addr = I8051.reg_addr I8051.dpl
63let dph_addr = I8051.reg_addr I8051.dph
64let st0_addr = I8051.reg_addr I8051.st0
65let st1_addr = I8051.reg_addr I8051.st1
66
67
68let translate_statement env = function
69  | LIN.St_goto lbl -> [`Jmp lbl]
70  | LIN.St_label lbl -> [`Label lbl]
71  | LIN.St_comment _ -> []
72  | LIN.St_cost lbl ->
73    (* TODO: hack! Need to make the difference between cost labels and regular
74       labels. *)
75    [`Cost lbl ; `NOP ]
76  | LIN.St_ind_0 i -> [`Index i ; `NOP (* TODO: hack! *)]
77  | LIN.St_ind_inc i -> [`Inc i ; `NOP (* TODO: hack! *)]
78  | LIN.St_int (r, 0) when I8051.eq_reg r I8051.a ->
79    [`CLR `A]
80  | LIN.St_int (r, i) ->
81    [`MOV (`U3 (I8051.reg_addr r, data_of_int i))]
82  | LIN.St_pop ->
83    [`POP acc_addr]
84  | LIN.St_push ->
85    [`PUSH acc_addr]
86  | LIN.St_addr x when List.mem x env.externals ->
87    error ("Primitive or external " ^ x ^ " is not supported.")
88  | LIN.St_addr x ->
89    [`Mov (`DPTR, x)]
90  | LIN.St_from_acc r ->
91    [`MOV (`U3 (I8051.reg_addr r, `A))]
92  | LIN.St_to_acc r ->
93    [`MOV (`U1 (`A, I8051.reg_addr r))]
94  | LIN.St_opaccs I8051.Mul ->
95    [`MUL (`A, `B)]
96  | LIN.St_opaccs I8051.DivuModu ->
97    [`DIV (`A, `B)]
98  | LIN.St_op1 I8051.Cmpl ->
99    [`CPL `A]
100  | LIN.St_op1 I8051.Inc ->
101    [`INC `A]
102  | LIN.St_op1 I8051.Rl ->
103    [`RL `A]
104  | LIN.St_op2 (I8051.Add, a) ->
105    [`ADD (`A, reg_or_data a)]
106  | LIN.St_op2 (I8051.Addc, a) ->
107    [`ADDC (`A, reg_or_data a)]
108  | LIN.St_op2 (I8051.Sub, a) ->
109    [`SUBB (`A, reg_or_data a)]
110  | LIN.St_op2 (I8051.And, r) ->
111    [`ANL (`U1 (`A, reg_or_data r))]
112  | LIN.St_op2 (I8051.Or, r) ->
113    [`ORL (`U1 (`A, reg_or_data r))]
114  | LIN.St_op2 (I8051.Xor, r) ->
115    [`XRL (`U1 (`A, reg_or_data r))]
116  | LIN.St_clear_carry ->
117    [`CLR `C]
118  | LIN.St_set_carry ->
119    [`SETB `C]
120  | LIN.St_load ->
121    [`MOVX (`U1 (`A, `EXT_IND_DPTR))]
122  | LIN.St_store ->
123    [`MOVX (`U2 (`EXT_IND_DPTR, `A))]
124  | LIN.St_call_id x when List.mem x env.externals ->
125    error ("Primitive or external " ^ x ^ " is not supported.")
126  | LIN.St_call_id f ->
127    [`Call f]
128  | LIN.St_call_ptr ->
129    let lbl = env.fresh () in
130    [`MOV (`U3 (st0_addr, dpl_addr)) ; (* save DPL *)
131     `MOV (`U3 (st1_addr, dph_addr)) ; (* save DPH *)
132     `Mov (`DPTR, lbl) ;               (* DPTR <- return address *)
133     `PUSH dpl_addr ;                  (* push DPL *)
134     `PUSH dph_addr ;                  (* push DPH *)
135     `MOV (`U3 (dpl_addr, st0_addr)) ; (* restore DPL *)
136     `MOV (`U3 (dph_addr, st1_addr)) ; (* restore DPH *)
137     `MOV (`U1 (`A, data_of_int 0)) ;  (* A <- 0 *)
138     `JMP `IND_DPTR ;                  (* jump to A+DPTR *)
139     `Label lbl]                       (* return address *)
140  | LIN.St_condacc lbl ->
141    [`WithLabel (`JNZ (`Label lbl))]
142  | LIN.St_return ->
143    [`RET]
144
145let translate_code env code =
146  List.flatten (List.map (translate_statement env) code)
147
148
149let translate_fun_def env (id, def) =
150  let code = match def with
151  | LIN.F_int code -> translate_code env code
152  | LIN.F_ext ext -> [`NOP] in
153  ((`Label id) :: code)
154
155let translate_functs env main functs =
156  let preamble = match main with
157    | None -> []
158    | Some main ->
159      [`MOV (`U3 (`DIRECT (byte_of_int I8051.isp_addr),
160                  data_of_int I8051.isp_init)) ;
161       `MOV (`U3 (`DIRECT (byte_of_int I8051.spl_addr),
162                  data_of_int I8051.spl_init)) ;
163       `MOV (`U3 (`DIRECT (byte_of_int I8051.sph_addr),
164                  data_of_int I8051.sph_init)) ;
165       `Call main ;
166       `Label env.exit_lbl ; `Jmp env.exit_lbl] in
167  preamble @ (List.flatten (List.map (translate_fun_def env) functs))
168
169
170let init_env p =
171  let f_externals (id, def) = match def with LIN.F_ext _ -> [id] | _ -> [] in
172  let externals =
173    List.fold_left (fun res def -> res @ (f_externals def)) [] p.LIN.functs in
174  let prog_lbls = prog_labels p in
175  let exit_lbl = Label.Gen.fresh_prefix prog_lbls "_exit" in
176  let fresh = Label.make_fresh prog_lbls "_call_ret" in
177  make_env externals exit_lbl fresh
178
179
180(* Translating programs.
181
182   Global variables are associated an offset from the base of the external
183   memory. *)
184
185let translate p =
186  let env = init_env p in
187  let p =
188    { ASM.ppreamble = p.LIN.vars ;
189      ASM.pexit_label = env.exit_lbl ;
190      ASM.pcode = translate_functs env p.LIN.main p.LIN.functs ;
191      ASM.phas_main = p.LIN.main <> None } in
192  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.