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

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

Update of D2.2 from Paris.

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    (`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(* Translating programs.
132
133   A fresh universe is create, in order to create an exit label and fresh labels
134   for the expansion of conditional instructions (see the .mli).
135
136   Global variables are associated an offset from the base of the external
137   memory. *)
138
139let translate p =
140  let prog_lbls = prog_labels p in
141  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
142  let fresh_tmp =
143    Label.Gen.fresh_prefix (Label.Set.add exit_label prog_lbls) "_tmp_lbl" in
144  let tmp_universe = Label.Gen.new_universe fresh_tmp in
145  let glbls_addr = globals_addr p.LIN.vars in
146  let p =
147    { ASM.ppreamble = p.LIN.vars ;
148      ASM.pexit_label = exit_label ;
149      ASM.pcode =
150        translate_functs tmp_universe glbls_addr exit_label p.LIN.main
151          p.LIN.functs ;
152      ASM.phas_main = p.LIN.main <> None } in
153  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.