Ignore:
Timestamp:
Nov 28, 2011, 3:13:14 PM (9 years ago)
Author:
tranquil
Message:
  • corrected previous bug
  • finished propagating immediates
File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/RTLabs/copyPropagation.ml

    r1569 r1572  
    1818
    1919module L  = struct
    20        
     20
    2121  type property =
    2222      Register.t Register.FlexMap.t
    2323
    2424  let bottom : property =
    25                 Register.FlexMap.empty
    26                
    27         let meet =
    28                 let choose r ro1 ro2 = match ro1, ro2 with
    29                         | Some r1, Some r2 when r1 = r2 -> Some r1
    30                         | _ -> None in
    31                 Register.FlexMap.merge choose
     25    Register.FlexMap.empty
     26
     27  let meet =
     28    let choose r ro1 ro2 = match ro1, ro2 with
     29      | Some r1, Some r2 when r1 = r2 -> Some r1
     30      | _ -> None in
     31    Register.FlexMap.merge choose
    3232
    3333  let big_meet f = function
    34                 | [] -> bottom
    35                 | x :: xs ->
    36                         let f' s y = meet s (f y) in
    37                         List.fold_left f' (f x) xs
    38        
     34    | [] -> bottom
     35    | x :: xs ->
     36      let f' s y = meet s (f y) in
     37      List.fold_left f' (f x) xs
     38
    3939  let equal : property -> property -> bool =
    40                 Register.FlexMap.equal Register.equal
     40    Register.FlexMap.equal Register.equal
    4141
    4242  let is_maximal _ = false
    43        
     43
    4444end
    4545
    4646let ( --* ) m = function
    47         | None -> m
    48         | Some r ->
    49                 let filter s t = not (Register.equal s r || Register.equal t r) in
    50                 Register.FlexMap.filter filter m
     47  | None -> m
     48  | Some r ->
     49    let filter s t = not (Register.equal s r || Register.equal t r) in
     50    Register.FlexMap.filter filter m
    5151
    5252module F = Fix.Make (Label.ImpMap) (L)
     
    5454let semantics
    5555    (graph : statement Label.Map.t)
    56                 (pred_table : Label.t list Label.Map.t)
    57                 (lbl : Label.t)
    58                 (valu : F.valuation)
    59                 : F.property =
     56    (pred_table : Label.t list Label.Map.t)
     57    (lbl : Label.t)
     58    (valu : F.valuation)
     59    : F.property =
    6060  let copies_out l =
    61                 let copies_out = valu l in
    62                 match Label.Map.find l graph with
    63                         | St_op1 (Op_id, r, s, _) ->
    64                                 let copy_of x =
    65                                         (try
    66                                                 Register.FlexMap.find x copies_out
    67                                         with
    68                                                 | Not_found -> x) in
    69                                 if Register.equal (copy_of r) (copy_of s) then copies_out else
    70                                 Register.FlexMap.add r s (copies_out --* (Some r))
    71                         | stmt -> copies_out --* RTLabsUtilities.modified_at_stmt stmt in
    72         L.big_meet copies_out (Label.Map.find lbl pred_table)
     61    let copies_out = valu l in
     62    match Label.Map.find l graph with
     63      | St_op1 (Op_id, r, s, _) ->
     64        let copy_of x =
     65          (try
     66             Register.FlexMap.find x copies_out
     67           with
     68             | Not_found -> x) in
     69        if Register.equal (copy_of r) (copy_of s) then copies_out else
     70          Register.FlexMap.add r s (copies_out --* (Some r))
     71      | stmt -> copies_out --* RTLabsUtilities.modified_at_stmt stmt in
     72  L.big_meet copies_out (Label.Map.find lbl pred_table)
    7373
    7474let analyze
    7575    (f_def : internal_function)
    76                 : F.valuation =
    77                
    78         let graph = f_def.f_graph in
    79        
    80         let pred_table = RTLabsUtilities.compute_predecessor_lists graph in
    81        
    82         F.lfp (semantics graph pred_table)
     76    : F.valuation =
     77
     78  let graph = f_def.f_graph in
     79
     80  let pred_table = RTLabsUtilities.compute_predecessor_lists graph in
     81
     82  F.lfp (semantics graph pred_table)
    8383
    8484(* we transform statements according to the valuation found out by analyze *)
     
    8686    (valu : F.valuation)
    8787    (p    : Label.t)
    88                 : statement -> statement =
    89         let copy_of x =
    90                 try
    91                         Register.FlexMap.find x (valu p)
    92                 with
    93                         | Not_found -> x in
    94         let copy_of_arg = function
    95                 | Reg x -> Reg (copy_of x)
    96                 | Imm _ as a -> a in
    97         function
    98                 | St_op1 (o,i,j,next) -> St_op1(o,i,copy_of j,next)
    99                 | St_op2 (o,i,j,k,next) -> St_op2(o,i,copy_of_arg j, copy_of_arg k,next)
    100           | St_load (q, a, j, l) -> St_load (q, copy_of_arg a, j, l)
    101                 | St_store (q, a1, a2, l) -> St_store(q, copy_of_arg a1, copy_of_arg a2, l)
    102                 | St_cond (i, if_true, if_false) -> St_cond (copy_of i, if_true, if_false)
    103                 | St_call_id (f, args, ret, sign, l) ->
    104                         St_call_id (f, List.map copy_of args, ret, sign, l)
    105                 | St_call_ptr (f, args, ret, sign, l) ->
    106             St_call_ptr (f, List.map copy_of args, ret, sign, l)
    107                 | stmt -> stmt
     88    : statement -> statement =
     89  let copy_of x =
     90    try
     91      Register.FlexMap.find x (valu p)
     92    with
     93      | Not_found -> x in
     94  let copy_of_arg = function
     95    | Reg x -> Reg (copy_of x)
     96    | Imm _ as a -> a in
     97  function
     98    | St_op1 (o,i,j,next) -> St_op1(o,i,copy_of j,next)
     99    | St_op2 (o,i,j,k,next) -> St_op2(o,i,copy_of_arg j, copy_of_arg k,next)
     100    | St_load (q, a, j, l) -> St_load (q, copy_of_arg a, j, l)
     101    | St_store (q, a1, a2, l) -> St_store(q, copy_of_arg a1, copy_of_arg a2, l)
     102    | St_cond (i, if_true, if_false) -> St_cond (copy_of i, if_true, if_false)
     103    | St_call_id (f, args, ret, sign, l) ->
     104      St_call_id (f, List.map copy_of_arg args, ret, sign, l)
     105    | St_call_ptr (f, args, ret, sign, l) ->
     106      St_call_ptr (f, List.map copy_of_arg args, ret, sign, l)
     107    | St_return (Some a) -> St_return (Some (copy_of_arg a))
     108    | stmt -> stmt
    108109
    109110let transform_int_function
    110111    (f_def  : internal_function)
    111                 : internal_function =
    112         let valu = analyze f_def in
    113         (* we transform the graph according to the analysis *)
    114         let graph = Label.Map.mapi (transform_statement valu) f_def.f_graph in
    115         {f_def with f_graph = graph}
     112    : internal_function =
     113  let valu = analyze f_def in
     114        (* we transform the graph according to the analysis *)
     115  let graph = Label.Map.mapi (transform_statement valu) f_def.f_graph in
     116  {f_def with f_graph = graph}
    116117
    117118let transform_function = function
    118         | (id, F_int f_def) -> (id, F_int (transform_int_function f_def))
    119         | f -> f
     119  | (id, F_int f_def) -> (id, F_int (transform_int_function f_def))
     120  | f -> f
    120121
    121122let trans = Languages.RTLabs, function
    122         | Languages.AstRTLabs p ->
    123                 Languages.AstRTLabs {p with functs = List.map transform_function p.functs}
    124         | _ -> assert false
    125 
    126          
     123  | Languages.AstRTLabs p ->
     124    Languages.AstRTLabs {p with functs = List.map transform_function p.functs}
     125  | _ -> assert false
Note: See TracChangeset for help on using the changeset viewer.