Changeset 1590 for Deliverables


Ignore:
Timestamp:
Dec 6, 2011, 5:13:16 PM (8 years ago)
Author:
tranquil
Message:
  • got back to previous implementation of multiplication in RTLabs -> RTL (there were bugs and not enough time to solve them)
File:
1 edited

Legend:

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

    r1589 r1590  
    321321    start_lbl dest_lbl def
    322322
     323
     324let rec translate_mul1 dummy tmpr destrs srcrs1 srcr2 start_lbl =
     325  match destrs, srcrs1 with
     326    | [], _ -> adds_graph [RTL.St_skip start_lbl] start_lbl
     327    | [destr], [] ->
     328      adds_graph
     329        [RTL.St_op2 (I8051.Addc, destr, RTL.Reg destr, RTL.Imm 0, start_lbl)]
     330        start_lbl
     331    | destr1 :: destr2 :: destrs, [] ->
     332      add_translates
     333        [adds_graph
     334            [RTL.St_op2 (I8051.Addc, destr1,
     335                         RTL.Reg destr1, RTL.Imm 0, start_lbl) ;
     336             RTL.St_op2 (I8051.Addc, destr2, RTL.Imm 0, RTL.Imm 0, start_lbl)] ;
     337         translate_cst (AST.Cst_int 0) destrs]
     338        start_lbl
     339    | [destr], srcr1 :: _ ->
     340      adds_graph
     341        [RTL.St_opaccs (I8051.Mul, tmpr, dummy, srcr2, srcr1, start_lbl) ;
     342         RTL.St_op2 (I8051.Addc, destr, RTL.Reg destr, RTL.Reg tmpr, start_lbl)]
     343        start_lbl
     344    | destr1 :: destr2 :: destrs, srcr1 :: srcrs1 ->
     345      add_translates
     346        [adds_graph
     347            [RTL.St_opaccs
     348                (I8051.Mul, tmpr, destr2, srcr2, srcr1, start_lbl) ;
     349             RTL.St_op2 (I8051.Addc, destr1, RTL.Reg destr1,
     350                         RTL.Reg tmpr, start_lbl)] ;
     351         translate_mul1 dummy tmpr (destr2 :: destrs) srcrs1 srcr2]
     352        start_lbl
     353
     354let translate_muli dummy tmpr destrs tmp_destrs srcrs1 dummy_lbl i translates
     355    srcr2i =
     356  let (tmp_destrs1, tmp_destrs2) = MiscPottier.split tmp_destrs i in
     357  translates @
     358    (match tmp_destrs2 with
     359      | [] -> []
     360      | tmp_destr2 :: tmp_destrs2 ->
     361        [adds_graph [RTL.St_clear_carry dummy_lbl ;
     362                     RTL.St_move (tmp_destr2, RTL.Imm 0, dummy_lbl)] ;
     363         translate_mul1 dummy tmpr (tmp_destr2 :: tmp_destrs2) srcrs1 srcr2i ;
     364         translate_cst (AST.Cst_int 0) tmp_destrs1 ;
     365         let reg_destrs = List.map (fun r -> RTL.Reg r) destrs in
     366         let tmp_destrs = List.map (fun r -> RTL.Reg r) tmp_destrs in
     367         translate_op I8051.Addc destrs reg_destrs tmp_destrs])
     368
    323369let translate_mul destrs srcrs1 srcrs2 start_lbl dest_lbl def =
    324   (* we save those parts of srcrs that could be overwritten *)
    325   let save_srcrs a (def, srcrs, init) = match a with
    326     | RTL.Reg r when List.mem r destrs ->
    327       let (def, new_r) = fresh_reg def in
    328       (def, RTL.Reg new_r :: srcrs,
    329        adds_graph [RTL.St_move (new_r, a, start_lbl)] :: init)
    330     | _ -> (def, a :: srcrs, init) in
    331   let (def, fresh_srcrs1, init) =
    332     List.fold_right save_srcrs srcrs1 (def, [], []) in
    333   let (def, fresh_srcrs2, init) =
    334     List.fold_right save_srcrs srcrs2 (def, [], init) in
    335   let srcrs1_n = List.length srcrs1 in
    336   let srcrs2_n = List.length srcrs2 in
    337   let destrs_n = List.length destrs in
    338   (* the next must be an invariant *)
    339   assert (srcrs1_n = destrs_n && destrs_n = srcrs1_n);
    340   (* we pad destrs with itself until we have two times as much
    341      registers. The routine should thus handle overflow nicely. *)
    342   let all_destrs = MiscPottier.fill destrs (2 * destrs_n) in
    343   let init = translate_cst (AST.Cst_int 0) destrs :: init in
    344   (* the registries to hold the temporary results of 8-bit mutliplication *)
    345   let (def, a) = fresh_reg def in
    346   let (def, b) = fresh_reg def in
    347   (* when getting the result, this is what is used (padded as necessary) *)
    348   let mul_arg k = [RTL.Reg a ; RTL.Reg b] @
    349     MiscPottier.make (RTL.Imm 0) (2*destrs_n - k - 2) in
    350   (* multiplication between the ith byte of srcrs1 and the jth byte of
    351      srcrs2 *)
    352   let mul i j =
    353     let s1i, s2j = List.nth fresh_srcrs1 i, List.nth fresh_srcrs2 j in
    354     (* the position in the result where the resulting bytes must be added *)
    355     let k = i + j in
    356     let dloc = MiscPottier.sublist all_destrs k (2*destrs_n) in
    357     let dloc_arg = List.map (fun r -> RTL.Reg r) dloc in
    358     (* we add until the end to propagate the carry bit.
    359        At the beginning this will be useless, but we rely on
    360        RTL's constant propagation and later dead register elimination
    361        to amend that *)
    362     [ adds_graph [RTL.St_opaccs (I8051.Mul, a, b, s1i, s2j, start_lbl)] ;
    363       translate_op I8051.Add dloc dloc_arg (mul_arg k)] in
    364   let insts = List.flatten (List.flatten
    365     (MiscPottier.makei (fun i ->
    366       MiscPottier.makei (mul i) srcrs2_n) srcrs1_n)) in
    367   add_translates (init @ insts) start_lbl dest_lbl def
     370  let (def, dummy) = fresh_reg def in
     371  let (def, tmpr) = fresh_reg def in
     372  let (def, tmp_destrs) = fresh_regs def (List.length destrs) in
     373  let (def, fresh_srcrs1) = fresh_regs def (List.length srcrs1) in
     374  (* let (def, fresh_srcrs2) = fresh_regs def (List.length srcrs2) in *)
     375  let reg r = RTL.Reg r in
     376  let insts_init =
     377    [translate_move fresh_srcrs1 srcrs1 ;
     378     (* translate_move fresh_srcrs2 srcrs2 ; *)
     379     translate_cst (AST.Cst_int 0) destrs] in
     380  let fresh_srcrs1 = List.map reg fresh_srcrs1 in
     381  let f = translate_muli dummy tmpr destrs tmp_destrs fresh_srcrs1 start_lbl in
     382  let insts_mul = MiscPottier.foldi f [] srcrs2 in
     383  add_translates (insts_init @ insts_mul) start_lbl dest_lbl def
     384
    368385
    369386let translate_divumodu8 order destrs srcr1 srcr2 start_lbl dest_lbl def =
Note: See TracChangeset for help on using the changeset viewer.