From 4e474137e78a4c9b35b6c298d2aacf731c0b3d8a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 Apr 2022 09:29:31 +0000 Subject: [PATCH] [Ada] Remove remaining references to gnatfind/gnatxref gcc/ada/ * gnat1drv.adb, gnatcmd.adb: Remove references to gnatfind/xref. * doc/gnat_ugn/building_executable_programs_with_gnat.rst, doc/gnat_ugn/the_gnat_compilation_model.rst: Ditto. * gnat_ugn.texi: Regenerate. * gnatfind.adb, gnatxref.adb, xr_tabls.adb, xr_tabls.ads, xref_lib.adb, xref_lib.ads: Removed, no longer used. --- ...building_executable_programs_with_gnat.rst | 8 +- .../gnat_ugn/the_gnat_compilation_model.rst | 7 +- gcc/ada/gnat1drv.adb | 2 +- gcc/ada/gnat_ugn.texi | 15 +- gcc/ada/gnatcmd.adb | 38 +- gcc/ada/gnatfind.adb | 407 ---- gcc/ada/gnatxref.adb | 344 --- gcc/ada/xr_tabls.adb | 1628 -------------- gcc/ada/xr_tabls.ads | 388 ---- gcc/ada/xref_lib.adb | 1892 ----------------- gcc/ada/xref_lib.ads | 179 -- 11 files changed, 16 insertions(+), 4892 deletions(-) delete mode 100644 gcc/ada/gnatfind.adb delete mode 100644 gcc/ada/gnatxref.adb delete mode 100644 gcc/ada/xr_tabls.adb delete mode 100644 gcc/ada/xr_tabls.ads delete mode 100644 gcc/ada/xref_lib.adb delete mode 100644 gcc/ada/xref_lib.ads diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 1dd3162e0d4..ed6b463efde 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -6015,10 +6015,10 @@ Debugging Control :switch:`-gnatx` Normally the compiler generates full cross-referencing information in - the :file:`ALI` file. This information is used by a number of tools, - including ``gnatfind`` and ``gnatxref``. The :switch:`-gnatx` switch - suppresses this information. This saves some space and may slightly - speed up compilation, but means that these tools cannot be used. + the :file:`ALI` file. This information is used by a number of tools. + The :switch:`-gnatx` switch suppresses this information. This saves some space + and may slightly speed up compilation, but means that tools depending + on this information cannot be used. .. index:: -fgnat-encodings (gcc) diff --git a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst index 68209bfd876..363670300e3 100644 --- a/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst +++ b/gcc/ada/doc/gnat_ugn/the_gnat_compilation_model.rst @@ -1743,8 +1743,7 @@ The following information is contained in the :file:`ALI` file. if any of these units are modified. * Cross-reference data. Contains information on all entities referenced - in the unit. Used by tools like ``gnatxref`` and ``gnatfind`` to - provide cross-reference information. + in the unit. Used by some tools to provide cross-reference information. For a full detailed description of the format of the :file:`ALI` file, see the source of the body of unit ``Lib.Writ``, contained in file @@ -2009,8 +2008,8 @@ be :file:`adalib`). You can also specify a new default path to the run-time library at compilation time with the switch :switch:`--RTS=rts-path`. You can thus choose / change the run-time library you want your program to be compiled with. This switch is -recognized by ``gcc``, ``gnatmake``, ``gnatbind``, -``gnatls``, ``gnatfind`` and ``gnatxref``. +recognized by ``gcc``, ``gnatmake``, ``gnatbind``, ``gnatls``, and all +project aware tools. It is possible to install a library before or after the standard GNAT library, by reordering the lines in the configuration files. In general, a diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index cd70a141e30..49ddf03d04b 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -1442,7 +1442,7 @@ begin -- Do not generate an ALI file in this case, because it would -- become obsolete when the parent is compiled, and thus - -- confuse tools such as gnatfind. + -- confuse some tools. elsif Main_Unit_Kind = N_Subprogram_Declaration then Write_Str (" (subprogram spec)"); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 218c375c361..1664c4912e0 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -3197,8 +3197,7 @@ if any of these units are modified. @item Cross-reference data. Contains information on all entities referenced -in the unit. Used by tools like @code{gnatxref} and @code{gnatfind} to -provide cross-reference information. +in the unit. Used by some tools to provide cross-reference information. @end itemize For a full detailed description of the format of the @code{ALI} file, @@ -3505,8 +3504,8 @@ be @code{adalib}). You can also specify a new default path to the run-time library at compilation time with the switch @code{--RTS=rts-path}. You can thus choose / change the run-time library you want your program to be compiled with. This switch is -recognized by @code{gcc}, @code{gnatmake}, @code{gnatbind}, -@code{gnatls}, @code{gnatfind} and @code{gnatxref}. +recognized by @code{gcc}, @code{gnatmake}, @code{gnatbind}, @code{gnatls}, and all +project aware tools. It is possible to install a library before or after the standard GNAT library, by reordering the lines in the configuration files. In general, a @@ -15077,10 +15076,10 @@ types in package Standard. @item @code{-gnatx} Normally the compiler generates full cross-referencing information in -the @code{ALI} file. This information is used by a number of tools, -including @code{gnatfind} and @code{gnatxref}. The @code{-gnatx} switch -suppresses this information. This saves some space and may slightly -speed up compilation, but means that these tools cannot be used. +the @code{ALI} file. This information is used by a number of tools. +The @code{-gnatx} switch suppresses this information. This saves some space +and may slightly speed up compilation, but means that tools depending +on this information cannot be used. @end table @geindex -fgnat-encodings (gcc) diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 0062736199a..74192bc3619 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -57,7 +57,6 @@ procedure GNATCmd is Compile, Check, Elim, - Find, Krunch, Link, List, @@ -69,10 +68,9 @@ procedure GNATCmd is Stack, Stub, Test, - Xref, Undefined); - subtype Real_Command_Type is Command_Type range Bind .. Xref; + subtype Real_Command_Type is Command_Type range Bind .. Test; -- All real command types (excludes only Undefined). type Alternate_Command is (Comp, Ls, Kr, Pp, Prep); @@ -160,11 +158,6 @@ procedure GNATCmd is Unixcmd => new String'("gnatelim"), Unixsws => null), - Find => - (Cname => new String'("FIND"), - Unixcmd => new String'("gnatfind"), - Unixsws => null), - Krunch => (Cname => new String'("KRUNCH"), Unixcmd => new String'("gnatkr"), @@ -218,11 +211,6 @@ procedure GNATCmd is Test => (Cname => new String'("TEST"), Unixcmd => new String'("gnattest"), - Unixsws => null), - - Xref => - (Cname => new String'("XREF"), - Unixcmd => new String'("gnatxref"), Unixsws => null) ); @@ -590,30 +578,6 @@ begin end loop; end if; - -- For FIND and XREF, look for switch -P. If it is specified, then - -- report an error indicating that the command does not support project - -- files. - - if The_Command in Find | Xref then - declare - Argv : String_Access; - begin - for Arg_Num in 1 .. Last_Switches.Last loop - Argv := Last_Switches.Table (Arg_Num); - - if Argv'Length >= 2 - and then Argv (Argv'First .. Argv'First + 1) = "-P" - then - if The_Command = Find then - Fail ("'gnat find -P' is not supported;"); - else - Fail ("'gnat xref -P' is not supported;"); - end if; - end if; - end loop; - end; - end if; - -- Gather all the arguments and invoke the executable declare diff --git a/gcc/ada/gnatfind.adb b/gcc/ada/gnatfind.adb deleted file mode 100644 index 04b0fe4faf2..00000000000 --- a/gcc/ada/gnatfind.adb +++ /dev/null @@ -1,407 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T F I N D -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Opt; -with Osint; use Osint; -with Switch; use Switch; -with Types; use Types; -with Xr_Tabls; -with Xref_Lib; use Xref_Lib; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Command_Line; use GNAT.Command_Line; - -with System.Strings; use System.Strings; - --------------- --- Gnatfind -- --------------- - -procedure Gnatfind is - Output_Ref : Boolean := False; - Pattern : Xref_Lib.Search_Pattern; - Local_Symbols : Boolean := True; - Prj_File : File_Name_String; - Prj_File_Length : Natural := 0; - Nb_File : Natural := 0; - Usage_Error : exception; - Full_Path_Name : Boolean := False; - Have_Entity : Boolean := False; - Wide_Search : Boolean := True; - Glob_Mode : Boolean := True; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Read_Only : Boolean := False; - Source_Lines : Boolean := False; - - Has_File_In_Entity : Boolean := False; - -- Will be true if a file name was specified in the entity - - RTS_Specified : String_Access := null; - -- Used to detect multiple use of --RTS= switch - - EXT_Specified : String_Access := null; - -- Used to detect multiple use of --ext= switch - - procedure Parse_Cmd_Line; - -- Parse every switch on the command line - - procedure Usage; - -- Display the usage - - procedure Write_Usage; - pragma No_Return (Write_Usage); - -- Print a small help page for program usage and exit program - - -------------------- - -- Parse_Cmd_Line -- - -------------------- - - procedure Parse_Cmd_Line is - - procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - - -- Start of processing for Parse_Cmd_Line - - begin - -- First check for --version or --help - - Check_Version_And_Help ("GNATFIND", "1998"); - - -- Now scan the other switches - - GNAT.Command_Line.Initialize_Option_Scan; - - loop - case - GNAT.Command_Line.Getopt - ("a aI: aO: d e f g h I: nostdinc nostdlib p: r s t -RTS= -ext=") - is - when ASCII.NUL => - exit; - - when 'a' => - if GNAT.Command_Line.Full_Switch = "a" then - Read_Only := True; - elsif GNAT.Command_Line.Full_Switch = "aI" then - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - else - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - end if; - - when 'd' => - Der_Info := True; - - when 'e' => - Glob_Mode := False; - - when 'f' => - Full_Path_Name := True; - - when 'g' => - Local_Symbols := False; - - when 'h' => - Write_Usage; - - when 'I' => - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - - when 'n' => - if GNAT.Command_Line.Full_Switch = "nostdinc" then - Opt.No_Stdinc := True; - elsif GNAT.Command_Line.Full_Switch = "nostdlib" then - Opt.No_Stdlib := True; - end if; - - when 'p' => - declare - S : constant String := GNAT.Command_Line.Parameter; - begin - Prj_File_Length := S'Length; - Prj_File (1 .. Prj_File_Length) := S; - end; - - when 'r' => - Output_Ref := True; - - when 's' => - Source_Lines := True; - - when 't' => - Type_Tree := True; - - -- Only switch starting with -- recognized is --RTS - - when '-' => - if GNAT.Command_Line.Full_Switch = "-RTS" then - - -- Check that it is the first time we see this switch - - if RTS_Specified = null then - RTS_Specified := new String'(GNAT.Command_Line.Parameter); - elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--RTS cannot be specified multiple times"); - end if; - - Opt.No_Stdinc := True; - Opt.RTS_Switch := True; - - declare - Src_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Include); - Lib_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Objects); - - begin - if Src_Path_Name /= null - and then Lib_Path_Name /= null - then - Add_Search_Dirs (Src_Path_Name, Include); - Add_Search_Dirs (Lib_Path_Name, Objects); - - elsif Src_Path_Name = null - and then Lib_Path_Name = null - then - Osint.Fail ("RTS path not valid: missing " & - "adainclude and adalib directories"); - - elsif Src_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adainclude directory"); - - elsif Lib_Path_Name = null then - Osint.Fail ("RTS path not valid: missing " & - "adalib directory"); - end if; - end; - - -- Process -ext switch - - elsif GNAT.Command_Line.Full_Switch = "-ext" then - - -- Check that it is the first time we see this switch - - if EXT_Specified = null then - EXT_Specified := new String'(GNAT.Command_Line.Parameter); - elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--ext cannot be specified multiple times"); - end if; - - if - EXT_Specified'Length = Osint.ALI_Default_Suffix'Length - then - Osint.ALI_Suffix := EXT_Specified.all'Access; - else - Osint.Fail ("--ext argument must have 3 characters"); - end if; - - end if; - - when others => - Try_Help; - raise Usage_Error; - end case; - end loop; - - -- Get the other arguments - - loop - declare - S : constant String := GNAT.Command_Line.Get_Argument; - - begin - exit when S'Length = 0; - - -- First argument is the pattern - - if not Have_Entity then - Add_Entity (Pattern, S, Glob_Mode); - Have_Entity := True; - - if not Has_File_In_Entity - and then Index (S, ":") /= 0 - then - Has_File_In_Entity := True; - end if; - - -- Next arguments are the files to search - - else - Add_Xref_File (S); - Wide_Search := False; - Nb_File := Nb_File + 1; - end if; - end; - end loop; - - exception - when GNAT.Command_Line.Invalid_Switch => - Ada.Text_IO.Put_Line ("Invalid switch : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when GNAT.Command_Line.Invalid_Parameter => - Ada.Text_IO.Put_Line ("Parameter missing for : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when Xref_Lib.Invalid_Argument => - Ada.Text_IO.Put_Line ("Invalid line or column in the pattern"); - Try_Help; - raise Usage_Error; - end Parse_Cmd_Line; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - Put_Line ("Usage: gnatfind pattern[:sourcefile[:line[:column]]] " - & "[file1 file2 ...]"); - New_Line; - Put_Line (" pattern Name of the entity to look for (can have " - & "wildcards)"); - Put_Line (" sourcefile Only find entities referenced from this " - & "file"); - Put_Line (" line Only find entities referenced from this line " - & "of file"); - Put_Line (" column Only find entities referenced from this columns" - & " of file"); - Put_Line (" file ... Set of Ada source files to search for " - & "references. This parameters are optional"); - New_Line; - Put_Line ("gnatfind switches:"); - Display_Usage_Version_And_Help; - Put_Line (" -a Consider all files, even when the ali file is " - & "readonly"); - Put_Line (" -aIdir Specify source files search path"); - Put_Line (" -aOdir Specify library/object files search path"); - Put_Line (" -d Output derived type information"); - Put_Line (" -e Use the full regular expression set for " - & "pattern"); - Put_Line (" -f Output full path name"); - Put_Line (" -g Output information only for global symbols"); - Put_Line (" -Idir Like -aIdir -aOdir"); - Put_Line (" -nostdinc Don't look for sources in the system default" - & " directory"); - Put_Line (" -nostdlib Don't look for library files in the system" - & " default directory"); - Put_Line (" --ext=xxx Specify alternate ali file extension"); - Put_Line (" --RTS=dir specify the default source and object search" - & " path"); - Put_Line (" -p file Use file as the configuration file"); - Put_Line (" -r Find all references (default to find declaration" - & " only)"); - Put_Line (" -s Print source line"); - Put_Line (" -t Print type hierarchy"); - end Usage; - - ----------------- - -- Write_Usage -- - ----------------- - - procedure Write_Usage is - begin - Display_Version ("GNATFIND", "1998"); - New_Line; - - Usage; - - raise Usage_Error; - end Write_Usage; - --- Start of processing for Gnatfind - -begin - Put_Line - ("WARNING: gnatfind is obsolete and will be removed in the next release"); - Put_Line - ("Consider using Libadalang or GNAT Studio python scripting instead"); - - Parse_Cmd_Line; - - if not Have_Entity then - if Argument_Count = 0 then - Write_Usage; - else - Try_Help; - raise Usage_Error; - end if; - end if; - - -- Special case to speed things up: if the user has a command line of the - -- form 'gnatfind entity:file', i.e. has specified a file and only wants - -- the bodies and specs, then we can restrict the search to the .ali file - -- associated with 'file'. - - if Has_File_In_Entity - and then not Output_Ref - then - Wide_Search := False; - end if; - - -- Find the project file - - if Prj_File_Length = 0 then - Xr_Tabls.Create_Project_File (Default_Project_File (".")); - else - Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length)); - end if; - - -- Fill up the table - - if Type_Tree and then Nb_File > 1 then - Ada.Text_IO.Put_Line ("Error: for type hierarchy output you must " - & "specify only one file."); - Ada.Text_IO.New_Line; - Try_Help; - raise Usage_Error; - end if; - - Search (Pattern, Local_Symbols, Wide_Search, Read_Only, - Der_Info, Type_Tree); - - if Source_Lines then - Xr_Tabls.Grep_Source_Files; - end if; - - Print_Gnatfind (Output_Ref, Full_Path_Name); - -exception - when Usage_Error => - null; -end Gnatfind; diff --git a/gcc/ada/gnatxref.adb b/gcc/ada/gnatxref.adb deleted file mode 100644 index 9499d11551a..00000000000 --- a/gcc/ada/gnatxref.adb +++ /dev/null @@ -1,344 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T X R E F -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Opt; -with Osint; use Osint; -with Types; use Types; -with Switch; use Switch; -with Xr_Tabls; -with Xref_Lib; use Xref_Lib; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Fixed; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Command_Line; use GNAT.Command_Line; - -with System.Strings; use System.Strings; - -procedure Gnatxref is - Search_Unused : Boolean := False; - Local_Symbols : Boolean := True; - Prj_File : File_Name_String; - Prj_File_Length : Natural := 0; - Usage_Error : exception; - Full_Path_Name : Boolean := False; - Vi_Mode : Boolean := False; - Read_Only : Boolean := False; - Have_File : Boolean := False; - Der_Info : Boolean := False; - - RTS_Specified : String_Access := null; - -- Used to detect multiple use of --RTS= switch - - EXT_Specified : String_Access := null; - -- Used to detect multiple use of --ext= switch - - procedure Parse_Cmd_Line; - -- Parse every switch on the command line - - procedure Usage; - -- Display the usage - - procedure Write_Usage; - pragma No_Return (Write_Usage); - -- Print a small help page for program usage - - -------------------- - -- Parse_Cmd_Line -- - -------------------- - - procedure Parse_Cmd_Line is - - procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); - - -- Start of processing for Parse_Cmd_Line - - begin - -- First check for --version or --help - - Check_Version_And_Help ("GNATXREF", "1998"); - - loop - case - GNAT.Command_Line.Getopt - ("a aI: aO: d f g h I: nostdinc nostdlib p: u v -RTS= -ext=") - is - when ASCII.NUL => - exit; - - when 'a' => - if GNAT.Command_Line.Full_Switch = "a" then - Read_Only := True; - - elsif GNAT.Command_Line.Full_Switch = "aI" then - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - - else - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - end if; - - when 'd' => - Der_Info := True; - - when 'f' => - Full_Path_Name := True; - - when 'g' => - Local_Symbols := False; - - when 'h' => - Write_Usage; - - when 'I' => - Osint.Add_Src_Search_Dir (GNAT.Command_Line.Parameter); - Osint.Add_Lib_Search_Dir (GNAT.Command_Line.Parameter); - - when 'n' => - if GNAT.Command_Line.Full_Switch = "nostdinc" then - Opt.No_Stdinc := True; - elsif GNAT.Command_Line.Full_Switch = "nostdlib" then - Opt.No_Stdlib := True; - end if; - - when 'p' => - declare - S : constant String := GNAT.Command_Line.Parameter; - begin - Prj_File_Length := S'Length; - Prj_File (1 .. Prj_File_Length) := S; - end; - - when 'u' => - Search_Unused := True; - Vi_Mode := False; - - when 'v' => - Vi_Mode := True; - Search_Unused := False; - - -- The only switch starting with -- recognized is --RTS - - when '-' => - - -- Check that it is the first time we see this switch - - if Full_Switch = "-RTS" then - if RTS_Specified = null then - RTS_Specified := new String'(GNAT.Command_Line.Parameter); - - elsif RTS_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--RTS cannot be specified multiple times"); - end if; - - Opt.No_Stdinc := True; - Opt.RTS_Switch := True; - - declare - Src_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Include); - - Lib_Path_Name : constant String_Ptr := - Get_RTS_Search_Dir - (GNAT.Command_Line.Parameter, - Objects); - - begin - if Src_Path_Name /= null - and then Lib_Path_Name /= null - then - Add_Search_Dirs (Src_Path_Name, Include); - Add_Search_Dirs (Lib_Path_Name, Objects); - - elsif Src_Path_Name = null - and then Lib_Path_Name = null - then - Osint.Fail - ("RTS path not valid: missing adainclude and " - & "adalib directories"); - - elsif Src_Path_Name = null then - Osint.Fail - ("RTS path not valid: missing adainclude directory"); - - elsif Lib_Path_Name = null then - Osint.Fail - ("RTS path not valid: missing adalib directory"); - end if; - end; - - elsif GNAT.Command_Line.Full_Switch = "-ext" then - - -- Check that it is the first time we see this switch - - if EXT_Specified = null then - EXT_Specified := new String'(GNAT.Command_Line.Parameter); - - elsif EXT_Specified.all /= GNAT.Command_Line.Parameter then - Osint.Fail ("--ext cannot be specified multiple times"); - end if; - - if EXT_Specified'Length = Osint.ALI_Default_Suffix'Length - then - Osint.ALI_Suffix := EXT_Specified.all'Access; - else - Osint.Fail ("--ext argument must have 3 characters"); - end if; - end if; - - when others => - Try_Help; - raise Usage_Error; - end case; - end loop; - - -- Get the other arguments - - loop - declare - S : constant String := GNAT.Command_Line.Get_Argument; - - begin - exit when S'Length = 0; - - if Ada.Strings.Fixed.Index (S, ":") /= 0 then - Ada.Text_IO.Put_Line - ("Only file names are allowed on the command line"); - Try_Help; - raise Usage_Error; - end if; - - Add_Xref_File (S); - Have_File := True; - end; - end loop; - - exception - when GNAT.Command_Line.Invalid_Switch => - Ada.Text_IO.Put_Line ("Invalid switch : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - - when GNAT.Command_Line.Invalid_Parameter => - Ada.Text_IO.Put_Line ("Parameter missing for : " - & GNAT.Command_Line.Full_Switch); - Try_Help; - raise Usage_Error; - end Parse_Cmd_Line; - - ----------- - -- Usage -- - ----------- - - procedure Usage is - begin - Put_Line ("Usage: gnatxref [switches] file1 file2 ..."); - New_Line; - Put_Line (" file ... list of source files to xref, " & - "including with'ed units"); - New_Line; - Put_Line ("gnatxref switches:"); - Display_Usage_Version_And_Help; - Put_Line (" -a Consider all files, even when the ali file is" - & " readonly"); - Put_Line (" -aIdir Specify source files search path"); - Put_Line (" -aOdir Specify library/object files search path"); - Put_Line (" -d Output derived type information"); - Put_Line (" -f Output full path name"); - Put_Line (" -g Output information only for global symbols"); - Put_Line (" -Idir Like -aIdir -aOdir"); - Put_Line (" -nostdinc Don't look for sources in the system default" - & " directory"); - Put_Line (" -nostdlib Don't look for library files in the system" - & " default directory"); - Put_Line (" --ext=xxx Specify alternate ali file extension"); - Put_Line (" --RTS=dir specify the default source and object search" - & " path"); - Put_Line (" -p file Use file as the configuration file"); - Put_Line (" -u List unused entities"); - Put_Line (" -v Print a 'tags' file for vi"); - New_Line; - - end Usage; - - ----------------- - -- Write_Usage -- - ----------------- - - procedure Write_Usage is - begin - Display_Version ("GNATXREF", "1998"); - New_Line; - Usage; - raise Usage_Error; - end Write_Usage; - -begin - Put_Line - ("WARNING: gnatxref is obsolete and will be removed in the next release"); - Put_Line - ("Consider using Libadalang or GNAT Studio python scripting instead"); - - Parse_Cmd_Line; - - if not Have_File then - if Argument_Count = 0 then - Write_Usage; - else - Try_Help; - raise Usage_Error; - end if; - end if; - - Xr_Tabls.Set_Default_Match (True); - - -- Find the project file - - if Prj_File_Length = 0 then - Xr_Tabls.Create_Project_File - (Default_Project_File (Osint.To_Host_Dir_Spec (".", False).all)); - else - Xr_Tabls.Create_Project_File (Prj_File (1 .. Prj_File_Length)); - end if; - - -- Fill up the table - - Search_Xref (Local_Symbols, Read_Only, Der_Info); - - if Search_Unused then - Print_Unused (Full_Path_Name); - elsif Vi_Mode then - Print_Vi (Full_Path_Name); - else - Print_Xref (Full_Path_Name); - end if; - -exception - when Usage_Error => - null; -end Gnatxref; diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb deleted file mode 100644 index 8f6fb7a27a8..00000000000 --- a/gcc/ada/xr_tabls.adb +++ /dev/null @@ -1,1628 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R _ T A B L S -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Types; use Types; -with Osint; - -with Ada.Unchecked_Conversion; -with Ada.Unchecked_Deallocation; -with Ada.Strings.Fixed; -with Ada.Strings; -with Ada.Text_IO; -with Ada.Characters.Handling; use Ada.Characters.Handling; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; - -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.HTable; -with GNAT.Heap_Sort_G; - -package body Xr_Tabls is - - type HTable_Headers is range 1 .. 10000; - - procedure Set_Next (E : File_Reference; Next : File_Reference); - function Next (E : File_Reference) return File_Reference; - function Get_Key (E : File_Reference) return Cst_String_Access; - function Hash (F : Cst_String_Access) return HTable_Headers; - function Equal (F1, F2 : Cst_String_Access) return Boolean; - -- The five subprograms above are used to instantiate the static - -- htable to store the files that should be processed. - - package File_HTable is new GNAT.HTable.Static_HTable - (Header_Num => HTable_Headers, - Element => File_Record, - Elmt_Ptr => File_Reference, - Null_Ptr => null, - Set_Next => Set_Next, - Next => Next, - Key => Cst_String_Access, - Get_Key => Get_Key, - Hash => Hash, - Equal => Equal); - -- A hash table to store all the files referenced in the - -- application. The keys in this htable are the name of the files - -- themselves, therefore it is assumed that the source path - -- doesn't contain twice the same source or ALI file name - - type Unvisited_Files_Record; - type Unvisited_Files_Access is access Unvisited_Files_Record; - type Unvisited_Files_Record is record - File : File_Reference; - Next : Unvisited_Files_Access; - end record; - -- A special list, in addition to File_HTable, that only stores - -- the files that haven't been visited so far. Note that the File - -- list points to some data in File_HTable, and thus should never be freed. - - function Next (E : Declaration_Reference) return Declaration_Reference; - procedure Set_Next (E, Next : Declaration_Reference); - function Get_Key (E : Declaration_Reference) return Cst_String_Access; - -- The subprograms above are used to instantiate the static - -- htable to store the entities that have been found in the application - - package Entities_HTable is new GNAT.HTable.Static_HTable - (Header_Num => HTable_Headers, - Element => Declaration_Record, - Elmt_Ptr => Declaration_Reference, - Null_Ptr => null, - Set_Next => Set_Next, - Next => Next, - Key => Cst_String_Access, - Get_Key => Get_Key, - Hash => Hash, - Equal => Equal); - -- A hash table to store all the entities defined in the - -- application. For each entity, we store a list of its reference - -- locations as well. - -- The keys in this htable should be created with Key_From_Ref, - -- and are the file, line and column of the declaration, which are - -- unique for every entity. - - Entities_Count : Natural := 0; - -- Number of entities in Entities_HTable. This is used in the end - -- when sorting the table. - - Longest_File_Name_In_Table : Natural := 0; - -- The length of the longest file name stored - - Unvisited_Files : Unvisited_Files_Access := null; - -- Linked list of unvisited files - - Directories : Project_File_Ptr; - -- Store the list of directories to visit - - Default_Match : Boolean := False; - -- Default value for match in declarations - - function Parse_Gnatls_Src return String; - -- Return the standard source directories (taking into account the - -- ADA_INCLUDE_PATH environment variable, if Osint.Add_Default_Search_Dirs - -- was called first). - - function Parse_Gnatls_Obj return String; - -- Return the standard object directories (taking into account the - -- ADA_OBJECTS_PATH environment variable). - - function Key_From_Ref - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return String; - -- Return a key for the symbol declared at File_Ref, Line, - -- Column. This key should be used for lookup in Entity_HTable - - function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean; - -- Compare two declarations (the comparison is case-insensitive) - - function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean; - -- Compare two references - - procedure Store_References - (Decl : Declaration_Reference; - Get_Writes : Boolean := False; - Get_Reads : Boolean := False; - Get_Bodies : Boolean := False; - Get_Declaration : Boolean := False; - Arr : in out Reference_Array; - Index : in out Natural); - -- Store in Arr, starting at Index, all the references to Decl. The Get_* - -- parameters can be used to indicate which references should be stored. - -- Constraint_Error will be raised if Arr is not big enough. - - procedure Sort (Arr : in out Reference_Array); - -- Sort an array of references (Arr'First must be 1) - - -------------- - -- Set_Next -- - -------------- - - procedure Set_Next (E : File_Reference; Next : File_Reference) is - begin - E.Next := Next; - end Set_Next; - - procedure Set_Next - (E : Declaration_Reference; Next : Declaration_Reference) is - begin - E.Next := Next; - end Set_Next; - - ------------- - -- Get_Key -- - ------------- - - function Get_Key (E : File_Reference) return Cst_String_Access is - begin - return E.File; - end Get_Key; - - function Get_Key (E : Declaration_Reference) return Cst_String_Access is - begin - return E.Key; - end Get_Key; - - ---------- - -- Hash -- - ---------- - - function Hash (F : Cst_String_Access) return HTable_Headers is - function H is new GNAT.HTable.Hash (HTable_Headers); - - begin - return H (F.all); - end Hash; - - ----------- - -- Equal -- - ----------- - - function Equal (F1, F2 : Cst_String_Access) return Boolean is - begin - return F1.all = F2.all; - end Equal; - - ------------------ - -- Key_From_Ref -- - ------------------ - - function Key_From_Ref - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return String - is - begin - return File_Ref.File.all & Natural'Image (Line) & Natural'Image (Column); - end Key_From_Ref; - - --------------------- - -- Add_Declaration -- - --------------------- - - function Add_Declaration - (File_Ref : File_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - Decl_Type : Character; - Is_Parameter : Boolean := False; - Remove_Only : Boolean := False; - Symbol_Match : Boolean := True) - return Declaration_Reference - is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Declaration_Record, Declaration_Reference); - - Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column); - - New_Decl : Declaration_Reference := - Entities_HTable.Get (Key'Unchecked_Access); - - Is_Param : Boolean := Is_Parameter; - - begin - -- Insert the Declaration in the table. There might already be a - -- declaration in the table if the entity is a parameter, so we - -- need to check that first. - - if New_Decl /= null and then New_Decl.Symbol_Length = 0 then - Is_Param := Is_Parameter or else New_Decl.Is_Parameter; - Entities_HTable.Remove (Key'Unrestricted_Access); - Entities_Count := Entities_Count - 1; - Free (New_Decl.Key); - Unchecked_Free (New_Decl); - New_Decl := null; - end if; - - -- The declaration might also already be there for parent types. In - -- this case, we should keep the entry, since some other entries are - -- pointing to it. - - if New_Decl = null - and then not Remove_Only - then - New_Decl := - new Declaration_Record' - (Symbol_Length => Symbol'Length, - Symbol => Symbol, - Key => new String'(Key), - Decl => new Reference_Record' - (File => File_Ref, - Line => Line, - Column => Column, - Source_Line => null, - Next => null), - Is_Parameter => Is_Param, - Decl_Type => Decl_Type, - Body_Ref => null, - Ref_Ref => null, - Modif_Ref => null, - Match => Symbol_Match - and then - (Default_Match - or else Match (File_Ref, Line, Column)), - Par_Symbol => null, - Next => null); - - Entities_HTable.Set (New_Decl); - Entities_Count := Entities_Count + 1; - - if New_Decl.Match then - Longest_File_Name_In_Table := - Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table); - end if; - - elsif New_Decl /= null - and then not New_Decl.Match - then - New_Decl.Match := Default_Match - or else Match (File_Ref, Line, Column); - New_Decl.Is_Parameter := New_Decl.Is_Parameter or Is_Param; - - elsif New_Decl /= null then - New_Decl.Is_Parameter := New_Decl.Is_Parameter or Is_Param; - end if; - - return New_Decl; - end Add_Declaration; - - ---------------------- - -- Add_To_Xref_File -- - ---------------------- - - function Add_To_Xref_File - (File_Name : String; - Visited : Boolean := True; - Emit_Warning : Boolean := False; - Gnatchop_File : String := ""; - Gnatchop_Offset : Integer := 0) return File_Reference - is - Base : aliased constant String := Base_Name (File_Name); - Dir : constant String := Dir_Name (File_Name); - Dir_Acc : GNAT.OS_Lib.String_Access := null; - Ref : File_Reference; - - begin - -- Do we have a directory name as well? - - if File_Name /= Base then - Dir_Acc := new String'(Dir); - end if; - - Ref := File_HTable.Get (Base'Unchecked_Access); - if Ref = null then - Ref := new File_Record' - (File => new String'(Base), - Dir => Dir_Acc, - Lines => null, - Visited => Visited, - Emit_Warning => Emit_Warning, - Gnatchop_File => new String'(Gnatchop_File), - Gnatchop_Offset => Gnatchop_Offset, - Next => null); - File_HTable.Set (Ref); - - if not Visited then - - -- Keep a separate list for faster access - - Set_Unvisited (Ref); - end if; - end if; - return Ref; - end Add_To_Xref_File; - - -------------- - -- Add_Line -- - -------------- - - procedure Add_Line - (File : File_Reference; - Line : Natural; - Column : Natural) - is - begin - File.Lines := new Ref_In_File'(Line => Line, - Column => Column, - Next => File.Lines); - end Add_Line; - - ---------------- - -- Add_Parent -- - ---------------- - - procedure Add_Parent - (Declaration : in out Declaration_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - File_Ref : File_Reference) - is - begin - Declaration.Par_Symbol := - Add_Declaration - (File_Ref, Symbol, Line, Column, - Decl_Type => ' ', - Symbol_Match => False); - end Add_Parent; - - ------------------- - -- Add_Reference -- - ------------------- - - procedure Add_Reference - (Declaration : Declaration_Reference; - File_Ref : File_Reference; - Line : Natural; - Column : Natural; - Ref_Type : Character; - Labels_As_Ref : Boolean) - is - New_Ref : Reference; - New_Decl : Declaration_Reference; - pragma Unreferenced (New_Decl); - - begin - case Ref_Type is - when ' ' | 'b' | 'c' | 'H' | 'i' | 'm' | 'o' | 'r' | 'R' | 's' | 'x' - => - null; - - when 'l' | 'w' => - if not Labels_As_Ref then - return; - end if; - - when '=' | '<' | '>' | '^' => - - -- Create dummy declaration in table to report it as a parameter - - -- In a given ALI file, the declaration of the subprogram comes - -- before the declaration of the parameter. However, it is - -- possible that another ALI file has been parsed that also - -- references the parameter (for instance a named parameter in - -- a call), so we need to check whether there already exists a - -- declaration for the parameter. - - New_Decl := - Add_Declaration - (File_Ref => File_Ref, - Symbol => "", - Line => Line, - Column => Column, - Decl_Type => ' ', - Is_Parameter => True); - - when 'd' | 'e' | 'E' | 'k' | 'p' | 'P' | 't' | 'z' => - return; - - when others => - Ada.Text_IO.Put_Line ("Unknown reference type: " & Ref_Type); - return; - end case; - - New_Ref := new Reference_Record' - (File => File_Ref, - Line => Line, - Column => Column, - Source_Line => null, - Next => null); - - -- We can insert the reference into the list directly, since all the - -- references will appear only once in the ALI file corresponding to the - -- file where they are referenced. This saves a lot of time compared to - -- checking the list to check if it exists. - - case Ref_Type is - when 'b' | 'c' => - New_Ref.Next := Declaration.Body_Ref; - Declaration.Body_Ref := New_Ref; - - when ' ' | 'H' | 'i' | 'l' | 'o' | 'r' | 'R' | 's' | 'w' | 'x' => - New_Ref.Next := Declaration.Ref_Ref; - Declaration.Ref_Ref := New_Ref; - - when 'm' => - New_Ref.Next := Declaration.Modif_Ref; - Declaration.Modif_Ref := New_Ref; - - when others => - null; - end case; - - if not Declaration.Match then - Declaration.Match := Match (File_Ref, Line, Column); - end if; - - if Declaration.Match then - Longest_File_Name_In_Table := - Natural'Max (File_Ref.File'Length, Longest_File_Name_In_Table); - end if; - end Add_Reference; - - ------------------- - -- ALI_File_Name -- - ------------------- - - function ALI_File_Name (Ada_File_Name : String) return String is - -- Should ideally be based on the naming scheme defined in - -- project files but this is too late for an obsolescent feature. - - Index : constant Natural := - Ada.Strings.Fixed.Index - (Ada_File_Name, ".", Going => Ada.Strings.Backward); - - begin - if Index /= 0 then - return Ada_File_Name (Ada_File_Name'First .. Index) - & Osint.ALI_Suffix.all; - else - return Ada_File_Name & "." & Osint.ALI_Suffix.all; - end if; - end ALI_File_Name; - - ------------------ - -- Is_Less_Than -- - ------------------ - - function Is_Less_Than (Ref1, Ref2 : Reference) return Boolean is - begin - if Ref1 = null then - return False; - elsif Ref2 = null then - return True; - end if; - - if Ref1.File.File.all < Ref2.File.File.all then - return True; - - elsif Ref1.File.File.all = Ref2.File.File.all then - return (Ref1.Line < Ref2.Line - or else (Ref1.Line = Ref2.Line - and then Ref1.Column < Ref2.Column)); - end if; - - return False; - end Is_Less_Than; - - ------------------ - -- Is_Less_Than -- - ------------------ - - function Is_Less_Than (Decl1, Decl2 : Declaration_Reference) return Boolean - is - -- We cannot store the data case-insensitive in the table, - -- since we wouldn't be able to find the right casing for the - -- display later on. - - S1 : constant String := To_Lower (Decl1.Symbol); - S2 : constant String := To_Lower (Decl2.Symbol); - - begin - if S1 < S2 then - return True; - elsif S1 > S2 then - return False; - end if; - - return Decl1.Key.all < Decl2.Key.all; - end Is_Less_Than; - - ------------------------- - -- Create_Project_File -- - ------------------------- - - procedure Create_Project_File (Name : String) is - Obj_Dir : Unbounded_String := Null_Unbounded_String; - Src_Dir : Unbounded_String := Null_Unbounded_String; - Build_Dir : GNAT.OS_Lib.String_Access := new String'(""); - - F : File_Descriptor; - Len : Positive; - File_Name : aliased String := Name & ASCII.NUL; - - begin - -- Read the size of the file - - F := Open_Read (File_Name'Address, Text); - - -- Project file not found - - if F /= Invalid_FD then - Len := Positive (File_Length (F)); - - declare - Buffer : String (1 .. Len); - Index : Positive := Buffer'First; - Last : Positive; - - begin - Len := Read (F, Buffer'Address, Len); - Close (F); - - -- First, look for Build_Dir, since all the source and object - -- path are relative to it. - - while Index <= Buffer'Last loop - - -- Find the end of line - - Last := Index; - while Last <= Buffer'Last - and then Buffer (Last) /= ASCII.LF - and then Buffer (Last) /= ASCII.CR - loop - Last := Last + 1; - end loop; - - if Index <= Buffer'Last - 9 - and then Buffer (Index .. Index + 9) = "build_dir=" - then - Index := Index + 10; - while Index <= Last - and then (Buffer (Index) = ' ' - or else Buffer (Index) = ASCII.HT) - loop - Index := Index + 1; - end loop; - - Free (Build_Dir); - Build_Dir := new String'(Buffer (Index .. Last - 1)); - end if; - - Index := Last + 1; - - -- In case we had a ASCII.CR/ASCII.LF end of line, skip the - -- remaining symbol - - if Index <= Buffer'Last - and then Buffer (Index) = ASCII.LF - then - Index := Index + 1; - end if; - end loop; - - -- Now parse the source and object paths - - Index := Buffer'First; - while Index <= Buffer'Last loop - - -- Find the end of line - - Last := Index; - while Last <= Buffer'Last - and then Buffer (Last) /= ASCII.LF - and then Buffer (Last) /= ASCII.CR - loop - Last := Last + 1; - end loop; - - if Index <= Buffer'Last - 7 - and then Buffer (Index .. Index + 7) = "src_dir=" - then - Append (Src_Dir, Normalize_Pathname - (Name => Ada.Strings.Fixed.Trim - (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both), - Directory => Build_Dir.all) & Path_Separator); - - elsif Index <= Buffer'Last - 7 - and then Buffer (Index .. Index + 7) = "obj_dir=" - then - Append (Obj_Dir, Normalize_Pathname - (Name => Ada.Strings.Fixed.Trim - (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both), - Directory => Build_Dir.all) & Path_Separator); - end if; - - -- In case we had a ASCII.CR/ASCII.LF end of line, skip the - -- remaining symbol - Index := Last + 1; - - if Index <= Buffer'Last - and then Buffer (Index) = ASCII.LF - then - Index := Index + 1; - end if; - end loop; - end; - end if; - - Osint.Add_Default_Search_Dirs; - - declare - Src : constant String := Parse_Gnatls_Src; - Obj : constant String := Parse_Gnatls_Obj; - - begin - Directories := new Project_File' - (Src_Dir_Length => Length (Src_Dir) + Src'Length, - Obj_Dir_Length => Length (Obj_Dir) + Obj'Length, - Src_Dir => To_String (Src_Dir) & Src, - Obj_Dir => To_String (Obj_Dir) & Obj, - Src_Dir_Index => 1, - Obj_Dir_Index => 1, - Last_Obj_Dir_Start => 0); - end; - - Free (Build_Dir); - end Create_Project_File; - - --------------------- - -- Current_Obj_Dir -- - --------------------- - - function Current_Obj_Dir return String is - begin - return Directories.Obj_Dir - (Directories.Last_Obj_Dir_Start .. Directories.Obj_Dir_Index - 2); - end Current_Obj_Dir; - - ---------------- - -- Get_Column -- - ---------------- - - function Get_Column (Decl : Declaration_Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Column), - Ada.Strings.Left); - end Get_Column; - - function Get_Column (Ref : Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Column), - Ada.Strings.Left); - end Get_Column; - - --------------------- - -- Get_Declaration -- - --------------------- - - function Get_Declaration - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return Declaration_Reference - is - Key : aliased constant String := Key_From_Ref (File_Ref, Line, Column); - - begin - return Entities_HTable.Get (Key'Unchecked_Access); - end Get_Declaration; - - ---------------------- - -- Get_Emit_Warning -- - ---------------------- - - function Get_Emit_Warning (File : File_Reference) return Boolean is - begin - return File.Emit_Warning; - end Get_Emit_Warning; - - -------------- - -- Get_File -- - -------------- - - function Get_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) return String - is - begin - return Get_File (Decl.Decl.File, With_Dir); - end Get_File; - - function Get_File - (Ref : Reference; - With_Dir : Boolean := False) return String - is - begin - return Get_File (Ref.File, With_Dir); - end Get_File; - - function Get_File - (File : File_Reference; - With_Dir : Boolean := False; - Strip : Natural := 0) return String - is - pragma Annotate (CodePeer, Skip_Analysis); - -- Disable CodePeer false positives - - Tmp : GNAT.OS_Lib.String_Access; - - function Internal_Strip (Full_Name : String) return String; - -- Internal function to process the Strip parameter - - -------------------- - -- Internal_Strip -- - -------------------- - - function Internal_Strip (Full_Name : String) return String is - Unit_End : Natural; - Extension_Start : Natural; - S : Natural; - - begin - if Strip = 0 then - return Full_Name; - end if; - - -- Isolate the file extension - - Extension_Start := Full_Name'Last; - while Extension_Start >= Full_Name'First - and then Full_Name (Extension_Start) /= '.' - loop - Extension_Start := Extension_Start - 1; - end loop; - - -- Strip the right number of subunit_names - - S := Strip; - Unit_End := Extension_Start - 1; - while Unit_End >= Full_Name'First - and then S > 0 - loop - if Full_Name (Unit_End) = '-' then - S := S - 1; - end if; - - Unit_End := Unit_End - 1; - end loop; - - if Unit_End < Full_Name'First then - return ""; - else - return Full_Name (Full_Name'First .. Unit_End) - & Full_Name (Extension_Start .. Full_Name'Last); - end if; - end Internal_Strip; - - -- Start of processing for Get_File - - begin - -- If we do not want the full path name - - if not With_Dir then - return Internal_Strip (File.File.all); - end if; - - if File.Dir = null then - if Ada.Strings.Fixed.Tail (File.File.all, 3) = - Osint.ALI_Suffix.all - then - Tmp := Locate_Regular_File - (Internal_Strip (File.File.all), Directories.Obj_Dir); - else - Tmp := Locate_Regular_File - (File.File.all, Directories.Src_Dir); - end if; - - if Tmp = null then - File.Dir := new String'(""); - else - File.Dir := new String'(Dir_Name (Tmp.all)); - Free (Tmp); - end if; - end if; - - return Internal_Strip (File.Dir.all & File.File.all); - end Get_File; - - ------------------ - -- Get_File_Ref -- - ------------------ - - function Get_File_Ref (Ref : Reference) return File_Reference is - begin - return Ref.File; - end Get_File_Ref; - - ----------------------- - -- Get_Gnatchop_File -- - ----------------------- - - function Get_Gnatchop_File - (File : File_Reference; - With_Dir : Boolean := False) - return String - is - begin - if File.Gnatchop_File.all = "" then - return Get_File (File, With_Dir); - else - return File.Gnatchop_File.all; - end if; - end Get_Gnatchop_File; - - function Get_Gnatchop_File - (Ref : Reference; - With_Dir : Boolean := False) - return String - is - begin - return Get_Gnatchop_File (Ref.File, With_Dir); - end Get_Gnatchop_File; - - function Get_Gnatchop_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) - return String - is - begin - return Get_Gnatchop_File (Decl.Decl.File, With_Dir); - end Get_Gnatchop_File; - - -------------- - -- Get_Line -- - -------------- - - function Get_Line (Decl : Declaration_Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Decl.Decl.Line), - Ada.Strings.Left); - end Get_Line; - - function Get_Line (Ref : Reference) return String is - begin - return Ada.Strings.Fixed.Trim (Natural'Image (Ref.Line), - Ada.Strings.Left); - end Get_Line; - - ---------------- - -- Get_Parent -- - ---------------- - - function Get_Parent - (Decl : Declaration_Reference) - return Declaration_Reference - is - begin - return Decl.Par_Symbol; - end Get_Parent; - - --------------------- - -- Get_Source_Line -- - --------------------- - - function Get_Source_Line (Ref : Reference) return String is - begin - if Ref.Source_Line /= null then - return Ref.Source_Line.all; - else - return ""; - end if; - end Get_Source_Line; - - function Get_Source_Line (Decl : Declaration_Reference) return String is - begin - if Decl.Decl.Source_Line /= null then - return Decl.Decl.Source_Line.all; - else - return ""; - end if; - end Get_Source_Line; - - ---------------- - -- Get_Symbol -- - ---------------- - - function Get_Symbol (Decl : Declaration_Reference) return String is - begin - return Decl.Symbol; - end Get_Symbol; - - -------------- - -- Get_Type -- - -------------- - - function Get_Type (Decl : Declaration_Reference) return Character is - begin - return Decl.Decl_Type; - end Get_Type; - - ---------- - -- Sort -- - ---------- - - procedure Sort (Arr : in out Reference_Array) is - Tmp : Reference; - - function Lt (Op1, Op2 : Natural) return Boolean; - procedure Move (From, To : Natural); - -- See GNAT.Heap_Sort_G - - -------- - -- Lt -- - -------- - - function Lt (Op1, Op2 : Natural) return Boolean is - begin - if Op1 = 0 then - return Is_Less_Than (Tmp, Arr (Op2)); - elsif Op2 = 0 then - return Is_Less_Than (Arr (Op1), Tmp); - else - return Is_Less_Than (Arr (Op1), Arr (Op2)); - end if; - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From, To : Natural) is - begin - if To = 0 then - Tmp := Arr (From); - elsif From = 0 then - Arr (To) := Tmp; - else - Arr (To) := Arr (From); - end if; - end Move; - - package Ref_Sort is new GNAT.Heap_Sort_G (Move, Lt); - - -- Start of processing for Sort - - begin - Ref_Sort.Sort (Arr'Last); - end Sort; - - ----------------------- - -- Grep_Source_Files -- - ----------------------- - - procedure Grep_Source_Files is - Length : Natural := 0; - Decl : Declaration_Reference := Entities_HTable.Get_First; - Arr : Reference_Array_Access; - Index : Natural; - End_Index : Natural := 0; - Current_File : File_Reference; - Current_Line : Cst_String_Access; - Buffer : GNAT.OS_Lib.String_Access; - Ref : Reference; - Line : Natural := Natural'Last; - - begin - -- Create a temporary array, where all references will be - -- sorted by files. This way, we only have to read the source - -- files once. - - while Decl /= null loop - - -- Add 1 for the declaration itself - - Length := Length + References_Count (Decl, True, True, True) + 1; - Decl := Entities_HTable.Get_Next; - end loop; - - Arr := new Reference_Array (1 .. Length); - Index := Arr'First; - - Decl := Entities_HTable.Get_First; - while Decl /= null loop - Store_References (Decl, True, True, True, True, Arr.all, Index); - Decl := Entities_HTable.Get_Next; - end loop; - - Sort (Arr.all); - - -- Now traverse the whole array and find the appropriate source - -- lines. - - for R in Arr'Range loop - Ref := Arr (R); - - if Ref.File /= Current_File then - Free (Buffer); - begin - Read_File (Get_File (Ref.File, With_Dir => True), Buffer); - End_Index := Buffer'First - 1; - Line := 0; - exception - when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => - Line := Natural'Last; - end; - Current_File := Ref.File; - end if; - - if Ref.Line > Line then - - -- Do not free Current_Line, it is referenced by the last - -- Ref we processed. - - loop - Index := End_Index + 1; - - loop - End_Index := End_Index + 1; - exit when End_Index > Buffer'Last - or else Buffer (End_Index) = ASCII.LF; - end loop; - - -- Skip spaces at beginning of line - - while Index < End_Index and then - (Buffer (Index) = ' ' or else Buffer (Index) = ASCII.HT) - loop - Index := Index + 1; - end loop; - - Line := Line + 1; - exit when Ref.Line = Line; - end loop; - - Current_Line := new String'(Buffer (Index .. End_Index - 1)); - end if; - - Ref.Source_Line := Current_Line; - end loop; - - Free (Buffer); - Free (Arr); - end Grep_Source_Files; - - --------------- - -- Read_File -- - --------------- - - procedure Read_File - (File_Name : String; - Contents : out GNAT.OS_Lib.String_Access) - is - Name_0 : constant String := File_Name & ASCII.NUL; - FD : constant File_Descriptor := Open_Read (Name_0'Address, Binary); - Length : Natural; - - begin - if FD = Invalid_FD then - raise Ada.Text_IO.Name_Error; - end if; - - -- Include room for EOF char - - Length := Natural (File_Length (FD)); - - declare - Buffer : String (1 .. Length + 1); - This_Read : Integer; - Read_Ptr : Natural := 1; - - begin - loop - This_Read := Read (FD, - A => Buffer (Read_Ptr)'Address, - N => Length + 1 - Read_Ptr); - Read_Ptr := Read_Ptr + Integer'Max (This_Read, 0); - exit when This_Read <= 0; - end loop; - - Buffer (Read_Ptr) := EOF; - Contents := new String'(Buffer (1 .. Read_Ptr)); - - if Read_Ptr /= Length + 1 then - raise Ada.Text_IO.End_Error; - end if; - - Close (FD); - end; - end Read_File; - - ----------------------- - -- Longest_File_Name -- - ----------------------- - - function Longest_File_Name return Natural is - begin - return Longest_File_Name_In_Table; - end Longest_File_Name; - - ----------- - -- Match -- - ----------- - - function Match - (File : File_Reference; - Line : Natural; - Column : Natural) - return Boolean - is - Ref : Ref_In_File_Ptr := File.Lines; - - begin - while Ref /= null loop - if (Ref.Line = 0 or else Ref.Line = Line) - and then (Ref.Column = 0 or else Ref.Column = Column) - then - return True; - end if; - - Ref := Ref.Next; - end loop; - - return False; - end Match; - - ----------- - -- Match -- - ----------- - - function Match (Decl : Declaration_Reference) return Boolean is - begin - return Decl.Match; - end Match; - - ---------- - -- Next -- - ---------- - - function Next (E : File_Reference) return File_Reference is - begin - return E.Next; - end Next; - - function Next (E : Declaration_Reference) return Declaration_Reference is - begin - return E.Next; - end Next; - - ------------------ - -- Next_Obj_Dir -- - ------------------ - - function Next_Obj_Dir return String is - First : constant Integer := Directories.Obj_Dir_Index; - Last : Integer; - - begin - Last := Directories.Obj_Dir_Index; - - if Last > Directories.Obj_Dir_Length then - return String'(1 .. 0 => ' '); - end if; - - while Directories.Obj_Dir (Last) /= Path_Separator loop - Last := Last + 1; - end loop; - - Directories.Obj_Dir_Index := Last + 1; - Directories.Last_Obj_Dir_Start := First; - return Directories.Obj_Dir (First .. Last - 1); - end Next_Obj_Dir; - - ------------------------- - -- Next_Unvisited_File -- - ------------------------- - - function Next_Unvisited_File return File_Reference is - procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (Unvisited_Files_Record, Unvisited_Files_Access); - - Ref : File_Reference; - Tmp : Unvisited_Files_Access; - - begin - if Unvisited_Files = null then - return Empty_File; - else - Tmp := Unvisited_Files; - Ref := Unvisited_Files.File; - Unvisited_Files := Unvisited_Files.Next; - Unchecked_Free (Tmp); - return Ref; - end if; - end Next_Unvisited_File; - - ---------------------- - -- Parse_Gnatls_Src -- - ---------------------- - - function Parse_Gnatls_Src return String is - Length : Natural; - - begin - Length := 0; - for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop - if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then - Length := Length + 2; - else - Length := Length + Osint.Dir_In_Src_Search_Path (J)'Length + 1; - end if; - end loop; - - declare - Result : String (1 .. Length); - L : Natural; - - begin - L := Result'First; - for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop - if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then - Result (L .. L + 1) := "." & Path_Separator; - L := L + 2; - - else - Result (L .. L + Osint.Dir_In_Src_Search_Path (J)'Length - 1) := - Osint.Dir_In_Src_Search_Path (J).all; - L := L + Osint.Dir_In_Src_Search_Path (J)'Length; - Result (L) := Path_Separator; - L := L + 1; - end if; - end loop; - - return Result; - end; - end Parse_Gnatls_Src; - - ---------------------- - -- Parse_Gnatls_Obj -- - ---------------------- - - function Parse_Gnatls_Obj return String is - Length : Natural; - - begin - Length := 0; - for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop - if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then - Length := Length + 2; - else - Length := Length + Osint.Dir_In_Obj_Search_Path (J)'Length + 1; - end if; - end loop; - - declare - Result : String (1 .. Length); - L : Natural; - - begin - L := Result'First; - for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop - if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then - Result (L .. L + 1) := "." & Path_Separator; - L := L + 2; - else - Result (L .. L + Osint.Dir_In_Obj_Search_Path (J)'Length - 1) := - Osint.Dir_In_Obj_Search_Path (J).all; - L := L + Osint.Dir_In_Obj_Search_Path (J)'Length; - Result (L) := Path_Separator; - L := L + 1; - end if; - end loop; - - return Result; - end; - end Parse_Gnatls_Obj; - - ------------------- - -- Reset_Obj_Dir -- - ------------------- - - procedure Reset_Obj_Dir is - begin - Directories.Obj_Dir_Index := 1; - end Reset_Obj_Dir; - - ----------------------- - -- Set_Default_Match -- - ----------------------- - - procedure Set_Default_Match (Value : Boolean) is - begin - Default_Match := Value; - end Set_Default_Match; - - ---------- - -- Free -- - ---------- - - procedure Free (Str : in out Cst_String_Access) is - function Convert is new Ada.Unchecked_Conversion - (Cst_String_Access, GNAT.OS_Lib.String_Access); - - S : GNAT.OS_Lib.String_Access := Convert (Str); - - begin - Free (S); - Str := null; - end Free; - - --------------------- - -- Reset_Directory -- - --------------------- - - procedure Reset_Directory (File : File_Reference) is - begin - Free (File.Dir); - end Reset_Directory; - - ------------------- - -- Set_Unvisited -- - ------------------- - - procedure Set_Unvisited (File_Ref : File_Reference) is - F : constant String := Get_File (File_Ref, With_Dir => False); - - begin - File_Ref.Visited := False; - - -- Do not add a source file to the list. This is true for gnatxref - -- gnatfind, so good enough. - - if F'Length > 4 - and then F (F'Last - 3 .. F'Last) = "." & Osint.ALI_Suffix.all - then - Unvisited_Files := new Unvisited_Files_Record' - (File => File_Ref, - Next => Unvisited_Files); - end if; - end Set_Unvisited; - - ---------------------- - -- Get_Declarations -- - ---------------------- - - function Get_Declarations - (Sorted : Boolean := True) - return Declaration_Array_Access - is - Arr : constant Declaration_Array_Access := - new Declaration_Array (1 .. Entities_Count); - Decl : Declaration_Reference := Entities_HTable.Get_First; - Index : Natural := Arr'First; - Tmp : Declaration_Reference; - - procedure Move (From : Natural; To : Natural); - function Lt (Op1, Op2 : Natural) return Boolean; - -- See GNAT.Heap_Sort_G - - -------- - -- Lt -- - -------- - - function Lt (Op1, Op2 : Natural) return Boolean is - begin - if Op1 = 0 then - return Is_Less_Than (Tmp, Arr (Op2)); - elsif Op2 = 0 then - return Is_Less_Than (Arr (Op1), Tmp); - else - return Is_Less_Than (Arr (Op1), Arr (Op2)); - end if; - end Lt; - - ---------- - -- Move -- - ---------- - - procedure Move (From : Natural; To : Natural) is - begin - if To = 0 then - Tmp := Arr (From); - elsif From = 0 then - Arr (To) := Tmp; - else - Arr (To) := Arr (From); - end if; - end Move; - - package Decl_Sort is new GNAT.Heap_Sort_G (Move, Lt); - - -- Start of processing for Get_Declarations - - begin - while Decl /= null loop - Arr (Index) := Decl; - Index := Index + 1; - Decl := Entities_HTable.Get_Next; - end loop; - - if Sorted and then Arr'Length /= 0 then - Decl_Sort.Sort (Entities_Count); - end if; - - return Arr; - end Get_Declarations; - - ---------------------- - -- References_Count -- - ---------------------- - - function References_Count - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Natural - is - function List_Length (E : Reference) return Natural; - -- Return the number of references in E - - ----------------- - -- List_Length -- - ----------------- - - function List_Length (E : Reference) return Natural is - L : Natural := 0; - E1 : Reference := E; - - begin - while E1 /= null loop - L := L + 1; - E1 := E1.Next; - end loop; - - return L; - end List_Length; - - Length : Natural := 0; - - -- Start of processing for References_Count - - begin - if Get_Reads then - Length := List_Length (Decl.Ref_Ref); - end if; - - if Get_Writes then - Length := Length + List_Length (Decl.Modif_Ref); - end if; - - if Get_Bodies then - Length := Length + List_Length (Decl.Body_Ref); - end if; - - return Length; - end References_Count; - - ---------------------- - -- Store_References -- - ---------------------- - - procedure Store_References - (Decl : Declaration_Reference; - Get_Writes : Boolean := False; - Get_Reads : Boolean := False; - Get_Bodies : Boolean := False; - Get_Declaration : Boolean := False; - Arr : in out Reference_Array; - Index : in out Natural) - is - procedure Add (List : Reference); - -- Add all the references in List to Arr - - --------- - -- Add -- - --------- - - procedure Add (List : Reference) is - E : Reference := List; - begin - while E /= null loop - Arr (Index) := E; - Index := Index + 1; - E := E.Next; - end loop; - end Add; - - -- Start of processing for Store_References - - begin - if Get_Declaration then - Add (Decl.Decl); - end if; - - if Get_Reads then - Add (Decl.Ref_Ref); - end if; - - if Get_Writes then - Add (Decl.Modif_Ref); - end if; - - if Get_Bodies then - Add (Decl.Body_Ref); - end if; - end Store_References; - - -------------------- - -- Get_References -- - -------------------- - - function Get_References - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Reference_Array_Access - is - Length : constant Natural := - References_Count (Decl, Get_Reads, Get_Writes, Get_Bodies); - - Arr : constant Reference_Array_Access := - new Reference_Array (1 .. Length); - - Index : Natural := Arr'First; - - begin - Store_References - (Decl => Decl, - Get_Writes => Get_Writes, - Get_Reads => Get_Reads, - Get_Bodies => Get_Bodies, - Get_Declaration => False, - Arr => Arr.all, - Index => Index); - - if Arr'Length /= 0 then - Sort (Arr.all); - end if; - - return Arr; - end Get_References; - - ---------- - -- Free -- - ---------- - - procedure Free (Arr : in out Reference_Array_Access) is - procedure Internal is new Ada.Unchecked_Deallocation - (Reference_Array, Reference_Array_Access); - begin - Internal (Arr); - end Free; - - ------------------ - -- Is_Parameter -- - ------------------ - - function Is_Parameter (Decl : Declaration_Reference) return Boolean is - begin - return Decl.Is_Parameter; - end Is_Parameter; - -end Xr_Tabls; diff --git a/gcc/ada/xr_tabls.ads b/gcc/ada/xr_tabls.ads deleted file mode 100644 index e8662b79c72..00000000000 --- a/gcc/ada/xr_tabls.ads +++ /dev/null @@ -1,388 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R _ T A B L S -- --- -- --- S p e c -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Cross reference utilities used by gnatxref and gnatfind - -with GNAT.OS_Lib; - -package Xr_Tabls is - - ------------------- - -- Project files -- - ------------------- - - function ALI_File_Name (Ada_File_Name : String) return String; - -- Returns the ali file name corresponding to Ada_File_Name - - procedure Create_Project_File (Name : String); - -- Open and parse a new project file. If the file Name could not be - -- opened or is not a valid project file, then a project file associated - -- with the standard default directories is returned - - function Next_Obj_Dir return String; - -- Returns the next directory to visit to find related ali files - -- If there are no more such directories, returns a null string. - - function Current_Obj_Dir return String; - -- Returns the obj_dir which was returned by the last Next_Obj_Dir call - - procedure Reset_Obj_Dir; - -- Reset the iterator for Obj_Dir - - ------------ - -- Tables -- - ------------ - - type Declaration_Reference is private; - Empty_Declaration : constant Declaration_Reference; - - type Declaration_Array is array (Natural range <>) of Declaration_Reference; - type Declaration_Array_Access is access Declaration_Array; - - type File_Reference is private; - Empty_File : constant File_Reference; - - type Reference is private; - Empty_Reference : constant Reference; - - type Reference_Array is array (Natural range <>) of Reference; - type Reference_Array_Access is access Reference_Array; - - procedure Free (Arr : in out Reference_Array_Access); - - function Add_Declaration - (File_Ref : File_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - Decl_Type : Character; - Is_Parameter : Boolean := False; - Remove_Only : Boolean := False; - Symbol_Match : Boolean := True) - return Declaration_Reference; - -- Add a new declaration in the table and return the index to it. Decl_Type - -- is the type of the entity Any previous instance of this entity in the - -- htable is removed. If Remove_Only is True, then any previous instance is - -- removed, but the new entity is never inserted. Symbol_Match should be - -- set to False if the name of the symbol doesn't match the pattern from - -- the command line. In that case, the entity will not be output by - -- gnatfind. If Symbol_Match is True, the entity will only be output if - -- the file name itself matches. Is_Parameter should be set to True if - -- the entity is known to be a subprogram parameter. - - procedure Add_Parent - (Declaration : in out Declaration_Reference; - Symbol : String; - Line : Natural; - Column : Natural; - File_Ref : File_Reference); - -- The parent declaration (Symbol in file File_Ref at position Line and - -- Column) information is added to Declaration. - - function Add_To_Xref_File - (File_Name : String; - Visited : Boolean := True; - Emit_Warning : Boolean := False; - Gnatchop_File : String := ""; - Gnatchop_Offset : Integer := 0) - return File_Reference; - -- Add a new reference to a file in the table. Ref is used to return the - -- index in the table where this file is stored. Visited is the value which - -- will be used in the table (if True, the file will not be returned by - -- Next_Unvisited_File). If Emit_Warning is True and the ali file does - -- not exist or does not have cross-referencing information, then a - -- warning will be emitted. Gnatchop_File is the name of the file that - -- File_Name was extracted from through a call to "gnatchop -r" (using - -- pragma Source_Reference). Gnatchop_Offset should be the index of the - -- first line of File_Name within the Gnatchop_File. - - procedure Add_Line - (File : File_Reference; - Line : Natural; - Column : Natural); - -- Add a new reference in a file, which the user has provided on the - -- command line. This is used for an optimized matching algorithm. - - procedure Add_Reference - (Declaration : Declaration_Reference; - File_Ref : File_Reference; - Line : Natural; - Column : Natural; - Ref_Type : Character; - Labels_As_Ref : Boolean); - -- Add a new reference (Ref_Type = 'r'), body (Ref_Type = 'b') or - -- modification (Ref_Type = 'm') to an entity. If Labels_As_Ref is True, - -- then the references to the entity after the end statements ("end Foo") - -- are counted as actual references. This means that the entity will never - -- be reported as unreferenced (for instance in the case of gnatxref -u). - - function Get_Declarations - (Sorted : Boolean := True) - return Declaration_Array_Access; - -- Return a sorted list of all the declarations in the application. - -- Freeing this array is the responsibility of the caller, however it - -- shouldn't free the actual contents of the array, which are pointers - -- to internal data - - function References_Count - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Natural; - -- Return the number of references in Decl for the categories specified - -- by the Get_* parameters (read-only accesses, write accesses and bodies) - - function Get_References - (Decl : Declaration_Reference; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - return Reference_Array_Access; - -- Return a sorted list of all references to the entity in decl. The - -- parameters Get_* are used to specify what kind of references should be - -- merged and returned (read-only accesses, write accesses and bodies). - - function Get_Column (Decl : Declaration_Reference) return String; - function Get_Column (Ref : Reference) return String; - - function Get_Declaration - (File_Ref : File_Reference; - Line : Natural; - Column : Natural) - return Declaration_Reference; - -- Returns reference to the declaration found in file File_Ref at the - -- given Line and Column - - function Get_Parent - (Decl : Declaration_Reference) - return Declaration_Reference; - -- Returns reference to Decl's parent declaration - - function Get_Emit_Warning (File : File_Reference) return Boolean; - -- Returns the Emit_Warning field of the structure - - function Get_Gnatchop_File - (File : File_Reference; - With_Dir : Boolean := False) - return String; - function Get_Gnatchop_File - (Ref : Reference; - With_Dir : Boolean := False) - return String; - function Get_Gnatchop_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) - return String; - -- Return the name of the file that File was extracted from through a - -- call to "gnatchop -r". The file name for File is returned if File - -- was not extracted from such a file. The directory will be given only - -- if With_Dir is True. - - function Get_File - (Decl : Declaration_Reference; - With_Dir : Boolean := False) return String; - pragma Inline (Get_File); - -- Extract column number or file name from reference - - function Get_File - (Ref : Reference; - With_Dir : Boolean := False) return String; - pragma Inline (Get_File); - - function Get_File - (File : File_Reference; - With_Dir : Boolean := False; - Strip : Natural := 0) return String; - -- Returns the file name (and its directory if With_Dir is True or the user - -- has used the -f switch on the command line. If Strip is not 0, then the - -- last Strip-th "-..." substrings are removed first. For instance, with - -- Strip=2, a file name "parent-child1-child2-child3.ali" would be returned - -- as "parent-child1.ali". This is used when looking for the ALI file to - -- use for a package, since for separates with have to use the parent's - -- ALI. The null string is returned if there is no such parent unit. - -- - -- Note that this version of Get_File is not inlined - - function Get_File_Ref (Ref : Reference) return File_Reference; - function Get_Line (Decl : Declaration_Reference) return String; - function Get_Line (Ref : Reference) return String; - function Get_Symbol (Decl : Declaration_Reference) return String; - function Get_Type (Decl : Declaration_Reference) return Character; - function Is_Parameter (Decl : Declaration_Reference) return Boolean; - -- Functions that return the contents of a declaration - - function Get_Source_Line (Ref : Reference) return String; - function Get_Source_Line (Decl : Declaration_Reference) return String; - -- Return the source line associated with the reference - - procedure Grep_Source_Files; - -- Parse all the source files which have at least one reference, and grep - -- the appropriate source lines so that we'll be able to display them. This - -- function should be called once all the .ali files have been parsed, and - -- only if the appropriate user switch - -- has been used (gnatfind -s). - -- - -- Note: To save memory, the strings for the source lines are shared. Thus - -- it is no longer possible to free the references, or we would free the - -- same chunk multiple times. It doesn't matter, though, since this is only - -- called once, prior to exiting gnatfind. - - function Longest_File_Name return Natural; - -- Returns the longest file name found - - function Match (Decl : Declaration_Reference) return Boolean; - -- Return True if the declaration matches - - function Match - (File : File_Reference; - Line : Natural; - Column : Natural) - return Boolean; - -- Returns True if File:Line:Column was given on the command line - -- by the user - - function Next_Unvisited_File return File_Reference; - -- Returns the next unvisited library file in the list If there is no more - -- unvisited file, return Empty_File. Two calls to this subprogram will - -- return different files. - - procedure Set_Default_Match (Value : Boolean); - -- Set the default value for match in declarations. - -- This is used so that if no file was provided in the - -- command line, then every file match - - procedure Reset_Directory (File : File_Reference); - -- Reset the cached directory for file. Next time Get_File is called, the - -- directory will be recomputed. - - procedure Set_Unvisited (File_Ref : File_Reference); - -- Set File_Ref as unvisited. So Next_Unvisited_File will return it - - procedure Read_File - (File_Name : String; - Contents : out GNAT.OS_Lib.String_Access); - -- Reads File_Name into the newly allocated string Contents. Types.EOF - -- character will be added to the returned Contents to simplify parsing. - -- Name_Error is raised if the file was not found. End_Error is raised if - -- the file could not be read correctly. For most systems correct reading - -- means that the number of bytes read is equal to the file size. - -private - type Project_File (Src_Dir_Length, Obj_Dir_Length : Natural) is record - Src_Dir_Index : Integer; - Obj_Dir_Index : Integer; - Last_Obj_Dir_Start : Natural; - Src_Dir : String (1 .. Src_Dir_Length); - Obj_Dir : String (1 .. Obj_Dir_Length); - end record; - - type Project_File_Ptr is access all Project_File; - -- This is actually a list of all the directories to be searched, - -- either for source files or for library files - - type Ref_In_File; - type Ref_In_File_Ptr is access all Ref_In_File; - - type Ref_In_File is record - Line : Natural; - Column : Natural; - Next : Ref_In_File_Ptr := null; - end record; - - type File_Record; - type File_Reference is access all File_Record; - - Empty_File : constant File_Reference := null; - type Cst_String_Access is access constant String; - - procedure Free (Str : in out Cst_String_Access); - - type File_Record is record - File : Cst_String_Access; - Dir : GNAT.OS_Lib.String_Access; - Lines : Ref_In_File_Ptr := null; - Visited : Boolean := False; - Emit_Warning : Boolean := False; - Gnatchop_File : GNAT.OS_Lib.String_Access := null; - Gnatchop_Offset : Integer := 0; - Next : File_Reference := null; - end record; - -- Holds a reference to a source file, that was referenced in at least one - -- ALI file. Gnatchop_File will contain the name of the file that File was - -- extracted From. Gnatchop_Offset contains the index of the first line of - -- File within Gnatchop_File. These two fields are used to properly support - -- gnatchop files and pragma Source_Reference. - -- - -- Lines is used for files that were given on the command line, to - -- memorize the lines and columns that the user specified. - - type Reference_Record; - type Reference is access all Reference_Record; - - Empty_Reference : constant Reference := null; - - type Reference_Record is record - File : File_Reference; - Line : Natural; - Column : Natural; - Source_Line : Cst_String_Access; - Next : Reference := null; - end record; - -- File is a reference to the Ada source file - -- Source_Line is the Line as it appears in the source file. This - -- field is only used when the switch is set on the command line of - -- gnatfind. - - type Declaration_Record; - type Declaration_Reference is access all Declaration_Record; - - Empty_Declaration : constant Declaration_Reference := null; - - type Declaration_Record (Symbol_Length : Natural) is record - Key : Cst_String_Access; - Decl : Reference; - Is_Parameter : Boolean := False; -- True if entity is subprog param - Decl_Type : Character; - Body_Ref : Reference := null; - Ref_Ref : Reference := null; - Modif_Ref : Reference := null; - Match : Boolean := False; - Par_Symbol : Declaration_Reference := null; - Next : Declaration_Reference := null; - Symbol : String (1 .. Symbol_Length); - end record; - -- The lists of referenced (Body_Ref, Ref_Ref and Modif_Ref) are - -- kept unsorted until the results needs to be printed. This saves - -- lots of time while the internal tables are created. - - pragma Inline (Get_Column); - pragma Inline (Get_Emit_Warning); - pragma Inline (Get_File_Ref); - pragma Inline (Get_Line); - pragma Inline (Get_Symbol); - pragma Inline (Get_Type); - pragma Inline (Longest_File_Name); -end Xr_Tabls; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb deleted file mode 100644 index 3cb7bcb8469..00000000000 --- a/gcc/ada/xref_lib.adb +++ /dev/null @@ -1,1892 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R E F _ L I B -- --- -- --- B o d y -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Ada_2012; - -with Osint; -with Output; use Output; -with Types; use Types; - -with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Text_IO; -with Ada.Unchecked_Deallocation; - -with GNAT.Command_Line; use GNAT.Command_Line; -with GNAT.IO_Aux; use GNAT.IO_Aux; - -package body Xref_Lib is - - Type_Position : constant := 50; - -- Column for label identifying type of entity - - --------------------- - -- Local Variables -- - --------------------- - - Pipe : constant Character := '|'; - -- First character on xref lines in the .ali file - - No_Xref_Information : exception; - -- Exception raised when there is no cross-referencing information in - -- the .ali files. - - procedure Parse_EOL - (Source : not null access String; - Ptr : in out Positive; - Skip_Continuation_Line : Boolean := False); - -- On return Source (Ptr) is the first character of the next line - -- or EOF. Source.all must be terminated by EOF. - -- - -- If Skip_Continuation_Line is True, this subprogram skips as many - -- lines as required when the second or more lines starts with '.' - -- (continuation lines in ALI files). - - function Current_Xref_File (File : ALI_File) return File_Reference; - -- Return the file matching the last 'X' line we found while parsing - -- the ALI file. - - function File_Name (File : ALI_File; Num : Positive) return File_Reference; - -- Returns the dependency file name number Num - - function Get_Full_Type (Decl : Declaration_Reference) return String; - -- Returns the full type corresponding to a type letter as found in - -- the .ali files. - - procedure Open - (Name : String; - File : in out ALI_File; - Dependencies : Boolean := False); - -- Open a new ALI file. If Dependencies is True, the insert every library - -- file 'with'ed in the files database (used for gnatxref) - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True; - Labels_As_Ref : Boolean := True); - -- Output the file and the line where the identifier was referenced, - -- If Local_Symbols is False then only the publicly visible symbols - -- will be processed. - -- - -- If Labels_As_Ref is true, then the references to the entities after - -- the end statements ("end Foo") will be counted as actual references. - -- The entity will never be reported as unreferenced by gnatxref -u - - procedure Parse_Token - (Source : not null access String; - Ptr : in out Positive; - Token_Ptr : out Positive); - -- Skips any separators and stores the start of the token in Token_Ptr. - -- Then stores the position of the next separator in Ptr. On return - -- Source (Token_Ptr .. Ptr - 1) is the token. Separators are space - -- and ASCII.HT. Parse_Token will never skip to the next line. - - procedure Parse_Number - (Source : not null access String; - Ptr : in out Positive; - Number : out Natural); - -- Skips any separators and parses Source up to the first character that - -- is not a decimal digit. Returns value of parsed digits or 0 if none. - - procedure Parse_X_Filename (File : in out ALI_File); - -- Reads and processes "X..." lines in the ALI file - -- and updates the File.X_File information. - - procedure Skip_To_First_X_Line - (File : in out ALI_File; - D_Lines : Boolean; - W_Lines : Boolean); - -- Skip the lines in the ALI file until the first cross-reference line - -- (^X...) is found. Search is started from the beginning of the file. - -- If not such line is found, No_Xref_Information is raised. - -- If W_Lines is false, then the lines "^W" are not parsed. - -- If D_Lines is false, then the lines "^D" are not parsed. - - ---------------- - -- Add_Entity -- - ---------------- - - procedure Add_Entity - (Pattern : in out Search_Pattern; - Entity : String; - Glob : Boolean := False) - is - File_Start : Natural; - Line_Start : Natural; - Col_Start : Natural; - Line_Num : Natural := 0; - Col_Num : Natural := 0; - - File_Ref : File_Reference := Empty_File; - pragma Warnings (Off, File_Ref); - - begin - -- Find the end of the first item in Entity (pattern or file?) - -- If there is no ':', we only have a pattern - - File_Start := Index (Entity, ":"); - - -- If the regular expression is invalid, just consider it as a string - - if File_Start = 0 then - begin - Pattern.Entity := Compile (Entity, Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * Entity'Length); - Index : Positive := 1; - - begin - for J in Entity'Range loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - Set_Default_Match (True); - return; - end if; - - -- If there is a dot in the pattern, then it is a file name - - if (Glob and then - Index (Entity (Entity'First .. File_Start - 1), ".") /= 0) - or else - (not Glob - and then Index (Entity (Entity'First .. File_Start - 1), - "\.") /= 0) - then - Pattern.Entity := Compile (".*", False); - Pattern.Initialized := True; - File_Start := Entity'First; - - else - -- If the regular expression is invalid, just consider it as a string - - begin - Pattern.Entity := - Compile (Entity (Entity'First .. File_Start - 1), Glob, False); - Pattern.Initialized := True; - - exception - when Error_In_Regexp => - - -- The basic idea is to insert a \ before every character - - declare - Tmp_Regexp : String (1 .. 2 * (File_Start - Entity'First)); - Index : Positive := 1; - - begin - for J in Entity'First .. File_Start - 1 loop - Tmp_Regexp (Index) := '\'; - Tmp_Regexp (Index + 1) := Entity (J); - Index := Index + 2; - end loop; - - Pattern.Entity := Compile (Tmp_Regexp, True, False); - Pattern.Initialized := True; - end; - end; - - File_Start := File_Start + 1; - end if; - - -- Parse the file name - - Line_Start := Index (Entity (File_Start .. Entity'Last), ":"); - - -- Check if it was a disk:\directory item (for Windows) - - if File_Start = Line_Start - 1 - and then Line_Start < Entity'Last - and then Entity (Line_Start + 1) = '\' - then - Line_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - end if; - - if Line_Start = 0 then - Line_Start := Entity'Length + 1; - - elsif Line_Start /= Entity'Last then - Col_Start := Index (Entity (Line_Start + 1 .. Entity'Last), ":"); - - if Col_Start = 0 then - Col_Start := Entity'Last + 1; - end if; - - if Col_Start > Line_Start + 1 then - begin - Line_Num := Natural'Value - (Entity (Line_Start + 1 .. Col_Start - 1)); - - exception - when Constraint_Error => - raise Invalid_Argument; - end; - end if; - - if Col_Start < Entity'Last then - begin - Col_Num := Natural'Value (Entity - (Col_Start + 1 .. Entity'Last)); - - exception - when Constraint_Error => raise Invalid_Argument; - end; - end if; - end if; - - declare - File_Name : String := Entity (File_Start .. Line_Start - 1); - - begin - Osint.Canonical_Case_File_Name (File_Name); - File_Ref := Add_To_Xref_File (File_Name, Visited => True); - Pattern.File_Ref := File_Ref; - - Add_Line (Pattern.File_Ref, Line_Num, Col_Num); - - File_Ref := - Add_To_Xref_File - (ALI_File_Name (File_Name), - Visited => False, - Emit_Warning => True); - end; - end Add_Entity; - - ------------------- - -- Add_Xref_File -- - ------------------- - - procedure Add_Xref_File (File : String) is - File_Ref : File_Reference := Empty_File; - pragma Unreferenced (File_Ref); - - Iterator : Expansion_Iterator; - - procedure Add_Xref_File_Internal (File : String); - -- Do the actual addition of the file - - ---------------------------- - -- Add_Xref_File_Internal -- - ---------------------------- - - procedure Add_Xref_File_Internal (File : String) is - begin - -- Case where we have an ALI file, accept it even though this is - -- not official usage, since the intention is obvious - - if Tail (File, 4) = "." & Osint.ALI_Suffix.all then - File_Ref := Add_To_Xref_File - (File, Visited => False, Emit_Warning => True); - - -- Normal non-ali file case - - else - File_Ref := Add_To_Xref_File (File, Visited => True); - - File_Ref := Add_To_Xref_File - (ALI_File_Name (File), - Visited => False, Emit_Warning => True); - end if; - end Add_Xref_File_Internal; - - -- Start of processing for Add_Xref_File - - begin - -- Check if we need to do the expansion - - if Ada.Strings.Fixed.Index (File, "*") /= 0 - or else Ada.Strings.Fixed.Index (File, "?") /= 0 - then - Start_Expansion (Iterator, File); - - loop - declare - S : constant String := Expansion (Iterator); - - begin - exit when S'Length = 0; - Add_Xref_File_Internal (S); - end; - end loop; - - else - Add_Xref_File_Internal (File); - end if; - end Add_Xref_File; - - ----------------------- - -- Current_Xref_File -- - ----------------------- - - function Current_Xref_File (File : ALI_File) return File_Reference is - begin - return File.X_File; - end Current_Xref_File; - - -------------------------- - -- Default_Project_File -- - -------------------------- - - function Default_Project_File (Dir_Name : String) return String is - My_Dir : Dir_Type; - Dir_Ent : File_Name_String; - Last : Natural; - - begin - Open (My_Dir, Dir_Name); - - loop - Read (My_Dir, Dir_Ent, Last); - exit when Last = 0; - - if Tail (Dir_Ent (1 .. Last), 4) = ".adp" then - - -- The first project file found is the good one - - Close (My_Dir); - return Dir_Ent (1 .. Last); - end if; - end loop; - - Close (My_Dir); - return String'(1 .. 0 => ' '); - - exception - when Directory_Error => return String'(1 .. 0 => ' '); - end Default_Project_File; - - --------------- - -- File_Name -- - --------------- - - function File_Name - (File : ALI_File; - Num : Positive) return File_Reference - is - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - begin - return Table (Num); - end File_Name; - - -------------------- - -- Find_ALI_Files -- - -------------------- - - procedure Find_ALI_Files is - My_Dir : Rec_DIR; - Dir_Ent : File_Name_String; - Last : Natural; - - File_Ref : File_Reference; - pragma Unreferenced (File_Ref); - - function Open_Next_Dir return Boolean; - -- Tries to open the next object directory, and return False if - -- the directory cannot be opened. - - ------------------- - -- Open_Next_Dir -- - ------------------- - - function Open_Next_Dir return Boolean is - begin - -- Until we are able to open a new directory - - loop - declare - Obj_Dir : constant String := Next_Obj_Dir; - - begin - -- Case of no more Obj_Dir lines - - if Obj_Dir'Length = 0 then - return False; - end if; - - Open (My_Dir.Dir, Obj_Dir); - exit; - - exception - - -- Could not open the directory - - when Directory_Error => null; - end; - end loop; - - return True; - end Open_Next_Dir; - - -- Start of processing for Find_ALI_Files - - begin - Reset_Obj_Dir; - - if Open_Next_Dir then - loop - Read (My_Dir.Dir, Dir_Ent, Last); - - if Last = 0 then - Close (My_Dir.Dir); - - if not Open_Next_Dir then - return; - end if; - - elsif Last > 4 - and then Dir_Ent (Last - 3 .. Last) = "." & Osint.ALI_Suffix.all - then - File_Ref := - Add_To_Xref_File (Dir_Ent (1 .. Last), Visited => False); - end if; - end loop; - end if; - end Find_ALI_Files; - - ------------------- - -- Get_Full_Type -- - ------------------- - - function Get_Full_Type (Decl : Declaration_Reference) return String is - - function Param_String return String; - -- Return the string to display depending on whether Decl is a parameter - - ------------------ - -- Param_String -- - ------------------ - - function Param_String return String is - begin - if Is_Parameter (Decl) then - return "parameter "; - else - return ""; - end if; - end Param_String; - - -- Start of processing for Get_Full_Type - - begin - case Get_Type (Decl) is - when 'A' => return "array type"; - when 'B' => return "boolean type"; - when 'C' => return "class-wide type"; - when 'D' => return "decimal type"; - when 'E' => return "enumeration type"; - when 'F' => return "float type"; - when 'H' => return "abstract type"; - when 'I' => return "integer type"; - when 'M' => return "modular type"; - when 'O' => return "fixed type"; - when 'P' => return "access type"; - when 'R' => return "record type"; - when 'S' => return "string type"; - when 'T' => return "task type"; - when 'W' => return "protected type"; - - when 'a' => return Param_String & "array object"; - when 'b' => return Param_String & "boolean object"; - when 'c' => return Param_String & "class-wide object"; - when 'd' => return Param_String & "decimal object"; - when 'e' => return Param_String & "enumeration object"; - when 'f' => return Param_String & "float object"; - when 'i' => return Param_String & "integer object"; - when 'j' => return Param_String & "class object"; - when 'm' => return Param_String & "modular object"; - when 'o' => return Param_String & "fixed object"; - when 'p' => return Param_String & "access object"; - when 'r' => return Param_String & "record object"; - when 's' => return Param_String & "string object"; - when 't' => return Param_String & "task object"; - when 'w' => return Param_String & "protected object"; - when 'x' => return Param_String & "abstract procedure"; - when 'y' => return Param_String & "abstract function"; - - when 'h' => return "interface"; - when 'g' => return "macro"; - when 'G' => return "function macro"; - when 'J' => return "class"; - when 'K' => return "package"; - when 'k' => return "generic package"; - when 'L' => return "statement label"; - when 'l' => return "loop label"; - when 'N' => return "named number"; - when 'n' => return "enumeration literal"; - when 'q' => return "block label"; - when 'Q' => return "include file"; - when 'U' => return "procedure"; - when 'u' => return "generic procedure"; - when 'V' => return "function"; - when 'v' => return "generic function"; - when 'X' => return "exception"; - when 'Y' => return "entry"; - - when '+' => return "private type"; - when '*' => return "private variable"; - - -- The above should be the only possibilities, but for this kind - -- of informational output, we don't want to bomb if we find - -- something else, so just return three question marks when we - -- have an unknown Abbrev value - - when others => - if Is_Parameter (Decl) then - return "parameter"; - else - return "??? (" & Get_Type (Decl) & ")"; - end if; - end case; - end Get_Full_Type; - - -------------------------- - -- Skip_To_First_X_Line -- - -------------------------- - - procedure Skip_To_First_X_Line - (File : in out ALI_File; - D_Lines : Boolean; - W_Lines : Boolean) - is - Ali : String_Access renames File.Buffer; - Token : Positive; - Ptr : Positive := Ali'First; - Num_Dependencies : Natural := 0; - File_Start : Positive; - File_End : Positive; - Gnatchop_Offset : Integer; - Gnatchop_Name : Positive; - - File_Ref : File_Reference; - pragma Unreferenced (File_Ref); - - begin - -- Read all the lines possibly processing with-clauses and dependency - -- information and exit on finding the first Xref line. - -- A fall-through of the loop means that there is no xref information - -- which is an error condition. - - while Ali (Ptr) /= EOF loop - if D_Lines and then Ali (Ptr) = 'D' then - - -- Found dependency information. Format looks like: - -- D src-nam time-stmp checksum [subunit-name] [line:file-name] - - -- Skip the D and parse the filenam - - Ptr := Ptr + 1; - Parse_Token (Ali, Ptr, Token); - File_Start := Token; - File_End := Ptr - 1; - - Num_Dependencies := Num_Dependencies + 1; - Set_Last (File.Dep, Num_Dependencies); - - Parse_Token (Ali, Ptr, Token); -- Skip time-stamp - Parse_Token (Ali, Ptr, Token); -- Skip checksum - Parse_Token (Ali, Ptr, Token); -- Read next entity on the line - - if not (Ali (Token) in '0' .. '9') then - Parse_Token (Ali, Ptr, Token); -- Was a subunit name - end if; - - -- Did we have a gnatchop-ed file with a pragma Source_Reference ? - - Gnatchop_Offset := 0; - - if Ali (Token) in '0' .. '9' then - Gnatchop_Name := Token; - while Ali (Gnatchop_Name) /= ':' loop - Gnatchop_Name := Gnatchop_Name + 1; - end loop; - - Gnatchop_Offset := - 2 - Natural'Value (Ali (Token .. Gnatchop_Name - 1)); - Token := Gnatchop_Name + 1; - end if; - - declare - Table : Table_Type renames - File.Dep.Table (1 .. Last (File.Dep)); - begin - Table (Num_Dependencies) := Add_To_Xref_File - (Ali (File_Start .. File_End), - Gnatchop_File => Ali (Token .. Ptr - 1), - Gnatchop_Offset => Gnatchop_Offset); - end; - - elsif W_Lines and then Ali (Ptr) = 'W' then - - -- Found with-clause information. Format looks like: - -- "W debug%s debug.adb debug.ali" - - -- Skip the W and parse the .ali filename (3rd token) - - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - Parse_Token (Ali, Ptr, Token); - - File_Ref := - Add_To_Xref_File (Ali (Token .. Ptr - 1), Visited => False); - - elsif Ali (Ptr) = 'X' then - - -- Found a cross-referencing line - stop processing - - File.Current_Line := Ptr; - File.Xref_Line := Ptr; - return; - end if; - - Parse_EOL (Ali, Ptr); - end loop; - - raise No_Xref_Information; - end Skip_To_First_X_Line; - - ---------- - -- Open -- - ---------- - - procedure Open - (Name : String; - File : in out ALI_File; - Dependencies : Boolean := False) - is - Ali : String_Access renames File.Buffer; - pragma Warnings (Off, Ali); - - begin - if File.Buffer /= null then - Free (File.Buffer); - end if; - - Init (File.Dep); - - begin - Read_File (Name, Ali); - - exception - when Ada.Text_IO.Name_Error | Ada.Text_IO.End_Error => - raise No_Xref_Information; - end; - - Skip_To_First_X_Line (File, D_Lines => True, W_Lines => Dependencies); - end Open; - - --------------- - -- Parse_EOL -- - --------------- - - procedure Parse_EOL - (Source : not null access String; - Ptr : in out Positive; - Skip_Continuation_Line : Boolean := False) - is - begin - loop - pragma Assert (Source (Ptr) /= EOF); - - -- Skip to end of line - - while Source (Ptr) /= ASCII.CR and then Source (Ptr) /= ASCII.LF - and then Source (Ptr) /= EOF - loop - Ptr := Ptr + 1; - end loop; - - -- Skip CR or LF if not at end of file - - if Source (Ptr) /= EOF then - Ptr := Ptr + 1; - end if; - - -- Skip past CR/LF - - if Source (Ptr - 1) = ASCII.CR and then Source (Ptr) = ASCII.LF then - Ptr := Ptr + 1; - end if; - - exit when not Skip_Continuation_Line or else Source (Ptr) /= '.'; - end loop; - end Parse_EOL; - - --------------------------- - -- Parse_Identifier_Info -- - --------------------------- - - procedure Parse_Identifier_Info - (Pattern : Search_Pattern; - File : in out ALI_File; - Local_Symbols : Boolean; - Der_Info : Boolean := False; - Type_Tree : Boolean := False; - Wide_Search : Boolean := True; - Labels_As_Ref : Boolean := True) - is - Ptr : Positive renames File.Current_Line; - Ali : String_Access renames File.Buffer; - - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Name : Positive; -- Pointer to begin of entity name - E_Global : Boolean; -- True iff entity is global - E_Type : Character; -- Type of current entity - - R_Line : Natural; -- Line number of current reference - R_Col : Natural; -- Column number of current reference - - R_Type : Character := ASCII.NUL; -- Type of current reference - - Decl_Ref : Declaration_Reference; - File_Ref : File_Reference := Current_Xref_File (File); - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String; - -- Returns the symbol name for the entity defined at the specified - -- line and column in the dependent unit number Eun. For this we need - -- to parse the ali file again because the parent entity is not in - -- the declaration table if it did not match the search pattern. - -- If the symbol is not found, we return (1 .. 3 => '?'). - - procedure Skip_To_Matching_Closing_Bracket; - -- When Ptr points to an opening square bracket, moves it to the - -- character following the matching closing bracket - - --------------------- - -- Get_Symbol_Name -- - --------------------- - - function Get_Symbol_Name (Eun, Line, Col : Natural) return String is - Ptr : Positive := 1; - E_Eun : Positive; -- Unit number of current entity - E_Line : Natural; -- Line number of current entity - E_Col : Natural; -- Column number of current entity - E_Name : Positive; -- Pointer to begin of entity name - - begin - -- Look for the X lines corresponding to unit Eun - - loop - if Ali (Ptr) = EOF then - return "???"; - end if; - - if Ali (Ptr) = 'X' then - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Eun); - exit when E_Eun = Eun; - end if; - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - end loop; - - -- Here we are in the right Ali section, we now look for the entity - -- declared at position (Line, Col). - - loop - Parse_Number (Ali, Ptr, E_Line); - exit when Ali (Ptr) = EOF; - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, E_Col); - exit when Ali (Ptr) = EOF; - Ptr := Ptr + 1; - - if Line = E_Line and then Col = E_Col then - Parse_Token (Ali, Ptr, E_Name); - return Ali (E_Name .. Ptr - 1); - end if; - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - exit when Ali (Ptr) = EOF; - end loop; - - return "???"; - end Get_Symbol_Name; - - -------------------------------------- - -- Skip_To_Matching_Closing_Bracket -- - -------------------------------------- - - procedure Skip_To_Matching_Closing_Bracket is - Num_Brackets : Natural; - - begin - Num_Brackets := 1; - while Num_Brackets /= 0 loop - Ptr := Ptr + 1; - if Ali (Ptr) = '[' then - Num_Brackets := Num_Brackets + 1; - elsif Ali (Ptr) = ']' then - Num_Brackets := Num_Brackets - 1; - end if; - end loop; - - Ptr := Ptr + 1; - end Skip_To_Matching_Closing_Bracket; - - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - - -- Start of processing for Parse_Identifier_Info - - begin - -- The identifier info looks like: - -- "38U9*Debug 12|36r6 36r19" - - -- Extract the line, column and entity name information - - Parse_Number (Ali, Ptr, E_Line); - - if Ali (Ptr) > ' ' then - E_Type := Ali (Ptr); - Ptr := Ptr + 1; - - -- Ignore some of the entities (labels,...) - - if E_Type in 'l' | 'L' | 'q' then - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - else - -- Unexpected contents, skip line and return - - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - - Parse_Number (Ali, Ptr, E_Col); - - E_Global := False; - if Ali (Ptr) >= ' ' then - E_Global := (Ali (Ptr) = '*'); - Ptr := Ptr + 1; - end if; - - Parse_Token (Ali, Ptr, E_Name); - - -- Exit if the symbol does not match or if we have a local symbol and we - -- do not want it or if the file is unknown. - - if File.X_File = Empty_File then - return; - end if; - - if (not Local_Symbols and not E_Global) - or else (Pattern.Initialized - and then not Match (Ali (E_Name .. Ptr - 1), Pattern.Entity)) - or else (E_Name >= Ptr) - then - Decl_Ref := Add_Declaration - (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type, - Remove_Only => True); - Parse_EOL (Ali, Ptr, Skip_Continuation_Line => True); - return; - end if; - - -- Insert the declaration in the table - - Decl_Ref := Add_Declaration - (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type); - - if Ali (Ptr) = '[' then - Skip_To_Matching_Closing_Bracket; - end if; - - -- Skip any renaming indication - - if Ali (Ptr) = '=' then - declare - P_Line, P_Column : Natural; - pragma Warnings (Off, P_Line); - pragma Warnings (Off, P_Column); - begin - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Line); - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Column); - end; - end if; - - while Ptr <= Ali'Last - and then (Ali (Ptr) = '<' - or else Ali (Ptr) = '(' - or else Ali (Ptr) = '{') - loop - -- Here we have a type derivation information. The format is - -- <3|12I45> which means that the current entity is derived from the - -- type defined in unit number 3, line 12 column 45. The pipe and - -- unit number is optional. It is specified only if the parent type - -- is not defined in the current unit. - - -- We also have the format for generic instantiations, as in - -- 7a5*Uid(3|5I8[4|2]) 2|4r74 - - -- We could also have something like - -- 16I9*I - -- that indicates that I derives from the predefined type integer. - - Ptr := Ptr + 1; - - if Ali (Ptr) in '0' .. '9' then - Parse_Derived_Info : declare - P_Line : Natural; -- parent entity line - P_Column : Natural; -- parent entity column - P_Eun : Natural := 0; -- parent entity file number - - begin - Parse_Number (Ali, Ptr, P_Line); - - -- If we have a pipe then the first number was the unit number - - if Ali (Ptr) = '|' then - P_Eun := P_Line; - Ptr := Ptr + 1; - - -- Now we have the line number - - Parse_Number (Ali, Ptr, P_Line); - - else - -- We don't have a unit number specified, so we set P_Eun to - -- the current unit. - - for K in Table'Range loop - P_Eun := K; - exit when Table (K) = File_Ref; - end loop; - end if; - - -- Then parse the type and column number - - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, P_Column); - - -- Skip the information for generics instantiations - - if Ali (Ptr) = '[' then - Skip_To_Matching_Closing_Bracket; - end if; - - -- Skip '>', or ')' or '>' - - Ptr := Ptr + 1; - - -- The derived info is needed only is the derived info mode is - -- on or if we want to output the type hierarchy - - if Der_Info or else Type_Tree then - pragma Assert (P_Eun /= 0); - - declare - Symbol : constant String := - Get_Symbol_Name (P_Eun, P_Line, P_Column); - begin - if Symbol /= "???" then - Add_Parent - (Decl_Ref, - Symbol, - P_Line, - P_Column, - Table (P_Eun)); - end if; - end; - end if; - - if Type_Tree - and then (Pattern.File_Ref = Empty_File - or else - Pattern.File_Ref = Current_Xref_File (File)) - then - Search_Parent_Tree : declare - Pattern : Search_Pattern; -- Parent type pattern - File_Pos_Backup : Positive; - - begin - Add_Entity - (Pattern, - Get_Symbol_Name (P_Eun, P_Line, P_Column) - & ':' & Get_Gnatchop_File (Table (P_Eun)) - & ':' & Get_Line (Get_Parent (Decl_Ref)) - & ':' & Get_Column (Get_Parent (Decl_Ref)), - False); - - -- No default match is needed to look for the parent type - -- since we are using the fully qualified symbol name: - -- symbol:file:line:column - - Set_Default_Match (False); - - -- The parent hierarchy is defined in the same unit as - -- the derived type. So we want to revisit the unit. - - File_Pos_Backup := File.Current_Line; - - Skip_To_First_X_Line - (File, D_Lines => False, W_Lines => False); - - while File.Buffer (File.Current_Line) /= EOF loop - Parse_X_Filename (File); - Parse_Identifier_Info - (Pattern => Pattern, - File => File, - Local_Symbols => False, - Der_Info => Der_Info, - Type_Tree => True, - Wide_Search => False, - Labels_As_Ref => Labels_As_Ref); - end loop; - - File.Current_Line := File_Pos_Backup; - end Search_Parent_Tree; - end if; - end Parse_Derived_Info; - - else - while Ali (Ptr) /= '>' - and then Ali (Ptr) /= ')' - and then Ali (Ptr) /= '}' - loop - Ptr := Ptr + 1; - end loop; - Ptr := Ptr + 1; - end if; - end loop; - - -- To find the body, we will have to parse the file too - - if Wide_Search then - declare - File_Name : constant String := Get_Gnatchop_File (File.X_File); - Ignored : File_Reference; - begin - Ignored := Add_To_Xref_File (ALI_File_Name (File_Name), False); - end; - end if; - - -- Parse references to this entity. - -- Ptr points to next reference with leading blanks - - loop - -- Process references on current line - - while Ali (Ptr) = ' ' or else Ali (Ptr) = ASCII.HT loop - - -- For every reference read the line, type and column, - -- optionally preceded by a file number and a pipe symbol. - - Parse_Number (Ali, Ptr, R_Line); - - if Ali (Ptr) = Pipe then - Ptr := Ptr + 1; - File_Ref := File_Name (File, R_Line); - - Parse_Number (Ali, Ptr, R_Line); - end if; - - if Ali (Ptr) > ' ' then - R_Type := Ali (Ptr); - Ptr := Ptr + 1; - end if; - - -- Imported entities may have an indication specifying information - -- about the corresponding external name: - -- 5U14*Foo2 5>20 6b22 # Imported entity - -- 5U14*Foo2 5>20 6i22 # Exported entity - - if Ali (Ptr) = '<' - and then (R_Type = 'b' or else R_Type = 'i') - then - while Ptr <= Ali'Last - and then Ali (Ptr) /= '>' - loop - Ptr := Ptr + 1; - end loop; - Ptr := Ptr + 1; - end if; - - Parse_Number (Ali, Ptr, R_Col); - - pragma Assert (R_Type /= ASCII.NUL); - - -- Insert the reference or body in the table - - Add_Reference - (Decl_Ref, File_Ref, R_Line, R_Col, R_Type, Labels_As_Ref); - - -- Skip generic information, if any - - if Ali (Ptr) = '[' then - declare - Num_Nested : Integer := 1; - - begin - Ptr := Ptr + 1; - while Num_Nested /= 0 loop - if Ali (Ptr) = ']' then - Num_Nested := Num_Nested - 1; - elsif Ali (Ptr) = '[' then - Num_Nested := Num_Nested + 1; - end if; - - Ptr := Ptr + 1; - end loop; - end; - end if; - - end loop; - - Parse_EOL (Ali, Ptr); - - -- Loop until new line is no continuation line - - exit when Ali (Ptr) /= '.'; - Ptr := Ptr + 1; - end loop; - end Parse_Identifier_Info; - - ------------------ - -- Parse_Number -- - ------------------ - - procedure Parse_Number - (Source : not null access String; - Ptr : in out Positive; - Number : out Natural) - is - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Number := 0; - while Source (Ptr) in '0' .. '9' loop - Number := - 10 * Number + (Character'Pos (Source (Ptr)) - Character'Pos ('0')); - Ptr := Ptr + 1; - end loop; - end Parse_Number; - - ----------------- - -- Parse_Token -- - ----------------- - - procedure Parse_Token - (Source : not null access String; - Ptr : in out Positive; - Token_Ptr : out Positive) - is - In_Quotes : Character := ASCII.NUL; - - begin - -- Skip separators - - while Source (Ptr) = ' ' or else Source (Ptr) = ASCII.HT loop - Ptr := Ptr + 1; - end loop; - - Token_Ptr := Ptr; - - -- Find end-of-token - - while (In_Quotes /= ASCII.NUL or else - not (Source (Ptr) = ' ' - or else Source (Ptr) = ASCII.HT - or else Source (Ptr) = '<' - or else Source (Ptr) = '{' - or else Source (Ptr) = '[' - or else Source (Ptr) = '=' - or else Source (Ptr) = '(')) - and then Source (Ptr) >= ' ' - loop - -- Double-quotes are used for operators - -- Simple-quotes are used for character constants, for instance when - -- they are found in an enumeration type "type A is ('+', '-');" - - case Source (Ptr) is - when '"' | ''' => - if In_Quotes = Source (Ptr) then - In_Quotes := ASCII.NUL; - elsif In_Quotes = ASCII.NUL then - In_Quotes := Source (Ptr); - end if; - - when others => - null; - end case; - - Ptr := Ptr + 1; - end loop; - end Parse_Token; - - ---------------------- - -- Parse_X_Filename -- - ---------------------- - - procedure Parse_X_Filename (File : in out ALI_File) is - Ali : String_Access renames File.Buffer; - Ptr : Positive renames File.Current_Line; - File_Nr : Natural; - - Table : Table_Type renames File.Dep.Table (1 .. Last (File.Dep)); - - begin - while Ali (Ptr) = 'X' loop - - -- The current line is the start of a new Xref file section, - -- whose format looks like: - - -- " X 1 debug.ads" - - -- Skip the X and read the file number for the new X_File - - Ptr := Ptr + 1; - Parse_Number (Ali, Ptr, File_Nr); - - -- If the referenced file is unknown, we simply ignore it - - if File_Nr in Table'Range then - File.X_File := Table (File_Nr); - else - File.X_File := Empty_File; - end if; - - Parse_EOL (Ali, Ptr); - end loop; - end Parse_X_Filename; - - -------------------- - -- Print_Gnatfind -- - -------------------- - - procedure Print_Gnatfind - (References : Boolean; - Full_Path_Name : Boolean) - is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - - procedure Print_Ref - (Ref : Reference; - Msg : String := " "); - -- Print a reference, according to the extended tag of the output - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref - (Ref : Reference; - Msg : String := " ") - is - F : String_Access := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Ref, Full_Path_Name)); - - Buffer : constant String := - F.all & - ":" & Get_Line (Ref) & - ":" & Get_Column (Ref) & - ": "; - - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Free (F); - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer - & String'(1 .. Num_Blanks => ' ') - & Msg & " " & Get_Symbol (Decl)); - - if Get_Source_Line (Ref)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Ref)); - end if; - end Print_Ref; - - -- Start of processing for Print_Gnatfind - - begin - for D in Decls'Range loop - Decl := Decls (D); - - if Match (Decl) then - - -- Output the declaration - - declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - - F : String_Access := - Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - - Buffer : constant String := - F.all & - ":" & Get_Line (Decl) & - ":" & Get_Column (Decl) & - ": "; - - Num_Blanks : Integer := Longest_File_Name + 10 - Buffer'Length; - - begin - Free (F); - Num_Blanks := Integer'Max (0, Num_Blanks); - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & "(spec) " & Get_Symbol (Decl)); - - if Parent /= Empty_Declaration then - F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); - Write_Line - (Buffer & String'(1 .. Num_Blanks => ' ') - & " derived from " & Get_Symbol (Parent) - & " (" - & F.all - & ':' & Get_Line (Parent) - & ':' & Get_Column (Parent) & ')'); - Free (F); - end if; - end; - - if Get_Source_Line (Decl)'Length /= 0 then - Write_Line (" " & Get_Source_Line (Decl)); - end if; - - -- Output the body (sorted) - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - Print_Ref (Arr (R), "(body)"); - end loop; - - Free (Arr); - - if References then - Arr := Get_References - (Decl, Get_Writes => True, Get_Reads => True); - - for R in Arr'Range loop - Print_Ref (Arr (R)); - end loop; - - Free (Arr); - end if; - end if; - end loop; - end Print_Gnatfind; - - ------------------ - -- Print_Unused -- - ------------------ - - procedure Print_Unused (Full_Path_Name : Boolean) is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - F : String_Access; - - begin - for D in Decls'Range loop - Decl := Decls (D); - - if References_Count - (Decl, Get_Reads => True, Get_Writes => True) = 0 - then - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - Write_Str (Get_Symbol (Decl) - & " (" - & Get_Full_Type (Decl) - & ") " - & F.all - & ':' - & Get_Line (Decl) - & ':' - & Get_Column (Decl)); - Free (F); - - -- Print the body if any - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Arr (R), Full_Path_Name)); - Write_Str (' ' - & F.all - & ':' & Get_Line (Arr (R)) - & ':' & Get_Column (Arr (R))); - Free (F); - end loop; - - Write_Eol; - Free (Arr); - end if; - end loop; - end Print_Unused; - - -------------- - -- Print_Vi -- - -------------- - - procedure Print_Vi (Full_Path_Name : Boolean) is - Tab : constant Character := ASCII.HT; - Decls : constant Declaration_Array_Access := - Get_Declarations (Sorted => False); - Decl : Declaration_Reference; - Arr : Reference_Array_Access; - F : String_Access; - - begin - for D in Decls'Range loop - Decl := Decls (D); - - F := Osint.To_Host_File_Spec (Get_File (Decl, Full_Path_Name)); - Write_Line (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Decl)); - Free (F); - - -- Print the body if any - - Arr := Get_References (Decl, Get_Bodies => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); - Write_Line - (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); - Free (F); - end loop; - - Free (Arr); - - -- Print the modifications - - Arr := Get_References (Decl, Get_Writes => True, Get_Reads => True); - - for R in Arr'Range loop - F := Osint.To_Host_File_Spec (Get_File (Arr (R), Full_Path_Name)); - Write_Line - (Get_Symbol (Decl) & Tab & F.all & Tab & Get_Line (Arr (R))); - Free (F); - end loop; - - Free (Arr); - end loop; - end Print_Vi; - - ---------------- - -- Print_Xref -- - ---------------- - - procedure Print_Xref (Full_Path_Name : Boolean) is - Decls : constant Declaration_Array_Access := Get_Declarations; - Decl : Declaration_Reference; - - Margin : constant := 10; - -- Column where file names start - - procedure New_Line80; - -- Go to start of new line - - procedure Print80 (S : String); - -- Print the text, respecting the 80 columns rule - - procedure Print_Ref (Line, Column : String); - -- The beginning of the output is aligned on a column multiple of 9 - - procedure Print_List - (Decl : Declaration_Reference; - Msg : String; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False); - -- Print a list of references. If the list is not empty, Msg will - -- be printed prior to the list. - - ---------------- - -- New_Line80 -- - ---------------- - - procedure New_Line80 is - begin - Write_Eol; - Write_Str (String'(1 .. Margin - 1 => ' ')); - end New_Line80; - - ------------- - -- Print80 -- - ------------- - - procedure Print80 (S : String) is - Align : Natural := Margin - (Integer (Column) mod Margin); - - begin - if Align = Margin then - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print80; - - --------------- - -- Print_Ref -- - --------------- - - procedure Print_Ref (Line, Column : String) is - Line_Align : constant Integer := 4 - Line'Length; - - S : constant String := String'(1 .. Line_Align => ' ') - & Line & ':' & Column; - - Align : Natural := Margin - (Integer (Output.Column) mod Margin); - - begin - if Align = Margin then - Align := 0; - end if; - - if Integer (Output.Column) + Align + S'Length > 79 then - New_Line80; - Align := 0; - end if; - - Write_Str (String'(1 .. Align => ' ') & S); - end Print_Ref; - - ---------------- - -- Print_List -- - ---------------- - - procedure Print_List - (Decl : Declaration_Reference; - Msg : String; - Get_Reads : Boolean := False; - Get_Writes : Boolean := False; - Get_Bodies : Boolean := False) - is - Arr : Reference_Array_Access := - Get_References - (Decl, - Get_Writes => Get_Writes, - Get_Reads => Get_Reads, - Get_Bodies => Get_Bodies); - File : File_Reference := Empty_File; - F : String_Access; - - begin - if Arr'Length /= 0 then - Write_Eol; - Write_Str (Msg); - end if; - - for R in Arr'Range loop - if Get_File_Ref (Arr (R)) /= File then - if File /= Empty_File then - New_Line80; - end if; - - File := Get_File_Ref (Arr (R)); - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Arr (R), Full_Path_Name)); - - if F = null then - Write_Str (" "); - else - Write_Str (F.all & ' '); - Free (F); - end if; - end if; - - Print_Ref (Get_Line (Arr (R)), Get_Column (Arr (R))); - end loop; - - Free (Arr); - end Print_List; - - F : String_Access; - - -- Start of processing for Print_Xref - - begin - for D in Decls'Range loop - Decl := Decls (D); - - Write_Str (Get_Symbol (Decl)); - - -- Put the declaration type in column Type_Position, but if the - -- declaration name is too long, put at least one space between its - -- name and its type. - - while Column < Type_Position - 1 loop - Write_Char (' '); - end loop; - - Write_Char (' '); - - Write_Line (Get_Full_Type (Decl)); - - Write_Parent_Info : declare - Parent : constant Declaration_Reference := Get_Parent (Decl); - - begin - if Parent /= Empty_Declaration then - Write_Str (" Ptype: "); - F := Osint.To_Host_File_Spec (Get_Gnatchop_File (Parent)); - Print80 (F.all); - Free (F); - Print_Ref (Get_Line (Parent), Get_Column (Parent)); - Print80 (" " & Get_Symbol (Parent)); - Write_Eol; - end if; - end Write_Parent_Info; - - Write_Str (" Decl: "); - F := Osint.To_Host_File_Spec - (Get_Gnatchop_File (Decl, Full_Path_Name)); - - if F = null then - Print80 (" "); - else - Print80 (F.all & ' '); - Free (F); - end if; - - Print_Ref (Get_Line (Decl), Get_Column (Decl)); - - Print_List - (Decl, " Body: ", Get_Bodies => True); - Print_List - (Decl, " Modi: ", Get_Writes => True); - Print_List - (Decl, " Ref: ", Get_Reads => True); - Write_Eol; - end loop; - end Print_Xref; - - ------------ - -- Search -- - ------------ - - procedure Search - (Pattern : Search_Pattern; - Local_Symbols : Boolean; - Wide_Search : Boolean; - Read_Only : Boolean; - Der_Info : Boolean; - Type_Tree : Boolean) - is - type String_Access is access String; - procedure Free is new Ada.Unchecked_Deallocation (String, String_Access); - - ALIfile : ALI_File; - File_Ref : File_Reference; - Strip_Num : Natural := 0; - Ali_Name : String_Access; - - begin - -- If we want all the .ali files, then find them - - if Wide_Search then - Find_ALI_Files; - end if; - - loop - -- Get the next unread ali file - - File_Ref := Next_Unvisited_File; - - exit when File_Ref = Empty_File; - - -- Find the ALI file to use. Most of the time, it will be the unit - -- name, with a different extension. However, when dealing with - -- separates the ALI file is in fact the parent's ALI file (and this - -- is recursive, in case the parent itself is a separate). - - Strip_Num := 0; - loop - Free (Ali_Name); - Ali_Name := new String' - (Get_File (File_Ref, With_Dir => True, Strip => Strip_Num)); - - -- Stripped too many things... - - if Ali_Name.all = "" then - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : file " & Get_File (File_Ref, With_Dir => True) - & " not found"); - Set_Standard_Output; - end if; - Free (Ali_Name); - exit; - - -- If not found, try the parent's ALI file (this is needed for - -- separate units and subprograms). - - -- Reset the cached directory first, in case the separate's - -- ALI file is not in the same directory. - - elsif not File_Exists (Ali_Name.all) then - Strip_Num := Strip_Num + 1; - Reset_Directory (File_Ref); - - -- Else we finally found it - - else - exit; - end if; - end loop; - - -- If we had to get the parent's ALI, insert it in the list as usual. - -- This is to avoid parsing it twice in case it has already been - -- parsed. - - if Ali_Name /= null and then Strip_Num /= 0 then - File_Ref := Add_To_Xref_File - (File_Name => Ali_Name.all, - Visited => False); - - -- Now that we have a file name, parse it to find any reference to - -- the entity. - - elsif Ali_Name /= null - and then (Read_Only or else Is_Writable_File (Ali_Name.all)) - then - begin - Open (Ali_Name.all, ALIfile); - - -- The cross-reference section in the ALI file may be followed - -- by other sections, which can be identified by the starting - -- character of every line, which should neither be 'X' nor a - -- figure in '1' .. '9'. - - -- The loop tests below also take into account the end-of-file - -- possibility. - - while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop - Parse_X_Filename (ALIfile); - - while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' - loop - Parse_Identifier_Info - (Pattern, ALIfile, Local_Symbols, Der_Info, Type_Tree, - Wide_Search, Labels_As_Ref => True); - end loop; - end loop; - - exception - when No_Xref_Information => - if Get_Emit_Warning (File_Ref) then - Set_Standard_Error; - Write_Line - ("warning : No cross-referencing information in " - & Ali_Name.all); - Set_Standard_Output; - end if; - end; - end if; - end loop; - - Free (Ali_Name); - end Search; - - ----------------- - -- Search_Xref -- - ----------------- - - procedure Search_Xref - (Local_Symbols : Boolean; - Read_Only : Boolean; - Der_Info : Boolean) - is - ALIfile : ALI_File; - File_Ref : File_Reference; - Null_Pattern : Search_Pattern; - - begin - Null_Pattern.Initialized := False; - - loop - -- Find the next unvisited file - - File_Ref := Next_Unvisited_File; - exit when File_Ref = Empty_File; - - -- Search the object directories for the .ali file - - declare - F : constant String := Get_File (File_Ref, With_Dir => True); - - begin - if Read_Only or else Is_Writable_File (F) then - Open (F, ALIfile, True); - - -- The cross-reference section in the ALI file may be followed - -- by other sections, which can be identified by the starting - -- character of every line, which should neither be 'X' nor a - -- figure in '1' .. '9'. - - -- The loop tests below also take into account the end-of-file - -- possibility. - - while ALIfile.Buffer (ALIfile.Current_Line) = 'X' loop - Parse_X_Filename (ALIfile); - - while ALIfile.Buffer (ALIfile.Current_Line) in '1' .. '9' - loop - Parse_Identifier_Info - (Null_Pattern, ALIfile, Local_Symbols, Der_Info, - Labels_As_Ref => False); - end loop; - end loop; - end if; - - exception - when No_Xref_Information => null; - end; - end loop; - end Search_Xref; - -end Xref_Lib; diff --git a/gcc/ada/xref_lib.ads b/gcc/ada/xref_lib.ads deleted file mode 100644 index 467e3a52417..00000000000 --- a/gcc/ada/xref_lib.ads +++ /dev/null @@ -1,179 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- X R E F _ L I B -- --- -- --- S p e c -- --- -- --- Copyright (C) 1998-2022, 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. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Miscellaneous utilities for the cross-referencing tool - -with Hostparm; -with Xr_Tabls; use Xr_Tabls; - -with GNAT.Directory_Operations; use GNAT.Directory_Operations; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with GNAT.Dynamic_Tables; -with GNAT.Regexp; use GNAT.Regexp; - -package Xref_Lib is - - subtype File_Name_String is String (1 .. Hostparm.Max_Name_Length); - subtype Line_String is String (1 .. Hostparm.Max_Line_Length); - - type ALI_File is limited private; - - --------------------- - -- Directory Input -- - --------------------- - - type Rec_DIR is limited private; - -- This one is used for recursive search of .ali files - - procedure Find_ALI_Files; - -- Find all the ali files that we will have to parse, and have them to - -- the file list - - --------------------- - -- Search patterns -- - --------------------- - - type Search_Pattern is private; - type Search_Pattern_Ptr is access all Search_Pattern; - - procedure Add_Entity - (Pattern : in out Search_Pattern; - Entity : String; - Glob : Boolean := False); - -- Add a new entity to the search pattern (the entity should have the - -- form pattern[:file[:line[:column]]], and it is parsed entirely in - -- this procedure. Glob indicates if we should use the 'globbing - -- patterns' (True) or the full regular expressions (False) - - procedure Add_Xref_File (File : String); - -- Add a new file in the list of files to search for references. File - -- is interpreted as a globbing regular expression, which is expanded. - - Invalid_Argument : exception; - -- Exception raised when there is a syntax error in the command line - - ----------------------- - -- Output Algorithms -- - ----------------------- - - procedure Print_Gnatfind - (References : Boolean; - Full_Path_Name : Boolean); - procedure Print_Unused (Full_Path_Name : Boolean); - procedure Print_Vi (Full_Path_Name : Boolean); - procedure Print_Xref (Full_Path_Name : Boolean); - -- The actual print procedures. These functions step through the symbol - -- table and print all the symbols if they match the files given on the - -- command line (they already match the entities if they are in the - -- symbol table) - - ------------------------ - -- General Algorithms -- - ------------------------ - - function Default_Project_File (Dir_Name : String) return String; - -- Returns the default Project file name for the directory Dir_Name - - procedure Search - (Pattern : Search_Pattern; - Local_Symbols : Boolean; - Wide_Search : Boolean; - Read_Only : Boolean; - Der_Info : Boolean; - Type_Tree : Boolean); - -- Search every ALI file for entities matching Pattern, and add - -- these entities to the internal symbol tables. - -- - -- If Wide_Search is True, all ALI files found in the object path - -- are searched. - -- - -- If Read_Only is True, read-only ALI files will also be parsed, - -- similar to gnatmake -a. - -- - -- If Der_Info is true, then the derived type information will be - -- processed. - -- - -- If Type_Tree is true, then the type hierarchy will be searched - -- going from the pattern to the parent type. - - procedure Search_Xref - (Local_Symbols : Boolean; - Read_Only : Boolean; - Der_Info : Boolean); - -- Search every ali file given in the command line and all their - -- dependencies. If Read_Only is True, we parse the read-only ali - -- files too. If Der_Mode is true then the derived type information will - -- be processed - -private - type Rec_DIR is limited record - Dir : GNAT.Directory_Operations.Dir_Type; - end record; - - package Dependencies_Tables is new GNAT.Dynamic_Tables - (Table_Component_Type => Xr_Tabls.File_Reference, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 400, - Table_Increment => 100); - use Dependencies_Tables; - - type Dependencies is new Dependencies_Tables.Instance; - - type ALI_File is limited record - Buffer : String_Access := null; - -- Buffer used to read the whole file at once - - Current_Line : Positive; - -- Start of the current line in Buffer - - Xref_Line : Positive; - -- Start of the xref lines in Buffer - - X_File : Xr_Tabls.File_Reference; - -- Stores the cross-referencing file-name ("X..." lines), as an - -- index into the dependencies table - - Dep : Dependencies; - -- Store file name associated with each number ("D..." lines) - end record; - - -- The following record type stores all the patterns that are searched for - - type Search_Pattern is record - Entity : GNAT.Regexp.Regexp; - -- A regular expression matching the entities we are looking for. - -- File is a list of the places where the declaration of the entities - -- has to be. When the user enters a file:line:column on the command - -- line, it is stored as "Entity_Name Declaration_File:line:column" - - File_Ref : Xr_Tabls.File_Reference; - -- A reference to the source file, if any - - Initialized : Boolean := False; - -- Set to True when Entity has been initialized - end record; - -end Xref_Lib; -- 2.34.1