source: Deliverables/D2.2/8051-indexed-labels-branch/src/LIN/LINToASM.ml @ 1349

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