[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
This commit is contained in:
parent
b329a739f8
commit
f8c79ade9e
|
@ -1,3 +1,30 @@
|
||||||
|
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>
|
2014-07-29 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* gnat_ugn.texi: Clean up and correct documentation of warnings.
|
* gnat_ugn.texi: Clean up and correct documentation of warnings.
|
||||||
|
|
|
@ -450,6 +450,9 @@ package body CStand is
|
||||||
-- Creates entities for all predefined floating point types, and
|
-- Creates entities for all predefined floating point types, and
|
||||||
-- adds these to the Predefined_Float_Types list in package Standard.
|
-- 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);
|
procedure Pack_String_Type (String_Type : Entity_Id);
|
||||||
-- Generate proper tree for pragma Pack that applies to given type, and
|
-- Generate proper tree for pragma Pack that applies to given type, and
|
||||||
-- mark type as having the pragma.
|
-- mark type as having the pragma.
|
||||||
|
@ -553,6 +556,27 @@ package body CStand is
|
||||||
end loop;
|
end loop;
|
||||||
end Create_Float_Types;
|
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 --
|
-- Pack_String_Type --
|
||||||
----------------------
|
----------------------
|
||||||
|
@ -907,7 +931,7 @@ package body CStand is
|
||||||
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
||||||
Set_Type_Definition (Parent (Standard_String), 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_Etype (Standard_String, Standard_String);
|
||||||
Set_Component_Type (Standard_String, Standard_Character);
|
Set_Component_Type (Standard_String, Standard_Character);
|
||||||
Set_Component_Size (Standard_String, Uint_8);
|
Set_Component_Size (Standard_String, Uint_8);
|
||||||
|
@ -926,8 +950,8 @@ package body CStand is
|
||||||
|
|
||||||
-- Set index type of String
|
-- Set index type of String
|
||||||
|
|
||||||
E_Id := First
|
E_Id :=
|
||||||
(Subtype_Marks (Type_Definition (Parent (Standard_String))));
|
First (Subtype_Marks (Type_Definition (Parent (Standard_String))));
|
||||||
Set_First_Index (Standard_String, E_Id);
|
Set_First_Index (Standard_String, E_Id);
|
||||||
Set_Entity (E_Id, Standard_Positive);
|
Set_Entity (E_Id, Standard_Positive);
|
||||||
Set_Etype (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));
|
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
||||||
Set_Type_Definition (Parent (Standard_Wide_String), 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_Etype (Standard_Wide_String, Standard_Wide_String);
|
||||||
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
|
Set_Component_Type (Standard_Wide_String, Standard_Wide_Character);
|
||||||
Set_Component_Size (Standard_Wide_String, Uint_16);
|
Set_Component_Size (Standard_Wide_String, Uint_16);
|
||||||
|
@ -960,7 +984,8 @@ package body CStand is
|
||||||
|
|
||||||
-- Set index type of Wide_String
|
-- Set index type of Wide_String
|
||||||
|
|
||||||
E_Id := First
|
E_Id :=
|
||||||
|
First
|
||||||
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
|
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
|
||||||
Set_First_Index (Standard_Wide_String, E_Id);
|
Set_First_Index (Standard_Wide_String, E_Id);
|
||||||
Set_Entity (E_Id, Standard_Positive);
|
Set_Entity (E_Id, Standard_Positive);
|
||||||
|
@ -985,7 +1010,7 @@ package body CStand is
|
||||||
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
|
||||||
Set_Type_Definition (Parent (Standard_Wide_Wide_String), 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,
|
Set_Etype (Standard_Wide_Wide_String,
|
||||||
Standard_Wide_Wide_String);
|
Standard_Wide_Wide_String);
|
||||||
Set_Component_Type (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
|
-- Set index type of Wide_Wide_String
|
||||||
|
|
||||||
E_Id := First
|
E_Id :=
|
||||||
(Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));
|
First
|
||||||
|
(Subtype_Marks
|
||||||
|
(Type_Definition (Parent (Standard_Wide_Wide_String))));
|
||||||
Set_First_Index (Standard_Wide_Wide_String, E_Id);
|
Set_First_Index (Standard_Wide_Wide_String, E_Id);
|
||||||
Set_Entity (E_Id, Standard_Positive);
|
Set_Entity (E_Id, Standard_Positive);
|
||||||
Set_Etype (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");
|
Make_Name (Any_Character, "a character type");
|
||||||
|
|
||||||
Any_Array := New_Standard_Entity;
|
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_Scope (Any_Array, Standard_Standard);
|
||||||
Set_Etype (Any_Array, Any_Array);
|
Set_Etype (Any_Array, Any_Array);
|
||||||
Set_Component_Type (Any_Array, Any_Character);
|
Set_Component_Type (Any_Array, Any_Character);
|
||||||
Init_Size_Align (Any_Array);
|
Init_Size_Align (Any_Array);
|
||||||
Make_Name (Any_Array, "an array type");
|
Make_Name (Any_Array, "an array type");
|
||||||
|
Make_Dummy_Index (Any_Array);
|
||||||
|
|
||||||
Any_Boolean := New_Standard_Entity;
|
Any_Boolean := New_Standard_Entity;
|
||||||
Set_Ekind (Any_Boolean, E_Enumeration_Type);
|
Set_Ekind (Any_Boolean, E_Enumeration_Type);
|
||||||
|
@ -1305,24 +1333,13 @@ package body CStand is
|
||||||
Make_Name (Any_Scalar, "a scalar type");
|
Make_Name (Any_Scalar, "a scalar type");
|
||||||
|
|
||||||
Any_String := New_Standard_Entity;
|
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_Scope (Any_String, Standard_Standard);
|
||||||
Set_Etype (Any_String, Any_String);
|
Set_Etype (Any_String, Any_String);
|
||||||
Set_Component_Type (Any_String, Any_Character);
|
Set_Component_Type (Any_String, Any_Character);
|
||||||
Init_Size_Align (Any_String);
|
Init_Size_Align (Any_String);
|
||||||
Make_Name (Any_String, "a string type");
|
Make_Name (Any_String, "a string type");
|
||||||
|
Make_Dummy_Index (Any_String);
|
||||||
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;
|
|
||||||
|
|
||||||
Raise_Type := New_Standard_Entity;
|
Raise_Type := New_Standard_Entity;
|
||||||
Decl := New_Node (N_Full_Type_Declaration, Stloc);
|
Decl := New_Node (N_Full_Type_Declaration, Stloc);
|
||||||
|
|
|
@ -7185,11 +7185,10 @@ package body Einfo is
|
||||||
|
|
||||||
function Is_String_Type (Id : E) return B is
|
function Is_String_Type (Id : E) return B is
|
||||||
begin
|
begin
|
||||||
return Ekind (Id) in String_Kind
|
return Is_Array_Type (Id)
|
||||||
or else (Is_Array_Type (Id)
|
|
||||||
and then Id /= Any_Composite
|
and then Id /= Any_Composite
|
||||||
and then Number_Dimensions (Id) = 1
|
and then Number_Dimensions (Id) = 1
|
||||||
and then Is_Character_Type (Component_Type (Id)));
|
and then Is_Character_Type (Component_Type (Id));
|
||||||
end Is_String_Type;
|
end Is_String_Type;
|
||||||
|
|
||||||
-------------------------------
|
-------------------------------
|
||||||
|
@ -7555,7 +7554,7 @@ package body Einfo is
|
||||||
T : Node_Id;
|
T : Node_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Ekind (Id) in String_Kind then
|
if Ekind (Id) = E_String_Literal_Subtype then
|
||||||
return 1;
|
return 1;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
@ -7563,7 +7562,7 @@ package body Einfo is
|
||||||
T := First_Index (Id);
|
T := First_Index (Id);
|
||||||
while Present (T) loop
|
while Present (T) loop
|
||||||
N := N + 1;
|
N := N + 1;
|
||||||
T := Next (T);
|
Next_Index (T);
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
return N;
|
return N;
|
||||||
|
@ -8050,10 +8049,6 @@ package body Einfo is
|
||||||
E_Record_Subtype =>
|
E_Record_Subtype =>
|
||||||
Kind := E_Record_Subtype;
|
Kind := E_Record_Subtype;
|
||||||
|
|
||||||
when E_String_Type |
|
|
||||||
E_String_Subtype =>
|
|
||||||
Kind := E_String_Subtype;
|
|
||||||
|
|
||||||
when Enumeration_Kind =>
|
when Enumeration_Kind =>
|
||||||
Kind := E_Enumeration_Subtype;
|
Kind := E_Enumeration_Subtype;
|
||||||
|
|
||||||
|
|
|
@ -1245,14 +1245,14 @@ package Einfo is
|
||||||
-- all the extra formals (see description of Extra_Formals field).
|
-- all the extra formals (see description of Extra_Formals field).
|
||||||
|
|
||||||
-- First_Index (Node17)
|
-- First_Index (Node17)
|
||||||
-- Defined in array types and subtypes and in string types and subtypes.
|
-- Defined in array types and subtypes. By introducing implicit subtypes
|
||||||
-- By introducing implicit subtypes for the index constraints, we have
|
-- for the index constraints, we have the same structure for constrained
|
||||||
-- the same structure for constrained and unconstrained arrays, subtype
|
-- and unconstrained arrays, subtype marks and discrete ranges are
|
||||||
-- marks and discrete ranges are both represented by a subtype. This
|
-- both represented by a subtype. This function returns the tree node
|
||||||
-- function returns the tree node corresponding to an occurrence of the
|
-- corresponding to an occurrence of the first index (NOT the entity for
|
||||||
-- first index (NOT the entity for the type). Subsequent indices are
|
-- the type). Subsequent indices are obtained using Next_Index. Note that
|
||||||
-- obtained using Next_Index. Note that this field is defined for the
|
-- this field is defined for the case of string literal subtypes, but is
|
||||||
-- case of string literal subtypes, but is always Empty.
|
-- always Empty.
|
||||||
|
|
||||||
-- First_Literal (Node17)
|
-- First_Literal (Node17)
|
||||||
-- Defined in all enumeration types, including character and boolean
|
-- Defined in all enumeration types, including character and boolean
|
||||||
|
@ -4519,12 +4519,9 @@ package Einfo is
|
||||||
-- or the use of an anonymous array subtype.
|
-- or the use of an anonymous array subtype.
|
||||||
|
|
||||||
E_String_Type,
|
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,
|
E_String_Subtype,
|
||||||
-- A string subtype, created by an explicit subtype declaration for a
|
-- These are obsolete and not used any more, they are retained to ease
|
||||||
-- string type, or the use of an anonymous subtype of a string type,
|
-- transition in getting rid of these obsolete entries.
|
||||||
|
|
||||||
E_String_Literal_Subtype,
|
E_String_Literal_Subtype,
|
||||||
-- A special string subtype, used only to describe the type of a string
|
-- 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
|
subtype Aggregate_Kind is Entity_Kind range
|
||||||
E_Array_Type ..
|
E_Array_Type ..
|
||||||
-- E_Array_Subtype
|
-- E_Array_Subtype
|
||||||
-- E_String_Type
|
|
||||||
-- E_String_Subtype
|
|
||||||
-- E_String_Literal_Subtype
|
-- E_String_Literal_Subtype
|
||||||
-- E_Class_Wide_Type
|
-- E_Class_Wide_Type
|
||||||
-- E_Class_Wide_Subtype
|
-- E_Class_Wide_Subtype
|
||||||
|
@ -4769,8 +4764,6 @@ package Einfo is
|
||||||
subtype Array_Kind is Entity_Kind range
|
subtype Array_Kind is Entity_Kind range
|
||||||
E_Array_Type ..
|
E_Array_Type ..
|
||||||
-- E_Array_Subtype
|
-- E_Array_Subtype
|
||||||
-- E_String_Type
|
|
||||||
-- E_String_Subtype
|
|
||||||
E_String_Literal_Subtype;
|
E_String_Literal_Subtype;
|
||||||
|
|
||||||
subtype Assignable_Kind is Entity_Kind range
|
subtype Assignable_Kind is Entity_Kind range
|
||||||
|
@ -4785,8 +4778,6 @@ package Einfo is
|
||||||
subtype Composite_Kind is Entity_Kind range
|
subtype Composite_Kind is Entity_Kind range
|
||||||
E_Array_Type ..
|
E_Array_Type ..
|
||||||
-- E_Array_Subtype
|
-- E_Array_Subtype
|
||||||
-- E_String_Type
|
|
||||||
-- E_String_Subtype
|
|
||||||
-- E_String_Literal_Subtype
|
-- E_String_Literal_Subtype
|
||||||
-- E_Class_Wide_Type
|
-- E_Class_Wide_Type
|
||||||
-- E_Class_Wide_Subtype
|
-- E_Class_Wide_Subtype
|
||||||
|
@ -5011,11 +5002,6 @@ package Einfo is
|
||||||
-- E_Floating_Point_Type
|
-- E_Floating_Point_Type
|
||||||
E_Floating_Point_Subtype;
|
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
|
subtype Subprogram_Kind is Entity_Kind range
|
||||||
E_Function ..
|
E_Function ..
|
||||||
-- E_Operator
|
-- E_Operator
|
||||||
|
@ -5054,8 +5040,6 @@ package Einfo is
|
||||||
-- E_Anonymous_Access_Type
|
-- E_Anonymous_Access_Type
|
||||||
-- E_Array_Type
|
-- E_Array_Type
|
||||||
-- E_Array_Subtype
|
-- E_Array_Subtype
|
||||||
-- E_String_Type
|
|
||||||
-- E_String_Subtype
|
|
||||||
-- E_String_Literal_Subtype
|
-- E_String_Literal_Subtype
|
||||||
-- E_Class_Wide_Subtype
|
-- E_Class_Wide_Subtype
|
||||||
-- E_Class_Wide_Type
|
-- E_Class_Wide_Type
|
||||||
|
@ -6085,18 +6069,6 @@ package Einfo is
|
||||||
-- Type_High_Bound (synth)
|
-- Type_High_Bound (synth)
|
||||||
-- (plus type attributes)
|
-- (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
|
-- E_String_Literal_Subtype
|
||||||
-- String_Literal_Low_Bound (Node15)
|
-- String_Literal_Low_Bound (Node15)
|
||||||
-- String_Literal_Length (Uint16)
|
-- String_Literal_Length (Uint16)
|
||||||
|
|
|
@ -5043,9 +5043,8 @@ package body Exp_Ch3 is
|
||||||
Obj_Ref : Node_Id;
|
Obj_Ref : Node_Id;
|
||||||
|
|
||||||
Dummy : Entity_Id;
|
Dummy : Entity_Id;
|
||||||
pragma Unreferenced (Dummy);
|
-- This variable captures a dummy internal entity, see the comment
|
||||||
-- This variable captures an unused dummy internal entity, see the
|
-- associated with its use.
|
||||||
-- comment associated with its use.
|
|
||||||
|
|
||||||
-- Start of processing for Default_Initialize_Object
|
-- Start of processing for Default_Initialize_Object
|
||||||
|
|
||||||
|
|
|
@ -2082,7 +2082,7 @@ package body Freeze is
|
||||||
|
|
||||||
-- Processing that is done only for base types
|
-- 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
|
-- Deal with default setting of reverse storage order
|
||||||
|
|
||||||
|
@ -2231,8 +2231,7 @@ package body Freeze is
|
||||||
|
|
||||||
if Has_Pragma_Pack (Arr)
|
if Has_Pragma_Pack (Arr)
|
||||||
and then not Present (Comp_Size_C)
|
and then not Present (Comp_Size_C)
|
||||||
and then
|
and then (Csiz = 7 or else Csiz = 15 or else Csiz = 31)
|
||||||
(Csiz = 7 or else Csiz = 15 or else Csiz = 31)
|
|
||||||
and then Esize (Base_Type (Ctyp)) = Csiz + 1
|
and then Esize (Base_Type (Ctyp)) = Csiz + 1
|
||||||
then
|
then
|
||||||
Error_Msg_Uint_1 := Csiz;
|
Error_Msg_Uint_1 := Csiz;
|
||||||
|
@ -2274,8 +2273,7 @@ package body Freeze is
|
||||||
if Known_Static_Esize (Component_Type (Arr))
|
if Known_Static_Esize (Component_Type (Arr))
|
||||||
and then Esize (Component_Type (Arr)) = Csiz
|
and then Esize (Component_Type (Arr)) = Csiz
|
||||||
then
|
then
|
||||||
Set_Has_Non_Standard_Rep
|
Set_Has_Non_Standard_Rep (Base_Type (Arr), False);
|
||||||
(Base_Type (Arr), False);
|
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- In all other cases, packing is indeed needed
|
-- In all other cases, packing is indeed needed
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
|
-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -45,11 +45,39 @@ with Ada.Unchecked_Conversion;
|
||||||
|
|
||||||
package body GNAT.Debug_Pools is
|
package body GNAT.Debug_Pools is
|
||||||
|
|
||||||
Default_Alignment : constant := Standard'Maximum_Alignment;
|
Storage_Alignment : constant := Standard'Maximum_Alignment;
|
||||||
-- Alignment used for the memory chunks returned by Allocate. Using this
|
-- Alignment enforced for all the memory chunks returned by Allocate,
|
||||||
-- value guarantees that this alignment will be compatible with all types
|
-- maximized to make sure that it will be compatible with all types.
|
||||||
-- and at the same time makes it easy to find the location of the extra
|
--
|
||||||
-- header allocated for each chunk.
|
-- The addresses returned by the underlying low-level allocator (be it
|
||||||
|
-- 'new' or a straight 'malloc') aren't guaranteed to be that much aligned
|
||||||
|
-- on some targets, so we manage the needed alignment padding ourselves
|
||||||
|
-- systematically. Use of a common value for every allocation allows
|
||||||
|
-- significant simplifications in the code, nevertheless, for improved
|
||||||
|
-- robustness and efficiency overall.
|
||||||
|
|
||||||
|
-- We combine a few internal devices to offer the pool services:
|
||||||
|
--
|
||||||
|
-- * A management header attached to each allocated memory block, located
|
||||||
|
-- right ahead of it, like so:
|
||||||
|
--
|
||||||
|
-- Storage Address returned by the pool,
|
||||||
|
-- aligned on Storage_Alignment
|
||||||
|
-- v
|
||||||
|
-- +------+--------+---------------------
|
||||||
|
-- | ~~~~ | HEADER | USER DATA ... |
|
||||||
|
-- +------+--------+---------------------
|
||||||
|
-- <---->
|
||||||
|
-- alignment
|
||||||
|
-- padding
|
||||||
|
--
|
||||||
|
-- The alignment padding is required
|
||||||
|
--
|
||||||
|
-- * A validity bitmap, which holds a validity bit for blocks managed by
|
||||||
|
-- the pool. Enforcing Storage_Alignment on those blocks allows efficient
|
||||||
|
-- validity management.
|
||||||
|
--
|
||||||
|
-- * A list of currently used blocks.
|
||||||
|
|
||||||
Max_Ignored_Levels : constant Natural := 10;
|
Max_Ignored_Levels : constant Natural := 10;
|
||||||
-- Maximum number of levels that will be ignored in backtraces. This is so
|
-- Maximum number of levels that will be ignored in backtraces. This is so
|
||||||
|
@ -192,20 +220,26 @@ package body GNAT.Debug_Pools is
|
||||||
(Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address);
|
(Traceback_Htable_Elem_Ptr, Traceback_Ptr_Or_Address);
|
||||||
|
|
||||||
Header_Offset : constant Storage_Count :=
|
Header_Offset : constant Storage_Count :=
|
||||||
Default_Alignment *
|
(Allocation_Header'Object_Size / System.Storage_Unit);
|
||||||
((Allocation_Header'Size / System.Storage_Unit
|
-- Offset, in bytes, from start of allocation Header to start of User
|
||||||
+ Default_Alignment - 1) / Default_Alignment);
|
-- data. The start of user data is assumed to be aligned at least as much
|
||||||
-- Offset of user data after allocation header
|
-- as what the header type requires, so applying this offset yields a
|
||||||
|
-- suitably aligned address as well.
|
||||||
|
|
||||||
Minimum_Allocation : constant Storage_Count :=
|
Extra_Allocation : constant Storage_Count :=
|
||||||
Default_Alignment - 1 + Header_Offset;
|
(Storage_Alignment - 1 + Header_Offset);
|
||||||
-- Minimal allocation: size of allocation_header rounded up to next
|
-- Amount we need to secure in addition to the user data for a given
|
||||||
-- multiple of default alignment + worst-case padding.
|
-- allocation request: room for the allocation header plus worst-case
|
||||||
|
-- alignment padding.
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
-- Local subprograms --
|
-- Local subprograms --
|
||||||
-----------------------
|
-----------------------
|
||||||
|
|
||||||
|
function Align (Addr : Integer_Address) return Integer_Address;
|
||||||
|
pragma Inline (Align);
|
||||||
|
-- Return the next address aligned on Storage_Alignment from Addr.
|
||||||
|
|
||||||
function Find_Or_Create_Traceback
|
function Find_Or_Create_Traceback
|
||||||
(Pool : Debug_Pool;
|
(Pool : Debug_Pool;
|
||||||
Kind : Traceback_Kind;
|
Kind : Traceback_Kind;
|
||||||
|
@ -289,6 +323,16 @@ package body GNAT.Debug_Pools is
|
||||||
-- addresses internal to this package). Depth is the number of levels that
|
-- addresses internal to this package). Depth is the number of levels that
|
||||||
-- the user is interested in.
|
-- the user is interested in.
|
||||||
|
|
||||||
|
-----------
|
||||||
|
-- Align --
|
||||||
|
-----------
|
||||||
|
|
||||||
|
function Align (Addr : Integer_Address) return Integer_Address is
|
||||||
|
Factor : constant Integer_Address := Storage_Alignment;
|
||||||
|
begin
|
||||||
|
return ((Addr + Factor - 1) / Factor) * Factor;
|
||||||
|
end Align;
|
||||||
|
|
||||||
---------------
|
---------------
|
||||||
-- Header_Of --
|
-- Header_Of --
|
||||||
---------------
|
---------------
|
||||||
|
@ -522,7 +566,7 @@ package body GNAT.Debug_Pools is
|
||||||
-- that two chunk of allocated data are very far from each other.
|
-- that two chunk of allocated data are very far from each other.
|
||||||
|
|
||||||
Memory_Chunk_Size : constant Integer_Address := 2 ** 24; -- 16 MB
|
Memory_Chunk_Size : constant Integer_Address := 2 ** 24; -- 16 MB
|
||||||
Validity_Divisor : constant := Default_Alignment * System.Storage_Unit;
|
Validity_Divisor : constant := Storage_Alignment * System.Storage_Unit;
|
||||||
|
|
||||||
Max_Validity_Byte_Index : constant :=
|
Max_Validity_Byte_Index : constant :=
|
||||||
Memory_Chunk_Size / Validity_Divisor;
|
Memory_Chunk_Size / Validity_Divisor;
|
||||||
|
@ -575,12 +619,12 @@ package body GNAT.Debug_Pools is
|
||||||
Int_Storage : constant Integer_Address := To_Integer (Storage);
|
Int_Storage : constant Integer_Address := To_Integer (Storage);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- The pool only returns addresses aligned on Default_Alignment so
|
-- The pool only returns addresses aligned on Storage_Alignment so
|
||||||
-- anything off cannot be a valid block address and we can return
|
-- anything off cannot be a valid block address and we can return
|
||||||
-- early in this case. We actually have to since our data structures
|
-- early in this case. We actually have to since our data structures
|
||||||
-- map validity bits for such aligned addresses only.
|
-- map validity bits for such aligned addresses only.
|
||||||
|
|
||||||
if Int_Storage mod Default_Alignment /= 0 then
|
if Int_Storage mod Storage_Alignment /= 0 then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
@ -592,7 +636,7 @@ package body GNAT.Debug_Pools is
|
||||||
Offset : constant Integer_Address :=
|
Offset : constant Integer_Address :=
|
||||||
(Int_Storage -
|
(Int_Storage -
|
||||||
(Block_Number * Memory_Chunk_Size)) /
|
(Block_Number * Memory_Chunk_Size)) /
|
||||||
Default_Alignment;
|
Storage_Alignment;
|
||||||
Bit : constant Byte :=
|
Bit : constant Byte :=
|
||||||
2 ** Natural (Offset mod System.Storage_Unit);
|
2 ** Natural (Offset mod System.Storage_Unit);
|
||||||
begin
|
begin
|
||||||
|
@ -615,7 +659,7 @@ package body GNAT.Debug_Pools is
|
||||||
Ptr : Validity_Bits_Ref := Validy_Htable.Get (Block_Number);
|
Ptr : Validity_Bits_Ref := Validy_Htable.Get (Block_Number);
|
||||||
Offset : constant Integer_Address :=
|
Offset : constant Integer_Address :=
|
||||||
(Int_Storage - (Block_Number * Memory_Chunk_Size)) /
|
(Int_Storage - (Block_Number * Memory_Chunk_Size)) /
|
||||||
Default_Alignment;
|
Storage_Alignment;
|
||||||
Bit : constant Byte :=
|
Bit : constant Byte :=
|
||||||
2 ** Natural (Offset mod System.Storage_Unit);
|
2 ** Natural (Offset mod System.Storage_Unit);
|
||||||
|
|
||||||
|
@ -656,11 +700,12 @@ package body GNAT.Debug_Pools is
|
||||||
Size_In_Storage_Elements : Storage_Count;
|
Size_In_Storage_Elements : Storage_Count;
|
||||||
Alignment : Storage_Count)
|
Alignment : Storage_Count)
|
||||||
is
|
is
|
||||||
|
|
||||||
pragma Unreferenced (Alignment);
|
pragma Unreferenced (Alignment);
|
||||||
-- Ignored, we always force 'Default_Alignment
|
-- Ignored, we always force Storage_Alignment
|
||||||
|
|
||||||
type Local_Storage_Array is new Storage_Array
|
type Local_Storage_Array is new Storage_Array
|
||||||
(1 .. Size_In_Storage_Elements + Minimum_Allocation);
|
(1 .. Size_In_Storage_Elements + Extra_Allocation);
|
||||||
|
|
||||||
type Ptr is access Local_Storage_Array;
|
type Ptr is access Local_Storage_Array;
|
||||||
-- On some systems, we might want to physically protect pages against
|
-- On some systems, we might want to physically protect pages against
|
||||||
|
@ -705,17 +750,33 @@ package body GNAT.Debug_Pools is
|
||||||
P := new Local_Storage_Array;
|
P := new Local_Storage_Array;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
Storage_Address :=
|
-- Compute Storage_Address, aimed at receiving user data. We need room
|
||||||
To_Address
|
-- for the allocation header just ahead of the user data space plus
|
||||||
(Default_Alignment *
|
-- alignment padding so Storage_Address is aligned on Storage_Alignment,
|
||||||
((To_Integer (P.all'Address) + Default_Alignment - 1)
|
-- like so:
|
||||||
/ Default_Alignment)
|
--
|
||||||
+ Integer_Address (Header_Offset));
|
-- Storage_Address, aligned
|
||||||
|
-- on Storage_Alignment
|
||||||
|
-- v
|
||||||
|
-- | ~~~~ | Header | User data ... |
|
||||||
|
-- ^........^
|
||||||
|
-- Header_Offset
|
||||||
|
--
|
||||||
|
-- Header_Offset is fixed so moving back and forth between user data
|
||||||
|
-- and allocation header is straightforward. The value is also such
|
||||||
|
-- that the header type alignment is honored when starting from
|
||||||
|
-- Default_alignment.
|
||||||
|
|
||||||
|
-- For the purpose of computing Storage_Address, we just do as if the
|
||||||
|
-- header was located first, followed by the alignment padding:
|
||||||
|
|
||||||
|
Storage_Address := To_Address
|
||||||
|
(Align (To_Integer (P.all'Address) + Integer_Address (Header_Offset)));
|
||||||
-- Computation is done in Integer_Address, not Storage_Offset, because
|
-- Computation is done in Integer_Address, not Storage_Offset, because
|
||||||
-- the range of Storage_Offset may not be large enough.
|
-- the range of Storage_Offset may not be large enough.
|
||||||
|
|
||||||
pragma Assert ((Storage_Address - System.Null_Address)
|
pragma Assert ((Storage_Address - System.Null_Address)
|
||||||
mod Default_Alignment = 0);
|
mod Storage_Alignment = 0);
|
||||||
pragma Assert (Storage_Address + Size_In_Storage_Elements
|
pragma Assert (Storage_Address + Size_In_Storage_Elements
|
||||||
<= P.all'Address + P'Length);
|
<= P.all'Address + P'Length);
|
||||||
|
|
||||||
|
@ -726,7 +787,7 @@ package body GNAT.Debug_Pools is
|
||||||
pragma Warnings (Off);
|
pragma Warnings (Off);
|
||||||
-- Turn warning on alignment for convert call off. We know that in fact
|
-- Turn warning on alignment for convert call off. We know that in fact
|
||||||
-- this conversion is safe since P itself is always aligned on
|
-- this conversion is safe since P itself is always aligned on
|
||||||
-- Default_Alignment.
|
-- Storage_Alignment.
|
||||||
|
|
||||||
Header_Of (Storage_Address).all :=
|
Header_Of (Storage_Address).all :=
|
||||||
(Allocation_Address => P.all'Address,
|
(Allocation_Address => P.all'Address,
|
||||||
|
@ -950,7 +1011,7 @@ package body GNAT.Debug_Pools is
|
||||||
(Output_File (Pool),
|
(Output_File (Pool),
|
||||||
"info: Freeing physical memory "
|
"info: Freeing physical memory "
|
||||||
& Storage_Count'Image
|
& Storage_Count'Image
|
||||||
((abs Header.Block_Size) + Minimum_Allocation)
|
((abs Header.Block_Size) + Extra_Allocation)
|
||||||
& " bytes at 0x"
|
& " bytes at 0x"
|
||||||
& Address_Image (Header.Allocation_Address));
|
& Address_Image (Header.Allocation_Address));
|
||||||
end if;
|
end if;
|
||||||
|
@ -1167,7 +1228,7 @@ package body GNAT.Debug_Pools is
|
||||||
& Storage_Count'Image (Size_In_Storage_Elements)
|
& Storage_Count'Image (Size_In_Storage_Elements)
|
||||||
& " bytes at 0x" & Address_Image (Storage_Address)
|
& " bytes at 0x" & Address_Image (Storage_Address)
|
||||||
& " (physically"
|
& " (physically"
|
||||||
& Storage_Count'Image (Header.Block_Size + Minimum_Allocation)
|
& Storage_Count'Image (Header.Block_Size + Extra_Allocation)
|
||||||
& " bytes at 0x" & Address_Image (Header.Allocation_Address)
|
& " bytes at 0x" & Address_Image (Header.Allocation_Address)
|
||||||
& "), at ");
|
& "), at ");
|
||||||
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null,
|
||||||
|
|
|
@ -502,14 +502,18 @@ package Lib.Xref is
|
||||||
E_Signed_Integer_Subtype => 'I',
|
E_Signed_Integer_Subtype => 'I',
|
||||||
E_Signed_Integer_Type => 'I',
|
E_Signed_Integer_Type => 'I',
|
||||||
E_String_Literal_Subtype => ' ',
|
E_String_Literal_Subtype => ' ',
|
||||||
E_String_Subtype => 'S',
|
|
||||||
E_String_Type => 'S',
|
|
||||||
E_Subprogram_Type => ' ',
|
E_Subprogram_Type => ' ',
|
||||||
E_Task_Subtype => 'T',
|
E_Task_Subtype => 'T',
|
||||||
E_Task_Type => 'T',
|
E_Task_Type => 'T',
|
||||||
E_Variable => '*',
|
E_Variable => '*',
|
||||||
E_Void => ' ',
|
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-
|
-- 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
|
-- 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
|
-- a package are to the spec, not the body) Indeed the occurrence of the
|
||||||
|
|
|
@ -1558,7 +1558,6 @@ package body Prj.Dect is
|
||||||
if Token = Tok_Right_Paren then
|
if Token = Tok_Right_Paren then
|
||||||
Scan (In_Tree);
|
Scan (In_Tree);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
end Parse_String_Type_Declaration;
|
end Parse_String_Type_Declaration;
|
||||||
|
|
||||||
--------------------------------
|
--------------------------------
|
||||||
|
|
|
@ -4083,7 +4083,7 @@ package body Sprint is
|
||||||
|
|
||||||
-- Array types and string types
|
-- Array types and string types
|
||||||
|
|
||||||
when E_Array_Type | E_String_Type =>
|
when E_Array_Type =>
|
||||||
Write_Header;
|
Write_Header;
|
||||||
Write_Str ("array (");
|
Write_Str ("array (");
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue