Skip to content

R
riscv-gcc-1
Commit f8c79ade by Arnaud Charlet
Options

[multiple changes] 

2014-07-29  Olivier Hainque  <hainque@adacore.com>

	* g-debpoo.adb
	(Default_Alignment): Rename as Storage_Alignment. This is not
	a "default" that can be overriden. Augment comment to clarify
	intent and document why we need to manage alignment padding.
	(Header_Offset): Set to Header'Object_Size instead of 'Size
	rounded up to Storage_Alignment. Storage_Alignment on the
	allocation header is not required by our internals so was
	overkill. 'Object_Size is enough to ensure proper alignment
	of the header address when substracted from a storage address
	aligned on Storage_Alignment.
	(Minimum_Allocation): Rename as Extra_Allocation, conveying that
	this is always added on top of the incoming allocation requests.
	(Align): New function, to perform alignment rounding operations.
	(Allocate): Add comments on the Storage_Address computation
	scheme and adjust so that the alignment padding applies to that
	(Storage_Address) only.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Default_Initialize_Object): Remove incorrect
	pragma Unreferenced.
	* cstand.adb (Create_Standard): Use E_Array_Type for standard
	string types. Make sure index of Any_String/Any_Array is in a list.
	* errout.adb: Minor reformatting.

From-SVN: r213169
parent b329a739
Showing with 190 additions and 118 deletions
gcc/ada/ChangeLog
2014-07-29 Olivier Hainque <hainque@adacore.com>
* g-debpoo.adb
(Default_Alignment): Rename as Storage_Alignment. This is not
a "default" that can be overriden. Augment comment to clarify
intent and document why we need to manage alignment padding.
(Header_Offset): Set to Header'Object_Size instead of 'Size
rounded up to Storage_Alignment. Storage_Alignment on the
allocation header is not required by our internals so was
overkill. 'Object_Size is enough to ensure proper alignment
of the header address when substracted from a storage address
aligned on Storage_Alignment.
(Minimum_Allocation): Rename as Extra_Allocation, conveying that
this is always added on top of the incoming allocation requests.
(Align): New function, to perform alignment rounding operations.
(Allocate): Add comments on the Storage_Address computation
scheme and adjust so that the alignment padding applies to that
(Storage_Address) only.
2014-07-29 Robert Dewar <dewar@adacore.com>
* exp_ch3.adb (Default_Initialize_Object): Remove incorrect
pragma Unreferenced.
* cstand.adb (Create_Standard): Use E_Array_Type for standard
string types. Make sure index of Any_String/Any_Array is in a list.
* errout.adb: Minor reformatting.
2014-07-29 Robert Dewar <dewar@adacore.com>
* gnat_ugn.texi: Clean up and correct documentation of warnings.
......
gcc/ada/cstand.adb
......@@ -450,6 +450,9 @@ package body CStand is
-- Creates entities for all predefined floating point types, and
-- adds these to the Predefined_Float_Types list in package Standard.
procedure Make_Dummy_Index (E : Entity_Id);
-- Called to provide a dummy index field value for Any_Array/Any_String
procedure Pack_String_Type (String_Type : Entity_Id);
-- Generate proper tree for pragma Pack that applies to given type, and
-- mark type as having the pragma.
......@@ -554,6 +557,27 @@ package body CStand is
end Create_Float_Types;
----------------------
-- Make_Dummy_Index --
----------------------
procedure Make_Dummy_Index (E : Entity_Id) is
Index : Node_Id;
Dummy : List_Id;
begin
Index :=
Make_Range (Sloc (E),
Low_Bound => Make_Integer (Uint_0),
High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
Set_Etype (Index, Standard_Integer);
Set_First_Index (E, Index);
-- Make sure Index is a list as required, so Next_Index is Empty
Dummy := New_List (Index);
end Make_Dummy_Index;
----------------------
-- Pack_String_Type --
----------------------
......@@ -907,7 +931,7 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
Set_Ekind (Standard_String, E_String_Type);
Set_Ekind (Standard_String, E_Array_Type);
Set_Etype (Standard_String, Standard_String);
Set_Component_Type (Standard_String, Standard_Character);
Set_Component_Size (Standard_String, Uint_8);
......@@ -926,8 +950,8 @@ package body CStand is
-- Set index type of String
E_Id := First
(Subtype_Marks (Type_Definition (Parent (Standard_String))));
E_Id :=
First (Subtype_Marks (Type_Definition (Parent (Standard_String))));
Set_First_Index (Standard_String, E_Id);
Set_Entity (E_Id, Standard_Positive);
Set_Etype (E_Id, Standard_Positive);
......@@ -951,7 +975,7 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
Set_Ekind (Standard_Wide_String, E_String_Type);
Set_Ekind (Standard_Wide_String, E_Array_Type);
Set_Etype (Standard_Wide_String, Standard_Wide_String);
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
Set_Component_Size (Standard_Wide_String, Uint_16);
......@@ -960,8 +984,9 @@ package body CStand is
-- Set index type of Wide_String
E_Id := First
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
E_Id :=
First
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
Set_First_Index (Standard_Wide_String, E_Id);
Set_Entity (E_Id, Standard_Positive);
Set_Etype (E_Id, Standard_Positive);
......@@ -985,7 +1010,7 @@ package body CStand is
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
Set_Ekind (Standard_Wide_Wide_String, E_String_Type);
Set_Ekind (Standard_Wide_Wide_String, E_Array_Type);
Set_Etype (Standard_Wide_Wide_String,
Standard_Wide_Wide_String);
Set_Component_Type (Standard_Wide_Wide_String,
......@@ -997,8 +1022,10 @@ package body CStand is
-- Set index type of Wide_Wide_String
E_Id := First
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));
E_Id :=
First
(Subtype_Marks
(Type_Definition (Parent (Standard_Wide_Wide_String))));
Set_First_Index (Standard_Wide_Wide_String, E_Id);
Set_Entity (E_Id, Standard_Positive);
Set_Etype (E_Id, Standard_Positive);
......@@ -1213,12 +1240,13 @@ package body CStand is
Make_Name (Any_Character, "a character type");
Any_Array := New_Standard_Entity;
Set_Ekind (Any_Array, E_String_Type);
Set_Ekind (Any_Array, E_Array_Type);
Set_Scope (Any_Array, Standard_Standard);
Set_Etype (Any_Array, Any_Array);
Set_Component_Type (Any_Array, Any_Character);
Init_Size_Align (Any_Array);
Make_Name (Any_Array, "an array type");
Make_Dummy_Index (Any_Array);
Any_Boolean := New_Standard_Entity;
Set_Ekind (Any_Boolean, E_Enumeration_Type);
......@@ -1305,24 +1333,13 @@ package body CStand is
Make_Name (Any_Scalar, "a scalar type");
Any_String := New_Standard_Entity;
Set_Ekind (Any_String, E_String_Type);
Set_Ekind (Any_String, E_Array_Type);
Set_Scope (Any_String, Standard_Standard);
Set_Etype (Any_String, Any_String);
Set_Component_Type (Any_String, Any_Character);
Init_Size_Align (Any_String);
Make_Name (Any_String, "a string type");
declare
Index : Node_Id;
begin
Index :=
Make_Range (Stloc,
Low_Bound => Make_Integer (Uint_0),
High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
Set_Etype (Index, Standard_Integer);
Set_First_Index (Any_String, Index);
end;
Make_Dummy_Index (Any_String);
Raise_Type := New_Standard_Entity;
Decl := New_Node (N_Full_Type_Declaration, Stloc);
......
gcc/ada/einfo.adb
......@@ -7185,11 +7185,10 @@ package body Einfo is
function Is_String_Type (Id : E) return B is
begin
return Ekind (Id) in String_Kind
or else (Is_Array_Type (Id)
and then Id /= Any_Composite
and then Number_Dimensions (Id) = 1
and then Is_Character_Type (Component_Type (Id)));
return Is_Array_Type (Id)
and then Id /= Any_Composite
and then Number_Dimensions (Id) = 1
and then Is_Character_Type (Component_Type (Id));
end Is_String_Type;
-------------------------------
......@@ -7555,7 +7554,7 @@ package body Einfo is
T : Node_Id;
begin
if Ekind (Id) in String_Kind then
if Ekind (Id) = E_String_Literal_Subtype then
return 1;
else
......@@ -7563,7 +7562,7 @@ package body Einfo is
T := First_Index (Id);
while Present (T) loop
N := N + 1;
T := Next (T);
Next_Index (T);
end loop;
return N;
......@@ -8050,10 +8049,6 @@ package body Einfo is
E_Record_Subtype =>
Kind := E_Record_Subtype;
when E_String_Type |
E_String_Subtype =>
Kind := E_String_Subtype;
when Enumeration_Kind =>
Kind := E_Enumeration_Subtype;
......
gcc/ada/einfo.ads
......@@ -1245,14 +1245,14 @@ package Einfo is
-- all the extra formals (see description of Extra_Formals field).
-- First_Index (Node17)
-- Defined in array types and subtypes and in string types and subtypes.
-- By introducing implicit subtypes for the index constraints, we have
-- the same structure for constrained and unconstrained arrays, subtype
-- marks and discrete ranges are both represented by a subtype. This
-- function returns the tree node corresponding to an occurrence of the
-- first index (NOT the entity for the type). Subsequent indices are
-- obtained using Next_Index. Note that this field is defined for the
-- case of string literal subtypes, but is always Empty.
-- Defined in array types and subtypes. By introducing implicit subtypes
-- for the index constraints, we have the same structure for constrained
-- and unconstrained arrays, subtype marks and discrete ranges are
-- both represented by a subtype. This function returns the tree node
-- corresponding to an occurrence of the first index (NOT the entity for
-- the type). Subsequent indices are obtained using Next_Index. Note that
-- this field is defined for the case of string literal subtypes, but is
-- always Empty.
-- First_Literal (Node17)
-- Defined in all enumeration types, including character and boolean
......@@ -4519,12 +4519,9 @@ package Einfo is
-- or the use of an anonymous array subtype.
E_String_Type,
-- A string type, i.e. an array type whose component type is a character
-- type, and for which string literals can thus be written.
E_String_Subtype,
-- A string subtype, created by an explicit subtype declaration for a
-- string type, or the use of an anonymous subtype of a string type,
-- These are obsolete and not used any more, they are retained to ease
-- transition in getting rid of these obsolete entries.
E_String_Literal_Subtype,
-- A special string subtype, used only to describe the type of a string
......@@ -4758,8 +4755,6 @@ package Einfo is
subtype Aggregate_Kind is Entity_Kind range
E_Array_Type ..
-- E_Array_Subtype
-- E_String_Type
-- E_String_Subtype
-- E_String_Literal_Subtype
-- E_Class_Wide_Type
-- E_Class_Wide_Subtype
......@@ -4769,8 +4764,6 @@ package Einfo is
subtype Array_Kind is Entity_Kind range
E_Array_Type ..
-- E_Array_Subtype
-- E_String_Type
-- E_String_Subtype
E_String_Literal_Subtype;
subtype Assignable_Kind is Entity_Kind range
......@@ -4785,8 +4778,6 @@ package Einfo is
subtype Composite_Kind is Entity_Kind range
E_Array_Type ..
-- E_Array_Subtype
-- E_String_Type
-- E_String_Subtype
-- E_String_Literal_Subtype
-- E_Class_Wide_Type
-- E_Class_Wide_Subtype
......@@ -5011,11 +5002,6 @@ package Einfo is
-- E_Floating_Point_Type
E_Floating_Point_Subtype;
subtype String_Kind is Entity_Kind range
E_String_Type ..
-- E_String_Subtype
E_String_Literal_Subtype;
subtype Subprogram_Kind is Entity_Kind range
E_Function ..
-- E_Operator
......@@ -5054,8 +5040,6 @@ package Einfo is
-- E_Anonymous_Access_Type
-- E_Array_Type
-- E_Array_Subtype
-- E_String_Type
-- E_String_Subtype
-- E_String_Literal_Subtype
-- E_Class_Wide_Subtype
-- E_Class_Wide_Type
......@@ -6085,18 +6069,6 @@ package Einfo is
-- Type_High_Bound (synth)
-- (plus type attributes)
-- E_String_Type
-- E_String_Subtype
-- First_Index (Node17)
-- Component_Type (Node20) (base type only)
-- Static_Real_Or_String_Predicate (Node25)
-- Is_Constrained (Flag12)
-- SSO_Set_High_By_Default (Flag273) (base type only)
-- SSO_Set_Low_By_Default (Flag272) (base type only)
-- Next_Index (synth)
-- Number_Dimensions (synth)
-- (plus type attributes)
-- E_String_Literal_Subtype
-- String_Literal_Low_Bound (Node15)
-- String_Literal_Length (Uint16)
......
gcc/ada/errout.adb
......@@ -1945,8 +1945,8 @@ package body Errout is
Err_Flag :=
E /= No_Error_Msg
and then Errors.Table (E).Line = N
and then Errors.Table (E).Sfile = Sfile;
and then Errors.Table (E).Line = N
and then Errors.Table (E).Sfile = Sfile;
Output_Source_Line (N, Sfile, Err_Flag);
......
gcc/ada/exp_ch3.adb
......@@ -5043,9 +5043,8 @@ package body Exp_Ch3 is
Obj_Ref : Node_Id;
Dummy : Entity_Id;
pragma Unreferenced (Dummy);
-- This variable captures an unused dummy internal entity, see the
-- comment associated with its use.
-- This variable captures a dummy internal entity, see the comment
-- associated with its use.
-- Start of processing for Default_Initialize_Object
......
gcc/ada/freeze.adb
......@@ -2082,7 +2082,7 @@ package body Freeze is
-- Processing that is done only for base types
if Ekind (Arr) = E_Array_Type then -- what about E_String_Type ???
if Ekind (Arr) = E_Array_Type then
-- Deal with default setting of reverse storage order
......@@ -2231,8 +2231,7 @@ package body Freeze is
if Has_Pragma_Pack (Arr)
and then not Present (Comp_Size_C)
and then
(Csiz = 7 or else Csiz = 15 or else Csiz = 31)
and then (Csiz = 7 or else Csiz = 15 or else Csiz = 31)
and then Esize (Base_Type (Ctyp)) = Csiz + 1
then
Error_Msg_Uint_1 := Csiz;
......@@ -2274,8 +2273,7 @@ package body Freeze is
if Known_Static_Esize (Component_Type (Arr))
and then Esize (Component_Type (Arr)) = Csiz
then
Set_Has_Non_Standard_Rep
(Base_Type (Arr), False);
Set_Has_Non_Standard_Rep (Base_Type (Arr), False);
end if;
-- In all other cases, packing is indeed needed
......
gcc/ada/lib-xref.ads
......@@ -502,14 +502,18 @@ package Lib.Xref is
E_Signed_Integer_Subtype => 'I',
E_Signed_Integer_Type => 'I',
E_String_Literal_Subtype => ' ',
E_String_Subtype => 'S',
E_String_Type => 'S',
E_Subprogram_Type => ' ',
E_Task_Subtype => 'T',
E_Task_Type => 'T',
E_Variable => '*',
E_Void => ' ',
-- These are dummy entries which can be removed when we finally get
-- rid of these obsolete entries once and for all.
E_String_Type => ' ',
E_String_Subtype => ' ',
-- The following entities are not ones to which we gather the cross-
-- references, since it does not make sense to do so (e.g. references to
-- a package are to the spec, not the body) Indeed the occurrence of the
......
gcc/ada/prj-dect.adb
......@@ -1558,7 +1558,6 @@ package body Prj.Dect is
if Token = Tok_Right_Paren then
Scan (In_Tree);
end if;
end Parse_String_Type_Declaration;
--------------------------------
......
gcc/ada/sprint.adb
......@@ -4083,7 +4083,7 @@ package body Sprint is
-- Array types and string types
when E_Array_Type | E_String_Type =>
when E_Array_Type =>
Write_Header;
Write_Str ("array (");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment