Changeset 624


Ignore:
Timestamp:
Mar 2, 2011, 11:06:58 PM (9 years ago)
Author:
ayache
Message:

Bug fixs and signed division hack in D2.2.

Location:
Deliverables/D2.2/8051
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/myocamlbuild_config.ml

    r622 r624  
    1 let parser_lib = "/home/dpm/Projects/Cerco/Deliverables/D2.2/8051/lib"
     1let parser_lib = "/home/ayache/Downloads/Bol/Deliverables/D2.2/8051/lib"
  • Deliverables/D2.2/8051/src/LIN/LINToASM.ml

    r619 r624  
    8787
    8888let rec remove_following_cost_label lbl = function
    89   | [] -> assert false (* wrong labelling *)
     89  | [] -> (None, []) (* no labelling *)
    9090  | LIN.St_label lbl' :: LIN.St_cost cost_lbl :: code when lbl' = lbl ->
    91     (cost_lbl, LIN.St_label lbl' :: code)
     91    (Some cost_lbl, LIN.St_label lbl' :: code)
    9292  | stmt :: code ->
    9393    let (cost_lbl, code') = remove_following_cost_label lbl code in
     
    102102         as to not introduce an imprecision. *)
    103103      let (cost_lbl, code') = remove_following_cost_label lbl code in
    104       let tmp_lbl = Label.Gen.fresh tmp_universe in
    105       [`WithLabel (`JZ (`Label tmp_lbl)) ;
    106        `Cost cost_lbl ; `Jmp lbl ;
    107        `Label tmp_lbl] @
    108       (aux code')
     104      (match cost_lbl with
     105        | None -> aux code'
     106        | Some cost_lbl ->
     107          let tmp_lbl = Label.Gen.fresh tmp_universe in
     108          [`WithLabel (`JZ (`Label tmp_lbl)) ;
     109           `Cost cost_lbl ; `Jmp lbl ;
     110           `Label tmp_lbl] @
     111            (aux code'))
    109112    | stmt :: code -> (translate_statement glbls_addr stmt) @ (aux code) in
    110113  aux
  • Deliverables/D2.2/8051/src/RTL/RTLToERTL.ml

    r619 r624  
    422422    | ERTL.St_cost (cost_label, next_lbl) ->
    423423      let graph = Label.Map.add lbl (ERTL.St_skip next_lbl) def.ERTL.f_graph in
    424       (cost_label, { def with ERTL.f_graph = graph })
     424      (Some cost_label, { def with ERTL.f_graph = graph })
    425425    | ERTL.St_skip lbl | ERTL.St_comment (_, lbl) | ERTL.St_get_hdw (_, _, lbl)
    426426    | ERTL.St_set_hdw (_, _, lbl) | ERTL.St_hdw_to_hdw (_, _, lbl)
     
    435435      aux lbl
    436436    | ERTL.St_condacc _ | ERTL.St_return _ ->
    437       (* Should be impossible: the first cost label is found after some linear
    438          instructions. *)
    439       assert false in
     437      (* No cost label found (no labelling performed). Indeed, the first cost
     438         label must after some linear instructions. *)
     439      (None, def) in
    440440  aux def.ERTL.f_entry
    441441
    442442let move_first_cost_label_up_internal def =
    443443  let (cost_label, def) = find_and_remove_first_cost_label def in
    444   generate (ERTL.St_cost (cost_label, def.ERTL.f_entry)) def
     444  match cost_label with
     445    | None -> def
     446    | Some cost_label ->
     447      generate (ERTL.St_cost (cost_label, def.ERTL.f_entry)) def
    445448
    446449let move_first_cost_label_up (id, def) =
  • Deliverables/D2.2/8051/src/clight/clightAnnotator.ml

    r619 r624  
    166166      let e' = instrument_expr cost_mapping cost_incr e in
    167167      Clight.Efield (e', x)
    168   | Clight.Ecost (lbl, e) ->
     168  | Clight.Ecost (lbl, e) when CostLabel.Map.mem lbl cost_mapping ->
    169169      let e' = instrument_expr cost_mapping cost_incr e in
    170170      let incr = CostLabel.Map.find lbl cost_mapping in
    171       Clight.Ecall (cost_incr, const_int incr, e')
     171      if incr = 0 then let Clight.Expr (e'', _) = e' in e''
     172      else Clight.Ecall (cost_incr, const_int incr, e')
     173  | Clight.Ecost (_, e) ->
     174    let Clight.Expr (e', _) = instrument_expr cost_mapping cost_incr e in
     175    e'
    172176  | Clight.Ecall (x, e1, e2) -> assert false (* Should not happen. *)
    173177
     
    221225      let s' = instrument_body cost_mapping cost_incr s in
    222226      Clight.Slabel (lbl, s')
    223   | Clight.Scost (lbl, s) ->
     227  | Clight.Scost (lbl, s) when CostLabel.Map.mem lbl cost_mapping ->
    224228      let s' = instrument_body cost_mapping cost_incr s in
    225229      let incr = CostLabel.Map.find lbl cost_mapping in
     
    230234        let args = [Clight.Expr (Clight.Econst_int incr, int_typ)] in
    231235        Clight.Ssequence (Clight.Scall (None, f, args), s')
     236  | Clight.Scost (_, s) ->
     237      instrument_body cost_mapping cost_incr s
    232238and instrument_ls cost_mapping cost_incr = function
    233239  | Clight.LSdefault s ->
  • Deliverables/D2.2/8051/src/clight/clightCasts.ml

    r619 r624  
    55    will be transformed into [x + y]. *)
    66
    7 let simplify p = assert false (* TODO *)
     7let f_ctype ctype _ = ctype
     8
     9let f_expr = ClightFold.expr_fill_subs
     10
     11let f_expr_descr e sub_ctypes_res sub_exprs_res =
     12  match e, sub_exprs_res with
     13    | Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
     14      Clight.Expr
     15        (Clight.Eunop
     16           (unop,
     17            Clight.Expr
     18              (Clight.Ecast
     19                 (Clight.Tint (Clight.I32, _),
     20                  (Clight.Expr (_, Clight.Tint (Clight.I8, signedness2)) as e)),
     21               _)),
     22         _) :: _ when signedness1 = signedness2 ->
     23      Clight.Eunop (unop, e)
     24    | Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
     25      Clight.Expr
     26        (Clight.Ebinop
     27           (binop,
     28            Clight.Expr
     29              (Clight.Ecast
     30                 (Clight.Tint (Clight.I32, _),
     31                  (Clight.Expr (_,
     32                                Clight.Tint (Clight.I8, signedness2)) as e1)),
     33               _),
     34            Clight.Expr
     35              (Clight.Ecast
     36                 (Clight.Tint (Clight.I32, _),
     37                  (Clight.Expr (_,
     38                                Clight.Tint (Clight.I8, signedness3)) as e2)),
     39               _)),
     40         _) :: _ when signedness1 = signedness2 && signedness2 = signedness3 ->
     41      Clight.Ebinop (binop, e1, e2)
     42    | Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
     43      Clight.Expr
     44        (Clight.Ebinop
     45           (binop,
     46            Clight.Expr
     47              (Clight.Ecast
     48                 (Clight.Tint (Clight.I32, _),
     49                  (Clight.Expr (_,
     50                                Clight.Tint (Clight.I8, signedness2)) as e1)),
     51               _),
     52            Clight.Expr (Clight.Econst_int i, _)),
     53         _) :: _ when signedness1 = signedness2 ->
     54      Clight.Ebinop (binop, e1,
     55                     Clight.Expr (Clight.Econst_int i,
     56                                  Clight.Tint (Clight.I8, signedness1)))
     57    | Clight.Ecast (Clight.Tint (Clight.I8, signedness1), _),
     58      Clight.Expr
     59        (Clight.Ebinop
     60           (binop,
     61            Clight.Expr (Clight.Econst_int i, _),
     62            Clight.Expr
     63              (Clight.Ecast
     64                 (Clight.Tint (Clight.I32, _),
     65                  (Clight.Expr (_,
     66                                Clight.Tint (Clight.I8, signedness2)) as e1)),
     67               _)),
     68         _) :: _ when signedness1 = signedness2 ->
     69      Clight.Ebinop (binop,
     70                     Clight.Expr (Clight.Econst_int i,
     71                                  Clight.Tint (Clight.I8, signedness1)),
     72                     e1)
     73    | _ -> ClightFold.expr_descr_fill_subs e sub_ctypes_res sub_exprs_res
     74
     75let f_statement = ClightFold.statement_fill_subs
     76
     77let simplify_stmt = ClightFold.statement f_ctype f_expr f_expr_descr f_statement
     78
     79let simplify_funct (id, fundef) =
     80  let fundef' = match fundef with
     81    | Clight.Internal cfun ->
     82      Clight.Internal
     83        { cfun with Clight.fn_body = simplify_stmt cfun.Clight.fn_body }
     84    | _ -> fundef in
     85  (id, fundef')
     86
     87let simplify p =
     88  { p with Clight.prog_funct = List.map simplify_funct p.Clight.prog_funct }
  • Deliverables/D2.2/8051/src/clight/clightFold.ml

    r619 r624  
    3333
    3434let expr_subs = function
    35   | Clight.Expr (expr_descr, ctype) -> ([expr_descr], [ctype])
     35  | Clight.Expr (expr_descr, ctype) -> ([ctype], [expr_descr])
    3636
    3737let expr_descr_subs = function
     
    4747  | Clight.Ecall (_, e1, e2) -> ([], [e1 ; e2])
    4848
    49 let expr_fill_subs e sub_expr_descrs sub_ctypes =
    50   match e, sub_expr_descrs, sub_ctypes with
    51   | Clight.Expr _, expr_descr :: _, ctype :: _ ->
     49let expr_fill_subs e sub_ctypes sub_expr_descrs =
     50  match e, sub_ctypes, sub_expr_descrs with
     51  | Clight.Expr _, ctype :: _, expr_descr :: _ ->
    5252    Clight.Expr (expr_descr, ctype)
    5353  | _ -> assert false (* wrong arguments, do not use on these values *)
     
    6565  | Clight.Econdition _, _, e1 :: e2 :: e3 :: _ ->
    6666    Clight.Econdition (e1, e2, e3)
     67  | Clight.Eandbool (_, _), _, e1 :: e2 :: _ ->
     68    Clight.Eandbool (e1, e2)
     69  | Clight.Eorbool (_, _), _, e1 :: e2 :: _ ->
     70    Clight.Eorbool (e1, e2)
     71  | Clight.Esizeof _, ctype :: _, _ -> Clight.Esizeof ctype
    6772  | Clight.Efield (_, field_name), _, e :: _ -> Clight.Efield (e, field_name)
    68   | _ -> assert false (* TODO *)
    69 (*
     73  | Clight.Ecost (lbl, _), _, e :: _ -> Clight.Ecost (lbl, e)
     74  | Clight.Ecall (id, _, _), _, e1 :: e2 :: _ -> Clight.Ecall (id, e1, e2)
    7075  | _ -> assert false (* wrong arguments, do not use on these values *)
    71   | Clight.Ebinop (_, e1, e2) | Clight.Eandbool (e1, e2)
    72   | Clight.Eorbool (e1, e2) -> ([], [e1 ; e2])
    73   | Clight.Ecast (ctype, e) -> ([ctype], [e])
    74   | Clight.Econdition (e1, e2, e3) -> ([], [e1 ; e2 ; e3])
    75   | Clight.Esizeof ctype -> ([ctype], [])
    76   | Clight.Ecost (_, e) -> ([], [e])
    77   | Clight.Ecall (_, e1, e2) -> ([], [e1 ; e2])
    78 *)
    7976
    80 let rec expr f_expr_descr f_ctype f_expr e =
    81   let (sub_expr_descrs, sub_ctypes) = expr_subs e in
     77let rec expr f_ctype f_expr f_expr_descr e =
     78  let (sub_ctypes, sub_expr_descrs) = expr_subs e in
    8279  let sub_expr_descrs_res =
    8380    List.map (expr_descr f_ctype f_expr f_expr_descr) sub_expr_descrs in
    8481  let sub_ctypes_res = List.map (ctype f_ctype) sub_ctypes in
    85   f_expr e sub_expr_descrs_res sub_ctypes_res
     82  f_expr e sub_ctypes_res sub_expr_descrs_res
    8683
    8784and expr_descr f_ctype f_expr f_expr_descr e =
    8885  let (sub_ctypes, sub_exprs) = expr_descr_subs e in
    8986  let sub_exprs_res =
    90     List.map (expr f_expr_descr f_ctype f_expr) sub_exprs in
     87    List.map (expr f_ctype f_expr f_expr_descr) sub_exprs in
    9188  let sub_ctypes_res = List.map (ctype f_ctype) sub_ctypes in
    9289  f_expr_descr e sub_ctypes_res sub_exprs_res
     90
     91
     92let rec labeled_statements_subs = function
     93  | Clight.LSdefault stmt -> [stmt]
     94  | Clight.LScase (_, stmt, lbl_stmts) ->
     95    stmt :: (labeled_statements_subs lbl_stmts)
     96
     97let statement_subs = function
     98  | Clight.Sskip | Clight.Sbreak | Clight.Scontinue | Clight.Sreturn None
     99  | Clight.Sgoto _ -> ([], [])
     100  | Clight.Sassign (e1, e2) -> ([e1 ; e2], [])
     101  | Clight.Scall (None, e, args) -> (e :: args, [])
     102  | Clight.Scall (Some e1, e2, args) -> (e1 :: e2 :: args, [])
     103  | Clight.Ssequence (stmt1, stmt2) -> ([], [stmt1 ; stmt2])
     104  | Clight.Sifthenelse (e, stmt1, stmt2) -> ([e], [stmt1 ; stmt2])
     105  | Clight.Swhile (e, stmt) | Clight.Sdowhile (e, stmt) -> ([e], [stmt])
     106  | Clight.Sfor (stmt1, e, stmt2, stmt3) -> ([e], [stmt1 ; stmt2 ; stmt3])
     107  | Clight.Sreturn (Some e) -> ([e], [])
     108  | Clight.Sswitch (e, lbl_stmts) -> ([e], labeled_statements_subs lbl_stmts)
     109  | Clight.Slabel (_, stmt) | Clight.Scost (_, stmt) -> ([], [stmt])
     110
     111let rec labeled_statements_fill_subs lbl_stmts sub_statements =
     112  match lbl_stmts, sub_statements with
     113    | Clight.LSdefault _, stmt :: _ -> Clight.LSdefault stmt
     114    | Clight.LScase (i, _, lbl_stmts), stmt :: sub_statements ->
     115      Clight.LScase (i, stmt,
     116                     labeled_statements_fill_subs lbl_stmts sub_statements)
     117    | _ -> assert false (* wrong arguments, do not use on these values *)
     118
     119let statement_fill_subs statement sub_exprs sub_statements =
     120  match statement, sub_exprs, sub_statements with
     121    | Clight.Sskip, _, _ | Clight.Sbreak, _, _ | Clight.Scontinue, _, _
     122    | Clight.Sreturn None, _, _ | Clight.Sgoto _, _, _ -> statement
     123    | Clight.Sassign _, e1 :: e2 :: _, _ -> Clight.Sassign (e1, e2)
     124    | Clight.Scall (None, _, _), e :: args, _ ->
     125      Clight.Scall (None, e, args)
     126    | Clight.Scall (Some _, _, _), e1 :: e2 :: args, _ ->
     127      Clight.Scall (Some e1, e2, args)
     128    | Clight.Ssequence _, _, stmt1 :: stmt2 :: _ ->
     129      Clight.Ssequence (stmt1, stmt2)
     130    | Clight.Sifthenelse _, e :: _, stmt1 :: stmt2 :: _ ->
     131      Clight.Sifthenelse (e, stmt1, stmt2)
     132    | Clight.Swhile _, e :: _, stmt :: _ ->
     133      Clight.Swhile (e, stmt)
     134    | Clight.Sdowhile _, e :: _, stmt :: _ ->
     135      Clight.Sdowhile (e, stmt)
     136    | Clight.Sfor _, e :: _, stmt1 :: stmt2 :: stmt3 :: _ ->
     137      Clight.Sfor (stmt1, e, stmt2, stmt3)
     138    | Clight.Sreturn (Some _), e :: _, _ -> Clight.Sreturn (Some e)
     139    | Clight.Sswitch (_, lbl_stmts), e :: _, _ ->
     140      Clight.Sswitch (e, labeled_statements_fill_subs lbl_stmts sub_statements)
     141    | Clight.Slabel (lbl, _), _, stmt :: _ -> Clight.Slabel (lbl, stmt)
     142    | Clight.Scost (lbl, _), _, stmt :: _ -> Clight.Scost (lbl, stmt)
     143    | _ -> assert false (* wrong arguments, do not use on these values *)
     144
     145let rec statement f_ctype f_expr f_expr_descr f_statement stmt =
     146  let (sub_exprs, sub_stmts) = statement_subs stmt in
     147  let sub_exprs_res = List.map (expr f_ctype f_expr f_expr_descr) sub_exprs in
     148  let sub_stmts_res =
     149    List.map (statement f_ctype f_expr f_expr_descr f_statement) sub_stmts in
     150  f_statement stmt sub_exprs_res sub_stmts_res
  • Deliverables/D2.2/8051/src/clight/clightInterpret.ml

    r619 r624  
    296296
    297297let eval_div = function
     298(*
    298299  | ((v1,t1),(v2,t2)) when t1=t2 && is_int_type t1 -> Value.div v1 v2
     300*)
     301  (* TODO: temporary hack! *)
     302  | ((v1,t1),(v2,t2)) when t1=t2 && is_int_type t1 -> Value.divu v1 v2
    299303  | ((v1,t1),(v2,t2)) when t1=t2 && is_float_type t1 ->
    300304      assert false (*Not supported*)
  • Deliverables/D2.2/8051/src/clight/clightToCminor.ml

    r619 r624  
    129129
    130130let translate_div e1 e2 = function
     131(*
    131132  | (Tint(_,Signed),Tint(_,Signed))     -> Op2 (Op_div,e1,e2)
     133*)
     134  (* TODO: temporary hack! *)
     135  | (Tint(_,Signed),Tint(_,Signed))     -> Op2 (Op_divu,e1,e2)
    132136  | (Tint(_,Unsigned),Tint(_,Unsigned)) -> Op2 (Op_divu,e1,e2)
    133137  | (Tfloat _,Tfloat _)                 -> assert false (*Not supported*)
     
    522526
    523527let translate p =
    524   (* TODO: Clight32ToClight8 transformation *)
     528  (* TODO: Clight32 to Clight8 transformation *)
    525529(*
    526530  let p = Clight32ToClight8.translate p in
Note: See TracChangeset for help on using the changeset viewer.