[multiple changes]
[gcc.git] / gcc / ada / einfo.adb
index e215df9eb9d59cc6cd2a90a8231bee2723eed2e9..f364960fe0fd7581039969a91cb7d229d92e45a0 100644 (file)
@@ -70,6 +70,7 @@ package body Einfo is
    --    Homonym                         Node4
    --    First_Rep_Item                  Node6
    --    Freeze_Node                     Node7
+   --    Associated_Entity               Node37
 
    --  The usage of other fields (and the entity kinds to which it applies)
    --  depends on the particular field (see Einfo spec for details).
@@ -88,7 +89,6 @@ package body Einfo is
    --    Part_Of_Constituents            Elist9
    --    Renaming_Map                    Uint9
 
-   --    Encapsulating_State             Node10
    --    Direct_Primitive_Operations     Elist10
    --    Discriminal_Link                Node10
    --    Float_Rep                       Uint10 (but returns Float_Rep_Kind)
@@ -146,7 +146,6 @@ package body Einfo is
    --    First_Literal                   Node17
    --    Master_Id                       Node17
    --    Modulus                         Uint17
-   --    Non_Limited_View                Node17
    --    Prival                          Node17
 
    --    Alias                           Node18
@@ -168,6 +167,7 @@ package body Einfo is
    --    Default_Aspect_Value            Node19
    --    Entry_Bodies_Array              Node19
    --    Extra_Accessibility_Of_Result   Node19
+   --    Non_Limited_View                Node19
    --    Parent_Subtype                  Node19
    --    Size_Check_Code                 Node19
    --    Spec_Entity                     Node19
@@ -213,13 +213,12 @@ package body Einfo is
    --    Stored_Constraint               Elist23
 
    --    Related_Expression              Node24
-   --    Uplevel_References              Elist24
    --    Subps_Index                     Uint24
 
-   --    Interface_Alias                 Node25
-   --    Interfaces                      Elist25
    --    Debug_Renaming_Link             Node25
    --    DT_Offset_To_Top_Func           Node25
+   --    Interface_Alias                 Node25
+   --    Interfaces                      Elist25
    --    PPC_Wrapper                     Node25
    --    Related_Array_Object            Node25
    --    Static_Discrete_Predicate       List25
@@ -254,6 +253,7 @@ package body Einfo is
    --    Thunk_Entity                    Node31
    --    Activation_Record_Component     Node31
 
+   --    Encapsulating_State             Node32
    --    SPARK_Pragma                    Node32
    --    No_Tagged_Streams_Pragma        Node32
 
@@ -264,6 +264,12 @@ package body Einfo is
 
    --    Import_Pragma                   Node35
 
+   --    (unused)                        Node36
+   --    (unused)                        Node38
+   --    (unused)                        Node39
+   --    (unused)                        Node40
+   --    (unused)                        Node41
+
    ---------------------------------------------
    -- Usage of Flags in Defining Entity Nodes --
    ---------------------------------------------
@@ -583,7 +589,7 @@ package body Einfo is
 
    --    Is_Static_Type                  Flag281
    --    Has_Nested_Subprogram           Flag282
-   --    Uplevel_Reference_Noted         Flag283
+   --    Is_Uplevel_Referenced_Entity    Flag283
    --    Is_Unimplemented                Flag284
 
    --    (unused)                        Flag285
@@ -747,6 +753,11 @@ package body Einfo is
       return Uint14 (Id);
    end Alignment;
 
+   function Associated_Entity (Id : E) return E is
+   begin
+      return Node37 (Id);
+   end Associated_Entity;
+
    function Associated_Formal_Package (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Package);
@@ -1105,8 +1116,8 @@ package body Einfo is
 
    function Encapsulating_State (Id : E) return N is
    begin
-      pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
-      return Node10 (Id);
+      pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
+      return Node32 (Id);
    end Encapsulating_State;
 
    function Enclosing_Scope (Id : E) return E is
@@ -1170,7 +1181,8 @@ package body Einfo is
                        E_Package,
                        E_Package_Body,
                        E_Subprogram_Body,
-                       E_Variable)
+                       E_Variable,
+                       E_Void)
           or else Is_Subprogram_Or_Generic_Subprogram (Id));
       return Node34 (Id);
    end Contract;
@@ -2411,7 +2423,6 @@ package body Einfo is
 
    function Is_Static_Type (Id : E) return B is
    begin
