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

Last change on this file since 1488 was 1488, checked in by ayache, 8 years ago

Function pointers in D2.2/8051. Bugged for now.

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