-----------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--                     G N A T S Y N C . T H R E A D S                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                       Copyright (C) 2008, AdaCore                        --
--                                                                          --
-- GNATSYNC  is  free  software;  you  can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 2, or ( at your option)  any  later --
-- version.  GNATCHECK  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 distributed with GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATSYNC is maintained by AdaCore (http://www.adacore.com).              --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;           use Ada.Characters.Handling;
with Ada.Containers.Indefinite_Hashed_Sets;
with Ada.Containers.Ordered_Sets;
with Ada.Containers.Vectors;
with Ada.Strings.Hash;
with Ada.Wide_Text_IO;                  use Ada.Wide_Text_IO;

with GNAT.HTable;
with GNAT.OS_Lib;                       use GNAT.OS_Lib;

with Asis.Compilation_Units;            use Asis.Compilation_Units;
with Asis.Declarations;                 use Asis.Declarations;
with Asis.Elements;                     use Asis.Elements;

with ASIS_UL.Common;                    use ASIS_UL.Common;
with ASIS_UL.Misc;                      use ASIS_UL.Misc;
with ASIS_UL.Output;                    use ASIS_UL.Output;
with ASIS_UL.Utilities;                 use ASIS_UL.Utilities;
with ASIS_UL.Wide_Strings;              use ASIS_UL.Wide_Strings;

with Gnatsync.ASIS_Utilities;           use Gnatsync.ASIS_Utilities;
with Gnatsync.Options;                  use Gnatsync.Options;

package body Gnatsync.Threads is

   ------------------------------------
   --  Foreign threads names storage --
   ------------------------------------

   package Thread_Info_Simple_Names is new
     Ada.Containers.Indefinite_Hashed_Sets
        (Element_Type        => String,
         Hash                => Ada.Strings.Hash,
         Equivalent_Elements => Standard."=",
         "="                 => Standard."=");
   --  Note, that we keep all the strings folded to lower case

   Thread_Simple_Names_Table         : Thread_Info_Simple_Names.Set;
   Section_Border_Simple_Names_Table : Thread_Info_Simple_Names.Set;

   ---------------------------
   --  Threads info storage --
   ---------------------------

   First_Thread_Info : constant Thread_Info_Id := No_Thread_Info + 1;

   subtype Existing_Thread_Info_Id is Thread_Info_Id
     range First_Thread_Info .. Thread_Info_Id'Last;

   package Section_Border_Lists is new Ada.Containers.Ordered_Sets
     (Element_Type => Thread_Info_Id);

   type Thread_Info_Rec is record
      Name                    : Wide_String_Loc;
      Thread_Info_Kind        : Thread_Info_Kinds;
      Related_Section_Borders : Section_Border_Lists.Set;
      Hash_Link               : Thread_Info_Id;
   end record;

   type Thread_Info_Rec_Access is access Thread_Info_Rec;

   package Thread_Info_Container is new Ada.Containers.Vectors
      (Index_Type   => Existing_Thread_Info_Id,
       Element_Type => Thread_Info_Rec);
   --  We can not use a hashed container. ???.

   Thread_Info_Table : Thread_Info_Container.Vector;

   ---------------------
   -- Access routines --
   ---------------------

   function Table (Id : Thread_Info_Id) return Thread_Info_Rec_Access;
   --  Returns the pointer to the element from Thread_Info_Table

   function Get_Name (Id : Thread_Info_Id) return Wide_String;
   --  Returns the name of the corresponding procedure.

   function Get_Hash_Link (Id : Thread_Info_Id) return Thread_Info_Id;
   --  Get the hash link of the corresponding entry in the Thread_Info_Table.

   --  All the Get_... functions assume that Present (Id).

   ---------------------
   -- Update routines --
   ---------------------

   procedure Set_Hash_Link (Id : Thread_Info_Id; Val : Thread_Info_Id);
   procedure Add_Section_Border (To : Thread_Info_Id; Border : Thread_Info_Id);

   ---------------------
   --  Debug routines --
   ---------------------

   procedure Print_Short_Thread_Names;
   procedure Print_Short_Section_Border_Names;
   procedure Print_Thread_Info_Table;
   procedure Print_Node (Id : Existing_Thread_Info_Id);

   -------------------------
   -- Processing routines --
   -------------------------

   procedure Store_Thread_Info_Item
     (Name             : Wide_String;
      Info_Kind        : Thread_Info_Kinds;
      Section_Start_Id : Thread_Info_Id);
   --  Stores the corresponding piece of the thread info. Name is stored in
   --  Thread_Info_Table, and its defining selector is also stored in
   --  Thread_Names_Table (if Info_Kind is set to Thread) or in
   --  Section_Border_Names_Table (if Info_Kind is in
   --  Section_Start .. Section_End). If Info_Kind is equal to Section_End,
   --  this procedure sets the links between the entry corresponding to Name
   --  (as the section end procedure) and the section start procedure pointed
   --  by Section_Start parameter.

   function Find_Info (Name : Wide_String) return Thread_Info_Id;
   --  Tries to locate the entry corresponding to Name into Thread_Info_Table.
   --  Returns No_Thread_Info if there is no such entry.

   function Find_Info
     (Decl           : Asis.Element;
      Info_Kind      : Thread_Info_Kinds := Not_A_Thread_Info;
      Section_Border : Boolean := False)
      return           Thread_Info_Id;
   --  Tries to locate the thread info item corresponding to Decl. The other
   --  two parameters, when specified, are used to narrow the search. If
   --  Info_Kind is set to some existing info kind, the function looks only for
   --  the specified kind of information items. If Section_Border is set ON,
   --  the function looks for items of the kinds Section_Start .. Section_End.
   --  It is an error to specify both these additional parameters (that is, to
   --  set Section_Border ON and to provide the existing info item kind for
   --  Info_Kind.
   --
   --  At the moment the only expected kind for Decl is a procedure
   --  declaration, a procedure instantiation or a procedure body declaration.
   --  It is an error to call this function for other ASIS Elements

   ------------------------------------------
   -- Hash table for Thread_Info_Container --
   ------------------------------------------

   Hash_Num : constant Integer := 2**8;  --  ???
   --  Number of headers in the hash table. We are not expecting too much
   --  entries for the names of thhread and section start/stop procedures

   Hash_Max : constant Integer := Hash_Num - 1;
   --  Indexes in the hash header table run from 0 to Hash_Num - 1

   subtype Hash_Index_Type is Integer range 0 .. Hash_Max;
   --  Range of hash index values

   Hash_Table : array (Hash_Index_Type) of Thread_Info_Id :=
     (others => No_Thread_Info);
   --  The hash table is used to locate existing entries in the threads info
   --  table. The entries point to the first table entry whose hash value
   --  matches the hash code. Then subsequent table entries with the same hash
   --  code value are linked through the Hash_Link fields.

   function Hash (Ada_Expanded_Name : Wide_String) return Hash_Index_Type;
   --  Compute hash code for its argument.

   function Hash is new GNAT.HTable.Hash (Header_Num => Hash_Index_Type);

   --------------------
   -- Closes_Section --
   --------------------

   function Closes_Section
     (Started_By   : Thread_Info_Id;
      Closing_Item : Thread_Info_Id)
      return         Boolean
   is
      Result : Boolean;
   begin
      Result := Section_Border_Lists.Contains
                  (Table (Started_By).Related_Section_Borders, Closing_Item);

      return Result;
   end Closes_Section;

   ---------------
   -- Find_Info --
   ---------------

   function Find_Info (Name : Wide_String) return Thread_Info_Id is
      Result       :          Thread_Info_Id := Hash_Table (Hash (Name));
      Normalized_N : constant Wide_String    := To_Upper_Case (Name);
   begin

      while Present (Result) loop

         if Normalized_N = Get_Name (Result) then
            exit;
         end if;

         Result :=
           Thread_Info_Container.Element (Thread_Info_Table, Result).Hash_Link;
      end loop;

      return Result;
   end Find_Info;

   function Find_Info
     (Decl           : Asis.Element;
      Info_Kind      : Thread_Info_Kinds := Not_A_Thread_Info;
      Section_Border : Boolean := False)
      return           Thread_Info_Id
   is
      No_Info : Boolean := False;
      --  If this flag is computed to True, then any further analysis is not
      --  necessary, because this for sure means that the corresponding thread
      --  information items does not exist.

      Result  : Thread_Info_Id := No_Thread_Info;

      Encl_Unit_Kind : Unit_Kinds;
      Def_Name       : Asis.Element;
      Short_Name     : String_Access;
      Full_Name      : Wide_String_Access;

   begin
      pragma Assert
               (not (Section_Border
                and then
                     Info_Kind /= Not_A_Thread_Info));

      --  The firts very rough check:
      No_Info :=
        not (Foreign_Threads_Present or else Foreign_Critical_Sections_Present)
       or else
            ((Section_Border or else Info_Kind in Section_Start .. Section_End)
           and then
              not Foreign_Critical_Sections_Present)
       or else
            (Info_Kind = Thread and then not Foreign_Threads_Present);

      if not No_Info then
         --  First, checking for a short name:
         Def_Name   := First_Name (Decl);
         Short_Name :=
           new String '(To_Lower (To_String (Defining_Name_Image (Def_Name))));

         if Info_Kind = Thread then
            No_Info := not Thread_Info_Simple_Names.Contains
                             (Container => Thread_Simple_Names_Table,
                              Item      => Short_Name.all);
         elsif Section_Border
              or else
               Info_Kind in Section_Start .. Section_End
         then
            No_Info := not Thread_Info_Simple_Names.Contains
                             (Container => Section_Border_Simple_Names_Table,
                              Item      => Short_Name.all);
         else
            --  No additional information about the proceddure to look for:

            No_Info :=
              not (Thread_Info_Simple_Names.Contains
                     (Container => Section_Border_Simple_Names_Table,
                      Item      => Short_Name.all)
                 or else
                   Thread_Info_Simple_Names.Contains
                             (Container => Thread_Simple_Names_Table,
                              Item      => Short_Name.all));
         end if;

         Free (Short_Name);
      end if;

      --  Now check if Decl satisfies to the restrictions imposed currently on
      --  subprograms that can be defined for gnatsync as foreigh threads or
      --  borders of critical sections:

      if not No_Info then
         Encl_Unit_Kind := Unit_Kind (Enclosing_Compilation_Unit (Decl));

         case Encl_Unit_Kind is
            when A_Procedure          |
                 A_Procedure_Body     |
                 A_Procedure_Instance |
                 A_Package            |
                 A_Package_Instance   =>

               if not (Encl_Unit_Kind = A_Procedure_Body)
                      and then
                       not Is_Nil (Enclosing_Element (Decl))
               then
                  --  This condition filters out the cases of entities declared
                  --  in the bodies of library procedures

                  case Declaration_Kind (Decl) is
                     when A_Procedure_Declaration      |
                          A_Procedure_Body_Declaration |
                          A_Procedure_Instantiation    =>
                        null;
                     when others =>
                        No_Info := True;
                  end case;

               end if;

            when others =>
               No_Info := True;
         end case;

      end if;

      if not No_Info then
         --  Full-size search in the Thread_Info_Table
         Full_Name := Get_Expanded_Name (Decl);
         Result    := Find_Info (Full_Name.all);

         if Present (Result) then
            --  Check if we have found what we need
            if Info_Kind /= Not_A_Thread_Info
              and then
               Thread_Info_Kind (Result) /= Info_Kind
            then
               Result := No_Thread_Info;
            elsif Section_Border
              and then
                  Thread_Info_Kind (Result) not in Section_Start .. Section_End
            then
               Result := No_Thread_Info;
            end if;
         end if;

         Free (Full_Name);
      end if;

      return Result;
   end Find_Info;

   -----------------------------------------
   -- Foreign_Critical_Sections_Specified --
   -----------------------------------------

   function Foreign_Critical_Sections_Specified return Boolean is
   begin
      return not Thread_Info_Simple_Names.Is_Empty
                   (Section_Border_Simple_Names_Table);
   end Foreign_Critical_Sections_Specified;

   ------------------------------
   -- Foring_Threads_Specified --
   ------------------------------

   function Foring_Threads_Specified return Boolean is
   begin
      return not Thread_Info_Simple_Names.Is_Empty (Thread_Simple_Names_Table);
   end Foring_Threads_Specified;

   -------------------
   -- Get_Hash_Link --
   -------------------

   function Get_Hash_Link (Id : Thread_Info_Id) return Thread_Info_Id is
   begin
      pragma Assert (Present (Id));

      return Table (Id).Hash_Link;
   end Get_Hash_Link;

   --------------
   -- Get_Name --
   ---------------

   function Get_Name (Id : Thread_Info_Id) return Wide_String is
   begin
      pragma Assert (Present (Id));

      return Get_Wide_String (Table (Id).Name);
   end Get_Name;

   ---------------------------
   -- Get_Section_Border_Id --
   ---------------------------

   function Get_Section_Border_Id (El : Asis.Element) return Thread_Info_Id is
      Result : constant Thread_Info_Id :=
        Find_Info (Decl => El,
        Section_Border  => True);
   begin
      return Result;
   end Get_Section_Border_Id;

   ----------------------
   -- Thread_Info_Kind --
   ----------------------

   function Thread_Info_Kind (Id : Thread_Info_Id) return Thread_Info_Kinds is
   begin
      if No (Id) then
         return Not_A_Thread_Info;
      else
         pragma Assert (Present (Id));
         return Table (Id).Thread_Info_Kind;
      end if;
   end Thread_Info_Kind;

   ----------
   -- Hash --
   ----------

   function Hash (Ada_Expanded_Name : Wide_String) return Hash_Index_Type is
   begin
      return Hash (To_Lower (To_String (Ada_Expanded_Name)));
   end Hash;

   -----------------------
   -- Is_Foreign_Thread --
   -----------------------

   function Is_Foreign_Thread (El : Asis.Element) return Boolean is
   begin
      return Present (Find_Info (Decl => El,
                                 Info_Kind => Thread));
   end Is_Foreign_Thread;

   --------
   -- No --
   --------

   function No (Id : Thread_Info_Id) return Boolean is
   begin
      return Id = No_Thread_Info;
   end No;

   -------------
   -- Present --
   -------------

   function Present (Id : Thread_Info_Id) return Boolean is
   begin
      return Id in First_Thread_Info ..
                   Thread_Info_Container.Last_Index (Thread_Info_Table);
   end Present;

   ----------------
   -- Print_Node --
   ----------------

   procedure Print_Node (Id : Existing_Thread_Info_Id) is
      Next_El : Section_Border_Lists.Cursor :=
        Section_Border_Lists.First (Table (Id).Related_Section_Borders);
      use type Section_Border_Lists.Cursor;
   begin
      Info_No_EOL ("Id =" & Id'Img);
      Info        (" - " & Thread_Info_Kind (Id)'Img);

      Info_No_EOL ("   name :");
      Info_No_EOL (To_String (Get_Name (Id)));
      Info (":");

      Info ("   hash link: " & Get_Hash_Link (Id)'Img);

      Info_No_EOL ("   Related_Section_Borders:");

      if Next_El = Section_Border_Lists.No_Element then
         Info_No_EOL (" ...nothing...");
      else

         while Next_El /= Section_Border_Lists.No_Element loop
            Info_No_EOL (Section_Border_Lists.Element (Next_El)'Img);
            Next_El := Section_Border_Lists.Next (Next_El);
         end loop;

      end if;

      Info ("");

   end Print_Node;

   ------------------------------
   -- Print_Short_Thread_Names --
   ------------------------------

   procedure Print_Short_Thread_Names is
      Next_Elem : Thread_Info_Simple_Names.Cursor;
   begin
      Info ("List of short threads names:");

      if Thread_Info_Simple_Names.Is_Empty (Thread_Simple_Names_Table) then
         Info ("   Empty");
      else
         Info_No_EOL ("  ");

         Next_Elem :=
           Thread_Info_Simple_Names.First (Thread_Simple_Names_Table);

         while Thread_Info_Simple_Names.Has_Element (Next_Elem) loop
            Info_No_EOL (" ");
            Info_No_EOL (Thread_Info_Simple_Names.Element (Next_Elem));

            Next_Elem := Thread_Info_Simple_Names.Next (Next_Elem);
         end loop;

         Info ("");
      end if;

   end Print_Short_Thread_Names;

   --------------------------------------
   -- Print_Short_Section_Border_Names --
   --------------------------------------

   procedure Print_Short_Section_Border_Names is
      Next_Elem : Thread_Info_Simple_Names.Cursor;
   begin
      Info ("List of short section borders names:");

      if Thread_Info_Simple_Names.Is_Empty
           (Section_Border_Simple_Names_Table)
      then
         Info ("   Empty");
      else
         Info_No_EOL ("  ");

         Next_Elem := Thread_Info_Simple_Names.First
                        (Section_Border_Simple_Names_Table);

         while Thread_Info_Simple_Names.Has_Element (Next_Elem) loop
            Info_No_EOL (" ");
            Info_No_EOL (Thread_Info_Simple_Names.Element (Next_Elem));

            Next_Elem := Thread_Info_Simple_Names.Next (Next_Elem);
         end loop;

         Info ("");
      end if;

   end Print_Short_Section_Border_Names;

   ------------------------------
   -- Print_Threads_Debug_Info --
   ------------------------------

   procedure Print_Threads_Debug_Info is
   begin
      Info ("*** FOREIGN THREADS INFORMATION ***");

      Print_Short_Thread_Names;
      Print_Short_Section_Border_Names;
      Print_Thread_Info_Table;
   end Print_Threads_Debug_Info;

   -----------------------------
   -- Print_Thread_Info_Table --
   -----------------------------

   procedure Print_Thread_Info_Table is
   begin
      Info ("=== Foreign info table ===");

      if Thread_Info_Container.Last_Index (Thread_Info_Table) <
         First_Thread_Info
      then
         Info ("   Empty");
      end if;

      for J in First_Thread_Info ..
               Thread_Info_Container.Last_Index (Thread_Info_Table)
      loop
         Print_Node (J);
      end loop;

   end Print_Thread_Info_Table;

   ----------------------------
   -- Store_Thread_Info_Item --
   ----------------------------

   procedure Store_Thread_Info_Item
     (Name             : Wide_String;
      Info_Kind        : Thread_Info_Kinds;
      Section_Start_Id : Thread_Info_Id)
   is
      Last_Idx       : constant Positive := Name'Last;
      Selector_Start :           Positive := Name'First;

      Success    : Boolean;
      Nul_Cursor : Thread_Info_Simple_Names.Cursor;
      pragma Unreferenced (Nul_Cursor);

      New_Info_Id   : Thread_Info_Id := No_Thread_Info;
      New_Info_Rec  : Thread_Info_Rec;
      Hash_Value    : Hash_Index_Type;
      Last_In_Chain : Thread_Info_Id;
   begin

      for J in reverse Name'Range loop

         if Name (J) = '.' then
            Selector_Start := J + 1;
            exit;
         end if;

      end loop;

      if Info_Kind = Thread then

         Thread_Info_Simple_Names.Insert
           (Container => Thread_Simple_Names_Table,
            New_Item  => To_Lower (To_String
              (Name (Selector_Start .. Last_Idx))),
            Position  => Nul_Cursor,
            Inserted  => Success);
      else
         Thread_Info_Simple_Names.Insert
           (Container => Section_Border_Simple_Names_Table,
            New_Item  => To_Lower (To_String
              (Name (Selector_Start .. Last_Idx))),
            Position  => Nul_Cursor,
            Inserted  => Success);
      end if;

      if not Success then
         --  If Success is False, there is a chance that we already have stoted
         --  the corresponding information item

         New_Info_Id := Find_Info (Name);
      end if;

      if Present (New_Info_Id)
        and then
         Thread_Info_Kind (New_Info_Id) /= Info_Kind
      then
         Error
           (To_String (Name) & " is defined as " &
            Thread_Info_Kind (New_Info_Id)'Img &
            " and as " & Info_Kind'Img);
         raise Parameter_Error;
      end if;

      if No (New_Info_Id) then
         New_Info_Rec.Name := Enter_Wide_String (To_Upper_Case (Name));
         New_Info_Rec.Thread_Info_Kind := Info_Kind;
         New_Info_Rec.Hash_Link        := No_Thread_Info;

         Thread_Info_Container.Append (Container => Thread_Info_Table,
                                       New_Item  => New_Info_Rec);

         New_Info_Id := Thread_Info_Container.Last_Index (Thread_Info_Table);

         Hash_Value    := Hash (Name);
         Last_In_Chain := Hash_Table (Hash_Value);

         if No (Last_In_Chain) then
            Hash_Table (Hash_Value) := New_Info_Id;
         else

            while Present (Get_Hash_Link (Last_In_Chain)) loop
               Last_In_Chain :=  Get_Hash_Link (Last_In_Chain);
            end loop;

            Set_Hash_Link (Id => Last_In_Chain, Val => New_Info_Id);
         end if;

      end if;

      case Info_Kind is
         when Not_A_Thread_Info =>
            pragma Assert (False);
            null;
         when Thread | Section_Start =>
            null;

         when Section_End =>
            Add_Section_Border (To => New_Info_Id, Border => Section_Start_Id);
            Add_Section_Border (To => Section_Start_Id, Border => New_Info_Id);
      end case;

   end Store_Thread_Info_Item;

   ------------------------
   -- Store_Threads_Info --
   ------------------------

   procedure Store_Threads_Info (Thread_File_Name : String) is
      Thread_File : File_Type;

      Line_Num : Natural := 0;
      --  The number of the currently processed line in Thread_File

      Line_Buffer         : Wide_String (1 .. 1024);
      Line_Len            : Natural;
      First_Idx, Last_Idx : Natural := 0;
      --  To be set to the beginning and to the end of the next word that is
      --  supposed to be an Ada name of a foreign thread

      Scan_State : Thread_Info_Kinds := Thread;
      --  Indicates the type of the thread info information item that is
      --  expected

      Last_Section_Start_Id : Thread_Info_Id := No_Thread_Info;
      --  If set not to No_Thread_Info, points to the Id of the latest stored
      --  procedure that starts a critical section

      procedure Set_Next_Word;
      --  Assuming that First_Idx points to the first character of non-scanned
      --  part of Line_Buffer, sets First_Idx and Last_Idx pointing to the next
      --  word (that is, a part of the Line_Buffer that is bounded by white
      --  spaces but does not contan a white space itself). Sets First_Idx to 0
      --  if there is no non-blank content in the Line_Buffer or of the rest
      --  of Line_Buffer is a comment (Set_Next_Word is scanned up to
      --  Line_Len).

      procedure Set_Next_Word is
         Found : Boolean := False;
      begin

         if First_Idx > Line_Len then
            First_Idx := 0;
            return;
         end if;

         for J in First_Idx .. Line_Len loop

            if not Is_White_Space (To_Character (Line_Buffer (J))) then
               First_Idx := J;
               Found     := True;
               exit;
            end if;

         end loop;

         if not Found then
            First_Idx := 0;
            return;
         elsif First_Idx < Line_Len
           and then
               Line_Buffer (First_Idx .. First_Idx + 1) = "--"
         then
            First_Idx := 0;
            return;
         end if;

         --  If we are here, we have to define the end of the word:
         Last_Idx := Line_Len;

         for J in First_Idx .. Line_Len - 1 loop

            if Is_White_Space (To_Character (Line_Buffer (J + 1))) then
               Last_Idx := J;
               exit;
            end if;

         end loop;

      end Set_Next_Word;

   begin

      begin
         Open (File => Thread_File,
               Mode => In_File,
               Name => Thread_File_Name);
      exception
         when Name_Error =>
            Error ("can not find foreign threads names file " &
                   Thread_File_Name);
            return;

         when Status_Error =>
            Error ("can not open foreign threads names file " &
                   Thread_File_Name & " file may be in use");
            return;
      end;

      while not End_Of_File (Thread_File) loop
         Line_Num := Line_Num + 1;

         Get_Line (Thread_File, Line_Buffer, Line_Len);

         if Line_Len > 0 then

            First_Idx := 1;

            Set_Next_Word;

            while First_Idx > 0 loop

               case Scan_State is
                  when Thread =>

                     if Line_Buffer (First_Idx) = '(' then
                        Scan_State := Section_Start;
                        First_Idx  := First_Idx + 1;
                     end if;

                  when Section_Start =>
                     null; --  ???
                  when Section_End =>

                     if Line_Buffer (Last_Idx) = ')' then
                        Last_Idx  := Last_Idx - 1;
                     else
                        Error
                          (Thread_File_Name & ":" & Image (Line_Num) &
                           " bad syntax of thread definition file, " &
                           "')' expected");

                        raise Parameter_Error;
                     end if;

                  when Not_A_Thread_Info =>
                     null;

               end case;

               if Is_Ada_Name (Line_Buffer (First_Idx .. Last_Idx)) then

                  Store_Thread_Info_Item
                    (Name             => Line_Buffer (First_Idx .. Last_Idx),
                     Info_Kind        => Scan_State,
                     Section_Start_Id => Last_Section_Start_Id);

                  case Scan_State is
                     when Thread =>
                        Last_Section_Start_Id := No_Thread_Info;
                     when Section_Start =>
                        Scan_State            := Section_End;
                        Last_Section_Start_Id :=
                          Thread_Info_Container.Last_Index (Thread_Info_Table);
                     when Section_End =>
                        Last_Section_Start_Id := No_Thread_Info;
                        Scan_State            := Thread;
                        Last_Idx              := Last_Idx + 1;
                     when Not_A_Thread_Info =>
                        pragma Assert (False);
                        null;
                  end case;

               else
                  Error (Thread_File_Name & ":" & Image (Line_Num) & ' ' &
                         To_String (Line_Buffer (First_Idx .. Last_Idx)) &
                         " is not an Ada name");

                  raise Parameter_Error;
               end if;

               First_Idx := Last_Idx + 1;
               Set_Next_Word;

            end loop;

         end if;

      end loop;

   end Store_Threads_Info;

   -----------
   -- Table --
   -----------

   function Table (Id : Thread_Info_Id) return Thread_Info_Rec_Access is
      Result : Thread_Info_Rec_Access;

      procedure Process (E : in out Thread_Info_Rec);

      procedure Process (E : in out Thread_Info_Rec) is
      begin
         Result := E'Unrestricted_Access;
      end Process;
   begin
      Thread_Info_Container.Update_Element
        (Container => Thread_Info_Table,
         Index     => Id,
         Process   => Process'Access);

      return Result;
   end Table;

   ---------------------
   -- Update routines --
   ---------------------

   Id_Tmp : Thread_Info_Id;

   procedure Add_Section_Border (For_Thread_Info_Rec : in out Thread_Info_Rec);
   procedure Set_Hash_Link      (For_Thread_Info_Rec : in out Thread_Info_Rec);

   procedure Add_Section_Border (For_Thread_Info_Rec : in out Thread_Info_Rec)
   is
      Tmp_Cursor  : Section_Border_Lists.Cursor;
      Tmp_Boolean : Boolean;
      pragma Warnings (Off, Tmp_Cursor);
      pragma Warnings (Off, Tmp_Boolean);
   begin
      Section_Border_Lists.Insert
       (Container => For_Thread_Info_Rec.Related_Section_Borders,
        New_Item  => Id_Tmp,
        Position  => Tmp_Cursor,
        Inserted  => Tmp_Boolean);
   end Add_Section_Border;

   procedure Set_Hash_Link (For_Thread_Info_Rec : in out Thread_Info_Rec) is
   begin
      For_Thread_Info_Rec.Hash_Link := Id_Tmp;
   end Set_Hash_Link;

   procedure Add_Section_Border (To : Thread_Info_Id; Border : Thread_Info_Id)
   is
   begin
      Id_Tmp := Border;

      Thread_Info_Container.Update_Element
        (Container => Thread_Info_Table,
         Index     => To,
         Process   => Add_Section_Border'Access);
   end Add_Section_Border;

   procedure Set_Hash_Link (Id : Thread_Info_Id; Val : Thread_Info_Id) is
   begin
      Id_Tmp := Val;

      Thread_Info_Container.Update_Element
        (Container => Thread_Info_Table,
         Index     => Id,
         Process   => Set_Hash_Link'Access);
   end Set_Hash_Link;

end Gnatsync.Threads;