Ignore:
Timestamp:
May 19, 2011, 4:03:04 PM (9 years ago)
Author:
ayache
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/clight/clightCasts.ml

    r740 r818  
    66    be polymorphic, but working only on homogene types. *)
    77
     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
    8183let f_ctype ctype _ = ctype
    9184
    10 (*
    11 let f_expr = ClightFold.expr_fill_subs
    12 
    13 let f_expr_descr e sub_ctypes_res sub_exprs_res =
    14   match e, sub_exprs_res with
    15     | Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
    16       Clight.Expr
    17         (Clight.Eunop
    18            (unop,
    19             Clight.Expr
    20               (Clight.Ecast
    21                  (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.Expr
    28         (Clight.Ebinop
    29            (binop,
    30             Clight.Expr
    31               (Clight.Ecast
    32                  (Clight.Tint (Clight.I32, _),
    33                   (Clight.Expr (_,
    34                                 Clight.Tint (Clight.I8, signedness2)) as e1)),
    35                _),
    36             Clight.Expr
    37               (Clight.Ecast
    38                  (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.Expr
    46         (Clight.Ebinop
    47            (binop,
    48             Clight.Expr
    49               (Clight.Ecast
    50                  (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.Expr
    61         (Clight.Ebinop
    62            (binop,
    63             Clight.Expr (Clight.Econst_int i, _),
    64             Clight.Expr
    65               (Clight.Ecast
    66                  (Clight.Tint (Clight.I32, _),
    67                   (Clight.Expr (_,
    68                                 Clight.Tint (Clight.I8, signedness2)) as e1)),
    69                _)),sub_ctypes_res sub_exprs_res
    70          _) :: _ 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_res
    76 *)
    77 
    78 let simplify_exp ctype_opt e = e (* TODO *)
    79 
    80185let f_expr e _ _ = e
    81186
     
    83188
    84189let 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
    87199  ClightFold.statement_fill_subs stmt sub_exprs sub_stmts_res
    88200
     
    97209  (id, fundef')
    98210
    99 let simplify p = p
    100 (* (* TODO: below *)
     211let simplify p =
    101212  { p with Clight.prog_funct = List.map simplify_funct p.Clight.prog_funct }
    102 *)
Note: See TracChangeset for help on using the changeset viewer.