Changeset 818 for Deliverables/D2.2/8051/src/clight/clightCasts.ml
 Timestamp:
 May 19, 2011, 4:03:04 PM (9 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Deliverables/D2.2/8051/src/clight/clightCasts.ml
r740 r818 6 6 be polymorphic, but working only on homogene types. *) 7 7 8 9 let error_prefix = "Clight casts simplification" 10 let error = Error.global_error error_prefix 11 let error_float () = error "float not supported." 12 13 14 (* Int sizes *) 15 16 let int_of_intsize = function 17  Clight.I8 > 8 18  Clight.I16 > 16 19  Clight.I32 > 32 20 21 let intsize_of_int = function 22  i when i <= 8 > Clight.I8 23  i when i <= 16 > Clight.I16 24  _ > Clight.I32 25 26 let cmp_intsize cmp size1 size2 = 27 cmp (int_of_intsize size1) (int_of_intsize size2) 28 29 let max_intsize size1 size2 = 30 if (int_of_intsize size1) < (int_of_intsize size2) then size2 else size1 31 32 let intsize_union size1 size2 = 33 intsize_of_int ((int_of_intsize size1) + (int_of_intsize size2)) 34 35 let pow2 = MiscPottier.pow 2 36 37 let 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 48 let 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 65 let type_of_expr (Clight.Expr (_, t)) = t 66 67 let 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 77 let 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 84 let 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 120 and 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 124 and 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 130 and 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 8 183 let f_ctype ctype _ = ctype 9 184 10 (*11 let f_expr = ClightFold.expr_fill_subs12 13 let f_expr_descr e sub_ctypes_res sub_exprs_res =14 match e, sub_exprs_res with15  Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),16 Clight.Expr17 (Clight.Eunop18 (unop,19 Clight.Expr20 (Clight.Ecast21 (Clight.Tint (Clight.I32, _),22 (Clight.Expr (_, Clight.Tint (Clight.I8, signedness2)) as e)),23 _)),24 _) :: _ when signedness1 = signedness2 >25 Clight.Eunop (unop, e)26  Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),27 Clight.Expr28 (Clight.Ebinop29 (binop,30 Clight.Expr31 (Clight.Ecast32 (Clight.Tint (Clight.I32, _),33 (Clight.Expr (_,34 Clight.Tint (Clight.I8, signedness2)) as e1)),35 _),36 Clight.Expr37 (Clight.Ecast38 (Clight.Tint (Clight.I32, _),39 (Clight.Expr (_,40 Clight.Tint (Clight.I8, signedness3)) as e2)),41 _)),42 _) :: _ when signedness1 = signedness2 && signedness2 = signedness3 >43 Clight.Ebinop (binop, e1, e2)44  Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),45 Clight.Expr46 (Clight.Ebinop47 (binop,48 Clight.Expr49 (Clight.Ecast50 (Clight.Tint (Clight.I32, _),51 (Clight.Expr (_,52 Clight.Tint (Clight.I8, signedness2)) as e1)),53 _),54 Clight.Expr (Clight.Econst_int i, _)),55 _) :: _ when signedness1 = signedness2 >56 Clight.Ebinop (binop, e1,57 Clight.Expr (Clight.Econst_int i,58 Clight.Tint (Clight.I8, signedness1)))59  Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),60 Clight.Expr61 (Clight.Ebinop62 (binop,63 Clight.Expr (Clight.Econst_int i, _),64 Clight.Expr65 (Clight.Ecast66 (Clight.Tint (Clight.I32, _),67 (Clight.Expr (_,68 Clight.Tint (Clight.I8, signedness2)) as e1)),69 _)),sub_ctypes_res sub_exprs_res70 _) :: _ when signedness1 = signedness2 >71 Clight.Ebinop (binop,72 Clight.Expr (Clight.Econst_int i,73 Clight.Tint (Clight.I8, signedness1)),74 e1)75  _ > ClightFold.expr_descr_fill_subs e sub_ctypes_res sub_exprs_res76 *)77 78 let simplify_exp ctype_opt e = e (* TODO *)79 80 185 let f_expr e _ _ = e 81 186 … … 83 188 84 189 let f_statement stmt _ sub_stmts_res = 85 let sub_exprs = match stmt with 86  _ > assert false in 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 87 199 ClightFold.statement_fill_subs stmt sub_exprs sub_stmts_res 88 200 … … 97 209 (id, fundef') 98 210 99 let simplify p = p 100 (* (* TODO: below *) 211 let simplify p = 101 212 { p with Clight.prog_funct = List.map simplify_funct p.Clight.prog_funct } 102 *)
Note: See TracChangeset
for help on using the changeset viewer.