aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-04-26 11:44:01 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-04-26 11:44:01 +0200
commit50cd5b4de92b3c4616e4ee567f7ad7bcec068f18 (patch)
treedb5a7bbfe11d0e117ba306db000ae772a5fbd187
parent851634c76df50c39045cfa3f2aabe02d7ad5203b (diff)
downloadgcc-50cd5b4de92b3c4616e4ee567f7ad7bcec068f18.zip
gcc-50cd5b4de92b3c4616e4ee567f7ad7bcec068f18.tar.gz
gcc-50cd5b4de92b3c4616e4ee567f7ad7bcec068f18.tar.bz2
[multiple changes]
2012-04-26 Robert Dewar <dewar@adacore.com> * sem_util.adb: Minor reformatting. 2012-04-26 Thomas Quinot <quinot@adacore.com> * exp_aggr.adb, exp_pakd.adb (Setup_Inline_Packed_Array_Reference, Packed_Array_Aggregate_Handled.Get_Component_Val): Reverse bit numbering within PAT when Reverse_Storage_Order applies to the enclosing record. 2012-04-26 Thomas Quinot <quinot@adacore.com> * freeze.adb (Freeze_Record_Type): Improve error message for Scalar_Storage_Order inconsistent with Bit_Order. From-SVN: r186865
-rw-r--r--gcc/ada/ChangeLog16
-rw-r--r--gcc/ada/exp_aggr.adb33
-rw-r--r--gcc/ada/exp_pakd.adb62
-rw-r--r--gcc/ada/freeze.adb16
-rw-r--r--gcc/ada/sem_util.adb16
5 files changed, 108 insertions, 35 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 35f8213..53c3818 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2012-04-26 Robert Dewar <dewar@adacore.com>
+
+ * sem_util.adb: Minor reformatting.
+
+2012-04-26 Thomas Quinot <quinot@adacore.com>
+
+ * exp_aggr.adb, exp_pakd.adb (Setup_Inline_Packed_Array_Reference,
+ Packed_Array_Aggregate_Handled.Get_Component_Val):
+ Reverse bit numbering within PAT when Reverse_Storage_Order
+ applies to the enclosing record.
+
+2012-04-26 Thomas Quinot <quinot@adacore.com>
+
+ * freeze.adb (Freeze_Record_Type): Improve error message for
+ Scalar_Storage_Order inconsistent with Bit_Order.
+
2012-04-25 Gary Dismukes <dismukes@adacore.com>
* exp_ch9.adb: Add comments on the usage of the
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 8cfbe3b..39c1019 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6077,12 +6077,43 @@ package body Exp_Aggr is
Expr : Node_Id;
-- Next expression from positional parameters of aggregate
+ Enclosing_Aggregate : Node_Id;
+
+ In_Reverse_Storage_Order_Record : Boolean;
+ -- True if we are within an aggregate of a record type with
+ -- reversed storage order.
+
begin
+ -- Determine whether we are in a reversed storage order record
+ -- aggregate.
+
+ In_Reverse_Storage_Order_Record := False;
+ Enclosing_Aggregate := Parent (N);
+ while Present (Enclosing_Aggregate) loop
+ if Nkind (Enclosing_Aggregate) = N_Component_Association then
+ null;
+
+ elsif Nkind (Enclosing_Aggregate) /= N_Aggregate then
+ exit;
+
+ elsif Is_Record_Type (Etype (Enclosing_Aggregate))
+ and then Reverse_Storage_Order
+ (Etype (Enclosing_Aggregate))
+ then
+ In_Reverse_Storage_Order_Record := True;
+ exit;
+ end if;
+ Enclosing_Aggregate := Parent (Enclosing_Aggregate);
+ end loop;
+
-- For little endian, we fill up the low order bits of the target
-- value. For big endian we fill up the high order bits of the
-- target value (which is a left justified modular value).
- if Bytes_Big_Endian xor Debug_Flag_8 then
+ if Bytes_Big_Endian
+ xor Debug_Flag_8
+ xor In_Reverse_Storage_Order_Record
+ then
Shift := Csiz * (Len - 1);
Incr := -Csiz;
else
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 756a3d1..233ce2f 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -1280,12 +1280,12 @@ package body Exp_Pakd is
-- Initially Rhs is the right hand side value, it will be replaced
-- later by an appropriate unchecked conversion for the assignment.
- Obj : Node_Id;
- Atyp : Entity_Id;
- PAT : Entity_Id;
- Ctyp : Entity_Id;
- Csiz : Int;
- Cmask : Uint;
+ Obj : Node_Id;
+ Atyp : Entity_Id;
+ PAT : Entity_Id;
+ Ctyp : Entity_Id;
+ Csiz : Int;
+ Cmask : Uint;
Shift : Node_Id;
-- The expression for the shift value that is required
@@ -1433,9 +1433,9 @@ package body Exp_Pakd is
Rhs_Val := Expr_Rep_Value (Rhs);
Rhs_Val_Known := True;
- -- The following test catches the case of an unchecked conversion
- -- of an integer literal. This results from optimizing aggregates
- -- of packed types.
+ -- The following test catches the case of an unchecked conversion of
+ -- an integer literal. This results from optimizing aggregates of
+ -- packed types.
elsif Nkind (Rhs) = N_Unchecked_Type_Conversion
and then Compile_Time_Known_Value (Expression (Rhs))
@@ -2619,11 +2619,16 @@ package body Exp_Pakd is
Cmask : out Uint;
Shift : out Node_Id)
is
- Loc : constant Source_Ptr := Sloc (N);
- PAT : Entity_Id;
- Otyp : Entity_Id;
- Csiz : Uint;
- Osiz : Uint;
+ Loc : constant Source_Ptr := Sloc (N);
+ PAT : Entity_Id;
+ Otyp : Entity_Id;
+ Pref : Node_Id;
+ Csiz : Uint;
+ Osiz : Uint;
+
+ In_Reverse_Storage_Order_Record : Boolean;
+ -- Set True if Obj is a [sub]component of a record that has reversed
+ -- scalar storage order.
begin
Csiz := Component_Size (Atyp);
@@ -2658,7 +2663,7 @@ package body Exp_Pakd is
if Csiz /= 1 then
Shift :=
Make_Op_Multiply (Loc,
- Left_Opnd => Make_Integer_Literal (Loc, Csiz),
+ Left_Opnd => Make_Integer_Literal (Loc, Csiz),
Right_Opnd => Shift);
end if;
@@ -2693,7 +2698,7 @@ package body Exp_Pakd is
Prefix => Obj,
Expressions => New_List (
Make_Op_Divide (Loc,
- Left_Opnd => Duplicate_Subexpr (Shift),
+ Left_Opnd => Duplicate_Subexpr (Shift),
Right_Opnd => Make_Integer_Literal (Loc, Osiz))));
Shift := New_Shift;
@@ -2725,7 +2730,30 @@ package body Exp_Pakd is
-- the array used to implement the packed array, F is the number of bits
-- in a source array element, and Shift is the count so far computed.
- if Bytes_Big_Endian then
+ -- We also have to adjust if the storage order is reversed
+
+ Pref := Obj;
+ loop
+ case Nkind (Pref) is
+ when N_Selected_Component =>
+ Pref := Prefix (Pref);
+ exit;
+
+ when N_Indexed_Component =>
+ Pref := Prefix (Pref);
+
+ when others =>
+ Pref := Empty;
+ exit;
+ end case;
+ end loop;
+
+ In_Reverse_Storage_Order_Record :=
+ Present (Pref)
+ and then Is_Record_Type (Etype (Pref))
+ and then Reverse_Storage_Order (Etype (Pref));
+
+ if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record then
Shift :=
Make_Op_Subtract (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Osiz - Csiz),
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 3eae40e..5a7d3b2 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2138,15 +2138,13 @@ package body Freeze is
if Present (ADC)
and then Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
then
- if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
- Error_Msg_N
- ("Scalar_Storage_Order High_Order_First is inconsistent with"
- & " Bit_Order", ADC);
- else
- Error_Msg_N
- ("Scalar_Storage_Order Low_Order_First is inconsistent with"
- & " Bit_Order", ADC);
- end if;
+ -- Note: report error on Rec, not on ADC, as ADC may apply to
+ -- an ancestor type.
+
+ Error_Msg_Sloc := Sloc (ADC);
+ Error_Msg_N
+ ("scalar storage order for& specified# inconsistent with "
+ & "its bit order", Rec);
end if;
-- Deal with Bit_Order aspect specifying a non-default bit order
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d7bafb2..4c37ca1 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -1236,9 +1236,7 @@ package body Sem_Util is
-- Loop through sequence of basic declarative items
Outer : while Present (Decl) loop
- if Nkind (Decl) /= N_Subprogram_Body
- and then Nkind (Decl) /= N_Package_Body
- and then Nkind (Decl) /= N_Task_Body
+ if not Nkind_In (Decl, N_Subprogram_Body, N_Package_Body, N_Task_Body)
and then Nkind (Decl) not in N_Body_Stub
then
Next (Decl);
@@ -3577,15 +3575,15 @@ package body Sem_Util is
Enclosing_Subp : constant Node_Id := Enclosing_Subprogram (Def_Id);
Enclosing_Pack : constant Node_Id := Enclosing_Package (Def_Id);
Other_Scope : constant Node_Id := Enclosing_Dynamic_Scope (C);
- begin
+ begin
-- ... unless the new declaration is in a subprogram, and the
-- visible declaration is a variable declaration or a parameter
-- specification outside that subprogram.
if Present (Enclosing_Subp)
and then Nkind_In (Parent (C), N_Object_Declaration,
- N_Parameter_Specification)
+ N_Parameter_Specification)
and then not Scope_Within_Or_Same (Other_Scope, Enclosing_Subp)
then
null;
@@ -7595,13 +7593,13 @@ package body Sem_Util is
--------------------------------------
function Is_Internally_Generated_Renaming (N : Node_Id) return Boolean is
- P : Node_Id := N;
+ P : Node_Id;
begin
+ P := N;
while Present (P) loop
if Nkind (P) = N_Object_Renaming_Declaration then
return not Comes_From_Source (P);
-
elsif Is_List_Member (P) then
return False;
end if;
@@ -11659,9 +11657,11 @@ package body Sem_Util is
------------------------
function Proper_First_Index (Array_Typ : Entity_Id) return Entity_Id is
- Typ : Entity_Id := Array_Typ;
+ Typ : Entity_Id;
begin
+ Typ := Array_Typ;
+
if Ekind (Typ) = E_String_Literal_Subtype then
Typ := Base_Type (Typ);
end if;