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

Last change on this file since 1291 was 1291, checked in by tranquil, 9 years ago

Started branch of untrusted compiler with indexed labels

  • added indexing structure to CostLabel?
  • propagated changes to other modules
  • added indexing as parameter to labelling
  • loop indexes not implemented yet, so behaviour is still the same
File size: 4.2 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_int (r, i) ->
54    [`MOV (`U3 (I8051.reg_addr r, data_of_int i))]
55  | LIN.St_pop ->
56    [`POP acc_addr]
57  | LIN.St_push ->
58    [`PUSH acc_addr]
59  | LIN.St_addr x when List.mem_assoc x glbls_addr ->
60    [`MOV (`U4 (`DPTR, data16_of_int (List.assoc x glbls_addr)))]
61  | LIN.St_addr x ->
62    error ("unknown global " ^ x ^ ".")
63  | LIN.St_from_acc r ->
64    [`MOV (`U3 (I8051.reg_addr r, `A))]
65  | LIN.St_to_acc r ->
66    [`MOV (`U1 (`A, I8051.reg_addr r))]
67  | LIN.St_opaccs I8051.Mul ->
68    [`MUL (`A, `B)]
69  | LIN.St_opaccs I8051.DivuModu ->
70    [`DIV (`A, `B)]
71  | LIN.St_op1 I8051.Cmpl ->
72    [`CPL `A]
73  | LIN.St_op1 I8051.Inc ->
74    [`INC `A]
75  | LIN.St_op2 (I8051.Add, r) ->
76    [`ADD (`A, I8051.reg_addr r)]
77  | LIN.St_op2 (I8051.Addc, r) ->
78    [`ADDC (`A, I8051.reg_addr r)]
79  | LIN.St_op2 (I8051.Sub, r) ->
80    [`SUBB (`A, I8051.reg_addr r)]
81  | LIN.St_op2 (I8051.And, r) ->
82    [`ANL (`U1 (`A, I8051.reg_addr r))]
83  | LIN.St_op2 (I8051.Or, r) ->
84    [`ORL (`U1 (`A, I8051.reg_addr r))]
85  | LIN.St_op2 (I8051.Xor, r) ->
86    [`XRL (`U1 (`A, I8051.reg_addr r))]
87  | LIN.St_clear_carry ->
88    [`CLR `C]
89  | LIN.St_set_carry ->
90    [`SETB `C]
91  | LIN.St_load ->
92    [`MOVX (`U1 (`A, `EXT_IND_DPTR))]
93  | LIN.St_store ->
94    [`MOVX (`U2 (`EXT_IND_DPTR, `A))]
95  | LIN.St_call_id f ->
96    [`Call f]
97  | LIN.St_condacc lbl ->
98    [`WithLabel (`JNZ (`Label lbl))]
99  | LIN.St_return ->
100    [`RET]
101
102let translate_code glbls_addr code =
103  List.flatten (List.map (translate_statement glbls_addr) code)
104
105
106let translate_fun_def glbls_addr (id, def) = match def with
107  | LIN.F_int code -> (`Label id) :: (translate_code glbls_addr code)
108  | LIN.F_ext ext ->
109    error ("potential call to unsupported external " ^ ext.AST.ef_tag ^ ".")
110
111let translate_functs glbls_addr exit_label main functs =
112  let preamble = match main with
113    | None -> []
114    | Some main ->
115      [`MOV (`U3 (`DIRECT (byte_of_int I8051.isp_addr),
116                  data_of_int I8051.isp_init)) ;
117       `Call main ;
118       `Label exit_label ; `Jmp exit_label] in
119  preamble @
120  (List.flatten (List.map (translate_fun_def glbls_addr) functs))
121
122
123let globals_addr l =
124  let f (res, offset) (x, size) = ((x, offset) :: res, offset + size) in
125  fst (List.fold_left f ([], 0) l)
126
127
128(* Translating programs.
129
130   Global variables are associated an offset from the base of the external
131   memory. *)
132
133let translate p =
134  let prog_lbls = prog_labels p in
135  let exit_label = Label.Gen.fresh_prefix prog_lbls "_exit" in
136  let glbls_addr = globals_addr p.LIN.vars in
137  let p =
138    { ASM.ppreamble = p.LIN.vars ;
139      ASM.pexit_label = exit_label ;
140      ASM.pcode =
141        translate_functs glbls_addr exit_label p.LIN.main p.LIN.functs ;
142      ASM.phas_main = p.LIN.main <> None } in
143  ASMInterpret.assembly p
Note: See TracBrowser for help on using the repository browser.