Move sources to src/ subdirectory.

1 files changed, 857 insertions, 0 deletions

diff --git a/src/files_map.adb b/src/files_map.adb
new file mode 100644
index 000000000..f4927e8db
--- /dev/null
+++ b/src/files_map.adb
@@ -0,0 +1,857 @@
+--  Loading of source files.
+--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold
+--
+--  GHDL is free software; you can redistribute it and/or modify it under
+--  the terms of the GNU General Public License as published by the Free
+--  Software Foundation; either version 2, or (at your option) any later
+--  version.
+--
+--  GHDL is distributed in the hope that it will be useful, but WITHOUT 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
+--  along with GHDL; see the file COPYING.  If not, write to the Free
+--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+--  02111-1307, USA.
+with Interfaces.C;
+with Ada.Characters.Latin_1;
+with Ada.Text_IO; use Ada.Text_IO;
+with Ada.Unchecked_Deallocation;
+with GNAT.Table;
+with GNAT.OS_Lib;
+with GNAT.Directory_Operations;
+with Name_Table; use Name_Table;
+with Str_Table;
+with Ada.Calendar;
+with Ada.Calendar.Time_Zones;
+
+package body Files_Map is
+
+   -- Check validity of FILE.
+   -- Raise an exception in case of error.
+   procedure Check_File (File: in Source_File_Entry);
+
+   type Lines_Table_Type is array (Positive) of Source_Ptr;
+   type Lines_Table_Ptr is access all Lines_Table_Type;
+
+   --  Data associed with a file.
+   type Source_File_Record is record
+      --  All location between first and last belong to this file.
+      First_Location : Location_Type;
+      Last_Location : Location_Type;
+
+      -- The name_id that identify this file.
+      -- FIXME: what about file aliasing (links) ?
+      File_Name: Name_Id;
+
+      Directory : Name_Id;
+
+      -- The buffer containing the file.
+      Source: File_Buffer_Acc;
+
+      -- Length of the file, which is also the length of the buffer.
+      File_Length: Natural;
+
+      Time_Stamp: Time_Stamp_Id;
+
+      --  Current number of line in Lines_Table.
+      Nbr_Lines: Natural;
+
+      Lines_Table: Lines_Table_Ptr;
+
+      --  Current size of Lines_Table.
+      Lines_Table_Max: Natural;
+
+      --  Cache.
+      Cache_Line : Natural;
+      Cache_Pos : Source_Ptr;
+   end record;
+
+   --  Next location to use.
+   Next_Location : Location_Type := Location_Nil + 1;
+
+   package Source_Files is new GNAT.Table
+     (Table_Index_Type => Source_File_Entry,
+      Table_Component_Type => Source_File_Record,
+      Table_Low_Bound => No_Source_File_Entry + 1,
+      Table_Initial => 16,
+      Table_Increment => 100);
+
+   function Get_Last_Source_File_Entry return Source_File_Entry is
+   begin
+      return Source_Files.Last;
+   end Get_Last_Source_File_Entry;
+
+   Home_Dir : Name_Id := Null_Identifier;
+
+   function Get_Home_Directory return Name_Id is
+   begin
+      if Home_Dir = Null_Identifier then
+         GNAT.Directory_Operations.Get_Current_Dir (Name_Buffer, Name_Length);
+         Home_Dir := Get_Identifier;
+      end if;
+      return Home_Dir;
+   end Get_Home_Directory;
+
+   procedure Location_To_File_Pos (Location : Location_Type;
+                                   File : out Source_File_Entry;
+                                   Pos : out Source_Ptr)
+   is
+   begin
+      --  FIXME: use a cache
+      --  FIXME: dicotomy
+      for I in Source_Files.First .. Source_Files.Last loop
+         declare
+            F : Source_File_Record renames Source_Files.Table (I);
+         begin
+            if Location >= F.First_Location
+              and then Location <= F.Last_Location
+            then
+               File := I;
+               Pos := Source_Ptr (Location - F.First_Location);
+               return;
+            end if;
+         end;
+      end loop;
+      --  File not found, location must be bad...
+      raise Internal_Error;
+   end Location_To_File_Pos;
+
+   function File_Pos_To_Location (File : Source_File_Entry; Pos : Source_Ptr)
+     return Location_Type
+   is
+   begin
+      if Source_Files.Table (File).Source = null then
+         raise Internal_Error;
+      else
+         return Source_Files.Table (File).First_Location + Location_Type (Pos);
+      end if;
+   end File_Pos_To_Location;
+
+   function Source_File_To_Location (File : Source_File_Entry)
+     return Location_Type
+   is
+   begin
+      return Source_Files.Table (File).First_Location;
+   end Source_File_To_Location;
+
+   procedure Reallocate_Lines_Table
+     (File: in out Source_File_Record; New_Size: Natural) is
+      use Interfaces.C;
+
+      function realloc
+        (memblock : Lines_Table_Ptr;
+         size     : size_t)
+         return     Lines_Table_Ptr;
+      pragma Import (C, realloc);
+
+      function malloc
+        (size     : size_t)
+         return     Lines_Table_Ptr;
+      pragma Import (C, malloc);
+
+      New_Table: Lines_Table_Ptr;
+      New_Byte_Size : size_t;
+   begin
+      New_Byte_Size :=
+        size_t(New_Size *
+                Lines_Table_Type'Component_Size / System.Storage_Unit);
+      if File.Lines_Table = null then
+         New_Table := malloc (New_Byte_Size);
+      else
+         New_Table := realloc (File.Lines_Table, New_Byte_Size);
+      end if;
+      if New_Table = null then
+         raise Storage_Error;
+      else
+         File.Lines_Table := New_Table;
+         File.Lines_Table (File.Lines_Table_Max + 1 .. New_Size) :=
+           (others => Source_Ptr_Bad);
+         File.Lines_Table_Max := New_Size;
+      end if;
+   end Reallocate_Lines_Table;
+
+   -- Add a new entry in the lines_table.
+   -- The new entry must be the next one after the last entry.
+   procedure File_Add_Line_Number
+     (File: Source_File_Entry; Line: Natural; Pos: Source_Ptr) is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+   begin
+      -- Just check File is not out of bounds.
+      if File > Source_Files.Last then
+         raise Internal_Error;
+      end if;
+
+      if Line = 1 then
+         -- The position of the first line is well-known.
+         if Pos /= Source_Ptr_Org then
+            raise Internal_Error;
+         end if;
+      else
+         -- The position of a non first line is not the well-known value.
+         if Pos <= Source_Ptr_Org then
+            raise Internal_Error;
+         end if;
+         -- Take care of scan backtracking.
+         if Line <= Source_File.Nbr_Lines then
+            if Source_File.Lines_Table (Line) = Source_Ptr_Bad then
+               Source_File.Lines_Table (Line) := Pos;
+            elsif Pos /= Source_File.Lines_Table (Line) then
+               Put_Line ("file" & Source_File_Entry'Image (File)
+                         & " for line" & Natural'Image (Line)
+                         & " pos =" & Source_Ptr'Image (Pos)
+                         & ", lines_table = "
+                         & Source_Ptr'Image (Source_File.Lines_Table (Line)));
+               raise Internal_Error;
+            end if;
+            return;
+         end if;
+         -- The new entry must just follow the last entry.
+--          if Line /= Source_File.Nbr_Lines + 1 then
+--             raise Internal_Error;
+--          end if;
+      end if;
+      if Line > Source_File.Lines_Table_Max then
+         Reallocate_Lines_Table (Source_File, (Line / 128 + 1) * 128);
+      end if;
+      Source_File.Lines_Table (Line) := Pos;
+      if Line > Source_File.Nbr_Lines then
+         Source_File.Nbr_Lines := Line;
+      end if;
+      -- Source_File.Nbr_Lines := Source_File.Nbr_Lines + 1;
+      if False then
+         Put_Line ("file" & Source_File_Entry'Image (File)
+                   & " line" & Natural'Image (Line)
+                   & " at position" & Source_Ptr'Image (Pos));
+      end if;
+   end File_Add_Line_Number;
+
+   --  Convert a physical column to a logical column.
+   --  A physical column is the offset in byte from the first byte of the line.
+   --  A logical column is the position of the character when displayed.
+   --  A HT (tabulation) moves the cursor to the next position multiple of 8.
+   --  The first character is at position 1 and at offset 0.
+   procedure Coord_To_Position
+     (File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Offset : Natural;
+      Name : out Name_Id;
+      Col : out Natural)
+   is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+      Res : Positive := 1;
+   begin
+      Name := Source_File.File_Name;
+      for I in Line_Pos .. Line_Pos + Source_Ptr (Offset) - 1 loop
+         if Source_File.Source (I) = Ada.Characters.Latin_1.HT then
+            Res := Res + 8 - Res mod 8;
+         else
+            Res := Res + 1;
+         end if;
+      end loop;
+      Col := Res;
+   end Coord_To_Position;
+
+   --  Should only be called by Location_To_Coord.
+   function Location_To_Line
+     (Source_File : Source_File_Record; Pos : Source_Ptr)
+     return Natural
+   is
+      Low, Hi, Mid : Natural;
+      Mid1 : Natural;
+      Lines_Table : constant Lines_Table_Ptr := Source_File.Lines_Table;
+   begin
+      --  Look in the cache.
+      if Pos >= Source_File.Cache_Pos then
+         Low := Source_File.Cache_Line;
+         Hi := Source_File.Nbr_Lines;
+      else
+         Low := 1;
+         Hi := Source_File.Cache_Line;
+      end if;
+
+      loop
+         << Again >> null;
+         Mid := (Hi + Low) / 2;
+         if Lines_Table (Mid) = Source_Ptr_Bad then
+            -- There is a hole: no position for this line.
+            -- Set MID1 to a line which has a position.
+            -- Try downward.
+            Mid1 := Mid;
+            while Lines_Table (Mid1) = Source_Ptr_Bad loop
+               --  Note: Low may have no line.
+               exit when Mid1 = Low;
+               Mid1 := Mid1 - 1;
+            end loop;
+            if Mid1 /= Low then
+               --  Mid1 has a line.
+               if Pos < Lines_Table (Mid1) then
+                  Hi := Mid1;
+                  goto Again;
+               end if;
+               if Pos > Lines_Table (Mid1) then
+                  Low := Mid1;
+                  goto Again;
+               end if;
+               --  Found, handled just below.
+            else
+               --  Failed (downward is LOW): try upward.
+               Mid1 := Mid;
+               while Lines_Table (Mid1) = Source_Ptr_Bad loop
+                  Mid1 := Mid1 + 1;
+               end loop;
+               if Mid1 = Hi then
+                  --  Failed: no lines between LOW and HI.
+                  if Pos >= Lines_Table (Hi) then
+                     Mid1 := Hi;
+                  else
+                     Mid1 := Low;
+                  end if;
+                  return Mid1;
+               end if;
+               --  Mid1 has a line.
+               if Pos < Lines_Table (Mid1) then
+                  Hi := Mid1;
+                  goto Again;
+               end if;
+               if Pos > Lines_Table (Mid1) then
+                  Low := Mid1;
+                  goto Again;
+               end if;
+            end if;
+            Mid := Mid1;
+         end if;
+         if Pos >= Lines_Table (Mid) then
+            if Mid = Source_File.Nbr_Lines
+              or else Pos < Lines_Table (Mid + 1)
+              or else Pos = Lines_Table (Mid)
+              or else (Hi <= Mid + 1
+                       and Lines_Table (Mid + 1) = Source_Ptr_Bad)
+            then
+               return Mid;
+            end if;
+         end if;
+         if Pos < Lines_Table (Mid) then
+            Hi := Mid - 1;
+         else
+            if Lines_Table (Mid + 1) /= Source_Ptr_Bad then
+               Low := Mid + 1;
+            else
+               Low := Mid;
+            end if;
+         end if;
+      end loop;
+   end Location_To_Line;
+
+   procedure Location_To_Coord
+     (Source_File : in out Source_File_Record;
+      Pos : Source_Ptr;
+      Line_Pos : out Source_Ptr;
+      Line : out Natural;
+      Offset : out Natural)
+   is
+      Line_P : Source_Ptr;
+      Line_Threshold : constant Natural := 4;
+      Low, Hi : Natural;
+   begin
+      --  Look in the cache.
+      if Pos >= Source_File.Cache_Pos then
+         Low := Source_File.Cache_Line;
+         Hi := Source_File.Nbr_Lines;
+
+         --  Maybe adjust the threshold.
+         --  Quick look.
+         if Pos - Source_File.Cache_Pos <= 120
+           and then Low + Line_Threshold <= Hi
+         then
+            for I in 1 .. Line_Threshold loop
+               Line_P := Source_File.Lines_Table (Low + I);
+               if Line_P > Pos then
+                  Line := Low + I - 1;
+                  goto Found;
+               else
+                  exit when Line_P = Source_Ptr_Bad;
+               end if;
+            end loop;
+         end if;
+      end if;
+
+      Line := Location_To_Line (Source_File, Pos);
+
+      << Found >> null;
+
+      Line_Pos := Source_File.Lines_Table (Line);
+      Offset := Natural (Pos - Source_File.Lines_Table (Line));
+
+      --  Update cache.
+      Source_File.Cache_Pos := Pos;
+      Source_File.Cache_Line := Line;
+   end Location_To_Coord;
+
+   procedure Location_To_Position
+     (Location : Location_Type;
+      Name : out Name_Id;
+      Line : out Natural;
+      Col : out Natural)
+   is
+      File : Source_File_Entry;
+      Line_Pos : Source_Ptr;
+      Offset : Natural;
+   begin
+      Location_To_Coord (Location, File, Line_Pos, Line, Offset);
+      Coord_To_Position (File, Line_Pos, Offset, Name, Col);
+   end Location_To_Position;
+
+   procedure Location_To_Coord
+     (Location : Location_Type;
+      File : out Source_File_Entry;
+      Line_Pos : out Source_Ptr;
+      Line : out Natural;
+      Offset : out Natural)
+   is
+      Pos : Source_Ptr;
+   begin
+      Location_To_File_Pos (Location, File, Pos);
+      Location_To_Coord (Source_Files.Table (File), Pos,
+                         Line_Pos, Line, Offset);
+   end Location_To_Coord;
+
+   -- Convert the first digit of VAL into a character (base 10).
+   function Digit_To_Char (Val: Natural) return Character is
+   begin
+      return Character'Val (Character'Pos ('0') + Val mod 10);
+   end Digit_To_Char;
+
+   -- Format: YYYYMMDDHHmmsscc
+   -- Y: year, M: month, D: day, H: hour, m: minute, s: second, cc:100th sec
+   function Os_Time_To_Time_Stamp_Id (Time: GNAT.OS_Lib.OS_Time)
+     return Time_Stamp_Id
+   is
+      use GNAT.OS_Lib;
+      use Str_Table;
+      Res: Time_Stamp_Id;
+      Year: Year_Type;
+      Month: Month_Type;
+      Day: Day_Type;
+      Hour: Hour_Type;
+      Minute: Minute_Type;
+      Second: Second_Type;
+   begin
+      GM_Split (Time, Year, Month, Day, Hour, Minute, Second);
+      Res := Time_Stamp_Id (Start);
+      Append (Digit_To_Char (Year / 1000));
+      Append (Digit_To_Char (Year / 100));
+      Append (Digit_To_Char (Year / 10));
+      Append (Digit_To_Char (Year / 1));
+      Append (Digit_To_Char (Month / 10));
+      Append (Digit_To_Char (Month / 1));
+      Append (Digit_To_Char (Day / 10));
+      Append (Digit_To_Char (Day / 1));
+      Append (Digit_To_Char (Hour / 10));
+      Append (Digit_To_Char (Hour / 1));
+      Append (Digit_To_Char (Minute / 10));
+      Append (Digit_To_Char (Minute / 1));
+      Append (Digit_To_Char (Second / 10));
+      Append (Digit_To_Char (Second / 1));
+      Append ('.');
+      Append ('0');
+      Append ('0');
+      Append ('0');
+      Finish;
+      return Res;
+   end Os_Time_To_Time_Stamp_Id;
+
+   function Get_File_Time_Stamp (Filename : System.Address)
+     return Time_Stamp_Id
+   is
+      use GNAT.OS_Lib;
+      Fd : File_Descriptor;
+      Res : Time_Stamp_Id;
+   begin
+      Fd := Open_Read (Filename, Binary);
+      if Fd = Invalid_FD then
+         return Null_Time_Stamp;
+      end if;
+      Res :=  Os_Time_To_Time_Stamp_Id (File_Time_Stamp (Fd));
+      Close (Fd);
+      return Res;
+   end Get_File_Time_Stamp;
+
+   function Get_File_Time_Stamp (FD : GNAT.OS_Lib.File_Descriptor)
+                                return Time_Stamp_Id
+   is
+   begin
+      return Os_Time_To_Time_Stamp_Id (GNAT.OS_Lib.File_Time_Stamp (FD));
+   end Get_File_Time_Stamp;
+
+   function Get_Os_Time_Stamp return Time_Stamp_Id
+   is
+      use Ada.Calendar;
+      use Ada.Calendar.Time_Zones;
+      use Str_Table;
+
+      Now : constant Time := Clock;
+      Now_UTC : constant Time := Now - Duration (UTC_Time_Offset (Now) * 60);
+      Year : Year_Number;
+      Month : Month_Number;
+      Day : Day_Number;
+      Sec : Day_Duration;
+      S : Integer;
+      S1 : Integer;
+      M : Integer;
+      Res: Time_Stamp_Id;
+   begin
+      --  Use UTC time (like file time stamp).
+      Split (Now_UTC, Year, Month, Day, Sec);
+
+      Res := Time_Stamp_Id (Start);
+      Append (Digit_To_Char (Year / 1000));
+      Append (Digit_To_Char (Year / 100));
+      Append (Digit_To_Char (Year / 10));
+      Append (Digit_To_Char (Year / 1));
+      Append (Digit_To_Char (Month / 10));
+      Append (Digit_To_Char (Month / 1));
+      Append (Digit_To_Char (Day / 10));
+      Append (Digit_To_Char (Day / 1));
+      S := Integer (Sec);
+      if Day_Duration (S) > Sec then
+         --  We need a truncation.
+         S := S - 1;
+      end if;
+      S1 := S / 3600;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+      S1 := (S / 60) mod 60;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+      S1 := S mod 60;
+      Append (Digit_To_Char (S1 / 10));
+      Append (Digit_To_Char (S1));
+
+      Append ('.');
+      Sec := Sec - Day_Duration (S);
+      M := Integer (Sec * 1000);
+      if M = 1000 then
+         --  We need truncation.
+         M := 999;
+      end if;
+      Append (Digit_To_Char (M / 100));
+      Append (Digit_To_Char (M / 10));
+      Append (Digit_To_Char (M));
+      Finish;
+      return Res;
+   end Get_Os_Time_Stamp;
+
+   function Get_Pathname (Directory : Name_Id;
+                          Name: Name_Id;
+                          Add_Nul : Boolean)
+     return String
+   is
+      L : Natural;
+   begin
+      Image (Name);
+      if not GNAT.OS_Lib.Is_Absolute_Path (Name_Buffer (1 .. Name_Length)) then
+         L := Name_Length;
+         Image (Directory);
+         Name_Buffer (Name_Length + 1 .. Name_Length + L) := Image (Name);
+         Name_Length := Name_Length + L;
+      end if;
+      if Add_Nul then
+         Name_Length := Name_Length + 1;
+         Name_Buffer (Name_Length) := Character'Val (0);
+      end if;
+      return Name_Buffer (1 .. Name_Length);
+   end Get_Pathname;
+
+   --  Find a source_file by DIRECTORY and NAME.
+   --  Return NO_SOURCE_FILE_ENTRY if not already opened.
+   function Find_Source_File (Directory : Name_Id; Name: Name_Id)
+     return Source_File_Entry
+   is
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         if Source_Files.Table (I).File_Name = Name
+           and then Source_Files.Table (I).Directory = Directory
+         then
+            return I;
+         end if;
+      end loop;
+      return No_Source_File_Entry;
+   end Find_Source_File;
+
+   -- Return an entry for a filename.
+   -- The file is not loaded.
+   function Create_Source_File_Entry (Directory : Name_Id; Name: Name_Id)
+     return Source_File_Entry
+   is
+      Res: Source_File_Entry;
+   begin
+      if Find_Source_File (Directory, Name) /= No_Source_File_Entry then
+         raise Internal_Error;
+      end if;
+
+      -- Create a new entry.
+      Res := Source_Files.Allocate;
+      Source_Files.Table (Res) := (First_Location => Next_Location,
+                                   Last_Location => Next_Location,
+                                   File_Name => Name,
+                                   Directory => Directory,
+                                   Time_Stamp => Null_Time_Stamp,
+                                   Source => null,
+                                   File_Length => 0,
+                                   Nbr_Lines => 0,
+                                   Lines_Table_Max => 0,
+                                   Lines_Table => null,
+                                   Cache_Pos => Source_Ptr_Org,
+                                   Cache_Line => 1);
+      File_Add_Line_Number (Res, 1, Source_Ptr_Org);
+      return Res;
+   end Create_Source_File_Entry;
+
+   function Create_Source_File_From_String (Name: Name_Id; Content : String)
+                                           return Source_File_Entry
+   is
+      Res : Source_File_Entry;
+      Buffer: File_Buffer_Acc;
+      Len : constant Source_Ptr := Source_Ptr (Content'Length);
+   begin
+      Res := Create_Source_File_Entry (Null_Identifier, Name);
+
+      Buffer := new File_Buffer
+        (Source_Ptr_Org .. Source_Ptr_Org + Len + 1);
+
+      Buffer (Source_Ptr_Org .. Source_Ptr_Org + Len - 1) :=
+        File_Buffer (Content);
+      Buffer (Source_Ptr_Org + Len) := EOT;
+      Buffer (Source_Ptr_Org + Len + 1) := EOT;
+
+      Source_Files.Table (Res).Last_Location :=
+        Next_Location + Location_Type (Len) + 1;
+      Next_Location := Source_Files.Table (Res).Last_Location + 1;
+      Source_Files.Table (Res).Source := Buffer;
+      Source_Files.Table (Res).File_Length := Natural (Len);
+
+      return Res;
+   end Create_Source_File_From_String;
+
+   function Create_Virtual_Source_File (Name: Name_Id)
+                                       return Source_File_Entry
+   is
+   begin
+      return Create_Source_File_From_String (Name, "");
+   end Create_Virtual_Source_File;
+
+   -- Return an entry for a filename.
+   -- Load the filename if necessary.
+   function Load_Source_File (Directory : Name_Id; Name: Name_Id)
+                              return Source_File_Entry
+   is
+      use GNAT.OS_Lib;
+      Fd: File_Descriptor;
+
+      Res: Source_File_Entry;
+
+      Length: Source_Ptr;
+      Buffer: File_Buffer_Acc;
+   begin
+      --  If the file is already loaded, nothing to do!
+      Res := Find_Source_File (Directory, Name);
+      if Res /= No_Source_File_Entry then
+         if Source_Files.Table (Res).Source = null then
+            raise Internal_Error;
+         end if;
+         return Res;
+      end if;
+
+      --  Open the file (punt on non regular files).
+      declare
+         Filename : String := Get_Pathname (Directory, Name, True);
+      begin
+         if not Is_Regular_File(Filename) then
+            return No_Source_File_Entry;
+         end if;
+         Fd := Open_Read (Filename'Address, Binary);
+         if Fd = Invalid_FD then
+            return No_Source_File_Entry;
+         end if;
+      end;
+
+      Res := Create_Source_File_Entry (Directory, Name);
+
+      Source_Files.Table (Res).Time_Stamp := Get_File_Time_Stamp (Fd);
+
+      Length := Source_Ptr (File_Length (Fd));
+
+      Buffer :=
+        new File_Buffer (Source_Ptr_Org .. Source_Ptr_Org + Length + 1);
+
+      if Read (Fd, Buffer (Source_Ptr_Org)'Address, Integer (Length))
+        /= Integer (Length)
+      then
+         Close (Fd);
+         raise Internal_Error;
+      end if;
+      Buffer (Length) := EOT;
+      Buffer (Length + 1) := EOT;
+
+      if Source_Files.Table (Res).First_Location /= Next_Location then
+         --  Load_Source_File call must follow its Create_Source_File.
+         raise Internal_Error;
+      end if;
+
+      Source_Files.Table (Res).Last_Location :=
+        Next_Location + Location_Type (Length) + 1;
+      Next_Location := Source_Files.Table (Res).Last_Location + 1;
+      Source_Files.Table (Res).Source := Buffer;
+      Source_Files.Table (Res).File_Length := Integer (Length);
+
+      Close (Fd);
+
+      return Res;
+   end Load_Source_File;
+
+   -- Check validity of FILE.
+   -- Raise an exception in case of error.
+   procedure Check_File (File: in Source_File_Entry) is
+   begin
+      if File > Source_Files.Last then
+         raise Internal_Error;
+      end if;
+   end Check_File;
+
+   -- Return a buffer (access to the contents of the file) for a file entry.
+   function Get_File_Source (File: Source_File_Entry)
+                             return File_Buffer_Acc is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Source;
+   end Get_File_Source;
+
+   -- Return the length of the file (which is the size of the file buffer).
+   function Get_File_Length (File: Source_File_Entry) return Source_Ptr is
+   begin
+      Check_File (File);
+      return Source_Ptr (Source_Files.Table (File).File_Length);
+   end Get_File_Length;
+
+   -- Return the name of the file.
+   function Get_File_Name (File: Source_File_Entry) return Name_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).File_Name;
+   end Get_File_Name;
+
+   -- Return the date of the file (last modification date) as a string.
+   function Get_File_Time_Stamp (File: Source_File_Entry)
+     return Time_Stamp_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Time_Stamp;
+   end Get_File_Time_Stamp;
+
+   function Get_Source_File_Directory (File : Source_File_Entry)
+                                       return Name_Id is
+   begin
+      Check_File (File);
+      return Source_Files.Table (File).Directory;
+   end Get_Source_File_Directory;
+
+   function Line_To_Position (File : Source_File_Entry; Line : Natural)
+                             return Source_Ptr
+   is
+   begin
+      Check_File (File);
+      if Line > Source_Files.Table (File).Nbr_Lines then
+         return Source_Ptr_Bad;
+      else
+         return Source_Files.Table (File).Lines_Table (Line);
+      end if;
+   end Line_To_Position;
+
+   function Is_Eq (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
+   is
+      use Str_Table;
+      L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+   begin
+      return L_Str (1 .. Time_Stamp_String'Length)
+        = R_Str (1 .. Time_Stamp_String'Length);
+   end Is_Eq;
+
+   function Is_Gt (L : Time_Stamp_Id; R : Time_Stamp_Id) return Boolean
+   is
+      use Str_Table;
+      L_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (L));
+      R_Str : constant String_Fat_Acc := Get_String_Fat_Acc (String_Id (R));
+   begin
+      return L_Str (1 .. Time_Stamp_String'Length)
+        > R_Str (1 .. Time_Stamp_String'Length);
+   end Is_Gt;
+
+   function Get_Time_Stamp_String (Ts : Time_Stamp_Id) return String is
+   begin
+      if Ts = Null_Time_Stamp then
+         return "NULL_TS";
+      else
+         return String (Str_Table.Get_String_Fat_Acc (String_Id (Ts))
+                          (1 .. Time_Stamp_String'Length));
+      end if;
+   end Get_Time_Stamp_String;
+
+   -- Debug procedures.
+   procedure Debug_Source_Lines (File: Source_File_Entry);
+   pragma Unreferenced (Debug_Source_Lines);
+
+   procedure Debug_Source_File;
+   pragma Unreferenced (Debug_Source_File);
+
+   --  Disp sources lines of a file.
+   procedure Debug_Source_Lines (File: Source_File_Entry) is
+      Source_File: Source_File_Record renames Source_Files.Table (File);
+   begin
+      Check_File (File);
+      for I in Positive'First .. Source_File.Nbr_Lines loop
+         Put_Line ("line" & Natural'Image (I) & " at offset"
+                   & Source_Ptr'Image (Source_File.Lines_Table (I)));
+      end loop;
+   end Debug_Source_Lines;
+
+   procedure Debug_Source_File is
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         declare
+            F : Source_File_Record renames Source_Files.Table(I);
+         begin
+            Put ("file" & Source_File_Entry'Image (I));
+            Put (" name: " & Image (F.File_Name));
+            Put (" dir:" & Image (F.Directory));
+            Put (" length:" & Natural'Image (F.File_Length));
+            New_Line;
+            if F.Time_Stamp /= Null_Time_Stamp then
+               Put (" time_stamp: " & Get_Time_Stamp_String (F.Time_Stamp));
+            end if;
+            Put (" nbr lines:" & Natural'Image (F.Nbr_Lines));
+            Put (" lines_table_max:" & Natural'Image (F.Lines_Table_Max));
+            New_Line;
+         end;
+      end loop;
+   end Debug_Source_File;
+
+   procedure Initialize
+   is
+      procedure free (Ptr : Lines_Table_Ptr);
+      pragma Import (C, free);
+
+      procedure Free is new Ada.Unchecked_Deallocation
+        (File_Buffer, File_Buffer_Acc);
+   begin
+      for I in Source_Files.First .. Source_Files.Last loop
+         free (Source_Files.Table (I).Lines_Table);
+         Free (Source_Files.Table (I).Source);
+      end loop;
+      Source_Files.Free;
+      Source_Files.Init;
+   end Initialize;
+end Files_Map;