summaryrefslogtreecommitdiff
path: root/cparser
diff options
context:
space:
mode:
authorGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2013-04-29 07:51:00 +0000
committerGravatar xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>2013-04-29 07:51:00 +0000
commitfbdff974fe7d2040c25dee1d35781f7e70d87d6c (patch)
tree14f112a70481f467e581ca59136eed42601ce725 /cparser
parente1fc4beb37252b6248c0e0ca4cf5ec00a45190bf (diff)
Revert suppression of __builtin_{read,write}_reversed for x86 and ARM,
for compatibility with earlier CompCert versions. But don't use them in PackedStructs. git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2216 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'cparser')
-rw-r--r--cparser/Machine.ml18
-rw-r--r--cparser/Machine.mli1
-rw-r--r--cparser/PackedStructs.ml63
3 files changed, 49 insertions, 33 deletions
diff --git a/cparser/Machine.ml b/cparser/Machine.ml
index 0300582..7696444 100644
--- a/cparser/Machine.ml
+++ b/cparser/Machine.ml
@@ -16,6 +16,7 @@
(* Machine-dependent aspects *)
type t = {
+ name: string;
char_signed: bool;
sizeof_ptr: int;
sizeof_short: int;
@@ -45,6 +46,7 @@ type t = {
}
let ilp32ll64 = {
+ name = "ilp32ll64";
char_signed = false;
sizeof_ptr = 4;
sizeof_short = 2;
@@ -74,6 +76,7 @@ let ilp32ll64 = {
}
let i32lpll64 = {
+ name = "i32lpll64";
char_signed = false;
sizeof_ptr = 8;
sizeof_short = 2;
@@ -103,6 +106,7 @@ let i32lpll64 = {
}
let il32pll64 = {
+ name = "il32pll64";
char_signed = false;
sizeof_ptr = 8;
sizeof_short = 2;
@@ -133,11 +137,15 @@ let il32pll64 = {
(* Canned configurations for some ABIs *)
-let x86_32 = { ilp32ll64 with char_signed = true }
-let x86_64 = { i32lpll64 with char_signed = true }
-let win64 = { il32pll64 with char_signed = true }
-let ppc_32_bigendian = { ilp32ll64 with bigendian = true; bitfields_msb_first = true }
-let arm_littleendian = ilp32ll64
+let x86_32 =
+ { ilp32ll64 with char_signed = true; name = "x86_32" }
+let x86_64 =
+ { i32lpll64 with char_signed = true; name = "x86_64" }
+let win64 =
+ { il32pll64 with char_signed = true; name = "x86_64" }
+let ppc_32_bigendian =
+ { ilp32ll64 with bigendian = true; bitfields_msb_first = true; name = "powerpc" }
+let arm_littleendian = { ilp32ll64 with name = "arm" }
(* Add GCC extensions re: sizeof and alignof *)
diff --git a/cparser/Machine.mli b/cparser/Machine.mli
index 3becce3..b621d4c 100644
--- a/cparser/Machine.mli
+++ b/cparser/Machine.mli
@@ -16,6 +16,7 @@
(* Machine-dependent aspects *)
type t = {
+ name: string;
char_signed: bool;
sizeof_ptr: int;
sizeof_short: int;
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index dbd5160..ebf210b 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -197,25 +197,31 @@ let arrow_packed_field base pf ty =
(* (ty) __builtin_readNN_reversed(&lval)
or (ty) __builtin_bswapNN(lval) *)
+let use_reversed =
+ match !Machine.config.Machine.name with
+ | "powerpc" -> true
+ | _ -> false
+
let bswap_read loc env lval =
let ty = lval.etyp in
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
- 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
+ if use_reversed then begin
+ 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 else begin
+ 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
+ end
with Env.Error msg ->
fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg)
@@ -228,20 +234,21 @@ let bswap_write loc env lhs rhs =
accessor_type loc env ty in
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[]}
- 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)
+ if use_reversed then begin
+ 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 else begin
+ 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)
+ end
with Env.Error msg ->
fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg)