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

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

Bug fixs and signed division hack in D2.2.

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  | [] -> (None, []) (* no labelling *)
90  | LIN.St_label lbl' :: LIN.St_cost cost_lbl :: code when lbl' = lbl ->
91    (Some 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      (match cost_lbl with
105        | None -> aux code'
106        | Some cost_lbl ->
107          let tmp_lbl = Label.Gen.fresh tmp_universe in
108          [`WithLabel (`JZ (`Label tmp_lbl)) ;
109           `Cost cost_lbl ; `Jmp lbl ;
110           `Label tmp_lbl] @
111            (aux code'))
112    | stmt :: code -> (translate_statement glbls_addr stmt) @ (aux code) in
113  aux
114
115
116let translate_fun_def tmp_universe glbls_addr (id, def) = match def with
117  | LIN.F_int code ->
118    (`Label id) :: (translate_code tmp_universe glbls_addr code)
119  | _ -> []
120
121let translate_functs tmp_universe glbls_addr exit_label main functs =
122  let preamble = match main with
123    | None -> []
124    | Some main -> [`Call main ; `Label exit_label ; `Jmp exit_label] in
125  preamble @
126    (List.flatten (List.map (translate_fun_def tmp_universe glbls_addr) functs))
127
128
129let globals_addr l =
130  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
131  fst (List.fold_left f ([], 0) l)
132
133
134(* Translating programs.
135
136   A fresh universe is create, in order to create an exit label and fresh labels
137   for the expansion of conditional instructions (see the .mli).
138
139   Global variables are associated an offset from the base of the external
140   memory. *)
141
142let translate p =
143  let prog_lbls = prog_labels p in
144  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
145  let fresh_tmp =
146    Label.Gen.fresh_prefix (Label.Set.add exit_label prog_lbls) "_tmp_lbl" in
147  let tmp_universe = Label.Gen.new_universe fresh_tmp in
148  let glbls_addr = globals_addr p.LIN.vars in
149  let p =
150    { ASM.ppreamble = p.LIN.vars ;
151      ASM.pexit_label = exit_label ;
152      ASM.pcode =
153        translate_functs tmp_universe glbls_addr exit_label p.LIN.main
154          p.LIN.functs ;
155      ASM.phas_main = p.LIN.main <> None } in
156  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.