-      pragma Assert (Is_Type (Id));
       return Flag281 (Id);
    end Is_Static_Type;
 
@@ -2467,6 +2478,11 @@ package body Einfo is
       return Flag144 (Id);
    end Is_Unsigned_Type;
 
+   function Is_Uplevel_Referenced_Entity (Id : E) return B is
+   begin
+      return Flag283 (Id);
+   end Is_Uplevel_Referenced_Entity;
+
    function Is_Valued_Procedure (Id : E) return B is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -2676,8 +2692,12 @@ package body Einfo is
    function Non_Limited_View (Id : E) return E is
    begin
       pragma Assert
-        (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
-      return Node17 (Id);
+        (Ekind (Id) in Incomplete_Kind
+           or else
+         Ekind (Id) in Class_Wide_Kind
+           or else
+         Ekind (Id) = E_Abstract_State);
+      return Node19 (Id);
    end Non_Limited_View;
 
    function Nonzero_Is_True (Id : E) return B is
@@ -3238,17 +3258,6 @@ package body Einfo is
       return Node16 (Id);
    end Unset_Reference;
 
-   function Uplevel_Reference_Noted (Id : E) return B is
-   begin
-      return Flag283 (Id);
-   end Uplevel_Reference_Noted;
-
-   function Uplevel_References (Id : E) return L is
-   begin
-      pragma Assert (Is_Subprogram (Id));
-      return Elist24 (Id);
-   end Uplevel_References;
-
    function Used_As_Generic_Actual (Id : E) return B is
    begin
       return Flag222 (Id);
@@ -3555,6 +3564,11 @@ package body Einfo is
       Set_Elist16 (Id, V);
    end Set_Access_Disp_Table;
 
+   procedure Set_Associated_Entity (Id : E; V : E) is
+   begin
+      Set_Node37 (Id, V);
+   end Set_Associated_Entity;
+
    procedure Set_Associated_Formal_Package (Id : E; V : E) is
    begin
       Set_Node12 (Id, V);
@@ -3730,13 +3744,13 @@ package body Einfo is
    begin
       pragma Assert
         (Ekind_In (Id, E_Entry,
-                         E_Entry_Family,
-                         E_Generic_Package,
-                         E_Package,
-                         E_Package_Body,
-                         E_Subprogram_Body,
-                         E_Variable,
-                         E_Void)
+                       E_Entry_Family,
+                       E_Generic_Package,
+                       E_Package,
+                       E_Package_Body,
+                       E_Subprogram_Body,
+                       E_Variable,
+                       E_Void)
           or else Is_Subprogram_Or_Generic_Subprogram (Id));
       Set_Node34 (Id, V);
    end Set_Contract;
@@ -3990,8 +4004,8 @@ package body Einfo is
 
    procedure Set_Encapsulating_State (Id : E; V : E) is
    begin
-      pragma Assert (Ekind_In (Id, E_Abstract_State, E_Variable));
-      Set_Node10 (Id, V);
+      pragma Assert (Ekind_In (Id, E_Abstract_State, E_Constant, E_Variable));
+      Set_Node32 (Id, V);
    end Set_Encapsulating_State;
 
    procedure Set_Enclosing_Scope (Id : E; V : E) is
@@ -4449,11 +4463,6 @@ package body Einfo is
       Set_Flag282 (Id, V);
    end Set_Has_Nested_Subprogram;
 
-   procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
-   begin
-      Set_Flag215 (Id, V);
-   end Set_Has_Uplevel_Reference;
-
    procedure Set_Has_Non_Standard_Rep (Id : E; V : B := True) is
    begin
       pragma Assert (Id = Base_Type (Id));
@@ -4704,6 +4713,11 @@ package body Einfo is
       Set_Flag72 (Id, V);
    end Set_Has_Unknown_Discriminants;
 
+   procedure Set_Has_Uplevel_Reference (Id : E; V : B := True) is
+   begin
+      Set_Flag215 (Id, V);
+   end Set_Has_Uplevel_Reference;
+
    procedure Set_Has_Visible_Refinement (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Abstract_State);
@@ -5414,6 +5428,15 @@ package body Einfo is
       Set_Flag144 (Id, V);
    end Set_Is_Unsigned_Type;
 
