* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186865
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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
-- 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
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))
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);
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;
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;
-- 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),
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
-- 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);
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;
--------------------------------------
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;
------------------------
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;
projects / platform / upstream / linaro-gcc.git / commitdiff