[COMMITTED 17/30] ada: Remove streaming facilities from generics for formal containers
From: Yannick Moy The dependency on Ada.Streams is problematic for light runtimes. As these streaming facilities are in fact not used in formal containers, remove the corresponding dead code. gcc/ada/ * libgnat/a-chtgfo.adb (Generic_Read, Generic_Write): Remove. * libgnat/a-chtgfo.ads: Same. Remove dependency on Ada.Streams. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-chtgfo.adb | 68 gcc/ada/libgnat/a-chtgfo.ads | 24 - 2 files changed, 92 deletions(-) diff --git a/gcc/ada/libgnat/a-chtgfo.adb b/gcc/ada/libgnat/a-chtgfo.adb index c3fff336e9d..df7b554c050 100644 --- a/gcc/ada/libgnat/a-chtgfo.adb +++ b/gcc/ada/libgnat/a-chtgfo.adb @@ -359,74 +359,6 @@ package body Ada.Containers.Hash_Tables.Generic_Formal_Operations is end loop; end Generic_Iteration; - -- - -- Generic_Read -- - -- - - procedure Generic_Read - (Stream : not null access Root_Stream_Type'Class; - HT : out Hash_Table_Type) - is - N : Count_Type'Base; - - begin - Clear (HT); - - Count_Type'Base'Read (Stream, N); - - if Checks and then N < 0 then - raise Program_Error with "stream appears to be corrupt"; - end if; - - if N = 0 then - return; - end if; - - if Checks and then N > HT.Capacity then - raise Capacity_Error with "too many elements in stream"; - end if; - - for J in 1 .. N loop - declare -Node : constant Count_Type := New_Node (Stream); -Indx : constant Hash_Type := Index (HT, HT.Nodes (Node)); -B: Count_Type renames HT.Buckets (Indx); - begin -Set_Next (HT.Nodes (Node), Next => B); -B := Node; - end; - - HT.Length := HT.Length + 1; - end loop; - end Generic_Read; - - --- - -- Generic_Write -- - --- - - procedure Generic_Write - (Stream : not null access Root_Stream_Type'Class; - HT : Hash_Table_Type) - is - procedure Write (Node : Count_Type); - pragma Inline (Write); - - procedure Write is new Generic_Iteration (Write); - - --- - -- Write -- - --- - - procedure Write (Node : Count_Type) is - begin - Write (Stream, HT.Nodes (Node)); - end Write; - - begin - Count_Type'Base'Write (Stream, HT.Length); - Write (HT); - end Generic_Write; - --- -- Index -- --- diff --git a/gcc/ada/libgnat/a-chtgfo.ads b/gcc/ada/libgnat/a-chtgfo.ads index 76633d8da05..f4471bec3d2 100644 --- a/gcc/ada/libgnat/a-chtgfo.ads +++ b/gcc/ada/libgnat/a-chtgfo.ads @@ -30,8 +30,6 @@ -- Hash_Table_Type is used to implement hashed containers. This package -- declares hash-table operations that do not depend on keys. -with Ada.Streams; - generic with package HT_Types is new Generic_Formal_Hash_Table_Types (<>); @@ -113,26 +111,4 @@ package Ada.Containers.Hash_Tables.Generic_Formal_Operations is procedure Generic_Iteration (HT : Hash_Table_Type); -- Calls Process for each node in hash table HT - generic - use Ada.Streams; - with procedure Write -(Stream : not null access Root_Stream_Type'Class; - Node : Node_Type); - procedure Generic_Write - (Stream : not null access Root_Stream_Type'Class; - HT : Hash_Table_Type); - -- Used to implement the streaming attribute for hashed containers. It - -- calls Write for each node to write its value into Stream. - - generic - use Ada.Streams; - with function New_Node (Stream : not null access Root_Stream_Type'Class) - return Count_Type; - procedure Generic_Read - (Stream : not null access Root_Stream_Type'Class; - HT : out Hash_Table_Type); - -- Used to implement the streaming attribute for hashed containers. It - -- first clears hash table HT, then populates the hash table by calling - -- New_Node for each item in Stream. - end Ada.Containers.Hash_Tables.Generic_Formal_Operations; -- 2.45.1
[COMMITTED 08/30] ada: Enable inlining for subprograms with multiple return statements
From: Piotr Trojanek
With the support for forward GOTO statements in the GNATprove backend,
we can now inline subprograms with multiple return statements in the
frontend.
Also, fix inconsistent source locations in the inlined code, which were
now triggering assertion violations in the code for GNATprove
counterexamples.
gcc/ada/
* inline.adb (Has_Single_Return_In_GNATprove_Mode): Remove.
(Process_Formals): When rewriting an occurrence of a formal
parameter, use location of the occurrence, not of the inlined
call.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/inline.adb | 91 --
1 file changed, 8 insertions(+), 83 deletions(-)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 17b3099e6a6..04cf1194009 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1090,14 +1090,6 @@ package body Inline is
-- conflict with subsequent inlinings, so that it is unsafe to try to
-- inline in such a case.
- function Has_Single_Return_In_GNATprove_Mode return Boolean;
- -- This function is called only in GNATprove mode, and it returns
- -- True if the subprogram has no return statement or a single return
- -- statement as last statement. It returns False for subprogram with
- -- a single return as last statement inside one or more blocks, as
- -- inlining would generate gotos in that case as well (although the
- -- goto is useless in that case).
-
function Uses_Secondary_Stack (Bod : Node_Id) return Boolean;
-- If the body of the subprogram includes a call that returns an
-- unconstrained type, the secondary stack is involved, and it is
@@ -1173,64 +1165,6 @@ package body Inline is
return False;
end Has_Pending_Instantiation;
- -
- -- Has_Single_Return_In_GNATprove_Mode --
- -
-
- function Has_Single_Return_In_GNATprove_Mode return Boolean is
- Body_To_Inline : constant Node_Id := N;
- Last_Statement : Node_Id := Empty;
-
- function Check_Return (N : Node_Id) return Traverse_Result;
- -- Returns OK on node N if this is not a return statement different
- -- from the last statement in the subprogram.
-
- --
- -- Check_Return --
- --
-
- function Check_Return (N : Node_Id) return Traverse_Result is
- begin
-case Nkind (N) is
- when N_Extended_Return_Statement
- | N_Simple_Return_Statement
- =>
- if N = Last_Statement then
- return OK;
- else
- return Abandon;
- end if;
-
- -- Skip locally declared subprogram bodies inside the body to
- -- inline, as the return statements inside those do not count.
-
- when N_Subprogram_Body =>
- if N = Body_To_Inline then
- return OK;
- else
- return Skip;
- end if;
-
- when others =>
- return OK;
-end case;
- end Check_Return;
-
- function Check_All_Returns is new Traverse_Func (Check_Return);
-
- -- Start of processing for Has_Single_Return_In_GNATprove_Mode
-
- begin
- -- Retrieve the last statement
-
- Last_Statement := Last (Statements (Handled_Statement_Sequence (N)));
-
- -- Check that the last statement is the only possible return
- -- statement in the subprogram.
-
- return Check_All_Returns (N) = OK;
- end Has_Single_Return_In_GNATprove_Mode;
-
--
-- Uses_Secondary_Stack --
--
@@ -1275,16 +1209,6 @@ package body Inline is
then
return;
- -- Subprograms that have return statements in the middle of the body are
- -- inlined with gotos. GNATprove does not currently support gotos, so
- -- we prevent such inlining.
-
- elsif GNATprove_Mode
-and then not Has_Single_Return_In_GNATprove_Mode
- then
- Cannot_Inline ("cannot inline & (multiple returns)?", N, Spec_Id);
- return;
-
-- Functions that return controlled types cannot currently be inlined
-- because they require secondary stack handling; controlled actions
-- may also interfere in complex ways with inlining.
@@ -3518,6 +3442,7 @@ package body Inline is
-
function Process_Formals (N : Node_Id) return Traverse_Result is
+ Loc : constant Source_Ptr := Sloc (N);
A : Entity_Id;
E : Entity_Id;
Ret : Node_Id;
@@ -3544,13 +3469,13 @@ package body Inline is
if
[COMMITTED 19/30] ada: Fix references to Ada RM in comments
From: Piotr Trojanek We seem to have a convention of using "RM" in the GNAT comments, not "Ada RM". Also, the paragraph references by convention should appear in parentheses, e.g. "8.3(12.3/2)", not "8.3 12.3/2". gcc/ada/ * einfo.ads, exp_attr.adb, exp_ch4.adb, exp_ch7.adb, lib-writ.adb, libgnat/a-stbuut.ads, sem_ch13.adb, sem_ch3.adb, sem_ch7.adb: Use "RM" in comments. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads| 2 +- gcc/ada/exp_attr.adb | 4 ++-- gcc/ada/exp_ch4.adb | 2 +- gcc/ada/exp_ch7.adb | 2 +- gcc/ada/lib-writ.adb | 3 +-- gcc/ada/libgnat/a-stbuut.ads | 2 +- gcc/ada/sem_ch13.adb | 4 ++-- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_ch7.adb | 2 +- 9 files changed, 11 insertions(+), 12 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index e5110f51670..0b0529a39cf 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2728,7 +2728,7 @@ package Einfo is -- Defined in all entities. Set for implicitly declared subprograms -- that require overriding or are null procedures, and are hidden by -- a non-fully conformant homograph with the same characteristics --- (Ada RM 8.3 12.3/2). +-- (RM 8.3(12.3/2)). --Is_Hidden_Open_Scope -- Defined in all entities. Set for a scope that contains the diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 0349db28a1a..1396007a2d1 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2173,8 +2173,8 @@ package body Exp_Attr is -- for the arguments of a 'Read attribute reference (since the -- scalar argument is an OUT scalar) and for the arguments of a -- 'Has_Same_Storage or 'Overlaps_Storage attribute reference (which not - -- considered to be reads of their prefixes and expressions, see Ada RM - -- 13.3(73.10/3)). + -- considered to be reads of their prefixes and expressions, see + -- RM 13.3(73.10/3)). if Validity_Checks_On and then Validity_Check_Operands and then Id /= Attribute_Asm_Output diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 6ceffdf8302..95b7765b173 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -8512,7 +8512,7 @@ package body Exp_Ch4 is -- For small negative exponents, we return the reciprocal of -- the folding of the exponentiation for the opposite (positive) - -- exponent, as required by Ada RM 4.5.6(11/3). + -- exponent, as required by RM 4.5.6(11/3). if abs Expv <= 4 then diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 993c13c7318..fd1d9db0654 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -7419,7 +7419,7 @@ package body Exp_Ch7 is -- non-POC components are finalized before the -- non-POC extension components. This violates the -- usual "finalize in reverse declaration order" - -- principle, but that's ok (see Ada RM 7.6.1(9)). + -- principle, but that's ok (see RM 7.6.1(9)). -- -- Last_POC_Call should be non-empty if the extension -- has at least one POC. Interactions with variant diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 697b2f2b797..0755b92e4db 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -298,8 +298,7 @@ package body Lib.Writ is function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is begin -- With clauses created for ancestor units are marked as internal, --- however, they emulate the semantics in Ada RM 10.1.2 (6/2), --- where +-- however, they emulate the semantics in RM 10.1.2 (6/2), where -- --with A.B; -- diff --git a/gcc/ada/libgnat/a-stbuut.ads b/gcc/ada/libgnat/a-stbuut.ads index dadfe5f0010..2a8b08bca57 100644 --- a/gcc/ada/libgnat/a-stbuut.ads +++ b/gcc/ada/libgnat/a-stbuut.ads @@ -33,7 +33,7 @@ with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; package Ada.Strings.Text_Buffers.Utils with Pure is - -- Ada.Strings.Text_Buffers is a predefined unit (see Ada RM A.4.12). + -- Ada.Strings.Text_Buffers is a predefined unit (see RM A.4.12). -- This is a GNAT-defined child unit of that parent. subtype Character_7 is diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index c0a5b6c2c37..f84ca2c75d7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12860,7 +12860,7 @@ package body Sem_Ch13 is procedure Hide_Non_Overridden_Subprograms (Typ : Entity_Id); -- Inspect the primitive operations of type Typ and hide all pairs of -- implicitly declared non-overridden non-fully conformant homographs - -- (Ada RM 8.3 12.3/2). + -- (RM 8.3(12.3/2)).
[COMMITTED 30/30] ada: Add support for No_Implicit_Conditionals to nonbinary modular types
From: Eric Botcazou The expansion of additive operations for nonbinary modular types implemented in the front-end and its counterpart in code generators may create branches, which is not allowed when restriction No_Implicit_Conditionals is in effect. This changes it to use an explicit Mod operation when the restriction is in effect, which is assumed not to create such branches. gcc/ada/ * exp_ch4.adb (Expand_Nonbinary_Modular_Op): Create an explicit Mod for additive operations if No_Implicit_Conditionals is in effect. (Expand_Modular_Addition): Likewise. (Expand_Modular_Subtraction): Likewise. (Expand_Modular_Op): Always use an unsigned type obtained by calling Small_Integer_Type_For on the required size. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 132 ++-- 1 file changed, 77 insertions(+), 55 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 95b7765b173..bf90b46249a 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -139,9 +139,10 @@ package body Exp_Ch4 is -- case of array type arguments. procedure Expand_Nonbinary_Modular_Op (N : Node_Id); - -- When generating C code, convert nonbinary modular arithmetic operations - -- into code that relies on the front-end expansion of operator Mod. No - -- expansion is performed if N is not a nonbinary modular operand. + -- When generating C code or if restriction No_Implicit_Conditionals is in + -- effect, convert most nonbinary modular arithmetic operations into code + -- that relies on the expansion of an explicit Mod operator. No expansion + -- is performed if N is not a nonbinary modular operation. procedure Expand_Short_Circuit_Operator (N : Node_Id); -- Common expansion processing for short-circuit boolean operators @@ -3899,10 +3900,13 @@ package body Exp_Ch4 is procedure Expand_Modular_Addition is begin - -- If this is not the addition of a constant then compute it using - -- the general rule: (lhs + rhs) mod Modulus + -- If this is not the addition of a constant or else restriction + -- No_Implicit_Conditionals is in effect, then compute it using + -- the general rule: (lhs + rhs) mod Modulus. - if Nkind (Right_Opnd (N)) /= N_Integer_Literal then + if Nkind (Right_Opnd (N)) /= N_Integer_Literal + or else Restriction_Active (No_Implicit_Conditionals) + then Expand_Modular_Op; -- If this is an addition of a constant, convert it to a subtraction @@ -3921,6 +3925,7 @@ package body Exp_Ch4 is Cond_Expr : Node_Id; Then_Expr : Node_Id; Else_Expr : Node_Id; + begin -- To prevent spurious visibility issues, convert all -- operands to Standard.Unsigned. @@ -3966,12 +3971,12 @@ package body Exp_Ch4 is -- We will convert to another type (not a nonbinary-modulus modular -- type), evaluate the op in that representation, reduce the result, -- and convert back to the original type. This means that the - -- backend does not have to deal with nonbinary-modulus ops. - - Op_Expr : constant Node_Id := New_Op_Node (Nkind (N), Loc); - Mod_Expr : Node_Id; + -- back end does not have to deal with nonbinary-modulus ops. + Mod_Expr: Node_Id; + Op_Expr : Node_Id; Target_Type : Entity_Id; + begin -- Select a target type that is large enough to avoid spurious -- intermediate overflow on pre-reduction computation (for @@ -3979,22 +3984,15 @@ package body Exp_Ch4 is declare Required_Size : Uint := RM_Size (Etype (N)); -Use_Unsigned : Boolean := True; + begin case Nkind (N) is - when N_Op_Add => + when N_Op_Add | N_Op_Subtract => -- For example, if modulus is 255 then RM_Size will be 8 -- and the range of possible values (before reduction) will -- be 0 .. 508; that range requires 9 bits. Required_Size := Required_Size + 1; - when N_Op_Subtract => - -- For example, if modulus is 255 then RM_Size will be 8 - -- and the range of possible values (before reduction) will - -- be -254 .. 254; that range requires 9 bits, signed. - Use_Unsigned := False; - Required_Size := Required_Size + 1; - when N_Op_Multiply => -- For example, if modulus is 255 then RM_Size will be 8 -- and the range of possible values (before reduction) will @@ -4005,37 +4003,15 @@ package body Exp_Ch4 is null; end
[COMMITTED 09/30] ada: Simplify check for type without stream operations
From: Piotr Trojanek Recursive routine Type_Without_Stream_Operation was checking restriction No_Default_Stream_Attributes at every call, which was confusing and inefficient. This routine is only called from the places: Check_Stream_Attribute, which already checks if this restriction is active, and Stream_Operation_OK, where we add such a check. Cleanup related to extending the use of No_Streams restriction. gcc/ada/ * exp_ch3.adb (Stream_Operation_OK): Check restriction No_Default_Stream_Attributes before call to Type_Without_Stream_Operation. * sem_util.adb (Type_Without_Stream_Operation): Remove static condition from recursive routine Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch3.adb | 4 +++- gcc/ada/sem_util.adb | 4 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 8ddae1eb1be..f9dd0914111 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -12912,7 +12912,9 @@ package body Exp_Ch3 is and then No (No_Tagged_Streams_Pragma (Typ)) and then not No_Run_Time_Mode and then RTE_Available (RE_Tag) -and then No (Type_Without_Stream_Operation (Typ)) +and then + (not Restriction_Active (No_Default_Stream_Attributes) + or else No (Type_Without_Stream_Operation (Typ))) and then RTE_Available (RE_Root_Stream_Type); end Stream_Operation_OK; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 15994b4d1e9..241be3d2957 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -28557,10 +28557,6 @@ package body Sem_Util is Op_Missing : Boolean; begin - if not Restriction_Active (No_Default_Stream_Attributes) then - return Empty; - end if; - if Is_Elementary_Type (T) then if Op = TSS_Null then Op_Missing := -- 2.45.1
[COMMITTED 04/30] ada: Fix handling of aspects CPU and Interrupt_Priority
From: Piotr Trojanek When resolving aspect expression, aspects CPU and Interrupt_Priority should be handled like the aspect Priority; in particular, all these expressions can reference discriminants of the annotated task type. gcc/ada/ * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Make discriminants visible when analyzing aspect Interrupt_Priority. (Freeze_Entity_Checks): Likewise. (Resolve_Aspect_Expressions): Likewise for both aspects CPU and Interrupt_Priority. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch13.adb | 7 ++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 4cf6fc9a645..c0a5b6c2c37 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -11107,6 +11107,7 @@ package body Sem_Ch13 is elsif A_Id in Aspect_CPU | Aspect_Dynamic_Predicate | Aspect_Ghost_Predicate + | Aspect_Interrupt_Priority | Aspect_Predicate | Aspect_Priority | Aspect_Static_Predicate @@ -13366,6 +13367,7 @@ package body Sem_Ch13 is if Get_Aspect_Id (Ritem) in Aspect_CPU | Aspect_Dynamic_Predicate | Aspect_Ghost_Predicate +| Aspect_Interrupt_Priority | Aspect_Predicate | Aspect_Static_Predicate | Aspect_Priority @@ -15881,7 +15883,10 @@ package body Sem_Ch13 is Set_Must_Not_Freeze (Expr); Preanalyze_Spec_Expression (Expr, E); - when Aspect_Priority => + when Aspect_CPU + | Aspect_Interrupt_Priority + | Aspect_Priority + => Push_Type (E); Preanalyze_Spec_Expression (Expr, Any_Integer); Pop_Type (E); -- 2.45.1
[COMMITTED 18/30] ada: Tune code related to potentially unevaluated expressions
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * sem_util.adb (Immediate_Context_Implies_Is_Potentially_Unevaluated): Use collective subtypes in membership tests. (Is_Known_On_Entry): Require all alternatives in a case statement to return; this change could prevent a recently fixed glitch, where one of the alternatives relied on the return statement afterwards (also, the new code is shorter). * sem_util.ads (Is_Potentially_Unevaluated): Clarify that this routine applies to Ada 2012. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 8 +++- gcc/ada/sem_util.ads | 2 +- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 241be3d2957..5bea088c44e 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -19485,10 +19485,10 @@ package body Sem_Util is elsif Nkind (Par) = N_Case_Expression then return Expr /= Expression (Par); - elsif Nkind (Par) in N_And_Then | N_Or_Else then + elsif Nkind (Par) in N_Short_Circuit then return Expr = Right_Opnd (Par); - elsif Nkind (Par) in N_In | N_Not_In then + elsif Nkind (Par) in N_Membership_Test then -- If the membership includes several alternatives, only the first -- is definitely evaluated. @@ -30880,10 +30880,8 @@ package body Sem_Util is return True; when others => - null; + return False; end case; - -return False; end Is_Known_On_Entry; end Conditional_Evaluation; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 4fef8966380..f282d1fad99 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2219,7 +2219,7 @@ package Sem_Util is -- type be partially initialized. function Is_Potentially_Unevaluated (N : Node_Id) return Boolean; - -- Predicate to implement definition given in RM 6.1.1 (20/3) + -- Predicate to implement definition given in RM 2012 6.1.1 (20/3) function Is_Potentially_Persistent_Type (T : Entity_Id) return Boolean; -- Determines if type T is a potentially persistent type. A potentially -- 2.45.1
[COMMITTED 10/30] ada: Skip processing of NUL character for attribute Type_Key
From: Piotr Trojanek Code cleanup; behavior is unaffected. gcc/ada/ * sem_attr.adb (Analyze_Attribute): Use fully qualified name without a NUL, so that it doesn't need to be skipped afterwards. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 8 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 403810c8b5e..4fd270aeae9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6863,8 +6863,8 @@ package body Sem_Attr is -- when Attribute_Type_Key => Type_Key : declare - Full_Name : constant String_Id := -Fully_Qualified_Name_String (Entity (P)); + Full_Name : constant String_Id := + Fully_Qualified_Name_String (Entity (P), Append_NUL => False); CRC : CRC32; -- The computed signature for the type @@ -6997,9 +6997,9 @@ package body Sem_Attr is Start_String; Deref := False; - -- Copy all characters in Full_Name but the trailing NUL + -- Copy all characters in Full_Name - for J in 1 .. String_Length (Full_Name) - 1 loop + for J in 1 .. String_Length (Full_Name) loop Store_String_Char (Get_String_Char (Full_Name, Pos (J))); end loop; -- 2.45.1
[COMMITTED 16/30] ada: Fix usage of SetThreadAffinityMask
From: Ronan Desplanques This patches fixes the signature of the binding to SetThreadAffinityMask in the run-time library. It also fixes the error checking after calls to SetThreadAffinityMask. The previous code behaved as if SetThreadAffinityMask returned 1 on success, but it in fact returns a pointer value on success and 0 on failure. gcc/ada/ * libgnarl/s-taprop__mingw.adb (Set_Task_Affinity): Fix usage of SetThreadAffinityMask. * libgnat/s-winext.ads (SetThreadAffinityMask): Fix binding signature. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taprop__mingw.adb | 6 +++--- gcc/ada/libgnat/s-winext.ads | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnarl/s-taprop__mingw.adb b/gcc/ada/libgnarl/s-taprop__mingw.adb index 38e281cb721..f77d71970b8 100644 --- a/gcc/ada/libgnarl/s-taprop__mingw.adb +++ b/gcc/ada/libgnarl/s-taprop__mingw.adb @@ -1340,7 +1340,7 @@ package body System.Task_Primitives.Operations is then declare CPU_Set : DWORD := 0; - +Mask_Result : DWORD_PTR; begin for Proc in T.Common.Domain'Range loop if T.Common.Domain (Proc) then @@ -1352,8 +1352,8 @@ package body System.Task_Primitives.Operations is end if; end loop; -Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set); -pragma Assert (Result = 1); +Mask_Result := SetThreadAffinityMask (T.Common.LL.Thread, CPU_Set); +pragma Assert (Mask_Result /= 0); end; end if; end Set_Task_Affinity; diff --git a/gcc/ada/libgnat/s-winext.ads b/gcc/ada/libgnat/s-winext.ads index 3f14fc04e60..b402a5615c9 100644 --- a/gcc/ada/libgnat/s-winext.ads +++ b/gcc/ada/libgnat/s-winext.ads @@ -55,7 +55,7 @@ package System.Win32.Ext is function SetThreadAffinityMask (hThread : HANDLE; - dwThreadAffinityMask : DWORD) return DWORD; + dwThreadAffinityMask : DWORD) return DWORD_PTR; pragma Import (Stdcall, SetThreadAffinityMask, "SetThreadAffinityMask"); -- -- 2.45.1
[COMMITTED 05/30] ada: Cleanup building of error messages for class-wide contracts
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * exp_ch6.adb (Build_Dynamic_Check_Helper_Call): Remove unused iteration over formal parameters. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch6.adb | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index a8a70a5759d..e43389132ae 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7635,7 +7635,6 @@ package body Exp_Ch6 is Dynamic_Call_Helper (CW_Subp); Actuals : constant List_Id := New_List; A : Node_Id := First_Actual (Call_Node); - F : Entity_Id := First_Formal (Helper_Id); begin while Present (A) loop @@ -7646,7 +7645,7 @@ package body Exp_Ch6 is Remove_Side_Effects (A); Append_To (Actuals, New_Copy_Tree (A)); -Next_Formal (F); + Next_Actual (A); end loop; -- 2.45.1
[COMMITTED 03/30] ada: Remove unnecessary guard against empty list
From: Piotr Trojanek
Code cleanup; semantics is unaffected.
gcc/ada/
* sem_prag.adb (Report_Extra_Clauses): Remove redundant check
for empty list, because First works also for No_List.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 15 ++-
1 file changed, 6 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 29f27652138..9ccf1b9cf65 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -28248,16 +28248,13 @@ package body Sem_Prag is
Clause : Node_Id;
begin
- if Present (Clauses) then
-Clause := First (Clauses);
-while Present (Clause) loop
- SPARK_Msg_N
- ("unmatched or extra clause in dependence refinement",
- Clause);
+ Clause := First (Clauses);
+ while Present (Clause) loop
+SPARK_Msg_N
+ ("unmatched or extra clause in dependence refinement", Clause);
- Next (Clause);
-end loop;
- end if;
+Next (Clause);
+ end loop;
end Report_Extra_Clauses;
-- Local variables
--
2.45.1
[COMMITTED 07/30] ada: Add switch to disable expansion of assertions in CodePeer mode
From: Piotr Trojanek A new debug switch -gnatd_k is added, which has only effect in CodePeer mode. When enabled, assertion expressions are no longer expanded (which is the default in the CodePeer mode); instead, their expansion needs to be explicitly enabled by pragma Assertion_Policy. gcc/ada/ * debug.adb (d_k): Use first available debug switch. * gnat1drv.adb (Adjust_Global_Switches): If new debug switch is active then don't expand assertion expressions by default. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/debug.adb| 7 ++- gcc/ada/gnat1drv.adb | 8 ++-- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 18b4a5480b6..540db2a9942 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -148,7 +148,7 @@ package body Debug is -- d_h Disable the use of (perfect) hash functions for enumeration Value -- d_i Ignore activations and calls to instances for elaboration -- d_j Read JSON files and populate Repinfo tables (opposite of -gnatRjs) - -- d_k + -- d_k In CodePeer mode disable expansion of assertion checks -- d_l -- d_m -- d_n @@ -990,6 +990,11 @@ package body Debug is -- compilation session if -gnatRjs was passed, in order to populate -- the internal tables of the Repinfo unit from them. + -- d_k In CodePeer mode assertion expressions are expanded by default + -- (regardless of the -gnata compiler switch); when this switch is + -- enabled, expansion of assertion expressions is controlled by + -- pragma Assertion_Policy. + -- d_p The compiler ignores calls to subprograms which verify the run-time -- semantics of invariants and postconditions in both the static and -- dynamic elaboration models. diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 55b5d565536..081d9435f4a 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -357,9 +357,13 @@ procedure Gnat1drv is Generate_SCIL := True; - -- Enable assertions, since they give CodePeer valuable extra info + -- Enable assertions, since they give CodePeer valuable extra info; + -- however, when switch -gnatd_k is active, then keep assertions + -- disabled by default and only enable them when explicitly + -- requested by pragma Assertion_Policy, just like in ordinary + -- compilation. - Assertions_Enabled := True; + Assertions_Enabled := not Debug_Flag_Underscore_K; -- Set normal RM validity checking and checking of copies (to catch -- e.g. wrong values used in unchecked conversions). -- 2.45.1
[COMMITTED 11/30] ada: Adjust comments and doc about the new use of restriction No_Streams
From: Piotr Trojanek
Extend code comment; move recently added documentation from pragma
No_Tagged_Streams to restriction No_Streams.
gcc/ada/
* doc/gnat_rm/implementation_defined_pragmas.rst
(No_Tagged_Streams): Move documentation.
* doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
(No_Streams): Likewise.
* exp_disp.adb (Make_DT): Extend comment.
* gnat_rm.texi: Regenerate.
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../doc/gnat_rm/implementation_defined_pragmas.rst | 6 --
...ard_and_implementation_defined_restrictions.rst | 6 ++
gcc/ada/exp_disp.adb | 4
gcc/ada/gnat_rm.texi | 14 +++---
gcc/ada/gnat_ugn.texi | 4 ++--
5 files changed, 19 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 7e4dd935342..0661670e047 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -4000,12 +4000,6 @@ applied to a tagged type its Expanded_Name and
External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
-Alternatively, when pragmas ``Discard_Names`` and ``Restrictions (No_Streams)``
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
Pragma Normalize_Scalars
diff --git
a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
index 5c023239163..cf4657b7050 100644
--- a/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
+++ b/gcc/ada/doc/gnat_rm/standard_and_implementation_defined_restrictions.rst
@@ -675,6 +675,12 @@ To take maximum advantage of this space-saving
optimization, any
unit declaring a tagged type should be compiled with the restriction,
though this is not required.
+When pragmas ``Discard_Names`` and ``Restrictions (No_Streams)`` simultaneously
+apply to a tagged type, its Expanded_Name and External_Tag are also initialized
+with empty strings. In particular, both these pragmas can be applied as
+configuration pragmas to avoid exposing entity names at binary level for the
+entire partition.
+
No_Tagged_Type_Registration
---
.. index:: No_Tagged_Type_Registration
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 66be77c9ffc..1a19c1e3303 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4598,6 +4598,10 @@ package body Exp_Disp is
--(2) External_Tag (combined with Internal_Tag) is used for object
--streaming and No_Tagged_Streams inhibits the generation of
--streams.
+ -- Instead of No_Tagged_Streams, which applies either to a single
+ -- type or to a declarative region, it is possible to use restriction
+ -- No_Streams, which prevents stream objects from being created in the
+ -- entire partition.
Discard_Names : constant Boolean :=
(Present (No_Tagged_Streams_Pragma (Typ))
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 776dd4a4afc..1e6fb093672 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -19,7 +19,7 @@
@copying
@quotation
-GNAT Reference Manual , Apr 16, 2024
+GNAT Reference Manual , May 28, 2024
AdaCore
@@ -5535,12 +5535,6 @@ applied to a tagged type its Expanded_Name and
External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
-Alternatively, when pragmas @code{Discard_Names} and @code{Restrictions
(No_Streams)}
-simultanously apply to a tagged type, its Expanded_Name and External_Tag are
-also initialized with empty strings. In particular, both these pragmas can be
-applied as configuration pragmas to avoid exposing entity names at binary
-level for the entire parition.
-
@node Pragma Normalize_Scalars,Pragma Obsolescent,Pragma
No_Tagged_Streams,Implementation Defined Pragmas
@anchor{gnat_rm/implementation_defined_pragmas
pragma-normalize-scalars}@anchor{b0}
@section Pragma Normalize_Scalars
@@ -13246,6 +13240,12 @@ To take maximum advantage of this space-saving
optimization, any
unit declaring a tagged type should be compiled with the restriction,
though this is not required.
+When pragmas @code{Discard_Names} and @code{Restrictions (No_Streams)}
simultaneously
+apply to a tagged type, its
[COMMITTED 06/30] ada: Refactor common code for dynamic and static class-wide preconditions
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * exp_ch6.adb (Install_Class_Preconditions_Check): Refactor common code for checking if precondition fails, since the difference is only in raising an exception or calling the Raise_Assert_Failure procedure. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch6.adb | 36 ++-- 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index e43389132ae..b5c5865242d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7868,6 +7868,7 @@ package body Exp_Ch6 is Present (Controlling_Argument (Call_Node)); Class_Subp: Entity_Id; Cond : Node_Id; + Fail : Node_Id; Subp : Entity_Id; -- Start of processing for Install_Class_Preconditions_Check @@ -7913,30 +7914,29 @@ package body Exp_Ch6 is end if; if Exception_Locations_Suppressed then - Insert_Action (Call_Node, - Make_If_Statement (Loc, - Condition => Make_Op_Not (Loc, Cond), - Then_Statements => New_List ( - Make_Raise_Statement (Loc, - Name => - New_Occurrence_Of - (RTE (RE_Assert_Failure), Loc); + Fail := + Make_Raise_Statement (Loc, + Name => + New_Occurrence_Of + (RTE (RE_Assert_Failure), Loc)); -- Failed check with message indicating the failed precondition and the -- call that caused it. else - Insert_Action (Call_Node, - Make_If_Statement (Loc, - Condition => Make_Op_Not (Loc, Cond), - Then_Statements => New_List ( - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of - (RTE (RE_Raise_Assert_Failure), Loc), - Parameter_Associations => - New_List (Build_Error_Message (Subp)); + Fail := + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of + (RTE (RE_Raise_Assert_Failure), Loc), + Parameter_Associations => + New_List (Build_Error_Message (Subp))); end if; + + Insert_Action (Call_Node, +Make_If_Statement (Loc, + Condition => Make_Op_Not (Loc, Cond), + Then_Statements => New_List (Fail))); end Install_Class_Preconditions_Check; -- -- 2.45.1
[COMMITTED 02/30] ada: Refactor checks for Refined_Depends in generic instances
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * sem_prag.adb (Check_Dependency_Clause, Check_Output_States, Report_Extra_Clauses): Remove multiple checks for being inside an instance. (Analyze_Refined_Depends_In_Decl_Part): Add single check for being inside an instance. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 30 +- 1 file changed, 9 insertions(+), 21 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 86a25dc7d0c..29f27652138 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -27650,13 +27650,6 @@ package body Sem_Prag is -- Start of processing for Check_Dependency_Clause begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -return; - end if; - -- Examine all refinement clauses and compare them against the -- dependence clause. @@ -27910,16 +27903,10 @@ package body Sem_Prag is -- Start of processing for Check_Output_States begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - -- Inspect the outputs of pragma Depends looking for a state with a -- visible refinement. - elsif Present (Spec_Outputs) then + if Present (Spec_Outputs) then Item_Elmt := First_Elmt (Spec_Outputs); while Present (Item_Elmt) loop Item := Node (Item_Elmt); @@ -28261,13 +28248,7 @@ package body Sem_Prag is Clause : Node_Id; begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - - elsif Present (Clauses) then + if Present (Clauses) then Clause := First (Clauses); while Present (Clause) loop SPARK_Msg_N @@ -28369,6 +28350,13 @@ package body Sem_Prag is Analyze_Depends_In_Decl_Part (N); + -- Do not perform these checks in an instance because they were already + -- performed successfully in the generic template. + + if In_Instance then + goto Leave; + end if; + -- Do not match dependencies against refinements if Refined_Depends is -- illegal to avoid emitting misleading error. -- 2.45.1
[COMMITTED 01/30] ada: Refactor checks for Refined_Global in generic instances
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * sem_prag.adb (Check_In_Out_States, Check_Input_States, Check_Output_States, Check_Proof_In_States, Check_Refined_Global_List, Report_Extra_Constituents, Report_Missing_Items): Remove multiple checks for being inside an instance. (Analyze_Refined_Global_In_Decl_Part): Add single check for being inside an instance. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 86 1 file changed, 23 insertions(+), 63 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index a895fd2053a..86a25dc7d0c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -28712,16 +28712,10 @@ package body Sem_Prag is -- Start of processing for Check_In_Out_States begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - -- Inspect the In_Out items of the corresponding Global pragma -- looking for a state with a visible refinement. - elsif Has_In_Out_State and then Present (In_Out_Items) then + if Has_In_Out_State and then Present (In_Out_Items) then Item_Elmt := First_Elmt (In_Out_Items); while Present (Item_Elmt) loop Item_Id := Node (Item_Elmt); @@ -28821,16 +28815,10 @@ package body Sem_Prag is -- Start of processing for Check_Input_States begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - -- Inspect the Input items of the corresponding Global pragma looking -- for a state with a visible refinement. - elsif Has_In_State and then Present (In_Items) then + if Has_In_State and then Present (In_Items) then Item_Elmt := First_Elmt (In_Items); while Present (Item_Elmt) loop Item_Id := Node (Item_Elmt); @@ -28944,16 +28932,10 @@ package body Sem_Prag is -- Start of processing for Check_Output_States begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - -- Inspect the Output items of the corresponding Global pragma -- looking for a state with a visible refinement. - elsif Has_Out_State and then Present (Out_Items) then + if Has_Out_State and then Present (Out_Items) then Item_Elmt := First_Elmt (Out_Items); while Present (Item_Elmt) loop Item_Id := Node (Item_Elmt); @@ -29050,16 +29032,10 @@ package body Sem_Prag is -- Start of processing for Check_Proof_In_States begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - -- Inspect the Proof_In items of the corresponding Global pragma -- looking for a state with a visible refinement. - elsif Has_Proof_In_State and then Present (Proof_In_Items) then + if Has_Proof_In_State and then Present (Proof_In_Items) then Item_Elmt := First_Elmt (Proof_In_Items); while Present (Item_Elmt) loop Item_Id := Node (Item_Elmt); @@ -29214,13 +29190,7 @@ package body Sem_Prag is -- Start of processing for Check_Refined_Global_List begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - - elsif Nkind (List) = N_Null then + if Nkind (List) = N_Null then null; -- Single global item declaration @@ -29465,18 +29435,10 @@ package body Sem_Prag is -- Start of processing for Report_Extra_Constituents begin - -- Do not perform this check in an instance because it was already - -- performed successfully in the generic template. - - if In_Instance then -null; - - else -Report_Extra_Constituents_In_List (In_Constits); -Report_Extra_Constituents_In_List (In_Out_Constits); -Report_Extra_Constituents_In_List (Out_Constits); -Report_Extra_Constituents_In_List (Proof_In_Constits); - end if; + Report_Extra_Constituents_In_List (In_Constits); + Report_Extra_Constituents_In_List (In_Out_Constits); + Report_Extra_Constituents_In_List (Out_Constits); + Report_Extra_Constituents_In_List
Re: [PATCH] aarch64: adjust enum writeback after rename
Richard Sandiford writes: > Marc Poulhiès writes: >> gcc/ChangeLog: >> >> * config/aarch64/aarch64-ldp-fusion.cc (struct aarch64_pair_fusion): >> Use new type name. >> --- >> My previous change fixed the generic code, but I forgot to adjust the >> overload in aarch64. >> >> I don't have an aarch64 setup to check it fixes the build, but will set it >> up later. Unless it's >> OK to apply it as it's easy enough. > > I've tested locally and it builds correctly, so ok now. Thanks for testing Richard, now applied. And sorry for missing this in the first fix. Marc
[PATCH] aarch64: adjust enum writeback after rename
gcc/ChangeLog:
* config/aarch64/aarch64-ldp-fusion.cc (struct aarch64_pair_fusion):
Use new type name.
---
My previous change fixed the generic code, but I forgot to adjust the overload
in aarch64.
I don't have an aarch64 setup to check it fixes the build, but will set it up
later. Unless it's
OK to apply it as it's easy enough.
Marc
gcc/config/aarch64/aarch64-ldp-fusion.cc | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gcc/config/aarch64/aarch64-ldp-fusion.cc
b/gcc/config/aarch64/aarch64-ldp-fusion.cc
index 0af927231d3..b255dcbe73c 100644
--- a/gcc/config/aarch64/aarch64-ldp-fusion.cc
+++ b/gcc/config/aarch64/aarch64-ldp-fusion.cc
@@ -75,9 +75,9 @@ struct aarch64_pair_fusion : public pair_fusion
return aarch64_ldp_alias_check_limit;
}
- bool should_handle_writeback (enum writeback which) override final
+ bool should_handle_writeback (writeback_type which) override final
{
-if (which == writeback::ALL)
+if (which == writeback_type::ALL)
return aarch64_ldp_writeback > 1;
else
return aarch64_ldp_writeback;
--
2.45.1
Re: [PATCH] pair-fusion: fix for older GCC
Richard Sandiford writes: > Marc Poulhiès writes: >> Older GCCs fail with: >> >> .../gcc/pair-fusion.cc: In member function ‘bool >> pair_fusion_bb_info::fuse_pair(bool, unsigned int, int, rtl_ssa::insn_info*, >> rtl_ssa::in >> sn_info*, base_cand&, const rtl_ssa::insn_range_info&)’: >> .../gcc/pair-fusion.cc:1790:40: error: ‘writeback’ is not a class, >> namespace, or enumeration >> if (m_pass->should_handle_writeback (writeback::ALL) >> >> Renaming the enum type works around the name conflict with the local >> variable and also prevents future similar conflicts. >> >> gcc/ChangeLog: >> >> * pair-fusion.h (enum class writeback): Rename to... >> (enum class writeback_type): ...this. >> (struct pair_fusion): Adjust type name after renaming. >> * pair-fusion.cc (pair_fusion_bb_info::track_access): Likewise. >> (pair_fusion_bb_info::fuse_pair): Likewise. >> (pair_fusion::process_block): Likewise. > > OK, thanks, and sorry for missing this during the review. This breaks aarch64: https://builder.sourceware.org/buildbot/#/builders/266/builds/3487/steps/4/logs/stdio I'll try to send a followup fix quickly... Marc
Re: [Patch, aarch64, middle-end\ v4: Move pair_fusion pass from aarch64 to middle-end
Richard Sandiford writes: > Marc Poulhiès writes: >> Hello, >> >> I can't bootstrap using gcc 5.5 since this change. It fails with: >> >> .../gcc/pair-fusion.cc: In member function ‘bool >> pair_fusion_bb_info::fuse_pair(bool, unsigned int, int, rtl_ssa::insn_info*, >> rtl_ssa::in >> sn_info*, base_cand&, const rtl_ssa::insn_range_info&)’: >> .../gcc/pair-fusion.cc:1790:40: error: ‘writeback’ is not a class, >> namespace, or enumeration >>if (m_pass->should_handle_writeback (writeback::ALL) >> ^ >> Is it possible that C++11 enum classes are not correctly supported in >> older GCC? > > Looks to be due to an overloading of "writeback", which is also a local > variable in that function. > > One fix would be to rename the type to "writeback_type". > FWIW, the "enum"s in "enum writeback" can also be removed, > so it'd be s/enum writeback/writeback_type/. Thanks Richard! I've submitted a patch based on your suggestion and checked the compiler was correctly built using gcc 5.5. Marc
[PATCH] pair-fusion: fix for older GCC
Older GCCs fail with:
.../gcc/pair-fusion.cc: In member function ‘bool
pair_fusion_bb_info::fuse_pair(bool, unsigned int, int, rtl_ssa::insn_info*,
rtl_ssa::in
sn_info*, base_cand&, const rtl_ssa::insn_range_info&)’:
.../gcc/pair-fusion.cc:1790:40: error: ‘writeback’ is not a class, namespace,
or enumeration
if (m_pass->should_handle_writeback (writeback::ALL)
Renaming the enum type works around the name conflict with the local
variable and also prevents future similar conflicts.
gcc/ChangeLog:
* pair-fusion.h (enum class writeback): Rename to...
(enum class writeback_type): ...this.
(struct pair_fusion): Adjust type name after renaming.
* pair-fusion.cc (pair_fusion_bb_info::track_access): Likewise.
(pair_fusion_bb_info::fuse_pair): Likewise.
(pair_fusion::process_block): Likewise.
---
Patch discussed in
https://inbox.sourceware.org/gcc-patches/mptwmn93njq@arm.com/
Tested on x86_64-linux-gnu. OK for master?
gcc/pair-fusion.cc | 6 +++---
gcc/pair-fusion.h | 4 ++--
2 files changed, 5 insertions(+), 5 deletions(-)
diff --git a/gcc/pair-fusion.cc b/gcc/pair-fusion.cc
index 9f897ac04e2..26b2284ed37 100644
--- a/gcc/pair-fusion.cc
+++ b/gcc/pair-fusion.cc
@@ -426,7 +426,7 @@ pair_fusion_bb_info::track_access (insn_info *insn, bool
load_p, rtx mem)
return;
// Ignore writeback accesses if the hook says to do so.
- if (!m_pass->should_handle_writeback (writeback::EXISTING)
+ if (!m_pass->should_handle_writeback (writeback_type::EXISTING)
&& GET_RTX_CLASS (GET_CODE (XEXP (mem, 0))) == RTX_AUTOINC)
return;
@@ -1787,7 +1787,7 @@ pair_fusion_bb_info::fuse_pair (bool load_p,
// update of the base register and try and fold it in to make this into a
// writeback pair.
insn_info *trailing_add = nullptr;
- if (m_pass->should_handle_writeback (writeback::ALL)
+ if (m_pass->should_handle_writeback (writeback_type::ALL)
&& !writeback_effect
&& (!load_p || (!refers_to_regno_p (base_regno, base_regno + 1,
XEXP (pats[0], 0), nullptr)
@@ -2996,7 +2996,7 @@ void pair_fusion::process_block (bb_info *bb)
rtx pat = PATTERN (rti);
bool load_p;
if (reload_completed
- && should_handle_writeback (writeback::ALL)
+ && should_handle_writeback (writeback_type::ALL)
&& pair_mem_insn_p (rti, load_p))
try_promote_writeback (insn, load_p);
diff --git a/gcc/pair-fusion.h b/gcc/pair-fusion.h
index 2a38dc8f743..45e4edceecb 100644
--- a/gcc/pair-fusion.h
+++ b/gcc/pair-fusion.h
@@ -75,7 +75,7 @@ struct alias_walker;
// When querying should_handle_writeback, this enum is used to
// qualify which opportunities we are asking about.
-enum class writeback {
+enum class writeback_type {
// Only those writeback opportunities that arise from existing
// auto-increment accesses.
EXISTING,
@@ -123,7 +123,7 @@ struct pair_fusion {
// Return true if we should try to handle writeback opportunities.
// WHICH determines the kinds of writeback opportunities the caller
// is asking about.
- virtual bool should_handle_writeback (enum writeback which) = 0;
+ virtual bool should_handle_writeback (writeback_type which) = 0;
// Given BASE_MEM, the mem from the lower candidate access for a pair,
// and LOAD_P (true if the access is a load), check if we should proceed
--
2.45.1
Re: [Patch, aarch64, middle-end\ v4: Move pair_fusion pass from aarch64 to middle-end
Hello, I can't bootstrap using gcc 5.5 since this change. It fails with: .../gcc/pair-fusion.cc: In member function ‘bool pair_fusion_bb_info::fuse_pair(bool, unsigned int, int, rtl_ssa::insn_info*, rtl_ssa::in sn_info*, base_cand&, const rtl_ssa::insn_range_info&)’: .../gcc/pair-fusion.cc:1790:40: error: ‘writeback’ is not a class, namespace, or enumeration if (m_pass->should_handle_writeback (writeback::ALL) ^ Is it possible that C++11 enum classes are not correctly supported in older GCC? Thanks, Marc
[COMMITTED] fix: valid compiler optimization may fail the test
cxa4001 may fail with "Exception not raised" when the compiler omits the
calls to To_Mapping, in accordance with 10.2.1(18/3):
"If a library unit is declared pure, then the implementation is
permitted to omit a call on a library-level subprogram of the library
unit if the results are not needed after the call"
Using the result of both To_Mapping calls prevents the compiler from
omitting them.
"The corrected test will be available on the ACAA web site
(http://www.ada-auth.org/), and will be issued with the Modified Tests List
version 2.6K, 3.1DD, and 4.1GG."
gcc/testsuite/ChangeLog:
* ada/acats/tests/cxa/cxa4001.a: Use function result.
---
Tested on x86_64-linux-gnu, commited on master.
gcc/testsuite/ada/acats/tests/cxa/cxa4001.a | 12
1 file changed, 12 insertions(+)
diff --git a/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
b/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
index d850acd4a72..52fabc3d514 100644
--- a/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
+++ b/gcc/testsuite/ada/acats/tests/cxa/cxa4001.a
@@ -185,6 +185,12 @@ begin
begin
Bad_Map := Maps.To_Mapping(From => "aa", To => "yz");
Report.Failed("Exception not raised with repeated character");
+
+ if Report.Equal (Character'Pos('y'),
+ Character'Pos(Maps.Value(Bad_Map, 'a'))) then
+-- Use the map to avoid optimization.
+Report.Comment ("Shouldn't get here.");
+ end if;
exception
when Translation_Error => null; -- OK
when others=>
@@ -200,6 +206,12 @@ begin
begin
Bad_Map := Maps.To_Mapping("abc", "yz");
Report.Failed("Exception not raised with unequal parameter lengths");
+
+ if Report.Equal (Character'Pos('y'),
+ Character'Pos(Maps.Value(Bad_Map, 'a'))) then
+-- Use the map to avoid optimization.
+Report.Comment ("Shouldn't get here.");
+ end if;
exception
when Translation_Error => null; -- OK
when others=>
--
2.45.1
[COMMITTED 30/31] ada: Simplify test for propagation of attributes to subtypes
From: Eric Botcazou This changes the test to use the Is_Base_Type predicate and also removes the superfluous call to Base_Type before First_Subtype. No functional changes. gcc/ada/ * gcc-interface/decl.cc (gnat_to_gnu_entity): Use the Is_Base_Type predicate and remove superfluous calls to Base_Type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/decl.cc | 7 +++ 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index 6e40a157734..f6a4c0631b6 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -506,11 +506,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) /* Machine_Attributes on types are expected to be propagated to subtypes. The corresponding Gigi_Rep_Items are only attached to the first subtype though, so we handle the propagation here. */ - if (Base_Type (gnat_entity) != gnat_entity + if (!Is_Base_Type (gnat_entity) && !Is_First_Subtype (gnat_entity) - && Has_Gigi_Rep_Item (First_Subtype (Base_Type (gnat_entity - prepend_attributes (_list, - First_Subtype (Base_Type (gnat_entity))); + && Has_Gigi_Rep_Item (First_Subtype (gnat_entity))) + prepend_attributes (_list, First_Subtype (gnat_entity)); /* Compute a default value for the size of an elementary type. */ if (Known_Esize (gnat_entity) && Is_Elementary_Type (gnat_entity)) -- 2.43.2
[COMMITTED 26/31] ada: Fix strict aliasing violation in parameter passing
From: Eric Botcazou
This fixes a long-standing (implicit) violation of the strict aliasing rules
that occurs when the result of a call to an instance of Unchecked_Conversion
is directly passed as an actual parameter in a call to a subprogram and the
passing mechanism is by reference. In this case, the reference passed to
the subprogram may be to a type that has nothing to do with the type of the
underlying object, which is the definition of such a violation.
This implements the following two-pronged approach: first, the problematic
cases are detected and a reference to a temporary is passed instead of the
direct reference to the underlying object; second, the implementation of
pragma Universal_Aliasing is enhanced so that it is propagated from the
component type of an array type to the array type itself, or else can be
applied to the array type directly, and may therefore be used to prevent
the violation from occurring in the first place, when the array type is
involved in the Unchecked_Conversion.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Set
TYPE_TYPELESS_STORAGE on the array types if Universal_Aliasing is
set on the type or its component type.
: Likewise.
For other aggregate types, set TYPE_TYPELESS_STORAGE in this case.
(set_typeless_storage_on_aggregate_type): New function.
(set_universal_aliasing_on_type): Likewise.
* gcc-interface/trans.cc (Call_to_gnu): Add const to local variable.
Adjust comment. Pass GNAT_NAME in the call to addressable_p and add
a bypass for atomic types in case it returns false.
(addressable_p): Add GNAT_EXPR third parameter with default value
and add a default value to the existing second parameter.
: Return false if the expression comes from a
function call and if the alias sets of source and target types are
both distinct from zero and each other.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 40 ++-
gcc/ada/gcc-interface/trans.cc | 60 --
2 files changed, 82 insertions(+), 18 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 0987d534e69..ab54d2ccf13 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -205,6 +205,8 @@ static Entity_Id Gigi_Cloned_Subtype (Entity_Id);
static tree gnu_ext_name_for_subprog (Entity_Id, tree);
static void set_nonaliased_component_on_array_type (tree);
static void set_reverse_storage_order_on_array_type (tree);
+static void set_typeless_storage_on_aggregate_type (tree);
+static void set_universal_aliasing_on_type (tree);
static bool same_discriminant_p (Entity_Id, Entity_Id);
static bool array_type_has_nonaliased_component (tree, Entity_Id);
static bool compile_time_known_address_p (Node_Id);
@@ -2385,6 +2387,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
set_reverse_storage_order_on_array_type (tem);
if (array_type_has_nonaliased_component (tem, gnat_entity))
set_nonaliased_component_on_array_type (tem);
+ if (Universal_Aliasing (gnat_entity)
+ || Universal_Aliasing (Component_Type (gnat_entity)))
+ set_typeless_storage_on_aggregate_type (tem);
}
/* If this is a packed type implemented specially, then process the
@@ -2790,6 +2795,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
set_reverse_storage_order_on_array_type (gnu_type);
if (array_type_has_nonaliased_component (gnu_type, gnat_entity))
set_nonaliased_component_on_array_type (gnu_type);
+ if (Universal_Aliasing (gnat_entity)
+ || Universal_Aliasing (Component_Type (gnat_entity)))
+ set_typeless_storage_on_aggregate_type (gnu_type);
/* Clear the TREE_OVERFLOW flag, if any, for null arrays. */
if (gnu_null_ranges[index])
@@ -4757,7 +4765,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
/* Record whether a pragma Universal_Aliasing was specified. */
if (Universal_Aliasing (gnat_entity) && !TYPE_IS_DUMMY_P (gnu_type))
- TYPE_UNIVERSAL_ALIASING_P (gnu_type) = 1;
+ {
+ /* Set TYPE_TYPELESS_STORAGE if this is an aggregate type and
+TYPE_UNIVERSAL_ALIASING_P otherwise, since the former is not
+available in the latter case Both will effectively put alias
+set 0 on the type, but the former is more robust because it
+will be streamed in LTO mode. */
+ if (AGGREGATE_TYPE_P (gnu_type))
+ set_typeless_storage_on_aggregate_type (gnu_type);
+ else
+ set_universal_aliasing_on_type (gnu_type);
+ }
[COMMITTED 25/31] ada: Fix crash with aliased array and if expression
From: Ronan Desplanques
The way if expressions were translated led the gimplifying phase
to attempt to create a temporary of a variable-sized type in some
cases. This patch fixes this by adding an address indirection layer
in those cases.
gcc/ada/
* gcc-interface/utils2.cc (build_cond_expr): Also apply an
indirection when the result type is variable-sized.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/utils2.cc | 8 +---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
index 64712cb9962..161f0f11e5c 100644
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -1711,11 +1711,13 @@ build_cond_expr (tree result_type, tree
condition_operand,
true_operand = convert (result_type, true_operand);
false_operand = convert (result_type, false_operand);
- /* If the result type is unconstrained, take the address of the operands and
- then dereference the result. Likewise if the result type is passed by
- reference, because creating a temporary of this type is not allowed. */
+ /* If the result type is unconstrained or variable-sized, take the address
+ of the operands and then dereference the result. Likewise if the result
+ type is passed by reference, because creating a temporary of this type is
+ not allowed. */
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
|| type_contains_placeholder_p (result_type)
+ || !TREE_CONSTANT (TYPE_SIZE (result_type))
|| TYPE_IS_BY_REFERENCE_P (result_type))
{
result_type = build_pointer_type (result_type);
--
2.43.2
[COMMITTED 31/31] ada: Streamline implementation of simple nonbinary modular operations
From: Eric Botcazou
They are implemented by the nonbinary_modular_operation routine, which is
complex and, in particular, creates signed types and types with a partial
precision each time a subtraction or a multiplication resp. is generated.
Both are unnecessary and a simple approach even generates better code for
the subtraction on architectures with conditional moves.
gcc/ada/
* gcc-interface/utils2.cc (nonbinary_modular_operation): Rewrite.
Do not create signed types for subtraction, do not create types with
partial precision, call fold_convert instead of convert throughout.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/utils2.cc | 91 ++---
1 file changed, 28 insertions(+), 63 deletions(-)
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
index 8fb86ab29e3..4b7e2739f6a 100644
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -535,85 +535,50 @@ compare_fat_pointers (location_t loc, tree result_type,
tree p1, tree p2)
}
/* Compute the result of applying OP_CODE to LHS and RHS, where both are of
- type TYPE. We know that TYPE is a modular type with a nonbinary
- modulus. */
+ TYPE. We know that TYPE is a modular type with a nonbinary modulus. */
static tree
nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
tree rhs)
{
tree modulus = TYPE_MODULUS (type);
- unsigned int needed_precision = tree_floor_log2 (modulus) + 1;
- unsigned int precision;
- bool unsignedp = true;
- tree op_type = type;
- tree result;
+ unsigned precision = tree_floor_log2 (modulus) + 1;
+ tree op_type, result;
- /* If this is an addition of a constant, convert it to a subtraction
- of a constant since we can do that faster. */
- if (op_code == PLUS_EXPR && TREE_CODE (rhs) == INTEGER_CST)
-{
- rhs = fold_build2 (MINUS_EXPR, type, modulus, rhs);
- op_code = MINUS_EXPR;
-}
-
- /* For the logical operations, we only need PRECISION bits. For
- addition and subtraction, we need one more and for multiplication we
- need twice as many. But we never want to make a size smaller than
- our size. */
+ /* For the logical operations, we only need PRECISION bits. For addition and
+ subtraction, we need one more, and for multiplication twice as many. */
if (op_code == PLUS_EXPR || op_code == MINUS_EXPR)
-needed_precision += 1;
+precision += 1;
else if (op_code == MULT_EXPR)
-needed_precision *= 2;
-
- precision = MAX (needed_precision, TYPE_PRECISION (op_type));
+precision *= 2;
- /* Unsigned will do for everything but subtraction. */
- if (op_code == MINUS_EXPR)
-unsignedp = false;
-
- /* If our type is the wrong signedness or isn't wide enough, make a new
- type and convert both our operands to it. */
- if (TYPE_PRECISION (op_type) < precision
- || TYPE_UNSIGNED (op_type) != unsignedp)
+ /* If the type is not wide enough, make a new type of the needed precision
+ and convert modulus and operands to it. Use a type with full precision
+ for its mode since operations are ultimately performed in the mode. */
+ if (TYPE_PRECISION (type) < precision)
{
- /* Copy the type so we ensure it can be modified to make it modular. */
- op_type = copy_type (gnat_type_for_size (precision, unsignedp));
- modulus = convert (op_type, modulus);
- SET_TYPE_MODULUS (op_type, modulus);
- TYPE_MODULAR_P (op_type) = 1;
- lhs = convert (op_type, lhs);
- rhs = convert (op_type, rhs);
+ const scalar_int_mode m = smallest_int_mode_for_size (precision);
+ op_type = gnat_type_for_mode (m, 1);
+ modulus = fold_convert (op_type, modulus);
+ lhs = fold_convert (op_type, lhs);
+ rhs = fold_convert (op_type, rhs);
}
+ else
+op_type = type;
/* Do the operation, then we'll fix it up. */
result = fold_build2 (op_code, op_type, lhs, rhs);
- /* For multiplication, we have no choice but to do a full modulus
- operation. However, we want to do this in the narrowest
- possible size. */
- if (op_code == MULT_EXPR)
-{
- /* Copy the type so we ensure it can be modified to make it modular. */
- tree div_type = copy_type (gnat_type_for_size (needed_precision, 1));
- modulus = convert (div_type, modulus);
- SET_TYPE_MODULUS (div_type, modulus);
- TYPE_MODULAR_P (div_type) = 1;
- result = convert (op_type,
- fold_build2 (TRUNC_MOD_EXPR, div_type,
-convert (div_type, result), modulus));
-}
+ /* Unconditionally add the modulus to the result for a subtraction, this gets
+ rid of all its peculiarities by cancelling out the addition of the binary
+ modulus in the case where the subtraction wraps around in OP_TYPE, and may
+ even generate better code on architectures
[COMMITTED 23/31] ada: Follow-up adjustment to earlier fix in Build_Allocate_Deallocate_Proc
From: Eric Botcazou
The deallocation call of the return and secondary stacks no longer matches
the profile built in Exp_Util.Build_Allocate_Deallocate_Proc, so this just
removes the code as unreachable and adds an assertion to that effect.
gcc/ada/
* gcc-interface/utils2.cc (build_call_alloc_dealloc_proc): Add an
assertion that this is not a deallocation of the return or secondary
stack and remove subsequent unreachable code.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/utils2.cc | 12
1 file changed, 4 insertions(+), 8 deletions(-)
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
index fb0ccf59224..64712cb9962 100644
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2187,15 +2187,16 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree
gnu_size, tree gnu_type,
= Etype (Next_Formal (First_Formal (gnat_proc)));
tree gnu_size_type = gnat_to_gnu_type (gnat_size_type);
+ /* Deallocation is not supported for return and secondary stacks. */
+ gcc_assert (!gnu_obj);
+
gnu_size = convert (gnu_size_type, gnu_size);
gnu_align = convert (gnu_size_type, gnu_align);
if (DECL_BUILT_IN_CLASS (gnu_proc) == BUILT_IN_FRONTEND
&& DECL_FE_FUNCTION_CODE (gnu_proc) == BUILT_IN_RETURN_SLOT)
{
- /* This must be an allocation of the return stack in a function that
-returns by invisible reference. */
- gcc_assert (!gnu_obj);
+ /* This must be a function that returns by invisible reference. */
gcc_assert (current_function_decl
&& TREE_ADDRESSABLE (TREE_TYPE (current_function_decl)));
tree gnu_ret_size;
@@ -2221,11 +,6 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree
gnu_size, tree gnu_type,
N_Raise_Program_Error));
}
- /* The first arg is the address of the object, for a deallocator,
-then the size. */
- else if (gnu_obj)
- gnu_call = build_call_n_expr (gnu_proc, 2, gnu_obj, gnu_size);
-
else
gnu_call = build_call_n_expr (gnu_proc, 2, gnu_size, gnu_align);
}
--
2.43.2
[COMMITTED 29/31] ada: Fix internal error on discriminated record with Atomic aspect in Ada 2022
From: Eric Botcazou It occurs in build_load_modify_store where the pattern matching logic cannot find the atomic load that is present in the tree because it has been wrapped in a SAVE_EXPR by gnat_protect_expr, which is unnecessary. gcc/ada/ * gcc-interface/utils2.cc (gnat_protect_expr): Deal specifically with atomic loads. Document the relationship with gnat_save_expr. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/utils2.cc | 13 - 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index c1346cfadeb..8fb86ab29e3 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -2887,7 +2887,11 @@ gnat_save_expr (tree exp) /* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that is optimized under the assumption that EXP's value doesn't change before - its subsequent reuse(s) except through its potential reevaluation. */ + its subsequent reuse(s) except potentially through its reevaluation. + + gnat_protect_expr guarantees that multiple evaluations of the expression + will not generate multiple side effects, whereas gnat_save_expr further + guarantees that all evaluations will yield the same result. */ tree gnat_protect_expr (tree exp) @@ -2932,6 +2936,13 @@ gnat_protect_expr (tree exp) return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)), TREE_OPERAND (exp, 1), NULL_TREE); + /* An atomic load is an INDIRECT_REF of its first argument, so apply the + same transformation as in the INDIRECT_REF case above. */ + if (code == CALL_EXPR && call_is_atomic_load (exp)) +return build_call_expr (TREE_OPERAND (CALL_EXPR_FN (exp), 0), 2, + gnat_protect_expr (CALL_EXPR_ARG (exp, 0)), + CALL_EXPR_ARG (exp, 1)); + /* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer. This may be more efficient, but will also allow us to more easily find the match for the PLACEHOLDER_EXPR. */ -- 2.43.2
[COMMITTED 27/31] ada: Make detection of useless copy for return more robust
From: Eric Botcazou In the return-by-invisible-reference case, the return object of an extended return statement is allocated directly on the return stack and, therefore, the copy operation on return is useless. The code detecting this was not robust enough and missed some complex cases. gcc/ada/ * gcc-interface/trans.cc (gnat_to_gnu) : In the return-by-invisible-reference case, remove conversions before looking for a dereference in the return values and building the test protecting against a useless copy operation. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/trans.cc | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index a6b86ec8b51..4ae599b8b4c 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -7767,11 +7767,12 @@ gnat_to_gnu (Node_Id gnat_node) gnu_result = build2 (INIT_EXPR, void_type_node, gnu_ret_deref, gnu_ret_val); /* Avoid a useless copy with __builtin_return_slot. */ - if (INDIRECT_REF_P (gnu_ret_val)) + tree gnu_inner_val = remove_conversions (gnu_ret_val, false); + if (INDIRECT_REF_P (gnu_inner_val)) gnu_result = build3 (COND_EXPR, void_type_node, fold_build2 (NE_EXPR, boolean_type_node, - TREE_OPERAND (gnu_ret_val, 0), + TREE_OPERAND (gnu_inner_val, 0), gnu_ret_obj), gnu_result, NULL_TREE); add_stmt_with_node (gnu_result, gnat_node); -- 2.43.2
[COMMITTED 24/31] ada: Minor typo fix in comment
gcc/ada/ * gcc-interface/decl.cc: Fix typo in comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/decl.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc index e16ee6edac5..0987d534e69 100644 --- a/gcc/ada/gcc-interface/decl.cc +++ b/gcc/ada/gcc-interface/decl.cc @@ -5629,7 +5629,7 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first, by_ref = true; } - /* If we were requested or muss pass by reference, do so. + /* If we were requested or must pass by reference, do so. If we were requested to pass by copy, do so. Otherwise, for foreign conventions, pass In Out or Out parameters or aggregates by reference. For COBOL and Fortran, pass all -- 2.43.2
[COMMITTED 22/31] ada: Avoid temporary for conditional expression of discriminated record type
From: Eric Botcazou
This just aligns the definite case (discriminants with default) with the
indefinite case (discriminants without default), the latter case having
been properly handled for long. In the former case, the maximum size is
used so a temporary can be much larger than the actual data it contains.
gcc/ada/
* gcc-interface/utils2.cc (build_cond_expr): Use the indirect path
for all types containing a placeholder.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/utils2.cc | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
index a953b070ed8..fb0ccf59224 100644
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -1715,8 +1715,8 @@ build_cond_expr (tree result_type, tree condition_operand,
then dereference the result. Likewise if the result type is passed by
reference, because creating a temporary of this type is not allowed. */
if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE
- || TYPE_IS_BY_REFERENCE_P (result_type)
- || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)))
+ || type_contains_placeholder_p (result_type)
+ || TYPE_IS_BY_REFERENCE_P (result_type))
{
result_type = build_pointer_type (result_type);
true_operand = build_unary_op (ADDR_EXPR, result_type, true_operand);
--
2.43.2
[COMMITTED 17/31] ada: Fix oversight in previous change
From: Eric Botcazou In rare cases, types using structural equality may reach relate_alias_sets. gcc/ada/ * gcc-interface/utils.cc (relate_alias_sets): Restore previous code when the type uses structural equality. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/utils.cc | 7 +-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/gcc/ada/gcc-interface/utils.cc b/gcc/ada/gcc-interface/utils.cc index b628481335d..ae520542ace 100644 --- a/gcc/ada/gcc-interface/utils.cc +++ b/gcc/ada/gcc-interface/utils.cc @@ -1867,8 +1867,11 @@ relate_alias_sets (tree new_type, tree old_type, enum alias_set_op op) && TYPE_NONALIASED_COMPONENT (new_type) != TYPE_NONALIASED_COMPONENT (old_type))); - /* The alias set always lives on the TYPE_CANONICAL. */ - TYPE_ALIAS_SET (TYPE_CANONICAL (new_type)) = get_alias_set (old_type); + /* The alias set is a property of the TYPE_CANONICAL if it exists. */ + if (TYPE_STRUCTURAL_EQUALITY_P (new_type)) + TYPE_ALIAS_SET (new_type) = get_alias_set (old_type); + else + TYPE_ALIAS_SET (TYPE_CANONICAL (new_type)) = get_alias_set (old_type); break; case ALIAS_SET_SUBSET: -- 2.43.2
[COMMITTED 18/31] ada: Fix small inaccuracy for Size attribute applied to objects
From: Eric Botcazou
This reverts a change made some time ago in lvalue_required_for_attribute_p
whereby the Size attribute applied to objects would no longer be considered
as requiring an lvalue.
While not wrong in principle, this turns out to be problematic because the
implementation in Attribute_to_gnu needs to look at the translated prefix
to spot particular cases and not only at the actual type of its value.
This of course requires a small adjustment in gnat_to_gnu to compensate.
gcc/ada/
* gcc-interface/trans.cc (access_attribute_p): New predicate.
(lvalue_required_for_attribute_p): Return again 1 for Size and add
the missing terminating call to gcc_unreachable.
(gnat_to_gnu): Return the result unmodified for a reference to an
unconstrained array only if it is the prefix of an access attribute.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/trans.cc | 28 +---
1 file changed, 25 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 8c7ffbf5687..6f761766559 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -745,6 +745,26 @@ build_raise_check (int check, enum exception_info_kind
kind)
return result;
}
+/* Return true if GNAT_NODE, which is an N_Attribute_Reference, is one of the
+ access attributes. */
+
+static bool
+access_attribute_p (Node_Id gnat_node)
+{
+ switch (Get_Attribute_Id (Attribute_Name (gnat_node)))
+{
+case Attr_Access:
+case Attr_Unchecked_Access:
+case Attr_Unrestricted_Access:
+ return true;
+
+default:
+ return false;
+}
+
+ gcc_unreachable ();
+}
+
/* Return a positive value if an lvalue is required for GNAT_NODE, which is
an N_Attribute_Reference. */
@@ -760,7 +780,6 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
case Attr_Range_Length:
case Attr_Length:
case Attr_Object_Size:
-case Attr_Size:
case Attr_Value_Size:
case Attr_Component_Size:
case Attr_Descriptor_Size:
@@ -786,11 +805,14 @@ lvalue_required_for_attribute_p (Node_Id gnat_node)
case Attr_First_Bit:
case Attr_Last_Bit:
case Attr_Bit:
+case Attr_Size:
case Attr_Asm_Input:
case Attr_Asm_Output:
default:
return 1;
}
+
+ gcc_unreachable ();
}
/* Return a positive value if an lvalue is required for GNAT_NODE. GNU_TYPE
@@ -8472,7 +8494,7 @@ gnat_to_gnu (Node_Id gnat_node)
return slot optimization in this case.
5. If this is a reference to an unconstrained array which is used either
- as the prefix of an attribute reference that requires an lvalue or in
+ as the prefix of an attribute reference for an access attribute or in
a return statement without storage pool, return the result unmodified
because we want to return the original bounds.
@@ -8539,7 +8561,7 @@ gnat_to_gnu (Node_Id gnat_node)
else if (TREE_CODE (TREE_TYPE (gnu_result)) == UNCONSTRAINED_ARRAY_TYPE
&& Present (Parent (gnat_node))
&& ((Nkind (Parent (gnat_node)) == N_Attribute_Reference
- && lvalue_required_for_attribute_p (Parent (gnat_node)))
+ && access_attribute_p (Parent (gnat_node)))
|| (Nkind (Parent (gnat_node)) == N_Simple_Return_Statement
&& No (Storage_Pool (Parent (gnat_node))
;
--
2.43.2
[COMMITTED 19/31] ada: Fix crash on aliased constant with packed array type and -g switch
From: Eric Botcazou
The problem is that we build a template whose array field is not an array
in the case of an aliased object with nominal unconstrained array subtype.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : For an
array allocated with its bounds, make sure to have an array type
to build the template.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 3 +++
1 file changed, 3 insertions(+)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index ca174bff009..41d5c29a17c 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -939,6 +939,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
&& !type_annotate_only)
{
tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
+ /* Make sure to have an array type for the template. */
+ if (TYPE_IS_PADDING_P (gnu_type))
+ gnu_type = TREE_TYPE (TYPE_FIELDS (gnu_type));
gnu_type
= build_unc_object_type_from_ptr (TREE_TYPE (gnu_array),
gnu_type,
--
2.43.2
[COMMITTED 14/31] ada: Remove duplicate statement
From: Ronan Desplanques This patch removes a duplicate statement that was useless and could be misleading to the reader by suggesting that there are multiple global variables named Style_Check, while there is just one. gcc/ada/ * frontend.adb (Frontend): Remove duplicate statement. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/frontend.adb | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index bd0f0c44ff4..ece0e728e4a 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -158,7 +158,6 @@ begin -- intended -gnatg or -gnaty compilations. We also disconnect checking -- for maximum line length. - Opt.Style_Check := False; Style_Check := False; -- Capture current suppress options, which may get modified -- 2.43.2
[COMMITTED 20/31] ada: Fix assembler error for gigantic library-level object on 64-bit Windows
From: Eric Botcazou
Most small 64-bit code models have a limit of 2 GB on the span of binaries,
so we also use the limit for the size of the largest statically allocatable
object by the compiler. If the limit is topped, the compiler switches over
to a dynamic allocation (if not forbidden) after giving a warning.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : Give a
warning for a statically allocated object whose size is constant,
valid but too large.
(allocatable_size_p): In the static case, return false for a size
that is constant, valid but too large.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 27 +--
1 file changed, 21 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 41d5c29a17c..e16ee6edac5 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -1415,10 +1415,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
false);
}
- if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST
- && !valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
- post_error ("??Storage_Error will be raised at run time!",
- gnat_entity);
+ /* Give a warning if the size is constant but too large. */
+ if (TREE_CODE (TYPE_SIZE_UNIT (gnu_alloc_type)) == INTEGER_CST)
+ {
+ if (valid_constant_size_p (TYPE_SIZE_UNIT (gnu_alloc_type)))
+ {
+ post_error
+ ("??too large object cannot be allocated statically",
+ gnat_entity);
+ post_error ("\\?dynamic allocation will be used
instead",
+ gnat_entity);
+ }
+
+ else
+ post_error ("??Storage_Error will be raised at run time!",
+ gnat_entity);
+ }
gnu_expr
= build_allocator (gnu_alloc_type, gnu_expr, gnu_type,
@@ -6822,9 +6834,12 @@ constructor_address_p (tree gnu_expr)
static bool
allocatable_size_p (tree gnu_size, bool static_p)
{
- /* We can allocate a fixed size if it is a valid for the middle-end. */
+ /* We can allocate a fixed size if it is a valid for the middle-end but, for
+ a static allocation, we do not allocate more than 2 GB because this would
+ very likely be unintended and problematic for usual code models. */
if (TREE_CODE (gnu_size) == INTEGER_CST)
-return valid_constant_size_p (gnu_size);
+return valid_constant_size_p (gnu_size)
+ && (!static_p || tree_to_uhwi (gnu_size) <= INT_MAX);
/* We can allocate a variable size if this isn't a static allocation. */
else
--
2.43.2
[COMMITTED 15/31] ada: Fix layout in a list of aspects
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * aspects.ads (Nonoverridable_Aspect_Id): Fix layout. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/aspects.ads | 19 +++ 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index ce393d4f602..3cc62de3411 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -237,14 +237,17 @@ package Aspects is -- Aspect_Id's excluding No_Aspect subtype Nonoverridable_Aspect_Id is Aspect_Id with - Static_Predicate => Nonoverridable_Aspect_Id in - Aspect_Default_Iterator | Aspect_Iterator_Element | - Aspect_Implicit_Dereference | Aspect_Constant_Indexing | - Aspect_Variable_Indexing | Aspect_Aggregate | - Aspect_Max_Entry_Queue_Length -| Aspect_No_Controlled_Parts - -- ??? No_Controlled_Parts not yet in Aspect_Id enumeration - ; -- see RM 13.1.1(18.7) + Static_Predicate => + Nonoverridable_Aspect_Id in Aspect_Aggregate + | Aspect_Constant_Indexing + | Aspect_Default_Iterator + | Aspect_Implicit_Dereference + | Aspect_Iterator_Element + | Aspect_Max_Entry_Queue_Length + | Aspect_No_Controlled_Parts + | Aspect_Variable_Indexing; + -- ??? No_Controlled_Parts not yet in Aspect_Id enumeration see RM + -- 13.1.1(18.7). -- The following array indicates aspects that accept 'Class -- 2.43.2
[COMMITTED 28/31] ada: Fix strict aliasing violation in parameter passing (continued)
From: Eric Botcazou
This fixes another long-standing (implicit) violation of the strict aliasing
rules that occurs when the result of a value conversion is directly passed
as an actual parameter in a call to a subprogram and the passing mechanism
is by reference. In this case, the reference passed to the subprogram may
be to a type that is too different from the type of the underlying object,
which is the definition of such a violation.
The change reworks and strengthens the previous fix as follows: first, the
detection of these violations is moved into a dedicated predicate; second,
an assertion is added to check that none of them has been missed, which is
triggered by either -fchecking or -fstrict-aliasing, as the closely related
assertion that is present in relate_alias_sets.
The assertion uncovered two internal sources of violations: implementation
types for packed array types with peculiar index types and interface types,
which are fixed by propagating alias sets in the first case and resorting to
universal aliasing in the second case.
Finally, an unconditional warning is implemented to inform the user that the
temporary is created and to suggest a possible solution to prevent that.
gcc/ada/
* gcc-interface/decl.cc (gnat_to_gnu_entity) : For a
packed type implemented specially, temporarily save the XUA type as
equivalent to the entity before processing the implementation type.
For this implementation type, if its component type is the same as
that of the original type, copy the alias set from the latter.
: Resort to universal aliasing for all interface types.
* gcc-interface/trans.cc (Call_to_gnu): Add GNU_ACTUAL_TYPE local
variable and rename existing one to GNU_UNPADDED_ACTUAL_TYPE.
If the formal is passed by reference and the actual is a conversion,
call aliasable_p to detect aliasing violations, issue a warning upon
finding one and create the temporary in the target type.
Add an assertion that no such violation has been missed above.
(addressable_p): Revert latest changes.
(aliasable_p): New predicate.
* gcc-interface/utils2.cc (build_binary_op) : When
creating a new array type on the fly, preserve the alias set of the
operation type.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/decl.cc | 48 ++---
gcc/ada/gcc-interface/trans.cc | 167 +++-
gcc/ada/gcc-interface/utils2.cc | 6 +-
3 files changed, 159 insertions(+), 62 deletions(-)
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index ab54d2ccf13..6e40a157734 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -2119,6 +2119,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
case E_Array_Type:
{
+ const Entity_Id OAT = Original_Array_Type (gnat_entity);
const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity);
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
@@ -2392,14 +2393,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree
gnu_expr, bool definition)
set_typeless_storage_on_aggregate_type (tem);
}
- /* If this is a packed type implemented specially, then process the
- implementation type so it is elaborated in the proper scope. */
- if (Present (PAT))
- gnat_to_gnu_entity (PAT, NULL_TREE, false);
-
- /* Otherwise, if an alignment is specified, use it if valid and, if
- the alignment was requested with an explicit clause, state so. */
- else if (Known_Alignment (gnat_entity))
+ /* If an alignment is specified for an array that is not a packed type
+ implemented specially, use the alignment if it is valid and, if it
+ was requested with an explicit clause, preserve the information. */
+ if (Known_Alignment (gnat_entity) && No (PAT))
{
SET_TYPE_ALIGN (tem,
validate_alignment (Alignment (gnat_entity),
@@ -2418,7 +2415,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
TYPE_BIT_PACKED_ARRAY_TYPE_P (tem)
= (Is_Packed_Array_Impl_Type (gnat_entity)
-? Is_Bit_Packed_Array (Original_Array_Type (gnat_entity))
+? Is_Bit_Packed_Array (OAT)
: Is_Bit_Packed_Array (gnat_entity));
if (Treat_As_Volatile (gnat_entity))
@@ -2447,8 +2444,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr,
bool definition)
TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size;
/* See the above description for the rationale. */
- create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
- artificial_p, debug_info_p, gnat_entity);
+ tree gnu_tmp_decl
+ = create_type_decl
[COMMITTED 10/31] ada: Remove some explicit yields in tasking run-time
From: Ronan Desplanques This patch removes three occurrences where tasking run-time subprograms yielded control shortly before conditional calls to Sleep, in order to avoid these calls more often. It was intended as an optimization on systems where calls to Sleep are costly and in particular VMS. A problem was that two of the yields contained data races that were reported by thread sanitizing tools on some platforms, and that's the motivation for removing them. gcc/ada/ * libgnarl/s-taenca.adb (Wait_For_Completion): Remove call to Yield. * libgnarl/s-tasren.adb (Timed_Selective_Wait, Wait_For_Call): Remove calls to Yield. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taenca.adb | 12 gcc/ada/libgnarl/s-tasren.adb | 24 2 files changed, 36 deletions(-) diff --git a/gcc/ada/libgnarl/s-taenca.adb b/gcc/ada/libgnarl/s-taenca.adb index cd9c53b19fe..1dc8ec518bd 100644 --- a/gcc/ada/libgnarl/s-taenca.adb +++ b/gcc/ada/libgnarl/s-taenca.adb @@ -410,18 +410,6 @@ package body System.Tasking.Entry_Calls is Self_Id.Common.State := Entry_Caller_Sleep; - -- Try to remove calls to Sleep in the loop below by letting the caller - -- a chance of getting ready immediately, using Unlock & Yield. - -- See similar action in Wait_For_Call & Timed_Selective_Wait. - - STPO.Unlock (Self_Id); - - if Entry_Call.State < Done then - STPO.Yield; - end if; - - STPO.Write_Lock (Self_Id); - loop Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call); diff --git a/gcc/ada/libgnarl/s-tasren.adb b/gcc/ada/libgnarl/s-tasren.adb index d65b9f011b0..6face7ef8d4 100644 --- a/gcc/ada/libgnarl/s-tasren.adb +++ b/gcc/ada/libgnarl/s-tasren.adb @@ -1317,18 +1317,6 @@ package body System.Tasking.Rendezvous is Self_Id.Common.State := Acceptor_Delay_Sleep; --- Try to remove calls to Sleep in the loop below by letting the --- caller a chance of getting ready immediately, using Unlock --- Yield. See similar action in Wait_For_Completion/Wait_For_Call. - -Unlock (Self_Id); - -if Self_Id.Open_Accepts /= null then - Yield; -end if; - -Write_Lock (Self_Id); - -- Check if this task has been aborted while the lock was released if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then @@ -1510,18 +1498,6 @@ package body System.Tasking.Rendezvous is begin Self_Id.Common.State := Acceptor_Sleep; - -- Try to remove calls to Sleep in the loop below by letting the caller - -- a chance of getting ready immediately, using Unlock & Yield. - -- See similar action in Wait_For_Completion & Timed_Selective_Wait. - - Unlock (Self_Id); - - if Self_Id.Open_Accepts /= null then - Yield; - end if; - - Write_Lock (Self_Id); - -- Check if this task has been aborted while the lock was released if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then -- 2.43.2
[COMMITTED 16/31] ada: Missing constraint check for initial value of object with address clause
From: Steve Baird In some cases where an object is declared with an initial value that is an aggregate and also with a specified Address (either via an aspect_specification or via an attribute_definition_clause), the check that the initial value satisfies the constraints of the object's subtype was incorrectly omitted. gcc/ada/ * exp_util.adb (Remove_Side_Effects): Make_Reference assumes that the referenced object satisfies the constraints of the designated subtype of the access type. Ensure that this assumption holds by introducing a qualified expression if needed (and then ensuring that checking associated with evaluation of the qualified expression is not suppressed). Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_util.adb | 29 + 1 file changed, 29 insertions(+) diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b71f7739481..654ea7d9124 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -12772,6 +12772,35 @@ package body Exp_Util is -- since we know it cannot be null and we don't want a check. else + -- Make_Reference assumes that the referenced + -- object satisfies the constraints of the designated + -- subtype of the access type. Ensure that this assumption + -- holds by introducing a qualified expression if needed. + + if not Analyzed (Exp) + and then Nkind (Exp) = N_Aggregate + and then (Is_Array_Type (Exp_Type) + or else Has_Discriminants (Exp_Type)) + and then Is_Constrained (Exp_Type) + then + -- Do not suppress checks associated with the qualified + -- expression we are about to introduce (unless those + -- checks were already suppressed when Remove_Side_Effects + -- was called). + + if Is_Array_Type (Exp_Type) then + Scope_Suppress.Suppress (Length_Check) + := Svg_Suppress.Suppress (Length_Check); + else + Scope_Suppress.Suppress (Discriminant_Check) + := Svg_Suppress.Suppress (Discriminant_Check); + end if; + + E := Make_Qualified_Expression (Loc, + Subtype_Mark => New_Occurrence_Of (Exp_Type, Loc), + Expression => E); + end if; + New_Exp := Make_Reference (Loc, E); Set_Is_Known_Non_Null (Def_Id); end if; -- 2.43.2
[COMMITTED 13/31] ada: Remove useless trampolines caused by Unchecked_Conversion
From: Eric Botcazou The partial solution implemented in Validate_Unchecked_Conversion to support unchecked conversions between addresses and pointers to subprograms, for the platforms where pointers to subprograms do not all have the same size, turns out to be counter-productive for others because it may cause the creation of useless trampolines, which in turn makes the stack executable. gcc/ada/ * sem_ch13.adb (Validate_Unchecked_Conversion): Restrict forcing the Can_Use_Internal_Rep flag to platforms that require unnesting. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_ch13.adb | 29 - 1 file changed, 16 insertions(+), 13 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 59c80022c20..4cf6fc9a645 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -18132,20 +18132,23 @@ package body Sem_Ch13 is Set_No_Strict_Aliasing (Implementation_Base_Type (Target)); end if; - -- If the unchecked conversion is between Address and an access - -- subprogram type, show that we shouldn't use an internal - -- representation for the access subprogram type. + -- For code generators that do not support nested subprograms, if the + -- unchecked conversion is between Address and an access subprogram + -- type, show that we shouldn't use an internal representation for the + -- access subprogram type. - if Is_Access_Subprogram_Type (Target) -and then Is_Descendant_Of_Address (Source) -and then In_Same_Source_Unit (Target, N) - then - Set_Can_Use_Internal_Rep (Base_Type (Target), False); - elsif Is_Access_Subprogram_Type (Source) -and then Is_Descendant_Of_Address (Target) -and then In_Same_Source_Unit (Source, N) - then - Set_Can_Use_Internal_Rep (Base_Type (Source), False); + if Unnest_Subprogram_Mode then + if Is_Access_Subprogram_Type (Target) + and then Is_Descendant_Of_Address (Source) + and then In_Same_Source_Unit (Target, N) + then +Set_Can_Use_Internal_Rep (Base_Type (Target), False); + elsif Is_Access_Subprogram_Type (Source) + and then Is_Descendant_Of_Address (Target) + and then In_Same_Source_Unit (Source, N) + then +Set_Can_Use_Internal_Rep (Base_Type (Source), False); + end if; end if; -- Generate N_Validate_Unchecked_Conversion node for back end in case -- 2.43.2
[COMMITTED 21/31] ada: Remove unused dependencies from gnatbind object list
From: Piotr Trojanek The gnatbind executable does not depend on aspects, SCIL, style checks, etc. Also, these dependencies are not needed to actually build the executable. Cleanup. gcc/ada/ * gcc-interface/Make-lang.in (GNATBIND_OBJS): Remove unused dependencies. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/Make-lang.in | 5 - 1 file changed, 5 deletions(-) diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index f6404c0b1eb..4f1b310fb84 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -572,7 +572,6 @@ GNATBIND_OBJS = \ ada/ali-util.o \ ada/ali.o\ ada/alloc.o \ - ada/aspects.o\ ada/atree.o \ ada/bcheck.o \ ada/binde.o \ @@ -602,12 +601,10 @@ GNATBIND_OBJS = \ ada/exit.o \ ada/final.o \ ada/fmap.o \ - ada/fname-uf.o \ ada/fname.o \ ada/gnatbind.o \ ada/gnatvsn.o\ ada/hostparm.o \ - ada/krunch.o \ ada/lib.o\ ada/link.o \ ada/namet.o \ @@ -618,7 +615,6 @@ GNATBIND_OBJS = \ ada/output.o \ ada/rident.o \ ada/scans.o \ - ada/scil_ll.o\ ada/scng.o \ ada/sdefault.o \ ada/seinfo.o\ @@ -631,7 +627,6 @@ GNATBIND_OBJS = \ ada/snames.o \ ada/stand.o \ ada/stringt.o\ - ada/style.o \ ada/styleg.o \ ada/stylesw.o\ ada/switch-b.o \ -- 2.43.2
[COMMITTED 01/31] ada: Add new Mingw task priority mapping
From: Justin Squirek This patch adds a new mapping (Non_FIFO_Underlying_Priorities) for dynamically setting task priorities in Windows when pragma Task_Dispatching_Policy (FIFO_Within_Priorities) is not present. Additionally, it documents the requirement to specify the pragma in order to use Set_Priority in the general case. gcc/ada/ * doc/gnat_ugn/platform_specific_information.rst: Add note about different priority level granularities under different policies in Windows and move POSIX related info into new section. * libgnarl/s-taprop.ads: Add note about Task_Dispatching_Policy. * libgnarl/s-taprop__mingw.adb: (Set_Priority): Add use of Non_FIFO_Underlying_Priorities. * libgnat/system-mingw.ads: Add documentation for modifying priority mappings and add alternative mapping Non_FIFO_Underlying_Priorities. * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- .../platform_specific_information.rst | 117 +++--- gcc/ada/gnat_ugn.texi | 359 +- gcc/ada/libgnarl/s-taprop.ads | 9 + gcc/ada/libgnarl/s-taprop__mingw.adb | 5 +- gcc/ada/libgnat/system-mingw.ads | 27 +- 5 files changed, 289 insertions(+), 228 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst index 3744b742f8e..7eeb6c2c396 100644 --- a/gcc/ada/doc/gnat_ugn/platform_specific_information.rst +++ b/gcc/ada/doc/gnat_ugn/platform_specific_information.rst @@ -171,57 +171,6 @@ Selecting another run-time library temporarily can be achieved by using the :switch:`--RTS` switch, e.g., :switch:`--RTS=sjlj` -.. _Choosing_the_Scheduling_Policy: - -.. index:: SCHED_FIFO scheduling policy -.. index:: SCHED_RR scheduling policy -.. index:: SCHED_OTHER scheduling policy - -Choosing the Scheduling Policy --- - -When using a POSIX threads implementation, you have a choice of several -scheduling policies: ``SCHED_FIFO``, ``SCHED_RR`` and ``SCHED_OTHER``. - -Typically, the default is ``SCHED_OTHER``, while using ``SCHED_FIFO`` -or ``SCHED_RR`` requires special (e.g., root) privileges. - -.. index:: pragma Time_Slice -.. index:: -T0 option -.. index:: pragma Task_Dispatching_Policy - - -By default, GNAT uses the ``SCHED_OTHER`` policy. To specify -``SCHED_FIFO``, -you can use one of the following: - -* ``pragma Time_Slice (0.0)`` -* the corresponding binder option :switch:`-T0` -* ``pragma Task_Dispatching_Policy (FIFO_Within_Priorities)`` - - -To specify ``SCHED_RR``, -you should use ``pragma Time_Slice`` with a -value greater than 0.0, or else use the corresponding :switch:`-T` -binder option. - - -To make sure a program is running as root, you can put something like -this in a library package body in your application: - - .. code-block:: ada - - function geteuid return Integer; - pragma Import (C, geteuid, "geteuid"); - Ignore : constant Boolean := - (if geteuid = 0 then True else raise Program_Error with "must be root"); - -It gets the effective user id, and if it's not 0 (i.e. root), it raises -Program_Error. Note that if you re running the code in a container, this may -not be sufficient, as you may have sufficient priviledge on the container, -but not on the host machine running the container, so check that you also -have sufficient priviledge for running the container image. - .. index:: Linux .. index:: GNU/Linux @@ -296,6 +245,55 @@ drop the :samp:`-no-pie` workaround, you'll need to get the identified dependencies rebuilt with PIE enabled (compiled with :samp:`-fPIE` and linked with :samp:`-pie`). +.. _Choosing_the_Scheduling_Policy_With_GNU_Linux: + +.. index:: SCHED_FIFO scheduling policy +.. index:: SCHED_RR scheduling policy +.. index:: SCHED_OTHER scheduling policy + +Choosing the Scheduling Policy with GNU/Linux +- + +When using a POSIX threads implementation, you have a choice of several +scheduling policies: ``SCHED_FIFO``, ``SCHED_RR`` and ``SCHED_OTHER``. + +Typically, the default is ``SCHED_OTHER``, while using ``SCHED_FIFO`` +or ``SCHED_RR`` requires special (e.g., root) privileges. + +.. index:: pragma Time_Slice +.. index:: -T0 option +.. index:: pragma Task_Dispatching_Policy + + +By default, GNAT uses the ``SCHED_OTHER`` policy. To specify +``SCHED_FIFO``, +you can use one of the following: + +* ``pragma Time_Slice (0.0)`` +* the corresponding binder option :switch:`-T0` +* ``pragma Task_Dispatching_Policy (FIFO_Within_Priorities)`` + +To specify ``SCHED_RR``, +you should use ``pragma Time_Slice`` with a +value greater than 0.0, or else use the corresponding :switch:`-T` +binder option. + +To make sure a program is running as root, you can put something like +this in a library package body in your application: + + .. code-block:: ada + +
[COMMITTED 11/31] ada: Simplify management of scopes while inlining
From: Piotr Trojanek
Code cleanup; semantics is unaffected.
gcc/ada/
* inline.adb (Add_Scope_To_Clean): Use Append_Unique_Elmt.
(Analyze_Inlined_Bodies): Refine type of a local counter;
remove extra whitespace.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/inline.adb | 19 ---
1 file changed, 4 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index a628a59e145..17b3099e6a6 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -845,19 +845,8 @@ package body Inline is
procedure Add_Scope_To_Clean (Scop : Entity_Id) is
- Elmt : Elmt_Id;
-
begin
- Elmt := First_Elmt (To_Clean);
- while Present (Elmt) loop
- if Node (Elmt) = Scop then
-return;
- end if;
-
- Next_Elmt (Elmt);
- end loop;
-
- Append_Elmt (Scop, To_Clean);
+ Append_Unique_Elmt (Scop, To_Clean);
end Add_Scope_To_Clean;
--
@@ -915,7 +904,7 @@ package body Inline is
procedure Analyze_Inlined_Bodies is
Comp_Unit : Node_Id;
- J : Int;
+ J : Nat;
Pack : Entity_Id;
Subp : Subp_Index;
S : Succ_Index;
@@ -2569,8 +2558,8 @@ package body Inline is
(Proc_Id : out Entity_Id;
Decl_List : out List_Id)
is
-Formals : constant List_Id := New_List;
-Subp_Name : constant Name_Id := New_Internal_Name ('F');
+Formals : constant List_Id := New_List;
+Subp_Name : constant Name_Id := New_Internal_Name ('F');
Body_Decls : List_Id := No_List;
Decl : Node_Id;
--
2.43.2
[COMMITTED 05/31] ada: Do not leak tagged type names when Discard_Names is enabled
From: Piotr Trojanek
When both pragmas Discard_Names and No_Tagged_Streams apply to a tagged
type, the intended behavior is to prevent type names from leaking into
object code, as documented in GNAT RM.
However, while Discard_Names can be used as a configuration pragma,
No_Tagged_Streams must be applied to each type separately. This patch
enables the use of restriction No_Streams, which can be activated
globally, instead of No_Tagged_Streams on individual types.
When no tagged stream object can be created and allocated, then routines
that make use of the External_Tag won't be used.
gcc/ada/
* doc/gnat_rm/implementation_defined_pragmas.rst
(No_Tagged_Streams): Document how to avoid exposing entity names
for the entire partition.
* exp_disp.adb (Make_DT): Make use of restriction No_Streams.
* exp_put_image.adb (Build_Record_Put_Image_Procedure): Respect
Discard_Names in the generated Put_Image procedure.
* gnat_rm.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../implementation_defined_pragmas.rst| 6
gcc/ada/exp_disp.adb | 5 +--
gcc/ada/exp_put_image.adb | 34 ++-
gcc/ada/gnat_rm.texi | 6
4 files changed, 41 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 0661670e047..7e4dd935342 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -4000,6 +4000,12 @@ applied to a tagged type its Expanded_Name and
External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
+Alternatively, when pragmas ``Discard_Names`` and ``Restrictions (No_Streams)``
+simultanously apply to a tagged type, its Expanded_Name and External_Tag are
+also initialized with empty strings. In particular, both these pragmas can be
+applied as configuration pragmas to avoid exposing entity names at binary
+level for the entire parition.
+
Pragma Normalize_Scalars
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 601d463a8b0..66be77c9ffc 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4600,8 +4600,9 @@ package body Exp_Disp is
--streams.
Discard_Names : constant Boolean :=
-Present (No_Tagged_Streams_Pragma (Typ))
- and then
+(Present (No_Tagged_Streams_Pragma (Typ))
+ or else Restriction_Active (No_Streams))
+ and then
(Global_Discard_Names or else Einfo.Entities.Discard_Names (Typ));
-- The following name entries are used by Make_DT to generate a number
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 09fbfa75eeb..94299e39661 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -44,6 +44,7 @@ with Sinfo.Nodes;use Sinfo.Nodes;
with Sinfo.Utils;use Sinfo.Utils;
with Snames; use Snames;
with Stand;
+with Stringt;use Stringt;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
@@ -825,14 +826,31 @@ package body Exp_Put_Image is
Make_Raise_Program_Error (Loc,
Reason => PE_Explicit_Raise));
else
-Append_To (Stms,
- Make_Procedure_Call_Statement (Loc,
-Name => New_Occurrence_Of (RTE (RE_Put_Image_Unknown), Loc),
-Parameter_Associations => New_List
- (Make_Identifier (Loc, Name_S),
- Make_String_Literal (Loc,
- Fully_Qualified_Name_String
- (Btyp, Append_NUL => False);
+declare
+ Type_Name : String_Id;
+begin
+ -- If aspect Discard_Names is enabled the intention is to
+ -- prevent type names from leaking into object file. Instead,
+ -- we emit string that is different from the ones from the
+ -- default implementations of the Put_Image attribute.
+
+ if Global_Discard_Names or else Discard_Names (Typ) then
+ Start_String;
+ Store_String_Chars ("(DISCARDED TYPE NAME)");
+ Type_Name := End_String;
+ else
+ Type_Name :=
+Fully_Qualified_Name_String (Btyp, Append_NUL => False);
+ end if;
+
+ Append_To (Stms,
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (RTE (RE_Put_Image_Unknown), Loc),
+ Parameter_Associations => New_List
+ (Make_Identifier (Loc, Name_S),
[COMMITTED 06/31] ada: Update documentation of warning messages
From: Viljar Indus
Update the documentation of warning messages that only
emit info messages to clearly reflect that they only emit
info messages and not warning messages.
gcc/ada/
* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
Update the documentation of -gnatw.n and -gnatw.l
* gnat_ugn.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../building_executable_programs_with_gnat.rst | 14 +++---
gcc/ada/gnat_ugn.texi| 16
2 files changed, 15 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index 21e277d5916..2f63d02daf7 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -3415,7 +3415,7 @@ of the pragma in the :title:`GNAT_Reference_manual`).
.. index:: -gnatw.l (gcc)
:switch:`-gnatw.l`
- *List inherited aspects.*
+ *List inherited aspects as info messages.*
This switch causes the compiler to list inherited invariants,
preconditions, and postconditions from Type_Invariant'Class, Invariant'Class,
@@ -3425,7 +3425,7 @@ of the pragma in the :title:`GNAT_Reference_manual`).
.. index:: -gnatw.L (gcc)
:switch:`-gnatw.L`
- *Suppress listing of inherited aspects.*
+ *Suppress listing of inherited aspects as info messages.*
This switch suppresses listing of inherited aspects.
@@ -3495,20 +3495,20 @@ of the pragma in the :title:`GNAT_Reference_manual`).
.. index:: Atomic Synchronization, warnings
:switch:`-gnatw.n`
- *Activate warnings on atomic synchronization.*
+ *Activate info messages on atomic synchronization.*
- This switch actives warnings when an access to an atomic variable
+ This switch activates info messages when an access to an atomic variable
requires the generation of atomic synchronization code. These
- warnings are off by default.
+ info messages are off by default.
.. index:: -gnatw.N (gcc)
:switch:`-gnatw.N`
- *Suppress warnings on atomic synchronization.*
+ *Suppress info messages on atomic synchronization.*
.. index:: Atomic Synchronization, warnings
- This switch suppresses warnings when an access to an atomic variable
+ This switch suppresses info messages when an access to an atomic variable
requires the generation of atomic synchronization code.
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 43251ba3f1c..2df2a780ec7 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -11646,7 +11646,7 @@ This switch suppresses warnings for possible
elaboration problems.
@item @code{-gnatw.l}
-`List inherited aspects.'
+`List inherited aspects as info messages.'
This switch causes the compiler to list inherited invariants,
preconditions, and postconditions from Type_Invariant’Class, Invariant’Class,
@@ -11660,7 +11660,7 @@ Pre’Class, and Post’Class aspects. Also list inherited
subtype predicates.
@item @code{-gnatw.L}
-`Suppress listing of inherited aspects.'
+`Suppress listing of inherited aspects as info messages.'
This switch suppresses listing of inherited aspects.
@end table
@@ -11755,11 +11755,11 @@ use of @code{-gnatg}.
@item @code{-gnatw.n}
-`Activate warnings on atomic synchronization.'
+`Activate info messages on atomic synchronization.'
-This switch actives warnings when an access to an atomic variable
+This switch activates info messages when an access to an atomic variable
requires the generation of atomic synchronization code. These
-warnings are off by default.
+info messages are off by default.
@end table
@geindex -gnatw.N (gcc)
@@ -11769,12 +11769,12 @@ warnings are off by default.
@item @code{-gnatw.N}
-`Suppress warnings on atomic synchronization.'
+`Suppress info messages on atomic synchronization.'
@geindex Atomic Synchronization
@geindex warnings
-This switch suppresses warnings when an access to an atomic variable
+This switch suppresses info messages when an access to an atomic variable
requires the generation of atomic synchronization code.
@end table
@@ -29645,8 +29645,8 @@ to permit their use in free software.
@printindex ge
-@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
@anchor{d1}@w{ }
+@anchor{gnat_ugn/gnat_utility_programs switches-related-to-project-files}@w{
}
@c %**end of body
@bye
--
2.43.2
[COMMITTED 09/31] ada: Fix formatting in list of implemented Ada 2012 features
From: Piotr Trojanek
Fix formatting; meaning is unaffected.
gcc/ada/
* doc/gnat_rm/implementation_of_ada_2012_features.rst:
Fix formatting.
* gnat_rm.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst | 6 +++---
gcc/ada/gnat_rm.texi| 6 +++---
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst
b/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst
index 706de492301..9708e15de8d 100644
--- a/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst
@@ -255,7 +255,7 @@ http://www.ada-auth.org/ai05-summary.html.
* *AI-0039 Stream attributes cannot be dynamic (-00-00)*
- The RM permitted the use of dynamic expressions (such as ``ptr.all``)`
+ The RM permitted the use of dynamic expressions (such as ``ptr.all``)
for stream attributes, but these were never useful and are now illegal. GNAT
has always regarded such expressions as illegal.
@@ -555,7 +555,7 @@ http://www.ada-auth.org/ai05-summary.html.
This AI clarifies that 'needs finalization' is part of dynamic semantics,
and therefore depends on the run-time characteristics of an object (i.e. its
tag) and not on its nominal type. As the AI indicates: "we do not expect
- this to affect any implementation''.
+ this to affect any implementation".
RM References: 7.06.01 (6) 7.06.01 (7) 7.06.01 (8) 7.06.01 (9/2)
@@ -812,7 +812,7 @@ http://www.ada-auth.org/ai05-summary.html.
The new syntax for iterating over arrays and containers is now implemented.
Iteration over containers is for now limited to read-only iterators. Only
- default iterators are supported, with the syntax: ``for Elem of C``.
+ default iterators are supported, with the syntax: ``for Elem of C``.
RM References: 5.05
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index df6969f98b7..776dd4a4afc 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -26913,7 +26913,7 @@ RM References: A.10.05 (37) A.10.07 (8/1) A.10.07
(10) A.10.07 (12) A.1
@item
`AI-0039 Stream attributes cannot be dynamic (-00-00)'
-The RM permitted the use of dynamic expressions (such as @code{ptr.all})`
+The RM permitted the use of dynamic expressions (such as @code{ptr.all})
for stream attributes, but these were never useful and are now illegal. GNAT
has always regarded such expressions as illegal.
@@ -27358,7 +27358,7 @@ RM References: 3.10.01 (6) 3.10.01 (9.2/2)
This AI clarifies that ‘needs finalization’ is part of dynamic semantics,
and therefore depends on the run-time characteristics of an object (i.e. its
tag) and not on its nominal type. As the AI indicates: “we do not expect
-this to affect any implementation’’.
+this to affect any implementation”.
RM References: 7.06.01 (6) 7.06.01 (7) 7.06.01 (8) 7.06.01 (9/2)
@end itemize
@@ -27730,7 +27730,7 @@ RM References: A.04.11
The new syntax for iterating over arrays and containers is now implemented.
Iteration over containers is for now limited to read-only iterators. Only
-default iterators are supported, with the syntax: @code{for Elem of C}.
+default iterators are supported, with the syntax: @code{for Elem of C}.
RM References: 5.05
@end itemize
--
2.43.2
[COMMITTED 12/31] ada: Add elaboration switch tags to info messages
From: Viljar Indus
Add the ?$? insertion characters for elaboration
message so they would be marked with the [-gnatel]
tag. Note that these insertion characters were
not added for SPARK elaboration messages:
gcc/ada/
* sem_elab.adb: Add missing elaboration insertion
characters to info messages.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_elab.adb | 13 -
1 file changed, 8 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 9205f4cef82..4d6e14cc49c 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -4920,7 +4920,7 @@ package body Sem_Elab is
and then not New_In_State.Suppress_Info_Messages
then
Error_Msg_NE
- ("info: access to & during elaboration", Attr, Subp_Id);
+ ("info: access to & during elaboration?$?", Attr, Subp_Id);
end if;
-- Warnings are suppressed when a prior scenario is already in that
@@ -5027,7 +5027,7 @@ package body Sem_Elab is
and then not New_In_State.Suppress_Info_Messages
then
Error_Msg_NE
- ("info: activation of & during elaboration", Call, Obj_Id);
+ ("info: activation of & during elaboration?$?", Call, Obj_Id);
end if;
-- Nothing to do when the call activates a task whose type is defined
@@ -6461,7 +6461,7 @@ package body Sem_Elab is
if In_SPARK then
return " in SPARK";
else
- return "";
+ return "?$?";
end if;
end Suffix;
@@ -8277,7 +8277,9 @@ package body Sem_Elab is
Error_Msg_Name_1 := Prag_Nam;
Error_Msg_Qual_Level := Nat'Last;
- Error_Msg_NE ("info: missing pragma % for unit &", N, Unit_Id);
+ Error_Msg_NE
+ ("info: missing pragma % for unit &?$?", N,
+ Unit_Id);
Error_Msg_Qual_Level := 0;
end if;
end Info_Missing_Pragma;
@@ -8406,7 +8408,8 @@ package body Sem_Elab is
Error_Msg_Qual_Level := Nat'Last;
Error_Msg_NE
- ("info: implicit pragma % generated for unit &", N, Unit_Id);
+ ("info: implicit pragma % generated for unit &?$?",
+ N, Unit_Id);
Error_Msg_Qual_Level := 0;
Output_Active_Scenarios (N, In_State);
--
2.43.2
[COMMITTED 03/31] ada: Remove trailing NUL in minimal expansion of Put_Image attribute
From: Piotr Trojanek When procedure that implements Put_Image attribute emits the type name, this name was wrongly followed by a NUL character. gcc/ada/ * exp_put_image.adb (Build_Record_Put_Image_Procedure): Remove trailing NUL from the fully qualified type name. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_put_image.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index c23b4e24354..f5141a56626 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -832,7 +832,9 @@ package body Exp_Put_Image is Parameter_Associations => New_List (Make_Identifier (Loc, Name_S), Make_String_Literal (Loc, - To_String (Fully_Qualified_Name_String (Btyp)); + To_String + (Fully_Qualified_Name_String + (Btyp, Append_NUL => False)); end if; elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True) then -- 2.43.2
[COMMITTED 07/31] ada: Fix index entry for an implemented AI feature
From: Piotr Trojanek Fix inconsistent reference with "05" in the name of AI. gcc/ada/ * doc/gnat_rm/implementation_of_ada_2012_features.rst (AI-0216): Fix index reference. * gnat_rm.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst | 2 +- gcc/ada/gnat_rm.texi| 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst b/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst index 2825362c616..d7f1fea01f3 100644 --- a/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst +++ b/gcc/ada/doc/gnat_rm/implementation_of_ada_2012_features.rst @@ -1243,7 +1243,7 @@ Supported Aspect Source RM References: B.01 (17) B.03 (62) B.03 (71.1/2) -.. index:: AI05-0216 (Ada 2012 feature) +.. index:: AI-0216 (Ada 2012 feature) * *AI-0216 No_Task_Hierarchy forbids local tasks (-00-00)* diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 4ff1de42db2..0d38b1a4bc6 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -28603,7 +28603,7 @@ non-portable. RM References: B.01 (17) B.03 (62) B.03 (71.1/2) @end itemize -@geindex AI05-0216 (Ada 2012 feature) +@geindex AI-0216 (Ada 2012 feature) @itemize * -- 2.43.2
[COMMITTED 04/31] ada: Remove conversion from String_Id to String and back to String_Id
From: Piotr Trojanek Code cleanup; semantics is unaffected. gcc/ada/ * exp_put_image.adb (Build_Record_Put_Image_Procedure): Remove useless conversions. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_put_image.adb | 6 ++ 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index f5141a56626..09fbfa75eeb 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -44,7 +44,6 @@ with Sinfo.Nodes;use Sinfo.Nodes; with Sinfo.Utils;use Sinfo.Utils; with Snames; use Snames; with Stand; -with Stringt;use Stringt; with Tbuild; use Tbuild; with Ttypes; use Ttypes; with Uintp; use Uintp; @@ -832,9 +831,8 @@ package body Exp_Put_Image is Parameter_Associations => New_List (Make_Identifier (Loc, Name_S), Make_String_Literal (Loc, - To_String - (Fully_Qualified_Name_String - (Btyp, Append_NUL => False)); + Fully_Qualified_Name_String + (Btyp, Append_NUL => False); end if; elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True) then -- 2.43.2
[COMMITTED 02/31] ada: Follow-up fix to previous change for Text_Ptr
From: Eric Botcazou The variable would be saved and restored while still uninitialized. gcc/ada/ * err_vars.ads (Error_Msg_Sloc): Initialize to No_Location. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/err_vars.ads | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 113dd936db6..838217b95f4 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -107,7 +107,7 @@ package Err_Vars is -- WARNING: There is a matching C declaration of these variables in fe.h - Error_Msg_Sloc : Source_Ptr; + Error_Msg_Sloc : Source_Ptr := No_Location; -- Source location for # insertion character in message Error_Msg_Name_1 : Name_Id; -- 2.43.2
[COMMITTED 30/30] ada: Allow 'others' in formal packages with overloaded formals
From: Bob Duff
If a generic package has two or more generic formal parameters with the
same defining name (which can happen only for formal subprograms), then
RM-12.7(4.1/3) disallows named associations in a corresponding formal
package. This is not intended to cover "others => <>".
This patch allows "others => <>" even when it applies to such
formals. Previously, the compiler incorrectly gave an error.
Minor related cleanups involving type Text_Ptr.
gcc/ada/
* sem_ch12.adb: Misc cleanups and comment fixes.
(Check_Overloaded_Formal_Subprogram): Remove the Others_Choice
error message.
(Others_Choice): Remove this variable; no longer needed.
* types.ads (Text_Ptr): Add a range constraint limiting the
subtype to values that are actually used. This has the advantage
that when the compiler is compiled with validity checks,
uninitialized values of subtypes Text_Ptr and Source_Ptr will be
caught.
* sinput.ads (Sloc_Adjust): Use the base subtype; this is used as
an offset, so we need to allow arbitrary negative values.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 27 ++-
gcc/ada/sinput.ads | 2 +-
gcc/ada/types.ads| 7 +++
3 files changed, 14 insertions(+), 22 deletions(-)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 4ceddda2052..9919cda6340 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -1130,10 +1130,11 @@ package body Sem_Ch12 is
Saved_Formal: Node_Id;
Default_Formals : constant List_Id := New_List;
- -- If an Others_Choice is present, some of the formals may be defaulted.
- -- To simplify the treatment of visibility in an instance, we introduce
- -- individual defaults for each such formal. These defaults are
- -- appended to the list of associations and replace the Others_Choice.
+ -- If an N_Others_Choice is present, some of the formals may be
+ -- defaulted. To simplify the treatment of visibility in an instance,
+ -- we introduce individual defaults for each such formal. These
+ -- defaults are appended to the list of associations and replace the
+ -- N_Others_Choice.
Found_Assoc : Node_Id;
-- Association for the current formal being match. Empty if there are
@@ -1145,9 +1146,8 @@ package body Sem_Ch12 is
Num_Actuals: Nat := 0;
Others_Present : Boolean := False;
- Others_Choice : Node_Id := Empty;
-- In Ada 2005, indicates partial parameterization of a formal
- -- package. As usual an other association must be last in the list.
+ -- package. As usual an 'others' association must be last in the list.
procedure Build_Subprogram_Wrappers;
-- Ada 2022: AI12-0272 introduces pre/postconditions for formal
@@ -1195,7 +1195,7 @@ package body Sem_Ch12 is
procedure Process_Default (Formal : Node_Id);
-- Add a copy of the declaration of a generic formal to the list of
-- associations, and add an explicit box association for its entity
- -- if there is none yet, and the default comes from an Others_Choice.
+ -- if there is none yet, and the default comes from an N_Others_Choice.
function Renames_Standard_Subprogram (Subp : Entity_Id) return Boolean;
-- Determine whether Subp renames one of the subprograms defined in the
@@ -1314,14 +1314,8 @@ package body Sem_Ch12 is
Error_Msg_N
("named association not allowed for overloaded formal",
Found_Assoc);
-
- else
- Error_Msg_N
-("named association not allowed for overloaded formal",
- Others_Choice);
+ Abandon_Instantiation (Instantiation_Node);
end if;
-
- Abandon_Instantiation (Instantiation_Node);
end if;
Next (Temp_Formal);
@@ -1592,7 +1586,7 @@ package body Sem_Ch12 is
Append (Decl, Assoc_List);
- if No (Found_Assoc) then
+ if No (Found_Assoc) then -- i.e. 'others'
Default :=
Make_Generic_Association (Loc,
Selector_Name =>
@@ -1686,7 +1680,6 @@ package body Sem_Ch12 is
while Present (Actual) loop
if Nkind (Actual) = N_Others_Choice then
Others_Present := True;
- Others_Choice := Actual;
if Present (Next (Actual)) then
Error_Msg_N ("OTHERS must be last association", Actual);
@@ -2311,7 +2304,7 @@ package body Sem_Ch12 is
-- If this is a formal package, normalize the parameter list by adding
-- explicit box associations for the formals that are covered by an
- -- Others_Choice.
+ -- N_Others_Choice.
Append_List (Default_Formals, Formals);
[COMMITTED 28/30] ada: Fix internal error on nested aggregate in conditional expression
From: Eric Botcazou This plugs a loophole in the change improving code generation for nested aggregates present in conditional expressions: once the delayed expansion is chosen for the nested aggregate, the expansion of the parent aggregate cannot be left to the back-end and the test must be adjusted to implement this in the presence of conditional expressions too. gcc/ada/ * exp_aggr.adb (Expand_Record_Aggregate.Component_OK_For_Backend): Also return False for a delayed conditional expression. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index a386aa85ae4..796b0f1e0de 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -8376,7 +8376,9 @@ package body Exp_Aggr is Static_Components := False; return False; -elsif Is_Delayed_Aggregate (Expr_Q) then +elsif Is_Delayed_Aggregate (Expr_Q) + or else Is_Delayed_Conditional_Expression (Expr_Q) +then Static_Components := False; return False; -- 2.43.2
[COMMITTED 27/30] ada: Get rid of secondary stack for indefinite record types with size clause
From: Eric Botcazou This change eliminates the use of the secondary stack for indefinite record types for which a valid (object) size clause is specified. In accordance with the RM, the compiler accepts (object) size clauses on such types only if all the components, including those of the variants of the variant part if any, have a size known at compile time, and only if the clauses specify a value that is at least as large as the largest possible size of objects of the types when all the variants are considered. However, it would still have used the secondary stack, despite valid (object) size clauses, before the change, as soon as a variant part was present in the types. gcc/ada/ * freeze.ads (Check_Compile_Time_Size): Remove obsolete description of usage for the Size_Known_At_Compile_Time flag. * freeze.adb (Check_Compile_Time_Size.Size_Known): In the case where a variant part is present, do not return False if Esize is known. * sem_util.adb (Needs_Secondary_Stack.Caller_Known_Size_Record): Add missing "Start of processing" comment. Return true if either a size clause or an object size clause has been given for the first subtype of the type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/freeze.adb | 1 + gcc/ada/freeze.ads | 11 +-- gcc/ada/sem_util.adb | 12 3 files changed, 18 insertions(+), 6 deletions(-) diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 26e9d01d8b2..ea6106e6455 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1077,6 +1077,7 @@ package body Freeze is and then No (Discriminant_Default_Value (First_Discriminant (T))) and then not Known_RM_Size (T) +and then not Known_Esize (T) then return False; end if; diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads index fc0b7678fdc..066d8f054f6 100644 --- a/gcc/ada/freeze.ads +++ b/gcc/ada/freeze.ads @@ -156,17 +156,16 @@ package Freeze is --RM_Size field is set to the required size, allowing for possible front --end packing of an array using this type as a component type. -- - -- Note: the flag Size_Known_At_Compile_Time is used to determine if the - -- secondary stack must be used to return a value of the type, and also - -- to determine whether a component clause is allowed for a component - -- of the given type. - -- - -- Note: this is public because of one dubious use in Sem_Res??? + -- Note: the flag Size_Known_At_Compile_Time is used to determine whether a + -- size clause is allowed for the type, and also whether a component clause + -- is allowed for a component of the type. -- -- Note: Check_Compile_Time_Size does not test the case of the size being -- known because a size clause is specifically given. That is because we -- do not allow a size clause if the size would not otherwise be known at -- compile time in any case. + -- + -- ??? This is public because of dubious uses in Sem_Ch3 and Sem_Res procedure Check_Inherited_Conditions (R : Entity_Id; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 09358278210..15994b4d1e9 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -22409,6 +22409,8 @@ package body Sem_Util is return False; end Depends_On_Discriminant; + -- Start of processing for Caller_Known_Size_Record + begin -- This is a protected type without Corresponding_Record_Type set, -- typically because expansion is disabled. The safe thing to do is @@ -22418,6 +22420,16 @@ package body Sem_Util is return True; end if; + -- If either size is specified for the type, then it's known in the + -- caller in particular. Note that, even if the clause is confirming, + -- this does not change the outcome since the size was already known. + + if Has_Size_Clause (First_Subtype (Typ)) + or else Has_Object_Size_Clause (First_Subtype (Typ)) + then +return True; + end if; + -- First see if we have a variant part and return False if it depends -- on discriminants. -- 2.43.2
[COMMITTED 29/30] ada: Add direct workaround for limitations of RTSfind mechanism
From: Eric Botcazou This adds a direct workaround for the spurious compilation errors caused by the presence of preconditions/postconditions in the Interfaces.C unit, which trip on limitations of the RTSfind mechanism when it comes to visibility, as well as removes an indirect workaround that was added very recently. These errors were first triggered in the context of finalization and worked around by preloading the System.Finalization_Primitives unit. Now they also appear in the context of tasking, and it turns out that the preloading trick does not work for separate compilation units. gcc/ada/ * exp_ch7.ads (Preload_Finalization_Collection): Delete. * exp_ch7.adb (Allows_Finalization_Collection): Revert change. (Preload_Finalization_Collection): Delete. * opt.ads (Interface_Seen): Likewise. * scng.adb (Scan): Revert latest change. * sem_ch10.adb: Remove clause for Exp_Ch7. (Analyze_Compilation_Unit): Revert latest change. * libgnat/i-c.ads: Use a fully qualified name for the standard "+" operator in the preconditons/postconditions of subprograms. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch7.adb | 38 -- gcc/ada/exp_ch7.ads | 6 -- gcc/ada/libgnat/i-c.ads | 19 +++ gcc/ada/opt.ads | 4 gcc/ada/scng.adb| 5 + gcc/ada/sem_ch10.adb| 3 --- 6 files changed, 12 insertions(+), 63 deletions(-) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index fdacf1cdc01..993c13c7318 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -965,12 +965,6 @@ package body Exp_Ch7 is if Restriction_Active (No_Finalization) then return False; - -- The System.Finalization_Primitives unit must have been preloaded if - -- finalization is really required. - - elsif not RTU_Loaded (System_Finalization_Primitives) then - return False; - -- Do not consider C and C++ types since it is assumed that the non-Ada -- side will handle their cleanup. @@ -8630,38 +8624,6 @@ package body Exp_Ch7 is return Scope_Stack.Table (Scope_Stack.Last).Node_To_Be_Wrapped; end Node_To_Be_Wrapped; - -- - -- Preload_Finalization_Collection -- - -- - - procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id) is - begin - -- We can't call RTE (Finalization_Collection) for at least some - -- predefined units, because it would introduce cyclic dependences, - -- as the type is itself a controlled type. - -- - -- It's only needed when finalization is involved in the unit, which - -- requires the presence of controlled or class-wide types in the unit - -- (see the Sem_Util.Needs_Finalization predicate for the rationale). - -- But controlled types are tagged or contain tagged (sub)components - -- so it is sufficient for the parser to detect the "interface" and - -- "tagged" keywords. - -- - -- Don't do it if Finalization_Collection is unavailable in the runtime - - if not In_Predefined_Unit (Compilation_Unit) -and then (Interface_Seen or else Tagged_Seen) -and then not No_Run_Time_Mode -and then RTE_Available (RE_Finalization_Collection) - then - declare -Ignore : constant Entity_Id := RTE (RE_Finalization_Collection); - begin -null; - end; - end if; - end Preload_Finalization_Collection; - -- Store_Actions_In_Scope -- diff --git a/gcc/ada/exp_ch7.ads b/gcc/ada/exp_ch7.ads index 386a02b9283..712671a427e 100644 --- a/gcc/ada/exp_ch7.ads +++ b/gcc/ada/exp_ch7.ads @@ -257,12 +257,6 @@ package Exp_Ch7 is -- Build a call to suppress the finalization of the object Obj, only after -- creating the Master_Node of Obj if it does not already exist. - procedure Preload_Finalization_Collection (Compilation_Unit : Node_Id); - -- Call RTE (RE_Finalization_Collection) if necessary to load the packages - -- involved in finalization support. We need to do this explicitly, fairly - -- early during compilation, because otherwise it happens during freezing, - -- which triggers visibility bugs in generic instantiations. - -- Task and Protected Object finalization -- diff --git a/gcc/ada/libgnat/i-c.ads b/gcc/ada/libgnat/i-c.ads index fe87fba32b6..f9f9f75fc03 100644 --- a/gcc/ada/libgnat/i-c.ads +++ b/gcc/ada/libgnat/i-c.ads @@ -24,6 +24,9 @@ pragma Assertion_Policy (Pre=> Ignore, Contract_Cases => Ignore, Ghost => Ignore); +-- Pre/postconditions use a fully qualified name for the
[COMMITTED 19/30] ada: Fix list of attributes defined by Ada 2012
From: Piotr Trojanek Recognize references to attributes Old, Overlaps_Storage and Result as language-defined in Ada 2012 and implementation-defined in earlier versions of Ada. Other attributes introduced by Ada 2012 RM are correctly categorized. This change only affects code with restriction No_Implementation_Attributes. gcc/ada/ * sem_attr.adb (Attribute_12): Add attributes Old, Overlaps_Storage and Result. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 5 - 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 414224e86b6..df52229b6aa 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -170,7 +170,10 @@ package body Sem_Attr is (Attribute_First_Valid | Attribute_Has_Same_Storage | Attribute_Last_Valid | - Attribute_Max_Alignment_For_Allocation => True, + Attribute_Max_Alignment_For_Allocation | + Attribute_Old | + Attribute_Overlaps_Storage | + Attribute_Result => True, others => False); -- The following array is the list of attributes defined in the Ada 2022 -- 2.43.2
[COMMITTED 25/30] ada: Add Is_Base_Type predicate to C interface
From: Eric Botcazou This also documents what the predicate effectively does. gcc/ada/ * einfo-utils.ads (Is_Base_Type): Move to Miscellaneous Subprograms section and add description. * fe.h (Is_Base_Type): Declare. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo-utils.ads | 8 ++-- gcc/ada/fe.h| 4 +++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/gcc/ada/einfo-utils.ads b/gcc/ada/einfo-utils.ads index d87a3e34f49..01953c35bc3 100644 --- a/gcc/ada/einfo-utils.ads +++ b/gcc/ada/einfo-utils.ads @@ -183,8 +183,6 @@ package Einfo.Utils is function Has_Null_Abstract_State (Id : E) return B; function Has_Null_Visible_Refinement (Id : E) return B; function Implementation_Base_Type (Id : E) return E; - function Is_Base_Type (Id : E) return B with Inline; - -- Note that Is_Base_Type returns True for nontypes function Is_Boolean_Type (Id : E) return B with Inline; function Is_Constant_Object (Id : E) return B with Inline; function Is_Controlled (Id : E) return B with Inline; @@ -504,6 +502,12 @@ package Einfo.Utils is -- is the name of a class_wide type whose root is incomplete, return the -- corresponding full declaration, else return T itself. + function Is_Base_Type (Id : E) return B with Inline; + -- Return True for a type entity and False for a subtype entity. Note that + -- this returns True for nontypes. + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Entity_Name (N : Node_Id) return Boolean with Inline; -- Test if the node N is the name of an entity (i.e. is an identifier, -- expanded name, or an attribute reference that returns an entity). diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index 692c29a70af..b4c1aea5c8b 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -98,9 +98,11 @@ extern void Set_Normalized_First_Bit (Entity_Id, Uint); extern void Set_Normalized_Position(Entity_Id, Uint); extern void Set_RM_Size(Entity_Id, Uint); +#define Is_Base_Type einfo__utils__is_base_type #define Is_Entity_Name einfo__utils__is_entity_name -extern Boolean Is_Entity_Name (Node_Id); +extern Boolean Is_Base_Type(Entity_Id); +extern Boolean Is_Entity_Name (Node_Id); #define Get_Attribute_Definition_Clause einfo__utils__get_attribute_definition_clause -- 2.43.2
[COMMITTED 18/30] ada: Apply restriction No_Implementation_Attributes to source nodes only
From: Piotr Trojanek Restriction No_Implementation_Attributes must not be applied to nodes that come from expansion. In particular, it must not be applied to Object_Size, which is implementation-defined attribute before Ada 2022, but appears in expansion of tagged types since Ada 95. gcc/ada/ * sem_attr.adb (Analyze_Attribute): Move IF statement that checks restriction No_Implementation_Attributes for Ada 2005, 2012 and Ada 2022 attributes inside Comes_From_Source condition that checks the same restriction for Ada 83 attributes. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.adb | 27 ++- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 6c32d201c55..414224e86b6 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3221,9 +3221,10 @@ package body Sem_Attr is Check_Restriction_No_Use_Of_Attribute (N); - -- Deal with Ada 83 issues - if Comes_From_Source (N) then + + -- Deal with Ada 83 issues + if not Attribute_83 (Attr_Id) then if Ada_Version = Ada_83 then Error_Msg_Name_1 := Aname; @@ -3234,19 +3235,19 @@ package body Sem_Attr is Check_Restriction (No_Implementation_Attributes, N); end if; end if; - end if; - -- Deal with Ada 2005 attributes that are implementation attributes - -- because they appear in a version of Ada before Ada 2005, ditto for - -- Ada 2012 and Ada 2022 attributes appearing in an earlier version. + -- Deal with Ada 2005 attributes that are implementation attributes + -- because they appear in a version of Ada before Ada 2005, ditto for + -- Ada 2012 and Ada 2022 attributes appearing in an earlier version. - if (Attribute_05 (Attr_Id) and then Ada_Version < Ada_2005) -or else - (Attribute_12 (Attr_Id) and then Ada_Version < Ada_2012) -or else - (Attribute_22 (Attr_Id) and then Ada_Version < Ada_2022) - then - Check_Restriction (No_Implementation_Attributes, N); + if (Attribute_05 (Attr_Id) and then Ada_Version < Ada_2005) + or else +(Attribute_12 (Attr_Id) and then Ada_Version < Ada_2012) + or else +(Attribute_22 (Attr_Id) and then Ada_Version < Ada_2022) + then +Check_Restriction (No_Implementation_Attributes, N); + end if; end if; -- Remote access to subprogram type access attribute reference needs -- 2.43.2
[COMMITTED 21/30] ada: Further refine 'Super attribute
From: Justin Squirek
This patch relaxes the restriction on 'Super such that it can apply to abstract
type objects.
gcc/ada/
* sem_attr.adb (Analyze_Attribute): Remove restriction on 'Super
for abstract types.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 4
1 file changed, 4 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index df52229b6aa..403810c8b5e 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -6683,10 +6683,6 @@ package body Sem_Attr is
elsif Depends_On_Private (P_Type) then
Error_Attr_P ("prefix type of % is a private extension");
--- Check that we don't view convert to an abstract type
-
-elsif Is_Abstract_Type (Node (First_Elmt (Parents))) then
- Error_Attr_P ("type of % cannot be abstract");
end if;
-- Generate a view conversion and analyze it
--
2.43.2
[COMMITTED 17/30] ada: Remove repeated condition in check for implementation attributes
From: Piotr Trojanek
Code cleanup; semantics is unaffected.
gcc/ada/
* sem_attr.adb (Analyze_Attribute): Remove condition that is
already checked by an enclosing IF statement.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 2b22cf13ad0..6c32d201c55 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3225,7 +3225,7 @@ package body Sem_Attr is
if Comes_From_Source (N) then
if not Attribute_83 (Attr_Id) then
-if Ada_Version = Ada_83 and then Comes_From_Source (N) then
+if Ada_Version = Ada_83 then
Error_Msg_Name_1 := Aname;
Error_Msg_N ("(Ada 83) attribute% is not standard??", N);
end if;
--
2.43.2
[COMMITTED 26/30] ada: Formal package comment corrections in sinfo.ads
From: Bob Duff
Misc comment corrections and clarifications in sinfo.ads
related to generic formal packages.
gcc/ada/
* sinfo.ads: Misc comment corrections and clarifications.
The syntax for GENERIC_ASSOCIATION and FORMAL_PACKAGE_ACTUAL_PART
was wrong.
Emphasize that "others => <>" is not represented as an
N_Generic_Association (with or without Box_Present set),
and give examples illustrating the various possibilities.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sinfo.ads | 61 +++
1 file changed, 46 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 228082eb823..599f4f63cce 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -1574,9 +1574,9 @@ package Sinfo is
-- Instance_Spec
--This field is present in generic instantiation nodes, and also in
--formal package declaration nodes (formal package declarations are
- --treated in a manner very similar to package instantiations). It points
- --to the node for the spec of the instance, inserted as part of the
- --semantic processing for instantiations in Sem_Ch12.
+ --treated similarly to package instantiations). It points to the node
+ --for the spec of the instance, inserted as part of the semantic
+ --processing for instantiations in Sem_Ch12.
-- Is_Abort_Block
--Present in N_Block_Statement nodes. True if the block protects a list
@@ -3639,8 +3639,8 @@ package Sinfo is
-- The only choice that appears explicitly is the OTHERS choice, as
-- defined here. Other cases of discrete choice (expression and
- -- discrete range) appear directly. This production is also used
- -- for the OTHERS possibility of an exception choice.
+ -- discrete range) appear directly. N_Others_Choice is also used
+ -- in exception handlers and generic formal packages.
-- Note: in accordance with the syntax, the parser does not check that
-- OTHERS appears at the end on its own in a choice list context. This
@@ -7139,6 +7139,7 @@ package Sinfo is
-- GENERIC_ASSOCIATION ::=
--[generic_formal_parameter_SELECTOR_NAME =>]
+ -- EXPLICIT_GENERIC_ACTUAL_PARAMETER
-- Note: unlike the procedure call case, a generic association node
-- is generated for every association, even if no formal parameter
@@ -7149,7 +7150,8 @@ package Sinfo is
-- In Ada 2005, a formal may be associated with a box, if the
-- association is part of the list of actuals for a formal package.
-- If the association is given by OTHERS => <>, the association is
- -- an N_Others_Choice.
+ -- an N_Others_Choice (not an N_Generic_Association whose Selector_Name
+ -- is an N_Others_Choice).
-- N_Generic_Association
-- Sloc points to first token of generic association
@@ -7442,7 +7444,7 @@ package Sinfo is
-- Defining_Identifier
-- Name
-- Generic_Associations (set to No_List if (<>) case or
- -- empty generic actual part)
+ -- empty formal package actual part)
-- Box_Present
-- Instance_Spec
-- Is_Known_Guaranteed_ABE
@@ -7452,21 +7454,50 @@ package Sinfo is
--
-- FORMAL_PACKAGE_ACTUAL_PART ::=
- --([OTHERS] => <>)
+ --([OTHERS =>] <>)
--| [GENERIC_ACTUAL_PART]
- --(FORMAL_PACKAGE_ASSOCIATION {. FORMAL_PACKAGE_ASSOCIATION}
+ --| (FORMAL_PACKAGE_ASSOCIATION {, FORMAL_PACKAGE_ASSOCIATION}
+ --[, OTHERS => <>])
-- FORMAL_PACKAGE_ASSOCIATION ::=
-- GENERIC_ASSOCIATION
-- | GENERIC_FORMAL_PARAMETER_SELECTOR_NAME => <>
-- There is no explicit node in the tree for a formal package actual
- -- part. Instead the information appears in the parent node (i.e. the
- -- formal package declaration node itself).
-
- -- There is no explicit node for a formal package association. All of
- -- them are represented either by a generic association, possibly with
- -- Box_Present, or by an N_Others_Choice.
+ -- part, nor for a formal package association. A formal package
+ -- association is represented as a generic association, possibly with
+ -- Box_Present.
+ --
+ -- The "others => <>" syntax (both cases) is represented as an
+ -- N_Others_Choice (not an N_Generic_Association whose Selector_Name
+ -- is an N_Others_Choice). This admittedly odd representation does not
+ -- lose information, because "others" cannot be followed by anything
+ -- other than "=> <>". Thus:
+ --
+ -- "... is new G;"
+ --The N_Formal_Package_Declaration has empty Generic_Associations,
+ --and Box_Present = False.
+ --
+ -- "... is new G(<>);"
+
[COMMITTED 20/30] ada: Fix list of implementation-defined attributes
From: Piotr Trojanek Several of the implementation-defined attributes were wrongly recognized as defined by the Ada RM. This change only affects code with restriction No_Implementation_Attributes. gcc/ada/ * sem_attr.ads (Attribute_Impl_Def): Fix list of implementation-defined attributes. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.ads | 27 +++ 1 file changed, 27 insertions(+) diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 40ec423c4c7..52359e40ef6 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -609,6 +609,33 @@ package Sem_Attr is -- for constructing this definition in package System (see note above -- in Default_Bit_Order description). This is a static attribute. + Attribute_Atomic_Always_Lock_Free| + Attribute_Bit_Position | + Attribute_Compiler_Version | + Attribute_Descriptor_Size| + Attribute_Enabled| + Attribute_Fast_Math | + Attribute_From_Any | + Attribute_Has_Access_Values | + Attribute_Has_Tagged_Values | + Attribute_Initialized| + Attribute_Library_Level | + Attribute_Pool_Address | + Attribute_Restriction_Set| + Attribute_Scalar_Storage_Order | + Attribute_Simple_Storage_Pool| + Attribute_Small_Denominator | + Attribute_Small_Numerator| + Attribute_System_Allocator_Alignment | + Attribute_To_Any | + Attribute_TypeCode | + Attribute_Type_Key | + Attribute_Unconstrained_Array| + Attribute_Update | + Attribute_Valid_Value| + Attribute_Wchar_T_Size => True, + -- See description in GNAT RM + others => False); -- The following table lists all attributes that yield a result of a -- 2.43.2
[COMMITTED 23/30] ada: Error on instantiation of generic containing legal container aggregate
From: Gary Dismukes
When a container aggregate for a predefined container type (such as
a Vector type) that has an iterated component association occurs within
a generic unit and that generic is instantiated, the compiler reports
a spurious error message "iterated component association can only appear
in an array aggregate" and the compilation aborts (because Unrecoverable_Error
is raised unconditionally after that error). The problem is that as part of
the instantiation process, for aggregates whose type has a partial view,
in Copy_Generic_Node the compiler switches the visibility so that the full
view of the type is available, and for a type whose full view is a record
type this leads to incorrectly trying to process the aggregate as a record
aggregate in Resolve_Aggregate (making a call to Resolve_Record_Aggregate).
Rather than trying to address this by changing what Copy_Generic_Node does,
this can be fixed by reordering and adjusting the code in Resolve_Aggregate,
so that we first test whether we need to resolve as a record aggregate
(if the aggregate is not homogeneous), followed by testing whether the
type has an Aggregate aspect and calling Resolve_Container_Aggregate.
As a bonus, we also remove the subsequent complex condition and redundant
code for handling null container aggregates.
gcc/ada/
* sem_aggr.adb (Resolve_Aggregate): Move condition and call for
Resolve_Record_Aggregate in front of code related to calling
Resolve_Container_Aggregate (and add test that the aggregate
is not homogeneous), and remove special-case testing and call
to Resolve_Container_Aggregate for empty aggregates.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 22 +-
1 file changed, 5 insertions(+), 17 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 658b3a4634c..6e40e5c2564 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1182,8 +1182,12 @@ package body Sem_Aggr is
elsif Is_Array_Type (Typ) and then Null_Record_Present (N) then
Error_Msg_N ("null record forbidden in array aggregate", N);
+ elsif Is_Record_Type (Typ)
+and then not Is_Homogeneous_Aggregate (N)
+ then
+ Resolve_Record_Aggregate (N, Typ);
+
elsif Has_Aspect (Typ, Aspect_Aggregate)
-and then Ekind (Typ) /= E_Record_Type
and then Ada_Version >= Ada_2022
then
-- Check for Ada 2022 and () aggregate.
@@ -1194,22 +1198,6 @@ package body Sem_Aggr is
Resolve_Container_Aggregate (N, Typ);
- -- Check Ada 2022 empty aggregate [] initializing a record type that has
- -- aspect aggregate; the empty aggregate will be expanded into a call to
- -- the empty function specified in the aspect aggregate.
-
- elsif Has_Aspect (Typ, Aspect_Aggregate)
-and then Ekind (Typ) = E_Record_Type
-and then Is_Homogeneous_Aggregate (N)
-and then Is_Empty_List (Expressions (N))
-and then Is_Empty_List (Component_Associations (N))
-and then Ada_Version >= Ada_2022
- then
- Resolve_Container_Aggregate (N, Typ);
-
- elsif Is_Record_Type (Typ) then
- Resolve_Record_Aggregate (N, Typ);
-
elsif Is_Array_Type (Typ) then
-- First a special test, for the case of a positional aggregate of
--
2.43.2
[COMMITTED 10/30] ada: Another small cleanup about allocators and aggregates
From: Eric Botcazou This eliminates a few more oddities present in the expander for allocators and aggregates nested in allocators and other constructs: - Convert_Aggr_In_Allocator takes both the N_Allocator and the aggregate as parameters, while the sibling procedures Convert_Aggr_In_Assignment and Convert_Aggr_In_Object_Decl only take the former. This changes the first to be consistent with the two others and propagates the change to Convert_Array_Aggr_In_Allocator. - Convert_Aggr_In_Object_Decl contains an awkward code structure with a useless inner block statement. - In_Place_Assign_OK and Convert_To_Assignments have some declarations of local variables not in the right place. No functional changes (presumably). gcc/ada/ * exp_aggr.ads (Convert_Aggr_In_Allocator): Remove Aggr parameter and adjust description. (Convert_Aggr_In_Object_Decl): Adjust description. * exp_aggr.adb (Convert_Aggr_In_Allocator): Remove Aggr parameter and add local variable of the same name instead. Adjust call to Convert_Array_Aggr_In_Allocator. (Convert_Aggr_In_Object_Decl): Add comment for early return and remove useless inner block statement. (Convert_Array_Aggr_In_Allocator): Remove Aggr parameter and add local variable of the same name instead. (In_Place_Assign_OK): Move down declarations of local variables. (Convert_To_Assignments): Put all declarations of local variables in the same place. Fix typo in comment. Replace T with Full_Typ. * exp_ch4.adb (Expand_Allocator_Expression): Call Unqualify instead of Expression on the qualified expression of the allocator for the sake of consistency. Adjust call to Convert_Aggr_In_Allocator. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 188 +-- gcc/ada/exp_aggr.ads | 18 ++--- gcc/ada/exp_ch4.adb | 4 +- 3 files changed, 104 insertions(+), 106 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2476675604c..8a3d1685cb3 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -282,10 +282,7 @@ package body Exp_Aggr is --Indexes is the current list of expressions used to index the object we --are writing into. - procedure Convert_Array_Aggr_In_Allocator - (N : Node_Id; - Aggr : Node_Id; - Target : Node_Id); + procedure Convert_Array_Aggr_In_Allocator (N : Node_Id; Target : Node_Id); -- If the aggregate appears within an allocator and can be expanded in -- place, this routine generates the individual assignments to components -- of the designated object. This is an optimization over the general @@ -3543,11 +3540,8 @@ package body Exp_Aggr is -- Convert_Aggr_In_Allocator -- --- - procedure Convert_Aggr_In_Allocator - (N: Node_Id; - Aggr : Node_Id; - Temp : Entity_Id) - is + procedure Convert_Aggr_In_Allocator (N : Node_Id; Temp : Entity_Id) is + Aggr : constant Node_Id:= Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); @@ -3557,7 +3551,7 @@ package body Exp_Aggr is begin if Is_Array_Type (Typ) then - Convert_Array_Aggr_In_Allocator (N, Aggr, Occ); + Convert_Array_Aggr_In_Allocator (N, Occ); elsif Has_Default_Init_Comps (Aggr) then declare @@ -3605,12 +3599,9 @@ package body Exp_Aggr is Aggr : constant Node_Id:= Unqualify (Expression (N)); Loc : constant Source_Ptr := Sloc (Aggr); Typ : constant Entity_Id := Etype (Aggr); - Occ : constant Node_Id:= New_Occurrence_Of (Obj, Loc); - - Has_Transient_Scope : Boolean := False; function Discriminants_Ok return Boolean; - -- If the object type is constrained, the discriminants in the + -- If the object's subtype is constrained, the discriminants in the -- aggregate must be checked against the discriminants of the subtype. -- This cannot be done using Apply_Discriminant_Checks because after -- expansion there is no aggregate left to check. @@ -3677,10 +3668,19 @@ package body Exp_Aggr is return True; end Discriminants_Ok; + -- Local variables + + Has_Transient_Scope : Boolean; + Occ : Node_Id; + Param : Node_Id; + Stmt: Node_Id; + Stmts : List_Id; + -- Start of processing for Convert_Aggr_In_Object_Decl begin - Set_Assignment_OK (Occ); + -- First generate discriminant checks if need be, and bail out if one + -- of them fails statically. if Has_Discriminants (Typ) and then Typ /= Etype (Obj) @@ -3706,61 +3706,59 @@ package body Exp_Aggr is then
[COMMITTED 24/30] ada: Error on instantiation of generic containing legal container aggregate
From: Gary Dismukes
When a container aggregate for a predefined container type (such as
a Vector type) that has an iterated component association occurs within
a generic unit and that generic is instantiated, the compiler reports
a spurious error message "iterated component association can only appear
in an array aggregate" and the compilation aborts (because Unrecoverable_Error
is raised unconditionally after that error). The problem is that as part of
the instantiation process, for aggregates whose type has a partial view,
in Copy_Generic_Node the compiler switches the visibility so that the full
view of the type is available, and for a type whose full view is a record
type this leads to incorrectly trying to process the aggregate as a record
aggregate in Resolve_Aggregate (making a call to Resolve_Record_Aggregate).
Rather than trying to address this by changing what Copy_Generic_Node does,
this can be fixed by reordering and adjusting the code in Resolve_Aggregate,
so that we first test whether we need to resolve as a record aggregate
(if the aggregate is not homogeneous), followed by testing whether the
type has an Aggregate aspect and calling Resolve_Container_Aggregate.
As a bonus, we also remove the subsequent complex condition and redundant
code for handling null container aggregates.
gcc/ada/
* sem_aggr.adb (Resolve_Aggregate): Move condition and call for
Resolve_Record_Aggregate in front of code related to calling
Resolve_Container_Aggregate (and add test that the aggregate is
not homogeneous), and remove special-case testing and call to
Resolve_Container_Aggregate for empty aggregates. Also, add error
check for an attempt to use "[]" for an aggregate of a record type
that does not specify an Aggregate aspect.
(Resolve_Record_Aggregate): Remove error check for record
aggregates with "[]" (now done by Resolve_Aggregate).
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 17 -
1 file changed, 8 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 6e40e5c2564..60738550ec1 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1198,6 +1198,14 @@ package body Sem_Aggr is
Resolve_Container_Aggregate (N, Typ);
+ -- Check for an attempt to use "[]" for an aggregate of a record type
+ -- after handling the case where the type has an Aggregate aspect,
+ -- because the aspect can be specified for record types, but if it
+ -- wasn't specified, then this is an error.
+
+ elsif Is_Record_Type (Typ) and then Is_Homogeneous_Aggregate (N) then
+ Error_Msg_N ("record aggregate must use (), not '[']", N);
+
elsif Is_Array_Type (Typ) then
-- First a special test, for the case of a positional aggregate of
@@ -5518,15 +5526,6 @@ package body Sem_Aggr is
return;
end if;
- -- A record aggregate can only use parentheses
-
- if Nkind (N) = N_Aggregate
-and then Is_Homogeneous_Aggregate (N)
- then
- Error_Msg_N ("record aggregate must use (), not '[']", N);
- return;
- end if;
-
-- STEP 2: Verify aggregate structure
Step_2 : declare
--
2.43.2
[COMMITTED 13/30] ada: Extend expansion delaying mechanism to conditional expressions
From: Eric Botcazou When an aggregate that needs to be converted into a series of assignments is present in an expression of a parent aggregate, or in the expression of an allocator, an object declaration, or an assignment in very specific cases, its expansion is delayed until its parent itself is expanded. This makes it possible to avoid creating a superfluous temporary for the aggregate. This change extends the delaying mechanism in the case of record aggregates to intermediate conditional expressions, that is to say, to the conditional expressions that are present between the parent and the aggregate, provided that the aggregate be a dependent expression, directly or recursively. This again makes it possible to avoid creating a temporary for the aggregate. gcc/ada/ * exp_aggr.ads (Is_Delayed_Conditional_Expression): New predicate. * exp_aggr.adb (Convert_To_Assignments.Known_Size): Likewise. (Convert_To_Assignments): Climb the parent chain, looking through qualified expressions and dependent expressions of conditional expressions, to find out whether the expansion may be delayed. Call Known_Size for this in the case of an object declaration. If so, set Expansion_Delayed on the aggregate as well as all the intermediate conditional expressions. (Initialize_Component): Reset the Analyzed flag on an initialization expression that is a conditional expression whose expansion has been delayed. (Is_Delayed_Conditional_Expression): New predicate. * exp_ch3.adb (Expand_N_Object_Declaration): Handle initialization expressions that are conditional expressions whose expansion has been delayed. * exp_ch4.adb (Build_Explicit_Assignment): New procedure. (Expand_Allocator_Expression): Handle initialization expressions that are conditional expressions whose expansion has been delayed. (Expand_N_Case_Expression): Deal with expressions whose expansion has been delayed by waiting for the rewriting of their parent as an assignment statement and then optimizing the assignment. (Expand_N_If_Expression): Likewise. (Expand_N_Qualified_Expression): Do not apply a predicate check to an operand that is a delayed aggregate or conditional expression. * gen_il-gen-gen_nodes.adb (N_If_Expression): Add Expansion_Delayed semantic flag. (N_Case_Expression): Likewise. * sinfo.ads (Expansion_Delayed): Document extended usage. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 201 - gcc/ada/exp_aggr.ads | 4 + gcc/ada/exp_ch3.adb | 38 gcc/ada/exp_ch4.adb | 363 --- gcc/ada/gen_il-gen-gen_nodes.adb | 4 +- gcc/ada/sinfo.ads| 4 + 6 files changed, 479 insertions(+), 135 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6208b49ffd9..a386aa85ae4 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4216,84 +4216,152 @@ package body Exp_Aggr is procedure Convert_To_Assignments (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); - Aggr_Code : List_Id; - Full_Typ: Entity_Id; - Instr : Node_Id; - Parent_Kind : Node_Kind; - Parent_Node : Node_Id; - Target_Expr : Node_Id; - Temp: Entity_Id; - Unc_Decl: Boolean := False; + function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean; + -- Decl is an N_Object_Declaration node. Return true if it declares an + -- object with a known size; in this context, that is always the case, + -- except for a declaration without explicit constraints of an object, + -- either whose nominal subtype is class-wide, or whose initialization + -- contains a conditional expression and whose nominal subtype is both + -- discriminated and unconstrained. + + + -- Known_Size -- + + + function Known_Size (Decl : Node_Id; Cond_Init : Boolean) return Boolean + is + begin + if Is_Entity_Name (Object_Definition (Decl)) then +declare + Typ : constant Entity_Id := Entity (Object_Definition (Decl)); + +begin + return not Is_Class_Wide_Type (Typ) + and then not (Cond_Init +and then Has_Discriminants (Typ) +and then not Is_Constrained (Typ)); +end; + + else +return True; + end if; + end Known_Size; + + -- Local variables + + Aggr_Code: List_Id; + Full_Typ : Entity_Id; + In_Cond_Expr : Boolean; + Instr: Node_Id; + Node : Node_Id; + Parent_Node : Node_Id; +
[COMMITTED 12/30] ada: Resolve ACATS compilation and execution issues with container aggregates
From: Gary Dismukes
This change set addresses various compilation and execution problems
encountered in the draft ACATS tests for container aggregates:
C435001 (container aggregates with Assign_Indexed)
C435002 (container aggregates with Add_Unnamed)
C435003 (container aggregates with Add_Named)
C435004 (container aggregates with Assign_Indexed and Add_Unnamed)
gcc/ada/
* exp_aggr.adb (Expand_Container_Aggregate): Add top-level
variables Choice_{Lo|Hi} and Int_Choice_{Lo|Hi} used for
determining the low and high bounds of component association
choices. Replace code for determining whether we have an indexed
aggregate with call to new function Sem_Aggr.Is_Indexed_Aggregate.
Remove test of whether Empty_Subp is a function, since it must be
a function. Move Default and Count_Type to be locals of a new
block enclosing the code that creates the object to hold the
aggregate length, and set them according to the default and type
of the Empty function's parameter when present (and to Empty and
Standard_Natural otherwise). Use Siz_Exp for the aggregate length
when set, and use Empty's default length when available, and use
zero for the length otherwise. In generating the call to the
New_Indexed function, use the determined lower and upper bounds if
determined earlier by Aggregate_Size, and otherwise compute those
from the index type's lower bound and the determined aggregate
length. In the case where a call to Empty is generated and the
function has a formal parameter, pass the value saved in Siz_Decl
(otherwise the parameter list is empty). Remove code specific to
making a parameterless call to the Empty function. Extend the code
for handling positional container aggregates to account for types
that define Assign_Indexed, rather than just Add_Unnamed, and in
the case of indexed aggregates, create a temporary object to hold
values of the aggregate's key index, and initialize and increment
that temporary for each call generated to the Assign_Indexed
procedure. For named container aggregates that have key choices
given by ranges, call Expand_Range_Component to generate a loop
that will call the appropriate insertion procedure for each value
of the range. For indexed aggregates with a Component_Associations
list, set and use the Assign_Indexed procedure for each component
association, whether or not there's an iterator specification.
(Add_Range_Size): Add code to determine the low and high bounds of
the range and capture those in up-level variables when their value
is less than or greater than (respectively) the current minimum
and maximum bounds values.
(Aggregate_Size): Separately handle the case where a single choice
is of a discrete type, and call Add_Range_Size to take its value
into consideration for determination of min and max bounds of the
aggregate. Add comments in a couple of places.
(Build_Siz_Exp): Remove the last sentence and "???" from the
comment that talks about accumulating nonstatic sizes, since that
sentence seems to be obsolete. Record the low and high bound
values in Choice_Lo and Choice_Hi in the case of a nonstatic
range.
(Expand_Iterated_Component): Set the Defining_Identifier of the
iterator specification to the Loop_Id in the
N_Iterated_Component_Association case.
(Expand_Range_Component): Procedure unnested from the block
handling indexed aggregates in Expand_Container_Aggregate, and
moved to top level of that procedure so it can also be called for
Add_Named cases. A formal parameter Insert_Op is added, and
existing calls to this procedure are changed to pass the
appropriate insertion procedure's Entity.
* sem_aggr.ads: Add with_clause for Sinfo.Nodes.
(Is_Indexed_Aggregate): New function for use by
Resolve_Container_Aggregate and Expand_Container_Aggregate.
* sem_aggr.adb: Add with_clause for Sem_Ch5. Move with_clause for
Sinfo.Nodes to sem_aggr.ads.
(Is_Indexed_Aggregate): New function to determine whether a
container aggregate is a container aggregate (replacing local
variable of the same name in Resolve_Container_Aggregate).
(Resolve_Iterated_Association): Remove part of comment saying that
a Key_Expression is always present. Set Parent field of the copy
of a component association with a loop parameter specification. On
the setting of Loop_Param_Id, account for a
Loop_Parameter_Specification being changed into an
Iterator_Specification as a result of being analyzed. Only call
Preanalyze_And_Resolve on Key_Expr when a key expression is
[COMMITTED 11/30] ada: Fix incorrect free with Task_Info pragma
From: Ronan Desplanques Before this patch, on Linux, the procedure System.Task_Primitives.Operations.Set_Task_Affinity called CPU_FREE on instances of cpu_set_t_ptr that it didn't own when the obsolescent Task_Info pragma was in play. This patch fixes that issue. gcc/ada/ * libgnarl/s-taprop__linux.adb (Set_Task_Affinity): Fix decision about whether to call CPU_FREE. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taprop__linux.adb | 17 +++-- 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 1faa3d8914e..0c09817739c 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -1466,12 +1466,13 @@ package body System.Task_Primitives.Operations is and then T.Common.LL.Thread /= Null_Thread_Id then declare -CPUs: constant size_t := -C.size_t (Multiprocessors.Number_Of_CPUs); -CPU_Set : cpu_set_t_ptr := null; -Size: constant size_t := CPU_ALLOC_SIZE (CPUs); +CPUs : constant size_t := + C.size_t (Multiprocessors.Number_Of_CPUs); +CPU_Set : cpu_set_t_ptr := null; +Is_Set_Owned : Boolean := False; +Size : constant size_t := CPU_ALLOC_SIZE (CPUs); -Result : C.int; +Result : C.int; begin -- We look at the specific CPU (Base_CPU) first, then at the @@ -1483,6 +1484,7 @@ package body System.Task_Primitives.Operations is -- Set the affinity to an unique CPU CPU_Set := CPU_ALLOC (CPUs); + Is_Set_Owned := True; System.OS_Interface.CPU_ZERO (Size, CPU_Set); System.OS_Interface.CPU_SET (int (T.Common.Base_CPU), Size, CPU_Set); @@ -1499,6 +1501,7 @@ package body System.Task_Primitives.Operations is -- dispatching domain. CPU_Set := CPU_ALLOC (CPUs); + Is_Set_Owned := True; System.OS_Interface.CPU_ZERO (Size, CPU_Set); for Proc in T.Common.Domain'Range loop @@ -1512,7 +1515,9 @@ package body System.Task_Primitives.Operations is pthread_setaffinity_np (T.Common.LL.Thread, Size, CPU_Set); pragma Assert (Result = 0); -CPU_FREE (CPU_Set); +if Is_Set_Owned then + CPU_FREE (CPU_Set); +end if; end; end if; end Set_Task_Affinity; -- 2.43.2
[COMMITTED 22/30] ada: Handle accessibility calculations for 'First and 'Last
From: Justin Squirek This patch fixes a crash in the compiler whereby calculating the accessibility level of of a local variable whose original expression is an 'First on an array type led to an error during compilation. gcc/ada/ * accessibility.adb (Accessibility_Level): Add cases for 'First and 'Last. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/accessibility.adb | 10 +- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb index c0a9d50f38a..33ce001718a 100644 --- a/gcc/ada/accessibility.adb +++ b/gcc/ada/accessibility.adb @@ -465,7 +465,15 @@ package body Accessibility is -- so handle these cases explicitly. elsif Attribute_Name (E) -in Name_Old | Name_Loop_Entry | Name_Result | Name_Super +in Name_Old| + Name_Loop_Entry | + Name_Result | + Name_Super | + Name_Tag| + Name_Safe_First | + Name_Safe_Last | + Name_First | + Name_Last then -- Named access types -- 2.43.2
[COMMITTED 14/30] ada: Tweak handling of thread ID on POSIX
From: Ronan Desplanques This patch changes the task initialization subprograms on POSIX platforms so that the thread ID of an ATCB is only set once. This has the advantage of getting rid of the Atomic aspect on the corresponding record component, and silences a Helgrind warning about a data race. gcc/ada/ * libgnarl/s-taprop__linux.adb (Enter_Task): Move setting of thread ID out of Enter_Task. (Initialize): Set thread ID for the environment task. (Create_Task): Remove now unnecessary Unrestricted_Access attribute and add justification for a memory write. * libgnarl/s-taprop__posix.adb: Likewise. * libgnarl/s-taprop__qnx.adb: Likewise. * libgnarl/s-taprop__rtems.adb: Likewise. * libgnarl/s-taprop__solaris.adb: Likewise. * libgnarl/s-taspri__posix.ads: Remove pragma Atomic for Private_Data.Thread, and update documentation comment. * libgnarl/s-taspri__lynxos.ads: Likewise. * libgnarl/s-taspri__posix-noaltstack.ads: Likewise. * libgnarl/s-taspri__solaris.ads: Likewise. * libgnarl/s-tporft.adb (Register_Foreign_Thread): Adapt to Enter_Task not setting the thread ID anymore. * libgnarl/s-tassta.adb (Task_Wrapper): Update comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taprop__linux.adb| 14 +++--- gcc/ada/libgnarl/s-taprop__posix.adb| 14 +++--- gcc/ada/libgnarl/s-taprop__qnx.adb | 14 +++--- gcc/ada/libgnarl/s-taprop__rtems.adb| 14 +++--- gcc/ada/libgnarl/s-taprop__solaris.adb | 16 gcc/ada/libgnarl/s-taspri__lynxos.ads | 16 ++-- gcc/ada/libgnarl/s-taspri__posix-noaltstack.ads | 16 ++-- gcc/ada/libgnarl/s-taspri__posix.ads| 16 ++-- gcc/ada/libgnarl/s-taspri__solaris.ads | 16 ++-- gcc/ada/libgnarl/s-tassta.adb | 2 +- gcc/ada/libgnarl/s-tporft.adb | 1 + 11 files changed, 78 insertions(+), 61 deletions(-) diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index 0c09817739c..0a51b3601c0 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -730,7 +730,6 @@ package body System.Task_Primitives.Operations is raise Invalid_CPU_Number; end if; - Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.LWP := lwp_self; -- Set thread name to ease debugging. If the name of the task is @@ -1004,14 +1003,14 @@ package body System.Task_Primitives.Operations is -- do not need to manipulate caller's signal mask at this point. -- All tasks in RTS will have All_Tasks_Mask initially. - -- Note: the use of Unrestricted_Access in the following call is needed - -- because otherwise we have an error of getting a access-to-volatile - -- value which points to a non-volatile object. But in this case it is - -- safe to do this, since we know we have no problems with aliasing and - -- Unrestricted_Access bypasses this check. + -- The write to T.Common.LL.Thread is not racy with regard to the + -- created thread because the created thread will not access it until + -- we release the RTS lock (or the current task's lock when + -- Restricted.Stages is used). One can verify that by inspecting the + -- Task_Wrapper procedures. Result := pthread_create -(T.Common.LL.Thread'Unrestricted_Access, +(T.Common.LL.Thread'Access, Thread_Attr'Access, Thread_Body_Access (Wrapper), To_Address (T)); @@ -1385,6 +1384,7 @@ package body System.Task_Primitives.Operations is begin Environment_Task_Id := Environment_Task; + Environment_Task.Common.LL.Thread := pthread_self; Interrupt_Management.Initialize; diff --git a/gcc/ada/libgnarl/s-taprop__posix.adb b/gcc/ada/libgnarl/s-taprop__posix.adb index 7ed52ea2d82..fb70aaf4976 100644 --- a/gcc/ada/libgnarl/s-taprop__posix.adb +++ b/gcc/ada/libgnarl/s-taprop__posix.adb @@ -636,7 +636,6 @@ package body System.Task_Primitives.Operations is procedure Enter_Task (Self_ID : Task_Id) is begin - Self_ID.Common.LL.Thread := pthread_self; Self_ID.Common.LL.LWP := lwp_self; Specific.Set (Self_ID); @@ -841,14 +840,14 @@ package body System.Task_Primitives.Operations is -- do not need to manipulate caller's signal mask at this point. -- All tasks in RTS will have All_Tasks_Mask initially. - -- Note: the use of Unrestricted_Access in the following call is needed - -- because otherwise we have an error of getting a access-to-volatile - -- value which points to a non-volatile object. But in this case it is - -- safe to do this, since we know we have no problems with
[COMMITTED 09/30] ada: Fix static 'Img for enumeration type with Discard_Names
From: Piotr Trojanek
Fix a short-circuit folding of 'Img for enumeration type, which wrongly
ignored Discard_Names and exposed enumeration literals.
gcc/ada/
* sem_attr.adb (Eval_Attribute): Handle enumeration type with
Discard_Names.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_attr.adb | 19 ---
1 file changed, 16 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 96f216cc587..2b22cf13ad0 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8221,13 +8221,26 @@ package body Sem_Attr is
then
declare
Lit : constant Entity_Id := Expr_Value_E (P);
+Typ : constant Entity_Id := Etype (Entity (P));
Str : String_Id;
begin
Start_String;
-Get_Unqualified_Decoded_Name_String (Chars (Lit));
-Set_Casing (All_Upper_Case);
-Store_String_Chars (Name_Buffer (1 .. Name_Len));
+
+-- If Discard_Names is in effect for the type, then we emit the
+-- numeric representation of the prefix literal 'Pos attribute,
+-- prefixed with a single space.
+
+if Discard_Names (Typ) then
+ UI_Image (Enumeration_Pos (Lit), Decimal);
+ Store_String_Char (' ');
+ Store_String_Chars (UI_Image_Buffer (1 .. UI_Image_Length));
+else
+ Get_Unqualified_Decoded_Name_String (Chars (Lit));
+ Set_Casing (All_Upper_Case);
+ Store_String_Chars (Name_Buffer (1 .. Name_Len));
+end if;
+
Str := End_String;
Rewrite (N, Make_String_Literal (Loc, Strval => Str));
--
2.43.2
[COMMITTED 01/30] ada: Rework and augment documentation on strict aliasing
From: Eric Botcazou The documentation was originally centered around pragma No_Strict_Aliasing and pragma Universal_Aliasing was mentioned only as an afterthought. It also contained a warning about the usage of overlays implemented by means of address clauses that has been obsolete for long. gcc/ada/ * doc/gnat_rm/implementation_defined_pragmas.rst (Universal_Aliasing): Remove reference to No_Strict_Aliasing. * doc/gnat_ugn/gnat_and_program_execution.rst (Optimization and Strict Aliasinng): Simplify first example and make it more consistent with the second. Add description of the effects of pragma Universal_Aliasing and document new warning issued for unchecked conversions. Remove obsolete stuff. * gnat_rm.texi: Regenerate. * gnat_ugn.texi: Regenerate. Tested on x86_64-pc-linux-gnu, committed on master. --- .../implementation_defined_pragmas.rst| 7 +- .../gnat_ugn/gnat_and_program_execution.rst | 296 + gcc/ada/gnat_rm.texi | 7 +- gcc/ada/gnat_ugn.texi | 306 ++ 4 files changed, 353 insertions(+), 263 deletions(-) diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 7f221e32344..bcbd85984dc 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -6949,10 +6949,9 @@ Syntax: ``type_LOCAL_NAME`` must refer to a type declaration in the current declarative part. The effect is to inhibit strict type-based aliasing -optimization for the given type. In other words, the effect is as though -access types designating this type were subject to pragma No_Strict_Aliasing. -For a detailed description of the strict aliasing optimization, and the -situations in which it must be suppressed, see the section on +optimizations for the given type. For a detailed description of the +strict type-based aliasing optimizations and the situations in which +they need to be suppressed, see the section on ``Optimization and Strict Aliasing`` in the :title:`GNAT User's Guide`. .. _Pragma-Unmodified: diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index 35e34772658..d502da87eb0 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -2072,37 +2072,36 @@ the following example: .. code-block:: ada - procedure R is + procedure M is type Int1 is new Integer; +I1 : Int1; + type Int2 is new Integer; -type Int1A is access Int1; -type Int2A is access Int2; -Int1V : Int1A; -Int2V : Int2A; +type A2 is access Int2; +V2 : A2; ... begin ... for J in Data'Range loop - if Data (J) = Int1V.all then - Int2V.all := Int2V.all + 1; + if Data (J) = I1 then + V2.all := V2.all + 1; end if; end loop; ... - end R; + end; -In this example, since the variable ``Int1V`` can only access objects -of type ``Int1``, and ``Int2V`` can only access objects of type -``Int2``, there is no possibility that the assignment to -``Int2V.all`` affects the value of ``Int1V.all``. This means that -the compiler optimizer can "know" that the value ``Int1V.all`` is constant -for all iterations of the loop and avoid the extra memory reference -required to dereference it each time through the loop. +In this example, since ``V2`` can only access objects of type ``Int2`` +and ``I1`` is not one of them, there is no possibility that the assignment +to ``V2.all`` affects the value of ``I1``. This means that the compiler +optimizer can infer that the value ``I1`` is constant for all iterations +of the loop and load it from memory only once, before entering the loop, +instead of in every iteration (this is called load hoisting). -This kind of optimization, called strict aliasing analysis, is +This kind of optimizations, based on strict type-based aliasing, is triggered by specifying an optimization level of :switch:`-O2` or -higher or :switch:`-Os` and allows GNAT to generate more efficient code -when access values are involved. +higher (or :switch:`-Os`) and allows the compiler to generate more +efficient code. However, although this optimization is always correct in terms of the formal semantics of the Ada Reference Manual, difficulties can @@ -2111,173 +2110,214 @@ the typing system. Consider the following complete program example: .. code-block:: ada - package p1 is - type int1 is new integer; - type int2 is new integer; - type a1 is access int1; - type a2 is access int2; - end p1; + package P1 is + type Int1 is new Integer; +
[COMMITTED 16/30] ada: Use discrete choice list in declaration of universal type attributes
From: Piotr Trojanek Code cleanup. gcc/ada/ * sem_attr.ads (Universal_Type_Attribute): Simplify using array aggregate syntax with discrete choice list. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.ads | 62 ++-- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index d18bd5b0667..40ec423c4c7 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -615,37 +615,37 @@ package Sem_Attr is -- universal type. Universal_Type_Attribute : constant array (Attribute_Id) of Boolean := - (Attribute_Aft => True, - Attribute_Alignment=> True, - Attribute_Component_Size => True, - Attribute_Count=> True, - Attribute_Delta=> True, - Attribute_Digits => True, - Attribute_Exponent => True, - Attribute_First_Bit=> True, - Attribute_Fore => True, - Attribute_Last_Bit => True, - Attribute_Length => True, - Attribute_Machine_Emax => True, - Attribute_Machine_Emin => True, - Attribute_Machine_Mantissa => True, - Attribute_Machine_Radix=> True, - Attribute_Max_Alignment_For_Allocation => True, - Attribute_Max_Size_In_Storage_Elements => True, - Attribute_Model_Emin => True, - Attribute_Model_Epsilon=> True, - Attribute_Model_Mantissa => True, - Attribute_Model_Small => True, - Attribute_Modulus => True, - Attribute_Pos => True, - Attribute_Position => True, - Attribute_Safe_First => True, - Attribute_Safe_Last=> True, - Attribute_Scale=> True, - Attribute_Size => True, - Attribute_Small=> True, - Attribute_Wide_Wide_Width => True, - Attribute_Wide_Width => True, + (Attribute_Aft | + Attribute_Alignment| + Attribute_Component_Size | + Attribute_Count| + Attribute_Delta| + Attribute_Digits | + Attribute_Exponent | + Attribute_First_Bit| + Attribute_Fore | + Attribute_Last_Bit | + Attribute_Length | + Attribute_Machine_Emax | + Attribute_Machine_Emin | + Attribute_Machine_Mantissa | + Attribute_Machine_Radix| + Attribute_Max_Alignment_For_Allocation | + Attribute_Max_Size_In_Storage_Elements | + Attribute_Model_Emin | + Attribute_Model_Epsilon| + Attribute_Model_Mantissa | + Attribute_Model_Small | + Attribute_Modulus | + Attribute_Pos | + Attribute_Position | + Attribute_Safe_First | + Attribute_Safe_Last| + Attribute_Scale| + Attribute_Size | + Attribute_Small| + Attribute_Wide_Wide_Width | + Attribute_Wide_Width | Attribute_Width=> True, others => False); -- 2.43.2
[COMMITTED 15/30] ada: Fix style in list of implementation-defined attributes
From: Piotr Trojanek Code cleanup. gcc/ada/ * sem_attr.ads (Attribute_Impl_Def): Fix style in comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_attr.ads | 8 1 file changed, 8 insertions(+) diff --git a/gcc/ada/sem_attr.ads b/gcc/ada/sem_attr.ads index 0e7d1693682..d18bd5b0667 100644 --- a/gcc/ada/sem_attr.ads +++ b/gcc/ada/sem_attr.ads @@ -288,6 +288,10 @@ package Sem_Attr is -- attribute is primarily intended for use in implementation of the -- standard input-output functions for fixed-point values. + + -- Invalid_Value -- + + Attribute_Invalid_Value => True, -- For every scalar type, S'Invalid_Value designates an undefined value -- of the type. If possible this value is an invalid value, and in fact @@ -298,6 +302,10 @@ package Sem_Attr is -- coding standards in use), but logically no initialization is needed, -- and the value should never be accessed. + + -- Loop_Entry -- + + Attribute_Loop_Entry => True, -- For every object of a non-limited type, S'Loop_Entry [(Loop_Name)] -- denotes the constant value of prefix S at the point of entry into the -- 2.43.2
[COMMITTED 08/30] ada: Fix for attribute Width on enumeration types with Discard_Name
From: Piotr Trojanek Fix computation of attribute 'Width for enumeration types with Discard_Name aspect enabled. gcc/ada/ * exp_imgv.adb (Expand_Width_Attribute): Fix for 'Width that is computed at run time. * sem_attr.adb (Eval_Attribute): Fix for 'Width that is computed at compilation time. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_imgv.adb | 25 +++-- gcc/ada/sem_attr.adb | 7 --- 2 files changed, 19 insertions(+), 13 deletions(-) diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 6dc59f2c6f3..e5d84cc52e3 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -2294,7 +2294,7 @@ package body Exp_Imgv is -- in the range of the subtype + 1 for the space at the start. We -- build: - -- Tnn : constant Integer := Rtyp'Pos (Ptyp'Last) + -- Tnn : constant Integer := Rtyp'Pos (Ptyp'Last); -- and replace the expression by @@ -2320,9 +2320,15 @@ package body Exp_Imgv is declare Tnn : constant Entity_Id := Make_Temporary (Loc, 'T'); Cexpr : Node_Id; - P : Int; - M : Int; - K : Int; + + P : constant Nat := + UI_To_Int (Enumeration_Pos (Entity (Type_High_Bound (Rtyp; + -- The largest value that might need to be represented + + K : Pos; + M : Pos; + -- K is the number of chars that will fit the image of 0..M-1; + -- M is the smallest number that won't fit in K chars. begin Insert_Action (N, @@ -2342,14 +2348,13 @@ package body Exp_Imgv is Attribute_Name => Name_Last)); -- OK, now we need to build the if expression. First get the - -- value of M, the largest possible value needed. + -- values of K and M for the largest possible value P. - P := UI_To_Int - (Enumeration_Pos (Entity (Type_High_Bound (Rtyp; + K := 2; + M := 10; + -- With 2 characters we can represent values in 0..9 - K := 1; - M := 1; - while M < P loop + while P >= M loop M := M * 10; K := K + 1; end loop; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index a921909685a..96f216cc587 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -10906,9 +10906,10 @@ package body Sem_Attr is -- that accommodates the Pos of the largest value, which -- is the high bound of the range + one for the space. - W := 1; - T := Hi; - while T /= 0 loop + W := 1; -- one character for the leading space + W := W + 1; -- one character for the 0 .. 9 digit + T := Hi; -- one character for every decimal digit + while T >= 10 loop T := T / 10; W := W + 1; end loop; -- 2.43.2
[COMMITTED 05/30] ada: One more adjustment coming from aliasing considerations
From: Eric Botcazou It is needed on PowerPC platforms because of specific calling conventions. gcc/ada/ * libgnat/g-sothco.ads (In_Addr): Add aspect Universal_Aliasing. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/g-sothco.ads | 7 +-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads index 8c219333649..da1e6f5bcdd 100644 --- a/gcc/ada/libgnat/g-sothco.ads +++ b/gcc/ada/libgnat/g-sothco.ads @@ -123,10 +123,13 @@ package GNAT.Sockets.Thin_Common is type In_Addr is record S_B1, S_B2, S_B3, S_B4 : C.unsigned_char; - end record with Convention => C, Alignment => C.int'Alignment; + end record + with Convention => C, Alignment => C.int'Alignment, Universal_Aliasing; -- IPv4 address, represented as a network-order C.int. Note that the -- underlying operating system may assume that values of this type have - -- C.int alignment, so we need to provide a suitable alignment clause here. + -- C.int's alignment, so we need to provide a suitable alignment clause. + -- We also need to inhibit strict type-based aliasing optimizations in + -- order to implement the following unchecked conversions efficiently. function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr); function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int); -- 2.43.2
[COMMITTED 07/30] ada: Use System.Address for address computation in System.Pool_Global
From: Sebastian Poeplau Some architectures don't let us convert System.Storage_Elements.Integer_Address back to a valid System.Address. Using the arithmetic operations on System.Address from System.Storage_Elements prevents the problem while leaving semantics unchanged. gcc/ada/ * libgnat/s-pooglo.adb (Allocate): Use arithmetic on System.Address to compute the aligned address. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-pooglo.adb | 7 --- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/gcc/ada/libgnat/s-pooglo.adb b/gcc/ada/libgnat/s-pooglo.adb index dea3de15cc5..9ce21c8fd0d 100644 --- a/gcc/ada/libgnat/s-pooglo.adb +++ b/gcc/ada/libgnat/s-pooglo.adb @@ -75,9 +75,10 @@ package body System.Pool_Global is -- Realign the returned address - Aligned_Address := To_Address - (To_Integer (Allocated) + Integer_Address (Alignment) - - (To_Integer (Allocated) mod Integer_Address (Alignment))); + Aligned_Address := + Allocated + Alignment + - Storage_Offset (To_Integer (Allocated) + mod Integer_Address (Alignment)); -- Save the block address -- 2.43.2
[COMMITTED 06/30] ada: Reject too-strict alignment specifications.
From: Steve Baird
For a discrete (or fixed-point) type T, GNAT requires that T'Object_Size
shall be a multiple of T'Alignment * 8 .
GNAT also requires that T'Object_Size shall be no larger than
Standard'Max_Integer_Size.
For a sufficiently-large alignment specification, these requirements can
conflict.
The conflict is resolved by rejecting such alignment specifications (which
were previously accepted in some cases).
gcc/ada/
* freeze.adb (Adjust_Esize_For_Alignment): Assert that a valid
Alignment specification cannot result in adjusting the given
type's Esize to be larger than System_Max_Integer_Size.
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): In analyzing
an Alignment specification, enforce the rule that a specified
Alignment value for a discrete or fixed-point type shall not be
larger than System_Max_Integer_Size / 8 .
gcc/testsuite/ChangeLog:
* gnat.dg/specs/alignment2.ads: Adjust.
* gnat.dg/specs/alignment2_bis.ads: New test.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/freeze.adb| 8 +++--
gcc/ada/sem_ch13.adb | 15
gcc/testsuite/gnat.dg/specs/alignment2.ads| 14
.../gnat.dg/specs/alignment2_bis.ads | 36 +++
4 files changed, 57 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a980c7e5b47..26e9d01d8b2 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -303,8 +303,12 @@ package body Freeze is
if Known_Esize (Typ) and then Known_Alignment (Typ) then
Align := Alignment_In_Bits (Typ);
- if Align > Esize (Typ) and then Align <= System_Max_Integer_Size then
-Set_Esize (Typ, Align);
+ if Align > Esize (Typ) then
+if Align > System_Max_Integer_Size then
+ pragma Assert (Serious_Errors_Detected > 0);
+else
+ Set_Esize (Typ, Align);
+end if;
end if;
end if;
end Adjust_Esize_For_Alignment;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 13bf93ca548..59c80022c20 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6573,6 +6573,21 @@ package body Sem_Ch13 is
("alignment for & set to Maximum_Aligment??", Nam);
Set_Alignment (U_Ent, Max_Align);
+ -- Because Object_Size must be multiple of Alignment (in bits),
+ -- System_Max_Integer_Size limit for discrete and fixed point
+ -- types implies a limit on alignment for such types.
+
+ elsif (Is_Discrete_Type (U_Ent)
+or else Is_Fixed_Point_Type (U_Ent))
+ and then Align > System_Max_Integer_Size / System_Storage_Unit
+ then
+ Error_Msg_N
+("specified alignment too large for discrete or fixed " &
+ "point type", Expr);
+ Set_Alignment
+(U_Ent, UI_From_Int (System_Max_Integer_Size /
+ System_Storage_Unit));
+
-- All other cases
else
diff --git a/gcc/testsuite/gnat.dg/specs/alignment2.ads
b/gcc/testsuite/gnat.dg/specs/alignment2.ads
index 0b6c14f1b7d..75a002e9bee 100644
--- a/gcc/testsuite/gnat.dg/specs/alignment2.ads
+++ b/gcc/testsuite/gnat.dg/specs/alignment2.ads
@@ -32,18 +32,4 @@ package Alignment2 is
end record;
for R4'Alignment use 32;
- -- warning
- type I1 is new Integer_32;
- for I1'Size use 32;
- for I1'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
-
- -- warning
- type I2 is new Integer_32;
- for I2'Alignment use 32; -- { dg-warning "suspiciously large alignment" }
-
- -- OK, big size
- type I3 is new Integer_32;
- for I3'Size use 32 * 8; -- { dg-warning "unused" }
- for I3'Alignment use 32;
-
end Alignment2;
diff --git a/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
b/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
new file mode 100644
index 000..ad31a400b84
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/alignment2_bis.ads
@@ -0,0 +1,36 @@
+-- { dg-do compile }
+
+with Interfaces; use Interfaces;
+
+package Alignment2_Bis is
+
+ pragma Warnings (Off, "*size*");
+
+ -- OK, big size
+ type R3 is record
+A, B, C, D : Integer_8;
+ end record;
+ for R3'Size use 32 * 8;
+ for R3'Alignment use 32;
+
+ -- OK, big size
+ type R4 is record
+A, B, C, D, E, F, G, H : Integer_32;
+ end record;
+ for R4'Alignment use 32;
+
+ -- warning
+ type I1 is new Integer_32;
+ for I1'Size use 32;
+ for I1'Alignment use 32; -- { dg-error "error: specified alignment too large
for discrete or fixed point type" }
+
+ -- warning
+ type I2 is new Integer_32;
+ for I2'Alignment use 32; -- { dg-error "error: specified
[COMMITTED 04/30] ada: Detect only conflict with synomyms of max queue length
From: Jose Ruiz
Use of duplicated representation aspect is detected elsewhere
so we do not try to detect them here to avoid repetition of
messages.
gcc/ada/
* sem_prag.adb (Analyze_Pragma): Exclude detection of duplicates
because they are detected elsewhere.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 18 +-
1 file changed, 13 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 0e2ce9de4b5..a895fd2053a 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -20388,15 +20388,23 @@ package body Sem_Prag is
("pragma % must apply to a protected entry declaration");
end if;
--- Check for duplicates
+-- Check for conflicting use of synonyms. Note that we exclude
+-- the detection of duplicates here because they are detected
+-- elsewhere.
-if Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Length)
+if (Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Length)
+ and then
+Prag_Id /= Pragma_Max_Entry_Queue_Length)
or else
- Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Depth)
+ (Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Depth)
+ and then
+Prag_Id /= Pragma_Max_Entry_Queue_Depth)
or else
- Has_Rep_Pragma (Entry_Id, Name_Max_Queue_Length)
+ (Has_Rep_Pragma (Entry_Id, Name_Max_Queue_Length)
+ and then
+Prag_Id /= Pragma_Max_Queue_Length)
then
- Error_Msg_N ("??duplicate Max_Entry_Queue_Length pragma", N);
+ Error_Msg_N ("??maximum entry queue length already set", N);
end if;
-- Mark the pragma as Ghost if the related subprogram is also
--
2.43.2
[COMMITTED 02/30] ada: Small cleanup in System.Finalization_Primitives unit
From: Eric Botcazou It has been made possible by recent changes. gcc/ada/ * libgnat/s-finpri.ads (Collection_Node): Move to private part. (Collection_Node_Ptr): Likewise. (Header_Alignment): Change to declaration and move completion to private part. (Header_Size): Likewise. (Lock_Type): Delete. (Finalization_Collection): Move Lock component and remove default value for Finalization_Started component. * libgnat/s-finpri.adb (Initialize): Reorder statements. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/s-finpri.adb | 4 +-- gcc/ada/libgnat/s-finpri.ads | 48 +++- 2 files changed, 28 insertions(+), 24 deletions(-) diff --git a/gcc/ada/libgnat/s-finpri.adb b/gcc/ada/libgnat/s-finpri.adb index 028c9d76062..bc90fe23ac9 100644 --- a/gcc/ada/libgnat/s-finpri.adb +++ b/gcc/ada/libgnat/s-finpri.adb @@ -394,14 +394,14 @@ package body System.Finalization_Primitives is (Collection : in out Finalization_Collection) is begin - Collection.Finalization_Started := False; - -- The dummy head must point to itself in both directions Collection.Head.Prev := Collection.Head'Unchecked_Access; Collection.Head.Next := Collection.Head'Unchecked_Access; Initialize_RTS_Lock (Collection.Lock'Address); + + Collection.Finalization_Started := False; end Initialize; - diff --git a/gcc/ada/libgnat/s-finpri.ads b/gcc/ada/libgnat/s-finpri.ads index 62c2474b4f4..a821f1db657 100644 --- a/gcc/ada/libgnat/s-finpri.ads +++ b/gcc/ada/libgnat/s-finpri.ads @@ -146,16 +146,6 @@ package System.Finalization_Primitives with Preelaborate is -- collection, in some arbitrary order. Calls to this procedure with -- a collection that has already been finalized have no effect. - type Collection_Node is private; - -- Each controlled object associated with a finalization collection has - -- an associated object of this type. - - type Collection_Node_Ptr is access all Collection_Node; - for Collection_Node_Ptr'Storage_Size use 0; - pragma No_Strict_Aliasing (Collection_Node_Ptr); - -- A reference to a collection node. Since this type may not be used to - -- allocate objects, its storage size is zero. - procedure Attach_Object_To_Collection (Object_Address : System.Address; Finalize_Address : not null Finalize_Address_Ptr; @@ -171,13 +161,13 @@ package System.Finalization_Primitives with Preelaborate is -- Calls to the procedure with an object that has already been detached -- have no effects. - function Header_Alignment return System.Storage_Elements.Storage_Count is - (Collection_Node'Alignment); - -- Return the alignment of type Collection_Node as Storage_Count + function Header_Alignment return System.Storage_Elements.Storage_Count; + -- Return the alignment of the header to be placed immediately in front of + -- a controlled object allocated for some access type, in storage units. - function Header_Size return System.Storage_Elements.Storage_Count is - (Collection_Node'Object_Size / Storage_Unit); - -- Return the object size of type Collection_Node as Storage_Count + function Header_Size return System.Storage_Elements.Storage_Count; + -- Return the size of the header to be placed immediately in front of a + -- controlled object allocated for some access type, in storage units. private @@ -221,6 +211,16 @@ private -- Finalization collections: + type Collection_Node; + -- Each controlled object associated with a finalization collection has + -- an associated object of this type. + + type Collection_Node_Ptr is access all Collection_Node; + for Collection_Node_Ptr'Storage_Size use 0; + pragma No_Strict_Aliasing (Collection_Node_Ptr); + -- A reference to a collection node. Since this type may not be used to + -- allocate objects, its storage size is zero. + -- Collection node type structure. Finalize_Address comes first because it -- is an access-to-subprogram and, therefore, might be twice as large and -- as aligned as an access-to-object on some platforms. @@ -237,7 +237,11 @@ private -- Collection nodes are managed as a circular doubly-linked list end record; - type Lock_Type is mod 2**8 with Size => 8; + function Header_Alignment return System.Storage_Elements.Storage_Count is + (Collection_Node'Alignment); + + function Header_Size return System.Storage_Elements.Storage_Count is + (Collection_Node'Object_Size / Storage_Unit); -- Finalization collection type structure @@ -245,15 +249,15 @@ private new Ada.Finalization.Limited_Controlled with record Head : aliased Collection_Node; - -- The head of the circular doubly-linked list of Collection_Nodes + -- The head of the circular doubly-linked list of collection nodes + + Lock
[COMMITTED 03/30] ada: Implement representation aspect Max_Entry_Queue_Length
From: Jose Ruiz
Enforce Max_Entry_Queue_Length (and its
synonym Max_Entry_Queue_Depth) when applied to individual
protected entries.
gcc/ada/
* exp_ch9.adb (Expand_N_Protected_Type_Declaration): Clarify
comments.
* sem_prag.adb (Analyze_Pragma): Check for duplicates
Max_Entry_Queue_Length, Max_Entry_Queue_Depth and Max_Queue_Length
for the same protected entry.
* sem_util.adb (Get_Max_Queue_Length): Take into account all three
representation aspects that can be used to set this restriction.
(Has_Max_Queue_Length): Likewise.
* doc/gnat_rm/implementation_defined_pragmas.rst:
(pragma Max_Queue_Length): Fix pragma in example.
* gnat_rm.texi: Regenerate.
Tested on x86_64-pc-linux-gnu, committed on master.
---
.../implementation_defined_pragmas.rst| 2 +-
gcc/ada/exp_ch9.adb | 6 ++--
gcc/ada/gnat_rm.texi | 2 +-
gcc/ada/sem_prag.adb | 11 +++
gcc/ada/sem_util.adb | 33 ++-
5 files changed, 41 insertions(+), 13 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index bcbd85984dc..0661670e047 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -3771,7 +3771,7 @@ Pragma Max_Queue_Length
Syntax::
- pragma Max_Entry_Queue (static_integer_EXPRESSION);
+ pragma Max_Queue_Length (static_integer_EXPRESSION);
This pragma is used to specify the maximum callers per entry queue for
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 051b1df060f..4de253ab6e8 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -9405,7 +9405,8 @@ package body Exp_Ch9 is
end loop;
-- Create the declaration of an array object which contains the values
- -- of aspect/pragma Max_Queue_Length for all entries of the protected
+ -- of any aspect/pragma Max_Queue_Length, Max_Entry_Queue_Length or
+ -- Max_EntryQueue_Depth for all entries of the protected
-- type. This object is later passed to the appropriate protected object
-- initialization routine.
@@ -9422,7 +9423,8 @@ package body Exp_Ch9 is
Need_Array : Boolean := False;
begin
--- First check if there is any Max_Queue_Length pragma
+-- First check if there is any Max_Queue_Length,
+-- Max_Entry_Queue_Length or Max_Entry_Queue_Depth pragma.
Item := First_Entity (Prot_Typ);
while Present (Item) loop
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 40516121b7a..4dbbb036a25 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -5312,7 +5312,7 @@ no effect in GNAT, other than being syntax checked.
Syntax:
@example
-pragma Max_Entry_Queue (static_integer_EXPRESSION);
+pragma Max_Queue_Length (static_integer_EXPRESSION);
@end example
This pragma is used to specify the maximum callers per entry queue for
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index f27e40edcbb..0e2ce9de4b5 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -20388,6 +20388,17 @@ package body Sem_Prag is
("pragma % must apply to a protected entry declaration");
end if;
+-- Check for duplicates
+
+if Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Length)
+ or else
+ Has_Rep_Pragma (Entry_Id, Name_Max_Entry_Queue_Depth)
+ or else
+ Has_Rep_Pragma (Entry_Id, Name_Max_Queue_Length)
+then
+ Error_Msg_N ("??duplicate Max_Entry_Queue_Length pragma", N);
+end if;
+
-- Mark the pragma as Ghost if the related subprogram is also
-- Ghost. This also ensures that any expansion performed further
-- below will produce Ghost nodes.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index d512d462b44..09358278210 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10714,26 +10714,38 @@ package body Sem_Util is
function Get_Max_Queue_Length (Id : Entity_Id) return Uint is
pragma Assert (Is_Entry (Id));
- Prag : constant Entity_Id := Get_Pragma (Id, Pragma_Max_Queue_Length);
- Max : Uint;
+ PMQL : constant Entity_Id := Get_Pragma (Id, Pragma_Max_Queue_Length);
+ PMEQD : constant Entity_Id :=
+ Get_Pragma (Id, Pragma_Max_Entry_Queue_Depth);
+ PMEQL : constant Entity_Id :=
+ Get_Pragma (Id, Pragma_Max_Entry_Queue_Length);
+ Max : Uint;
begin
-- A value of 0 or -1 represents no maximum specified, and entries and
-- entry families with no Max_Queue_Length aspect or pragma default to
-- it.
- if No (Prag) then
-
[COMMITTED 32/35] ada: Improve test for unprocessed preprocessor directives
From: Steve Baird
Preprocessor directives are case insensitive and may have spaces or tabs
between the '#' and the keyword. When checking for the error case of
unprocessed preprocessor directives, take these rules into account.
gcc/ada/
* scng.adb (scan): When checking for an unprocessed preprocessor
directive, take into account the preprocessor's rules about case
insensitivity and about white space between the '#' and the
keyword.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/scng.adb | 183 +++
1 file changed, 122 insertions(+), 61 deletions(-)
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index 9b1d00e3452..8b2829ffbbf 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -40,6 +40,7 @@ with Widechar; use Widechar;
pragma Warnings (Off);
-- This package is used also by gnatcoll
+with System.Case_Util;
with System.CRC32;
with System.UTF_32; use System.UTF_32;
with System.WCh_Con; use System.WCh_Con;
@@ -2250,86 +2251,146 @@ package body Scng is
when Special_Preprocessor_Character =>
--- If Set_Special_Character has been called for this character,
--- set Scans.Special_Character and return a Special token.
+declare
+ function Matches_After_Skipping_White_Space
+ (S : String) return Boolean;
+
+ -- Return True iff after skipping past white space the
+ -- next Source characters match the given string.
+
+
+ -- Matches_After_Skipping_White_Space --
+
+
+ function Matches_After_Skipping_White_Space
+ (S : String) return Boolean
+ is
+ function To_Lower_Case_String (Buff : Text_Buffer)
+return String;
+ -- Convert a text buffer to a lower-case string.
+
+ --
+ -- To_Lower_Case_String --
+ --
+
+ function To_Lower_Case_String (Buff : Text_Buffer)
+return String
+ is
+ subtype One_Based is Text_Buffer (1 .. Buff'Length);
+ Result : String := String (One_Based (Buff));
+ begin
+ -- The System.Case_Util.To_Lower function (the overload
+ -- that takes a string parameter) cannot be called
+ -- here due to bootstrapping problems. That function
+ -- was added too recently.
+
+ System.Case_Util.To_Lower (Result);
+ return Result;
+ end To_Lower_Case_String;
+
+ pragma Assert (Source (Scan_Ptr) = '#');
+ Local_Scan_Ptr : Source_Ptr := Scan_Ptr + 1;
+
+ -- Start of processing for Matches_After_Skipping_White_Space
-if Special_Characters (Source (Scan_Ptr)) then
- Token_Ptr := Scan_Ptr;
- Token := Tok_Special;
- Special_Character := Source (Scan_Ptr);
- Scan_Ptr := Scan_Ptr + 1;
- return;
+ begin
+ while Local_Scan_Ptr in Source'Range
+and then Source (Local_Scan_Ptr) in ' ' | HT
+ loop
+ Local_Scan_Ptr := Local_Scan_Ptr + 1;
+ end loop;
--- Check for something looking like a preprocessor directive
+ return Local_Scan_Ptr in Source'Range
+and then Local_Scan_Ptr + (S'Length - 1) in Source'Range
+and then S = To_Lower_Case_String (
+ Source (Local_Scan_Ptr ..
+ Local_Scan_Ptr + (S'Length - 1)));
+ end Matches_After_Skipping_White_Space;
-elsif Source (Scan_Ptr) = '#'
- and then (Source (Scan_Ptr + 1 .. Scan_Ptr + 2) = "if"
- or else
-Source (Scan_Ptr + 1 .. Scan_Ptr + 5) = "elsif"
- or else
-Source (Scan_Ptr + 1 .. Scan_Ptr + 4) = "else"
- or else
-Source (Scan_Ptr + 1 .. Scan_Ptr + 3) = "end")
-then
- Error_Msg_S
- ("preprocessor directive ignored, preprocessor not active");
+begin
+ -- If Set_Special_Character has been called for this character,
+ -- set Scans.Special_Character and return a Special token.
- -- Skip to end of line
+ if Special_Characters (Source (Scan_Ptr)) then
+ Token_Ptr := Scan_Ptr;
+ Token :=
[COMMITTED 24/35] ada: Do not query the modification time of a special file.
From: Steve Baird In Ada.Directories, the function Modification_Time raises Name_Error if it is called for a special file. So don't do that in Start_Search_Internal. gcc/ada/ * libgnat/a-direct.adb (Start_Search_Internal): Do not call Modification_Time for a special file; declare a Calendar.Time constant No_Time and use that instead. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/a-direct.adb | 18 -- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/gcc/ada/libgnat/a-direct.adb b/gcc/ada/libgnat/a-direct.adb index 32e020c48c3..adff12277e8 100644 --- a/gcc/ada/libgnat/a-direct.adb +++ b/gcc/ada/libgnat/a-direct.adb @@ -29,7 +29,7 @@ -- -- -- -with Ada.Calendar; use Ada.Calendar; +with Ada.Calendar.Formatting;use Ada.Calendar; with Ada.Characters.Handling;use Ada.Characters.Handling; with Ada.Containers.Vectors; with Ada.Directories.Validity; use Ada.Directories.Validity; @@ -1392,6 +1392,17 @@ package body Ada.Directories is end record; Res : Result := (Found => False); + + -- This declaration of No_Time copied from GNAT.Calendar + -- because adding a "with GNAT.Calendar;" to this unit + -- results in problems. + + No_Time : constant Ada.Calendar.Time := +Ada.Calendar.Formatting.Time_Of + (Ada.Calendar.Year_Number'First, + Ada.Calendar.Month_Number'First, + Ada.Calendar.Day_Number'First, + Time_Zone => 0); begin -- Get the file attributes for the directory item @@ -1452,7 +1463,10 @@ package body Ada.Directories is Full_Name => To_Unbounded_String (Path), Attr_Error_Code => 0, Kind => Res.Kind, - Modification_Time => Modification_Time (Path), + Modification_Time => + (if Res.Kind = Special_File + then No_Time + else Modification_Time (Path)), Size => Res.Size)); end if; end if; -- 2.43.2
[COMMITTED 33/35] ada: Start the initialization of the tasking runtime earlier
From: Eric Botcazou
This installs the tasking versions of the RTS_Lock manipulation routines
very early, before the elaboration of all the Ada units of the program,
including those of the runtime, because this elaboration may require the
initialization of RTS_Lock objects.
gcc/ada/
* bindgen.adb (Gen_Adainit): Generate declaration and call to the
imported procedure __gnat_tasking_runtime_initialize if need be.
* libgnat/s-soflin.ads (Locking Soft-Links): Add commentary.
* libgnarl/s-tasini.adb (Tasking_Runtime_Initialize): New procedure
exported as __gnat_tasking_runtime_initialize. Initialize RTS_Lock
manipulation routines here instead of...
(Init_RTS): ...here.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/bindgen.adb | 18 --
gcc/ada/libgnarl/s-tasini.adb | 30 +-
gcc/ada/libgnat/s-soflin.ads | 4 +++-
3 files changed, 40 insertions(+), 12 deletions(-)
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb
index fc834e3a9b6..f15f96495df 100644
--- a/gcc/ada/bindgen.adb
+++ b/gcc/ada/bindgen.adb
@@ -819,8 +819,7 @@ package body Bindgen is
WBI (" pragma Import (C, XDR_Stream, ""__gl_xdr_stream"");");
end if;
- -- Import entry point for elaboration time signal handler
- -- installation, and indication of if it's been called previously.
+ -- Import entry point for initialization of the runtime
WBI ("");
WBI (" procedure Runtime_Initialize " &
@@ -828,6 +827,15 @@ package body Bindgen is
WBI (" pragma Import (C, Runtime_Initialize, " &
"""__gnat_runtime_initialize"");");
+ -- Import entry point for initialization of the tasking runtime
+
+ if With_GNARL then
+WBI ("");
+WBI (" procedure Tasking_Runtime_Initialize;");
+WBI (" pragma Import (C, Tasking_Runtime_Initialize, " &
+ """__gnat_tasking_runtime_initialize"");");
+ end if;
+
-- Import handlers attach procedure for sequential elaboration policy
if System_Interrupts_Used
@@ -1090,6 +1098,12 @@ package body Bindgen is
-- Generate call to Runtime_Initialize
WBI (" Runtime_Initialize (1);");
+
+ -- Generate call to Tasking_Runtime_Initialize
+
+ if With_GNARL then
+WBI (" Tasking_Runtime_Initialize;");
+ end if;
end if;
-- Generate call to set Initialize_Scalar values if active
diff --git a/gcc/ada/libgnarl/s-tasini.adb b/gcc/ada/libgnarl/s-tasini.adb
index 22294145bed..794183f5356 100644
--- a/gcc/ada/libgnarl/s-tasini.adb
+++ b/gcc/ada/libgnarl/s-tasini.adb
@@ -102,10 +102,6 @@ package body System.Tasking.Initialization is
procedure Release_RTS_Lock (Addr : Address);
-- Release the RTS lock at Addr
-
- -- Local Subprograms --
-
-
-- Tasking Initialization --
@@ -116,6 +112,15 @@ package body System.Tasking.Initialization is
-- of initializing global locks, and installing tasking versions of certain
-- operations used by the compiler. Init_RTS is called during elaboration.
+ procedure Tasking_Runtime_Initialize;
+ pragma Export (Ada, Tasking_Runtime_Initialize,
+ "__gnat_tasking_runtime_initialize");
+ -- This procedure starts the initialization of the GNARL. It installs the
+ -- tasking versions of the RTS_Lock manipulation routines. It is called
+ -- very early before the elaboration of all the Ada units of the program,
+ -- including those of the runtime, because this elaboration may require
+ -- the initialization of RTS_Lock objects.
+
--
-- Change_Base_Priority --
--
@@ -414,11 +419,6 @@ package body System.Tasking.Initialization is
SSL.Task_Name := Task_Name'Access;
SSL.Get_Current_Excep := Get_Current_Excep'Access;
- SSL.Initialize_RTS_Lock := Initialize_RTS_Lock'Access;
- SSL.Finalize_RTS_Lock := Finalize_RTS_Lock'Access;
- SSL.Acquire_RTS_Lock:= Acquire_RTS_Lock'Access;
- SSL.Release_RTS_Lock:= Release_RTS_Lock'Access;
-
-- Initialize the tasking soft links (if not done yet) that are common
-- to the full and the restricted run times.
@@ -430,6 +430,18 @@ package body System.Tasking.Initialization is
Undefer_Abort (Environment_Task);
end Init_RTS;
+
+ -- Tasking_Runtime_Initialize --
+
+
+ procedure Tasking_Runtime_Initialize is
+ begin
+ SSL.Initialize_RTS_Lock := Initialize_RTS_Lock'Access;
+ SSL.Finalize_RTS_Lock := Finalize_RTS_Lock'Access;
+ SSL.Acquire_RTS_Lock:=
[COMMITTED 26/35] ada: Factor out duplicated code in bodies of System.Task_Primitives.Operations
From: Eric Botcazou The duplication is present in some POSIX-like implementations (POSIX and RTEMS) while it has already been eliminated in others (Linux, QNX). The latter implementations are also slightly modified for consistency's sake. No functional changes. gcc/ada/ * libgnarl/s-taprop__dummy.adb (Initialize_Lock): Fix formatting. * libgnarl/s-taprop__linux.adb (RTS_Lock_Ptr): Delete. (Init_Mutex): Rename into... (Initialize_Lock): ...this. (Initialize_Lock [Lock]): Call above procedure. (Initialize_Lock [RTS_Lock]): Likewise. (Initialize_TCB): Likewise. * libgnarl/s-taprop__posix.adb (Initialize_Lock): New procedure factored out from the other two homonyms. (Initialize_Lock [Lock]): Call above procedure. (Initialize_Lock [RTS_Lock]): Likewise. * libgnarl/s-taprop__qnx.adb (RTS_Lock_Ptr): Delete. (Init_Mutex): Rename into... (Initialize_Lock): ...this. (Initialize_Lock [Lock]): Call above procedure. (Initialize_Lock [RTS_Lock]): Likewise. (Initialize_TCB): Likewise. * libgnarl/s-taprop__rtems.adb (Initialize_Lock): New procedure factored out from the other two homonyms. (Initialize_Lock [Lock]): Call above procedure. (Initialize_Lock [RTS_Lock]): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taprop__dummy.adb | 4 +- gcc/ada/libgnarl/s-taprop__linux.adb | 47 ++--- gcc/ada/libgnarl/s-taprop__posix.adb | 61 +--- gcc/ada/libgnarl/s-taprop__qnx.adb | 46 ++--- gcc/ada/libgnarl/s-taprop__rtems.adb | 61 +--- 5 files changed, 90 insertions(+), 129 deletions(-) diff --git a/gcc/ada/libgnarl/s-taprop__dummy.adb b/gcc/ada/libgnarl/s-taprop__dummy.adb index 90c4cd4cf72..829d595694c 100644 --- a/gcc/ada/libgnarl/s-taprop__dummy.adb +++ b/gcc/ada/libgnarl/s-taprop__dummy.adb @@ -239,7 +239,9 @@ package body System.Task_Primitives.Operations is end Initialize_Lock; procedure Initialize_Lock - (L : not null access RTS_Lock; Level : Lock_Level) is + (L : not null access RTS_Lock; + Level : Lock_Level) + is begin null; end Initialize_Lock; diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb b/gcc/ada/libgnarl/s-taprop__linux.adb index d6a29b5e158..74717cb2d2b 100644 --- a/gcc/ada/libgnarl/s-taprop__linux.adb +++ b/gcc/ada/libgnarl/s-taprop__linux.adb @@ -248,10 +248,10 @@ package body System.Task_Primitives.Operations is -- as in "sudo /sbin/setcap cap_sys_nice=ep exe_file". If it doesn't have -- permission, then a request for Ceiling_Locking is ignored. - type RTS_Lock_Ptr is not null access all RTS_Lock; - - function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int; - -- Initialize the mutex L. If Ceiling_Support is True, then set the ceiling + function Initialize_Lock + (L: not null access RTS_Lock; + Prio : Any_Priority) return C.int; + -- Initialize the lock L. If Ceiling_Support is True, then set the ceiling -- to Prio. Returns 0 for success, or ENOMEM for out-of-memory. --- @@ -340,11 +340,20 @@ package body System.Task_Primitives.Operations is function Self return Task_Id renames Specific.Self; - - -- Init_Mutex -- - + - + -- Initialize_Lock -- + - - function Init_Mutex (L : RTS_Lock_Ptr; Prio : Any_Priority) return C.int is + -- Note: mutexes and cond_variables needed per-task basis are initialized + -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such + -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any + -- status change of RTS. Therefore raising Storage_Error in the following + -- routines should be able to be handled safely. + + function Initialize_Lock + (L: not null access RTS_Lock; + Prio : Any_Priority) return C.int + is Mutex_Attr : aliased pthread_mutexattr_t; Result, Result_2 : C.int; @@ -377,17 +386,7 @@ package body System.Task_Primitives.Operations is Result_2 := pthread_mutexattr_destroy (Mutex_Attr'Access); pragma Assert (Result_2 = 0); return Result; -- of pthread_mutex_init, not pthread_mutexattr_destroy - end Init_Mutex; - - - - -- Initialize_Lock -- - - - - -- Note: mutexes and cond_variables needed per-task basis are initialized - -- in Initialize_TCB and the Storage_Error is handled. Other mutexes (such - -- as RTS_Lock, Memory_Lock...) used in RTS is initialized before any - -- status change of RTS. Therefore raising Storage_Error in the following - -- routines should be able to be handled safely. + end Initialize_Lock; procedure Initialize_Lock (Prio : Any_Priority; @@ -420,18 +419,19 @@
[COMMITTED 31/35] ada: Restore dependency on System.OS_Interface in System.Task_Primitives
From: Eric Botcazou The dependency is relied upon by the binder to drag the tasking runtime. gcc/ada/ * libgnarl/s-taspri__mingw.ads: Add clause for System.OS_Interface. (Private_Data): Change type of Thread component. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-taspri__mingw.ads | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/ada/libgnarl/s-taspri__mingw.ads b/gcc/ada/libgnarl/s-taspri__mingw.ads index a51f752d805..6eae97d4af6 100644 --- a/gcc/ada/libgnarl/s-taspri__mingw.ads +++ b/gcc/ada/libgnarl/s-taspri__mingw.ads @@ -31,6 +31,7 @@ -- This is a NT (native) version of this package +with System.OS_Interface; with System.OS_Locks; with System.Win32; @@ -87,7 +88,7 @@ private end record; type Private_Data is limited record - Thread : aliased Win32.HANDLE; + Thread : aliased System.OS_Interface.Thread_Id; pragma Atomic (Thread); -- Thread field may be updated by two different threads of control. -- (See, Enter_Task and Create_Task in s-taprop.adb). -- 2.43.2
[COMMITTED 30/35] ada: Further adjustments coming from aliasing considerations
From: Eric Botcazou They are needed on 32-bit platforms because of different calling conventions and again in the units implementing AltiVec and Streams support. gcc/ada/ * libgnat/g-alvevi.ads: Add pragma Universal_Aliasing for all the view types. * libgnat/s-stratt.ads: Likewise for Fat_Pointer type. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnat/g-alvevi.ads | 11 +++ gcc/ada/libgnat/s-stratt.ads | 3 +++ 2 files changed, 14 insertions(+) diff --git a/gcc/ada/libgnat/g-alvevi.ads b/gcc/ada/libgnat/g-alvevi.ads index b2beac7284c..b0f58790adf 100644 --- a/gcc/ada/libgnat/g-alvevi.ads +++ b/gcc/ada/libgnat/g-alvevi.ads @@ -58,6 +58,7 @@ package GNAT.Altivec.Vector_Views is type VUC_View is record Values : Varray_unsigned_char; end record; + pragma Universal_Aliasing (VUC_View); type Varray_signed_char is array (Vchar_Range) of signed_char; for Varray_signed_char'Alignment use VECTOR_ALIGNMENT; @@ -65,6 +66,7 @@ package GNAT.Altivec.Vector_Views is type VSC_View is record Values : Varray_signed_char; end record; + pragma Universal_Aliasing (VSC_View); type Varray_bool_char is array (Vchar_Range) of bool_char; for Varray_bool_char'Alignment use VECTOR_ALIGNMENT; @@ -72,6 +74,7 @@ package GNAT.Altivec.Vector_Views is type VBC_View is record Values : Varray_bool_char; end record; + pragma Universal_Aliasing (VBC_View); -- -- short components -- @@ -85,6 +88,7 @@ package GNAT.Altivec.Vector_Views is type VUS_View is record Values : Varray_unsigned_short; end record; + pragma Universal_Aliasing (VUS_View); type Varray_signed_short is array (Vshort_Range) of signed_short; for Varray_signed_short'Alignment use VECTOR_ALIGNMENT; @@ -92,6 +96,7 @@ package GNAT.Altivec.Vector_Views is type VSS_View is record Values : Varray_signed_short; end record; + pragma Universal_Aliasing (VSS_View); type Varray_bool_short is array (Vshort_Range) of bool_short; for Varray_bool_short'Alignment use VECTOR_ALIGNMENT; @@ -99,6 +104,7 @@ package GNAT.Altivec.Vector_Views is type VBS_View is record Values : Varray_bool_short; end record; + pragma Universal_Aliasing (VBS_View); -- int components -- @@ -112,6 +118,7 @@ package GNAT.Altivec.Vector_Views is type VUI_View is record Values : Varray_unsigned_int; end record; + pragma Universal_Aliasing (VUI_View); type Varray_signed_int is array (Vint_Range) of signed_int; for Varray_signed_int'Alignment use VECTOR_ALIGNMENT; @@ -119,6 +126,7 @@ package GNAT.Altivec.Vector_Views is type VSI_View is record Values : Varray_signed_int; end record; + pragma Universal_Aliasing (VSI_View); type Varray_bool_int is array (Vint_Range) of bool_int; for Varray_bool_int'Alignment use VECTOR_ALIGNMENT; @@ -126,6 +134,7 @@ package GNAT.Altivec.Vector_Views is type VBI_View is record Values : Varray_bool_int; end record; + pragma Universal_Aliasing (VBI_View); -- -- float components -- @@ -139,6 +148,7 @@ package GNAT.Altivec.Vector_Views is type VF_View is record Values : Varray_float; end record; + pragma Universal_Aliasing (VF_View); -- -- pixel components -- @@ -152,5 +162,6 @@ package GNAT.Altivec.Vector_Views is type VP_View is record Values : Varray_pixel; end record; + pragma Universal_Aliasing (VP_View); end GNAT.Altivec.Vector_Views; diff --git a/gcc/ada/libgnat/s-stratt.ads b/gcc/ada/libgnat/s-stratt.ads index 1d4c82d17ab..eee19f4bdce 100644 --- a/gcc/ada/libgnat/s-stratt.ads +++ b/gcc/ada/libgnat/s-stratt.ads @@ -74,6 +74,9 @@ package System.Stream_Attributes is P2 : System.Address; end record; + pragma Universal_Aliasing (Fat_Pointer); + -- This avoids a copy for the aforementioned unchecked conversions + -- Treatment of enumeration types -- -- 2.43.2
[COMMITTED 21/35] ada: Fix others error message location
From: Ronan Desplanques
Before this patch, the compiler pointed at the wrong component
association when reporting an illegal occurrence of "others" in an
aggregate. This patch fixes this by keeping track of which choice
contains the occurrence of "others" when resolving array aggregates.
gcc/ada/
* sem_aggr.adb (Resolve_Array_Aggregate): Fix location of error
message.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_aggr.adb | 43 +++
1 file changed, 19 insertions(+), 24 deletions(-)
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 64e7db79ecc..ee9beb04c9a 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1335,7 +1335,7 @@ package body Sem_Aggr is
Index_Base_High : constant Node_Id := Type_High_Bound (Index_Base);
-- Ditto for the base type
- Others_Present : Boolean := False;
+ Others_N : Node_Id := Empty;
Nb_Choices : Nat := 0;
-- Contains the overall number of named choices in this sub-aggregate
@@ -1870,7 +1870,7 @@ package body Sem_Aggr is
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
- Others_Present := True;
+ Others_N := Choice;
else
Analyze (Choice);
@@ -2189,7 +2189,7 @@ package body Sem_Aggr is
Delete_Choice := False;
while Present (Choice) loop
if Nkind (Choice) = N_Others_Choice then
- Others_Present := True;
+ Others_N := Choice;
if Choice /= First (Choice_List (Assoc))
or else Present (Next (Choice))
@@ -2289,7 +2289,7 @@ package body Sem_Aggr is
if Present (Expressions (N))
and then (Nb_Choices > 1
- or else (Nb_Choices = 1 and then not Others_Present))
+ or else (Nb_Choices = 1 and then No (Others_N)))
then
Error_Msg_N
("cannot mix named and positional associations in array aggregate",
@@ -2299,16 +2299,11 @@ package body Sem_Aggr is
-- Test for the validity of an others choice if present
- if Others_Present and then not Others_Allowed then
- declare
-Others_N : constant Node_Id :=
- First (Choice_List (First (Component_Associations (N;
- begin
-Error_Msg_N ("OTHERS choice not allowed here", Others_N);
-Error_Msg_N ("\qualify the aggregate with a constrained subtype "
- & "to provide bounds for it", Others_N);
-return Failure;
- end;
+ if Present (Others_N) and then not Others_Allowed then
+ Error_Msg_N ("OTHERS choice not allowed here", Others_N);
+ Error_Msg_N ("\qualify the aggregate with a constrained subtype "
+ & "to provide bounds for it", Others_N);
+ return Failure;
end if;
-- Protect against cascaded errors
@@ -2320,7 +2315,7 @@ package body Sem_Aggr is
-- STEP 2: Process named components
if No (Expressions (N)) then
- if Others_Present then
+ if Present (Others_N) then
Case_Table_Size := Nb_Choices - 1;
else
Case_Table_Size := Nb_Choices;
@@ -2709,7 +2704,7 @@ package body Sem_Aggr is
if Lo_Val <= Hi_Val
or else (Lo_Val > Hi_Val + 1
- and then not Others_Present)
+ and then No (Others_N))
then
Missing_Or_Duplicates := True;
exit;
@@ -2796,7 +2791,7 @@ package body Sem_Aggr is
-- Loop through entries in table to find missing indexes.
-- Not needed if others, since missing impossible.
- if not Others_Present then
+ if No (Others_N) then
for J in 2 .. Nb_Discrete_Choices loop
Lo_Val := Expr_Value (Table (J).Lo);
Hi_Val := Table (J - 1).Highest;
@@ -2862,7 +2857,7 @@ package body Sem_Aggr is
-- If Others is present, then bounds of aggregate come from the
-- index constraint (not the choices in the aggregate itself).
-if Others_Present then
+if Present (Others_N) then
Get_Index_Bounds (Index_Constr, Aggr_Low, Aggr_High);
-- Abandon processing if either bound is already signalled as
@@ -3043,7 +3038,7 @@ package body Sem_Aggr is
Next (Expr);
end loop;
- if Others_Present then
+ if Present (Others_N) then
Assoc := Last (Component_Associations (N));
-- Ada 2005 (AI-231)
@@ -3102,7 +3097,7 @@ package body Sem_Aggr is
-- STEP 3 (B):
[COMMITTED 35/35] ada: Improve deriving initial sizes for container aggregates
From: Viljar Indus Deriving the initial size of container aggregates is necessary for deriving the correct capacity for bounded containers. Add support for deriving the correct initial size when the container aggregate is iterating over an array object. gcc/ada/ * exp_aggr.adb (Expand_Container_Aggregate): Derive the size for iterable aggregates in the case of one-dimensional array objects. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_aggr.adb | 83 +--- 1 file changed, 55 insertions(+), 28 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 892f47ceb05..2476675604c 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6693,9 +6693,9 @@ package body Exp_Aggr is -- If one or more of the associations is one of the iterated -- forms, and is either an association with nonstatic bounds --- or is an iterator over an iterable object, then treat the --- whole container aggregate as having a nonstatic number of --- elements. +-- or is an iterator over an iterable object where the size +-- cannot be derived, then treat the whole container aggregate as +-- having a nonstatic number of elements. declare Has_Nonstatic_Length : Boolean := False; @@ -6725,37 +6725,43 @@ package body Exp_Aggr is Comp := First (Component_Associations (N)); while Present (Comp) loop - Choice := First (Choice_List (Comp)); + if Present (Choice_List (Comp)) then + Choice := First (Choice_List (Comp)); - while Present (Choice) loop - Analyze (Choice); + while Present (Choice) loop + Analyze (Choice); - if Nkind (Choice) = N_Range then - Lo := Low_Bound (Choice); - Hi := High_Bound (Choice); - Add_Range_Size; + if Nkind (Choice) = N_Range then +Lo := Low_Bound (Choice); +Hi := High_Bound (Choice); +Add_Range_Size; - elsif Is_Entity_Name (Choice) -and then Is_Type (Entity (Choice)) - then - Lo := Type_Low_Bound (Entity (Choice)); - Hi := Type_High_Bound (Entity (Choice)); - Add_Range_Size; + elsif Is_Entity_Name (Choice) + and then Is_Type (Entity (Choice)) + then +Lo := Type_Low_Bound (Entity (Choice)); +Hi := Type_High_Bound (Entity (Choice)); +Add_Range_Size; - Rewrite (Choice, - Make_Range (Loc, - New_Copy_Tree (Lo), - New_Copy_Tree (Hi))); +Rewrite (Choice, + Make_Range (Loc, +New_Copy_Tree (Lo), +New_Copy_Tree (Hi))); - else - -- Single choice (syntax excludes a subtype - -- indication). + else +-- Single choice (syntax excludes a subtype +-- indication). - Siz := Siz + 1; - end if; +Siz := Siz + 1; + end if; - Next (Choice); - end loop; + Next (Choice); + end loop; + + elsif Nkind (Comp) = N_Iterated_Component_Association then + + Siz := Siz + Build_Siz_Exp (Comp); + end if; Next (Comp); end loop; end if; @@ -6770,6 +6776,7 @@ package body Exp_Aggr is function Build_Siz_Exp (Comp : Node_Id) return Int is Lo, Hi : Node_Id; Temp_Siz_Exp : Node_Id; + It : Node_Id; begin if Nkind (Comp) = N_Range then @@ -6835,8 +6842,28 @@ package body Exp_Aggr is end if; elsif Nkind (Comp) = N_Iterated_Component_Association then -return Build_Siz_Exp (First (Discrete_Choices (Comp))); +if Present (Iterator_Specification (Comp)) then + + -- If the static size of the iterable object is known, + -- attempt to return it. + + It := Name (Iterator_Specification (Comp)); + Preanalyze (It); + -- Handle the simplest cases for now where It denotes a + -- top-level one-dimensional array objects". + + if Nkind (It) in N_Identifier + and then Ekind (Etype (It)) =
[COMMITTED 25/35] ada: Fix for validity checking and conditional evaluation of 'Old
From: Piotr Trojanek Detection of expression that are "known on entry" (as defined in Ada 2022 RM 6.1.1(20/5)) was confused by validity checks when used from within expansion of attribute 'Old. gcc/ada/ * sem_util.adb (Is_Known_On_Entry): Handle constants introduced by validity checks. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_util.adb | 8 1 file changed, 8 insertions(+) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index be777d26e46..d512d462b44 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -30791,6 +30791,14 @@ package body Sem_Util is return False; end if; + -- Handle constants introduced by side-effect + -- removal, e.g. by validity checks. + + if not Comes_From_Source (Obj) then + return +Is_Known_On_Entry (Expression (Parent (Obj))); + end if; + -- return False if not "all views are constant". if Is_Immutably_Limited_Type (Obj_Typ) or Needs_Finalization (Obj_Typ) -- 2.43.2
[COMMITTED 22/35] ada: Clarify code for aggregate warnings
From: Ronan Desplanques This patch improves comments in code that emits warnings about particular situations involving aggregates. It also removes a conjunct in a condition that's useless because always true in the context of the test. gcc/ada/ * sem_aggr.adb (Resolve_Array_Aggregate): Improve comments and condition. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aggr.adb | 52 +--- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index ee9beb04c9a..14c68b5eaf3 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2873,9 +2873,9 @@ package body Sem_Aggr is -- No others clause present else - -- Special processing if others allowed and not present. This - -- means that the bounds of the aggregate come from the index - -- constraint (and the length must match). + -- Special processing if others allowed and not present. In + -- this case, the bounds of the aggregate come from the + -- choices (RM 4.3.3 (27)). if Others_Allowed then Get_Index_Bounds (Index_Constr, Aggr_Low, Aggr_High); @@ -2890,30 +2890,28 @@ package body Sem_Aggr is return False; end if; - -- If others allowed, and no others present, then the array - -- should cover all index values. If it does not, we will - -- get a length check warning, but there is two cases where - -- an additional warning is useful: - - -- If we have no positional components, and the length is - -- wrong (which we can tell by others being allowed with - -- missing components), and the index type is an enumeration - -- type, then issue appropriate warnings about these missing - -- components. They are only warnings, since the aggregate - -- is fine, it's just the wrong length. We skip this check - -- for standard character types (since there are no literals - -- and it is too much trouble to concoct them), and also if - -- any of the bounds have values that are not known at - -- compile time. - - -- Another case warranting a warning is when the length - -- is right, but as above we have an index type that is - -- an enumeration, and the bounds do not match. This is a - -- case where dubious sliding is allowed and we generate a - -- warning that the bounds do not match. - - if No (Expressions (N)) -and then Nkind (Index) = N_Range + -- If there is an applicable index constraint and others is + -- not present, then sliding is allowed and only a length + -- check will be performed. However, additional warnings are + -- useful if the index type is an enumeration type, as + -- sliding is dubious in this case. We emit two kinds of + -- warnings: + -- + --1. If the length is wrong then there are missing + -- components; we issue appropriate warnings about + -- these missing components. They are only warnings, + -- since the aggregate is fine, it's just the wrong + -- length. We skip this check for standard character + -- types (since there are no literals and it is too + -- much trouble to concoct them), and also if any of + -- the bounds have values that are not known at compile + -- time. + -- + --2. If the length is right but the bounds do not match, + -- we issue a warning, as we consider sliding dubious + -- when the index type is an enumeration type. + + if Nkind (Index) = N_Range and then Is_Enumeration_Type (Etype (Index)) and then not Is_Standard_Character_Type (Etype (Index)) and then Compile_Time_Known_Value (Aggr_Low) -- 2.43.2
[COMMITTED 23/35] ada: Disable Equivalent_Array_Aggregate optimization if predicates involved
From: Steve Baird In most paths, the function Build_Equivalent_Record_Aggregate was already testing Has_Predicates for a given component type and conditionally returning an Empty result. This is also needed in the case of a scalar component type. Without it, we can build corrupt trees that fail use-before-definition detection checks in gigi. gcc/ada/ * exp_ch3.adb (Build_Equivalent_Record_Aggregate): Add Has_Predicates test for a scalar component to match what is already done for other kinds of components. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch3.adb | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 5764b22b800..f6314dff285 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1950,6 +1950,7 @@ package body Exp_Ch3 is or else not Compile_Time_Known_Value (Type_Low_Bound (Comp_Type)) or else not Compile_Time_Known_Value (Type_High_Bound (Comp_Type)) + or else Has_Predicates (Etype (Comp)) then Initialization_Warning (T); return Empty; -- 2.43.2
[COMMITTED 20/35] ada: Expose utility routine for processing of Depends contracts in SPARK
From: Piotr Trojanek Routine Is_Unconstrained_Or_Tagged_Item is now used both in the GNAT frontend (for checking legality of Depends clauses) and in the GNATprove backend (for representing implicit inputs in flow graphs). gcc/ada/ * sem_prag.adb (Is_Unconstrained_Or_Tagged_Item): Move to Sem_Util, so it can be used from GNATprove. * sem_util.ads (Is_Unconstrained_Or_Tagged_Item): Move from Sem_Prag; spec. * sem_util.adb (Is_Unconstrained_Or_Tagged_Item): Move from Sem_Prag; body. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_prag.adb | 29 - gcc/ada/sem_util.adb | 23 +++ gcc/ada/sem_util.ads | 5 + 3 files changed, 28 insertions(+), 29 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 02aad4d1caa..f27e40edcbb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -280,12 +280,6 @@ package body Sem_Prag is -- Determine whether dependency clause Clause is surrounded by extra -- parentheses. If this is the case, issue an error message. - function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean; - -- Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of - -- pragma Depends. Determine whether the type of dependency item Item is - -- tagged, unconstrained array, unconstrained private or unconstrained - -- record. - procedure Record_Possible_Body_Reference (State_Id : Entity_Id; Ref : Node_Id); @@ -32959,29 +32953,6 @@ package body Sem_Prag is and then List_Containing (N) = Private_Declarations (Parent (N)); end Is_Private_SPARK_Mode; - - - -- Is_Unconstrained_Or_Tagged_Item -- - - - - function Is_Unconstrained_Or_Tagged_Item - (Item : Entity_Id) return Boolean - is - Typ : constant Entity_Id := Etype (Item); - begin - if Is_Tagged_Type (Typ) then - return True; - - elsif Is_Array_Type (Typ) -or else Is_Record_Type (Typ) -or else Is_Private_Type (Typ) - then - return not Is_Constrained (Typ); - - else - return False; - end if; - end Is_Unconstrained_Or_Tagged_Item; - - -- Is_Valid_Assertion_Kind -- - diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index dd9f868b696..be777d26e46 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -20709,6 +20709,29 @@ package body Sem_Util is return T = Universal_Integer or else T = Universal_Real; end Is_Universal_Numeric_Type; + - + -- Is_Unconstrained_Or_Tagged_Item -- + - + + function Is_Unconstrained_Or_Tagged_Item + (Item : Entity_Id) return Boolean + is + Typ : constant Entity_Id := Etype (Item); + begin + if Is_Tagged_Type (Typ) then + return True; + + elsif Is_Array_Type (Typ) +or else Is_Record_Type (Typ) +or else Is_Private_Type (Typ) + then + return not Is_Constrained (Typ); + + else + return False; + end if; + end Is_Unconstrained_Or_Tagged_Item; + -- -- Is_User_Defined_Equality -- -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 99c60ddf708..4fef8966380 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -2397,6 +2397,11 @@ package Sem_Util is pragma Inline (Is_Universal_Numeric_Type); -- True if T is Universal_Integer or Universal_Real + function Is_Unconstrained_Or_Tagged_Item (Item : Entity_Id) return Boolean; + -- Subsidiary to Collect_Subprogram_Inputs_Outputs and the analysis of + -- pragma Depends. Determine whether the type of dependency item Item is + -- tagged, unconstrained array or unconstrained record. + function Is_User_Defined_Equality (Id : Entity_Id) return Boolean; -- Determine whether an entity denotes a user-defined equality -- 2.43.2
[COMMITTED 14/35] ada: gnatbind-related cleanups
From: Bob Duff This patch cleans up some things noticed while working on gnatbind. No change in behavior yet. gcc/ada/ * ali-util.adb (Read_Withed_ALIs): Minor reformatting. * bindo-units.adb (Corresponding_Body): Add assert. (Corresponding_Spec): Likewise. * uname.adb: Clean up assertions, use available functions. Get_Spec_Name/Get_Body_Name can assert that N obeys the conventions for Unit_Name_Type (end in "%s" or "%b"). Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ali-util.adb| 4 +-- gcc/ada/bindo-units.adb | 8 -- gcc/ada/uname.adb | 61 ++--- 3 files changed, 28 insertions(+), 45 deletions(-) diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index fe0af74086c..61dddb94e85 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -161,9 +161,7 @@ package body ALI.Util is -- Process all dependent units for U in ALIs.Table (Id).First_Unit .. ALIs.Table (Id).Last_Unit loop - for - W in Units.Table (U).First_With .. Units.Table (U).Last_With - loop + for W in Units.Table (U).First_With .. Units.Table (U).Last_With loop Afile := Withs.Table (W).Afile; -- Only process if not a generic (Afile /= No_File) and if diff --git a/gcc/ada/bindo-units.adb b/gcc/ada/bindo-units.adb index 0fbe8e9d381..0acc6612270 100644 --- a/gcc/ada/bindo-units.adb +++ b/gcc/ada/bindo-units.adb @@ -103,7 +103,9 @@ package body Bindo.Units is begin pragma Assert (U_Rec.Utype = Is_Spec); - return U_Id - 1; + return Result : constant Unit_Id := U_Id - 1 do + pragma Assert (ALI.Units.Table (Result).Utype = Is_Body); + end return; end Corresponding_Body; @@ -117,7 +119,9 @@ package body Bindo.Units is begin pragma Assert (U_Rec.Utype = Is_Body); - return U_Id + 1; + return Result : constant Unit_Id := U_Id + 1 do + pragma Assert (ALI.Units.Table (Result).Utype = Is_Spec); + end return; end Corresponding_Spec; diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index 08574784173..dbb08b88cfd 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -50,14 +50,8 @@ package body Uname is Buffer : Bounded_String; begin Append (Buffer, N); - - pragma Assert -(Buffer.Length > 2 - and then Buffer.Chars (Buffer.Length - 1) = '%' - and then Buffer.Chars (Buffer.Length) = 's'); - + pragma Assert (Is_Spec_Name (N)); Buffer.Chars (Buffer.Length) := 'b'; - return Name_Find (Buffer); end Get_Body_Name; @@ -160,14 +154,8 @@ package body Uname is Buffer : Bounded_String; begin Append (Buffer, N); - - pragma Assert -(Buffer.Length > 2 - and then Buffer.Chars (Buffer.Length - 1) = '%' - and then Buffer.Chars (Buffer.Length) = 'b'); - + pragma Assert (Is_Body_Name (N)); Buffer.Chars (Buffer.Length) := 's'; - return Name_Find (Buffer); end Get_Spec_Name; @@ -416,6 +404,9 @@ package body Uname is Suffix : Boolean := True) is begin + pragma Assert (Buf.Chars (1) /= '"'); + pragma Assert (Is_Body_Name (N) or else Is_Spec_Name (N)); + Buf.Length := 0; Append_Decoded (Buf, N); @@ -424,17 +415,11 @@ package body Uname is -- (lower case) 's'/'b', and before appending (lower case) "spec" or -- "body". - pragma Assert (Buf.Length >= 3); - pragma Assert (Buf.Chars (1) /= '"'); - pragma Assert (Buf.Chars (Buf.Length) in 's' | 'b'); - declare S : constant String := (if Buf.Chars (Buf.Length) = 's' then " (spec)" else " (body)"); begin - Buf.Length := Buf.Length - 1; -- remove 's' or 'b' - pragma Assert (Buf.Chars (Buf.Length) = '%'); - Buf.Length := Buf.Length - 1; -- remove '%' + Buf.Length := Buf.Length - 2; -- remove "%s" or "%b" Set_Casing (Buf, Identifier_Casing (Source_Index (Main_Unit))); if Suffix then @@ -474,9 +459,9 @@ package body Uname is Buffer : Bounded_String; begin Append (Buffer, N); - return Buffer.Length > 2 -and then Buffer.Chars (Buffer.Length - 1) = '%' -and then Buffer.Chars (Buffer.Length) = 'b'; + pragma Assert +(Buffer.Length > 2 and then Buffer.Chars (Buffer.Length - 1) = '%'); + return Buffer.Chars (Buffer.Length) = 'b'; end Is_Body_Name; --- @@ -535,10 +520,7 @@ package body Uname is System : constant String := "system"; begin - if Name = Ada -or else Name = Interfaces -or else Name = System - then + if Name in Ada | Interfaces | System then return True; end if; @@ -555,15 +537,14 @@ package body Uname is -- The following are
[COMMITTED 18/35] ada: gnatbind: subprogram spec no longer exists
From: Bob Duff If a subprogram spec S is present while compiling something that says "with S;", but the spec is absent while compiling the body of S, then gnatbind fails to detect the mismatch. The spec and body of S might have different parameter and result types. This patch fixes gnatbind to detect this case and give an error. gcc/ada/ * bcheck.adb (Check_Consistency_Of_Sdep): Split out new procedure. Add check for special case of subprogram spec that no longer exists. (Check_Consistency): Call Check_Consistency_Of_Sdep, except when Reified_Child_Spec is True. No need for "goto Continue" or "exit Sdep_Loop". * ali.ads (Subunit_Name, Unit_Name): Change the type to Unit_Name_Type. Add a comment pointing to the ALI file documentation, because it's in a somewhat-surprising place. * ali.adb (Scan_ALI): Subunit_Name and Unit_Name are now Unit_Name_Type. Remove comment explaining why Name_Find is used; Name_Find is the usual case. Do not remove the "%s" or "%b" from the Unit_Name. We need to be able to distinguish specs and bodies. This is also necessary to obey the invariant of Unit_Name_Type. * binde.adb (Write_Closure): Subunit_Name is now Unit_Name_Type. * clean.adb (Clean_Executables): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ali.adb| 9 +- gcc/ada/ali.ads| 10 +-- gcc/ada/bcheck.adb | 216 +++-- gcc/ada/binde.adb | 2 +- gcc/ada/clean.adb | 2 +- 5 files changed, 141 insertions(+), 98 deletions(-) diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 6bf48c04afe..69a91bce5ab 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -3287,8 +3287,8 @@ package body ALI is -- Acquire (sub)unit and reference file name entries -Sdep.Table (Sdep.Last).Subunit_Name := No_Name; -Sdep.Table (Sdep.Last).Unit_Name:= No_Name; +Sdep.Table (Sdep.Last).Subunit_Name := No_Unit_Name; +Sdep.Table (Sdep.Last).Unit_Name:= No_Unit_Name; Sdep.Table (Sdep.Last).Rfile:= Sdep.Table (Sdep.Last).Sfile; Sdep.Table (Sdep.Last).Start_Line := 1; @@ -3304,16 +3304,13 @@ package body ALI is Add_Char_To_Name_Buffer (Getc); end loop; - -- Set the (sub)unit name. Note that we use Name_Find rather - -- than Name_Enter here as the subunit name may already - -- have been put in the name table by the Project Manager. + -- Set the (sub)unit name. if Name_Len <= 2 or else Name_Buffer (Name_Len - 1) /= '%' then Sdep.Table (Sdep.Last).Subunit_Name := Name_Find; else - Name_Len := Name_Len - 2; Sdep.Table (Sdep.Last).Unit_Name := Name_Find; end if; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 67b8fcd1b80..1f452268681 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -25,7 +25,7 @@ -- This package defines the internal data structures used for representation -- of Ada Library Information (ALI) acquired from the ALI files generated by --- the front end. +-- the front end. The format of the ALI files is documented in Lib.Writ. with Casing; use Casing; with Gnatvsn; use Gnatvsn; @@ -882,11 +882,11 @@ package ALI is -- Set True for dummy entries that correspond to missing files or files -- where no dependency relationship exists. - Subunit_Name : Name_Id; - -- Name_Id for subunit name if present, else No_Name + Subunit_Name : Unit_Name_Type; + -- Subunit name if present, else No_Unit_Name - Unit_Name : Name_Id; - -- Name_Id for the unit name if not a subunit (No_Name for a subunit) + Unit_Name : Unit_Name_Type; + -- Unit name if not a subunit (No_Unit_Name for a subunit) Rfile : File_Name_Type; -- Reference file name. Same as Sfile unless a Source_Reference pragma diff --git a/gcc/ada/bcheck.adb b/gcc/ada/bcheck.adb index dd2ece80d01..56a417cc517 100644 --- a/gcc/ada/bcheck.adb +++ b/gcc/ada/bcheck.adb @@ -36,6 +36,7 @@ with Osint; with Output; use Output; with Rident; use Rident; with Types;use Types; +with Uname; package body Bcheck is @@ -68,6 +69,12 @@ package body Bcheck is -- Used to compare two unit names for No_Dependence checks. U1 is in -- standard unit name format, and U2 is in literal form with periods. + procedure Check_Consistency_Of_Sdep + (A : ALIs_Record; D : Sdep_Record; Src : Source_Record); + -- Called by Check_Consistency to check the consistency of one Sdep record, + -- where A is the ALI, and D represents the unit it depends on, and Src is + -- the source file
[COMMITTED 12/35] ada: Fix crash caused by missing New_Copy_tree
Since a recent refactor ("Factor common processing in expansion of
aggregates") where Initialize_Array_Component and
Initialize_Record_Component are merged, the behavior has slightly
changed. In the case of the expansion of an aggregate initialization
where the number of 'others' components is <= 3, the initialization
expression is not duplicated anymore, causing some incorrect multiple
definition when said expression is later transformed with
Expressions_With_Action that declares an object. The simple fix is to
add the now missing New_Copy_Tree where the assignments are created.
gcc/ada/
* exp_aggr.adb (Build_Array_Aggr_Code) : Copy the
initialization expression when unrolling the loop.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 9 ++---
1 file changed, 6 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index cff04fc1b79..9c5944a917d 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1649,11 +1649,14 @@ package body Exp_Aggr is
and then Local_Expr_Value (H) - Local_Expr_Value (L) <= 2
and then not Is_Iterated_Component
then
-Append_List_To (S, Gen_Assign (New_Copy_Tree (L), Expr));
-Append_List_To (S, Gen_Assign (Add (1, To => L), Expr));
+Append_List_To
+ (S, Gen_Assign (New_Copy_Tree (L), New_Copy_Tree (Expr)));
+Append_List_To
+ (S, Gen_Assign (Add (1, To => L), New_Copy_Tree (Expr)));
if Local_Expr_Value (H) - Local_Expr_Value (L) = 2 then
- Append_List_To (S, Gen_Assign (Add (2, To => L), Expr));
+ Append_List_To
+ (S, Gen_Assign (Add (2, To => L), New_Copy_Tree (Expr)));
end if;
return S;
--
2.43.2
[COMMITTED 15/35] ada: correction to gnatbind-related cleanups
From: Bob Duff Correction to previous change; Asserts had been moved to before Buf was initialized. gcc/ada/ * uname.adb (Get_Unit_Name_String): Move Asserts after Buf is initialized. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/uname.adb | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/gcc/ada/uname.adb b/gcc/ada/uname.adb index dbb08b88cfd..5a7dac53b3d 100644 --- a/gcc/ada/uname.adb +++ b/gcc/ada/uname.adb @@ -404,11 +404,10 @@ package body Uname is Suffix : Boolean := True) is begin - pragma Assert (Buf.Chars (1) /= '"'); - pragma Assert (Is_Body_Name (N) or else Is_Spec_Name (N)); - Buf.Length := 0; Append_Decoded (Buf, N); + pragma Assert (Buf.Chars (1) /= '"'); + pragma Assert (Is_Body_Name (N) or else Is_Spec_Name (N)); -- Buf always ends with "%s" or "%b", which we either remove, or replace -- with " (spec)" or " (body)". Set_Casing of Buf after checking for -- 2.43.2
[COMMITTED 29/35] ada: Replace spinlocks with fully-fledged locks in finalization collections
From: Eric Botcazou This replaces spinlocks with fully-fledged locks in finalization collections because the former are deemed problematic with tasks that can be preempted. Because of the requirement to avoid dragging the tasking runtime when it is not necessary, the implementation goes through the usual soft links, with an additional hurdle that space must be reserved for the lock in any case since it is part of the ABI. This entails the introduction of the System.OS_Locks unit in the non-tasking runtime and the modification of the tasking runtime to also use this unit. This in turn requires a small adjustment: because of the presence of pre- and post-conditions in Interfaces.C and of the limitations of the RTSfind mechanism, the System.Finalization_Primitives unit must be preloaded, as what is done for the Ada.Strings.Text_Buffers unit. This effectively reverts the implementation to using the global task lock on bare board platforms. gcc/ada/ * Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-oslock$(objext). (LIBGNAT_TARGET_PAIRS): Use s-oslock__dummy.ads by default. Set specific s-oslock.ads source file for all the platforms. * exp_ch7.ads (Preload_Finalization_Collection): New procedure. * exp_ch7.adb (Allows_Finalization_Collection): Return False if System.Finalization_Primitives has not been preloaded. (Preload_Finalization_Collection): New procedure. * opt.ads (Interface_Seen): New boolean variable. * s-oscons-tmplt.c: Use "N" string for pragma Style_Checks. * scng.adb (Scan): Set Interface_Seen upon seeing "interface". * sem_ch10.adb: Add clause for Exp_Ch7. (Analyze_Compilation_Unit): Call Preload_Finalization_Collection after the context of the unit is analyzed. * libgnarl/a-rttiev.adb: Add with clause for System.OS_Locks and alphabetize others. (Event_Queue_Lock): Adjust qualified name of subtype. * libgnarl/s-osinte__aix.ads: Add with clause for System.OS_Locks and change pthread_mutex_t into a local subtype. * libgnarl/s-osinte__android.ads: Likewise. * libgnarl/s-osinte__darwin.ads: Likewise. * libgnarl/s-osinte__dragonfly.ads: Likewise. * libgnarl/s-osinte__freebsd.ads: Likewise. * libgnarl/s-osinte__gnu.ads: Likewise. * libgnarl/s-osinte__hpux-dce.ads: Likewise. * libgnarl/s-osinte__hpux.ads: Add Likewise. * libgnarl/s-osinte__kfreebsd-gnu.ads: Likewise. * libgnarl/s-osinte__linux.ads: Likewise. * libgnarl/s-osinte__lynxos178e.ads: Likewise. * libgnarl/s-osinte__qnx.ads: Likewise. * libgnarl/s-osinte__rtems.ads: Likewise. * libgnarl/s-osinte__mingw.ads: Add with clause for System.OS_Locks and change CRITICAL_SECTION into a local subtype. Add declarations for imported procedures dealing with CRITICAL_SECTION. * libgnarl/s-osinte__solaris.ads: Add with clause for System.OS_Locks and change mutex_t into a local subtype. * libgnarl/s-osinte__vxworks.ads: Add missing blank line. * libgnarl/s-taprop.ads: Alphabetize clauses and package renamings. Use qualified name for RTS_Lock throughout. * libgnarl/s-taprop__dummy.adb: Add use clause for System.OS_Locks and alphabetize others. * libgnarl/s-taprop__hpux-dce.adb: Likewise. * libgnarl/s-taprop__linux.adb: Likewise. * libgnarl/s-taprop__posix.adb: Likewise. * libgnarl/s-taprop__qnx.adb: Likewise. * libgnarl/s-taprop__rtems.adb: Likewise. * libgnarl/s-taprop__solaris.adb: Likewise. * libgnarl/s-taprop__vxworks.adb: Likewise. * libgnarl/s-taprop__mingw.adb: Likewise. Remove declarations for imported procedures dealing with CRITICAL_SECTION. * libgnarl/s-tarest.adb: Add with clause for System.OS_Locks and alphabetize others. (Global_Task_Lock): Adjust qualified name of subtype. * libgnarl/s-tasini.adb: Add clause for System.OS_Locks. (Initialize_RTS_Lock): New procedure. (Finalize_RTS_Lock): Likewise. (Acquire_RTS_Lock): Likewise. (Release_RTS_Lock): Likewise. (Init_RTS): Add compile-time assertions for RTS_Lock types. Set the soft links for the RTS lock manipulation routines. * libgnarl/s-taspri__dummy.ads: Add with clause for System.OS_Locks. (RTS_Lock): Delete and adjust throughout accordingly. * libgnarl/s-taspri__hpux-dce.ads: Likewise. * libgnarl/s-taspri__lynxos.ads: Likewise. * libgnarl/s-taspri__mingw.ads: Likewise. * libgnarl/s-taspri__posix-noaltstack.ads: Likewise. * libgnarl/s-taspri__posix.ads: Likewise. * libgnarl/s-taspri__solaris.ads: Likewise. * libgnarl/s-taspri__vxworks.ads: Likewise. * libgnat/s-finpri.ads: Add clause for System.OS_Locks. (Finalization_Collection): Change
