Changeset 1590 for Deliverables/D2.2/8051/src/RTLabs

Timestamp:

Dec 6, 2011, 5:13:16 PM (9 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:

• Deliverables/D2.2/8051/src/RTLabs/RTLabsToRTL.ml (modified) (1 diff)

Deliverables/D2.2/8051/src/RTLabs/RTLabsToRTL.ml

@@ -321 +321 @@
     start_lbl dest_lbl def
 
+
+let rec translate_mul1 dummy tmpr destrs srcrs1 srcr2 start_lbl =
+  match destrs, srcrs1 with
+    | [], _ -> adds_graph [RTL.St_skip start_lbl] start_lbl
+    | [destr], [] ->
+      adds_graph
+        [RTL.St_op2 (I8051.Addc, destr, RTL.Reg destr, RTL.Imm 0, start_lbl)]
+        start_lbl
+    | destr1 :: destr2 :: destrs, [] ->
+      add_translates
+        [adds_graph
+            [RTL.St_op2 (I8051.Addc, destr1,
+                         RTL.Reg destr1, RTL.Imm 0, start_lbl) ;
+             RTL.St_op2 (I8051.Addc, destr2, RTL.Imm 0, RTL.Imm 0, start_lbl)] ;
+         translate_cst (AST.Cst_int 0) destrs]
+        start_lbl
+    | [destr], srcr1 :: _ ->
+      adds_graph
+        [RTL.St_opaccs (I8051.Mul, tmpr, dummy, srcr2, srcr1, start_lbl) ;
+         RTL.St_op2 (I8051.Addc, destr, RTL.Reg destr, RTL.Reg tmpr, start_lbl)]
+        start_lbl
+    | destr1 :: destr2 :: destrs, srcr1 :: srcrs1 ->
+      add_translates
+        [adds_graph
+            [RTL.St_opaccs
+                (I8051.Mul, tmpr, destr2, srcr2, srcr1, start_lbl) ;
+             RTL.St_op2 (I8051.Addc, destr1, RTL.Reg destr1,
+                         RTL.Reg tmpr, start_lbl)] ;
+         translate_mul1 dummy tmpr (destr2 :: destrs) srcrs1 srcr2]
+        start_lbl
+
+let translate_muli dummy tmpr destrs tmp_destrs srcrs1 dummy_lbl i translates
+    srcr2i =
+  let (tmp_destrs1, tmp_destrs2) = MiscPottier.split tmp_destrs i in
+  translates @
+    (match tmp_destrs2 with
+      | [] -> []
+      | tmp_destr2 :: tmp_destrs2 ->
+        [adds_graph [RTL.St_clear_carry dummy_lbl ;
+                     RTL.St_move (tmp_destr2, RTL.Imm 0, dummy_lbl)] ;
+         translate_mul1 dummy tmpr (tmp_destr2 :: tmp_destrs2) srcrs1 srcr2i ;
+         translate_cst (AST.Cst_int 0) tmp_destrs1 ;
+         let reg_destrs = List.map (fun r -> RTL.Reg r) destrs in
+         let tmp_destrs = List.map (fun r -> RTL.Reg r) tmp_destrs in
+         translate_op I8051.Addc destrs reg_destrs tmp_destrs])
+
 let translate_mul destrs srcrs1 srcrs2 start_lbl dest_lbl def =
-  (* we save those parts of srcrs that could be overwritten *)
-  let save_srcrs a (def, srcrs, init) = match a with
-    | RTL.Reg r when List.mem r destrs ->
-      let (def, new_r) = fresh_reg def in
-      (def, RTL.Reg new_r :: srcrs,
-       adds_graph [RTL.St_move (new_r, a, start_lbl)] :: init)
-    | _ -> (def, a :: srcrs, init) in
-  let (def, fresh_srcrs1, init) =
-    List.fold_right save_srcrs srcrs1 (def, [], []) in
-  let (def, fresh_srcrs2, init) =
-    List.fold_right save_srcrs srcrs2 (def, [], init) in
-  let srcrs1_n = List.length srcrs1 in
-  let srcrs2_n = List.length srcrs2 in
-  let destrs_n = List.length destrs in
-  (* the next must be an invariant *)
-  assert (srcrs1_n = destrs_n && destrs_n = srcrs1_n);
-  (* we pad destrs with itself until we have two times as much
-     registers. The routine should thus handle overflow nicely. *)
-  let all_destrs = MiscPottier.fill destrs (2 * destrs_n) in
-  let init = translate_cst (AST.Cst_int 0) destrs :: init in
-  (* the registries to hold the temporary results of 8-bit mutliplication *)
-  let (def, a) = fresh_reg def in
-  let (def, b) = fresh_reg def in
-  (* when getting the result, this is what is used (padded as necessary) *)
-  let mul_arg k = [RTL.Reg a ; RTL.Reg b] @
-    MiscPottier.make (RTL.Imm 0) (2*destrs_n - k - 2) in
-  (* multiplication between the ith byte of srcrs1 and the jth byte of
-     srcrs2 *)
-  let mul i j =
-    let s1i, s2j = List.nth fresh_srcrs1 i, List.nth fresh_srcrs2 j in
-    (* the position in the result where the resulting bytes must be added *)
-    let k = i + j in
-    let dloc = MiscPottier.sublist all_destrs k (2*destrs_n) in
-    let dloc_arg = List.map (fun r -> RTL.Reg r) dloc in
-    (* we add until the end to propagate the carry bit.
-       At the beginning this will be useless, but we rely on
-       RTL's constant propagation and later dead register elimination
-       to amend that *)
-    [ adds_graph [RTL.St_opaccs (I8051.Mul, a, b, s1i, s2j, start_lbl)] ;
-      translate_op I8051.Add dloc dloc_arg (mul_arg k)] in
-  let insts = List.flatten (List.flatten
-    (MiscPottier.makei (fun i ->
-      MiscPottier.makei (mul i) srcrs2_n) srcrs1_n)) in
-  add_translates (init @ insts) start_lbl dest_lbl def
+  let (def, dummy) = fresh_reg def in
+  let (def, tmpr) = fresh_reg def in
+  let (def, tmp_destrs) = fresh_regs def (List.length destrs) in
+  let (def, fresh_srcrs1) = fresh_regs def (List.length srcrs1) in
+  (* let (def, fresh_srcrs2) = fresh_regs def (List.length srcrs2) in *)
+  let reg r = RTL.Reg r in
+  let insts_init =
+    [translate_move fresh_srcrs1 srcrs1 ;
+     (* translate_move fresh_srcrs2 srcrs2 ; *)
+     translate_cst (AST.Cst_int 0) destrs] in
+  let fresh_srcrs1 = List.map reg fresh_srcrs1 in
+  let f = translate_muli dummy tmpr destrs tmp_destrs fresh_srcrs1 start_lbl in
+  let insts_mul = MiscPottier.foldi f [] srcrs2 in
+  add_translates (insts_init @ insts_mul) start_lbl dest_lbl def
+
 
 let translate_divumodu8 order destrs srcr1 srcr2 start_lbl dest_lbl def =