Ignore:
Timestamp:
Dec 6, 2011, 5:04:13 PM (9 years ago)
Author:
tranquil
Message:
  • turned to argument-less return statements for RTLabs and RTL (there was a hidden invariant, for which the arguments of return statements where equal to the f_result field of the function definition: they were useless and an optimization was breaking the compilation)
  • corrected a bug in liveness analysis I had introduced
Location:
Deliverables/D2.2/8051/src/RTLabs
Files:
7 edited

Legend:

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

    r1572 r1589  
    9696
    9797  (* Return statement. *)
    98   | St_return of argument option
     98  | St_return
    9999
    100100
  • Deliverables/D2.2/8051/src/RTLabs/RTLabsInterpret.ml

    r1572 r1589  
    1919   function being executed. *)
    2020
    21 type local_env = (Val.t * AST.sig_type) Register.Map.t
     21type local_env = {
     22  le_vals : (Val.t * AST.sig_type) Register.Map.t ;
     23  le_ret : Register.t option
     24}
    2225
    2326(* Call frames. The execution state has a call stack, each element of the stack
     
    2730
    2831type stack_frame =
    29     { ret_reg  : Register.t option ;
     32    { result   : Register.t option ;
    3033      graph    : RTLabs.graph ;
    3134      sp       : Val.address ;
     
    5356      (if Val.eq v Val.undef then ""
    5457       else (Register.print x) ^ " = " ^ (Val.to_string v) ^ "  ") in
    55   Register.Map.fold f lenv ""
     58  Register.Map.fold f lenv.le_vals ""
    5659
    5760let string_of_args args =
     
    8487
    8588let get_local_env f lenv r =
    86   if Register.Map.mem r lenv then f (Register.Map.find r lenv)
    87   else error ("Unknown local register \"" ^ (Register.print r) ^ "\".")
     89  let a = try Register.Map.find r lenv.le_vals with
     90    | Not_found ->
     91      error ("Unknown local register \"" ^ (Register.print r) ^ "\".") in
     92  f a
    8893
    8994let get_value = get_local_env fst
     
    9297
    9398let update_local r v lenv =
    94   let f (_, t) = Register.Map.add r (v, t) lenv in
    95   get_local_env f lenv r
     99  let f (_, t) = Register.Map.add r (v, t) lenv.le_vals in
     100  { lenv with le_vals = get_local_env f lenv r }
    96101
    97102let update_locals rs vs lenv =
     
    209214        (* Save the stack frame. *)
    210215        let sf =
    211           { ret_reg = destr ; graph = graph ; sp = sp ; pc = lbl ; lenv = lenv }
     216          { result = destr ; graph = graph ; sp = sp ; pc = lbl ; lenv = lenv }
    212217        in
    213218        CallState (sf :: sfrs, f_def, args, mem, inds, trace)
     
    219224        (* Save the stack frame. *)
    220225        let sf =
    221           { ret_reg = destr ; graph = graph ; sp = sp ; pc = lbl ; lenv = lenv }
     226          { result = destr ; graph = graph ; sp = sp ; pc = lbl ; lenv = lenv }
    222227        in
    223228        CallState (sf :: sfrs, f_def, args, mem, inds, trace)
     
    275280      *)
    276281
    277       | RTLabs.St_return None ->
     282      | RTLabs.St_return ->
    278283        let mem = Mem.free mem sp in
    279         ReturnState (sfrs, Val.undef, mem, inds, trace)
    280 
    281       | RTLabs.St_return (Some r) ->
    282         let v = eval_arg lenv mem sp r in
    283         let mem = Mem.free mem sp in
    284         ReturnState (sfrs, v, mem, inds, trace)
    285 
     284        let res =  match lenv.le_ret with
     285          | None -> Val.undef
     286          | Some r -> get_value lenv r in
     287        ReturnState (sfrs, res, mem, inds, trace)
    286288
    287289module InterpretExternal = Primitive.Interpret (Mem)
     
    297299    (locals           : (Register.t * AST.sig_type) list)
    298300    (params           : (Register.t * AST.sig_type) list)
     301    (ret              : (Register.t * AST.sig_type) option)
    299302    (args             : Val.t list) :
    300303    local_env =
    301304  let f_param lenv (r, t) v = Register.Map.add r (v, t) lenv in
    302305  let f_local lenv (r, t) = Register.Map.add r (Val.undef, t) lenv in
    303   let lenv = List.fold_left2 f_param Register.Map.empty params args in
    304   List.fold_left f_local lenv locals
     306  let lenv_vals = List.fold_left2 f_param Register.Map.empty params args in
     307  let ret = Option.map fst ret in
     308  { le_vals = List.fold_left f_local lenv_vals locals; le_ret = ret }
    305309
    306310let state_after_call
     
    316320      let (mem', sp) =
    317321        Mem.alloc mem (concrete_stacksize def.RTLabs.f_stacksize) in
    318       let lenv = init_locals def.RTLabs.f_locals def.RTLabs.f_params args in
     322      let lenv = init_locals
     323        def.RTLabs.f_locals
     324        def.RTLabs.f_params
     325        def.RTLabs.f_result
     326        args in
     327      let graph = def.RTLabs.f_graph in
    319328      (* allocate new constant indexing *)
    320       let graph = def.RTLabs.f_graph in
    321329      let inds = new_ind inds in
    322330      State (sfrs, graph, sp, def.RTLabs.f_entry, lenv, mem', inds, trace)
     
    334342    (trace   : CostLabel.t list) :
    335343    state =
    336   let lenv = match sf.ret_reg with
     344  let lenv = match sf.result with
    337345    | None -> sf.lenv
    338346    | Some ret_reg -> update_local ret_reg ret_val sf.lenv in
    339       (* erase current indexing and revert to previous one *)
    340       let inds = forget_ind inds in
    341       State (sfrs, sf.graph, sf.sp, sf.pc, lenv,
    342              mem, inds, trace)
     347  (* erase current indexing and revert to previous one *)
     348  let inds = forget_ind inds in
     349  State (sfrs, sf.graph, sf.sp, sf.pc, lenv, mem, inds, trace)
    343350
    344351
  • Deliverables/D2.2/8051/src/RTLabs/RTLabsPrinter.ml

    r1580 r1589  
    245245        (print_reg r)
    246246        (print_table tbl)
    247   | RTLabs.St_return None -> Printf.sprintf "return"
    248   | RTLabs.St_return (Some r) -> Printf.sprintf "return %s" (print_arg r)
     247  | RTLabs.St_return -> Printf.sprintf "return"
    249248
    250249
  • Deliverables/D2.2/8051/src/RTLabs/RTLabsToRTL.ml

    r1585 r1589  
    1111let error_shift () = error "Shift operations not supported."
    1212
     13let dummy = Label.dummy
    1314
    1415let add_graph lbl stmt def =
     
    174175  translate_cst (AST.Cst_int 0) destrs start_lbl dest_lbl def
    175176
    176 let translate_cast_signed destrs srcr start_lbl dest_lbl def =
    177   let (def, tmpr) = fresh_reg def in
    178   let insts =
     177let sign_mask destr srcr =
    179178    (* this sets tmpr to 0xFF if s is neg, 0x00 o.w. Done like that:
    180179       byte in tmpr if srcr is: neg   |  pos
     
    185184
    186185     *)
    187     [RTL.St_op2 (I8051.Or, tmpr, srcr, RTL.Imm 127, start_lbl) ;
    188      RTL.St_op1 (I8051.Rl, tmpr, tmpr, start_lbl) ;
    189      RTL.St_op1 (I8051.Inc, tmpr, tmpr, start_lbl) ;
    190      RTL.St_op1 (I8051.Cmpl, tmpr, tmpr, start_lbl) ] in
     186  [RTL.St_op2 (I8051.Or, destr, srcr, RTL.Imm 127, dummy) ;
     187   RTL.St_op1 (I8051.Rl, destr, destr, dummy) ;
     188   RTL.St_op1 (I8051.Inc, destr, destr, dummy) ;
     189   RTL.St_op1 (I8051.Cmpl, destr, destr, dummy) ]
     190
     191
     192let translate_cast_signed destrs srcr start_lbl dest_lbl def =
     193  let (def, tmpr) = fresh_reg def in
    191194  let srcrs = MiscPottier.make (RTL.Reg tmpr) (List.length destrs) in
    192   add_translates [adds_graph insts ; translate_move destrs srcrs]
     195  add_translates [adds_graph (sign_mask tmpr srcr); translate_move destrs srcrs]
    193196    start_lbl dest_lbl def
    194197
     
    477480
    478481    | AST.Op_add | AST.Op_addp ->
    479       translate_op I8051.Addc destrs srcrs1 srcrs2 start_lbl dest_lbl def
     482      translate_op I8051.Add destrs srcrs1 srcrs2 start_lbl dest_lbl def
    480483
    481484    | AST.Op_sub | AST.Op_subp | AST.Op_subpp ->
     
    666669    error "Jump tables not supported yet."
    667670
    668   | RTLabs.St_return None ->
    669     add_graph lbl (RTL.St_return []) def
    670 
    671   | RTLabs.St_return (Some r) ->
    672     add_graph lbl (RTL.St_return (find_local_env r lenv)) def
     671  | RTLabs.St_return ->
     672    add_graph lbl RTL.St_return def
     673
     674open BList.Notation
    673675
    674676open BList.Notation
     
    708710      load_args args (fun args ->
    709711        RTLabs.St_tailcall_ptr (f, args, s) ^:: bnil)
    710     | RTLabs.St_return (Some a) ->
    711       load_arg a (fun a ->
    712         RTLabs.St_return (Some a) ^:: bnil)
    713712    | stmt -> stmt ^:: bnil in
    714713  let module T = GraphUtilities.Trans(RTLabsGraph)(RTLabsGraph) in
  • Deliverables/D2.2/8051/src/RTLabs/constPropagation.ml

    r1580 r1589  
    332332        | L.V _ | L.A _ -> ([], Some [if_true])
    333333        | _ -> ([s], Some [if_true ; if_false]))
    334     | St_return (Some a) ->
    335       ([St_return (Some (arg_from_arg (valu p) types a))], None)
    336334    | St_call_id (f, args, ret, sg, l) ->
    337335      ([St_call_id (f, args_from_args (valu p) types args, ret, sg, l)], None)
  • Deliverables/D2.2/8051/src/RTLabs/copyPropagation.ml

    r1580 r1589  
    107107    | St_call_ptr (f, args, ret, sign, l) ->
    108108      St_call_ptr (f, List.map copy_of_arg args, ret, sign, l)
    109     | St_return (Some a) -> St_return (Some (copy_of_arg a))
    110109    | stmt -> stmt
    111110
  • Deliverables/D2.2/8051/src/RTLabs/redundancyElimination.ml

    r1580 r1589  
    118118
    119119(* used in possibly non side-effect-free statements *)
    120 let used_at_stmt stmt =
     120let used_at_stmt ret stmt =
    121121  let add_arg s = function
    122122    | Reg r -> Register.Set.add r s
     
    130130    | St_store (_, a, b, _) ->
    131131      add_arg (add_arg Register.Set.empty a) b
    132     | St_return (Some (Reg r))
    133132    | St_cond (r, _, _) -> Register.Set.singleton r
     133    | St_return ->
     134      begin match ret with
     135        | Some (r, _) -> Register.Set.singleton r
     136        | None ->  Register.Set.empty
     137      end
    134138    | _ -> Register.Set.empty
    135139
    136 let used_at g n = used_at_stmt (Label.Map.find n g)
     140let used_at ret g n = used_at_stmt ret (Label.Map.find n g)
    137141
    138142module ExprOrdered = struct
     
    378382    (g : graph)
    379383    (type_of : Register.t -> AST.sig_type)
     384    (ret : (Register.t * AST.sig_type) option)
    380385    (late : Fsing.valuation)
    381386    (lbl : Label.t)
     
    394399        Register.Set.union (Register.Set.remove r used_out) (vars_of g l)
    395400      | _ -> used_out in
    396     Register.Set.union used_out (used_at g l) in
     401    Register.Set.union used_out (used_at ret g l) in
    397402  let used = big_union f succs in
    398403
     
    406411
    407412  let graph = f_def.f_graph in
     413  let ret = f_def.f_result in
    408414
    409415  Fexprid.lfp
    410     (semantics_isolated_used graph type_of (late graph type_of delayed))
     416    (semantics_isolated_used graph type_of ret (late graph type_of delayed))
    411417
    412418(* expressions that are optimally placed at point p, without being isolated *)
Note: See TracChangeset for help on using the changeset viewer.