diff options
| -rw-r--r-- | gcc/ada/rtsfind.adb | 131 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 95 |
2 files changed, 109 insertions, 117 deletions
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index c43561c..d190115 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -540,87 +540,166 @@ package body Rtsfind is -- Get_Unit_Name -- ------------------- + -- The following subtypes include all the proper descendants of each unit + -- that has such descendants. For example, Ada_Calendar_Descendant includes + -- all the descendents of Ada.Calendar (except Ada.Calendar itself). These + -- are used by Get_Unit_Name to know where to change "_" to ".", and by + -- Is_Text_IO_Special_Package to detect the special generic pseudo-children + -- of [[Wide_]Wide_]Text_IO. + + subtype Ada_Descendant is RTU_Id + range Ada_Calendar .. Ada_Wide_Wide_Text_IO_Modular_IO; + + subtype Ada_Calendar_Descendant is Ada_Descendant + range Ada_Calendar_Delays .. Ada_Calendar_Delays; + + subtype Ada_Dispatching_Descendant is Ada_Descendant + range Ada_Dispatching_EDF .. Ada_Dispatching_EDF; + + subtype Ada_Interrupts_Descendant is Ada_Descendant range + Ada_Interrupts_Names .. Ada_Interrupts_Names; + + subtype Ada_Numerics_Descendant is Ada_Descendant + range Ada_Numerics_Generic_Elementary_Functions .. + Ada_Numerics_Generic_Elementary_Functions; + + subtype Ada_Real_Time_Descendant is Ada_Descendant + range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events; + + subtype Ada_Streams_Descendant is Ada_Descendant + range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO; + + subtype Ada_Strings_Descendant is Ada_Descendant + range Ada_Strings_Superbounded .. Ada_Strings_Text_Output_Utils; + + subtype Ada_Strings_Text_Output_Descendant is Ada_Strings_Descendant + range Ada_Strings_Text_Output_Utils .. Ada_Strings_Text_Output_Utils; + + subtype Ada_Text_IO_Descendant is Ada_Descendant + range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO; + + subtype Ada_Wide_Text_IO_Descendant is Ada_Descendant + range Ada_Wide_Text_IO_Decimal_IO .. Ada_Wide_Text_IO_Modular_IO; + + subtype Ada_Wide_Wide_Text_IO_Descendant is Ada_Descendant + range Ada_Wide_Wide_Text_IO_Decimal_IO .. + Ada_Wide_Wide_Text_IO_Modular_IO; + + subtype Interfaces_Descendant is RTU_Id + range Interfaces_Packed_Decimal .. Interfaces_Packed_Decimal; + + subtype System_Descendant is RTU_Id + range System_Address_Image .. System_Tasking_Stages; + + subtype System_Dim_Descendant is System_Descendant + range System_Dim_Float_IO .. System_Dim_Integer_IO; + + subtype System_Multiprocessors_Descendant is System_Descendant + range System_Multiprocessors_Dispatching_Domains .. + System_Multiprocessors_Dispatching_Domains; + + subtype System_Storage_Pools_Descendant is System_Descendant + range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools; + + subtype System_Strings_Descendant is System_Descendant + range System_Strings_Stream_Ops .. System_Strings_Stream_Ops; + + subtype System_Tasking_Descendant is System_Descendant + range System_Tasking_Async_Delays .. System_Tasking_Stages; + + subtype System_Tasking_Protected_Objects_Descendant is + System_Tasking_Descendant + range System_Tasking_Protected_Objects_Entries .. + System_Tasking_Protected_Objects_Single_Entry; + + subtype System_Tasking_Restricted_Descendant is System_Tasking_Descendant + range System_Tasking_Restricted_Stages .. + System_Tasking_Restricted_Stages; + + subtype System_Tasking_Async_Delays_Descendant is System_Tasking_Descendant + range System_Tasking_Async_Delays_Enqueue_Calendar .. + System_Tasking_Async_Delays_Enqueue_RT; + function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type is Uname_Chars : constant String := RTU_Id'Image (U_Id); - begin Name_Len := Uname_Chars'Length; Name_Buffer (1 .. Name_Len) := Uname_Chars; Set_Casing (All_Lower_Case); - if U_Id in Ada_Child then + if U_Id in Ada_Descendant then Name_Buffer (4) := '.'; - if U_Id in Ada_Calendar_Child then + if U_Id in Ada_Calendar_Descendant then Name_Buffer (13) := '.'; - elsif U_Id in Ada_Dispatching_Child then + elsif U_Id in Ada_Dispatching_Descendant then Name_Buffer (16) := '.'; - elsif U_Id in Ada_Interrupts_Child then + elsif U_Id in Ada_Interrupts_Descendant then Name_Buffer (15) := '.'; - elsif U_Id in Ada_Numerics_Child then + elsif U_Id in Ada_Numerics_Descendant then Name_Buffer (13) := '.'; - elsif U_Id in Ada_Real_Time_Child then + elsif U_Id in Ada_Real_Time_Descendant then Name_Buffer (14) := '.'; - elsif U_Id in Ada_Streams_Child then + elsif U_Id in Ada_Streams_Descendant then Name_Buffer (12) := '.'; - elsif U_Id in Ada_Strings_Child then + elsif U_Id in Ada_Strings_Descendant then Name_Buffer (12) := '.'; - if U_Id in Ada_Strings_Text_Output_Child then + if U_Id in Ada_Strings_Text_Output_Descendant then Name_Buffer (24) := '.'; end if; - elsif U_Id in Ada_Text_IO_Child then + elsif U_Id in Ada_Text_IO_Descendant then Name_Buffer (12) := '.'; - elsif U_Id in Ada_Wide_Text_IO_Child then + elsif U_Id in Ada_Wide_Text_IO_Descendant then Name_Buffer (17) := '.'; - elsif U_Id in Ada_Wide_Wide_Text_IO_Child then + elsif U_Id in Ada_Wide_Wide_Text_IO_Descendant then Name_Buffer (22) := '.'; end if; - elsif U_Id in Interfaces_Child then + elsif U_Id in Interfaces_Descendant then Name_Buffer (11) := '.'; - elsif U_Id in System_Child then + elsif U_Id in System_Descendant then Name_Buffer (7) := '.'; - if U_Id in System_Dim_Child then + if U_Id in System_Dim_Descendant then Name_Buffer (11) := '.'; end if; - if U_Id in System_Multiprocessors_Child then + if U_Id in System_Multiprocessors_Descendant then Name_Buffer (23) := '.'; end if; - if U_Id in System_Storage_Pools_Child then + if U_Id in System_Storage_Pools_Descendant then Name_Buffer (21) := '.'; end if; - if U_Id in System_Strings_Child then + if U_Id in System_Strings_Descendant then Name_Buffer (15) := '.'; end if; - if U_Id in System_Tasking_Child then + if U_Id in System_Tasking_Descendant then Name_Buffer (15) := '.'; end if; - if U_Id in System_Tasking_Restricted_Child then + if U_Id in System_Tasking_Restricted_Descendant then Name_Buffer (26) := '.'; end if; - if U_Id in System_Tasking_Protected_Objects_Child then + if U_Id in System_Tasking_Protected_Objects_Descendant then Name_Buffer (33) := '.'; end if; - if U_Id in System_Tasking_Async_Delays_Child then + if U_Id in System_Tasking_Async_Delays_Descendant then Name_Buffer (28) := '.'; end if; end if; @@ -769,19 +848,19 @@ package body Rtsfind is -- ??? detection with a scope climbing might be more efficient - for U in Ada_Text_IO_Child loop + for U in Ada_Text_IO_Descendant loop if Is_RTU (E, U) then return True; end if; end loop; - for U in Ada_Wide_Text_IO_Child loop + for U in Ada_Wide_Text_IO_Descendant loop if Is_RTU (E, U) then return True; end if; end loop; - for U in Ada_Wide_Wide_Text_IO_Child loop + for U in Ada_Wide_Wide_Text_IO_Descendant loop if Is_RTU (E, U) then return True; end if; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 13d2253..5074e18 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -59,6 +59,9 @@ package Rtsfind is -- the compilation except in the presence of use clauses, which might -- result in unexpected ambiguities. + -- NOTE: If RTU_Id is modified, the subtypes of RTU_Id in the package body + -- might need to be modified. See Get_Unit_Name. + type RTU_Id is ( -- Runtime packages, for list of accessible entities in each package, @@ -380,97 +383,6 @@ package Rtsfind is System_Tasking_Rendezvous, System_Tasking_Stages); - subtype Ada_Child is RTU_Id - range Ada_Calendar .. Ada_Wide_Wide_Text_IO_Modular_IO; - -- Range of values for children or grandchildren of Ada - - subtype Ada_Calendar_Child is Ada_Child - range Ada_Calendar_Delays .. Ada_Calendar_Delays; - -- Range of values for children of Ada.Calendar - - subtype Ada_Dispatching_Child is RTU_Id - range Ada_Dispatching_EDF .. Ada_Dispatching_EDF; - -- Range of values for children of Ada.Dispatching - - subtype Ada_Interrupts_Child is Ada_Child range - Ada_Interrupts_Names .. Ada_Interrupts_Names; - -- Range of values for children of Ada.Interrupts - - subtype Ada_Numerics_Child is Ada_Child - range Ada_Numerics_Generic_Elementary_Functions .. - Ada_Numerics_Generic_Elementary_Functions; - -- Range of values for children of Ada.Numerics - - subtype Ada_Real_Time_Child is Ada_Child - range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events; - -- Range of values for children of Ada.Real_Time - - subtype Ada_Streams_Child is Ada_Child - range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO; - -- Range of values for children of Ada.Streams - - subtype Ada_Strings_Child is Ada_Child - range Ada_Strings_Superbounded .. Ada_Strings_Text_Output_Utils; - -- Range of values for children and grandchildren of Ada.Strings - - subtype Ada_Strings_Text_Output_Child is Ada_Child - range Ada_Strings_Text_Output_Utils .. Ada_Strings_Text_Output_Utils; - -- Range of values for children of Ada.Strings.Text_Output - - subtype Ada_Text_IO_Child is Ada_Child - range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO; - -- Range of values for children of Ada.Text_IO - - subtype Ada_Wide_Text_IO_Child is Ada_Child - range Ada_Wide_Text_IO_Decimal_IO .. Ada_Wide_Text_IO_Modular_IO; - -- Range of values for children of Ada.Text_IO - - subtype Ada_Wide_Wide_Text_IO_Child is Ada_Child - range Ada_Wide_Wide_Text_IO_Decimal_IO .. - Ada_Wide_Wide_Text_IO_Modular_IO; - - subtype Interfaces_Child is RTU_Id - range Interfaces_Packed_Decimal .. Interfaces_Packed_Decimal; - -- Range of values for children of Interfaces - - subtype System_Child is RTU_Id - range System_Address_Image .. System_Tasking_Stages; - -- Range of values for children or grandchildren of System - - subtype System_Dim_Child is RTU_Id - range System_Dim_Float_IO .. System_Dim_Integer_IO; - -- Range of values for children of System.Dim - - subtype System_Multiprocessors_Child is RTU_Id - range System_Multiprocessors_Dispatching_Domains .. - System_Multiprocessors_Dispatching_Domains; - -- Range of values for children of System.Multiprocessors - - subtype System_Storage_Pools_Child is RTU_Id - range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools; - - subtype System_Strings_Child is RTU_Id - range System_Strings_Stream_Ops .. System_Strings_Stream_Ops; - - subtype System_Tasking_Child is System_Child - range System_Tasking_Async_Delays .. System_Tasking_Stages; - -- Range of values for children of System.Tasking - - subtype System_Tasking_Protected_Objects_Child is System_Tasking_Child - range System_Tasking_Protected_Objects_Entries .. - System_Tasking_Protected_Objects_Single_Entry; - -- Range of values for children of System.Tasking.Protected_Objects - - subtype System_Tasking_Restricted_Child is System_Tasking_Child - range System_Tasking_Restricted_Stages .. - System_Tasking_Restricted_Stages; - -- Range of values for children of System.Tasking.Restricted - - subtype System_Tasking_Async_Delays_Child is System_Tasking_Child - range System_Tasking_Async_Delays_Enqueue_Calendar .. - System_Tasking_Async_Delays_Enqueue_RT; - -- Range of values for children of System.Tasking.Async_Delays - -------------------------- -- Runtime Entity Table -- -------------------------- @@ -3193,6 +3105,7 @@ package Rtsfind is -- Ada RM defines to be nested in Ada.Text_IO, but GNAT defines as its -- private children. This is similar to Is_Text_IO_Special_Unit, but is -- meant to be used on a fully resolved AST, especially in the backends. + -- This is used by SPARK. function RTE (E : RE_Id) return Entity_Id; -- Given the entity defined in the above tables, as identified by the |