Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                                E I N F O                                 --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2012, 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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --

--                                                                          --

-- As a special exception under Section 7 of GPL version 3, you are granted --

-- additional permissions described in the GCC Runtime Library Exception,   --

-- version 3.1, as published by the Free Software Foundation.               --

--                                                                          --

-- You should have received a copy of the GNU General Public License and    --

-- a copy of the GCC Runtime Library Exception along with this program;     --

-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --

-- <http://www.gnu.org/licenses/>.                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

pragma Style_Checks (All_Checks);

--  Turn off subprogram ordering, not used for this unit

with Atree;    use Atree;

with Nlists;   use Nlists;

with Output;   use Output;

with Sinfo;    use Sinfo;

with Stand;    use Stand;

package body Einfo is

   use Atree.Unchecked_Access;

   --  This is one of the packages that is allowed direct untyped access to

   --  the fields in a node, since it provides the next level abstraction

   --  which incorporates appropriate checks.

   ----------------------------------------------

   -- Usage of Fields in Defining Entity Nodes --

   ----------------------------------------------

   --  Four of these fields are defined in Sinfo, since they in are the base

   --  part of the node. The access routines for these four fields and the

   --  corresponding set procedures are defined in Sinfo. These fields are

   --  present in all entities. Note that Homonym is also in the base part of

   --  the node, but has access routines that are more properly part of Einfo,

   --  which is why they are defined here.

   --    Chars                           Name1

   --    Next_Entity                     Node2

   --    Scope                           Node3

   --    Etype                           Node5

   --   Remaining fields are present only in extended nodes (i.e. entities)

   --  The following fields are present in all entities

   --    Homonym                         Node4

   --    First_Rep_Item                  Node6

   --    Freeze_Node                     Node7

   --  The usage of other fields (and the entity kinds to which it applies)

   --  depends on the particular field (see Einfo spec for details).

   --    Associated_Node_For_Itype       Node8

   --    Dependent_Instances             Elist8

   --    Hiding_Loop_Variable            Node8

   --    Mechanism                       Uint8 (but returns Mechanism_Type)

   --    Normalized_First_Bit            Uint8

   --    Postcondition_Proc              Node8

   --    Return_Applies_To               Node8

   --    First_Exit_Statement            Node8

   --    Class_Wide_Type                 Node9

   --    Current_Value                   Node9

   --    Renaming_Map                    Uint9

   --    Direct_Primitive_Operations     Elist10

   --    Discriminal_Link                Node10

   --    Float_Rep                       Uint10 (but returns Float_Rep_Kind)

   --    Handler_Records                 List10

   --    Normalized_Position_Max         Uint10

   --    Component_Bit_Offset            Uint11

   --    Full_View                       Node11

   --    Entry_Component                 Node11

   --    Enumeration_Pos                 Uint11

   --    Generic_Homonym                 Node11

   --    Protected_Body_Subprogram       Node11

   --    Block_Node                      Node11

   --    Barrier_Function                Node12

   --    Enumeration_Rep                 Uint12

   --    Esize                           Uint12

   --    Next_Inlined_Subprogram         Node12

   --    Corresponding_Equality          Node13

   --    Component_Clause                Node13

   --    Elaboration_Entity              Node13

   --    Extra_Accessibility             Node13

   --    RM_Size                         Uint13

   --    Alignment                       Uint14

   --    First_Optional_Parameter        Node14

   --    Normalized_Position             Uint14

   --    Shadow_Entities                 List14

   --    Discriminant_Number             Uint15

   --    DT_Position                     Uint15

   --    DT_Entry_Count                  Uint15

   --    Entry_Bodies_Array              Node15

   --    Entry_Parameters_Type           Node15

   --    Extra_Formal                    Node15

   --    Lit_Indexes                     Node15

   --    Related_Instance                Node15

   --    Return_Flag_Or_Transient_Decl   Node15

   --    Scale_Value                     Uint15

   --    Storage_Size_Variable           Node15

   --    String_Literal_Low_Bound        Node15

   --    Access_Disp_Table               Elist16

   --    Cloned_Subtype                  Node16

   --    DTC_Entity                      Node16

   --    Entry_Formal                    Node16

   --    First_Private_Entity            Node16

   --    Lit_Strings                     Node16

   --    String_Literal_Length           Uint16

   --    Unset_Reference                 Node16

   --    Actual_Subtype                  Node17

   --    Digits_Value                    Uint17

   --    Discriminal                     Node17

   --    First_Entity                    Node17

   --    First_Index                     Node17

   --    First_Literal                   Node17

   --    Master_Id                       Node17

   --    Modulus                         Uint17

   --    Non_Limited_View                Node17

   --    Prival                          Node17

   --    Alias                           Node18

   --    Corresponding_Concurrent_Type   Node18

   --    Corresponding_Protected_Entry   Node18

   --    Corresponding_Record_Type       Node18

   --    Delta_Value                     Ureal18

   --    Enclosing_Scope                 Node18

   --    Equivalent_Type                 Node18

   --    Private_Dependents              Elist18

   --    Renamed_Entity                  Node18

   --    Renamed_Object                  Node18

   --    Body_Entity                     Node19

   --    Corresponding_Discriminant      Node19

   --    Default_Aspect_Component_Value  Node19

   --    Default_Aspect_Value            Node19

   --    Extra_Accessibility_Of_Result   Node19

   --    Parent_Subtype                  Node19

   --    Size_Check_Code                 Node19

   --    Spec_Entity                     Node19

   --    Underlying_Full_View            Node19

   --    Component_Type                  Node20

   --    Default_Value                   Node20

   --    Directly_Designated_Type        Node20

   --    Discriminant_Checking_Func      Node20

   --    Discriminant_Default_Value      Node20

   --    Last_Entity                     Node20

   --    Prival_Link                     Node20

   --    Register_Exception_Call         Node20

   --    Scalar_Range                    Node20

   --    Accept_Address                  Elist21

   --    Default_Expr_Function           Node21

   --    Discriminant_Constraint         Elist21

   --    Interface_Name                  Node21

   --    Original_Array_Type             Node21

   --    Small_Value                     Ureal21

   --    Associated_Storage_Pool         Node22

   --    Component_Size                  Uint22

   --    Corresponding_Remote_Type       Node22

   --    Enumeration_Rep_Expr            Node22

   --    Exception_Code                  Uint22

   --    Original_Record_Component       Node22

   --    Private_View                    Node22

   --    Protected_Formal                Node22

   --    Scope_Depth_Value               Uint22

   --    Shared_Var_Procs_Instance       Node22

   --    CR_Discriminant                 Node23

   --    Entry_Cancel_Parameter          Node23

   --    Enum_Pos_To_Rep                 Node23

   --    Extra_Constrained               Node23

   --    Finalization_Master             Node23

   --    Generic_Renamings               Elist23

   --    Inner_Instances                 Elist23

   --    Limited_View                    Node23

   --    Packed_Array_Type               Node23

   --    Protection_Object               Node23

   --    Stored_Constraint               Elist23

   --    Finalizer                       Node24

   --    Related_Expression              Node24

   --    Contract                        Node24

   --    Interface_Alias                 Node25

   --    Interfaces                      Elist25

   --    Debug_Renaming_Link             Node25

   --    DT_Offset_To_Top_Func           Node25

   --    PPC_Wrapper                     Node25

   --    Related_Array_Object            Node25

   --    Static_Predicate                List25

   --    Task_Body_Procedure             Node25

   --    Dispatch_Table_Wrappers         Elist26

   --    Last_Assignment                 Node26

   --    Original_Access_Type            Node26

   --    Overridden_Operation            Node26

   --    Package_Instantiation           Node26

   --    Relative_Deadline_Variable      Node26

   --    Static_Initialization           Node26

   --    Current_Use_Clause              Node27

   --    Related_Type                    Node27

   --    Wrapped_Entity                  Node27

   --    Extra_Formals                   Node28

   --    Underlying_Record_View          Node28

   --    Subprograms_For_Type            Node29

   ---------------------------------------------

   -- Usage of Flags in Defining Entity Nodes --

   ---------------------------------------------

   --  All flags are unique, there is no overlaying, so each flag is physically

   --  present in every entity. However, for many of the flags, it only makes

   --  sense for them to be set true for certain subsets of entity kinds. See

   --  the spec of Einfo for further details.

   --  Note: Flag1-Flag3 are absent from this list, for historical reasons

   --    Is_Frozen                       Flag4

   --    Has_Discriminants               Flag5

   --    Is_Dispatching_Operation        Flag6

   --    Is_Immediately_Visible          Flag7

   --    In_Use                          Flag8

   --    Is_Potentially_Use_Visible      Flag9

   --    Is_Public                       Flag10

   --    Is_Inlined                      Flag11

   --    Is_Constrained                  Flag12

   --    Is_Generic_Type                 Flag13

   --    Depends_On_Private              Flag14

   --    Is_Aliased                      Flag15

   --    Is_Volatile                     Flag16

   --    Is_Internal                     Flag17

   --    Has_Delayed_Freeze              Flag18

   --    Is_Abstract_Subprogram          Flag19

   --    Is_Concurrent_Record_Type       Flag20

   --    Has_Master_Entity               Flag21

   --    Needs_No_Actuals                Flag22

   --    Has_Storage_Size_Clause         Flag23

   --    Is_Imported                     Flag24

   --    Is_Limited_Record               Flag25

   --    Has_Completion                  Flag26

   --    Has_Pragma_Controlled           Flag27

   --    Is_Statically_Allocated         Flag28

   --    Has_Size_Clause                 Flag29

   --    Has_Task                        Flag30

   --    Checks_May_Be_Suppressed        Flag31

   --    Kill_Elaboration_Checks         Flag32

   --    Kill_Range_Checks               Flag33

   --    Kill_Tag_Checks                 Flag34

   --    Is_Class_Wide_Equivalent_Type   Flag35

   --    Referenced_As_LHS               Flag36

   --    Is_Known_Non_Null               Flag37

   --    Can_Never_Be_Null               Flag38

   --    Has_Default_Aspect              Flag39

   --    Body_Needed_For_SAL             Flag40

   --    Treat_As_Volatile               Flag41

   --    Is_Controlled                   Flag42

   --    Has_Controlled_Component        Flag43

   --    Is_Pure                         Flag44

   --    In_Private_Part                 Flag45

   --    Has_Alignment_Clause            Flag46

   --    Has_Exit                        Flag47

   --    In_Package_Body                 Flag48

   --    Reachable                       Flag49

   --    Delay_Subprogram_Descriptors    Flag50

   --    Is_Packed                       Flag51

   --    Is_Entry_Formal                 Flag52

   --    Is_Private_Descendant           Flag53

   --    Return_Present                  Flag54

   --    Is_Tagged_Type                  Flag55

   --    Has_Homonym                     Flag56

   --    Is_Hidden                       Flag57

   --    Non_Binary_Modulus              Flag58

   --    Is_Preelaborated                Flag59

   --    Is_Shared_Passive               Flag60

   --    Is_Remote_Types                 Flag61

   --    Is_Remote_Call_Interface        Flag62

   --    Is_Character_Type               Flag63

   --    Is_Intrinsic_Subprogram         Flag64

   --    Has_Record_Rep_Clause           Flag65

   --    Has_Enumeration_Rep_Clause      Flag66

   --    Has_Small_Clause                Flag67

   --    Has_Component_Size_Clause       Flag68

   --    Is_Access_Constant              Flag69

   --    Is_First_Subtype                Flag70

   --    Has_Completion_In_Body          Flag71

   --    Has_Unknown_Discriminants       Flag72

   --    Is_Child_Unit                   Flag73

   --    Is_CPP_Class                    Flag74

   --    Has_Non_Standard_Rep            Flag75

   --    Is_Constructor                  Flag76

   --    Static_Elaboration_Desired      Flag77

   --    Is_Tag                          Flag78

   --    Has_All_Calls_Remote            Flag79

   --    Is_Constr_Subt_For_U_Nominal    Flag80

   --    Is_Asynchronous                 Flag81

   --    Has_Gigi_Rep_Item               Flag82

   --    Has_Machine_Radix_Clause        Flag83

   --    Machine_Radix_10                Flag84

   --    Is_Atomic                       Flag85

   --    Has_Atomic_Components           Flag86

   --    Has_Volatile_Components         Flag87

   --    Discard_Names                   Flag88

   --    Is_Interrupt_Handler            Flag89

   --    Returns_By_Ref                  Flag90

   --    Is_Itype                        Flag91

   --    Size_Known_At_Compile_Time      Flag92

   --    Has_Subprogram_Descriptor       Flag93

   --    Is_Generic_Actual_Type          Flag94

   --    Uses_Sec_Stack                  Flag95

   --    Warnings_Off                    Flag96

   --    Is_Controlling_Formal           Flag97

   --    Has_Controlling_Result          Flag98

   --    Is_Exported                     Flag99

   --    Has_Specified_Layout            Flag100

   --    Has_Nested_Block_With_Handler   Flag101

   --    Is_Called                       Flag102

   --    Is_Completely_Hidden            Flag103

   --    Address_Taken                   Flag104

   --    Suppress_Initialization         Flag105

   --    Is_Limited_Composite            Flag106

   --    Is_Private_Composite            Flag107

   --    Default_Expressions_Processed   Flag108

   --    Is_Non_Static_Subtype           Flag109

   --    Has_External_Tag_Rep_Clause     Flag110

   --    Is_Formal_Subprogram            Flag111

   --    Is_Renaming_Of_Object           Flag112

   --    No_Return                       Flag113

   --    Delay_Cleanups                  Flag114

   --    Never_Set_In_Source             Flag115

   --    Is_Visible_Child_Unit           Flag116

   --    Is_Unchecked_Union              Flag117

   --    Is_For_Access_Subtype           Flag118

   --    Has_Convention_Pragma           Flag119

   --    Has_Primitive_Operations        Flag120

   --    Has_Pragma_Pack                 Flag121

   --    Is_Bit_Packed_Array             Flag122

   --    Has_Unchecked_Union             Flag123

   --    Is_Eliminated                   Flag124

   --    C_Pass_By_Copy                  Flag125

   --    Is_Instantiated                 Flag126

   --    Is_Valued_Procedure             Flag127

   --    (used for Component_Alignment)  Flag128

   --    (used for Component_Alignment)  Flag129

   --    Is_Generic_Instance             Flag130

   --    No_Pool_Assigned                Flag131

   --    Is_AST_Entry                    Flag132

   --    Is_VMS_Exception                Flag133

   --    Is_Optional_Parameter           Flag134

   --    Has_Aliased_Components          Flag135

   --    No_Strict_Aliasing              Flag136

   --    Is_Machine_Code_Subprogram      Flag137

   --    Is_Packed_Array_Type            Flag138

   --    Has_Biased_Representation       Flag139

   --    Has_Complex_Representation      Flag140

   --    Is_Constr_Subt_For_UN_Aliased   Flag141

   --    Has_Missing_Return              Flag142

   --    Has_Recursive_Call              Flag143

   --    Is_Unsigned_Type                Flag144

   --    Strict_Alignment                Flag145

   --    Is_Abstract_Type                Flag146

   --    Needs_Debug_Info                Flag147

   --    Suppress_Elaboration_Warnings   Flag148

   --    Is_Compilation_Unit             Flag149

   --    Has_Pragma_Elaborate_Body       Flag150

   --    Has_Private_Ancestor            Flag151

   --    Entry_Accepted                  Flag152

   --    Is_Obsolescent                  Flag153

   --    Has_Per_Object_Constraint       Flag154

   --    Has_Private_Declaration         Flag155

   --    Referenced                      Flag156

   --    Has_Pragma_Inline               Flag157

   --    Finalize_Storage_Only           Flag158

   --    From_With_Type                  Flag159

   --    Is_Package_Body_Entity          Flag160

   --    Has_Qualified_Name              Flag161

   --    Nonzero_Is_True                 Flag162

   --    Is_True_Constant                Flag163

   --    Reverse_Bit_Order               Flag164

   --    Suppress_Style_Checks           Flag165

   --    Debug_Info_Off                  Flag166

   --    Sec_Stack_Needed_For_Return     Flag167

   --    Materialize_Entity              Flag168

   --    Has_Pragma_Thread_Local_Storage Flag169

   --    Is_Known_Valid                  Flag170

   --    Is_Hidden_Open_Scope            Flag171

   --    Has_Object_Size_Clause          Flag172

   --    Has_Fully_Qualified_Name        Flag173

   --    Elaboration_Entity_Required     Flag174

   --    Has_Forward_Instantiation       Flag175

   --    Is_Discrim_SO_Function          Flag176

   --    Size_Depends_On_Discriminant    Flag177

   --    Is_Null_Init_Proc               Flag178

   --    Has_Pragma_Pure_Function        Flag179

   --    Has_Pragma_Unreferenced         Flag180

   --    Has_Contiguous_Rep              Flag181

   --    Has_Xref_Entry                  Flag182

   --    Must_Be_On_Byte_Boundary        Flag183

   --    Has_Stream_Size_Clause          Flag184

   --    Is_Ada_2005_Only                Flag185

   --    Is_Interface                    Flag186

   --    Has_Constrained_Partial_View    Flag187

   --    Has_Persistent_BSS              Flag188

   --    Is_Pure_Unit_Access_Type        Flag189

   --    Has_Specified_Stream_Input      Flag190

   --    Has_Specified_Stream_Output     Flag191

   --    Has_Specified_Stream_Read       Flag192

   --    Has_Specified_Stream_Write      Flag193

   --    Is_Local_Anonymous_Access       Flag194

   --    Is_Primitive_Wrapper            Flag195

   --    Was_Hidden                      Flag196

   --    Is_Limited_Interface            Flag197

   --    Has_Pragma_Ordered              Flag198

   --    Is_Ada_2012_Only                Flag199

   --    Has_Delayed_Aspects             Flag200

   --    Has_Anon_Block_Suffix           Flag201

   --    Itype_Printed                   Flag202

   --    Has_Pragma_Pure                 Flag203

   --    Is_Known_Null                   Flag204

   --    Low_Bound_Tested                Flag205

   --    Is_Visible_Formal               Flag206

   --    Known_To_Have_Preelab_Init      Flag207

   --    Must_Have_Preelab_Init          Flag208

   --    Is_Return_Object                Flag209

   --    Elaborate_Body_Desirable        Flag210

   --    Has_Static_Discriminants        Flag211

   --    Has_Pragma_Unreferenced_Objects Flag212

   --    Requires_Overriding             Flag213

   --    Has_RACW                        Flag214

   --    Has_Up_Level_Access             Flag215

   --    Universal_Aliasing              Flag216

   --    Suppress_Value_Tracking_On_Call Flag217

   --    Is_Primitive                    Flag218

   --    Has_Initial_Value               Flag219

   --    Has_Dispatch_Table              Flag220

   --    Has_Pragma_Preelab_Init         Flag221

   --    Used_As_Generic_Actual          Flag222

   --    Is_Descendent_Of_Address        Flag223

   --    Is_Raised                       Flag224

   --    Is_Thunk                        Flag225

   --    Is_Only_Out_Parameter           Flag226

   --    Referenced_As_Out_Parameter     Flag227

   --    Has_Thunks                      Flag228

   --    Can_Use_Internal_Rep            Flag229

   --    Has_Pragma_Inline_Always        Flag230

   --    Renamed_In_Spec                 Flag231

   --    Has_Invariants                  Flag232

   --    Has_Pragma_Unmodified           Flag233

   --    Is_Dispatch_Table_Entity        Flag234

   --    Is_Trivial_Subprogram           Flag235

   --    Warnings_Off_Used               Flag236

   --    Warnings_Off_Used_Unmodified    Flag237

   --    Warnings_Off_Used_Unreferenced  Flag238

   --    OK_To_Reorder_Components        Flag239

   --    Has_Postconditions              Flag240

   --    Optimize_Alignment_Space        Flag241

   --    Optimize_Alignment_Time         Flag242

   --    Overlays_Constant               Flag243

   --    Is_RACW_Stub_Type               Flag244

   --    Is_Private_Primitive            Flag245

   --    Is_Underlying_Record_View       Flag246

   --    OK_To_Rename                    Flag247

   --    Has_Inheritable_Invariants      Flag248

   --    Is_Safe_To_Reevaluate           Flag249

   --    Has_Predicates                  Flag250

   --    Has_Implicit_Dereference        Flag251

   --    Is_Processed_Transient          Flag252

   --    Has_Anonymous_Master            Flag253

   --    Is_Implementation_Defined       Flag254

   -----------------------

   -- Local subprograms --

   -----------------------

   function Rep_Clause (Id : E; Rep_Name : Name_Id) return N;

   --  Returns the attribute definition clause for Id whose name is Rep_Name.

   --  Returns Empty if no matching attribute definition clause found for Id.

   ---------------

   -- Float_Rep --

   ---------------

   function Float_Rep (Id : E) return F is

      pragma Assert (Is_Floating_Point_Type (Id));

   begin

      return F'Val (UI_To_Int (Uint10 (Base_Type (Id))));

   end Float_Rep;

   ----------------

   -- Rep_Clause --

   ----------------

   function Rep_Clause (Id : E; Rep_Name : Name_Id) return N is

      Ritem : Node_Id;

   begin

      Ritem := First_Rep_Item (Id);

      while Present (Ritem) loop

         if Nkind (Ritem) = N_Attribute_Definition_Clause

           and then Chars (Ritem) = Rep_Name

         then

            return Ritem;

         else

            Next_Rep_Item (Ritem);

         end if;

      end loop;

      return Empty;

   end Rep_Clause;

   --------------------------------

   -- Attribute Access Functions --

   --------------------------------

   function Accept_Address (Id : E) return L is

   begin

      return Elist21 (Id);

   end Accept_Address;

   function Access_Disp_Table (Id : E) return L is

   begin

      pragma Assert (Ekind_In (Id, E_Record_Type,

                                   E_Record_Subtype));

      return Elist16 (Implementation_Base_Type (Id));

   end Access_Disp_Table;

   function Actual_Subtype (Id : E) return E is

   begin

      pragma Assert

        (Ekind_In (Id, E_Constant, E_Variable, E_Generic_In_Out_Parameter)

           or else Is_Formal (Id));

      return Node17 (Id);

   end Actual_Subtype;

   function Address_Taken (Id : E) return B is

   begin

      return Flag104 (Id);

   end Address_Taken;

   function Alias (Id : E) return E is

   begin

      pragma Assert

        (Is_Overloadable (Id) or else Ekind (Id) = E_Subprogram_Type);

      return Node18 (Id);

   end Alias;

   function Alignment (Id : E) return U is

   begin

      pragma Assert (Is_Type (Id)

                       or else Is_Formal (Id)

                       or else Ekind_In (Id, E_Loop_Parameter,

                                             E_Constant,

                                             E_Exception,

                                             E_Variable));

      return Uint14 (Id);

   end Alignment;

   function Associated_Formal_Package (Id : E) return E is

   begin

      pragma Assert (Ekind (Id) = E_Package);

      return Node12 (Id);

   end Associated_Formal_Package;

   function Associated_Node_For_Itype (Id : E) return N is

   begin

      return Node8 (Id);

   end Associated_Node_For_Itype;

   function Associated_Storage_Pool (Id : E) return E is

   begin

      pragma Assert (Is_Access_Type (Id));

      return Node22 (Root_Type (Id));

   end Associated_Storage_Pool;

   function Barrier_Function (Id : E) return N is

   begin

      pragma Assert (Is_Entry (Id));

      return Node12 (Id);

   end Barrier_Function;

   function Block_Node (Id : E) return N is

   begin

      pragma Assert (Ekind (Id) = E_Block);

      return Node11 (Id);

   end Block_Node;

   function Body_Entity (Id : E) return E is

   begin

      pragma Assert (Ekind_In (Id, E_Package, E_Generic_Package));

      return Node19 (Id);

   end Body_Entity;

   function Body_Needed_For_SAL (Id : E) return B is

   begin

      pragma Assert

        (Ekind (Id) = E_Package

           or else Is_Subprogram (Id)

           or else Is_Generic_Unit (Id));

      return Flag40 (Id);

   end Body_Needed_For_SAL;

   function C_Pass_By_Copy (Id : E) return B is

   begin

      pragma Assert (Is_Record_Type (Id));

      return Flag125 (Implementation_Base_Type (Id));

   end C_Pass_By_Copy;

   function Can_Never_Be_Null (Id : E) return B is

   begin

      return Flag38 (Id);

   end Can_Never_Be_Null;

   function Checks_May_Be_Suppressed (Id : E) return B is

   begin

      return Flag31 (Id);

   end Checks_May_Be_Suppressed;

   function Class_Wide_Type (Id : E) return E is

   begin

      pragma Assert (Is_Type (Id));

      return Node9 (Id);

   end Class_Wide_Type;

   function Cloned_Subtype (Id : E) return E is

   begin

      pragma Assert (Ekind_In (Id, E_Record_Subtype, E_Class_Wide_Subtype));

      return Node16 (Id);

   end Cloned_Subtype;

   function Component_Bit_Offset (Id : E) return U is

   begin

      pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));

      return Uint11 (Id);

   end Component_Bit_Offset;

   function Component_Clause (Id : E) return N is

   begin

      pragma Assert (Ekind_In (Id, E_Component, E_Discriminant));

      return Node13 (Id);

   end Component_Clause;

   function Component_Size (Id : E) return U is

   begin

      pragma Assert (Is_Array_Type (Id));

      return Uint22 (Implementation_Base_Type (Id));

   end Component_Size;

   function Component_Type (Id : E) return E is

   begin

      pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));

      return Node20 (Implementation_Base_Type (Id));

   end Component_Type;

   function Corresponding_Concurrent_Type (Id : E) return E is

   begin

      pragma Assert (Ekind (Id) = E_Record_Type);

      return Node18 (Id);

   end Corresponding_Concurrent_Type;

   function Corresponding_Discriminant (Id : E) return E is

   begin

      pragma Assert (Ekind (Id) = E_Discriminant);

      return Node19 (Id);

   end Corresponding_Discriminant;

   function Corresponding_Equality (Id : E) return E is

   begin

      pragma Assert

        (Ekind (Id) = E_Function

          and then not Comes_From_Source (Id)

          and then Chars (Id) = Name_Op_Ne);

      return Node13 (Id);

   end Corresponding_Equality;

   function Corresponding_Protected_Entry (Id : E) return E is

   begin

      pragma Assert (Ekind (Id) = E_Subprogram_Body);

      return Node18 (Id);

   end Corresponding_Protected_Entry;

   function Corresponding_Record_Type (Id : E) return E is

   begin

      pragma Assert (Is_Concurrent_Type (Id));

      return Node18 (Id);

   end Corresponding_Record_Type;

   function Corresponding_Remote_Type (Id : E) return E is

   begin

      return Node22 (Id);

   end Corresponding_Remote_Type;

   function Current_Use_Clause (Id : E) return E is

   begin

      pragma Assert (Ekind (Id) = E_Package or else Is_Type (Id));

      return Node27 (Id);

   end Current_Use_Clause;

   function Current_Value (Id : E) return N is

   begin

      pragma Assert (Ekind (Id) in Object_Kind);

      return Node9 (Id);

   end Current_Value;

   function CR_Discriminant (Id : E) return E is

   begin

      return Node23 (Id);

   end CR_Discriminant;

   function Debug_Info_Off (Id : E) return B is

   begin

      return Flag166 (Id);

   end Debug_Info_Off;

   function Debug_Renaming_Link (Id : E) return E is

   begin

      return Node25 (Id);

   end Debug_Renaming_Link;

   function Default_Aspect_Component_Value (Id : E) return N is

   begin

      pragma Assert (Is_Array_Type (Id));

      return Node19 (Id);

   end Default_Aspect_Component_Value;

   function Default_Aspect_Value (Id : E) return N is

   begin

      pragma Assert (Is_Scalar_Type (Id));