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

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

Deliverable D2.2

File size: 5.6 KB
Line 
1
2(** This module translates a [LIN] program into a [ASM] program. *)
3
4
5let statement_labels = function
6  | LIN.St_goto lbl
7  | LIN.St_label lbl
8  | LIN.St_cost lbl
9  | LIN.St_condacc lbl -> Label.Set.singleton lbl
10  | _ -> Label.Set.empty
11
12let funct_labels (_, fun_def) = match fun_def with
13  | LIN.F_int stmts ->
14    let f labels stmt = Label.Set.union labels (statement_labels stmt) in
15    List.fold_left f Label.Set.empty stmts
16  | _ -> Label.Set.empty
17
18(* Fetch the labels found in a LIN program. *)
19
20let prog_labels p =
21  let f labels funct = Label.Set.union labels (funct_labels funct) in
22  List.fold_left f Label.Set.empty p.LIN.functs
23
24
25let byte_of_int i = BitVectors.vect_of_int i `Eight
26let data_of_int i = `DATA (byte_of_int i)
27let data16_of_int i = `DATA16 (BitVectors.vect_of_int i `Sixteen)
28let acc_addr = I8051.reg_addr I8051.a
29
30
31let translate_statement glbls_addr = function
32  | LIN.St_goto lbl -> [`Jmp lbl]
33  | LIN.St_label lbl -> [`Label lbl]
34  | LIN.St_comment _ -> []
35  | LIN.St_cost lbl -> [`Cost lbl]
36  | LIN.St_int (r, i) ->
37    [`MOV (`U3 (I8051.reg_addr r, data_of_int i))]
38  | LIN.St_pop ->
39    [`POP acc_addr]
40  | LIN.St_push ->
41    [`PUSH acc_addr]
42  | LIN.St_addr x ->
43    [`MOV (`U4 (`DPTR, data16_of_int (List.assoc x glbls_addr)))]
44  | LIN.St_from_acc r ->
45    [`MOV (`U3 (I8051.reg_addr r, `A))]
46  | LIN.St_to_acc r ->
47    [`MOV (`U1 (`A, I8051.reg_addr r))]
48  | LIN.St_opaccs I8051.Mul ->
49    [`MUL (`A, `B)]
50  | LIN.St_opaccs I8051.Divu ->
51    [`DIV (`A, `B)]
52  | LIN.St_opaccs I8051.Modu ->
53    assert false (* Should have been translated before. *)
54  | LIN.St_op1 I8051.Cmpl ->
55    [`CPL `A]
56  | LIN.St_op1 I8051.Inc ->
57    [`INC `A]
58  | LIN.St_op2 (I8051.Add, r) ->
59    [`ADD (`A, I8051.reg_addr r)]
60  | LIN.St_op2 (I8051.Addc, r) ->
61    [`ADDC (`A, I8051.reg_addr r)]
62  | LIN.St_op2 (I8051.Sub, r) ->
63    [`SUBB (`A, I8051.reg_addr r)]
64  | LIN.St_op2 (I8051.And, r) ->
65    [`ANL (`U1 (`A, I8051.reg_addr r))]
66  | LIN.St_op2 (I8051.Or, r) ->
67    [`ORL (`U1 (`A, I8051.reg_addr r))]
68  | LIN.St_op2 (I8051.Xor, r) ->
69    [`XRL (`U1 (`A, I8051.reg_addr r))]
70  | LIN.St_clear_carry ->
71    [`CLR `C]
72  | LIN.St_load ->
73    [`MOVX (`U1 (`A, `EXT_IND_DPTR))]
74  | LIN.St_store ->
75    [`MOVX (`U2 (`EXT_IND_DPTR, `A))]
76  | LIN.St_call_id f ->
77    [`Call f]
78  | LIN.St_condacc lbl ->
79    assert false (* particular case treated in translate_code *)
80  | LIN.St_return ->
81    [`RET]
82
83(** [remove_following_cost_label lbl code] first finds the label instruction of
84    [lbl]. It supposes that [lbl] is the destination of a conditional
85    statement. Thus, it is followed by a cost instruction. The result is then
86    this cost label and the code without this particular cost instruction. *)
87
88let rec remove_following_cost_label lbl = function
89  | [] -> assert false (* wrong labelling *)
90  | LIN.St_label lbl' :: LIN.St_cost cost_lbl :: code when lbl' = lbl ->
91    (cost_lbl, LIN.St_label lbl' :: code)
92  | stmt :: code ->
93    let (cost_lbl, code') = remove_following_cost_label lbl code in
94    (cost_lbl, stmt :: code')
95
96let translate_code tmp_universe glbls_addr =
97  let rec aux = function
98    | [] -> []
99    | LIN.St_condacc lbl :: code ->
100      (* The conditional statement requires a special treatment. See the .mli
101         for details. We have to pay a special attention to the cost labels, so
102         as to not introduce an imprecision. *)
103      let (cost_lbl, code') = remove_following_cost_label lbl code in
104      let tmp_lbl = Label.Gen.fresh tmp_universe in
105      [`WithLabel (`JZ (`Label tmp_lbl)) ;
106       `Cost cost_lbl ; `Jmp lbl ;
107       `Label tmp_lbl] @
108      (aux code')
109    | stmt :: code -> (translate_statement glbls_addr stmt) @ (aux code) in
110  aux
111
112
113let translate_fun_def tmp_universe glbls_addr (id, def) = match def with
114  | LIN.F_int code ->
115    (`Label id) :: (translate_code tmp_universe glbls_addr code)
116  | _ -> []
117
118let translate_functs tmp_universe glbls_addr exit_label main functs =
119  let preamble = match main with
120    | None -> []
121    | Some main -> [`Call main ; `Label exit_label ; `Jmp exit_label] in
122  preamble @
123    (List.flatten (List.map (translate_fun_def tmp_universe glbls_addr) functs))
124
125
126let globals_addr l =
127  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
128  fst (List.fold_left f ([], 0) l)
129
130
131(* Move the first cost label of each function at the beginning of the
132   function. Indeed, some preamble instructions (such as frame creation) might
133   get in the way.  *)
134
135let move_first_cost_label_up_code =
136  let rec aux preamble = function
137    | [] -> preamble
138    | LIN.St_cost lbl :: code -> LIN.St_cost lbl :: preamble @ code
139    | inst :: code -> aux (preamble @ [inst]) code
140  in aux []
141
142let move_first_cost_label_up_funct (id, def) =
143  let def' = match def with
144    | LIN.F_int int_def -> LIN.F_int (move_first_cost_label_up_code int_def)
145    | _ -> def in
146  (id, def')
147
148let move_first_cost_label_up p =
149  { p with LIN.functs = List.map move_first_cost_label_up_funct p.LIN.functs }
150
151
152(* Translating programs.
153
154   A fresh universe is create, in order to create an exit label and fresh labels
155   for the expansion of conditional instructions (see the .mli).
156
157   Global variables are associated an offset from the base of the external
158   memory. *)
159
160let translate p =
161  let prog_lbls = prog_labels p in
162  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
163  let fresh_tmp =
164    Label.Gen.fresh_prefix (Label.Set.add exit_label prog_lbls) "_tmp_lbl" in
165  let tmp_universe = Label.Gen.new_universe fresh_tmp in
166  let glbls_addr = globals_addr p.LIN.vars in
167  { ASM.preamble = p.LIN.vars ;
168    ASM.exit_label = exit_label ;
169    ASM.code =
170      translate_functs tmp_universe glbls_addr exit_label p.LIN.main
171        p.LIN.functs ;
172    ASM.has_main = p.LIN.main <> None }
Note: See TracBrowser for help on using the repository browser.