diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 27 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 63 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 48 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/g-debpoo.adb | 125 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/prj-dect.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sprint.adb | 2 |
11 files changed, 190 insertions, 118 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d5b4c95be89..07ac917b9f2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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> * gnat_ugn.texi: Clean up and correct documentation of warnings. diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 4099a7d0457..0bb0d84c670 100644 --- a/gcc/ada/cstand.adb +++ b/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); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 35a88befa32..80f5be05278 100644 --- a/gcc/ada/einfo.adb +++ b/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; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 753a0306048..4117252280d 100644 --- a/gcc/ada/einfo.ads +++ b/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) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 1274b31ea1c..e835ea47cb4 100644 --- a/gcc/ada/errout.adb +++ b/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); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 8099b805ba2..ae9f911cea3 100644 --- a/gcc/ada/exp_ch3.adb +++ b/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 diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 046af103674..ed3a90ae5b3 100644 --- a/gcc/ada/freeze.adb +++ b/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 diff --git a/gcc/ada/g-debpoo.adb b/gcc/ada/g-debpoo.adb index 5ee63d9896f..07bff14fa26 100644 --- a/gcc/ada/g-debpoo.adb +++ b/gcc/ada/g-debpoo.adb @@ -6,7 +6,7 @@ -- -- -- 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 -- -- 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 - Default_Alignment : constant := Standard'Maximum_Alignment; - -- Alignment used for the memory chunks returned by Allocate. Using this - -- value guarantees that this alignment 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. + Storage_Alignment : constant := Standard'Maximum_Alignment; + -- Alignment enforced for all the memory chunks returned by Allocate, + -- maximized to make sure that it will be compatible with all types. + -- + -- 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; -- 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); Header_Offset : constant Storage_Count := - Default_Alignment * - ((Allocation_Header'Size / System.Storage_Unit - + Default_Alignment - 1) / Default_Alignment); - -- Offset of user data after allocation header - - Minimum_Allocation : constant Storage_Count := - Default_Alignment - 1 + Header_Offset; - -- Minimal allocation: size of allocation_header rounded up to next - -- multiple of default alignment + worst-case padding. + (Allocation_Header'Object_Size / System.Storage_Unit); + -- Offset, in bytes, from start of allocation Header to start of User + -- data. The start of user data is assumed to be aligned at least as much + -- as what the header type requires, so applying this offset yields a + -- suitably aligned address as well. + + Extra_Allocation : constant Storage_Count := + (Storage_Alignment - 1 + Header_Offset); + -- Amount we need to secure in addition to the user data for a given + -- allocation request: room for the allocation header plus worst-case + -- alignment padding. ----------------------- -- 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 (Pool : Debug_Pool; 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 -- 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 -- --------------- @@ -522,7 +566,7 @@ package body GNAT.Debug_Pools is -- that two chunk of allocated data are very far from each other. 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 := Memory_Chunk_Size / Validity_Divisor; @@ -575,12 +619,12 @@ package body GNAT.Debug_Pools is Int_Storage : constant Integer_Address := To_Integer (Storage); 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 -- early in this case. We actually have to since our data structures -- 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; end if; @@ -592,7 +636,7 @@ package body GNAT.Debug_Pools is Offset : constant Integer_Address := (Int_Storage - (Block_Number * Memory_Chunk_Size)) / - Default_Alignment; + Storage_Alignment; Bit : constant Byte := 2 ** Natural (Offset mod System.Storage_Unit); begin @@ -615,7 +659,7 @@ package body GNAT.Debug_Pools is Ptr : Validity_Bits_Ref := Validy_Htable.Get (Block_Number); Offset : constant Integer_Address := (Int_Storage - (Block_Number * Memory_Chunk_Size)) / - Default_Alignment; + Storage_Alignment; Bit : constant Byte := 2 ** Natural (Offset mod System.Storage_Unit); @@ -656,11 +700,12 @@ package body GNAT.Debug_Pools is Size_In_Storage_Elements : Storage_Count; Alignment : Storage_Count) is + pragma Unreferenced (Alignment); - -- Ignored, we always force 'Default_Alignment + -- Ignored, we always force Storage_Alignment 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; -- 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; end; - Storage_Address := - To_Address - (Default_Alignment * - ((To_Integer (P.all'Address) + Default_Alignment - 1) - / Default_Alignment) - + Integer_Address (Header_Offset)); + -- Compute Storage_Address, aimed at receiving user data. We need room + -- for the allocation header just ahead of the user data space plus + -- alignment padding so Storage_Address is aligned on Storage_Alignment, + -- like so: + -- + -- 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 -- the range of Storage_Offset may not be large enough. pragma Assert ((Storage_Address - System.Null_Address) - mod Default_Alignment = 0); + mod Storage_Alignment = 0); pragma Assert (Storage_Address + Size_In_Storage_Elements <= P.all'Address + P'Length); @@ -726,7 +787,7 @@ package body GNAT.Debug_Pools is pragma Warnings (Off); -- Turn warning on alignment for convert call off. We know that in fact -- this conversion is safe since P itself is always aligned on - -- Default_Alignment. + -- Storage_Alignment. Header_Of (Storage_Address).all := (Allocation_Address => P.all'Address, @@ -950,7 +1011,7 @@ package body GNAT.Debug_Pools is (Output_File (Pool), "info: Freeing physical memory " & Storage_Count'Image - ((abs Header.Block_Size) + Minimum_Allocation) + ((abs Header.Block_Size) + Extra_Allocation) & " bytes at 0x" & Address_Image (Header.Allocation_Address)); end if; @@ -1167,7 +1228,7 @@ package body GNAT.Debug_Pools is & Storage_Count'Image (Size_In_Storage_Elements) & " bytes at 0x" & Address_Image (Storage_Address) & " (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) & "), at "); Put_Line (Output_File (Pool), Pool.Stack_Trace_Depth, null, diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index 17733a0c930..b82f4b837c8 100644 --- a/gcc/ada/lib-xref.ads +++ b/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 diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index a4d07d8828b..028b2bc1a73 100644 --- a/gcc/ada/prj-dect.adb +++ b/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; -------------------------------- diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 29526173db7..19d34328e34 100644 --- a/gcc/ada/sprint.adb +++ b/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 ("); |