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

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

32 and 16 bits operations support in D2.2/8051

File size: 4.1 KB
Line 
1
2(** This module translates a [LIN] program into a [ASM] program. *)
3
4
5let error_prefix = "LIN to ASM"
6let error s = Error.global_error error_prefix s
7
8
9(* Fetch the labels found in a LIN program. *)
10
11let statement_labels = function
12  | LIN.St_goto lbl
13  | LIN.St_label lbl
14  | LIN.St_cost lbl
15  | LIN.St_condacc lbl -> Label.Set.singleton lbl
16  | _ -> Label.Set.empty
17
18let funct_labels (_, fun_def) = match fun_def with
19  | LIN.F_int stmts ->
20    let f labels stmt = Label.Set.union labels (statement_labels stmt) in
21    List.fold_left f Label.Set.empty stmts
22  | _ -> Label.Set.empty
23
24let prog_labels p =
25  let f labels funct = Label.Set.union labels (funct_labels funct) in
26  List.fold_left f Label.Set.empty p.LIN.functs
27
28
29let size_of_vect_size = function
30  | `Four -> 4
31  | `Seven -> 7
32  | `Eight -> 8
33  | `Eleven -> 11
34  | `Sixteen -> 16
35
36let vect_of_int i size =
37  let i' =
38    if i < 0 then (MiscPottier.pow 2 (size_of_vect_size size)) + i else i in
39  BitVectors.vect_of_int i' size
40
41let byte_of_int i = vect_of_int i `Eight
42let data_of_int i = `DATA (byte_of_int i)
43let data16_of_int i = `DATA16 (vect_of_int i `Sixteen)
44let acc_addr = I8051.reg_addr I8051.a
45
46
47let translate_statement glbls_addr = function
48  | LIN.St_goto lbl -> [`Jmp lbl]
49  | LIN.St_label lbl -> [`Label lbl]
50  | LIN.St_comment _ -> []
51  | LIN.St_cost lbl -> [`Cost lbl ; `NOP (* TODO: hack! Need to make the difference between cost labels and regular labels. *)]
52  | LIN.St_int (r, i) ->
53    [`MOV (`U3 (I8051.reg_addr r, data_of_int i))]
54  | LIN.St_pop ->
55    [`POP acc_addr]
56  | LIN.St_push ->
57    [`PUSH acc_addr]
58  | LIN.St_addr x when List.mem_assoc x glbls_addr ->
59    [`MOV (`U4 (`DPTR, data16_of_int (List.assoc x glbls_addr)))]
60  | LIN.St_addr x ->
61    error ("unknown global " ^ x ^ ".")
62  | LIN.St_from_acc r ->
63    [`MOV (`U3 (I8051.reg_addr r, `A))]
64  | LIN.St_to_acc r ->
65    [`MOV (`U1 (`A, I8051.reg_addr r))]
66  | LIN.St_opaccs I8051.Mul ->
67    [`MUL (`A, `B)]
68  | LIN.St_opaccs I8051.DivuModu ->
69    [`DIV (`A, `B)]
70  | LIN.St_op1 I8051.Cmpl ->
71    [`CPL `A]
72  | LIN.St_op1 I8051.Inc ->
73    [`INC `A]
74  | LIN.St_op2 (I8051.Add, r) ->
75    [`ADD (`A, I8051.reg_addr r)]
76  | LIN.St_op2 (I8051.Addc, r) ->
77    [`ADDC (`A, I8051.reg_addr r)]
78  | LIN.St_op2 (I8051.Sub, r) ->
79    [`SUBB (`A, I8051.reg_addr r)]
80  | LIN.St_op2 (I8051.And, r) ->
81    [`ANL (`U1 (`A, I8051.reg_addr r))]
82  | LIN.St_op2 (I8051.Or, r) ->
83    [`ORL (`U1 (`A, I8051.reg_addr r))]
84  | LIN.St_op2 (I8051.Xor, r) ->
85    [`XRL (`U1 (`A, I8051.reg_addr r))]
86  | LIN.St_clear_carry ->
87    [`CLR `C]
88  | LIN.St_set_carry ->
89    [`SETB `C]
90  | LIN.St_load ->
91    [`MOVX (`U1 (`A, `EXT_IND_DPTR))]
92  | LIN.St_store ->
93    [`MOVX (`U2 (`EXT_IND_DPTR, `A))]
94  | LIN.St_call_id f ->
95    [`Call f]
96  | LIN.St_condacc lbl ->
97    [`WithLabel (`JNZ (`Label lbl))]
98  | LIN.St_return ->
99    [`RET]
100
101let translate_code glbls_addr code =
102  List.flatten (List.map (translate_statement glbls_addr) code)
103
104
105let translate_fun_def glbls_addr (id, def) = match def with
106  | LIN.F_int code -> (`Label id) :: (translate_code glbls_addr code)
107  | LIN.F_ext ext ->
108    error ("potential call to unsupported external " ^ ext.AST.ef_tag ^ ".")
109
110let translate_functs glbls_addr exit_label main functs =
111  let preamble = match main with
112    | None -> []
113    | Some main ->
114      [`MOV (`U3 (`DIRECT (byte_of_int I8051.isp_addr),
115                  data_of_int I8051.isp_init)) ;
116       `Call main ;
117       `Label exit_label ; `Jmp exit_label] in
118  preamble @
119  (List.flatten (List.map (translate_fun_def glbls_addr) functs))
120
121
122let globals_addr l =
123  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
124  fst (List.fold_left f ([], 0) l)
125
126
127(* Translating programs.
128
129   Global variables are associated an offset from the base of the external
130   memory. *)
131
132let translate p =
133  let prog_lbls = prog_labels p in
134  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
135  let glbls_addr = globals_addr p.LIN.vars in
136  let p =
137    { ASM.ppreamble = p.LIN.vars ;
138      ASM.pexit_label = exit_label ;
139      ASM.pcode =
140        translate_functs glbls_addr exit_label p.LIN.main p.LIN.functs ;
141      ASM.phas_main = p.LIN.main <> None } in
142  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.