source: Deliverables/D2.2/8051/src/clight/clightCasts.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: 6.5 KB
Line 
1
2(** [simplify p] removes unnecessary casts in the Clight program [p].
3
4    Example: [(char) ((int)x + (int)y)] where [x] and [y] are of type [char]
5    will be transformed into [x + y]. Primitive operations are thus supposed to
6    be polymorphic, but working only on homogene types. *)
7
8
9let error_prefix = "Clight casts simplification"
10let error = Error.global_error error_prefix
11let error_float () = error "float not supported."
12
13
14(* Int sizes *)
15
16let int_of_intsize = function
17  | Clight.I8 -> 8
18  | Clight.I16 -> 16
19  | Clight.I32 -> 32
20
21let intsize_of_int = function
22  | i when i <= 8 -> Clight.I8
23  | i when i <= 16 -> Clight.I16
24  | _ -> Clight.I32
25
26let cmp_intsize cmp size1 size2 =
27  cmp (int_of_intsize size1) (int_of_intsize size2)
28
29let max_intsize size1 size2 =
30  if (int_of_intsize size1) < (int_of_intsize size2) then size2 else size1
31
32let intsize_union size1 size2 =
33  intsize_of_int ((int_of_intsize size1) + (int_of_intsize size2))
34
35let pow2 = MiscPottier.pow 2
36
37let belongs_to_int_type size sign i = match size, sign with
38  | Clight.I8, AST.Unsigned -> 0 <= i && i <= (pow2 8) - 1
39  | Clight.I8, AST.Signed -> -(pow2 7) <= i && i <= (pow2 7) - 1
40  | Clight.I16, AST.Unsigned -> 0 <= i && i <= (pow2 16) - 1
41  | Clight.I16, AST.Signed -> -(pow2 15) <= i && i <= (pow2 15) - 1
42  | Clight.I32, AST.Unsigned -> 0 <= i
43  | Clight.I32, AST.Signed ->
44    let pow2_30 = pow2 30 in
45    (-(pow2_30 + pow2_30)) <= i &&
46    i <= ((pow2_30 - 1) + pow2_30) (* = 2^31 - 1 *)
47
48let smallest_int_type i =
49  let (size, sign) = match i with
50  | _ when belongs_to_int_type Clight.I8 AST.Signed i ->
51    (Clight.I8, AST.Signed)
52  | _ when belongs_to_int_type Clight.I8 AST.Unsigned i ->
53    (Clight.I8, AST.Unsigned)
54  | _ when belongs_to_int_type Clight.I16 AST.Signed i ->
55    (Clight.I16, AST.Signed)
56  | _ when belongs_to_int_type Clight.I16 AST.Unsigned i ->
57    (Clight.I16, AST.Unsigned)
58  | _ when belongs_to_int_type Clight.I32 AST.Unsigned i ->
59    (Clight.I32, AST.Unsigned)
60  | _ ->
61    (Clight.I32, AST.Signed) in
62  Clight.Tint (size, sign)
63
64
65let type_of_expr (Clight.Expr (_, t)) = t
66
67let int_type_union t1 t2 =
68  let (size, sign) = match t1, t2 with
69    | Clight.Tint (size1, sign1), Clight.Tint (size2, sign2)
70      when sign1 = sign2 -> (max_intsize size1 size2, sign1)
71    | Clight.Tint (size1, sign1), Clight.Tint (size2, sign2) ->
72      (intsize_union size1 size2, AST.Signed)
73    | _ -> assert false (* only use on int types *)
74  in
75  Clight.Tint (size, sign)
76
77let cast_if_needed t (Clight.Expr (ed, t') as e) = match t, ed with
78  | _ when t = t' -> e
79  | Clight.Tint (size, sign), Clight.Econst_int i
80    when belongs_to_int_type size sign i ->
81    Clight.Expr (Clight.Econst_int i, t)
82  | _ -> Clight.Expr (Clight.Ecast (t, e), t)
83
84let rec simplify_binop t binop
85    (Clight.Expr (ed1, t1) as e1)
86    (Clight.Expr (ed2, t2) as e2) =
87  let e1' = simplify_expr e1 in
88  let e2' = simplify_expr e2 in
89  let make_int i t = Clight.Expr (Clight.Econst_int i, t) in
90
91  let (e1', e2', t') = match t1, t2, ed1, ed2 with
92
93    | Clight.Tint _, Clight.Tint _,
94      Clight.Econst_int i1, Clight.Econst_int i2 ->
95      let t1' = smallest_int_type i1 in
96      let t2' = smallest_int_type i2 in
97      let t' = int_type_union t1' t2' in
98      (make_int i1 t', make_int i2 t', t')
99
100    | Clight.Tint _, Clight.Tint _, _, Clight.Econst_int i2 ->
101      let t' = type_of_expr e1' in
102      let e2' = make_int i2 t' in
103      (e1', e2', t')
104
105    | Clight.Tint _, Clight.Tint _, Clight.Econst_int i1, _ ->
106      let t' = type_of_expr e2' in
107      let e1' = make_int i1 t' in
108      (e1', e2', t')
109
110    | Clight.Tint _, Clight.Tint _, _, _ ->
111      let t' = int_type_union (type_of_expr e1') (type_of_expr e2') in
112      (cast_if_needed t' e1', cast_if_needed t' e2', t')
113
114    | _ -> (e1', e2', t)
115
116  in
117
118  Clight.Expr (Clight.Ebinop (binop, e1', e2'), t')
119
120and simplify_bool_op f_bool t e1 e2 =
121  let (e1', e2', t') = simplify_and_same_type t e1 e2 in
122  Clight.Expr (f_bool e1' e2', t')
123
124and simplify_and_same_type t e1 e2 =
125  let e1' = simplify_expr e1 in
126  let e2' = simplify_expr e2 in
127  if type_of_expr e1' = type_of_expr e2' then (e1', e2', type_of_expr e1')
128  else (cast_if_needed t e1', cast_if_needed t e2', t)
129
130and simplify_expr (Clight.Expr (ed, t) as e) = match ed with
131
132  | Clight.Econst_int i ->
133    let t' = smallest_int_type i in
134    Clight.Expr (ed, t')
135
136  | Clight.Evar _ -> e
137
138  | Clight.Esizeof _ -> Clight.Expr (ed, Clight.Tint (Clight.I8, AST.Unsigned))
139
140  | Clight.Econst_float _ -> error_float ()
141
142  | Clight.Ederef e ->
143    let e' = simplify_expr e in
144    Clight.Expr (Clight.Ederef e', t)
145
146  | Clight.Eaddrof e ->
147    let e' = simplify_expr e in
148    Clight.Expr (Clight.Eaddrof e', t)
149
150  | Clight.Eunop (unop, e) ->
151    let e' = simplify_expr e in
152    Clight.Expr (Clight.Eunop (unop, e'), type_of_expr e')
153
154  | Clight.Ebinop (binop, e1, e2) ->
155    simplify_binop t binop e1 e2
156
157  | Clight.Ecast (Clight.Tint (Clight.I32, AST.Signed), e) -> simplify_expr e
158
159  | Clight.Ecast (t', e) ->
160    Clight.Expr (Clight.Ecast (t', simplify_expr e), t')
161
162  | Clight.Econdition (e1, e2, e3) ->
163    let e1' = simplify_expr e1 in
164    let (e2', e3', t') = simplify_and_same_type t e2 e3 in
165    Clight.Expr (Clight.Econdition (e1', e2', e3'), t')
166
167  | Clight.Eandbool (e1, e2) ->
168    simplify_bool_op (fun e1' e2' -> Clight.Eandbool (e1', e2')) t e1 e2
169
170  | Clight.Eorbool (e1, e2) ->
171    simplify_bool_op (fun e1' e2' -> Clight.Eorbool (e1', e2')) t e1 e2
172
173  | Clight.Efield (e, field) ->
174    Clight.Expr (Clight.Efield (simplify_expr e, field), t)
175
176  | Clight.Ecost (lbl, e) ->
177    Clight.Expr (Clight.Ecost (lbl, simplify_expr e), t)
178
179  | Clight.Ecall (id, e1, e2) ->
180    assert false (* should be impossible *)
181
182
183let f_ctype ctype _ = ctype
184
185let f_expr e _ _ = e
186
187let f_expr_descr e _ _ =  e
188
189let f_statement stmt _ sub_stmts_res =
190  let f_expr b e =
191    let e' = simplify_expr e in
192    if b then cast_if_needed (type_of_expr e) e'
193    else e' in
194  let f_exprs b = List.map (f_expr b) in
195  let f_sub_exprs = match stmt with
196    | Clight.Sassign _ | Clight.Scall _ | Clight.Sreturn _ -> f_exprs true
197    | _ -> f_exprs false in
198  let sub_exprs = f_sub_exprs (ClightFold.statement_sub_exprs stmt) in
199  ClightFold.statement_fill_subs stmt sub_exprs sub_stmts_res
200
201let simplify_stmt = ClightFold.statement f_ctype f_expr f_expr_descr f_statement
202
203let simplify_funct (id, fundef) =
204  let fundef' = match fundef with
205    | Clight.Internal cfun ->
206      Clight.Internal
207        { cfun with Clight.fn_body = simplify_stmt cfun.Clight.fn_body }
208    | _ -> fundef in
209  (id, fundef')
210
211let simplify p =
212  { p with Clight.prog_funct = List.map simplify_funct p.Clight.prog_funct }
Note: See TracBrowser for help on using the repository browser.