+   procedure Set_Is_Uplevel_Referenced_Entity (Id : E; V : B := True) is
+   begin
+      pragma Assert
+        (Ekind_In (Id, E_Constant, E_Variable)
+          or else Is_Formal (Id)
+          or else Is_Type (Id));
+      Set_Flag283 (Id, V);
+   end Set_Is_Uplevel_Referenced_Entity;
+
    procedure Set_Is_Valued_Procedure (Id : E; V : B := True) is
    begin
       pragma Assert (Ekind (Id) = E_Procedure);
@@ -5622,8 +5645,9 @@ package body Einfo is
    procedure Set_Non_Limited_View (Id : E; V : E) is
    begin
       pragma Assert
-        (Ekind (Id) in Incomplete_Kind or else Ekind (Id) = E_Abstract_State);
-      Set_Node17 (Id, V);
+        (Ekind (Id) in Incomplete_Kind
+          or else Ekind_In (Id, E_Abstract_State, E_Class_Wide_Type));
+      Set_Node19 (Id, V);
    end Set_Non_Limited_View;
 
    procedure Set_Nonzero_Is_True (Id : E; V : B := True) is
@@ -6213,17 +6237,6 @@ package body Einfo is
       Set_Node16 (Id, V);
    end Set_Unset_Reference;
 
-   procedure Set_Uplevel_Reference_Noted (Id : E; V : B := True) is
-   begin
-      Set_Flag283 (Id, V);
-   end Set_Uplevel_Reference_Noted;
-
-   procedure Set_Uplevel_References (Id : E; V : L) is
-   begin
-      pragma Assert (Is_Subprogram (Id));
-      Set_Elist24 (Id, V);
-   end Set_Uplevel_References;
-
    procedure Set_Used_As_Generic_Actual (Id : E; V : B := True) is
    begin
       Set_Flag222 (Id, V);
@@ -7098,6 +7111,18 @@ package body Einfo is
       return False;
    end Has_Interrupt_Handler;
 
+   --------------------------
+   -- Has_Non_Limited_View --
+   --------------------------
+
+   function Has_Non_Limited_View (Id : E) return B is
+   begin
+      return (Ekind (Id) in Incomplete_Kind
+               or else Ekind (Id) in Class_Wide_Kind
+               or else Ekind (Id) = E_Abstract_State)
+        and then Present (Non_Limited_View (Id));
+   end Has_Non_Limited_View;
+
    -----------------------------
    -- Has_Non_Null_Refinement --
    -----------------------------
@@ -8779,6 +8804,7 @@ package body Einfo is
       W ("Is_Underlying_Record_View",       Flag246 (Id));
       W ("Is_Unimplemented",                Flag284 (Id));
       W ("Is_Unsigned_Type",                Flag144 (Id));
+      W ("Is_Uplevel_Referenced_Entity",    Flag283 (Id));
       W ("Is_Valued_Procedure",             Flag127 (Id));
       W ("Is_Visible_Formal",               Flag206 (Id));
       W ("Is_Visible_Lib_Unit",             Flag116 (Id));
@@ -8836,7 +8862,6 @@ package body Einfo is
       W ("Suppress_Value_Tracking_On_Call", Flag217 (Id));
       W ("Treat_As_Volatile",               Flag41  (Id));
       W ("Universal_Aliasing",              Flag216 (Id));
-      W ("Uplevel_Reference_Noted",         Flag283 (Id));
       W ("Used_As_Generic_Actual",          Flag222 (Id));
       W ("Uses_Sec_Stack",                  Flag95  (Id));
       W ("Warnings_Off",                    Flag96  (Id));
@@ -8979,7 +9004,7 @@ package body Einfo is
    -----------------------
 
    procedure Write_Field6_Name (Id : Entity_Id) is
-      pragma Warnings (Off, Id);
+      pragma Unreferenced (Id);
    begin
       Write_Str ("First_Rep_Item");
    end Write_Field6_Name;
@@ -8989,7 +9014,7 @@ package body Einfo is
    -----------------------
 
    procedure Write_Field7_Name (Id : Entity_Id) is
-      pragma Warnings (Off, Id);
+      pragma Unreferenced (Id);
    begin
       Write_Str ("Freeze_Node");
    end Write_Field7_Name;
@@ -9069,10 +9094,6 @@ package body Einfo is
    procedure Write_Field10_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
-         when E_Abstract_State                             |
-              E_Variable                                   =>
-            Write_Str ("Encapsulating_State");
-
          when Class_Wide_Kind                              |
               Incomplete_Kind                              |
               E_Record_Type                                |
@@ -9081,13 +9102,13 @@ package body Einfo is
               Concurrent_Kind                              =>
             Write_Str ("Direct_Primitive_Operations");
 
