Ignore:
Timestamp:
Mar 2, 2011, 3:27:41 PM (9 years ago)
Author:
ayache
Message:

Update of D2.2 from Paris.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • Deliverables/D2.2/8051/src/RTL/RTLToERTL.ml

    r486 r619  
    171171  | [] -> [fun start_lbl -> adds_graph [ERTL.St_skip start_lbl] start_lbl]
    172172  | [r] ->
    173     [fun start_lbl ->
    174       adds_graph [ERTL.St_set_hdw (I8051.st0, r, start_lbl)] start_lbl]
     173    [fun start_lbl dest_lbl def ->
     174      let (def, r_tmp) = fresh_reg def in
     175      adds_graph [ERTL.St_int (r_tmp, 0, start_lbl) ;
     176                  ERTL.St_set_hdw (I8051.st1, r_tmp, start_lbl) ;
     177                  ERTL.St_set_hdw (I8051.st0, r, start_lbl)]
     178        start_lbl dest_lbl def]
    175179  | r1 :: r2 :: _ ->
    176180    [(fun start_lbl ->
    177       adds_graph [ERTL.St_set_hdw (I8051.st1, r1, start_lbl)] start_lbl) ;
    178      (fun start_lbl ->
    179        adds_graph [ERTL.St_set_hdw (I8051.st0, r2, start_lbl)] start_lbl)]
     181      adds_graph [ERTL.St_set_hdw (I8051.st1, r1, start_lbl) ;
     182                  ERTL.St_set_hdw (I8051.st0, r2, start_lbl)] start_lbl)]
    180183
    181184let add_epilogue ret_regs srah sral sregs def =
     
    267270
    268271(* Fetching the result depends on the type of the function, or say, the number
    269    of registers that are waiting for a value. *)
     272   of registers that are waiting for a value. Temporary non allocatable
     273   registers are used. Indeed, moving directly from DPL to a pseudo-register may
     274   cause a bug: DPL might be used to compute the address of the
     275   pseudo-register. *)
    270276
    271277let fetch_result ret_regs start_lbl = match ret_regs with
    272278  | [] -> adds_graph [ERTL.St_skip start_lbl] start_lbl
    273279  | [r] ->
    274     adds_graph
     280      adds_graph
    275281      [ERTL.St_hdw_to_hdw (I8051.st0, I8051.dpl, start_lbl) ;
    276282       ERTL.St_get_hdw (r, I8051.st0, start_lbl)]
     
    401407
    402408
     409(* Move the first cost label of each function at the beginning of the
     410   function. Indeed, the instructions for calling conventions (stack allocation
     411   for example) are added at the very beginning of the function, thus before the
     412   first cost label. *)
     413
     414let generate stmt def =
     415  let entry = Label.Gen.fresh def.ERTL.f_luniverse in
     416  let def =
     417    { def with ERTL.f_graph = Label.Map.add entry stmt def.ERTL.f_graph } in
     418  { def with ERTL.f_entry = entry }
     419
     420let find_and_remove_first_cost_label def =
     421  let rec aux lbl = match Label.Map.find lbl def.ERTL.f_graph with
     422    | ERTL.St_cost (cost_label, next_lbl) ->
     423      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 })
     425    | ERTL.St_skip lbl | ERTL.St_comment (_, lbl) | ERTL.St_get_hdw (_, _, lbl)
     426    | ERTL.St_set_hdw (_, _, lbl) | ERTL.St_hdw_to_hdw (_, _, lbl)
     427    | ERTL.St_pop (_, lbl) | ERTL.St_push (_, lbl) | ERTL.St_addrH (_, _, lbl)
     428    | ERTL.St_addrL (_, _, lbl) | ERTL.St_int (_, _, lbl)
     429    | ERTL.St_move (_, _, lbl) | ERTL.St_opaccs (_, _, _, _, lbl)
     430    | ERTL.St_op1 (_, _, _, lbl) | ERTL.St_op2 (_, _, _, _, lbl)
     431    | ERTL.St_clear_carry lbl | ERTL.St_load (_, _, _, lbl)
     432    | ERTL.St_store (_, _, _, lbl) | ERTL.St_call_id (_, _, lbl)
     433    | ERTL.St_newframe lbl | ERTL.St_delframe lbl | ERTL.St_framesize (_, lbl)
     434      ->
     435      aux lbl
     436    | 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
     440  aux def.ERTL.f_entry
     441
     442let move_first_cost_label_up_internal def =
     443  let (cost_label, def) = find_and_remove_first_cost_label def in
     444  generate (ERTL.St_cost (cost_label, def.ERTL.f_entry)) def
     445
     446let move_first_cost_label_up (id, def) =
     447  let def' = match def with
     448    | ERTL.F_int int_fun ->
     449      ERTL.F_int (move_first_cost_label_up_internal int_fun)
     450    | _ -> def in
     451  (id, def')
     452
     453
    403454let translate p =
    404455  (* We simplify tail calls as regular calls for now. *)
    405456  let p = RTLtailcall.simplify p in
     457  (* The tranformation on each RTL function: create an ERTL function and move
     458     its first cost label at the very beginning. *)
     459  let f funct = move_first_cost_label_up (translate_funct funct) in
    406460  { ERTL.vars   = p.RTL.vars ;
    407     ERTL.functs = List.map translate_funct p.RTL.functs ;
     461    ERTL.functs = List.map f p.RTL.functs ;
    408462    ERTL.main   = p.RTL.main }
Note: See TracChangeset for help on using the changeset viewer.