From 148c86d1ab9a1cc02651056a2da3b67003f1a51a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 2 Mar 2020 12:46:14 +0100 Subject: [PATCH] [Ada] Small cleanup in Einfo unit 2020-06-09 Eric Botcazou gcc/ada/ * einfo.ads (Has_Foreign_Convention): Fix description. (Component_Alignment): Move around. (Has_DIC): Likewise. (Has_Interrupt_Handler): Likewise. (Has_Invariants): Likewise. (Is_Atomic_Or_VFA): Likewise. (Next_Index): Likewise. (Scope_Depth): Likewise. (Init_Component_Size): Likewise. (Init_Component_Location): Likewise. (Init_Size): Likewise. (Inline Pragmas for functions): Add Corresponding_Function, Corresponding_Procedure, Entry_Max_Queue_Lengths_Array, Finalize_Storage_Only, Has_DIC, Has_Invariants, Initialization_Statements, Is_Anonymous_Access_Type, Next_Stored_Discriminant, Address_Clause, Alignment_Clause, Float_Rep, Has_Foreign_Convention, Has_Non_Limited_View, Is_Constant_Object, Is_Discriminal, Is_Finalizer, Is_Null_State, Is_Prival, Is_Protected_Component, Is_Protected_Record_Type, Is_Subprogram_Or_Entry, Is_Task_Record_Type, Size_Clause, Stream_Size_Clause, Type_High_Bound, Type_Low_Bound, Known_*, Unknown_*. (Inline Pragmas for procedures): Add Set_Corresponding_Function, Set_Corresponding_Procedure, Set_Finalize_Storage_Only, Set_Float_Rep, Set_Initialization_Statements, Init_Normalized_First_Bit, Init_Normalized_Position, Init_Normalized_Position_Max. * einfo.adb (Was_Hidden): Move around. (Is_Packed_Array): Likewise. (Model_Emin_Value): Likewise. (Model_Epsilon_Value): Likewise. (Model_Mantissa_Value): Likewise. (Model_Small_Value): Likewise. --- gcc/ada/einfo.adb | 104 +++++++++++++++---------------- gcc/ada/einfo.ads | 183 ++++++++++++++++++++++++++++++++++++------------------ 2 files changed, 173 insertions(+), 114 deletions(-) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index cbcf9e3..174a5b9 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -3615,6 +3615,11 @@ package body Einfo is return Flag238 (Id); end Warnings_Off_Used_Unreferenced; + function Was_Hidden (Id : E) return B is + begin + return Flag196 (Id); + end Was_Hidden; + function Wrapped_Entity (Id : E) return E is begin pragma Assert (Ekind_In (Id, E_Function, E_Procedure) @@ -3622,11 +3627,6 @@ package body Einfo is return Node27 (Id); end Wrapped_Entity; - function Was_Hidden (Id : E) return B is - begin - return Flag196 (Id); - end Was_Hidden; - ------------------------------ -- Classification Functions -- ------------------------------ @@ -8168,15 +8168,6 @@ package body Einfo is Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null; end Is_Null_State; - --------------------- - -- Is_Packed_Array -- - --------------------- - - function Is_Packed_Array (Id : E) return B is - begin - return Is_Array_Type (Id) and then Is_Packed (Id); - end Is_Packed_Array; - ----------------------------------- -- Is_Package_Or_Generic_Package -- ----------------------------------- @@ -8186,6 +8177,15 @@ package body Einfo is return Ekind_In (Id, E_Generic_Package, E_Package); end Is_Package_Or_Generic_Package; + --------------------- + -- Is_Packed_Array -- + --------------------- + + function Is_Packed_Array (Id : E) return B is + begin + return Is_Array_Type (Id) and then Is_Packed (Id); + end Is_Packed_Array; + --------------- -- Is_Prival -- --------------- @@ -8404,44 +8404,6 @@ package body Einfo is Set_Next_Entity (First, Second); -- First --> Second end Link_Entities; - ---------------------- - -- Model_Emin_Value -- - ---------------------- - - function Model_Emin_Value (Id : E) return Uint is - begin - return Machine_Emin_Value (Id); - end Model_Emin_Value; - - ------------------------- - -- Model_Epsilon_Value -- - ------------------------- - - function Model_Epsilon_Value (Id : E) return Ureal is - Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); - begin - return Radix ** (1 - Model_Mantissa_Value (Id)); - end Model_Epsilon_Value; - - -------------------------- - -- Model_Mantissa_Value -- - -------------------------- - - function Model_Mantissa_Value (Id : E) return Uint is - begin - return Machine_Mantissa_Value (Id); - end Model_Mantissa_Value; - - ----------------------- - -- Model_Small_Value -- - ----------------------- - - function Model_Small_Value (Id : E) return Ureal is - Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); - begin - return Radix ** (Model_Emin_Value (Id) - 1); - end Model_Small_Value; - ------------------------ -- Machine_Emax_Value -- ------------------------ @@ -8517,6 +8479,44 @@ package body Einfo is end case; end Machine_Radix_Value; + ---------------------- + -- Model_Emin_Value -- + ---------------------- + + function Model_Emin_Value (Id : E) return Uint is + begin + return Machine_Emin_Value (Id); + end Model_Emin_Value; + + ------------------------- + -- Model_Epsilon_Value -- + ------------------------- + + function Model_Epsilon_Value (Id : E) return Ureal is + Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); + begin + return Radix ** (1 - Model_Mantissa_Value (Id)); + end Model_Epsilon_Value; + + -------------------------- + -- Model_Mantissa_Value -- + -------------------------- + + function Model_Mantissa_Value (Id : E) return Uint is + begin + return Machine_Mantissa_Value (Id); + end Model_Mantissa_Value; + + ----------------------- + -- Model_Small_Value -- + ----------------------- + + function Model_Small_Value (Id : E) return Ureal is + Radix : constant Ureal := UR_From_Uint (Machine_Radix_Value (Id)); + begin + return Radix ** (Model_Emin_Value (Id) - 1); + end Model_Small_Value; + -------------------- -- Next_Component -- -------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 2490127..4315fce 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1681,9 +1681,10 @@ package Einfo is -- rewritten into something else and subsequently reanalyzed/expanded. -- Has_Foreign_Convention (synthesized) --- Applies to all entities. Determines if the Convention for the --- entity is a foreign convention (i.e. is other than Convention_Ada, --- Convention_Intrinsic, Convention_Entry or Convention_Protected). +-- Applies to all entities. Determines if the Convention for the entity +-- is a foreign convention, i.e. non-native: other than Convention_Ada, +-- Convention_Intrinsic, Convention_Entry, Convention_Protected, +-- Convention_Stubbed and Convention_Ada_Pass_By_(Copy,Reference). -- Has_Forward_Instantiation (Flag175) -- Defined in package entities. Set for packages that instantiate local @@ -7091,7 +7092,6 @@ package Einfo is function Class_Wide_Clone (Id : E) return E; function Class_Wide_Type (Id : E) return E; function Cloned_Subtype (Id : E) return E; - function Component_Alignment (Id : E) return C; function Component_Bit_Offset (Id : E) return U; function Component_Clause (Id : E) return N; function Component_Size (Id : E) return U; @@ -7199,7 +7199,6 @@ package Einfo is function Has_Delayed_Aspects (Id : E) return B; function Has_Delayed_Freeze (Id : E) return B; function Has_Delayed_Rep_Aspects (Id : E) return B; - function Has_DIC (Id : E) return B; function Has_Discriminants (Id : E) return B; function Has_Dispatch_Table (Id : E) return B; function Has_Dynamic_Predicate_Aspect (Id : E) return B; @@ -7216,8 +7215,6 @@ package Einfo is function Has_Inherited_DIC (Id : E) return B; function Has_Inherited_Invariants (Id : E) return B; function Has_Initial_Value (Id : E) return B; - function Has_Interrupt_Handler (Id : E) return B; - function Has_Invariants (Id : E) return B; function Has_Loop_Entry_Attributes (Id : E) return B; function Has_Machine_Radix_Clause (Id : E) return B; function Has_Master_Entity (Id : E) return B; @@ -7301,7 +7298,6 @@ package Einfo is function Is_Aliased (Id : E) return B; function Is_Asynchronous (Id : E) return B; function Is_Atomic (Id : E) return B; - function Is_Atomic_Or_VFA (Id : E) return B; function Is_Bit_Packed_Array (Id : E) return B; function Is_Called (Id : E) return B; function Is_Character_Type (Id : E) return B; @@ -7624,6 +7620,7 @@ package Einfo is function Aft_Value (Id : E) return U; function Alignment_Clause (Id : E) return N; function Base_Type (Id : E) return E; + function Component_Alignment (Id : E) return C; function Declaration_Node (Id : E) return N; function Designated_Type (Id : E) return E; function First_Component (Id : E) return E; @@ -7631,14 +7628,18 @@ package Einfo is function First_Formal (Id : E) return E; function First_Formal_With_Extras (Id : E) return E; function Has_Attach_Handler (Id : E) return B; + function Has_DIC (Id : E) return B; function Has_Entries (Id : E) return B; function Has_Foreign_Convention (Id : E) return B; + function Has_Interrupt_Handler (Id : E) return B; + function Has_Invariants (Id : E) return B; function Has_Non_Limited_View (Id : E) return B; function Has_Non_Null_Abstract_State (Id : E) return B; function Has_Non_Null_Visible_Refinement (Id : E) return B; 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_Atomic_Or_VFA (Id : E) return B; function Is_Base_Type (Id : E) return B; function Is_Boolean_Type (Id : E) return B; function Is_Constant_Object (Id : E) return B; @@ -7677,6 +7678,7 @@ package Einfo is function Next_Discriminant (Id : E) return E; function Next_Formal (Id : E) return E; function Next_Formal_With_Extras (Id : E) return E; + function Next_Index (Id : N) return N; function Next_Literal (Id : E) return E; function Next_Stored_Discriminant (Id : E) return E; function Number_Dimensions (Id : E) return Pos; @@ -7690,6 +7692,7 @@ package Einfo is function Safe_Emax_Value (Id : E) return U; function Safe_First_Value (Id : E) return R; function Safe_Last_Value (Id : E) return R; + function Scope_Depth (Id : E) return U; function Scope_Depth_Set (Id : E) return B; function Size_Clause (Id : E) return N; function Stream_Size_Clause (Id : E) return N; @@ -8303,8 +8306,8 @@ package Einfo is -- entities whose Ekind has not been set yet). procedure Init_Alignment (Id : E; V : Int); - procedure Init_Component_Size (Id : E; V : Int); procedure Init_Component_Bit_Offset (Id : E; V : Int); + procedure Init_Component_Size (Id : E; V : Int); procedure Init_Digits_Value (Id : E; V : Int); procedure Init_Esize (Id : E; V : Int); procedure Init_Normalized_First_Bit (Id : E; V : Int); @@ -8313,8 +8316,8 @@ package Einfo is procedure Init_RM_Size (Id : E; V : Int); procedure Init_Alignment (Id : E); - procedure Init_Component_Size (Id : E); procedure Init_Component_Bit_Offset (Id : E); + procedure Init_Component_Size (Id : E); procedure Init_Digits_Value (Id : E); procedure Init_Esize (Id : E); procedure Init_Normalized_First_Bit (Id : E); @@ -8322,6 +8325,14 @@ package Einfo is procedure Init_Normalized_Position_Max (Id : E); procedure Init_RM_Size (Id : E); + procedure Init_Component_Location (Id : E); + -- Initializes all fields describing the location of a component + -- (Normalized_Position, Component_Bit_Offset, Normalized_First_Bit, + -- Normalized_Position_Max, Esize) to all be Unknown. + + procedure Init_Size (Id : E; V : Int); + -- Initialize both the Esize and RM_Size fields of E to V + procedure Init_Size_Align (Id : E); -- This procedure initializes both size fields and the alignment -- field to all be Unknown. @@ -8330,14 +8341,6 @@ package Einfo is -- Same as Init_Size_Align except RM_Size field (which is only for types) -- is unaffected. - procedure Init_Size (Id : E; V : Int); - -- Initialize both the Esize and RM_Size fields of E to V - - procedure Init_Component_Location (Id : E); - -- Initializes all fields describing the location of a component - -- (Normalized_Position, Component_Bit_Offset, Normalized_First_Bit, - -- Normalized_Position_Max, Esize) to all be Unknown. - --------------- -- Iterators -- --------------- @@ -8524,18 +8527,9 @@ package Einfo is -- NOTE: No updates are done to the First_Entity and Last_Entity fields -- of the scope. - function Next_Index (Id : Node_Id) return Node_Id; - -- Given an index from a previous call to First_Index or Next_Index, - -- returns a node representing the occurrence of the next index subtype, - -- or Empty if there are no more index subtypes. - procedure Remove_Entity (Id : Entity_Id); -- Remove entity Id from the entity chain of its scope - function Scope_Depth (Id : Entity_Id) return Uint; - -- Returns the scope depth value of the Id, unless the Id is a record - -- type, in which case it returns the scope depth of the record scope. - function Subtype_Kind (K : Entity_Kind) return Entity_Kind; -- Given an entity_kind K this function returns the entity_kind -- corresponding to subtype kind of the type represented by K. For @@ -8597,9 +8591,9 @@ package Einfo is -- the given field, depending on the Ekind. No blanks or end of lines are -- output, just the characters of the field name. - -------------------- - -- Inline Pragmas -- - -------------------- + ---------------------------------- + -- Inline Pragmas for functions -- + ---------------------------------- -- Note that these inline pragmas are referenced by the XEINFO utility -- program in preparing the corresponding C header, and only those @@ -8646,6 +8640,8 @@ package Einfo is pragma Inline (Corresponding_Concurrent_Type); pragma Inline (Corresponding_Discriminant); pragma Inline (Corresponding_Equality); + pragma Inline (Corresponding_Function); + pragma Inline (Corresponding_Procedure); pragma Inline (Corresponding_Protected_Entry); pragma Inline (Corresponding_Record_Component); pragma Inline (Corresponding_Record_Type); @@ -8694,6 +8690,7 @@ package Einfo is pragma Inline (Entry_Formal); pragma Inline (Entry_Index_Constant); pragma Inline (Entry_Index_Type); + pragma Inline (Entry_Max_Queue_Lengths_Array); pragma Inline (Entry_Parameters_Type); pragma Inline (Enum_Pos_To_Rep); pragma Inline (Enumeration_Pos); @@ -8706,6 +8703,7 @@ package Einfo is pragma Inline (Extra_Constrained); pragma Inline (Extra_Formal); pragma Inline (Extra_Formals); + pragma Inline (Finalize_Storage_Only); pragma Inline (Finalization_Master); pragma Inline (Finalizer); pragma Inline (First_Entity); @@ -8738,6 +8736,7 @@ package Einfo is pragma Inline (Has_Delayed_Aspects); pragma Inline (Has_Delayed_Freeze); pragma Inline (Has_Delayed_Rep_Aspects); + pragma Inline (Has_DIC); pragma Inline (Has_Discriminants); pragma Inline (Has_Dispatch_Table); pragma Inline (Has_Dynamic_Predicate_Aspect); @@ -8754,6 +8753,7 @@ package Einfo is pragma Inline (Has_Inherited_DIC); pragma Inline (Has_Inherited_Invariants); pragma Inline (Has_Initial_Value); + pragma Inline (Has_Invariants); pragma Inline (Has_Loop_Entry_Attributes); pragma Inline (Has_Machine_Radix_Clause); pragma Inline (Has_Master_Entity); @@ -8822,6 +8822,7 @@ package Einfo is pragma Inline (In_Package_Body); pragma Inline (In_Private_Part); pragma Inline (In_Use); + pragma Inline (Initialization_Statements); pragma Inline (Inner_Instances); pragma Inline (Interface_Alias); pragma Inline (Interface_Name); @@ -8838,6 +8839,7 @@ package Einfo is pragma Inline (Is_Ada_2012_Only); pragma Inline (Is_Aggregate_Type); pragma Inline (Is_Aliased); + pragma Inline (Is_Anonymous_Access_Type); pragma Inline (Is_Array_Type); pragma Inline (Is_Assignable); pragma Inline (Is_Asynchronous); @@ -9020,6 +9022,7 @@ package Einfo is pragma Inline (Next_Index); pragma Inline (Next_Inlined_Subprogram); pragma Inline (Next_Literal); + pragma Inline (Next_Stored_Discriminant); pragma Inline (No_Dynamic_Predicate_On_Actual); pragma Inline (No_Pool_Assigned); pragma Inline (No_Predicate_On_Actual); @@ -9138,12 +9141,80 @@ package Einfo is pragma Inline (Was_Hidden); pragma Inline (Wrapped_Entity); - pragma Inline (Init_Alignment); - pragma Inline (Init_Component_Bit_Offset); - pragma Inline (Init_Component_Size); - pragma Inline (Init_Digits_Value); - pragma Inline (Init_Esize); - pragma Inline (Init_RM_Size); + -- END XEINFO INLINES + + -- The following Inline pragmas are *not* read by XEINFO when building the + -- C version of this interface automatically (so the C version will end up + -- making out of line calls). The pragma scan in XEINFO will be terminated + -- on encountering the END XEINFO INLINES line. We inline things here which + -- are small, but not of the canonical attribute access/set format that can + -- be handled by XEINFO. + + pragma Inline (Address_Clause); + pragma Inline (Alignment_Clause); + pragma Inline (Base_Type); + pragma Inline (Float_Rep); + pragma Inline (Has_Foreign_Convention); + pragma Inline (Has_Non_Limited_View); + pragma Inline (Is_Base_Type); + pragma Inline (Is_Boolean_Type); + pragma Inline (Is_Constant_Object); + pragma Inline (Is_Controlled); + pragma Inline (Is_Discriminal); + pragma Inline (Is_Entity_Name); + pragma Inline (Is_Finalizer); + pragma Inline (Is_Null_State); + pragma Inline (Is_Package_Or_Generic_Package); + pragma Inline (Is_Packed_Array); + pragma Inline (Is_Prival); + pragma Inline (Is_Protected_Component); + pragma Inline (Is_Protected_Record_Type); + pragma Inline (Is_String_Type); + pragma Inline (Is_Subprogram_Or_Entry); + pragma Inline (Is_Subprogram_Or_Generic_Subprogram); + pragma Inline (Is_Task_Record_Type); + pragma Inline (Is_Volatile); + pragma Inline (Is_Wrapper_Package); + pragma Inline (Scope_Depth); + pragma Inline (Scope_Depth_Set); + pragma Inline (Size_Clause); + pragma Inline (Stream_Size_Clause); + pragma Inline (Type_High_Bound); + pragma Inline (Type_Low_Bound); + + pragma Inline (Known_Alignment); + pragma Inline (Known_Component_Bit_Offset); + pragma Inline (Known_Component_Size); + pragma Inline (Known_Esize); + pragma Inline (Known_Normalized_First_Bit); + pragma Inline (Known_Normalized_Position); + pragma Inline (Known_Normalized_Position_Max); + pragma Inline (Known_RM_Size); + + pragma Inline (Known_Static_Component_Bit_Offset); + pragma Inline (Known_Static_Component_Size); + pragma Inline (Known_Static_Esize); + pragma Inline (Known_Static_Normalized_First_Bit); + pragma Inline (Known_Static_Normalized_Position); + pragma Inline (Known_Static_Normalized_Position_Max); + pragma Inline (Known_Static_RM_Size); + + pragma Inline (Unknown_Alignment); + pragma Inline (Unknown_Component_Bit_Offset); + pragma Inline (Unknown_Component_Size); + pragma Inline (Unknown_Esize); + pragma Inline (Unknown_Normalized_First_Bit); + pragma Inline (Unknown_Normalized_Position); + pragma Inline (Unknown_Normalized_Position_Max); + pragma Inline (Unknown_RM_Size); + + ----------------------------------- + -- Inline Pragmas for procedures -- + ----------------------------------- + + -- The following inline pragmas are *not* referenced by the XEINFO utility + -- program in preparing the corresponding C header, and therefore do *not* + -- need to meet the requirements documented in the section on XEINFO. pragma Inline (Set_Abstract_States); pragma Inline (Set_Accept_Address); @@ -9185,6 +9256,8 @@ package Einfo is pragma Inline (Set_Corresponding_Concurrent_Type); pragma Inline (Set_Corresponding_Discriminant); pragma Inline (Set_Corresponding_Equality); + pragma Inline (Set_Corresponding_Function); + pragma Inline (Set_Corresponding_Procedure); pragma Inline (Set_Corresponding_Protected_Entry); pragma Inline (Set_Corresponding_Record_Component); pragma Inline (Set_Corresponding_Record_Type); @@ -9244,6 +9317,7 @@ package Einfo is pragma Inline (Set_Extra_Constrained); pragma Inline (Set_Extra_Formal); pragma Inline (Set_Extra_Formals); + pragma Inline (Set_Finalize_Storage_Only); pragma Inline (Set_Finalization_Master); pragma Inline (Set_Finalizer); pragma Inline (Set_First_Entity); @@ -9252,6 +9326,7 @@ package Einfo is pragma Inline (Set_First_Literal); pragma Inline (Set_First_Private_Entity); pragma Inline (Set_First_Rep_Item); + pragma Inline (Set_Float_Rep); pragma Inline (Set_Freeze_Node); pragma Inline (Set_From_Limited_With); pragma Inline (Set_Full_View); @@ -9359,6 +9434,7 @@ package Einfo is pragma Inline (Set_In_Package_Body); pragma Inline (Set_In_Private_Part); pragma Inline (Set_In_Use); + pragma Inline (Set_Initialization_Statements); pragma Inline (Set_Inner_Instances); pragma Inline (Set_Interface_Alias); pragma Inline (Set_Interface_Name); @@ -9627,31 +9703,14 @@ package Einfo is pragma Inline (Set_Was_Hidden); pragma Inline (Set_Wrapped_Entity); - -- END XEINFO INLINES - - -- The following Inline pragmas are *not* read by xeinfo when building the - -- C version of this interface automatically (so the C version will end up - -- making out of line calls). The pragma scan in xeinfo will be terminated - -- on encountering the END XEINFO INLINES line. We inline things here which - -- are small, but not of the canonical attribute access/set format that can - -- be handled by xeinfo. - - pragma Inline (Base_Type); - pragma Inline (Is_Base_Type); - pragma Inline (Is_Boolean_Type); - pragma Inline (Is_Controlled); - pragma Inline (Is_Entity_Name); - pragma Inline (Is_Package_Or_Generic_Package); - pragma Inline (Is_Packed_Array); - pragma Inline (Is_String_Type); - pragma Inline (Is_Subprogram_Or_Generic_Subprogram); - pragma Inline (Is_Volatile); - pragma Inline (Is_Wrapper_Package); - pragma Inline (Known_RM_Size); - pragma Inline (Known_Static_Component_Bit_Offset); - pragma Inline (Known_Static_RM_Size); - pragma Inline (Scope_Depth); - pragma Inline (Scope_Depth_Set); - pragma Inline (Unknown_RM_Size); + pragma Inline (Init_Alignment); + pragma Inline (Init_Component_Bit_Offset); + pragma Inline (Init_Component_Size); + pragma Inline (Init_Digits_Value); + pragma Inline (Init_Esize); + pragma Inline (Init_Normalized_First_Bit); + pragma Inline (Init_Normalized_Position); + pragma Inline (Init_Normalized_Position_Max); + pragma Inline (Init_RM_Size); end Einfo; -- 2.7.4