New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45960 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 1376 insertions, 0 deletions

diff --git a/gcc/ada/xr_tabls.adb b/gcc/ada/xr_tabls.adb
new file mode 100644
index 00000000000..02af07e75ec
--- /dev/null
+++ b/gcc/ada/xr_tabls.adb
@@ -0,0 +1,1376 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             X R  _ T A B L S                             --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                            $Revision: 1.36 $
+--                                                                          --
+--          Copyright (C) 1998-2001 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 2,  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 COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.IO_Exceptions;
+with Ada.Strings.Fixed;
+with Ada.Strings;
+with Ada.Text_IO;
+with Hostparm;
+with GNAT.IO_Aux;
+with Unchecked_Deallocation;
+with GNAT.OS_Lib;               use GNAT.OS_Lib;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with Osint;
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package body Xr_Tabls is
+
+   subtype Line_String      is String (1 .. Hostparm.Max_Line_Length);
+   subtype File_Name_String is String (1 .. Hostparm.Max_Name_Length);
+
+   function Base_File_Name (File : String) return String;
+   --  Return the base file name for File (ie not including the directory)
+
+   function Dir_Name (File : String; Base : String := "") return String;
+   --  Return the directory name of File, or "" if there is no directory part
+   --  in File.
+   --  This includes the last separator at the end, and always return an
+   --  absolute path name (directories are relative to Base, or the current
+   --  directory if Base is "")
+
+   Dir_Sep       : Character renames GNAT.OS_Lib.Directory_Separator;
+
+   Files         : File_Table;
+   Entities      : Entity_Table;
+   Directories   : Project_File_Ptr;
+   Default_Match : Boolean := False;
+
+   ---------------------
+   -- Add_Declaration --
+   ---------------------
+
+   function Add_Declaration
+     (File_Ref  : File_Reference;
+      Symbol    : String;
+      Line      : Natural;
+      Column    : Natural;
+      Decl_Type : Character)
+      return      Declaration_Reference
+   is
+      The_Entities : Declaration_Reference := Entities.Table;
+      New_Decl     : Declaration_Reference;
+      Result       : Compare_Result;
+      Prev         : Declaration_Reference := null;
+
+   begin
+      --  Check if the identifier already exists in the table
+
+      while The_Entities /= null loop
+         Result := Compare (The_Entities, File_Ref, Line, Column, Symbol);
+         exit when Result = GreaterThan;
+
+         if Result = Equal then
+            return The_Entities;
+         end if;
+
+         Prev := The_Entities;
+         The_Entities  := The_Entities.Next;
+      end loop;
+
+      --  Insert the Declaration in the table
+
+      New_Decl := new Declaration_Record'
+        (Symbol_Length => Symbol'Length,
+         Symbol        => Symbol,
+         Decl          => (File          => File_Ref,
+                           Line          => Line,
+                           Column        => Column,
+                           Source_Line   => Null_Unbounded_String,
+                           Next          => null),
+         Decl_Type     => Decl_Type,
+         Body_Ref      => null,
+         Ref_Ref       => null,
+         Modif_Ref     => null,
+         Match         => Default_Match or else Match (File_Ref, Line, Column),
+         Par_Symbol    => null,
+         Next          => null);
+
+      if Prev = null then
+         New_Decl.Next := Entities.Table;
+         Entities.Table := New_Decl;
+      else
+         New_Decl.Next := Prev.Next;
+         Prev.Next := New_Decl;
+      end if;
+
+      if New_Decl.Match then
+         Files.Longest_Name := Natural'Max (File_Ref.File'Length,
+                                            Files.Longest_Name);
+      end if;
+
+      return New_Decl;
+   end Add_Declaration;
+
+   --------------
+   -- Add_File --
+   --------------
+
+   procedure Add_File
+     (File_Name    : String;
+      File_Existed : out Boolean;
+      Ref          : out File_Reference;
+      Visited      : Boolean := True;
+      Emit_Warning : Boolean := False;
+      Gnatchop_File : String := "";
+      Gnatchop_Offset : Integer := 0)
+   is
+      The_Files : File_Reference := Files.Table;
+      Base      : constant String := Base_File_Name (File_Name);
+      Dir       : constant String := Xr_Tabls.Dir_Name (File_Name);
+      Dir_Acc   : String_Access := null;
+
+   begin
+      --  Do we have a directory name as well ?
+      if Dir /= "" then
+         Dir_Acc := new String' (Dir);
+      end if;
+
+      --  Check if the file already exists in the table
+
+      while The_Files /= null loop
+
+         if The_Files.File = File_Name then
+            File_Existed      := True;
+            Ref               := The_Files;
+            return;
+         end if;
+
+         The_Files := The_Files.Next;
+      end loop;
+
+      Ref := new File_Record'
+        (File_Length     => Base'Length,
+         File            => Base,
+         Dir             => Dir_Acc,
+         Lines           => null,
+         Visited         => Visited,
+         Emit_Warning    => Emit_Warning,
+         Gnatchop_File   => new String' (Gnatchop_File),
+         Gnatchop_Offset => Gnatchop_Offset,
+         Next            => Files.Table);
+      Files.Table := Ref;
+      File_Existed := False;
+   end Add_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 := new Declaration_Record'
+        (Symbol_Length => Symbol'Length,
+         Symbol        => Symbol,
+         Decl          => (File         => File_Ref,
+                           Line         => Line,
+                           Column       => Column,
+                           Source_Line  => Null_Unbounded_String,
+                           Next         => null),
+         Decl_Type     => ' ',
+         Body_Ref      => null,
+         Ref_Ref       => null,
+         Modif_Ref     => null,
+         Match         => False,
+         Par_Symbol    => null,
+         Next          => null);
+   end Add_Parent;
+
+   -------------------
+   -- Add_Reference --
+   -------------------
+
+   procedure Add_Reference
+     (Declaration : Declaration_Reference;
+      File_Ref    : File_Reference;
+      Line        : Natural;
+      Column      : Natural;
+      Ref_Type    : Character)
+   is
+      procedure Free is new Unchecked_Deallocation
+        (Reference_Record, Reference);
+
+      Ref     : Reference;
+      Prev    : Reference := null;
+      Result  : Compare_Result;
+      New_Ref : Reference := new Reference_Record'
+        (File   => File_Ref,
+         Line   => Line,
+         Column => Column,
+         Source_Line => Null_Unbounded_String,
+         Next   => null);
+
+   begin
+      case Ref_Type is
+         when 'b' | 'c' => Ref := Declaration.Body_Ref;
+         when 'r' | 'i' => Ref := Declaration.Ref_Ref;
+         when 'm'       => Ref := Declaration.Modif_Ref;
+         when others => return;
+      end case;
+
+      --  Check if the reference already exists
+
+      while Ref /= null loop
+         Result := Compare (New_Ref, Ref);
+         exit when Result = LessThan;
+
+         if Result = Equal then
+            Free (New_Ref);
+            return;
+         end if;
+
+         Prev := Ref;
+         Ref  := Ref.Next;
+      end loop;
+
+      --  Insert it in the list
+
+      if Prev /= null then
+         New_Ref.Next := Prev.Next;
+         Prev.Next := New_Ref;
+
+      else
+         case Ref_Type is
+            when 'b' | 'c' =>
+               New_Ref.Next := Declaration.Body_Ref;
+               Declaration.Body_Ref := New_Ref;
+            when 'r' | 'i' =>
+               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;
+      end if;
+
+      if not Declaration.Match then
+         Declaration.Match := Match (File_Ref, Line, Column);
+      end if;
+
+      if Declaration.Match then
+         Files.Longest_Name := Natural'Max (File_Ref.File'Length,
+                                            Files.Longest_Name);
+      end if;
+   end Add_Reference;
+
+   -------------------
+   -- ALI_File_Name --
+   -------------------
+
+   function ALI_File_Name (Ada_File_Name : String) return String is
+      Index : 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)
+           & "ali";
+      else
+         return Ada_File_Name & ".ali";
+      end if;
+   end ALI_File_Name;
+
+   --------------------
+   -- Base_File_Name --
+   --------------------
+
+   function Base_File_Name (File : String) return String is
+   begin
+      for J in reverse File'Range loop
+         if File (J) = '/' or else File (J) = Dir_Sep then
+            return File (J + 1 .. File'Last);
+         end if;
+      end loop;
+      return File;
+   end Base_File_Name;
+
+   -------------
+   -- Compare --
+   -------------
+
+   function Compare
+     (Ref1 : Reference;
+      Ref2 : Reference)
+      return Compare_Result
+   is
+   begin
+      if Ref1 = null then
+         return GreaterThan;
+      elsif Ref2 = null then
+         return LessThan;
+      end if;
+
+      if Ref1.File.File < Ref2.File.File then
+         return LessThan;
+
+      elsif Ref1.File.File = Ref2.File.File then
+         if Ref1.Line < Ref2.Line then
+            return LessThan;
+
+         elsif Ref1.Line = Ref2.Line then
+            if Ref1.Column < Ref2.Column then
+               return LessThan;
+            elsif Ref1.Column = Ref2.Column then
+               return Equal;
+            else
+               return GreaterThan;
+            end if;
+
+         else
+            return GreaterThan;
+         end if;
+
+      else
+         return GreaterThan;
+      end if;
+   end Compare;
+
+   -------------
+   -- Compare --
+   -------------
+
+   function Compare
+     (Decl1 : Declaration_Reference;
+      File2 : File_Reference;
+      Line2 : Integer;
+      Col2  : Integer;
+      Symb2 : String)
+      return  Compare_Result
+   is
+   begin
+      if Decl1 = null then
+         return GreaterThan;
+      end if;
+
+      if Decl1.Symbol < Symb2 then
+         return LessThan;
+      elsif Decl1.Symbol > Symb2 then
+         return GreaterThan;
+      end if;
+
+      if Decl1.Decl.File.File < Get_File (File2) then
+         return LessThan;
+
+      elsif Decl1.Decl.File.File = Get_File (File2) then
+         if Decl1.Decl.Line < Line2 then
+            return LessThan;
+
+         elsif Decl1.Decl.Line = Line2 then
+            if Decl1.Decl.Column < Col2 then
+               return LessThan;
+
+            elsif Decl1.Decl.Column = Col2 then
+               return Equal;
+
+            else
+               return GreaterThan;
+            end if;
+
+         else
+            return GreaterThan;
+         end if;
+
+      else
+         return GreaterThan;
+      end if;
+   end Compare;
+
+   -------------------------
+   -- Create_Project_File --
+   -------------------------
+
+   procedure Create_Project_File
+     (Name           : String)
+   is
+      use Ada.Strings.Unbounded;
+
+      Obj_Dir     : Unbounded_String := Null_Unbounded_String;
+      Src_Dir     : Unbounded_String := Null_Unbounded_String;
+      Build_Dir   : Unbounded_String;
+
+      Gnatls_Src_Cache : Unbounded_String;
+      Gnatls_Obj_Cache : Unbounded_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;
+
+                  Build_Dir :=
+                    To_Unbounded_String (Buffer (Index .. Last - 1));
+                  if Buffer (Last - 1) /= Dir_Sep then
+                     Append (Build_Dir, Dir_Sep);
+                  end if;
+               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
+                  declare
+                     S : String := Ada.Strings.Fixed.Trim
+                       (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
+                  begin
+                     --  A relative directory ?
+                     if S (S'First) /= Dir_Sep then
+                        Append (Src_Dir, Build_Dir);
+                     end if;
+
+                     if S (S'Last) = Dir_Sep then
+                        Append (Src_Dir, S & " ");
+                     else
+                        Append (Src_Dir, S & Dir_Sep & " ");
+                     end if;
+                  end;
+
+               elsif Index <= Buffer'Last - 7
+                 and then Buffer (Index .. Index + 7) = "obj_dir="
+               then
+                  declare
+                     S : String := Ada.Strings.Fixed.Trim
+                       (Buffer (Index + 8 .. Last - 1), Ada.Strings.Both);
+                  begin
+                     --  A relative directory ?
+                     if S (S'First) /= Dir_Sep then
+                        Append (Obj_Dir, Build_Dir);
+                     end if;
+
+                     if S (S'Last) = Dir_Sep then
+                        Append (Obj_Dir, S & " ");
+                     else
+                        Append (Obj_Dir, S & Dir_Sep & " ");
+                     end if;
+                  end;
+               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;
+
+      Parse_Gnatls (Gnatls_Src_Cache, Gnatls_Obj_Cache);
+
+      Directories := new Project_File'
+        (Src_Dir_Length     => Length (Src_Dir) + Length (Gnatls_Src_Cache),
+         Obj_Dir_Length     => Length (Obj_Dir) + Length (Gnatls_Obj_Cache),
+         Src_Dir            => To_String (Src_Dir & Gnatls_Src_Cache),
+         Obj_Dir            => To_String (Obj_Dir & Gnatls_Obj_Cache),
+         Src_Dir_Index      => 1,
+         Obj_Dir_Index      => 1,
+         Last_Obj_Dir_Start => 0);
+   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;
+
+   --------------
+   -- Dir_Name --
+   --------------
+
+   function Dir_Name (File : String; Base : String := "") return String is
+   begin
+      for J in reverse File'Range loop
+         if File (J) = '/' or else File (J) = Dir_Sep then
+
+            --  Is this an absolute directory ?
+            if File (File'First) = '/'
+              or else File (File'First) = Dir_Sep
+            then
+               return File (File'First .. J);
+
+            --  Else do we know the base directory ?
+            elsif Base /= "" then
+               return Base & File (File'First .. J);
+
+            else
+               declare
+                  Max_Path : Integer;
+                  pragma Import (C, Max_Path, "max_path_len");
+
+                  Base2 : Dir_Name_Str (1 .. Max_Path);
+                  Last  : Natural;
+               begin
+                  Get_Current_Dir (Base2, Last);
+                  return Base2 (Base2'First .. Last) & File (File'First .. J);
+               end;
+            end if;
+         end if;
+      end loop;
+      return "";
+   end Dir_Name;
+
+   -------------------
+   -- Find_ALI_File --
+   -------------------
+
+   function Find_ALI_File (Short_Name  : String) return String is
+      use type Ada.Strings.Unbounded.String_Access;
+      Old_Obj_Dir : constant Integer := Directories.Obj_Dir_Index;
+
+   begin
+      Reset_Obj_Dir;
+
+      loop
+         declare
+            Obj_Dir : String := Next_Obj_Dir;
+         begin
+            exit when Obj_Dir'Length = 0;
+            if GNAT.IO_Aux.File_Exists (Obj_Dir & Short_Name) then
+               Directories.Obj_Dir_Index := Old_Obj_Dir;
+               return Obj_Dir;
+            end if;
+         end;
+      end loop;
+
+      --  Finally look in the standard directories
+
+      Directories.Obj_Dir_Index := Old_Obj_Dir;
+      return "";
+   end Find_ALI_File;
+
+   ----------------------
+   -- Find_Source_File --
+   ----------------------
+
+   function Find_Source_File (Short_Name  : String) return String is
+      use type Ada.Strings.Unbounded.String_Access;
+
+   begin
+      Reset_Src_Dir;
+      loop
+         declare
+            Src_Dir : String := Next_Src_Dir;
+         begin
+            exit when Src_Dir'Length = 0;
+
+            if GNAT.IO_Aux.File_Exists (Src_Dir & Short_Name) then
+               return Src_Dir;
+            end if;
+         end;
+      end loop;
+
+      --  Finally look in the standard directories
+
+      return "";
+   end Find_Source_File;
+
+   ----------------
+   -- First_Body --
+   ----------------
+
+   function First_Body (Decl : Declaration_Reference) return Reference is
+   begin
+      return Decl.Body_Ref;
+   end First_Body;
+
+   -----------------------
+   -- First_Declaration --
+   -----------------------
+
+   function First_Declaration return Declaration_Reference is
+   begin
+      return Entities.Table;
+   end First_Declaration;
+
+   -----------------
+   -- First_Modif --
+   -----------------
+
+   function First_Modif (Decl : Declaration_Reference) return Reference is
+   begin
+      return Decl.Modif_Ref;
+   end First_Modif;
+
+   ---------------------
+   -- First_Reference --
+   ---------------------
+
+   function First_Reference (Decl : Declaration_Reference) return Reference is
+   begin
+      return Decl.Ref_Ref;
+   end First_Reference;
+
+   ----------------
+   -- 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
+      The_Entities : Declaration_Reference := Entities.Table;
+   begin
+      while The_Entities /= null loop
+         if The_Entities.Decl.Line = Line
+           and then The_Entities.Decl.Column = Column
+           and then The_Entities.Decl.File = File_Ref
+         then
+            return The_Entities;
+         else
+            The_Entities := The_Entities.Next;
+         end if;
+      end loop;
+
+      return Empty_Declaration;
+   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 : in Boolean := False;
+      Strip    : Natural := 0)
+      return     String
+   is
+      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, Extension_Start : Natural;
+         S : Natural := Strip;
+      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
+
+         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;
+
+   begin
+      --  If we do not want the full path name
+
+      if not With_Dir then
+         return Internal_Strip (File.File);
+      end if;
+
+      if File.Dir = null then
+
+         if Ada.Strings.Fixed.Tail (File.File, 3) = "ali" then
+            File.Dir := new String'(Find_ALI_File (File.File));
+         else
+            File.Dir := new String'(Find_Source_File (File.File));
+         end if;
+      end if;
+
+      return Internal_Strip (File.Dir.all & File.File);
+   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;
+
+   -----------------------
+   -- 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;
+
+   -----------------------
+   -- 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
+      return To_String (Ref.Source_Line);
+   end Get_Source_Line;
+
+   function Get_Source_Line (Decl : Declaration_Reference) return String is
+   begin
+      return To_String (Decl.Decl.Source_Line);
+   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;
+
+   -----------------------
+   -- Grep_Source_Files --
+   -----------------------
+
+   procedure Grep_Source_Files is
+      Decl : Declaration_Reference := First_Declaration;
+
+      type Simple_Ref;
+      type Simple_Ref_Access is access Simple_Ref;
+      type Simple_Ref is
+         record
+            Ref  : Reference;
+            Next : Simple_Ref_Access;
+         end record;
+      List : Simple_Ref_Access := null;
+      --  This structure is used to speed up the parsing of Ada sources:
+      --  Every reference found by parsing the .ali files is inserted in this
+      --  list, sorted by filename and line numbers.
+      --  This allows use not to parse a same ada file multiple times
+
+      procedure Free is new Unchecked_Deallocation
+        (Simple_Ref, Simple_Ref_Access);
+      --  Clear an element of the list
+
+      procedure Grep_List;
+      --  For each reference in the list, parse the file and find the
+      --  source line
+
+      procedure Insert_In_Order (Ref  : Reference);
+      --  Insert a new reference in the list, ordered by line numbers
+
+      procedure Insert_List_Ref (First_Ref : Reference);
+      --  Process a list of references
+
+      ---------------
+      -- Grep_List --
+      ---------------
+
+      procedure Grep_List is
+         Line         : String (1 .. 1024);
+         Last         : Natural;
+         File         : Ada.Text_IO.File_Type;
+         Line_Number  : Natural;
+         Pos          : Natural;
+         Save_List    : Simple_Ref_Access := List;
+         Current_File : File_Reference;
+
+      begin
+         while List /= null loop
+
+            --  Makes sure we can find and read the file
+
+            Current_File := List.Ref.File;
+            Line_Number  := 0;
+
+            begin
+               Ada.Text_IO.Open (File,
+                                 Ada.Text_IO.In_File,
+                                 Get_File (List.Ref, True));
+
+               --  Read the file and find every relevant lines
+
+               while List /= null
+                 and then List.Ref.File = Current_File
+                 and then not Ada.Text_IO.End_Of_File (File)
+               loop
+                  Ada.Text_IO.Get_Line (File, Line, Last);
+                  Line_Number := Line_Number + 1;
+
+                  while List /= null
+                    and then Line_Number = List.Ref.Line
+                  loop
+
+                     --  Skip the leading blanks on the line
+
+                     Pos := 1;
+                     while Line (Pos) = ' '
+                       or else Line (Pos) = ASCII.HT
+                     loop
+                        Pos := Pos + 1;
+                     end loop;
+
+                     List.Ref.Source_Line :=
+                       To_Unbounded_String (Line (Pos .. Last));
+
+                     --  Find the next element in the list
+
+                     List := List.Next;
+                  end loop;
+
+               end loop;
+
+               Ada.Text_IO.Close (File);
+
+               --  If the Current_File was not found, just skip it
+
+            exception
+               when Ada.IO_Exceptions.Name_Error =>
+                  null;
+            end;
+
+            --  If the line or the file were not found
+
+            while List /= null
+              and then List.Ref.File = Current_File
+            loop
+               List := List.Next;
+            end loop;
+
+         end loop;
+
+         --  Clear the list
+
+         while Save_List /= null loop
+            List      := Save_List;
+            Save_List := Save_List.Next;
+            Free (List);
+         end loop;
+      end Grep_List;
+
+      ---------------------
+      -- Insert_In_Order --
+      ---------------------
+
+      procedure Insert_In_Order (Ref : Reference) is
+         Iter : Simple_Ref_Access := List;
+         Prev : Simple_Ref_Access := null;
+
+      begin
+         while Iter /= null loop
+
+            --  If we have found the file, sort by lines
+
+            if Iter.Ref.File = Ref.File then
+
+               while Iter /= null
+                 and then Iter.Ref.File = Ref.File
+               loop
+                  if Iter.Ref.Line > Ref.Line then
+
+                     if Iter = List then
+                        List := new Simple_Ref'(Ref, List);
+                     else
+                        Prev.Next := new Simple_Ref'(Ref, Iter);
+                     end if;
+                     return;
+                  end if;
+
+                  Prev := Iter;
+                  Iter := Iter.Next;
+               end loop;
+
+               if Iter = List then
+                  List := new Simple_Ref'(Ref, List);
+               else
+                  Prev.Next := new Simple_Ref'(Ref, Iter);
+               end if;
+               return;
+            end if;
+
+            Prev := Iter;
+            Iter := Iter.Next;
+         end loop;
+
+         --  The file was not already in the list, insert it
+
+         List := new Simple_Ref'(Ref, List);
+      end Insert_In_Order;
+
+      ---------------------
+      -- Insert_List_Ref --
+      ---------------------
+
+      procedure Insert_List_Ref (First_Ref : Reference) is
+         Ref : Reference := First_Ref;
+
+      begin
+         while Ref /= Empty_Reference loop
+            Insert_In_Order (Ref);
+            Ref := Next (Ref);
+         end loop;
+      end Insert_List_Ref;
+
+   --  Start of processing for Grep_Source_Files
+
+   begin
+      while Decl /= Empty_Declaration loop
+         Insert_In_Order (Decl.Decl'Access);
+         Insert_List_Ref (First_Body (Decl));
+         Insert_List_Ref (First_Reference (Decl));
+         Insert_List_Ref (First_Modif (Decl));
+         Decl := Next (Decl);
+      end loop;
+
+      Grep_List;
+   end Grep_Source_Files;
+
+   -----------------------
+   -- Longest_File_Name --
+   -----------------------
+
+   function Longest_File_Name return Natural is
+   begin
+      return Files.Longest_Name;
+   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 (Decl : Declaration_Reference) return Declaration_Reference is
+   begin
+      return Decl.Next;
+   end Next;
+
+   ----------
+   -- Next --
+   ----------
+
+   function Next (Ref : Reference) return Reference is
+   begin
+      return Ref.Next;
+   end Next;
+
+   ------------------
+   -- Next_Obj_Dir --
+   ------------------
+
+   function Next_Obj_Dir return String is
+      First : Integer := Directories.Obj_Dir_Index;
+      Last  : Integer := Directories.Obj_Dir_Index;
+
+   begin
+      if Last > Directories.Obj_Dir_Length then
+         return String'(1 .. 0 => ' ');
+      end if;
+
+      while Directories.Obj_Dir (Last) /= ' ' 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_Src_Dir --
+   ------------------
+
+   function Next_Src_Dir return String is
+      First : Integer := Directories.Src_Dir_Index;
+      Last  : Integer := Directories.Src_Dir_Index;
+
+   begin
+      if Last > Directories.Src_Dir_Length then
+         return String'(1 .. 0 => ' ');
+      end if;
+
+      while Directories.Src_Dir (Last) /= ' ' loop
+         Last := Last + 1;
+      end loop;
+
+      Directories.Src_Dir_Index := Last + 1;
+      return Directories.Src_Dir (First .. Last - 1);
+   end Next_Src_Dir;
+
+   -------------------------
+   -- Next_Unvisited_File --
+   -------------------------
+
+   function Next_Unvisited_File return File_Reference is
+      The_Files : File_Reference := Files.Table;
+
+   begin
+      while The_Files /= null loop
+         if not The_Files.Visited then
+            The_Files.Visited := True;
+            return The_Files;
+         end if;
+
+         The_Files := The_Files.Next;
+      end loop;
+
+      return Empty_File;
+   end Next_Unvisited_File;
+
+   ------------------
+   -- Parse_Gnatls --
+   ------------------
+
+   procedure Parse_Gnatls
+     (Gnatls_Src_Cache : out Ada.Strings.Unbounded.Unbounded_String;
+      Gnatls_Obj_Cache : out Ada.Strings.Unbounded.Unbounded_String)
+   is
+   begin
+      Osint.Add_Default_Search_Dirs;
+
+      for J in 1 .. Osint.Nb_Dir_In_Src_Search_Path loop
+         if Osint.Dir_In_Src_Search_Path (J)'Length = 0 then
+            Ada.Strings.Unbounded.Append (Gnatls_Src_Cache, "./" & ' ');
+         else
+            Ada.Strings.Unbounded.Append
+              (Gnatls_Src_Cache, Osint.Dir_In_Src_Search_Path (J).all & ' ');
+         end if;
+      end loop;
+
+      for J in 1 .. Osint.Nb_Dir_In_Obj_Search_Path loop
+         if Osint.Dir_In_Obj_Search_Path (J)'Length = 0 then
+            Ada.Strings.Unbounded.Append (Gnatls_Obj_Cache, "./" & ' ');
+         else
+            Ada.Strings.Unbounded.Append
+              (Gnatls_Obj_Cache, Osint.Dir_In_Obj_Search_Path (J).all & ' ');
+         end if;
+      end loop;
+   end Parse_Gnatls;
+
+   -------------------
+   -- Reset_Obj_Dir --
+   -------------------
+
+   procedure Reset_Obj_Dir is
+   begin
+      Directories.Obj_Dir_Index := 1;
+   end Reset_Obj_Dir;
+
+   -------------------
+   -- Reset_Src_Dir --
+   -------------------
+
+   procedure Reset_Src_Dir is
+   begin
+      Directories.Src_Dir_Index := 1;
+   end Reset_Src_Dir;
+
+   -----------------------
+   -- Set_Default_Match --
+   -----------------------
+
+   procedure Set_Default_Match (Value : Boolean) is
+   begin
+      Default_Match := Value;
+   end Set_Default_Match;
+
+   -------------------
+   -- Set_Directory --
+   -------------------
+
+   procedure Set_Directory
+     (File : in File_Reference;
+      Dir  : in String)
+   is
+   begin
+      File.Dir := new String'(Dir);
+   end Set_Directory;
+
+   -------------------
+   -- Set_Unvisited --
+   -------------------
+
+   procedure Set_Unvisited (File_Ref : in File_Reference) is
+      The_Files : File_Reference := Files.Table;
+
+   begin
+      while The_Files /= null loop
+         if The_Files = File_Ref then
+            The_Files.Visited := False;
+            return;
+         end if;
+
+         The_Files := The_Files.Next;
+      end loop;
+   end Set_Unvisited;
+
+end Xr_Tabls;