From patchwork Wed Sep 6 09:45:31 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810470 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461566-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="ul/tHLER"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xnJcJ0zX2z9s8J for ; Wed, 6 Sep 2017 19:45:50 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=MRXqnYHiB39mmDLv+590sqtJfcV/yJyXei0gIM9XZW8h9A6Nih F8r+NzJGNDU95MeWRSRJ5nocNVcBdTq+ULjNoLQKt1g212JUvryoAWVoCPuteDGn Ppi+nEVikk5mpEGJaVXR5CipHYI+dW2KmeuLrStRizxO+owMYF0etJrlE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=8XCtJUH4UWYZkAyOYFMFhzScwRU=; b=ul/tHLER7+PXaaUfPAE7 /TLknYrVX5cf0NNubM9Ze2mzaFRRn9DHCmG5YyQf+1lyWXBlucJY27HGHlky/EoY bh08vxt/y4eP120wTVEb2MTukhe/F9c/PwB62UgvnqyE4W/d22DqV0bJDUxT/sr6 7zrvXi6m1N1C1JqlqjGkOAw= Received: (qmail 56664 invoked by alias); 6 Sep 2017 09:45:39 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 56647 invoked by uid 89); 6 Sep 2017 09:45:38 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-8.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, LIKELY_SPAM_BODY, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=dw, du, dx, d.u X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 06 Sep 2017 09:45:33 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 24E385614B; Wed, 6 Sep 2017 05:45:32 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id ClhgVX9UkSm8; Wed, 6 Sep 2017 05:45:32 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 03DA65606C; Wed, 6 Sep 2017 05:45:32 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id F33094FC; Wed, 6 Sep 2017 05:45:31 -0400 (EDT) Date: Wed, 6 Sep 2017 05:45:31 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Enable automatic reordering of components in record types Message-ID: <20170906094531.GA96532@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This activates the reordering of components in record types with convention Ada that was implemented some time ago in the compiler. The idea is to get rid of blatant inefficiencies that the layout in textual order of the source code can bring about, typically when the offset of components is not fixed or not a multiple of the storage unit. The reordering is automatic and silent by default, but both aspects can be toggled: pragma No_Component_Reordering disables it either on a per-record- type or on a global basis, while -gnatw.q gives a warning for each affected component in record types. When pragma No_Component_Reordering is used as a configuration pragma to disable it, there is a requirement that the pragma be used consistently within a partition. The typical example is a discriminated record type with an array component, which yields with -gnatw.q -gnatl: 1. package P is 2. 3. type R (D : Positive) is record 4. S : String (1 .. D); | >>> warning: record layout may cause performance issues >>> warning: component "S" whose length depends on a discriminant >>> warning: comes too early and was moved down 5. I : Integer; 6. end record; 7. 8. end P; In this case, the compiler moves component S to the last position in the record so that every component is at a fixed offset from the start. Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Eric Botcazou * ali.ads (ALIs_Record): Add No_Component_Reordering component. (No_Component_Reordering_Specified): New switch. * ali.adb (Initialize_ALI): Set No_Component_Reordering_Specified. (Scan_ALI): Set No_Component_Reordering and deal with NC marker. * bcheck.adb (Check_Consistent_No_Component_Reordering): New check. (Check_Configuration_Consistency): Invoke it. * debug.adb (d.r): Toggle the effect of the switch. (d.v): Change to no-op. * einfo.ads (Has_Complex_Representation): Restrict to record types. (No_Reordering): New alias for Flag239. (OK_To_Reorder_Components): Delete. (No_Reordering): Declare. (Set_No_Reordering): Likewise. (OK_To_Reorder_Components): Delete. (Set_OK_To_Reorder_Components): Likewise. * einfo.adb (Has_Complex_Representation): Expect record types. (No_Reordering): New function. (OK_To_Reorder_Components): Delete. (Set_Has_Complex_Representation): Expect base record types. (Set_No_Reordering): New procedure. (Set_OK_To_Reorder_Components): Delete. (Write_Entity_Flags): Adjust to above change. * fe.h (Debug_Flag_Dot_R): New macro and declaration. * freeze.adb (Freeze_Record_Type): Remove conditional code setting OK_To_Reorder_Components on record types with convention Ada. * lib-writ.adb (Write_ALI): Deal with NC marker. * opt.ads (No_Component_Reordering): New flag. (No_Component_Reordering_Config): Likewise. (Config_Switches_Type): Add No_Component_Reordering component. * opt.adb (Register_Opt_Config_Switches): Copy No_Component_Reordering onto No_Component_Reordering_Config. (Restore_Opt_Config_Switches): Restore No_Component_Reordering. (Save_Opt_Config_Switches): Save No_Component_Reordering. (Set_Opt_Config_Switches): Set No_Component_Reordering. * par-prag.adb (Prag): Deal with Pragma_No_Component_Reordering. * sem_ch3.adb (Analyze_Private_Extension_Declaration): Also set the No_Reordering flag from the default. (Build_Derived_Private_Type): Likewise. (Build_Derived_Record_Type): Likewise. Then inherit it for untagged types and clean up handling of similar flags. (Record_Type_Declaration): Likewise. * sem_ch13.adb (Same_Representation): Deal with No_Reordering and remove redundant test on Is_Tagged_Type. * sem_prag.adb (Analyze_Pragma): Handle No_Component_Reordering. (Sig_Flags): Likewise. * snames.ads-tmpl (Name_No_Component_Reordering): New name. (Pragma_Id): Add Pragma_No_Component_Reordering value. * warnsw.adb (Set_GNAT_Mode_Warnings): Enable -gnatw.q as well. * gcc-interface/decl.c (gnat_to_gnu_entity) : Copy the layout of the parent type only if the No_Reordering settings match. (components_to_record): Reorder record types with convention Ada by default unless No_Reordering is set or -gnatd.r is specified and do not warn if No_Reordering is set in GNAT mode. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 251759) +++ sem_ch3.adb (working copy) @@ -5015,6 +5015,7 @@ Set_Ekind (T, E_Record_Type_With_Private); Init_Size_Align (T); Set_Default_SSO (T); + Set_No_Reordering (T, No_Component_Reordering); Set_Etype (T, Parent_Base); Propagate_Concurrent_Flags (T, Parent_Base); @@ -7679,6 +7680,7 @@ Set_Ekind (Full_Der, E_Record_Type); Set_Is_Underlying_Record_View (Full_Der); Set_Default_SSO (Full_Der); + Set_No_Reordering (Full_Der, No_Component_Reordering); Analyze (Decl); @@ -8478,6 +8480,7 @@ Type_Def := N; Set_Ekind (Derived_Type, E_Record_Type_With_Private); Set_Default_SSO (Derived_Type); + Set_No_Reordering (Derived_Type, No_Component_Reordering); else Type_Def := Type_Definition (N); @@ -8492,6 +8495,7 @@ if Present (Record_Extension_Part (Type_Def)) then Set_Ekind (Derived_Type, E_Record_Type); Set_Default_SSO (Derived_Type); + Set_No_Reordering (Derived_Type, No_Component_Reordering); -- Create internal access types for components with anonymous -- access types. @@ -9112,60 +9116,45 @@ Set_Has_Primitive_Operations (Derived_Type, Has_Primitive_Operations (Parent_Base)); - -- Fields inherited from the Parent_Base in the non-private case + -- Set fields for private derived types - if Ekind (Derived_Type) = E_Record_Type then - Set_Has_Complex_Representation - (Derived_Type, Has_Complex_Representation (Parent_Base)); + if Is_Private_Type (Derived_Type) then + Set_Depends_On_Private (Derived_Type, True); + Set_Private_Dependents (Derived_Type, New_Elmt_List); end if; - -- Fields inherited from the Parent_Base for record types + -- Inherit fields for non-private types. If this is the completion of a + -- derivation from a private type, the parent itself is private and the + -- attributes come from its full view, which must be present. if Is_Record_Type (Derived_Type) then declare Parent_Full : Entity_Id; begin - -- Ekind (Parent_Base) is not necessarily E_Record_Type since - -- Parent_Base can be a private type or private extension. Go - -- to the full view here to get the E_Record_Type specific flags. - - if Present (Full_View (Parent_Base)) then + if Is_Private_Type (Parent_Base) + and then not Is_Record_Type (Parent_Base) + then Parent_Full := Full_View (Parent_Base); else Parent_Full := Parent_Base; end if; - Set_OK_To_Reorder_Components - (Derived_Type, OK_To_Reorder_Components (Parent_Full)); - end; - end if; - - -- Set fields for private derived types - - if Is_Private_Type (Derived_Type) then - Set_Depends_On_Private (Derived_Type, True); - Set_Private_Dependents (Derived_Type, New_Elmt_List); - - -- Inherit fields from non private record types. If this is the - -- completion of a derivation from a private type, the parent itself - -- is private, and the attributes come from its full view, which must - -- be present. - - else - if Is_Private_Type (Parent_Base) - and then not Is_Record_Type (Parent_Base) - then Set_Component_Alignment - (Derived_Type, Component_Alignment (Full_View (Parent_Base))); + (Derived_Type, Component_Alignment (Parent_Full)); Set_C_Pass_By_Copy - (Derived_Type, C_Pass_By_Copy (Full_View (Parent_Base))); - else - Set_Component_Alignment - (Derived_Type, Component_Alignment (Parent_Base)); - Set_C_Pass_By_Copy - (Derived_Type, C_Pass_By_Copy (Parent_Base)); - end if; + (Derived_Type, C_Pass_By_Copy (Parent_Full)); + Set_Has_Complex_Representation + (Derived_Type, Has_Complex_Representation (Parent_Full)); + + -- For untagged types, inherit the layout by default to avoid + -- costly changes of representation for type conversions. + + if not Is_Tagged then + Set_Is_Packed (Derived_Type, Is_Packed (Parent_Full)); + Set_No_Reordering (Derived_Type, No_Reordering (Parent_Full)); + end if; + end; end if; -- Set fields for tagged types @@ -9270,11 +9259,6 @@ end if; end; end if; - - else - Set_Is_Packed (Derived_Type, Is_Packed (Parent_Base)); - Set_Has_Non_Standard_Rep - (Derived_Type, Has_Non_Standard_Rep (Parent_Base)); end if; -- STEP 4: Inherit components from the parent base and constrain them. @@ -21540,6 +21524,7 @@ Set_Interfaces (T, No_Elist); Set_Stored_Constraint (T, No_Elist); Set_Default_SSO (T); + Set_No_Reordering (T, No_Component_Reordering); -- Normal case Index: fe.h =================================================================== --- fe.h (revision 251755) +++ fe.h (working copy) @@ -56,7 +56,9 @@ /* debug: */ -#define Debug_Flag_NN debug__debug_flag_nn +#define Debug_Flag_Dot_R debug__debug_flag_dot_r +#define Debug_Flag_NN debug__debug_flag_nn +extern Boolean Debug_Flag_Dot_R; extern Boolean Debug_Flag_NN; /* einfo: */ Index: lib-writ.adb =================================================================== --- lib-writ.adb (revision 251753) +++ lib-writ.adb (working copy) @@ -1194,6 +1194,10 @@ Write_Info_Char (Partition_Elaboration_Policy); end if; + if No_Component_Reordering_Config then + Write_Info_Str (" NC"); + end if; + if not Object then Write_Info_Str (" NO"); end if; Index: debug.adb =================================================================== --- debug.adb (revision 251753) +++ debug.adb (working copy) @@ -108,11 +108,11 @@ -- d.o Conservative elaboration order for indirect calls -- d.p Use original Ada 95 semantics for Bit_Order (disable AI95-0133) -- d.q Suppress optimizations on imported 'in' - -- d.r Enable OK_To_Reorder_Components in non-variant records + -- d.r Disable reordering of components in record types -- d.s Strict secondary stack management -- d.t Disable static allocation of library level dispatch tables -- d.u Enable Modify_Tree_For_C (update tree for c) - -- d.v Enable OK_To_Reorder_Components in variant records + -- d.v -- d.w Do not check for infinite loops -- d.x No exception handlers -- d.y @@ -574,8 +574,7 @@ -- optimizations. This option should not be used; the correct solution -- is to declare the parameter 'in out'. - -- d.r Forces the flag OK_To_Reorder_Components to be set in all record - -- base types that have no discriminants. + -- d.r Do not reorder components in record types. -- d.s The compiler no longer attempts to optimize the calls to secondary -- stack management routines SS_Mark and SS_Release. As a result, each @@ -596,9 +595,6 @@ -- d.u Sets Modify_Tree_For_C mode in which tree is modified to make it -- easier to generate code using a C compiler. - -- d.v Forces the flag OK_To_Reorder_Components to be set in all record - -- base types that have at least one discriminant (v = variant). - -- d.w This flag turns off the scanning of loops to detect possible -- infinite loops. Index: einfo.adb =================================================================== --- einfo.adb (revision 251759) +++ einfo.adb (working copy) @@ -548,7 +548,7 @@ -- Warnings_Off_Used Flag236 -- Warnings_Off_Used_Unmodified Flag237 -- Warnings_Off_Used_Unreferenced Flag238 - -- OK_To_Reorder_Components Flag239 + -- No_Reordering Flag239 -- Has_Expanded_Contract Flag240 -- Optimize_Alignment_Space Flag241 @@ -1490,7 +1490,7 @@ function Has_Complex_Representation (Id : E) return B is begin - pragma Assert (Is_Type (Id)); + pragma Assert (Is_Record_Type (Id)); return Flag140 (Implementation_Base_Type (Id)); end Has_Complex_Representation; @@ -2864,6 +2864,12 @@ return Flag275 (Id); end No_Predicate_On_Actual; + function No_Reordering (Id : E) return B is + begin + pragma Assert (Is_Record_Type (Id)); + return Flag239 (Implementation_Base_Type (Id)); + end No_Reordering; + function No_Return (Id : E) return B is begin return Flag113 (Id); @@ -2928,12 +2934,6 @@ return Flag247 (Id); end OK_To_Rename; - function OK_To_Reorder_Components (Id : E) return B is - begin - pragma Assert (Is_Record_Type (Id)); - return Flag239 (Base_Type (Id)); - end OK_To_Reorder_Components; - function Optimize_Alignment_Space (Id : E) return B is begin pragma Assert @@ -4584,7 +4584,7 @@ procedure Set_Has_Complex_Representation (Id : E; V : B := True) is begin - pragma Assert (Ekind (Id) = E_Record_Type); + pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); Set_Flag140 (Id, V); end Set_Has_Complex_Representation; @@ -6020,6 +6020,12 @@ Set_Flag275 (Id, V); end Set_No_Predicate_On_Actual; + procedure Set_No_Reordering (Id : E; V : B := True) is + begin + pragma Assert (Is_Record_Type (Id) and then Is_Base_Type (Id)); + Set_Flag239 (Id, V); + end Set_No_Reordering; + procedure Set_No_Return (Id : E; V : B := True) is begin pragma Assert @@ -6085,13 +6091,6 @@ Set_Flag247 (Id, V); end Set_OK_To_Rename; - procedure Set_OK_To_Reorder_Components (Id : E; V : B := True) is - begin - pragma Assert - (Is_Record_Type (Id) and then Is_Base_Type (Id)); - Set_Flag239 (Id, V); - end Set_OK_To_Reorder_Components; - procedure Set_Optimize_Alignment_Space (Id : E; V : B := True) is begin pragma Assert @@ -9593,12 +9592,12 @@ W ("No_Dynamic_Predicate_On_actual", Flag276 (Id)); W ("No_Pool_Assigned", Flag131 (Id)); W ("No_Predicate_On_actual", Flag275 (Id)); + W ("No_Reordering", Flag239 (Id)); W ("No_Return", Flag113 (Id)); W ("No_Strict_Aliasing", Flag136 (Id)); W ("Non_Binary_Modulus", Flag58 (Id)); W ("Nonzero_Is_True", Flag162 (Id)); W ("OK_To_Rename", Flag247 (Id)); - W ("OK_To_Reorder_Components", Flag239 (Id)); W ("Optimize_Alignment_Space", Flag241 (Id)); W ("Optimize_Alignment_Time", Flag242 (Id)); W ("Overlays_Constant", Flag243 (Id)); Index: einfo.ads =================================================================== --- einfo.ads (revision 251753) +++ einfo.ads (working copy) @@ -1539,8 +1539,8 @@ -- the package body). -- Has_Complex_Representation (Flag140) [implementation base type only] --- Defined in all type entities. Set only for a record base type to --- which a valid pragma Complex_Representation applies. +-- Defined in record types. Set only for a base type to which a valid +-- pragma Complex_Representation applies. -- Has_Component_Size_Clause (Flag68) [implementation base type only] -- Defined in all type entities. Set if a component size clause is @@ -3630,6 +3630,10 @@ -- in the spec of a generic package, in constructs that forbid discrete -- types with predicates. +-- No_Reordering (Flag239) [implementation base type only] +-- Defined in record types. Set only for a base type to which a valid +-- pragma No_Component_Reordering applies. + -- No_Return (Flag113) -- Defined in all entities. Always false except in the case of procedures -- and generic procedures for which a pragma No_Return is given. @@ -3709,12 +3713,6 @@ -- is only worth setting this flag for composites, since for primitive -- types, it is cheaper to do the copy. --- OK_To_Reorder_Components (Flag239) [base type only] --- Defined in record types. Set if the backend is permitted to reorder --- the components. If not set, the record must be laid out in the order --- in which the components are declared textually. Currently this flag --- can only be set by debug switches. - -- Optimize_Alignment_Space (Flag241) -- Defined in type, subtype, variable, and constant entities. This -- flag records that the type or object is to be layed out in a manner @@ -4527,7 +4525,7 @@ -- Uses_Lock_Free (Flag188) -- Defined in protected type entities. Set to True when the Lock Free --- implementation is used for the protected type. This implemenatation is +-- implementation is used for the protected type. This implementation is -- based on atomic transactions and doesn't require anymore the use of -- Protection object (see System.Tasking.Protected_Objects). @@ -6493,7 +6491,7 @@ -- Is_Controlled (Flag42) (base type only) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) - -- OK_To_Reorder_Components (Flag239) (base type only) + -- No_Reordering (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) -- SSO_Set_High_By_Default (Flag273) (base type only) @@ -6522,7 +6520,7 @@ -- Is_Controlled (Flag42) (base type only) -- Is_Interface (Flag186) -- Is_Limited_Interface (Flag197) - -- OK_To_Reorder_Components (Flag239) (base type only) + -- No_Reordering (Flag239) (base type only) -- Reverse_Bit_Order (Flag164) (base type only) -- Reverse_Storage_Order (Flag93) (base type only) -- SSO_Set_High_By_Default (Flag273) (base type only) @@ -7279,6 +7277,7 @@ function No_Dynamic_Predicate_On_Actual (Id : E) return B; function No_Pool_Assigned (Id : E) return B; function No_Predicate_On_Actual (Id : E) return B; + function No_Reordering (Id : E) return B; function No_Return (Id : E) return B; function No_Strict_Aliasing (Id : E) return B; function No_Tagged_Streams_Pragma (Id : E) return N; @@ -7289,7 +7288,6 @@ function Normalized_Position (Id : E) return U; function Normalized_Position_Max (Id : E) return U; function OK_To_Rename (Id : E) return B; - function OK_To_Reorder_Components (Id : E) return B; function Optimize_Alignment_Space (Id : E) return B; function Optimize_Alignment_Time (Id : E) return B; function Original_Access_Type (Id : E) return E; @@ -7971,6 +7969,7 @@ procedure Set_No_Dynamic_Predicate_On_Actual (Id : E; V : B := True); procedure Set_No_Pool_Assigned (Id : E; V : B := True); procedure Set_No_Predicate_On_Actual (Id : E; V : B := True); + procedure Set_No_Reordering (Id : E; V : B := True); procedure Set_No_Return (Id : E; V : B := True); procedure Set_No_Strict_Aliasing (Id : E; V : B := True); procedure Set_No_Tagged_Streams_Pragma (Id : E; V : N); @@ -7981,7 +7980,6 @@ procedure Set_Normalized_Position (Id : E; V : U); procedure Set_Normalized_Position_Max (Id : E; V : U); procedure Set_OK_To_Rename (Id : E; V : B := True); - procedure Set_OK_To_Reorder_Components (Id : E; V : B := True); procedure Set_Optimize_Alignment_Space (Id : E; V : B := True); procedure Set_Optimize_Alignment_Time (Id : E; V : B := True); procedure Set_Original_Access_Type (Id : E; V : E); @@ -8815,6 +8813,7 @@ pragma Inline (No_Dynamic_Predicate_On_Actual); pragma Inline (No_Pool_Assigned); pragma Inline (No_Predicate_On_Actual); + pragma Inline (No_Reordering); pragma Inline (No_Return); pragma Inline (No_Strict_Aliasing); pragma Inline (No_Tagged_Streams_Pragma); @@ -8825,7 +8824,6 @@ pragma Inline (Normalized_Position); pragma Inline (Normalized_Position_Max); pragma Inline (OK_To_Rename); - pragma Inline (OK_To_Reorder_Components); pragma Inline (Optimize_Alignment_Space); pragma Inline (Optimize_Alignment_Time); pragma Inline (Original_Access_Type); @@ -9295,6 +9293,7 @@ pragma Inline (Set_No_Dynamic_Predicate_On_Actual); pragma Inline (Set_No_Pool_Assigned); pragma Inline (Set_No_Predicate_On_Actual); + pragma Inline (Set_No_Reordering); pragma Inline (Set_No_Return); pragma Inline (Set_No_Strict_Aliasing); pragma Inline (Set_No_Tagged_Streams_Pragma); @@ -9305,7 +9304,6 @@ pragma Inline (Set_Normalized_Position); pragma Inline (Set_Normalized_Position_Max); pragma Inline (Set_OK_To_Rename); - pragma Inline (Set_OK_To_Reorder_Components); pragma Inline (Set_Optimize_Alignment_Space); pragma Inline (Set_Optimize_Alignment_Time); pragma Inline (Set_Original_Access_Type); Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 251753) +++ sem_prag.adb (working copy) @@ -14398,10 +14398,10 @@ if Etype (E_Id) = Any_Type then return; - else - E := Entity (E_Id); end if; + E := Entity (E_Id); + -- A pragma that applies to a Ghost entity becomes Ghost for -- the purposes of legality checks and removal of ignored -- Ghost code. @@ -18066,6 +18066,43 @@ Opt.No_Elab_Code_All_Pragma := N; end if; + ----------------------------- + -- No_Component_Reordering -- + ----------------------------- + + -- pragma No_Component_Reordering [([Entity =>] type_LOCAL_NAME)]; + + when Pragma_No_Component_Reordering => No_Comp_Reordering : declare + E : Entity_Id; + E_Id : Node_Id; + + begin + GNAT_Pragma; + Check_At_Most_N_Arguments (1); + + if Arg_Count = 0 then + Check_Valid_Configuration_Pragma; + Opt.No_Component_Reordering := True; + + else + Check_Optional_Identifier (Arg2, Name_Entity); + Check_Arg_Is_Local_Name (Arg1); + E_Id := Get_Pragma_Arg (Arg1); + + if Etype (E_Id) = Any_Type then + return; + end if; + + E := Entity (E_Id); + + if not Is_Record_Type (E) then + Error_Pragma_Arg ("pragma% requires record type", Arg1); + end if; + + Set_No_Reordering (Base_Type (E)); + end if; + end No_Comp_Reordering; + -------------------------- -- No_Heap_Finalization -- -------------------------- @@ -18443,7 +18480,8 @@ -- pragma No_Strict_Aliasing [([Entity =>] type_LOCAL_NAME)]; when Pragma_No_Strict_Aliasing => No_Strict_Aliasing : declare - E_Id : Entity_Id; + E : Entity_Id; + E_Id : Node_Id; begin GNAT_Pragma; @@ -18456,15 +18494,19 @@ else Check_Optional_Identifier (Arg2, Name_Entity); Check_Arg_Is_Local_Name (Arg1); - E_Id := Entity (Get_Pragma_Arg (Arg1)); + E_Id := Get_Pragma_Arg (Arg1); - if E_Id = Any_Type then + if Etype (E_Id) = Any_Type then return; - elsif No (E_Id) or else not Is_Access_Type (E_Id) then + end if; + + E := Entity (E_Id); + + if not Is_Access_Type (E) then Error_Pragma_Arg ("pragma% requires access type", Arg1); end if; - Set_No_Strict_Aliasing (Implementation_Base_Type (E_Id)); + Set_No_Strict_Aliasing (Base_Type (E)); end if; end No_Strict_Aliasing; @@ -20369,7 +20411,7 @@ Check_Arg_Is_Local_Name (Arg1); E_Id := Get_Pragma_Arg (Arg1); - if Error_Posted (E_Id) then + if Etype (E_Id) = Any_Type then return; end if; @@ -23164,27 +23206,32 @@ -- pragma Universal_Aliasing [([Entity =>] type_LOCAL_NAME)]; when Pragma_Universal_Aliasing => Universal_Alias : declare - E_Id : Entity_Id; + E : Entity_Id; + E_Id : Node_Id; begin GNAT_Pragma; Check_Arg_Count (1); Check_Optional_Identifier (Arg2, Name_Entity); Check_Arg_Is_Local_Name (Arg1); - E_Id := Entity (Get_Pragma_Arg (Arg1)); + E_Id := Get_Pragma_Arg (Arg1); - if E_Id = Any_Type then + if Etype (E_Id) = Any_Type then return; - elsif No (E_Id) or else not Is_Type (E_Id) then + end if; + + E := Entity (E_Id); + + if not Is_Type (E) then Error_Pragma_Arg ("pragma% requires type", Arg1); end if; -- A pragma that applies to a Ghost entity becomes Ghost for the -- purposes of legality checks and removal of ignored Ghost code. - Mark_Ghost_Pragma (N, E_Id); - Set_Universal_Aliasing (Implementation_Base_Type (E_Id)); - Record_Rep_Item (E_Id, N); + Mark_Ghost_Pragma (N, E); + Set_Universal_Aliasing (Base_Type (E)); + Record_Rep_Item (E, N); end Universal_Alias; -------------------- @@ -29293,6 +29340,7 @@ Pragma_Memory_Size => 0, Pragma_No_Return => 0, Pragma_No_Body => 0, + Pragma_No_Component_Reordering => -1, Pragma_No_Elaboration_Code_All => 0, Pragma_No_Heap_Finalization => 0, Pragma_No_Inline => 0, Index: freeze.adb =================================================================== --- freeze.adb (revision 251753) +++ freeze.adb (working copy) @@ -4441,17 +4441,6 @@ end if; end; - -- Set OK_To_Reorder_Components depending on debug flags - - if Is_Base_Type (Rec) and then Convention (Rec) = Convention_Ada then - if (Has_Discriminants (Rec) and then Debug_Flag_Dot_V) - or else - (not Has_Discriminants (Rec) and then Debug_Flag_Dot_R) - then - Set_OK_To_Reorder_Components (Rec); - end if; - end if; - -- Check for useless pragma Pack when all components placed. We only -- do this check for record types, not subtypes, since a subtype may -- have all its components placed, and it still makes perfectly good Index: warnsw.adb =================================================================== --- warnsw.adb (revision 251753) +++ warnsw.adb (working copy) @@ -485,6 +485,7 @@ -- These warnings are added to the -gnatwa set Address_Clause_Overlay_Warnings := True; + Warn_On_Questionable_Layout := True; Warn_On_Overridden_Size := True; -- These warnings are removed from the -gnatwa set Index: ali.adb =================================================================== --- ali.adb (revision 251753) +++ ali.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -111,6 +111,7 @@ Locking_Policy_Specified := ' '; No_Normalize_Scalars_Specified := False; No_Object_Specified := False; + No_Component_Reordering_Specified := False; GNATprove_Mode_Specified := False; Normalize_Scalars_Specified := False; Partition_Elaboration_Policy_Specified := ' '; @@ -885,6 +886,7 @@ Main_Priority => -1, Main_CPU => -1, Main_Program => None, + No_Component_Reordering => False, No_Object => False, Normalize_Scalars => False, Ofile_Full_Name => Full_Object_File_Name, @@ -1122,9 +1124,15 @@ elsif C = 'N' then C := Getc; + -- Processing for NC + + if C = 'C' then + ALIs.Table (Id).No_Component_Reordering := True; + No_Component_Reordering_Specified := True; + -- Processing for NO - if C = 'O' then + elsif C = 'O' then ALIs.Table (Id).No_Object := True; No_Object_Specified := True; Index: ali.ads =================================================================== --- ali.ads (revision 251753) +++ ali.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -177,6 +177,11 @@ -- signalled by GP appearing on the P line. Not set if 'P' appears in -- Ignore_Lines. + No_Component_Reordering : Boolean; + -- Set to True if file was compiled with a configuration pragma file + -- containing pragma No_Component_Reordering. Not set if 'P' appears + -- in Ignore_Lines. + No_Object : Boolean; -- Set to True if no object file generated. Not set if 'P' appears in -- Ignore_Lines. @@ -492,6 +497,10 @@ -- Set to False by Initialize_ALI. Set to True if an ali file indicates -- that the file was compiled without normalize scalars. + No_Component_Reordering_Specified : Boolean := False; + -- Set to False by Initialize_ALI. Set to True if an ali file contains + -- the No_Component_Reordering flag. + No_Object_Specified : Boolean := False; -- Set to False by Initialize_ALI. Set to True if an ali file contains -- the No_Object flag. Index: par-prag.adb =================================================================== --- par-prag.adb (revision 251753) +++ par-prag.adb (working copy) @@ -1414,6 +1414,7 @@ | Pragma_Max_Queue_Length | Pragma_Memory_Size | Pragma_No_Body + | Pragma_No_Component_Reordering | Pragma_No_Elaboration_Code_All | Pragma_No_Heap_Finalization | Pragma_No_Inline Index: opt.adb =================================================================== --- opt.adb (revision 251753) +++ opt.adb (working copy) @@ -102,6 +102,7 @@ External_Name_Imp_Casing_Config := External_Name_Imp_Casing; Fast_Math_Config := Fast_Math; Initialize_Scalars_Config := Initialize_Scalars; + No_Component_Reordering_Config := No_Component_Reordering; Optimize_Alignment_Config := Optimize_Alignment; Persistent_BSS_Mode_Config := Persistent_BSS_Mode; Polling_Required_Config := Polling_Required; @@ -141,6 +142,7 @@ External_Name_Imp_Casing := Save.External_Name_Imp_Casing; Fast_Math := Save.Fast_Math; Initialize_Scalars := Save.Initialize_Scalars; + No_Component_Reordering := Save.No_Component_Reordering; Optimize_Alignment := Save.Optimize_Alignment; Optimize_Alignment_Local := Save.Optimize_Alignment_Local; Persistent_BSS_Mode := Save.Persistent_BSS_Mode; @@ -182,6 +184,7 @@ Save.External_Name_Imp_Casing := External_Name_Imp_Casing; Save.Fast_Math := Fast_Math; Save.Initialize_Scalars := Initialize_Scalars; + Save.No_Component_Reordering := No_Component_Reordering; Save.Optimize_Alignment := Optimize_Alignment; Save.Optimize_Alignment_Local := Optimize_Alignment_Local; Save.Persistent_BSS_Mode := Persistent_BSS_Mode; @@ -218,6 +221,7 @@ Extensions_Allowed := True; External_Name_Exp_Casing := As_Is; External_Name_Imp_Casing := Lowercase; + No_Component_Reordering := False; Optimize_Alignment := 'O'; Optimize_Alignment_Local := True; Persistent_BSS_Mode := False; @@ -269,6 +273,7 @@ External_Name_Imp_Casing := External_Name_Imp_Casing_Config; Fast_Math := Fast_Math_Config; Initialize_Scalars := Initialize_Scalars_Config; + No_Component_Reordering := No_Component_Reordering_Config; Optimize_Alignment := Optimize_Alignment_Config; Optimize_Alignment_Local := False; Persistent_BSS_Mode := Persistent_BSS_Mode_Config; Index: opt.ads =================================================================== --- opt.ads (revision 251753) +++ opt.ads (working copy) @@ -1107,6 +1107,10 @@ -- GNATNAME -- Do not create backup copies of project files. Set by switch --no-backup. + No_Component_Reordering : Boolean := False; + -- GNAT + -- Set True if pragma No_Component_Reordering with no parameter encountered + No_Deletion : Boolean := False; -- GNATPREP -- Set by preprocessor switch -a. Do not eliminate any source text. Implies @@ -2025,6 +2029,14 @@ -- This switch is not set when the pragma appears ahead of a given -- unit, so it does not affect the compilation of other units. + No_Component_Reordering_Config : Boolean; + -- GNAT + -- This is the value of the configuration switch that is set by the + -- pragma No_Component_Reordering when it appears in the gnat.adc file. + -- This flag is used to set the initial value of No_Component_Reordering + -- at the start of each compilation unit, except that it is always set + -- False for predefined units. + No_Exit_Message : Boolean := False; -- GNATMAKE, GPRBUILD -- Set with switch --no-exit-message. When True, if there are compilation @@ -2089,8 +2101,7 @@ procedure Save_Opt_Config_Switches (Save : out Config_Switches_Type); -- This procedure saves the current values of the switches which are - -- initialized from the above Config values, and then resets these switches - -- according to the Config value settings. + -- initialized from the above Config values. procedure Set_Opt_Config_Switches (Internal_Unit : Boolean; @@ -2306,6 +2317,7 @@ External_Name_Imp_Casing : External_Casing_Type; Fast_Math : Boolean; Initialize_Scalars : Boolean; + No_Component_Reordering : Boolean; Normalize_Scalars : Boolean; Optimize_Alignment : Character; Optimize_Alignment_Local : Boolean; Index: prj-attr.ads =================================================================== --- prj-attr.ads (revision 251753) +++ prj-attr.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -87,6 +87,7 @@ type Attribute_Data (Name_Length : Attribute_Name_Length := 1) is record Name : String (1 .. Name_Length); + pragma Warnings (Off, Name); -- Reorder it instead??? -- The name of the attribute Attr_Kind : Defined_Attribute_Kind; Index: g-socket.ads =================================================================== --- g-socket.ads (revision 251753) +++ g-socket.ads (working copy) @@ -506,6 +506,7 @@ Addr : Inet_Addr_Type (Family); Port : Port_Type; end record; + pragma No_Component_Reordering (Sock_Addr_Type); -- Socket addresses fully define a socket connection with protocol family, -- an Internet address and a port. No_Sock_Addr provides a special value -- for uninitialized socket addresses. Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 251753) +++ sem_ch13.adb (working copy) @@ -12799,7 +12799,8 @@ return True; end if; - -- Tagged types never have differing representations + -- Tagged types always have the same representation, because it is not + -- possible to specify different representations for common fields. if Is_Tagged_Type (T1) then return True; @@ -12837,6 +12838,15 @@ end if; end if; + -- For records, representations are different if reorderings differ + + if Is_Record_Type (T1) + and then Is_Record_Type (T2) + and then No_Reordering (T1) /= No_Reordering (T2) + then + return False; + end if; + -- Types definitely have same representation if neither has non-standard -- representation since default representations are always consistent. -- If only one has non-standard representation, and the other does not, @@ -12861,12 +12871,6 @@ if Is_Array_Type (T1) then return Component_Size (T1) = Component_Size (T2); - -- Tagged types always have the same representation, because it is not - -- possible to specify different representations for common fields. - - elsif Is_Tagged_Type (T1) then - return True; - -- Case of record types elsif Is_Record_Type (T1) then Index: bcheck.adb =================================================================== --- bcheck.adb (revision 251753) +++ bcheck.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -49,6 +49,7 @@ procedure Check_Consistent_Dynamic_Elaboration_Checking; procedure Check_Consistent_Interrupt_States; procedure Check_Consistent_Locking_Policy; + procedure Check_Consistent_No_Component_Reordering; procedure Check_Consistent_Normalize_Scalars; procedure Check_Consistent_Optimize_Alignment; procedure Check_Consistent_Partition_Elaboration_Policy; @@ -80,6 +81,10 @@ Check_Consistent_Locking_Policy; end if; + if No_Component_Reordering_Specified then + Check_Consistent_No_Component_Reordering; + end if; + if Partition_Elaboration_Policy_Specified /= ' ' then Check_Consistent_Partition_Elaboration_Policy; end if; @@ -643,6 +648,69 @@ end loop Find_Policy; end Check_Consistent_Locking_Policy; + ---------------------------------------------- + -- Check_Consistent_No_Component_Reordering -- + ---------------------------------------------- + + -- This routine checks for a consistent No_Component_Reordering setting. + -- Note that internal units are excluded from this check, since we don't + -- in any case allow the pragma to affect types in internal units, and + -- there is thus no requirement to recompile the run-time with the setting. + + procedure Check_Consistent_No_Component_Reordering is + OK : Boolean := True; + begin + -- Check that all entries have No_Component_Reordering set + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then not ALIs.Table (A1).No_Component_Reordering + then + OK := False; + exit; + end if; + end loop; + + -- All do, return + + if OK then + return; + end if; + + -- Here we have an inconsistency + + Consistency_Error_Msg + ("some but not all files compiled with No_Component_Reordering"); + + Write_Eol; + Write_Str ("files compiled with No_Component_Reordering"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then ALIs.Table (A1).No_Component_Reordering + then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + + Write_Eol; + Write_Str ("files compiled without No_Component_Reordering"); + Write_Eol; + + for A1 in ALIs.First .. ALIs.Last loop + if not Is_Internal_File_Name (ALIs.Table (A1).Sfile) + and then not ALIs.Table (A1).No_Component_Reordering + then + Write_Str (" "); + Write_Name (ALIs.Table (A1).Sfile); + Write_Eol; + end if; + end loop; + end Check_Consistent_No_Component_Reordering; + ---------------------------------------- -- Check_Consistent_Normalize_Scalars -- ---------------------------------------- Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 251753) +++ snames.ads-tmpl (working copy) @@ -432,6 +432,7 @@ Name_Interrupt_State : constant Name_Id := N + $; -- GNAT Name_License : constant Name_Id := N + $; -- GNAT Name_Locking_Policy : constant Name_Id := N + $; + Name_No_Component_Reordering : constant Name_Id := N + $; -- GNAT Name_No_Heap_Finalization : constant Name_Id := N + $; -- GNAT Name_No_Run_Time : constant Name_Id := N + $; -- GNAT Name_No_Strict_Aliasing : constant Name_Id := N + $; -- GNAT @@ -1810,6 +1811,7 @@ Pragma_Interrupt_State, Pragma_License, Pragma_Locking_Policy, + Pragma_No_Component_Reordering, Pragma_No_Heap_Finalization, Pragma_No_Run_Time, Pragma_No_Strict_Aliasing, Index: gcc-interface/decl.c =================================================================== --- gcc-interface/decl.c (revision 251753) +++ gcc-interface/decl.c (working copy) @@ -3331,7 +3331,8 @@ && Stored_Constraint (gnat_entity) != No_Elist && (gnat_parent_type = Underlying_Type (Etype (gnat_entity))) && Is_Record_Type (gnat_parent_type) - && !Is_Unchecked_Union (gnat_parent_type)) + && !Is_Unchecked_Union (gnat_parent_type) + && No_Reordering (gnat_entity) == No_Reordering (gnat_parent_type)) { tree gnu_parent_type = TYPE_MAIN_VARIANT (gnat_to_gnu_type (gnat_parent_type)); @@ -7692,9 +7693,7 @@ } /* Scan GNU_FIELD_LIST and see if any fields have rep clauses. If they do, - pull them out and put them onto the appropriate list. We have to do it - in a separate pass since we want to handle the discriminants but can't - play with them until we've used them in debugging data above. + pull them out and put them onto the appropriate list. Similarly, pull out the fields with zero size and no rep clause, as they would otherwise modify the layout and thus very likely run afoul of the @@ -7714,16 +7713,16 @@ different kinds of fields and issue a warning if some of them would be (or are being) reordered by the reordering mechanism. - Finally, pull out the fields whose size is not a multiple of a byte, so - that they don't cause the regular fields to be misaligned. As this can - only happen in packed record types, the alignment is capped to the byte. - - ??? If we reorder them, debugging information will be wrong but there is - nothing that can be done about this at the moment. */ - const bool do_reorder = OK_To_Reorder_Components (gnat_record_type); + ??? If we reorder fields, the debugging information will be affected and + the debugger print fields in a different order from the source code. */ + const bool do_reorder + = (Convention (gnat_record_type) == Convention_Ada + && !No_Reordering (gnat_record_type) + && !debug__debug_flag_dot_r); const bool w_reorder - = Warn_On_Questionable_Layout - && (Convention (gnat_record_type) == Convention_Ada); + = (Convention (gnat_record_type) == Convention_Ada + && Warn_On_Questionable_Layout + && !(No_Reordering (gnat_record_type) && GNAT_Mode)); const bool in_variant = (p_gnu_rep_list != NULL); tree gnu_zero_list = NULL_TREE; tree gnu_self_list = NULL_TREE;