Ignore:
Timestamp:
Nov 28, 2011, 3:13:14 PM (9 years ago)
Author:
tranquil
Message:
  • corrected previous bug
  • finished propagating immediates
Location:
Deliverables/D2.2/8051/src/ERTL
Files:
6 edited

Legend:

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

    r1568 r1572  
    9191  (* Push a value from a register to the IRAM. Parameter are the source
    9292     register, and the label of the next statement. *)
    93   | St_push of Register.t * Label.t
     93  | St_push of argument * Label.t
    9494
    9595  (* Assign the most significant bits of the address of a symbol to a
     
    115115     operation, the destination register, the source registers, and the label of
    116116     the next statement. *)
    117   | St_opaccsA of I8051.opaccs * Register.t * Register.t * Register.t * Label.t
     117  | St_opaccsA of I8051.opaccs * Register.t * argument * argument * Label.t
    118118
    119119  (* Apply a binary operation that will later be translated in an operation on
     
    121121     operation, the destination register, the source registers, and the label of
    122122     the next statement. *)
    123   | St_opaccsB of I8051.opaccs * Register.t * Register.t * Register.t * Label.t
     123  | St_opaccsB of I8051.opaccs * Register.t * argument * argument * Label.t
    124124
    125125  (* Apply an unary operation. Parameters are the operation, the destination
     
    129129  (* Apply a binary operation. Parameters are the operation, the destination
    130130     register, the source registers, and the label of the next statement. *)
    131   | St_op2 of I8051.op2 * Register.t * Register.t * argument * Label.t
     131  | St_op2 of I8051.op2 * Register.t * argument * argument * Label.t
    132132
    133133  (* Set the carry flag to zero. Parameter is the label of the next
     
    141141     address registers (low bytes first), and the label of the next
    142142     statement. *)
    143   | St_load of Register.t * Register.t * Register.t * Label.t
     143  | St_load of Register.t * argument * argument * Label.t
    144144
    145145  (* Store to external memory. Parameters are the address registers (low bytes
    146146     first), the source register, and the label of the next statement. *)
    147   | St_store of Register.t * Register.t * Register.t * Label.t
     147  | St_store of argument * argument * argument * Label.t
    148148
    149149  (* Call to a function given its name. Parameters are the name of the function,
     
    173173
    174174  (* Transfer control to the address stored in the return address registers. *)
    175   | St_return of registers
     175  | St_return of argument list
    176176
    177177type graph = statement Label.Map.t
  • Deliverables/D2.2/8051/src/ERTL/ERTLInterpret.ml

    r1568 r1572  
    207207  st
    208208
    209 let make_addr st r1 r2 = List.map (fun r -> get_reg (Psd r) st) [r1 ; r2]
     209let make_addr st r1 r2 = List.map (fun r -> get_arg r st) [r1 ; r2]
    210210
    211211
     
    318318
    319319    | ERTL.St_push (srcr, lbl) ->
    320       let v = get_reg (Psd srcr) st in
     320      let v = get_arg srcr st in
    321321      let st = push st v in
    322322      next_pc st lbl
     
    343343      let (v, _) =
    344344        Eval.opaccs opaccs
    345           (get_reg (Psd srcr1) st)
    346           (get_reg (Psd srcr2) st) in
     345          (get_arg srcr1 st)
     346          (get_arg srcr2 st) in
    347347      let st = add_reg (Psd destr) v st in
    348348      next_pc st lbl
     
    351351      let (_, v) =
    352352        Eval.opaccs opaccs
    353           (get_reg (Psd srcr1) st)
    354           (get_reg (Psd srcr2) st) in
     353          (get_arg srcr1 st)
     354          (get_arg srcr2 st) in
    355355      let st = add_reg (Psd destr) v st in
    356356      next_pc st lbl
     
    364364      let (v, carry) =
    365365        Eval.op2 st.carry op2
    366           (get_reg (Psd srcr1) st)
     366          (get_arg srcr1 st)
    367367          (get_arg srcr2 st) in
    368368      let st = change_carry st carry in
     
    386386    | ERTL.St_store (addr1, addr2, srcr, lbl) ->
    387387      let addr = make_addr st addr1 addr2 in
    388       let mem = Mem.store st.mem chunk addr (get_reg (Psd srcr) st) in
     388      let mem = Mem.store st.mem chunk addr (get_arg srcr st) in
    389389      let st = change_mem st mem in
    390390      next_pc st lbl
     
    394394
    395395    | ERTL.St_call_ptr (f1, f2, _, lbl) ->
    396       interpret_call lbls_offs st (make_addr st f1 f2) lbl
     396      interpret_call lbls_offs st (make_addr st (RTL.Reg f1) (RTL.Reg f2)) lbl
    397397
    398398    | ERTL.St_cond (srcr, lbl_true, lbl_false) ->
     
    436436
    437437let compute_result st ret_regs =
    438   let vs = List.map (fun r -> get_reg (Psd r) st) ret_regs in
     438  let vs = List.map (fun r -> get_arg r st) ret_regs in
    439439  let f res v = res && (Val.is_int v) in
    440440  let is_int vs = (List.length vs > 0) && (List.fold_left f true vs) in
  • Deliverables/D2.2/8051/src/ERTL/ERTLPrinter.ml

    r1568 r1572  
    2323    first (MiscPottier.string_of_list sep f rl) last
    2424
     25let print_arg = function
     26  | RTL.Imm i -> string_of_int i
     27  | RTL.Reg r -> Register.print r
     28
    2529let print_ptr rl = print_reg_list "[" "]" " ; " Register.print rl
    2630
    2731let print_args rl = print_reg_list "(" ")" ", " Register.print rl
    2832
    29 let print_return rl = print_reg_list "[" "]" " ; " Register.print rl
     33let print_return rl = print_reg_list "[" "]" " ; " print_arg rl
    3034
    3135let print_params rl = print_reg_list "(" ")" ", " Register.print rl
     
    3640
    3741let print_result rl = print_reg_list "[" "]" " ; " Register.print rl
    38 
    39 let print_arg = function
    40   | RTL.Imm i -> string_of_int i
    41   | RTL.Reg r -> Register.print r
    4242
    4343let print_statement = function
     
    7070    Printf.sprintf "pop %s --> %s" (Register.print r) lbl
    7171  | ERTL.St_push (r, lbl) ->
    72     Printf.sprintf "push %s --> %s" (Register.print r) lbl
     72    Printf.sprintf "push %s --> %s" (print_arg r) lbl
    7373  | ERTL.St_addrH (dstr, id, lbl) ->
    7474    Printf.sprintf "addrH %s, %s --> %s" (Register.print dstr) id lbl
     
    8484      (I8051.print_opaccs opaccs)
    8585      (Register.print dstr)
    86       (Register.print srcr1)
    87       (Register.print srcr2)
     86      (print_arg srcr1)
     87      (print_arg srcr2)
    8888      lbl
    8989  | ERTL.St_opaccsB (opaccs, dstr, srcr1, srcr2, lbl) ->
     
    9191      (I8051.print_opaccs opaccs)
    9292      (Register.print dstr)
    93       (Register.print srcr1)
    94       (Register.print srcr2)
     93      (print_arg srcr1)
     94      (print_arg srcr2)
    9595      lbl
    9696  | ERTL.St_op1 (op1, dstr, srcr, lbl) ->
     
    104104      (I8051.print_op2 op2)
    105105      (Register.print dstr)
    106       (Register.print srcr1)
     106      (print_arg srcr1)
    107107      (print_arg srcr2)
    108108      lbl
     
    114114    Printf.sprintf "load %s, (%s, %s) --> %s"
    115115      (Register.print dstr)
    116       (Register.print addr1)
    117       (Register.print addr2)
     116      (print_arg addr1)
     117      (print_arg addr2)
    118118      lbl
    119119  | ERTL.St_store (addr1, addr2, srcr, lbl) ->
    120120    Printf.sprintf "store (%s, %s), %s --> %s"
    121       (Register.print addr1)
    122       (Register.print addr2)
    123       (Register.print srcr)
     121      (print_arg addr1)
     122      (print_arg addr2)
     123      (print_arg srcr)
    124124      lbl
    125125  | ERTL.St_call_id (f, nb_args, lbl) ->
     
    148148
    149149
    150 let print_graph n c =
     150let print_graph n c entry =
    151151  let f lbl stmt s =
    152152    Printf.sprintf "%s%s: %s\n%s"
     
    155155      (print_statement stmt)
    156156      s in
    157   Label.Map.fold f c ""
     157  ERTLUtilities.dfs_fold f c entry ""
     158  (* Label.Map.fold f c "" *)
    158159
    159160
     
    173174    (n_spaces (n+2))
    174175    def.ERTL.f_exit
    175     (print_graph (n+2) def.ERTL.f_graph)
     176    (print_graph (n+2) def.ERTL.f_graph def.ERTL.f_entry)
    176177
    177178
  • Deliverables/D2.2/8051/src/ERTL/ERTLToLTLI.ml

    r1568 r1572  
    3333  open I8051
    3434
     35
     36  type argument =
     37    | AColor of I8051.register
     38    | ASpill of AST.immediate
     39    | AImm of AST.immediate
     40
     41  let lookup_as_arg r = match lookup r with
     42    | Spill k -> ASpill k
     43    | Color r -> AColor r
     44
     45  let lookup_arg = function
     46    | RTL.Imm k -> AImm k
     47    | RTL.Reg r -> lookup_as_arg r
     48
    3549  let adjust off = locals - (off + I8051.int_size)
    3650
    37   let get_stack r off l =
    38     let off = adjust off in
    39     let l = generate (LTL.St_from_acc (r, l)) in
    40     let l = generate (LTL.St_load l) in
    41     let l = generate (LTL.St_from_acc (I8051.dph, l)) in
    42     let l = generate (LTL.St_op2 (I8051.Addc, LTL.Reg I8051.sph, l)) in
    43     let l = generate (LTL.St_int (I8051.a, 0, l)) in
    44     let l = generate (LTL.St_from_acc (I8051.dpl, l)) in
    45     let l = generate (LTL.St_op2 (I8051.Add, LTL.Reg I8051.spl, l)) in
    46     LTL.St_int (I8051.a, off, l)
    47 
    48   let set_stack_preamble off l =
     51  (* side-effects : dpl, dph, a *)
     52  let move_sp_to_dptr off l =
    4953    let off = adjust off in
    5054    let l = generate (LTL.St_from_acc (I8051.dph, l)) in
     
    5559    LTL.St_int (I8051.a, off, l)
    5660
    57   let set_stack off r l =
     61
     62  (* side-effects : dpl, dph, a *)
     63  let get_stack r off l =
     64    let l =
     65      if I8051.eq_reg r I8051.a then l else generate (LTL.St_from_acc (r, l)) in
     66    let l = generate (LTL.St_load l) in
     67    move_sp_to_dptr off l
     68
     69  (* side-effects : dpl, dph, a *)
     70  let set_stack_not_a off r l =
    5871    let l = generate (LTL.St_store l) in
    5972    let l = generate (LTL.St_to_acc (r, l)) in
    60     set_stack_preamble off l
    61 
     73    move_sp_to_dptr off l
     74
     75  (* side-effects : dpl, dph, sst *)
     76  let set_stack_a off l =
     77    let l = generate (LTL.St_store l) in
     78    let l = generate (set_stack_not_a off I8051.sst l) in
     79    LTL.St_from_acc (I8051.st0, l)
     80
     81  (* side-effects : dpl, dph, st0 if r = a, a if r != a *)
     82  let set_stack off r =
     83    if I8051.eq_reg r I8051.a then set_stack_a off else
     84      set_stack_not_a off r
     85
     86  (* side-effects : dpl, dph, a *)
    6287  let set_stack_int off k l =
    6388    let l = generate (LTL.St_store l) in
    6489    let l = generate (LTL.St_int (I8051.a, k, l)) in
    65     set_stack_preamble off l
    66 
    67   (* let write (r : Register.t) (l : Label.t) : (I8051.register * Label.t) = *)
    68   (*   match lookup r with *)
    69 
    70   (*     | Color hwr -> *)
    71   (*       (\* Pseudo-register [r] has been mapped to hardware register *)
    72   (*          [hwr]. Just write into [hwr] and branch to [l]. *\) *)
    73   (*       (hwr, l) *)
    74 
    75   (*     | Spill off -> *)
    76   (*       (\* Pseudo-register [r] has been mapped to offset [off] in the local zone *)
    77   (*          of the stack. Then, write into [sst] (never allocated) and transfer *)
    78   (*          control to an instruction that copies [sst] in the designated *)
    79   (*          location of the stack before branching to [l]. *\) *)
    80   (*       (I8051.sst, generate (set_stack off I8051.sst l)) *)
    81 
    82 
    83   (* let read (r : Register.t) (stmt : I8051.register -> LTL.statement) = *)
    84   (*   match lookup r with *)
    85   (*     | Color hwr -> *)
    86   (*       (\* Pseudo-register [r] has been mapped to hardware register [hwr]. Just *)
    87   (*          generate statement [stmt] with a reference to register [hwr]. *\) *)
    88   (*       generate (stmt hwr) *)
    89 
    90   (*     | Spill off -> *)
    91   (*       (\* Pseudo-register [r] has been mapped to offset [off] in the local zone *)
    92   (*          of the stack. Issue a statement that copies the designated area in *)
    93   (*          the stack into the temporary unallocatable hardware register [sst], *)
    94   (*          then generate statement [stmt] with a reference to register *)
    95   (*          [sst]. *\) *)
    96   (*       let temphwr = I8051.sst in *)
    97   (*       let l = generate (stmt temphwr) in *)
    98   (*       generate (get_stack temphwr off l) *)
    99 
    100 
    101   let move (dest : decision) (src : decision) l =
    102     match dest, src with
    103 
    104       (* Both pseudo-registers are translated to hardware registers. Issue move
    105          statements, or no statement at all if both pseudo-registers reside in
    106          the same hardware register. *)
    107       | Color desthwr, Color sourcehwr when I8051.eq_reg desthwr sourcehwr ->
    108         LTL.St_skip l
    109       | Color desthwr, Color sourcehwr when I8051.eq_reg desthwr I8051.a ->
    110         LTL.St_to_acc (sourcehwr, l)
    111       | Color desthwr, Color sourcehwr when I8051.eq_reg sourcehwr I8051.a ->
    112         LTL.St_from_acc (desthwr, l)
    113       | Color desthwr, Color sourcehwr ->
    114         let l = generate (LTL.St_from_acc (desthwr, l)) in
    115         LTL.St_to_acc (sourcehwr, l)
    116 
    117       (* One pseudo-register is translated to a hardware register, while the
    118          other is spilled. Issue a single stack access instruction. *)
    119       | Color desthwr, Spill off -> get_stack desthwr off l
    120       | Spill off, Color sourcehwr -> set_stack off sourcehwr l
    121 
    122       (* Both pseudo-registers are spilled. Combine the previous two cases. Of
    123          course, if the two pseudo-registers have been spilled into the same
    124          stack slot, there is nothing to do. *)
    125       | Spill off1, Spill off2 when off1 = off2 ->
    126         LTL.St_skip l
    127       | Spill off1, Spill off2 ->
    128         let temphwr = I8051.sst in
    129         let l = generate (set_stack off1 temphwr l) in
    130         get_stack temphwr off2 l
    131 
     90    move_sp_to_dptr off l
     91
     92
     93  (* side-effects : (dpl, dph, a) if dest spilled *)
    13294  let move_int (dest : decision) (k : int) l =
    13395    match dest with
     
    13597      | Spill off -> set_stack_int off k l
    13698
    137   let op2 op (dest : decision) (src1 : decision) (src2 : decision) l =
    138     let l = generate (move dest (Color I8051.a) l) in
     99  (* side-effects : none if dest = src, a if both colored,
     100                    (dpl, dph, a) if src spilled or src imm and dest spilled,
     101                    (dpl, dph, a, sst) if dest spilled *)
     102  let move (dest : decision) (src : argument) l =
     103    match dest, src with
     104      | _, AImm k -> move_int dest k l
     105      (* Both pseudo-registers are translated to hardware registers. Issue move
     106         statements, or no statement at all if both pseudo-registers reside in
     107         the same hardware register. *)
     108      | Color desthwr, AColor sourcehwr
     109        when I8051.eq_reg desthwr sourcehwr ->
     110        LTL.St_skip l
     111      | Color desthwr, AColor sourcehwr
     112        when I8051.eq_reg desthwr I8051.a ->
     113        LTL.St_to_acc (sourcehwr, l)
     114      | Color desthwr, AColor sourcehwr
     115        when I8051.eq_reg sourcehwr I8051.a ->
     116        LTL.St_from_acc (desthwr, l)
     117      | Color desthwr, AColor sourcehwr ->
     118        let l = generate (LTL.St_from_acc (desthwr, l)) in
     119        LTL.St_to_acc (sourcehwr, l)
     120
     121      (* One pseudo-register is translated to a hardware register, while the
     122         other is spilled. Issue a single stack access instruction. *)
     123      | Color desthwr, ASpill off -> get_stack desthwr off l
     124      | Spill off, AColor sourcehwr -> set_stack off sourcehwr l
     125
     126      (* Both pseudo-registers are spilled. Combine the previous two cases. Of
     127         course, if the two pseudo-registers have been spilled into the same
     128         stack slot, there is nothing to do. *)
     129      | Spill off1, ASpill off2 when off1 = off2 ->
     130        LTL.St_skip l
     131      | Spill off1, ASpill off2 ->
     132        let l = generate (set_stack_a off1 l) in
     133        get_stack I8051.a off2 l
     134
     135  (* side-effects (dpl, dph) if either spilled, (dpl, dph, b) if both *)
     136  let op2 op (dest : decision) (src1 : argument) (src2 : argument) l =
     137    let l = generate (move dest (AColor I8051.a) l) in
    139138    match op, src1, src2 with
    140       | _, _, Color src2hwr ->
     139      | _, _, AImm k ->
     140        let l = generate (LTL.St_op2 (op, LTL.Imm k, l)) in
     141        move (Color I8051.a) src1 l
     142        (* if op is commutative, we can do as above if first is hwr *)
     143      | (Add | Addc | And | Or | Xor), AImm k, _ ->
     144        let l = generate (LTL.St_op2 (op, LTL.Imm k, l)) in
     145        move (Color I8051.a) src2 l
     146      | _, _, AColor src2hwr ->
    141147        let l = generate (LTL.St_op2 (op, LTL.Reg src2hwr, l)) in
    142148        move (Color I8051.a) src1 l
    143         (* if op is commutative, we can do as above if first is hwr *)
    144       | (Add | Addc | And | Or | Xor), Color src1hwr, _ ->
     149      | (Add | Addc | And | Or | Xor), AColor src1hwr, _ ->
    145150        let l = generate (LTL.St_op2 (op, LTL.Reg src1hwr, l)) in
    146151        move (Color I8051.a) src2 l
    147         (* otherwise we have to use b *)
    148       | _ ->
     152      | _, _, _ ->
    149153        let l = generate (LTL.St_op2 (op, LTL.Reg I8051.b, l)) in
    150154        let l = generate (move (Color I8051.a) src1 l) in
    151155        move (Color I8051.b) src2 l
    152156
    153   let move_to_dptr (addr1 : decision) (addr2 : decision) l =
     157  (* side-effects : a, b if both spilled *)
     158  let move_to_dptr (addr1 : argument) (addr2 : argument) l =
    154159    match addr1, addr2 with
    155       | Color _, _ ->
     160      | ASpill _, ASpill _  ->
     161        let l = generate (move (Color I8051.dph) (AColor I8051.b) l) in
     162        let l = generate (move (Color I8051.dpl) addr1 l) in
     163        move (Color I8051.b) addr2 l
     164      | (AColor _ | AImm _) , _ ->
    156165        (* the following does not change dph, as addr1 is hwr *)
    157166        let l = generate (move (Color I8051.dpl) addr1 l) in
    158167        move (Color I8051.dph) addr2 l
    159       | _, Color _ ->
    160         (* the following does not change dph, as addr1 is hwr *)
     168      | _, (AColor _ | AImm _) ->
     169        (* the following does not change dpl, as addr2 is hwr *)
    161170        let l = generate (move (Color I8051.dph) addr2 l) in
    162171        move (Color I8051.dpl) addr1 l
    163       | _ ->
    164         let l = generate (move (Color I8051.dph) (Color I8051.b) l) in
    165         let l = generate (move (Color I8051.dpl) addr1 l) in
    166         move (Color I8051.b) addr2 l
    167 
    168   let store addr1 addr2 srcr l =
     172
     173  (* side-effects :  dpl, dph, b if both addr spilled,
     174                     st0 if srcr = a or srcr spilled, a if srcrs != a *)
     175  let store (addr1 : argument) (addr2 : argument) (srcr : argument) l =
    169176    let l = generate (LTL.St_store l) in
    170177    match srcr with
    171       | Color _ ->
    172         let l = generate (move (Color I8051.a) srcr l) in
     178      | AColor r when I8051.eq_reg r a ->
     179        let l = generate (LTL.St_to_acc (I8051.st0, l)) in
     180        let l = generate (move_to_dptr addr1 addr2 l) in
     181        LTL.St_from_acc (I8051.st0, l)
     182      | AColor r ->
     183        let l = generate (LTL.St_to_acc (r, l)) in
    173184        move_to_dptr addr1 addr2 l
    174       | _ ->
     185      | AImm k ->
     186        let l = generate (LTL.St_int (I8051.a, k, l)) in
     187        move_to_dptr addr1 addr2 l
     188      | ASpill _ ->
    175189        let l = generate (LTL.St_to_acc (I8051.st0, l)) in
    176190        let l = generate (move_to_dptr addr1 addr2 l) in
     
    227241
    228242      | ERTL.St_get_hdw (destr, sourcehwr, l) ->
    229         move (lookup destr) (Color sourcehwr) l
    230 
    231       | ERTL.St_set_hdw (desthwr, RTL.Reg sourcer, l) ->
    232         move (Color desthwr) (lookup sourcer) l
    233 
    234       | ERTL.St_set_hdw (desthwr, RTL.Imm k, l) ->
    235         move_int (Color desthwr) k l
     243        move (lookup destr) (AColor sourcehwr) l
     244
     245      | ERTL.St_set_hdw (desthwr, sourcer, l) ->
     246        move (Color desthwr) (lookup_arg sourcer) l
    236247
    237248      | ERTL.St_hdw_to_hdw (r1, r2, l) ->
    238         move (Color r1) (Color r2) l
     249        move (Color r1) (AColor r2) l
    239250
    240251      | ERTL.St_newframe l ->
     
    248259
    249260      | ERTL.St_pop (r, l) ->
    250         let l = generate (move (lookup r) (Color I8051.a) l) in
     261        let l = generate (move (lookup r) (AColor I8051.a) l) in
    251262        LTL.St_pop l
    252263
    253264      | ERTL.St_push (r, l) ->
    254265        let l = generate (LTL.St_push l) in
    255         move (Color I8051.a) (lookup r) l
     266        move (Color I8051.a) (lookup_arg r) l
    256267
    257268      | ERTL.St_addrH (r, x, l) ->
    258         let l = generate (move (lookup r) (Color I8051.dph) l) in
     269        let l = generate (move (lookup r) (AColor I8051.dph) l) in
    259270        LTL.St_addr (x, l)
    260271
    261272      | ERTL.St_addrL (r, x, l) ->
    262         let l = generate (move (lookup r) (Color I8051.dpl) l) in
     273        let l = generate (move (lookup r) (AColor I8051.dpl) l) in
    263274        LTL.St_addr (x, l)
    264275
    265       | ERTL.St_move (r, RTL.Imm i, l) ->
    266         move_int (lookup r) i l
    267 
    268       | ERTL.St_move (r1, RTL.Reg r2, l) ->
    269         move (lookup r1) (lookup r2) l
     276      | ERTL.St_move (r, a, l) ->
     277        move (lookup r) (lookup_arg a) l
    270278
    271279      | ERTL.St_opaccsA (opaccs, destr, srcr1, srcr2, l) ->
    272         let l = generate (move (lookup destr) (Color I8051.a) l) in
     280        let l = generate (move (lookup destr) (AColor I8051.a) l) in
    273281        let l = generate (LTL.St_opaccs (opaccs, l)) in
    274         let l = generate (move (Color I8051.a) (lookup srcr1) l) in
    275         move (Color I8051.b) (lookup srcr2) l
     282        let l = generate (move (Color I8051.a) (lookup_arg srcr1) l) in
     283        move (Color I8051.b) (lookup_arg srcr2) l
    276284
    277285      | ERTL.St_opaccsB (opaccs, destr, srcr1, srcr2, l) ->
    278         let l = generate (move (lookup destr) (Color I8051.b) l) in
     286        let l = generate (move (lookup destr) (AColor I8051.b) l) in
    279287        let l = generate (LTL.St_opaccs (opaccs, l)) in
    280         let l = generate (move (Color I8051.a) (lookup srcr1) l) in
    281         move (Color I8051.b) (lookup srcr2) l
     288        let l = generate (move (Color I8051.a) (lookup_arg srcr1) l) in
     289        move (Color I8051.b) (lookup_arg srcr2) l
    282290
    283291      | ERTL.St_op1 (op1, destr, srcr, l) ->
    284         let l = generate (move (lookup destr) (Color I8051.a) l) in
     292        let l = generate (move (lookup destr) (AColor I8051.a) l) in
    285293        let l = generate (LTL.St_op1 (op1, l)) in
    286         move (Color I8051.a) (lookup srcr) l
    287 
    288       | ERTL.St_op2 (op, destr, srcr1, RTL.Reg srcr2, l) ->
    289         op2 op (lookup destr) (lookup srcr1) (lookup srcr2) l
    290 
    291       | ERTL.St_op2 (op2, destr, srcr1, RTL.Imm k, l) ->
    292         let l = generate (move (lookup destr) (Color I8051.a) l) in
    293         let l = generate (LTL.St_op2 (op2, LTL.Imm k, l)) in
    294         move (Color I8051.a) (lookup srcr1) l
     294        move (Color I8051.a) (lookup_as_arg srcr) l
     295
     296      | ERTL.St_op2 (op, destr, arg1, arg2, l) ->
     297        op2 op (lookup destr) (lookup_arg arg1) (lookup_arg arg2) l
    295298
    296299      | ERTL.St_clear_carry l ->
     
    300303        LTL.St_set_carry l
    301304
    302       (* act differently on hardware registers? if at least one of
    303          the address bytes is hdw use of st0 can be avoided. And in
    304          case of non-hdw, the read could actually target a register
    305          directly *)
    306305      | ERTL.St_load (destr, addr1, addr2, l) ->
    307         let l = generate (move (lookup destr) (Color I8051.a) l) in
     306        let l = generate (move (lookup destr) (AColor I8051.a) l) in
    308307        let l = generate (LTL.St_load l) in
    309         move_to_dptr (lookup addr1) (lookup addr2) l
     308        move_to_dptr (lookup_arg addr1) (lookup_arg addr2) l
    310309
    311310      | ERTL.St_store (addr1, addr2, srcr, l) ->
    312         store (lookup addr1) (lookup addr2) (lookup srcr) l
     311        store (lookup_arg addr1) (lookup_arg addr2) (lookup_arg srcr) l
    313312
    314313      | ERTL.St_call_id (f, _, l) ->
     
    317316      | ERTL.St_call_ptr (f1, f2, _, l) ->
    318317        let l = generate (LTL.St_call_ptr l) in
    319         move_to_dptr (lookup f1) (lookup f2) l
     318        move_to_dptr (lookup_as_arg f1) (lookup_as_arg f2) l
    320319
    321320      | ERTL.St_cond (srcr, lbl_true, lbl_false) ->
    322321        let l = generate (LTL.St_condacc (lbl_true, lbl_false)) in
    323         move (Color I8051.a) (lookup srcr) l
     322        move (Color I8051.a) (lookup_as_arg srcr) l
    324323
    325324      | ERTL.St_return _ ->
  • Deliverables/D2.2/8051/src/ERTL/liveness.ml

    r1568 r1572  
    143143let ret_regs = set_of_list I8051.rets
    144144
     145let add_arg : RTL.argument -> L.property -> L.property = function
     146  | RTL.Reg r -> L.join (L.psingleton r)
     147  | RTL.Imm _ -> fun x -> x
     148
    145149let used (stmt : statement) : L.t =
    146150  match stmt with
     
    156160  (* | St_int _ *)
    157161  | St_clear_carry _
    158   | St_set_carry _
    159   | St_set_hdw (_, RTL.Imm _, _)
    160   | St_move (_, RTL.Imm _, _) ->
     162  | St_set_carry _ ->
    161163    L.bottom
    162164  | St_call_id (_, nparams, _) ->
     
    171173  | St_hdw_to_hdw (_, r, _) ->
    172174    L.hsingleton r
    173   | St_op2 (I8051.Addc, _, r1, RTL.Reg r2, _) ->
    174     L.join (L.join (L.psingleton r1) (L.psingleton r2))
    175       (L.hsingleton I8051.carry)
    176   | St_op2 (I8051.Addc, _, r1, RTL.Imm _, _) ->
    177     L.join (L.psingleton r1) (L.hsingleton I8051.carry)
    178   | St_set_hdw (_, RTL.Reg r, _)
    179   | St_push (r, _)
    180   | St_move (_, RTL.Reg r, _)
    181175  | St_op1 (_, _, r, _)
    182   | St_op2 (_, _, r, RTL.Imm _, _)
    183176  | St_cond (r, _, _) ->
    184177    L.psingleton r
    185   | St_opaccsA (_, _, r1, r2, _)
    186   | St_opaccsB (_, _, r1, r2, _)
    187   | St_op2 (_, _, r1, RTL.Reg r2, _)
    188   | St_load (_, r1, r2, _) ->
    189     L.join (L.psingleton r1) (L.psingleton r2)
    190   | St_store (r1, r2, r3, _) ->
    191     L.join (L.join (L.psingleton r1) (L.psingleton r2)) (L.psingleton r3)
     178  | St_set_hdw (_, a, _)
     179  | St_push (a, _)
     180  | St_move (_, a, _) ->
     181    add_arg a L.bottom
     182  | St_op2 ((I8051.Addc | I8051.Sub), _, a1, a2, _) ->
     183    add_arg a1 (add_arg a2 (L.hsingleton I8051.carry))
     184  | St_opaccsA (_, _, a1, a2, _)
     185  | St_opaccsB (_, _, a1, a2, _)
     186  | St_op2 (_, _, a1, a2, _)
     187  | St_load (_, a1, a2, _) ->
     188    add_arg a1 (add_arg a2 L.bottom)
     189  | St_store (a1, a2, a3, _) ->
     190    add_arg a1 (add_arg a2 (add_arg a3 L.bottom))
    192191  | St_newframe _
    193192  | St_delframe _ ->
  • Deliverables/D2.2/8051/src/ERTL/uses.ml

    r1568 r1572  
    1515let count r uses = Register.Map.add r (lookup uses r + 1) uses
    1616
     17let count_arg = function
     18  | RTL.Reg r -> count r
     19  | RTL.Imm _ -> fun x -> x
     20
    1721let examine_statement _ stmt uses =
    1822  match stmt with
     
    2327  | St_ind_inc _
    2428  | St_hdw_to_hdw _
    25   | St_set_hdw (_, RTL.Imm _, _)
    2629  | St_newframe _
    2730  | St_delframe _
     
    3235    uses
    3336  | St_get_hdw (r, _, _)
    34   | St_set_hdw (_, RTL.Reg r, _)
    3537  | St_framesize (r, _)
    3638  | St_pop (r, _)
    37   | St_push (r, _)
    38   | St_move (r, RTL.Imm _, _)
    3939  | St_addrH (r, _, _)
    4040  | St_addrL (r, _, _)
    4141  | St_cond (r, _, _) ->
    4242    count r uses
    43   | St_move (r1, RTL.Reg r2, _)
    44   | St_op1 (_, r1, r2, _)
    45   | St_op2 (_, r1, r2, RTL.Imm _, _)
    46   | St_call_ptr (r1, r2, _, _) ->
     43  | St_set_hdw (_, a, _)
     44  | St_push (a, _) ->
     45    count_arg a uses
     46  | St_move (r1, a2, _) ->
     47    count r1 (count_arg a2 uses)
     48  | St_call_ptr (r1, r2, _, _)
     49  | St_op1 (_, r1, r2, _) ->
    4750    count r1 (count r2 uses)
    48   | St_opaccsA (_, r1, r2, r3, _)
    49   | St_opaccsB (_, r1, r2, r3, _)
    50   | St_op2 (_, r1, r2, RTL.Reg r3, _)
    51   | St_load (r1, r2, r3, _)
    52   | St_store (r1, r2, r3, _) ->
    53     count r1 (count r2 (count r3 uses))
     51  | St_opaccsA (_, r, a1, a2, _)
     52  | St_opaccsB (_, r, a1, a2, _)
     53  | St_load (r, a1, a2, _)
     54  | St_op2 (_, r, a1, a2, _) ->
     55    count r (count_arg a1 (count_arg a1 uses))
     56  | St_store (a1, a2, a3, _) ->
     57    count_arg a1 (count_arg a2 (count_arg a3 uses))
    5458
    5559let examine_internal int_fun =
Note: See TracChangeset for help on using the changeset viewer.