Ignore:
Timestamp:
Nov 25, 2011, 7:43:39 PM (8 years ago)
Author:
tranquil
Message:
  • Immediates introduced (but not fully used yet in RTLabs to RTL pass)
  • translation streamlined
  • BUGGY: interpretation fails in LTL, trying to fetch a function with incorrect address
File:
1 edited

Legend:

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

    r1542 r1568  
    9797  | RTL.St_addr (r1, r2, id, _) -> RTL.St_addr (r1, r2, id, lbl)
    9898  | RTL.St_stackaddr (r1, r2, _) -> RTL.St_stackaddr (r1, r2, lbl)
    99   | RTL.St_int (r, i, _) -> RTL.St_int (r, i, lbl)
     99  (* | RTL.St_int (r, i, _) -> RTL.St_int (r, i, lbl) *)
    100100  | RTL.St_move (r1, r2, _) -> RTL.St_move (r1, r2, lbl)
    101101  | RTL.St_opaccs (opaccs, dstr1, dstr2, srcr1, srcr2, _) ->
     
    204204    let module M = IntValue.Make (struct let size = size end) in
    205205    let is = List.map M.to_int (M.break (M.of_int i) size) in
    206     let f r i = RTL.St_int (r, i, dest_lbl) in
     206    let f r i = RTL.St_move (r, RTL.Imm i, dest_lbl) in
    207207    let l = List.map2 f destrs is in
    208208    adds_graph l start_lbl dest_lbl def
     
    229229let rec translate_move destrs srcrs start_lbl =
    230230  let ((common1, rest1), (common2, rest2)) = MiscPottier.reduce destrs srcrs in
    231   let f_common destr srcr = RTL.St_move (destr, srcr, start_lbl) in
     231  let f_common destr srcr = RTL.St_move (destr, RTL.Reg srcr, start_lbl) in
    232232  let translates1 = adds_graph (List.map2 f_common common1 common2) in
    233233  let translates2 = translate_cst (AST.Cst_int 0) rest1 in
    234234  add_translates [translates1 ; translates2] start_lbl
    235235
     236let rec translate_imm destrs vals start_lbl =
     237  let ((common1, rest1), (common2, _)) = MiscPottier.reduce destrs vals in
     238  let f_common destr srcr = RTL.St_move (destr, RTL.Imm srcr, start_lbl) in
     239  let translates1 = adds_graph (List.map2 f_common common1 common2) in
     240  let translates2 = translate_cst (AST.Cst_int 0) rest1 in
     241  add_translates [translates1 ; translates2] start_lbl
     242
    236243
    237244let translate_cast_unsigned destrs start_lbl dest_lbl def =
    238   let (def, tmp_zero) = fresh_reg def in
    239   let zeros = MiscPottier.make tmp_zero (List.length destrs) in
    240   add_translates
    241     [adds_graph [RTL.St_int (tmp_zero, 0, start_lbl)] ;
    242      translate_move destrs zeros]
    243     start_lbl dest_lbl def
     245  translate_cst (AST.Cst_int 0) destrs start_lbl dest_lbl def
    244246
    245247let translate_cast_signed destrs srcr start_lbl dest_lbl def =
    246   let (def, tmp_128) = fresh_reg def in
    247   let (def, tmp_255) = fresh_reg def in
    248248  let (def, tmpr) = fresh_reg def in
    249   let (def, dummy) = fresh_reg def in
    250249  let insts =
    251     [RTL.St_int (tmp_128, 128, start_lbl) ;
    252      RTL.St_op2 (I8051.And, tmpr, tmp_128, srcr, start_lbl) ;
    253      RTL.St_opaccs (I8051.DivuModu, tmpr, dummy, tmpr, tmp_128, start_lbl) ;
    254      RTL.St_int (tmp_255, 255, start_lbl) ;
    255      RTL.St_opaccs (I8051.Mul, tmpr, dummy, tmpr, tmp_255, start_lbl)] in
     250    (* this sets tmpr to 0xFF if s is neg, 0x00 o.w. Done like that:
     251       byte in tmpr if srcr is: neg   |  pos
     252       tmpr ← srcr | 127       11...1 | 01...1
     253       tmpr ← tmpr <rot< 1     1...11 | 1...10
     254       tmpr ← INC tmpr         0....0 | 1....1
     255       tmpr ← CPL tmpr         1....1 | 0....0
     256
     257     *)
     258    [RTL.St_op2 (I8051.Or, tmpr, srcr, RTL.Imm 127, start_lbl) ;
     259     RTL.St_op1 (I8051.Rl, tmpr, tmpr, start_lbl) ;
     260     RTL.St_op1 (I8051.Inc, tmpr, tmpr, start_lbl) ;
     261     RTL.St_op1 (I8051.Cmpl, tmpr, tmpr, start_lbl) ] in
    256262  let srcrs = MiscPottier.make tmpr (List.length destrs) in
    257263  add_translates [adds_graph insts ; translate_move destrs srcrs]
     
    273279
    274280let translate_negint destrs srcrs start_lbl dest_lbl def =
    275   assert (List.length destrs = List.length srcrs) ;
    276   let (def, tmpr) = fresh_reg def in
     281  assert (List.length destrs = List.length srcrs && List.length destrs > 0) ;
    277282  let f_cmpl destr srcr = RTL.St_op1 (I8051.Cmpl, destr, srcr, start_lbl) in
    278283  let insts_cmpl = List.map2 f_cmpl destrs srcrs in
    279   let insts_init =
    280     [RTL.St_set_carry start_lbl ;
    281      RTL.St_int (tmpr, 0, start_lbl)] in
    282   let f_add destr = RTL.St_op2 (I8051.Addc, destr, destr, tmpr, start_lbl) in
    283   let insts_add = List.map f_add destrs in
    284   adds_graph (insts_cmpl @ insts_init @ insts_add)
     284  let first, rest = List.hd destrs, List.tl destrs in
     285  let inst_init =
     286    RTL.St_op2 (I8051.Add, first, first, RTL.Imm 0, start_lbl) in
     287  let f_add destr =
     288    RTL.St_op2 (I8051.Addc, destr, destr, RTL.Imm 0, start_lbl) in
     289  let insts_add = List.map f_add rest in
     290  adds_graph (insts_cmpl @ inst_init :: insts_add)
    285291    start_lbl dest_lbl def
    286292
    287293
    288 let translate_notbool destrs srcrs start_lbl dest_lbl def = match destrs with
    289   | [] -> add_graph start_lbl (RTL.St_skip dest_lbl) def
    290   | destr :: destrs ->
    291     let (def, tmpr) = fresh_reg def in
    292     let (def, tmp_srcrs) = fresh_regs def (List.length srcrs) in
    293     let save_srcrs = translate_move tmp_srcrs srcrs in
    294     let init_destr = RTL.St_int (destr, 1, start_lbl) in
    295     let f tmp_srcr =
    296       [RTL.St_clear_carry start_lbl ;
    297        RTL.St_int (tmpr, 0, start_lbl) ;
    298        RTL.St_op2 (I8051.Sub, tmpr, tmpr, tmp_srcr, start_lbl) ;
    299        RTL.St_int (tmpr, 0, start_lbl) ;
    300        RTL.St_op2 (I8051.Addc, tmpr, tmpr, tmpr, start_lbl) ;
    301        RTL.St_op2 (I8051.Xor, destr, destr, tmpr, start_lbl)] in
    302     let insts = init_destr :: (List.flatten (List.map f tmp_srcrs)) in
    303     let epilogue = translate_cst (AST.Cst_int 0) destrs in
    304     add_translates [save_srcrs ; adds_graph insts ; epilogue]
    305       start_lbl dest_lbl def
     294let translate_notbool destrs srcrs start_lbl dest_lbl def =
     295  match destrs,srcrs with
     296    | [], _ -> adds_graph [] start_lbl dest_lbl def
     297    | destr :: destrs, srcr :: srcrs ->
     298      let (def, tmpr) = fresh_reg def in
     299      let init_destr = RTL.St_move (destr, RTL.Reg srcr, start_lbl) in
     300      let f r =
     301        RTL.St_op2 (I8051.Or, destr, destr, RTL.Reg r, start_lbl) in
     302      let big_or = List.map f srcrs in
     303      let finalize_destr =
     304        [RTL.St_move (tmpr, RTL.Imm 0, start_lbl) ;
     305         RTL.St_clear_carry start_lbl ;
     306         RTL.St_op2 (I8051.Sub, tmpr, tmpr, RTL.Reg destr, start_lbl) ;
     307         (* carry bit is set iff destr is non-zero iff destrs was non-zero *)
     308         RTL.St_move (tmpr, RTL.Imm 0, start_lbl) ;
     309         RTL.St_op2 (I8051.Addc, destr, tmpr, RTL.Reg tmpr, start_lbl) ;
     310         (* destr = carry bit = bigor of old destrs *)
     311         RTL.St_op2 (I8051.Xor, destr, destr, RTL.Imm 1, start_lbl)] in
     312      let epilogue = translate_cst (AST.Cst_int 0) destrs in
     313      add_translates [adds_graph (init_destr :: big_or @ finalize_destr) ;
     314                      epilogue]
     315        start_lbl dest_lbl def
     316    | destr :: destrs, [] ->
     317      translate_cst (AST.Cst_int 1) destrs start_lbl dest_lbl def
    306318
    307319
     
    336348    MiscPottier.reduce destrs_rest srcrs_rest in
    337349  let (def, tmpr) = fresh_reg def in
    338   let insts_init =
    339     [RTL.St_clear_carry start_lbl ;
    340      RTL.St_int (tmpr, 0, start_lbl)] in
     350  let carry_init = match op with
     351    | I8051.Addc | I8051.Sub ->
     352      (* depend on carry bit *)
     353      [RTL.St_clear_carry start_lbl]
     354    | I8051.Add -> assert false (* should not call with add, not correct *)
     355    | _ -> [] in
     356  let inst_init = RTL.St_move (tmpr, RTL.Imm 0, start_lbl) :: carry_init in
    341357  let f_add destr srcr1 srcr2 =
    342     RTL.St_op2 (op, destr, srcr1, srcr2, start_lbl) in
     358    RTL.St_op2 (op, destr, srcr1, RTL.Reg srcr2, start_lbl) in
    343359  let insts_add =
    344360    MiscPottier.map3 f_add destrs_common srcrs1_common srcrs2_common in
    345361  let f_add_cted destr srcr =
    346     RTL.St_op2 (op, destr, srcr, tmpr, start_lbl) in
     362    RTL.St_op2 (op, destr, srcr, RTL.Reg tmpr, start_lbl) in
    347363  let insts_add_cted = List.map2 f_add_cted destrs_cted srcrs_cted in
    348364  let f_rest destr =
    349     RTL.St_op2 (op, destr, tmpr, tmpr, start_lbl) in
     365    RTL.St_op2 (op, destr, tmpr, RTL.Reg tmpr, start_lbl) in
    350366  let insts_rest = List.map f_rest destrs_rest in
    351   adds_graph (insts_init @ insts_add @ insts_add_cted @ insts_rest)
     367  adds_graph (inst_init @ insts_add @ insts_add_cted @ insts_rest)
    352368    start_lbl dest_lbl def
    353369
     
    357373    | [], _ -> adds_graph [RTL.St_skip start_lbl] start_lbl
    358374    | [destr], [] ->
    359       adds_graph [RTL.St_int (tmpr, 0, start_lbl) ;
    360                   RTL.St_op2 (I8051.Addc, destr, destr, tmpr, start_lbl)]
     375      adds_graph [RTL.St_op2 (I8051.Addc, destr, destr, RTL.Imm 0, start_lbl)]
    361376        start_lbl
    362377    | destr1 :: destr2 :: destrs, [] ->
    363378      add_translates
    364         [adds_graph [RTL.St_int (tmpr, 0, start_lbl) ;
    365                      RTL.St_op2 (I8051.Addc, destr1, destr1, tmpr, start_lbl) ;
    366                      RTL.St_op2 (I8051.Addc, destr2, tmpr, tmpr, start_lbl)] ;
     379        [adds_graph
     380            [RTL.St_move (tmpr, RTL.Imm 0, start_lbl) ;
     381             RTL.St_op2 (I8051.Addc, destr1, destr1, RTL.Imm 0, start_lbl) ;
     382             RTL.St_op2 (I8051.Addc, destr2, tmpr, RTL.Imm 0, start_lbl)] ;
    367383         translate_cst (AST.Cst_int 0) destrs]
    368384        start_lbl
     
    370386      adds_graph
    371387        [RTL.St_opaccs (I8051.Mul, tmpr, dummy, srcr2, srcr1, start_lbl) ;
    372          RTL.St_op2 (I8051.Addc, destr, destr, tmpr, start_lbl)]
     388         RTL.St_op2 (I8051.Addc, destr, destr, RTL.Reg tmpr, start_lbl)]
    373389        start_lbl
    374390    | destr1 :: destr2 :: destrs, srcr1 :: srcrs1 ->
     
    377393            [RTL.St_opaccs
    378394                (I8051.Mul, tmpr, destr2, srcr2, srcr1, start_lbl) ;
    379              RTL.St_op2 (I8051.Addc, destr1, destr1, tmpr, start_lbl)] ;
     395             RTL.St_op2 (I8051.Addc, destr1, destr1, RTL.Reg tmpr, start_lbl)] ;
    380396         translate_mul1 dummy tmpr (destr2 :: destrs) srcrs1 srcr2]
    381397        start_lbl
     
    389405      | tmp_destr2 :: tmp_destrs2 ->
    390406        [adds_graph [RTL.St_clear_carry dummy_lbl ;
    391                      RTL.St_int (tmp_destr2, 0, dummy_lbl)] ;
     407                     RTL.St_move (tmp_destr2, RTL.Imm 0, dummy_lbl)] ;
    392408         translate_mul1 dummy tmpr (tmp_destr2 :: tmp_destrs2) srcrs1 srcr2i ;
    393409         translate_cst (AST.Cst_int 0) tmp_destrs1 ;
    394          adds_graph [RTL.St_clear_carry dummy_lbl] ;
    395410         translate_op I8051.Addc destrs destrs tmp_destrs])
    396411
     
    422437      add_translates [inst_div ; insts_rest] start_lbl dest_lbl def
    423438
    424 
    425439let translate_ne destrs srcrs1 srcrs2 start_lbl dest_lbl def =
    426440  match destrs with
    427     | [] -> add_graph start_lbl (RTL.St_skip dest_lbl) def
     441    | [] -> adds_graph [] start_lbl dest_lbl def
    428442    | destr :: destrs ->
    429443      let (def, tmpr) = fresh_reg def in
    430       let (def, tmp_zero) = fresh_reg def in
    431       let (def, tmp_srcrs1) = fresh_regs def (List.length srcrs1) in
    432       let save_srcrs1 = translate_move tmp_srcrs1 srcrs1 in
    433       let (def, tmp_srcrs2) = fresh_regs def (List.length srcrs2) in
    434       let save_srcrs2 = translate_move tmp_srcrs2 srcrs2 in
    435444      let ((common1, rest1), (common2, rest2)) =
    436         MiscPottier.reduce tmp_srcrs1 tmp_srcrs2 in
     445        MiscPottier.reduce srcrs1 srcrs2 in
    437446      let rest = choose_rest rest1 rest2 in
    438       let inits =
    439         [RTL.St_int (destr, 0, start_lbl) ;
    440          RTL.St_int (tmp_zero, 0, start_lbl)] in
    441       let f_common tmp_srcr1 tmp_srcr2 =
    442         [RTL.St_clear_carry start_lbl ;
    443          RTL.St_op2 (I8051.Sub, tmpr, tmp_srcr1, tmp_srcr2, start_lbl) ;
    444          RTL.St_op2 (I8051.Or, destr, destr, tmpr, start_lbl)] in
    445       let insts_common = List.flatten (List.map2 f_common common1 common2) in
     447      let firsts = match common1, common2 with
     448        | c1hd :: c1tl, c2hd :: c2tl ->
     449          let init =
     450            RTL.St_op2 (I8051.Xor, destr, c1hd, RTL.Reg c2hd, start_lbl) in
     451          let f_common tmp_srcr1 tmp_srcr2 =
     452            [RTL.St_op2 (I8051.Xor, tmpr, tmp_srcr1,
     453                         RTL.Reg tmp_srcr2, start_lbl) ;
     454             RTL.St_op2 (I8051.Or, destr, destr, RTL.Reg tmpr, start_lbl)] in
     455          let insts_common = List.flatten (List.map2 f_common c1tl c2tl) in
     456          init :: insts_common
     457        | [], [] ->
     458          [RTL.St_move (destr, RTL.Imm 0, start_lbl)]
     459        (* common1 and common2 have the same length *)
     460        | _ -> assert false in
    446461      let f_rest tmp_srcr =
    447         [RTL.St_clear_carry start_lbl ;
    448          RTL.St_op2 (I8051.Sub, tmpr, tmp_zero, tmp_srcr, start_lbl) ;
    449          RTL.St_op2 (I8051.Or, destr, destr, tmpr, start_lbl)] in
    450       let insts_rest = List.flatten (List.map f_rest rest) in
    451       let insts = inits @ insts_common @ insts_rest in
     462        RTL.St_op2 (I8051.Xor, destr, destr, RTL.Reg tmp_srcr, start_lbl) in
     463      let insts_rest = List.map f_rest rest in
     464      let insts = firsts @ insts_rest in
    452465      let epilogue = translate_cst (AST.Cst_int 0) destrs in
    453       add_translates [save_srcrs1 ; save_srcrs2 ; adds_graph insts ; epilogue]
    454         start_lbl dest_lbl def
    455 
    456 
    457 let translate_eq_reg tmp_zero tmp_one tmpr1 tmpr2 destr dummy_lbl
    458     (srcr1, srcr2) =
    459   [RTL.St_clear_carry dummy_lbl ;
    460    RTL.St_op2 (I8051.Sub, tmpr1, srcr1, srcr2, dummy_lbl) ;
    461    RTL.St_op2 (I8051.Addc, tmpr1, tmp_zero, tmp_zero, dummy_lbl) ;
    462    RTL.St_op2 (I8051.Sub, tmpr2, srcr2, srcr1, dummy_lbl) ;
    463    RTL.St_op2 (I8051.Addc, tmpr2, tmp_zero, tmp_zero, dummy_lbl) ;
    464    RTL.St_op2 (I8051.Or, tmpr1, tmpr1, tmpr2, dummy_lbl) ;
    465    RTL.St_op2 (I8051.Xor, tmpr1, tmpr1, tmp_one, dummy_lbl) ;
    466    RTL.St_op2 (I8051.And, destr, destr, tmpr1, dummy_lbl)]
    467 
    468 let translate_eq_list tmp_zero tmp_one tmpr1 tmpr2 destr leq dummy_lbl =
    469   let f = translate_eq_reg tmp_zero tmp_one tmpr1 tmpr2 destr dummy_lbl in
    470   (RTL.St_int (destr, 1, dummy_lbl)) :: (List.flatten (List.map f leq))
    471 
    472 let translate_atom tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl leq
    473     srcr1 srcr2 =
    474   (translate_eq_list tmp_zero tmp_one tmpr1 tmpr2 tmpr3 leq dummy_lbl) @
    475   [RTL.St_clear_carry dummy_lbl ;
    476    RTL.St_op2 (I8051.Sub, tmpr1, srcr1, srcr2, dummy_lbl) ;
    477    RTL.St_op2 (I8051.Addc, tmpr1, tmp_zero, tmp_zero, dummy_lbl) ;
    478    RTL.St_op2 (I8051.And, tmpr3, tmpr3, tmpr1, dummy_lbl) ;
    479    RTL.St_op2 (I8051.Or, destr, destr, tmpr3, dummy_lbl)]
    480 
    481 let translate_lt_main tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl
    482     srcrs1 srcrs2 =
    483   let f (insts, leq) srcr1 srcr2 =
    484     let added_insts =
    485       translate_atom tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl leq
    486         srcr1 srcr2 in
    487     (insts @ added_insts, leq @ [(srcr1, srcr2)]) in
    488   fst (List.fold_left2 f ([], []) srcrs1 srcrs2)
    489 
    490 let translate_lt destrs srcrs1 srcrs2 start_lbl dest_lbl def =
     466      add_translates [ adds_graph insts ; epilogue] start_lbl dest_lbl def
     467
     468(* this requires destrs to be either 0 or 1 to be truly correct
     469   to be used after translations that ensure this *)
     470let translate_toggle_bool destrs start_lbl =
    491471  match destrs with
    492     | [] -> add_graph start_lbl (RTL.St_skip dest_lbl) def
    493     | _ ->
    494       let (def, tmp_destrs) = fresh_regs def (List.length destrs) in
    495       let tmp_destr = List.hd tmp_destrs in
    496       let (def, tmp_zero) = fresh_reg def in
    497       let (def, tmp_one) = fresh_reg def in
    498       let (def, tmpr1) = fresh_reg def in
    499       let (def, tmpr2) = fresh_reg def in
    500       let (def, tmpr3) = fresh_reg def in
    501       let (srcrs1, srcrs2, added) = complete_regs def srcrs1 srcrs2 in
    502       let srcrs1 = List.rev srcrs1 in
    503       let srcrs2 = List.rev srcrs2 in
    504       let insts_init =
    505         [translate_cst (AST.Cst_int 0) tmp_destrs ;
    506          translate_cst (AST.Cst_int 0) added ;
    507          adds_graph [RTL.St_int (tmp_zero, 0, start_lbl) ;
    508                      RTL.St_int (tmp_one, 1, start_lbl)]] in
    509       let insts_main =
    510         translate_lt_main tmp_zero tmp_one tmpr1 tmpr2 tmpr3 tmp_destr start_lbl
    511           srcrs1 srcrs2 in
    512       let insts_main = [adds_graph insts_main] in
    513       let insts_exit = [translate_move destrs tmp_destrs] in
    514       add_translates (insts_init @ insts_main @ insts_exit )
    515         start_lbl dest_lbl def
    516 
    517 
    518 let add_128_to_last tmp_128 rs start_lbl = match rs with
    519   | [] -> adds_graph [] start_lbl
    520   | _ ->
    521     let r = MiscPottier.last rs in
    522     adds_graph [RTL.St_op2 (I8051.Add, r, r, tmp_128, start_lbl)] start_lbl
    523 
     472    | [] -> adds_graph [] start_lbl
     473    | destr :: _ ->
     474      adds_graph [RTL.St_op1 (I8051.Cmpl, destr, destr, start_lbl)] start_lbl
     475
     476
     477
     478(* let translate_eq_reg tmp_zero tmpr destr dummy_lbl *)
     479(*     (srcr1, srcr2) = *)
     480(*   [RTL.St_op2 (I8051.Xor, tmpr, srcr1, srcr2, dummy_lbl) ; *)
     481(*    (\* now tmpr = 0 iff srcr1 = srcr2 *\) *)
     482(*    RTL.St_clear_carry dummy_lbl ; *)
     483(*    RTL.St_op2 (I8051.Sub, tmpr, tmp_zero, tmpr, dummy_lbl) ; *)
     484(*    (\* now carry bit = (old tmpr is not zero) = (srcr1 != srcr2) *\) *)
     485(*    RTL.St_op2 (I8051.Addc, tmpr, tmp_zero, tmp_zero, dummy_lbl) ; *)
     486(*    (\* now tmpr = old carry bit = (srcr1 != srcr2) *\) *)
     487(*    RTL.St_op1 (I8051.Cpl, tmpr, tmpr, dummy_lbl)] *)
     488
     489(* let translate_eq_list tmp_zero tmpr destr leq dummy_lbl = match leq with *)
     490(*   | leqhd :: leqtl -> *)
     491(*     let init = translate_eq_reg tmp_zero destr dummy_lbl leqhd in *)
     492(*     let f p = translate_eq_reg tmp_zero tmpr destr dummy_lbl p @ *)
     493(*       [RTL.St_op2 (I8051.And, destr, destr, tmpr1, dummy_lbl)] in *)
     494(*     init @ List.flatten (List.map f leqtl) *)
     495(*   | _ -> [RTL.St_move (destr, RTL.Imm 1, dummy_lbl)] *)
     496
     497(* let translate_atom tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl leq *)
     498(*     srcr1 srcr2 = *)
     499(*   (translate_eq_list tmp_zero tmp_one tmpr1 tmpr2 tmpr3 leq dummy_lbl) @ *)
     500(*   [RTL.St_clear_carry dummy_lbl ; *)
     501(*    RTL.St_op2 (I8051.Sub, tmpr1, srcr1, srcr2, dummy_lbl) ; *)
     502(*    RTL.St_op2 (I8051.Addc, tmpr1, tmp_zero, tmp_zero, dummy_lbl) ; *)
     503(*    RTL.St_op2 (I8051.And, tmpr3, tmpr3, tmpr1, dummy_lbl) ; *)
     504(*    RTL.St_op2 (I8051.Or, destr, destr, tmpr3, dummy_lbl)] *)
     505
     506(* let translate_lt_main tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl *)
     507(*     srcrs1 srcrs2 = *)
     508(*   let f (insts, leq) srcr1 srcr2 = *)
     509(*     let added_insts = *)
     510(*       translate_atom tmp_zero tmp_one tmpr1 tmpr2 tmpr3 destr dummy_lbl leq *)
     511(*      srcr1 srcr2 in *)
     512(*     (insts @ added_insts, leq @ [(srcr1, srcr2)]) in *)
     513(*   fst (List.fold_left2 f ([], []) srcrs1 srcrs2) *)
     514
     515(* let translate_lt destrs srcrs1 srcrs2 start_lbl dest_lbl def = *)
     516(*   match destrs with *)
     517(*     | [] -> add_graph start_lbl (RTL.St_skip dest_lbl) def *)
     518(*     | _ -> *)
     519(*       let (def, tmp_destrs) = fresh_regs def (List.length destrs) in *)
     520(*       let tmp_destr = List.hd tmp_destrs in *)
     521(*       let (def, tmp_zero) = fresh_reg def in *)
     522(*       let (def, tmp_one) = fresh_reg def in *)
     523(*       let (def, tmpr1) = fresh_reg def in *)
     524(*       let (def, tmpr2) = fresh_reg def in *)
     525(*       let (def, tmpr3) = fresh_reg def in *)
     526(*       let (srcrs1, srcrs2, added) = complete_regs def srcrs1 srcrs2 in *)
     527(*       let srcrs1 = List.rev srcrs1 in *)
     528(*       let srcrs2 = List.rev srcrs2 in *)
     529(*       let insts_init = *)
     530(*      [translate_cst (AST.Cst_int 0) tmp_destrs ; *)
     531(*       translate_cst (AST.Cst_int 0) added ; *)
     532(*       adds_graph [RTL.St_int (tmp_zero, 0, start_lbl) ; *)
     533(*                   RTL.St_int (tmp_one, 1, start_lbl)]] in *)
     534(*       let insts_main = *)
     535(*      translate_lt_main tmp_zero tmp_one tmpr1 tmpr2 tmpr3 tmp_destr start_lbl *)
     536(*        srcrs1 srcrs2 in *)
     537(*       let insts_main = [adds_graph insts_main] in *)
     538(*       let insts_exit = [translate_move destrs tmp_destrs] in *)
     539(*       add_translates (insts_init @ insts_main @ insts_exit ) *)
     540(*      start_lbl dest_lbl def *)
     541
     542let rec pad_with p l1 l2 = match l1, l2 with
     543  | [], [] -> ([], [])
     544  | x :: xs, y :: ys ->
     545    let (xs', ys') = pad_with p xs ys in
     546    (x :: xs', y :: ys')
     547  | [], _ -> (MiscPottier.make p (List.length l2), l2)
     548  | _, [] -> (l1, MiscPottier.make p (List.length l1))
     549
     550let translate_ltu desrtrs srcrs1 srcrs2 start_lbl dest_lbl def =
     551  match desrtrs with
     552    | [] -> adds_graph [] start_lbl dest_lbl def
     553    | destr :: destrs ->
     554      let (def, tmpr_zero) = fresh_reg def in
     555      let (srcrs1, srcrs2) = pad_with tmpr_zero srcrs1 srcrs2 in
     556      let init =
     557        [RTL.St_move (tmpr_zero, RTL.Imm 0, start_lbl) ;
     558         RTL.St_clear_carry start_lbl] in
     559      let f srcr1 srcr2 =
     560        RTL.St_op2 (I8051.Sub, destr, srcr1, RTL.Reg srcr2, start_lbl) in
     561      (* not interested in result, just the carry bit
     562         the following is safe even if destrs = srcrsi *)
     563      let iter_sub = List.map2 f srcrs1 srcrs2 in
     564      let extract_carry =
     565        [RTL.St_op2 (I8051.Addc, destr, tmpr_zero,
     566                     RTL.Reg tmpr_zero, start_lbl)] in
     567      let epilogue = translate_cst (AST.Cst_int 0) destrs in
     568      add_translates [adds_graph (init @ iter_sub @ extract_carry);
     569                      epilogue] start_lbl dest_lbl def
     570
     571let rec add_128_to_last
     572    (tmp_128 : Register.t)
     573    (last_subst : Register.t)
     574    (rs : Register.t list)
     575    (dummy_lbl : Label.t) = match rs with
     576  | [] -> ([], adds_graph [])
     577  | [last] ->
     578    let insts =
     579      [RTL.St_move (last_subst, RTL.Reg last, dummy_lbl) ;
     580       RTL.St_op2 (I8051.Add, last_subst, last_subst,
     581                   RTL.Reg tmp_128, dummy_lbl)] in
     582    ([last_subst], adds_graph insts)
     583  | hd :: tail ->
     584    let (tail', trans) = add_128_to_last tmp_128 last_subst tail dummy_lbl in
     585    (hd :: tail', trans)
     586
     587(* what happens if srcrs1 and srcrs2 have different length? seems to me
     588   128 is added at the wrong place then *)
    524589let translate_lts destrs srcrs1 srcrs2 start_lbl dest_lbl def =
    525   let (def, tmp_srcrs1) = fresh_regs def (List.length srcrs1) in
    526   let (def, tmp_srcrs2) = fresh_regs def (List.length srcrs2) in
     590  let (def, tmp_last_srcr1) = fresh_reg def in
     591  let (def, tmp_last_srcr2) = fresh_reg def in
    527592  let (def, tmp_128) = fresh_reg def in
     593  (* I save just the last registers *)
     594  let (srcrs1, add_128_to_srcrs1) =
     595    add_128_to_last tmp_128 tmp_last_srcr1 srcrs1 start_lbl in
     596  let (srcrs2, add_128_to_srcrs2) =
     597    add_128_to_last tmp_128 tmp_last_srcr2 srcrs2 start_lbl in
    528598  add_translates
    529     [translate_move tmp_srcrs1 srcrs1 ;
    530      translate_move tmp_srcrs2 srcrs2 ;
    531      adds_graph [RTL.St_int (tmp_128, 128, start_lbl)] ;
    532      add_128_to_last tmp_128 tmp_srcrs1 ;
    533      add_128_to_last tmp_128 tmp_srcrs2 ;
    534      translate_lt destrs tmp_srcrs1 tmp_srcrs2]
     599    [adds_graph [RTL.St_move (tmp_128, RTL.Imm 128, start_lbl)] ;
     600     add_128_to_srcrs1;
     601     add_128_to_srcrs2;
     602     translate_ltu destrs srcrs1 srcrs2]
    535603    start_lbl dest_lbl def
    536604
    537605
    538 let rec translate_op2 op2 destrs srcrs1 srcrs2 start_lbl dest_lbl def =
     606let translate_op2 op2 destrs srcrs1 srcrs2 start_lbl dest_lbl def =
    539607  match op2 with
    540608
     
    569637    | AST.Op_cmpp AST.Cmp_eq ->
    570638      add_translates
    571         [translate_op2 (AST.Op_cmpu AST.Cmp_ne) destrs srcrs1 srcrs2 ;
    572          translate_op1 AST.Op_notbool destrs destrs]
    573         start_lbl dest_lbl def
     639        [translate_ne destrs srcrs1 srcrs2 ;
     640         translate_toggle_bool destrs] start_lbl dest_lbl def
    574641
    575642    | AST.Op_cmp AST.Cmp_ne
     
    582649
    583650    | AST.Op_cmpu AST.Cmp_lt | AST.Op_cmpp AST.Cmp_lt ->
    584       translate_lt destrs srcrs1 srcrs2 start_lbl dest_lbl def
     651      translate_ltu destrs srcrs1 srcrs2 start_lbl dest_lbl def
    585652
    586653    | AST.Op_cmp AST.Cmp_le ->
    587654      add_translates
    588         [translate_op2 (AST.Op_cmp AST.Cmp_lt) destrs srcrs2 srcrs1 ;
    589          translate_op1 AST.Op_notbool destrs destrs]
    590         start_lbl dest_lbl def
    591 
    592     | AST.Op_cmpu AST.Cmp_le ->
     655        [translate_lts destrs srcrs2 srcrs1 ;
     656         translate_toggle_bool destrs] start_lbl dest_lbl def
     657
     658    | AST.Op_cmpu AST.Cmp_le | AST.Op_cmpp AST.Cmp_le ->
    593659      add_translates
    594         [translate_op2 (AST.Op_cmpu AST.Cmp_lt) destrs srcrs2 srcrs1 ;
    595          translate_op1 AST.Op_notbool destrs destrs]
    596         start_lbl dest_lbl def
    597 
    598     | AST.Op_cmpp AST.Cmp_le ->
    599       add_translates
    600         [translate_op2 (AST.Op_cmpp AST.Cmp_lt) destrs srcrs2 srcrs1 ;
    601          translate_op1 AST.Op_notbool destrs destrs]
    602         start_lbl dest_lbl def
     660        [translate_ltu destrs srcrs2 srcrs1 ;
     661         translate_toggle_bool destrs] start_lbl dest_lbl def
    603662
    604663    | AST.Op_cmp AST.Cmp_gt ->
    605       translate_op2 (AST.Op_cmp AST.Cmp_lt)
    606         destrs srcrs2 srcrs1 start_lbl dest_lbl def
    607 
    608     | AST.Op_cmpu AST.Cmp_gt ->
    609       translate_op2 (AST.Op_cmpu AST.Cmp_lt)
    610         destrs srcrs2 srcrs1 start_lbl dest_lbl def
    611 
    612     | AST.Op_cmpp AST.Cmp_gt ->
    613       translate_op2 (AST.Op_cmpp AST.Cmp_lt)
    614         destrs srcrs2 srcrs1 start_lbl dest_lbl def
     664      translate_lts destrs srcrs2 srcrs1 start_lbl dest_lbl def
     665
     666    | AST.Op_cmpu AST.Cmp_gt | AST.Op_cmpp AST.Cmp_gt ->
     667      translate_ltu destrs srcrs2 srcrs1 start_lbl dest_lbl def
    615668
    616669    | AST.Op_cmp AST.Cmp_ge ->
    617670      add_translates
    618         [translate_op2 (AST.Op_cmp AST.Cmp_lt) destrs srcrs1 srcrs2 ;
    619          translate_op1 AST.Op_notbool destrs destrs]
    620         start_lbl dest_lbl def
    621 
    622     | AST.Op_cmpu AST.Cmp_ge ->
     671        [translate_lts destrs srcrs1 srcrs2 ;
     672         translate_toggle_bool destrs] start_lbl dest_lbl def
     673
     674    | AST.Op_cmpu AST.Cmp_ge | AST.Op_cmpp AST.Cmp_ge ->
    623675      add_translates
    624         [translate_op2 (AST.Op_cmpu AST.Cmp_lt) destrs srcrs1 srcrs2 ;
    625          translate_op1 AST.Op_notbool destrs destrs]
    626         start_lbl dest_lbl def
    627 
    628     | AST.Op_cmpp AST.Cmp_ge ->
    629       add_translates
    630         [translate_op2 (AST.Op_cmpp AST.Cmp_lt) destrs srcrs1 srcrs2 ;
    631          translate_op1 AST.Op_notbool destrs destrs]
    632         start_lbl dest_lbl def
     676        [translate_ltu destrs srcrs1 srcrs2 ;
     677         translate_toggle_bool destrs] start_lbl dest_lbl def
    633678
    634679    | AST.Op_div | AST.Op_divu | AST.Op_modu | AST.Op_mod | AST.Op_shl
     
    639684
    640685let translate_cond srcrs start_lbl lbl_true lbl_false def =
    641   let (def, tmpr) = fresh_reg def in
    642   let tmp_lbl = fresh_label def in
    643   let init = RTL.St_int (tmpr, 0, start_lbl) in
    644   let f srcr = RTL.St_op2 (I8051.Or, tmpr, tmpr, srcr, start_lbl) in
    645   let def = adds_graph (init :: (List.map f srcrs)) start_lbl tmp_lbl def in
    646   add_graph tmp_lbl (RTL.St_cond (tmpr, lbl_true, lbl_false)) def
     686  match srcrs with
     687    | [] -> add_graph start_lbl (RTL.St_skip lbl_false) def
     688    | srcr :: srcrs ->
     689      let (def, tmpr) = fresh_reg def in
     690      let tmp_lbl = fresh_label def in
     691      let init = RTL.St_move (tmpr, RTL.Reg srcr, start_lbl) in
     692      let f srcr = RTL.St_op2 (I8051.Or, tmpr, tmpr, RTL.Reg srcr, start_lbl) in
     693      let def = adds_graph (init :: (List.map f srcrs)) start_lbl tmp_lbl def in
     694      add_graph tmp_lbl (RTL.St_cond (tmpr, lbl_true, lbl_false)) def
    647695
    648696
     
    656704    let translates =
    657705      translates @
    658         [adds_graph [RTL.St_int (tmpr, off, start_lbl)] ;
     706        [adds_graph [RTL.St_move (tmpr, RTL.Imm off, start_lbl)] ;
    659707         translate_op2 AST.Op_addp tmp_addr save_addr [tmpr] ;
    660708         adds_graph [RTL.St_load (r, tmp_addr1, tmp_addr2, dest_lbl)]] in
     
    671719    let translates =
    672720      translates @
    673         [adds_graph [RTL.St_int (tmpr, off, start_lbl)] ;
     721        [adds_graph [RTL.St_move (tmpr, RTL.Imm off, start_lbl)] ;
    674722         translate_op2 AST.Op_addp tmp_addr addr [tmpr] ;
    675723         adds_graph [RTL.St_store (tmp_addr1, tmp_addr2, srcr, dest_lbl)]] in
     
    747795  | RTLabs.St_return (Some r) ->
    748796    add_graph lbl (RTL.St_return (find_local_env r lenv)) def
    749                
     797
    750798  | _ -> assert false (*not possible because of previous removal of immediates*)
    751799
Note: See TracChangeset for help on using the changeset viewer.