-         when Float_Kind                                   =>
-            Write_Str ("Float_Rep");
-
          when E_In_Parameter                               |
               E_Constant                                   =>
             Write_Str ("Discriminal_Link");
 
+         when Float_Kind                                   =>
+            Write_Str ("Float_Rep");
+
          when E_Function                                   |
               E_Package                                    |
               E_Package_Body                               |
@@ -9383,10 +9404,6 @@ package body Einfo is
          when Modular_Integer_Kind                         =>
             Write_Str ("Modulus");
 
-         when E_Abstract_State                             |
-              E_Incomplete_Type                            =>
-            Write_Str ("Non_Limited_View");
-
          when E_Incomplete_Subtype                         =>
             if From_Limited_With (Id) then
                Write_Str ("Non_Limited_View");
@@ -9482,6 +9499,11 @@ package body Einfo is
          when Scalar_Kind                                  =>
             Write_Str ("Default_Aspect_Value");
 
+         when E_Abstract_State                             |
+              E_Class_Wide_Type                            |
+              E_Incomplete_Type                            =>
+            Write_Str ("Non_Limited_View");
+
          when E_Array_Type                                 =>
             Write_Str ("Default_Component_Value");
 
@@ -9750,11 +9772,7 @@ package body Einfo is
          when E_Function                                   |
               E_Operator                                   |
               E_Procedure                                  =>
-            if Field24 (Id) in Uint_Range then
-               Write_Str ("Subps_Index");
-            else
-               Write_Str ("Uplevel_References");
-            end if;
+            Write_Str ("Subps_Index");
 
          when others                                       =>
             Write_Str ("Field24???");
@@ -9984,6 +10002,11 @@ package body Einfo is
    procedure Write_Field32_Name (Id : Entity_Id) is
    begin
       case Ekind (Id) is
+         when E_Abstract_State                             |
+              E_Constant                                   |
+              E_Variable                                   =>
+            Write_Str ("Encapsulating_State");
+
          when E_Function                                   |
               E_Generic_Function                           |
               E_Generic_Package                            |
@@ -10039,6 +10062,7 @@ package body Einfo is
               E_Package_Body                               |
               E_Subprogram_Body                            |
               E_Variable                                   |
+              E_Void                                       |
               Generic_Subprogram_Kind                      |
               Subprogram_Kind                              =>
             Write_Str ("Contract");
@@ -10063,6 +10087,76 @@ package body Einfo is
       end case;
    end Write_Field35_Name;
 
+   ------------------------
+   -- Write_Field36_Name --
+   ------------------------
+
+   procedure Write_Field36_Name (Id : Entity_Id) is
+   begin
+      case Ekind (Id) is
+         when others                                       =>
+            Write_Str ("Field36??");
+      end case;
+   end Write_Field36_Name;
+
+   ------------------------
+   -- Write_Field37_Name --
+   ------------------------
+
+   procedure Write_Field37_Name (Id : Entity_Id) is
+      pragma Unreferenced (Id);
+   begin
+      Write_Str ("Associated_Entity");
+   end Write_Field37_Name;
+
+   ------------------------
+   -- Write_Field38_Name --
+   ------------------------
+
+   procedure Write_Field38_Name (Id : Entity_Id) is
+   begin
+      case Ekind (Id) is
+         when others                                       =>
+            Write_Str ("Field38??");
+      end case;
+   end Write_Field38_Name;
+
+   ------------------------
+   -- Write_Field39_Name --
+   ------------------------
+
+   procedure Write_Field39_Name (Id : Entity_Id) is
+   begin
+      case Ekind (Id) is
+         when others                                       =>
+            Write_Str ("Field39??");
+      end case;
+   end Write_Field39_Name;
+
+   ------------------------
+   -- Write_Field40_Name --
+   ------------------------
+
+   procedure Write_Field40_Name (Id : Entity_Id) is
+   begin
+      case Ekind (Id) is
+         when others                                       =>
+            Write_Str ("Field40??");
+      end case;
+   end Write_Field40_Name;
+
+   ------------------------
+   -- Write_Field41_Name --
+   ------------------------
+
+   procedure Write_Field41_Name (Id : Entity_Id) is
+   begin
+      case Ekind (Id) is
+         when others                                       =>
+            Write_Str ("Field41??");
+      end case;
+   end Write_Field41_Name;
+
    -------------------------
    -- Iterator Procedures --
    -------------------------