From 468f0c4407895557ca8089430f894a85f06afe97 Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Sat, 20 Apr 2013 17:46:58 +0000
Subject: Add __builtin_bswap16 and __builtin_bswap32 to all ports. Remove
 __builtin_{read,write}_reversed from IA32 and ARM ports. Machregs: tighten
 destroyed_by_builtin Packedstructs: use bswap if read/write-reversed not
 available.

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2208 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 cparser/PackedStructs.ml | 50 +++++++++++++++++++++++++++++++++---------------
 1 file changed, 35 insertions(+), 15 deletions(-)

(limited to 'cparser')

diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index b1af7f6..dbd5160 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -59,7 +59,7 @@ let align x boundary =
 
 let rec can_byte_swap env ty =
   match unroll env ty with
-  | TInt(ik, _) -> (true, sizeof_ikind ik > 1)
+  | TInt(ik, _) -> (sizeof_ikind ik <= 4, sizeof_ikind ik > 1)
   | TEnum(_, _) -> (true, sizeof_ikind enum_ikind > 1)
   | TPtr(_, _) -> (true, true)          (* tolerance? *)
   | TArray(ty_elt, _, _) -> can_byte_swap env ty_elt
@@ -151,12 +151,9 @@ let transf_composite loc env su id attrs ml =
 (* Accessor functions *)
 
 let lookup_function loc env name =
-  try
-    match Env.lookup_ident env name with
-    | (id, II_ident(sto, ty)) -> (id, ty)
-    | (id, II_enum _) -> raise (Env.Error(Env.Unbound_identifier name))
-  with Env.Error msg ->
-    fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg)
+  match Env.lookup_ident env name with
+  | (id, II_ident(sto, ty)) -> (id, ty)
+  | (id, II_enum _) -> raise (Env.Error(Env.Unbound_identifier name))
 
 (* Type for the access *)
 
@@ -197,33 +194,56 @@ let arrow_packed_field base pf ty =
      etyp = TArray(TInt(IChar,[]),None,[]) } in
   ederef ty (ecast (TPtr(ty, [])) (eoffset payload pf.fi_offset))
 
-(*  (ty) __builtin_read_NN_reversed(&lval)  *)
+(*  (ty) __builtin_readNN_reversed(&lval)
+ or (ty) __builtin_bswapNN(lval) *)
+
 let bswap_read loc env lval =
   let ty = lval.etyp in
-  let (bsize, aty) =
-    accessor_type loc env ty in
-  if bsize = 8 then lval else begin
+  let (bsize, aty) = accessor_type loc env ty in
+  assert (bsize = 16 || bsize = 32);
+  try
     let (id, fty) =
       lookup_function loc env (sprintf "__builtin_read%d_reversed" bsize) in
     let fn = {edesc = EVar id; etyp = fty} in
     let args = [ecast_opt env (TPtr(aty,[])) (eaddrof lval)] in
     let call = {edesc = ECall(fn, args); etyp = aty} in
     ecast_opt env ty call
-  end
+  with Env.Error _ ->
+  try
+    let (id, fty) =
+      lookup_function loc env (sprintf "__builtin_bswap%d" bsize) in
+    let fn = {edesc = EVar id; etyp = fty} in
+    let args = [ecast_opt env aty lval] in
+    let call = {edesc = ECall(fn, args); etyp = aty} in
+    ecast_opt env ty call
+  with Env.Error msg ->
+    fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg)
+
+(*  __builtin_write_intNN_reversed(&lhs,rhs)
+  or  lhs = __builtin_bswapNN(rhs) *)
 
-(*  __builtin_write_intNN_reversed(&lhs,rhs)  *)
 let bswap_write loc env lhs rhs =
   let ty = lhs.etyp in
   let (bsize, aty) =
     accessor_type loc env ty in
-  if bsize = 8 then eassign lhs rhs else begin
+  assert (bsize = 16 || bsize = 32);
+  try
     let (id, fty) =
       lookup_function loc env (sprintf "__builtin_write%d_reversed" bsize) in
     let fn = {edesc = EVar id; etyp = fty} in
     let args = [ecast_opt env (TPtr(aty,[])) (eaddrof lhs); 
                 ecast_opt env aty rhs] in
     {edesc = ECall(fn, args); etyp = TVoid[]}
-  end
+  with Env.Error _ ->
+  try
+    let (id, fty) =
+      lookup_function loc env (sprintf "__builtin_bswap%d" bsize) in
+    let fn = {edesc = EVar id; etyp = fty} in
+    let args = [ecast_opt env aty rhs] in
+    let call = {edesc = ECall(fn, args); etyp = aty} in
+    eassign lhs (ecast_opt env ty call)
+  with Env.Error msg ->
+    fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg)
 
 (* Expressions *)
 
-- 
cgit v1.2.3