From 4dc3b96bfb6f807349ad67c062bf9f154e80b3a7 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.org>
Date: Tue, 6 Aug 2013 16:00:55 +0200
Subject: [PATCH] atomic 32 bit load

---
 asmcomp/cmmgen.ml | 72 ++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 58 insertions(+), 14 deletions(-)

diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index 23d4798..e66c663 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -697,24 +697,68 @@ let unaligned_set_16 ptr idx newval =
         Cop(Cstore Byte_unsigned,
             [add_int (add_int ptr idx) (Cconst_int 1); b2]))

+let rec is_aligned n = function
+  | Cconst_int i -> i mod n = 0
+  | Cop((Cand | Cmuli), [arg1; arg2]) ->
+    is_aligned n arg1 || is_aligned n arg2
+  | Cop(Clsl, [arg1; Cconst_int n]) ->
+    is_aligned n arg1 || n >= Misc.log2 n
+  | _ -> false
+
 let unaligned_load_32 ptr idx =
-  if Arch.allow_unaligned_access
+  if Arch.allow_unaligned_access || is_aligned 4 idx
+  (* ptr is assumed to be aligned *)
   then Cop(Cload Thirtytwo_unsigned, [add_int ptr idx])
   else
-    let v1 = Cop(Cload Byte_unsigned, [add_int ptr idx]) in
-    let v2 = Cop(Cload Byte_unsigned,
-                 [add_int (add_int ptr idx) (Cconst_int 1)]) in
-    let v3 = Cop(Cload Byte_unsigned,
-                 [add_int (add_int ptr idx) (Cconst_int 2)]) in
-    let v4 = Cop(Cload Byte_unsigned,
-                 [add_int (add_int ptr idx) (Cconst_int 3)]) in
-    let b1, b2, b3, b4 =
+
+    (* if the architecture does not accept unaligned access, we
+       still enforce atomic loads when the address is effectively
+       aligned by loading the whole value on one read. The effect
+       is moraly
+
+       let load addr =
+       if addr mod 4 = 0
+       then Cload addr
+       else
+         let addr1 = addr - (addr mod 4) in
+         let addr2 = addr1 + 4 in
+         let v1 = Cload addr1 in
+         let v2 = Cload addr2 in
+         if big_endian
+         then v1 lsl ((addr mod 4) * 8) || v2 lsr ((4 - (addr mod 4)) * 8)
+         else v1 lsr ((addr mod 4) * 8) || v2 lsl ((4 - (addr mod 4)) * 8)
+
+       but to avoid conditionnal branch, when (addr mod 4 = 0) we in fact
+       set addr2 = addr1 (to avoid potential segmentation fault) *)
+
+    bind "base_addr" (add_int ptr idx) (fun base_addr ->
+    bind "addr1" (lsl_int (lsr_int base_addr (Cconst_int 2)) (Cconst_int 2))
+    (fun addr1 -> (* base_addr - (base_addr mod 4) *)
+    bind "addr2" (lsl_int (incr_int (lsr_int (decr_int base_addr)
+                                       (Cconst_int 2))) (Cconst_int 2))
+    (fun addr2 -> (* if base_addr mod 4 = 0
+                  then base_addr
+                  else v
+                    such that v mod 4 = 0 and v > base_addr
+                    and v - base_addr < 4 *)
+
+    let v1 = Cop(Cload Thirtytwo_unsigned, [addr1]) in
+    let v2 = Cop(Cload Thirtytwo_unsigned, [addr2]) in
+    bind "mod_time_8" (lsl_int (Cop(Cand, [base_addr; Cconst_int 3]))
+                               (Cconst_int 3))
+    (fun mod_time_8 -> (* (base_addr mod 4) * 8 *)
+    let shift1 = mod_time_8 in
+    let shift2 = sub_int (Cconst_int 32) mod_time_8 in
+
+    let v1', v2' =
       if Arch.big_endian
-      then v1, v2, v3, v4
-      else v4, v3, v2, v1 in
-    Cop(Cor,
-        [Cop(Cor, [lsl_int b1 (Cconst_int 24); lsl_int b2 (Cconst_int 16)]);
-         Cop(Cor, [lsl_int b3 (Cconst_int 8); b4])])
+      then lsl_int v1 shift1, lsr_int v2 shift2
+      else lsr_int v1 shift1, lsl_int v2 shift2 in
+
+    let res = Cop(Cor, [v1'; v2']) in
+    if Arch.size_int = 8
+    then Cop(Cand, [res; Cconst_int 0xFF_FF_FF_FF])
+    else res))))

 let unaligned_set_32 ptr idx newval =
   if Arch.allow_unaligned_access
--
1.8.4.rc1