From 59f4d03898e13da463a202919875dfa3fac43456 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Thu, 17 Jul 2014 06:31:56 +0000 Subject: [PATCH] back_end.adb: Minor reformatting and comment additions. 2014-07-17 Robert Dewar * back_end.adb: Minor reformatting and comment additions. * checks.ads, checks.adb (Duplicated_Tag_Checks_Suppressed): New function. * exp_disp.adb (Make_DT): Use Duplicated_Tag_Checks_Suppressed. (Make_VM_TSD): Use Duplicated_Tag_Checks_Suppressed. * gnat_rm.texi: Document new check Duplicated_Tag_Checks_Suppressed. * gnat_ugn.texi: Additional documentation for Duplicated_Tag_Check. * snames.ads-tmpl (Duplicated_Tag_Checks_Suppressed): New check. * types.ads (Duplicated_Tag_Checks_Suppressed): New check. From-SVN: r212724 --- gcc/ada/ChangeLog | 12 ++++++++++++ gcc/ada/back_end.adb | 38 +++++++++++++++++++++----------------- gcc/ada/checks.adb | 35 ++++++++++++++++++++++++++++++++--- gcc/ada/checks.ads | 1 + gcc/ada/exp_disp.adb | 2 ++ gcc/ada/gnat_rm.texi | 20 +++++++++++++++++++- gcc/ada/gnat_ugn.texi | 14 ++++++++++---- gcc/ada/snames.ads-tmpl | 1 + gcc/ada/types.ads | 21 +++++++++++---------- 9 files changed, 109 insertions(+), 35 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 249ab16da7b..816b596c61f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2014-07-17 Robert Dewar + + * back_end.adb: Minor reformatting and comment additions. + * checks.ads, checks.adb (Duplicated_Tag_Checks_Suppressed): New + function. + * exp_disp.adb (Make_DT): Use Duplicated_Tag_Checks_Suppressed. + (Make_VM_TSD): Use Duplicated_Tag_Checks_Suppressed. + * gnat_rm.texi: Document new check Duplicated_Tag_Checks_Suppressed. + * gnat_ugn.texi: Additional documentation for Duplicated_Tag_Check. + * snames.ads-tmpl (Duplicated_Tag_Checks_Suppressed): New check. + * types.ads (Duplicated_Tag_Checks_Suppressed): New check. + 2014-07-17 Robert Dewar * gnat_rm.texi: Minor comment updates. diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb index b79f1f9072a..1d5de114e24 100644 --- a/gcc/ada/back_end.adb +++ b/gcc/ada/back_end.adb @@ -23,23 +23,23 @@ -- -- ------------------------------------------------------------------------------ -with Atree; use Atree; -with Debug; use Debug; -with Elists; use Elists; -with Errout; use Errout; -with Lib; use Lib; -with Osint; use Osint; -with Opt; use Opt; -with Osint.C; use Osint.C; -with Namet; use Namet; -with Nlists; use Nlists; -with Stand; use Stand; -with Sinput; use Sinput; -with Stringt; use Stringt; -with Switch; use Switch; -with Switch.C; use Switch.C; -with System; use System; -with Types; use Types; +with Atree; use Atree; +with Debug; use Debug; +with Elists; use Elists; +with Errout; use Errout; +with Lib; use Lib; +with Osint; use Osint; +with Opt; use Opt; +with Osint.C; use Osint.C; +with Namet; use Namet; +with Nlists; use Nlists; +with Stand; use Stand; +with Sinput; use Sinput; +with Stringt; use Stringt; +with Switch; use Switch; +with Switch.C; use Switch.C; +with System; use System; +with Types; use Types; with System.OS_Lib; use System.OS_Lib; @@ -126,6 +126,8 @@ package body Back_End is Nat (Physical_To_Logical (Last_Source_Line (J), J)); end loop; + -- Deal with case of generating SCIL, we should not be here! + if Generate_SCIL then Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit)); @@ -137,6 +139,8 @@ package body Back_End is end if; end if; + -- The actual call to the back end + gigi (gnat_root => Int (Cunit (Main_Unit)), max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index ea1f1647aca..81bbc67a512 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -423,6 +423,11 @@ package body Checks is -- Allocation_Checks_Suppressed -- ---------------------------------- + -- Note: at the current time there are no calls to this function, because + -- the relevant check is in the run-time, so it is not a check that the + -- compiler can suppress anyway, but we still have to recognize the check + -- name Allocation_Check since it is part of the standard. + function Allocation_Checks_Suppressed (E : Entity_Id) return Boolean is begin if Present (E) and then Checks_May_Be_Suppressed (E) then @@ -4616,6 +4621,19 @@ package body Checks is end if; end Division_Checks_Suppressed; + -------------------------------------- + -- Duplicated_Tag_Checks_Suppressed -- + -------------------------------------- + + function Duplicated_Tag_Checks_Suppressed (E : Entity_Id) return Boolean is + begin + if Present (E) and then Checks_May_Be_Suppressed (E) then + return Is_Check_Suppressed (E, Duplicated_Tag_Check); + else + return Scope_Suppress.Suppress (Duplicated_Tag_Check); + end if; + end Duplicated_Tag_Checks_Suppressed; + ----------------------------------- -- Elaboration_Checks_Suppressed -- ----------------------------------- @@ -6478,15 +6496,24 @@ package body Checks is -- Force evaluation to avoid multiple reads for atomic/volatile + -- Note: we set Name_Req to False. We used to set it to True, with + -- the thinking that a name is required as the prefix of the 'Valid + -- call, but in fact the check that the prefix of an attribute is + -- a name is in the parser, and we just don't require it here. + -- Moreover, when we set Name_Req to True, that interfered with the + -- checking for Volatile, since we couldn't just capture the value. + if Is_Entity_Name (Exp) and then Is_Volatile (Entity (Exp)) then - Force_Evaluation (Exp, Name_Req => True); + -- Same reasoning as above for setting Name_Req to False + + Force_Evaluation (Exp, Name_Req => False); end if; -- Build the prefix for the 'Valid call - PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => True); + PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => False); -- A rather specialized kludge. If PV is an analyzed expression -- which is an indexed component of a packed array that has not @@ -6504,7 +6531,9 @@ package body Checks is Set_Analyzed (PV, False); end if; - -- Build the raise CE node to check for validity + -- Build the raise CE node to check for validity. We build a type + -- qualification for the prefix, since it may not be of the form of + -- a name, and we don't care in this context! CE := Make_Raise_Constraint_Error (Loc, diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index f825e5e22a4..e1b538d9712 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -54,6 +54,7 @@ package Checks is function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean; function Discriminant_Checks_Suppressed (E : Entity_Id) return Boolean; function Division_Checks_Suppressed (E : Entity_Id) return Boolean; + function Duplicated_Tag_Checks_Suppressed (E : Entity_Id) return Boolean; function Elaboration_Checks_Suppressed (E : Entity_Id) return Boolean; function Index_Checks_Suppressed (E : Entity_Id) return Boolean; function Length_Checks_Suppressed (E : Entity_Id) return Boolean; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 8b4977b27eb..0cf6eb63256 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -6227,6 +6227,7 @@ package body Exp_Disp is and then Ada_Version >= Ada_2005 and then RTE_Available (RE_Check_TSD) and then not Debug_Flag_QQ + and then not Duplicated_Tag_Checks_Suppressed (Typ) then Append_To (Elab_Code, Make_Procedure_Call_Statement (Loc, @@ -6815,6 +6816,7 @@ package body Exp_Disp is and then Is_Library_Level_Entity (Typ) and then RTE_Available (RE_Check_TSD) and then not Debug_Flag_QQ + and then not Duplicated_Tag_Checks_Suppressed (Typ) then Append_To (Result, Make_Procedure_Call_Statement (Loc, diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 2705d786a7f..b82931fbbc3 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -6828,6 +6828,16 @@ on addresses used in address clauses. Such checks can also be suppressed by suppressing range checks, but the specific use of @code{Alignment_Check} allows suppression of alignment checks without suppressing other range checks. +@item +@code{Atomic_Synchronization} can be used to suppress the special memory +synchronization instructions that are normally generated for access to +@code{Atomic} variables to ensure correct synchronization between tasks +that use such variables for synchronization purposes. + +@item +@code{Duplicated_Tag_Check} Can be used to suppress the check that is generated +for a duplicated tag value when a tagged type is declared. + @item @code{Predicate_Check} can be used to control whether predicate checks are active. It is applicable only to predicates for which the policy is @@ -7458,8 +7468,16 @@ in pragma @code{Suppress}. One important application is to ensure that checks are on in cases where code depends on the checks for its correct functioning, so that the code will compile correctly even if the compiler switches are set to suppress -checks. +checks. For example, in a program that depends on external names of tagged +types and wants to ensure that the duplicated tag check occurs even if all +run-time checks are suppressed by a compiler switch, the following +configuration pragma will ensure this test is not suppressed: +@smallexample @c ada +pragma Unsuppress (Duplicated_Tag_Check); +@end smallexample + +@noindent This pragma is standard in Ada 2005. It is available in all earlier versions of Ada as an implementation-defined pragma. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d635400eef4..08d4e086b0d 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -6819,15 +6819,21 @@ unpredictable. The program might crash, or print wrong answers, or do anything else. It might even do exactly what you wanted it to do (and then it might start failing mysteriously next week or next year). The compiler will generate code based on the assumption that -the condition being checked is true, which can result in disaster if -that assumption is wrong. +the condition being checked is true, which can result in erroneous +execution if that assumption is wrong. The checks subject to suppression include all the checks defined by the Ada standard, the additional implementation defined checks -@code{Alignment_Check}, @code{Atomic_Synchronization}, +@code{Alignment_Check}, @code{Duplicated_Tag_Check}, @code{Predicate_Check}, and @code{Validity_Check}, as well as any checks introduced using -@code{pragma Check_Name}. +@code{pragma Check_Name}. Note that code{Atomic_Synchronization} +is not automatically suppressed by use of this option. + +If the code depends on certain checks being active, you can use +pragma @code{Unsuppress} either as a configuration pragma or as +a local pragma to make sure that a specified check is performed +even if @option{gnatp} is specified. The @option{-gnatp} switch has no effect if a subsequent @option{-gnat-p} switch appears. diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 0ea1beb43cb..ed9e75ed45d 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1100,6 +1100,7 @@ package Snames is Name_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT Name_Discriminant_Check : constant Name_Id := N + $; Name_Division_Check : constant Name_Id := N + $; + Name_Duplicated_Tag_Check : constant Name_Id := N + $; -- GNAT Name_Elaboration_Check : constant Name_Id := N + $; Name_Index_Check : constant Name_Id := N + $; Name_Length_Check : constant Name_Id := N + $; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 76e95d67092..46fb714ee57 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -669,20 +669,21 @@ package Types is Atomic_Synchronization : constant := 5; Discriminant_Check : constant := 6; Division_Check : constant := 7; - Elaboration_Check : constant := 8; - Index_Check : constant := 9; - Length_Check : constant := 10; - Overflow_Check : constant := 11; - Predicate_Check : constant := 12; - Range_Check : constant := 13; - Storage_Check : constant := 14; - Tag_Check : constant := 15; - Validity_Check : constant := 16; + Duplicated_Tag_Check : constant := 8; + Elaboration_Check : constant := 9; + Index_Check : constant := 10; + Length_Check : constant := 11; + Overflow_Check : constant := 12; + Predicate_Check : constant := 13; + Range_Check : constant := 14; + Storage_Check : constant := 15; + Tag_Check : constant := 16; + Validity_Check : constant := 17; -- Values used to represent individual predefined checks (including the -- setting of Atomic_Synchronization, which is implemented internally using -- a "check" whose name is Atomic_Synchronization). - All_Checks : constant := 17; + All_Checks : constant := 18; -- Value used to represent All_Checks value subtype Predefined_Check_Id is Check_Id range 1 .. All_Checks;