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

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

Bug fix in LINToASM (wrong conditional translation) in 8051 branch.

File size: 3.5 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 ; `NOP (* TODO: hack! Need to make the difference between cost labels and regular labels. *)]
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    [`WithLabel (`JNZ (`Label lbl))]
80  | LIN.St_return ->
81    [`RET]
82
83let translate_code glbls_addr code =
84  List.flatten (List.map (translate_statement glbls_addr) code)
85
86
87let translate_fun_def glbls_addr (id, def) = match def with
88  | LIN.F_int code -> (`Label id) :: (translate_code glbls_addr code)
89  | _ -> []
90
91let translate_functs glbls_addr exit_label main functs =
92  let preamble = match main with
93    | None -> []
94    | Some main -> [`Call main ; `Label exit_label ; `Jmp exit_label] in
95  preamble @
96    (List.flatten (List.map (translate_fun_def glbls_addr) functs))
97
98
99let globals_addr l =
100  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
101  fst (List.fold_left f ([], 0) l)
102
103
104(* Translating programs.
105
106   Global variables are associated an offset from the base of the external
107   memory. *)
108
109let translate p =
110  let prog_lbls = prog_labels p in
111  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
112  let glbls_addr = globals_addr p.LIN.vars in
113  let p =
114    { ASM.ppreamble = p.LIN.vars ;
115      ASM.pexit_label = exit_label ;
116      ASM.pcode =
117        translate_functs glbls_addr exit_label p.LIN.main p.LIN.functs ;
118      ASM.phas_main = p.LIN.main <> None } in
119  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.