source: Deliverables/D2.3/8051/src/LIN/LINToASM.ml @ 453

Last change on this file since 453 was 453, checked in by ayache, 9 years ago

Import of the Paris's sources.

File size: 5.0 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    `Begin_fun :: (`Label id) ::
116      (translate_code tmp_universe glbls_addr code) @
117      [`End_fun]
118  | _ -> []
119
120let translate_functs tmp_universe glbls_addr exit_label main functs =
121  let preamble = match main with
122    | None -> []
123    | Some main -> [`Call main ; `Label exit_label ; `Jmp exit_label] in
124  preamble @
125    (List.flatten (List.map (translate_fun_def tmp_universe glbls_addr) functs))
126
127
128let globals_addr l =
129  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
130  fst (List.fold_left f ([], 0) l)
131
132
133(* Translating programs.
134
135   A fresh universe is create, in order to create an exit label and fresh labels
136   for the expansion of conditional instructions (see the .mli).
137
138   Global variables are associated an offset from the base of the external
139   memory. *)
140
141let translate p =
142  let prog_lbls = prog_labels p in
143  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
144  let fresh_tmp =
145    Label.Gen.fresh_prefix (Label.Set.add exit_label prog_lbls) "_tmp_lbl" in
146  let tmp_universe = Label.Gen.new_universe fresh_tmp in
147  let glbls_addr = globals_addr p.LIN.vars in
148  { ASM.preamble = p.LIN.vars ;
149    ASM.exit_label = exit_label ;
150    ASM.code =
151      translate_functs tmp_universe glbls_addr exit_label p.LIN.main
152        p.LIN.functs ;
153    ASM.has_main = p.LIN.main <> None }
Note: See TracBrowser for help on using the repository browser.