From 2884c9d14edd0b821b7bb336cac13b73b547743c Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 26 Apr 2012 09:44:01 +0000 Subject: [PATCH] 2012-04-26 Robert Dewar * sem_util.adb: Minor reformatting. 2012-04-26 Thomas Quinot * 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 * freeze.adb (Freeze_Record_Type): Improve error message for Scalar_Storage_Order inconsistent with Bit_Order. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186865 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 16 ++++++++++++++ gcc/ada/exp_aggr.adb | 33 +++++++++++++++++++++++++++- gcc/ada/exp_pakd.adb | 62 ++++++++++++++++++++++++++++++++++++++-------------- gcc/ada/freeze.adb | 16 ++++++-------- gcc/ada/sem_util.adb | 16 +++++++------- 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 + + * sem_util.adb: Minor reformatting. + +2012-04-26 Thomas Quinot + + * 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 + + * freeze.adb (Freeze_Record_Type): Improve error message for + Scalar_Storage_Order inconsistent with Bit_Order. + 2012-04-25 Gary Dismukes * 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; -- 2.7.4