------------------------------------------------------------------------------
--                                                                          --
--                 ASIS-for-GNAT IMPLEMENTATION COMPONENTS                  --
--                                                                          --
--                             A 4 G . C O N T T                            --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.28 $
--                                                                          --
--            Copyright (c) 1995-2002, Free Software Foundation, Inc.       --
--                                                                          --
-- ASIS-for-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 --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version. ASIS-for-GNAT is distributed  in the hope  that it will be use- --
-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of MER- --
-- CHANTABILITY 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 ASIS-for-GNAT; see file     --
-- COPYING. If not, write to the Free Software Foundation,  59 Temple Place --
-- - Suite 330,  Boston, MA 02111-1307, USA.                                --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- ASIS-for-GNAT was originally developed  by the ASIS-for-GNAT team at the --
-- Software  Engineering  Laboratory  of  the Swiss  Federal  Institute  of --
-- Technology (LGL-EPFL) in Lausanne,  Switzerland, in cooperation with the --
-- Scientific  Research  Computer  Center of  Moscow State University (SRCC --
-- MSU), Russia,  with funding partially provided  by grants from the Swiss --
-- National  Science  Foundation  and  the  Swiss  Academy  of  Engineering --
-- Sciences.  ASIS-for-GNAT is now maintained by  Ada Core Technologies Inc --
-- (http://www.gnat.com).                                                   --
--                                                                          --
------------------------------------------------------------------------------

with Asis;            use Asis;
with Asis.Extensions; use Asis.Extensions;
with Asis.Errors;     use Asis.Errors;
with Asis.Exceptions; use Asis.Exceptions;

with A4G.Contt.UT;    use A4G.Contt.UT;
with A4G.Contt.Dp;    use A4G.Contt.Dp;
with A4G.Contt.SD;    use A4G.Contt.SD;
with A4G.Contt.TT;    use A4G.Contt.TT;
with A4G.Defaults;    use A4G.Defaults;
with A4G.A_Debug;     use A4G.A_Debug;
with A4G.A_Output;    use A4G.A_Output;
with A4G.Vcheck;      use A4G.Vcheck;
with A4G.A_Osint;     use A4G.A_Osint;


with Namet;           use Namet;
with Output;          use Output;

package body A4G.Contt is

   -------------------------------------------
   -- Local Subprograms and Data Structures --
   -------------------------------------------

   procedure Set_Empty_Context (C : Context_Id);
   --  Set all the attribute of the Context indicated by C as for a
   --  Context having no associations (being empty)

   procedure Set_Predefined_Units;
   --  Sets in the Unit Table the unit entries corresponding to the predefined
   --  Ada environment. For now it sets the entry for the package Standard
   --  only.

--   procedure Free_String   is new Unchecked_Deallocation
--     (String, String_Access);

   procedure Print_Context_Search_Dirs
     (C : Context_Id;
      Dir_Kind : Search_Dir_Kinds);
   --  outputs the list of the directories making up the Dir_Kind search path
   --  for the context C; is intended to be used to produce a part of the
   --  Context debug output

   procedure Process_Dir (Dir_Name : String; Dir_Kind : Search_Dir_Kinds);
   --  verifies the part of the context association parameter following the
   --  two leading "-<option>" by checking if it is the name of the
   --  existing directory. If this check fails, this routine raises
   --  ASIS_Failed with Status setting as Parameter_Error (as required by
   --  Asis.Ada_Environmemts.Associate. Otherwise this value is stored in
   --  a normalized form in some temporary data structures as a part of the
   --  search path for the currrent Context.
   --
   --  For now, normalization consists on appending the directory separator
   --  for the stored name, if Dir_Name does not end with the separator.
   --
   --  To store the search paths for the given context, the Set_Search_Paths
   --  procedure should be called after processing all the actual for the
   --  Parameters parameter of Asis.Ada_Environment.Associate query

   -----------------------------------------------------------------
   -- Structures for temporary handling search directories names  --
   -- during processing the Parameters of the Context Association --
   -----------------------------------------------------------------

   type Dir_Rec;

   type Link is access Dir_Rec;

   type Dir_Rec is record
      Dir_Name : String_Access;
      Next     : Link;
   end record;

   type Dir_List is record
      First : Link;
      Last  : Link;
   end record;

   Source_Dirs : Dir_List;
   Object_Dirs : Dir_List;
   Tree_Dirs   : Dir_List;

   Source_Dirs_Count : Natural := 0;
   Object_Dirs_Count : Natural := 0;
   Tree_Dirs_Count   : Natural := 0;

   procedure Append_Dir (Dirs : in out Dir_List; Dir : Link);
   --  appends a new element with the directory name to a directory list

   --------------------------
   -- Allocate_New_Context --
   --------------------------

   function Allocate_New_Context return Context_Id is
      C : Context_Id;
   begin
      Contexts.Increment_Last;
      C := Contexts.Last;
      Set_Empty_Context (C);

      return Contexts.Last;
   end Allocate_New_Context;

   ----------------
   -- Append_Dir --
   ----------------

   procedure Append_Dir (Dirs : in out Dir_List; Dir : Link) is
   begin
      if Dirs.First = null then
         Dirs.First := Dir;
      else
         Dirs.Last.Next := Dir;
      end if;
      Dirs.Last := Dir;

   end Append_Dir;

   ------------------
   -- Context_Info --
   ------------------

   function Context_Info (C : Context_Id) return String is
      Cont_Id_Image : String := Context_Id'Image (C);
      First_Digit   : Natural;
   begin
      for I in Cont_Id_Image'Range loop
         if Cont_Id_Image (I) /= ' ' then
            First_Digit := I;
            exit;
         end if;
      end loop;

      return  "ASIS Context " &
               Cont_Id_Image (First_Digit .. Cont_Id_Image'Last);
   end Context_Info;

   ---------------
   -- Erase_Old --
   ---------------

   procedure Erase_Old (C : Context_Id) is
   begin
      --  Old (previously associated) Context Name and Parameter values
      Free (Contexts.Table (C).Name);
      Free (Contexts.Table (C).Parameters);

      --  Context search paths
      Free_Argument_List (Contexts.Table (C).Source_Path);
      Free_Argument_List (Contexts.Table (C).Object_Path);
      Free_Argument_List (Contexts.Table (C).Tree_Path);
      --  Context "-I" options for the compiler
      Free_Argument_List (Contexts.Table (C).Context_I_Options);
      --  a list of tree files for C1/CN modes (if any)
      Free_Argument_List (Contexts.Table (C).Context_Tree_Files);
   end Erase_Old;

   --------------
   -- Finalize --
   --------------

   procedure Finalize is
   begin
      for C in First_Context_Id .. Contexts.Last loop
         Finalize (C);
      end loop;
   end Finalize;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (C : Context_Id) is
   begin
      Reset_Context (C);
      if Debug_Lib_Model then
         Print_Context_Info (C);
      end if;

      if Is_Associated (C) then
         Erase_Old (C);
         --  probably, some more cleaning up is needed...
      end if;
      --  at least we have to put off these flags:
      Contexts.Table (C).Is_Associated := False;
      Contexts.Table (C).Is_Opened     := False;


   exception
      when others =>
         Raise_ASIS_Failed ("Failed to finalize " & Context_Info (C));
   end Finalize;

   ----------------------
   -- Get_Context_Name --
   ----------------------

   function Get_Context_Name (C : Context_Id) return String is
      S : String_Access := Contexts.Table (C).Name;
   begin
      if S = null then
         return "";
      else
         return S.all;
      end if;
   end Get_Context_Name;

   ----------------------------
   -- Get_Context_Parameters --
   ----------------------------

   function Get_Context_Parameters (C : Context_Id) return String is
      S : String_Access := Contexts.Table (C).Parameters;
   begin
      if S = null then
         return "";
      else
         return S.all;
      end if;
   end Get_Context_Parameters;

   ---------------------
   -- Get_Current_Cont --
   ---------------------

   function Get_Current_Cont return Context_Id is
   begin
      return Current_Context;
   end Get_Current_Cont;

   ----------------------
   -- Get_Current_Tree --
   ----------------------

   function Get_Current_Tree return Tree_Id is
   begin
      return Current_Tree;
   end Get_Current_Tree;

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

   function Hash return Hash_Index_Type is
      subtype Int_1_12 is Int range 1 .. 12;
      --  Used to avoid when others on case jump below

      Even_Name_Len : Integer;
      --  Last even numbered position (used for >12 case)

   begin

      --  Special test for 12 (rather than counting on a when others for the
      --  case statement below) avoids some Ada compilers converting the case
      --  statement into successive jumps.

      --  The case of a name longer than 12 characters is handled by taking
      --  the first 6 odd numbered characters and the last 6 even numbered
      --  characters

      if A_Name_Len > 12 then
         Even_Name_Len := (A_Name_Len) / 2 * 2;

         return ((((((((((((
           Character'Pos (A_Name_Buffer (01))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len - 10))) * 2 +
           Character'Pos (A_Name_Buffer (03))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len - 08))) * 2 +
           Character'Pos (A_Name_Buffer (05))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len - 06))) * 2 +
           Character'Pos (A_Name_Buffer (07))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len - 04))) * 2 +
           Character'Pos (A_Name_Buffer (09))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len - 02))) * 2 +
           Character'Pos (A_Name_Buffer (11))) * 2 +
           Character'Pos (A_Name_Buffer (Even_Name_Len))) mod Hash_Num;
      end if;

      --  For the cases of 1-12 characters, all characters participate in the
      --  hash. The positioning is randomized, with the bias that characters
      --  later on participate fully (i.e. are added towards the right side).

      case (Int_1_12 (A_Name_Len)) is

         when 1 =>
            return
               Character'Pos (A_Name_Buffer (1));

         when 2 =>
            return ((
              Character'Pos (A_Name_Buffer (1))) * 64 +
              Character'Pos (A_Name_Buffer (2))) mod Hash_Num;

         when 3 =>
            return (((
              Character'Pos (A_Name_Buffer (1))) * 16 +
              Character'Pos (A_Name_Buffer (3))) * 16 +
              Character'Pos (A_Name_Buffer (2))) mod Hash_Num;

         when 4 =>
            return ((((
              Character'Pos (A_Name_Buffer (1))) * 8 +
              Character'Pos (A_Name_Buffer (2))) * 8 +
              Character'Pos (A_Name_Buffer (3))) * 8 +
              Character'Pos (A_Name_Buffer (4))) mod Hash_Num;

         when 5 =>
            return (((((
              Character'Pos (A_Name_Buffer (4))) * 8 +
              Character'Pos (A_Name_Buffer (1))) * 4 +
              Character'Pos (A_Name_Buffer (3))) * 4 +
              Character'Pos (A_Name_Buffer (5))) * 8 +
              Character'Pos (A_Name_Buffer (2))) mod Hash_Num;

         when 6 =>
            return ((((((
              Character'Pos (A_Name_Buffer (5))) * 4 +
              Character'Pos (A_Name_Buffer (1))) * 4 +
              Character'Pos (A_Name_Buffer (4))) * 4 +
              Character'Pos (A_Name_Buffer (2))) * 4 +
              Character'Pos (A_Name_Buffer (6))) * 4 +
              Character'Pos (A_Name_Buffer (3))) mod Hash_Num;

         when 7 =>
            return (((((((
              Character'Pos (A_Name_Buffer (4))) * 4 +
              Character'Pos (A_Name_Buffer (3))) * 4 +
              Character'Pos (A_Name_Buffer (1))) * 4 +
              Character'Pos (A_Name_Buffer (2))) * 2 +
              Character'Pos (A_Name_Buffer (5))) * 2 +
              Character'Pos (A_Name_Buffer (7))) * 2 +
              Character'Pos (A_Name_Buffer (6))) mod Hash_Num;

         when 8 =>
            return ((((((((
              Character'Pos (A_Name_Buffer (2))) * 4 +
              Character'Pos (A_Name_Buffer (1))) * 4 +
              Character'Pos (A_Name_Buffer (3))) * 2 +
              Character'Pos (A_Name_Buffer (5))) * 2 +
              Character'Pos (A_Name_Buffer (7))) * 2 +
              Character'Pos (A_Name_Buffer (6))) * 2 +
              Character'Pos (A_Name_Buffer (4))) * 2 +
              Character'Pos (A_Name_Buffer (8))) mod Hash_Num;

         when 9 =>
            return (((((((((
              Character'Pos (A_Name_Buffer (2))) * 4 +
              Character'Pos (A_Name_Buffer (1))) * 4 +
              Character'Pos (A_Name_Buffer (3))) * 4 +
              Character'Pos (A_Name_Buffer (4))) * 2 +
              Character'Pos (A_Name_Buffer (8))) * 2 +
              Character'Pos (A_Name_Buffer (7))) * 2 +
              Character'Pos (A_Name_Buffer (5))) * 2 +
              Character'Pos (A_Name_Buffer (6))) * 2 +
              Character'Pos (A_Name_Buffer (9))) mod Hash_Num;

         when 10 =>
            return ((((((((((
              Character'Pos (A_Name_Buffer (01))) * 2 +
              Character'Pos (A_Name_Buffer (02))) * 2 +
              Character'Pos (A_Name_Buffer (08))) * 2 +
              Character'Pos (A_Name_Buffer (03))) * 2 +
              Character'Pos (A_Name_Buffer (04))) * 2 +
              Character'Pos (A_Name_Buffer (09))) * 2 +
              Character'Pos (A_Name_Buffer (06))) * 2 +
              Character'Pos (A_Name_Buffer (05))) * 2 +
              Character'Pos (A_Name_Buffer (07))) * 2 +
              Character'Pos (A_Name_Buffer (10))) mod Hash_Num;

         when 11 =>
            return (((((((((((
              Character'Pos (A_Name_Buffer (05))) * 2 +
              Character'Pos (A_Name_Buffer (01))) * 2 +
              Character'Pos (A_Name_Buffer (06))) * 2 +
              Character'Pos (A_Name_Buffer (09))) * 2 +
              Character'Pos (A_Name_Buffer (07))) * 2 +
              Character'Pos (A_Name_Buffer (03))) * 2 +
              Character'Pos (A_Name_Buffer (08))) * 2 +
              Character'Pos (A_Name_Buffer (02))) * 2 +
              Character'Pos (A_Name_Buffer (10))) * 2 +
              Character'Pos (A_Name_Buffer (04))) * 2 +
              Character'Pos (A_Name_Buffer (11))) mod Hash_Num;

         when 12 =>
            return ((((((((((((
              Character'Pos (A_Name_Buffer (03))) * 2 +
              Character'Pos (A_Name_Buffer (02))) * 2 +
              Character'Pos (A_Name_Buffer (05))) * 2 +
              Character'Pos (A_Name_Buffer (01))) * 2 +
              Character'Pos (A_Name_Buffer (06))) * 2 +
              Character'Pos (A_Name_Buffer (04))) * 2 +
              Character'Pos (A_Name_Buffer (08))) * 2 +
              Character'Pos (A_Name_Buffer (11))) * 2 +
              Character'Pos (A_Name_Buffer (07))) * 2 +
              Character'Pos (A_Name_Buffer (09))) * 2 +
              Character'Pos (A_Name_Buffer (10))) * 2 +
              Character'Pos (A_Name_Buffer (12))) mod Hash_Num;

         when others =>
            --  ??? !!! ???
            --  this alternative can never been reached, but it looks like
            --  there is something wrong here with the compiler, it does not
            --  want to compile the code without this line (up to 3.10b)
            return 0;

      end case;
   end Hash;

   ---------------
   -- I_Options --
   ---------------

   function I_Options (C : Context_Id) return Argument_List is
      Nul_Argument_List : constant Argument_List (1 .. 0) := (others => null);
   begin
      if Contexts.Table (C).Context_I_Options = null then
         return Nul_Argument_List;
      else
         return Contexts.Table (C).Context_I_Options.all;
      end if;
   end I_Options;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize is
   begin
      Contexts.Init;
      Current_Context := Non_Associated;
      Current_Tree    := Nil_Tree;
   end Initialize;

   --------------------
   -- Pre_Initialize --
   --------------------

   procedure Pre_Initialize (C : Context_Id) is
   begin

      Backup_Current_Context;

      --  Clearing the Context Hash Table:
      for J in Hash_Index_Type loop
         Contexts.Table (C).Hash_Table (J) := No_Unit_Name;
      end loop;

      --  Initializing Context's internal tables:
      A_Name_Chars.Init;
      Unit_Table.Init;
      Tree_Table.Init;
      A4G.A_Elists.Initialize;

      Current_Context := C;
      Current_Tree    := Nil_Tree;
   end Pre_Initialize;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (C : Context_Id) is
   begin

      Contexts.Table (C).Opened_At := A_OS_Time;
      Contexts.Table (C).Specs     := 0;
      Contexts.Table (C).Bodies    := 0;

      --  Clearing the Context Hash Table:
      for J in Hash_Index_Type loop
         Contexts.Table (C).Hash_Table (J) := No_Unit_Name;
      end loop;

      Set_Predefined_Units;
   end Initialize;

   ---------------------------
   -- Locate_In_Search_Path --
   ---------------------------

   function Locate_In_Search_Path
     (C         : Context_Id;
      File_Name : String;
      Dir_Kind : Search_Dir_Kinds)
      return String_Access
   is
      Curr_Dir    : String_Access;
      Search_Path : Directory_List_Ptr;
   begin

      case Dir_Kind is
         when Source =>
            Search_Path := Contexts.Table (C).Source_Path;
         when Object =>
            Search_Path := Contexts.Table (C).Object_Path;
         when Tree   =>
            Search_Path := Contexts.Table (C).Tree_Path;
      end case;

      if Search_Path = null then
         --  this means that the current directory only should be used
         --  for locating the file
         if Is_Regular_File (File_Name) then
            return new String'(File_Name & ASCII.NUL);
         else
            return null;
         end if;
      end if;

      --  and here we have to look through the directory search path

      for I in 1 .. Search_Path'Last loop

         Curr_Dir := Search_Path (I);

         if Is_Regular_File (Curr_Dir.all & File_Name) then
            return new String'(Curr_Dir.all & File_Name & ASCII.NUL);
         end if;

      end loop;

      return null;
   end Locate_In_Search_Path;

   -------------
   -- NB_Save --
   -------------

   procedure NB_Save is
   begin
      Backup_Name_Len := A_Name_Len;
      Backup_Name_Buffer (1 .. Backup_Name_Len) :=
         A_Name_Buffer (1 .. A_Name_Len);
   end NB_Save;

   ----------------
   -- NB_Restore --
   ----------------

   procedure NB_Restore is
   begin
      A_Name_Len := Backup_Name_Len;
      A_Name_Buffer (1 .. A_Name_Len) :=
         Backup_Name_Buffer (1 .. Backup_Name_Len);
   end NB_Restore;

   ------------------------
   -- Print_Context_Info --
   ------------------------

   procedure Print_Context_Info is
   begin
      Write_Str ("ASIS Context Table - general information:");
      Write_Eol;
      Write_Eol;
      Write_Str ("The number of contexts which have been allocated: ");
      Write_Int (Int (Contexts.Last - First_Context_Id + 1));
      Write_Eol;
      Write_Eol;
      Write_Str ("Default search paths:");
      Write_Eol;
      Write_Eol;
      Write_Str ("Source search path:");
      Write_Eol;
      Print_Source_Defaults;
      Write_Eol;
      Write_Str ("Object/ALI search path:");
      Write_Eol;
      Print_Lib_Defaults;
      Write_Eol;
      Write_Str ("Tree search path:");
      Write_Eol;
      Print_Tree_Defaults;
      Write_Eol;
      Write_Str ("=====================================================");
      Write_Eol;

      for C in First_Context_Id .. Contexts.Last loop
         Print_Context_Info (C);
         Write_Eol;
      end loop;


   end Print_Context_Info;

   ------------------------
   -- Print_Context_Info --
   ------------------------

   procedure Print_Context_Info (C : Context_Id) is
   begin
      Reset_Context (C);
      Write_Str ("Debug output for context number: ");
      Write_Int (Int (C));
      Write_Eol;

      if C = Non_Associated then
         Write_Str ("   Nil Context, it can never be associated");
         Write_Eol;
         return;
      end if;

      if Is_Associated (C) then
         Print_Context_Parameters (C);

         if Is_Opened (C) then
            Print_Units (C);
            Print_Trees (C);
         else
            Write_Str ("This Context is closed");
            Write_Eol;
         end if;

      else
         Write_Str ("This Context is dissociated");
         Write_Eol;
      end if;

   end Print_Context_Info;

   ------------------------------
   -- Print_Context_Parameters --
   ------------------------------

   procedure Print_Context_Parameters (C : Context_Id) is
   begin

      Write_Str ("Association parameters for Context number: ");
      Write_Int (Int (C));
      Write_Eol;

      if C = Non_Associated then
         Write_Str ("   Nil Context, it can never be associated");
         Write_Eol;
         return;
      end if;

      if Is_Associated (C) then
         Write_Str ("Context name: ");

         if Contexts.Table (C).Name = null or else
            Contexts.Table (C).Name.all = ""
         then
            Write_Str ("no name has been associated");
         else
            Write_Str (Contexts.Table (C).Name.all);
         end if;

         Write_Eol;

         Write_Str ("Context parameters:");
         Write_Eol;

         if Contexts.Table (C).Parameters = null then
            Write_Str ("   no parameter has been associated");
         else
            Write_Str ("   " & Contexts.Table (C).Parameters.all);
         end if;

         Write_Eol;

         Write_Str ("Context Search Dirs:");
         Write_Eol;
         Write_Str ("--------------------");
         Write_Eol;
         Write_Str ("Source Dirs");
         Write_Eol;
         Print_Context_Search_Dirs (C, Source);
         Write_Eol;

         Write_Str ("The source search path for calling GNAT is ");
         Write_Eol;

         if Contexts.Table (C).Context_I_Options = null then
            Write_Str (" no ""-I"" option has been associated");
            Write_Eol;
         else

            for I in 1 .. Contexts.Table (C).Context_I_Options'Last loop
               Write_Str ("   " &
                          Contexts.Table (C).Context_I_Options (I).all);
               Write_Eol;
            end loop;

         end if;

         Write_Eol;

         Write_Str ("Object/ALI Dirs");
         Write_Eol;
         Print_Context_Search_Dirs (C, Object);
         Write_Eol;
         Write_Eol;
         Write_Str ("Tree Dirs");
         Write_Eol;
         Print_Context_Search_Dirs (C, Tree);
         Write_Eol;
         Write_Eol;
      else
         Write_Str ("The Context is dissociated");
         Write_Eol;
      end if;

   end Print_Context_Parameters;


   -------------------------------
   -- Print_Context_Search_Dirs --
   -------------------------------

   procedure Print_Context_Search_Dirs
     (C : Context_Id;
      Dir_Kind : Search_Dir_Kinds)
   is
      Path : Directory_List_Ptr;
      --  search path to print
   begin
      case Dir_Kind is
         when Source =>
            Path := Contexts.Table (C).Source_Path;
         when Object =>
            Path := Contexts.Table (C).Object_Path;
         when Tree   =>
            Path := Contexts.Table (C).Tree_Path;
      end case;

      if Path = null then
         Write_Str ("   No directory has been associated");
         return;
      end if;

      for I in Path'Range loop
         Write_Str ("   " & Path (I).all);
         Write_Eol;
      end loop;

      Write_Eol;
   end Print_Context_Search_Dirs;

   --------------------------------
   -- Process_Context_Parameters --
   --------------------------------

   procedure Process_Context_Parameters
     (Parameters : String;
      Cont       : Context_Id := Non_Associated)
   is
      Cont_Parameters : Argument_List_Access;

      C_Set           : Boolean := False;
      F_Set           : Boolean := False;
      S_Set           : Boolean := False;

      Next_TF_Name    : Natural := 0;

      procedure Process_One_Parameter (Param : String);
      --  incapsulates processing of a separate parameter

      procedure Check_Parameters;
      --  Checks, that context options are compatible with each other and with
      --  the presence of tree files (if any). The check made by this procedure
      --  is not very smart - it detects only one error, and it does not try to
      --  provide a very detailed diagnostic

      procedure Process_Tree_File_Name (TF_Name : String);
      --  Checks, that TF_Name has tree file name suffix (.ats or .atb), and
      --  generates an ASIS warning if this check fails. Stores TF_Name in
      --  Context_Tree_Files list for the Context Cont.

      ----------------------
      -- Check_Parameters --
      ----------------------

      procedure Check_Parameters is
         Mode_Str : String := "-C?";
      begin
         --  first, set defaults if needed:
         if not C_Set then
            Set_Default_Context_Processing_Mode (Cont);
            C_Set := True;
         end if;

         if not F_Set then
            Set_Default_Tree_Processing_Mode (Cont);
            F_Set := True;
         end if;

         if not S_Set then
            Set_Default_Source_Processing_Mode (Cont);
            S_Set := True;
         end if;

         case Context_Processing_Mode (Cont) is

            when One_Tree | N_Trees =>
               if Context_Processing_Mode (Cont) = One_Tree then
                  Mode_Str (3) := '1';
               else
                  Mode_Str (3) := 'N';
               end if;

               if not (Tree_Processing_Mode (Cont) = Pre_Created) then
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                &  "only -FT mode can be set for "
                                &  Mode_Str & " mode");
                  raise ASIS_Failed;
               end if;

               --  Process_Association_Option already checks, that at most one
               --  tree file can be set for this mode, and here we have to
               --  check, that at least one tree file is set:
               if Last_Tree_File < First_Tree_File then
                  --  this means, that first tree file just has not been
                  --  processed
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                &  "no tree file is set for "
                                &  Mode_Str & " mode");
                  raise ASIS_Failed;
               end if;
            when Partition =>
               --  for now, this is not implemented :-(
               Not_Implemented_Yet (Diagnosis =>
                          "Asis.Ada_Environments.Associate (-CP option)");
            when All_Trees =>

               --  all tree processing modes are allowed for All_Trees
               --  contexts, but no tree files should be explicitly set:

               if  Last_Tree_File >= First_Tree_File then
                  --  this means, that at least one tree file has been
                  --  processed
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                &  "no tree file must be set for -CA mode");
                  raise ASIS_Failed;
               end if;
         end case;

         if (Tree_Processing_Mode (Cont) = Mixed or else
             Tree_Processing_Mode (Cont) = On_The_Fly or else
             Tree_Processing_Mode (Cont) = Incremental)
           and then
            Source_Processing_Mode (Cont) /= All_Sources
         then
            Set_Error_Status
              (Status    => Asis.Errors.Parameter_Error,
               Diagnosis => "Asis.Ada_Environments.Associate:"
                          &  ASIS_Line_Terminator
                          &  "only -SA option is allowed if trees can be "
                          &  "created on the fly");
            raise ASIS_Failed;
         end if;
      end Check_Parameters;

      ---------------------------
      -- Process_One_Parameter --
      ---------------------------

      procedure Process_One_Parameter (Param : String) is
         Parameter : String (1 .. Param'Length) := Param;
         Par_Len   : Positive := Parameter'Length;

         procedure Process_Parameter;
         procedure Process_Option;
         --  Process_Option works if Param starts from '-', and
         --  Process_Parameter works otherwise

         procedure Process_Parameter is
         begin
            --  the only parameter currently available for Context association
            --  is a tree file name

            if Last_Tree_File < First_Tree_File then
               --  This means, that we've just encountered the first candidate
               --  for a tree file name as a part of the Parameters string.
               --  Therefore, we should set the default Context, tree and
               --  source processing options (if needed) and the corresponding
               --  flags:

               if not C_Set then
                  Set_Default_Context_Processing_Mode (Cont);
                  C_Set := True;
               end if;

               if not F_Set then
                  Set_Default_Tree_Processing_Mode (Cont);
                  F_Set := True;
               end if;

               if not S_Set then
                  Set_Default_Source_Processing_Mode (Cont);
                  S_Set := True;
               end if;
            else
               --  more then one tree file is illegal in -C1 mode
               if Context_Processing_Mode (Cont) = One_Tree then
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                &  "only one tree file is allowed in "
                                &  "-C1 mode");
                  raise ASIS_Failed;
               end if;
            end if;

            Process_Tree_File_Name (Parameter);

         end Process_Parameter;

         procedure Process_Option is
            Switch_Char : Character;
         begin

            if Par_Len < 3 then
               goto Wrong_Par;
            else
               Switch_Char := Parameter (2);
            end if;

            if Switch_Char = 'C' and then Par_Len = 3 then

               if C_Set then
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                & "-C option is either misplaced "
                                & "or duplicated");
                  raise ASIS_Failed;

               else
                  Switch_Char := Parameter (3);

                  case Switch_Char is
                     when '1' =>
                        Set_Context_Processing_Mode (Cont, One_Tree);
                     when 'N' =>
                        Set_Context_Processing_Mode (Cont, N_Trees);
                     when 'P' =>
                        Set_Context_Processing_Mode (Cont, Partition);
                     when 'A' =>
                        Set_Context_Processing_Mode (Cont, All_Trees);
                     when others =>
                        goto Wrong_Par;
                  end case;

                  C_Set := True;
               end if;

            elsif Switch_Char = 'F' and then Par_Len = 3 then

               if F_Set then
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                & "-F option is either misplaced "
                                & "or duplicated");
                  raise ASIS_Failed;

               else
                  Switch_Char := Parameter (3);

                  case Switch_Char is
                     when 'S' =>
                        Set_Tree_Processing_Mode (Cont, On_The_Fly);
                     when 'T' =>
                        Set_Tree_Processing_Mode (Cont, Pre_Created);
                     when 'M' =>
                        Set_Tree_Processing_Mode (Cont, Mixed);
                     when 'I' =>
                        Set_Tree_Processing_Mode (Cont, Incremental);
                     when others =>
                        goto Wrong_Par;
                  end case;

                  F_Set := True;
               end if;

            elsif Switch_Char = 'S' and then Par_Len = 3 then

               if S_Set then
                  Set_Error_Status
                    (Status    => Asis.Errors.Parameter_Error,
                     Diagnosis => "Asis.Ada_Environments.Associate:"
                                &  ASIS_Line_Terminator
                                & "-S option is either misplaced"
                                & " or duplicated");
                  raise ASIS_Failed;
               else
                  Switch_Char := Parameter (3);

                  case Switch_Char is
                     when 'A' =>
                        Set_Source_Processing_Mode (Cont, All_Sources);
                     when 'E' =>
                        Set_Source_Processing_Mode (Cont, Existing_Sources);
                     when 'N' =>
                        Set_Source_Processing_Mode (Cont, No_Sources);
                     when others =>
                        goto Wrong_Par;
                  end case;

                  S_Set := True;
               end if;

            elsif Switch_Char = 'I' then
               Process_Dir (Parameter (3 .. Par_Len), Source);

            elsif Switch_Char = 'O' then
               Process_Dir (Parameter (3 .. Par_Len), Object);

            elsif Switch_Char = 'T' then
               Process_Dir (Parameter (3 .. Par_Len), Tree);

            elsif Parameter = "-AOP" then
               Set_Use_Default_Trees (Cont, True);

            else
               goto Wrong_Par;
            end if;

            return;

            <<Wrong_Par>>
               ASIS_Warning
                  (Message => "Asis.Ada_Environments.Associate: "
                             & "unknown option "
                             &  Parameter,
                   Error   => Parameter_Error);

         end Process_Option;

      begin --  Process_One_Parameter
         if Parameter (1) = '-' then
            Process_Option;
         else
            Process_Parameter;
         end if;
      end Process_One_Parameter;

      ----------------------------
      -- Process_Tree_File_Name --
      ----------------------------

      procedure Process_Tree_File_Name (TF_Name : String) is
         TF_Len      : Natural := TF_Name'Length;
         Wrong_Name  : Boolean;
         T_File_Name : Name_Id;

      begin
         Wrong_Name := not (
               TF_Len >= 5
            and then
               (TF_Name (TF_Len) = 't' or else TF_Name (TF_Len) = 'T')
            and then
               (TF_Name (TF_Len - 1) = 'd' or else TF_Name (TF_Len - 1) = 'D')
            and then
               (TF_Name (TF_Len - 2) = 'a' or else TF_Name (TF_Len - 2) = 'A')
            and then
               TF_Name (TF_Len - 3) = '.');

         if Wrong_Name then
            ASIS_Warning
               (Message => "Asis.Ada_Environments.Associate: "
                         & TF_Name
                         & " does not have a form of a tree file name",
                Error   => Parameter_Error);
         end if;

         for I in 1 .. TF_Len loop
            Name_Buffer (I) := TF_Name (I);
         end loop;

         Name_Len := TF_Len;

         T_File_Name := Name_Find;

         if T_File_Name > Last_Tree_File then
            Last_Tree_File := T_File_Name;
            Next_TF_Name := Next_TF_Name + 1;
            Contexts.Table (Cont).Context_Tree_Files (Next_TF_Name) :=
               new String'(TF_Name);
         end if;

      end Process_Tree_File_Name;

   begin  -- Process_Context_Parameters

      Namet.Initialize; --  ???
      First_Tree_File := First_Name_Id;
      Last_Tree_File  := First_Name_Id - 1;

      Set_Use_Default_Trees (Cont, False);

      if Parameters /= "" then

         Cont_Parameters := Parameter_String_To_List (Parameters);

         Contexts.Table (Cont).Context_Tree_Files :=
            new Argument_List (1 .. Cont_Parameters'Length);

         for I in Cont_Parameters'Range loop
            Process_One_Parameter (Cont_Parameters (I).all);
         end loop;

         Free_Argument_List (Cont_Parameters);
      end if;

      Check_Parameters;
      Set_Context_Parameters (Cont, Parameters);
      Set_Search_Paths (Cont);

   exception
      when ASIS_Failed =>
         raise;
      when others =>
         Raise_ASIS_Failed ("A4G.Contt.Process_Context_Parameters");
   end Process_Context_Parameters;

   -----------------
   -- Process_Dir --
   -----------------

   procedure Process_Dir (Dir_Name : String; Dir_Kind : Search_Dir_Kinds) is
      First   : Positive := Dir_Name'First;
      Last    : Natural  := Dir_Name'Last;
      New_Dir : Link;
   begin

      for I in reverse Dir_Name'Range loop

         if Dir_Name (I) = Directory_Separator and then
            I > First                          and then
            Dir_Name (I - 1) /= Directory_Separator
         then
            Last := I - 1;
            exit;
         end if;

      end loop;

      if not Is_Directory (Dir_Name (First .. Last)) then
         Set_Error_Status (Status    => Asis.Errors.Parameter_Error,
                           Diagnosis => "Asis.Ada_Environments.Associate:"
                                      &  ASIS_Line_Terminator
                                      &  "Wrong parameter for Context "
                                      &  "Association: "
                                      &  Dir_Name
                                      &  " is not a directory name");
         raise ASIS_Failed;
      end if;

      New_Dir          := new Dir_Rec;
      New_Dir.Dir_Name := new String'(Normalize_Directory_Name (Dir_Name));

      case Dir_Kind is
         when Source =>
            Source_Dirs_Count := Source_Dirs_Count + 1;
            Append_Dir (Source_Dirs, New_Dir);
         when Object =>
            Object_Dirs_Count := Object_Dirs_Count + 1;
            Append_Dir (Object_Dirs, New_Dir);
         when Tree   =>
            Tree_Dirs_Count   := Tree_Dirs_Count   + 1;
            Append_Dir (Tree_Dirs, New_Dir);
      end case;

   exception
      when ASIS_Failed =>
         raise;
      when others =>
         Raise_ASIS_Failed ("Contt.Process_Dir");
   end Process_Dir;

   --------------------
   -- Scan_Trees_New --
   --------------------

   procedure Scan_Trees_New (C : Context_Id) is
   begin
      Scan_Tree_Files_New (C);
      Investigate_Trees_New (C);

      --  And now, when all the unit attributes are set, we compute integrated
      --  dependencies
      Set_All_Dependencies;

      Reorder_Trees (C);
   end Scan_Trees_New;

   ----------------------
   -- Set_Context_Name --
   ----------------------

   procedure Set_Context_Name (C : Context_Id; Name : String) is
   begin
      Contexts.Table (C).Name := new String'(Name);
   end Set_Context_Name;

   ----------------------------
   -- Set_Context_Parameters --
   ----------------------------

   procedure Set_Context_Parameters (C : Context_Id; Parameters : String)
   is
   begin
      Contexts.Table (C).Parameters := new String'(Parameters);
   end Set_Context_Parameters;

   -----------------------
   -- Set_Empty_Context --
   -----------------------

   procedure Set_Empty_Context (C : Context_Id) is
      Cont : constant Context_Id := C;
   begin
      --  We explicitly set all the fields of the context record

      Contexts.Table (C).Name       := null;
      Contexts.Table (C).Parameters := null;

      Set_Is_Associated     (Cont, False);
      Set_Is_Opened         (Cont, False);
      Set_Use_Default_Trees (Cont, False);

      Contexts.Table (C).Opened_At := Last_ASIS_OS_Time;
      Contexts.Table (C).Specs     := 0;
      Contexts.Table (C).Bodies    := 0;

      for J in Hash_Index_Type loop
         Contexts.Table (C).Hash_Table (J) := Nil_Unit;
      end loop;

      Contexts.Table (C).Current_Main_Unit  := Nil_Unit;

      Contexts.Table (C).Source_Path        := null;
      Contexts.Table (C).Object_Path        := null;
      Contexts.Table (C).Tree_Path          := null;
      Contexts.Table (C).Context_I_Options  := null;
      Contexts.Table (C).Context_Tree_Files := null;

      Contexts.Table (C).Mode               := All_Trees;
      Contexts.Table (C).Tree_Processing    := Pre_Created;
      Contexts.Table (C).Source_Processing  := All_Sources;

   end Set_Empty_Context;

   ---------------------
   -- Set_Current_Cont --
   ---------------------

   procedure Set_Current_Cont (L : Context_Id) is
   begin
      Current_Context := L;
   end Set_Current_Cont;

   ----------------------
   -- Set_Current_Tree --
   ----------------------

   procedure Set_Current_Tree (Tree : Tree_Id) is
   begin
      Current_Tree := Tree;
   end Set_Current_Tree;

   ----------------------
   -- Set_Name_String --
   ----------------------

   procedure Set_Name_String (S : String) is
   begin
      A_Name_Len                      := S'Length;
      A_Name_Buffer (1 .. A_Name_Len) := S;
   end Set_Name_String;

   --------------------------
   -- Set_Predefined_Units --
   --------------------------

   procedure Set_Predefined_Units is
      Cont : Context_Id := Get_Current_Cont;
      C_U  : Unit_Id;
   begin

      --  set the entry for the package Standard:

      Set_Name_String ("standard%s");
      C_U := Allocate_Unit_Entry (Cont);
      --  C_U should be equial to Standard_Id. Should we check this here?

      Set_Name_String ("Standard");
      Set_Ada_Name (C_U);
      Set_Kind     (Cont, C_U, A_Package);
      Set_Class    (Cont, C_U, A_Public_Declaration);
      Set_Top      (Cont, C_U, Empty);
      --  What is the best solution for computing the top node of the
      --  subtree for the package Standard? Now we compute it in
      --  Asis.Set_Get.Top...


      Set_Time_Stamp  (Cont, C_U, Empty_Time_Stamp);
      Set_Origin      (Cont, C_U, A_Predefined_Unit);

      Set_Is_Main_Unit (Cont, C_U, False);
      Set_Is_Body_Required (Cont, C_U, False);

      Set_Source_Status    (Cont, C_U, Absent);

      --  as for the source file, it was set to Nil when allocating the
      --  unit entry

   end Set_Predefined_Units;

   ----------------------
   -- Set_Search_Paths --
   ----------------------

   procedure Set_Search_Paths (C : Context_Id) is

      I_Opt_Len : Natural := Source_Dirs_Count;

      procedure Set_Path
        (Path : in out Directory_List_Ptr;
         From : in out Dir_List;
         N    : in out Natural);
      --  Sets the given search path, N is the count of the directories.
      --  resets the temporary data structures used to keep and to count
      --  directory names

      procedure Set_Path
        (Path : in out Directory_List_Ptr;
         From : in out Dir_List;
         N    : in out Natural)
      is
         Next_Dir : Link := From.First;
      begin
         if N = 0 then
            From.First := null;  -- just in case
            From.Last  := null;  -- just in case
            return;
            --  we have nothing to do, and the corresponding search path
            --  will remain null, as it should have been before the call
         end if;

         Path := new Argument_List (1 .. N);

         for I in 1 .. N loop
            Path (I) := new String'(Next_Dir.Dir_Name.all);
            Free (Next_Dir.Dir_Name);
            Next_Dir := Next_Dir.Next;
         end loop;

         From.First := null;
         From.Last  := null;
         N          := 0;

         --  we free the memory occupied by strings stored in this temporary
         --  list of directories, but we do not free the memory used by the
         --  links. We hope we can skip this optimization

      end Set_Path;

   begin --  Set_Search_Paths

      Set_Path
        (Contexts.Table (C).Source_Path, Source_Dirs, Source_Dirs_Count);
      Set_Path
        (Contexts.Table (C).Object_Path, Object_Dirs, Object_Dirs_Count);
      Set_Path
        (Contexts.Table (C).Tree_Path,   Tree_Dirs,   Tree_Dirs_Count);

      --  And the last thing to do is to set for a given Context its
      --  Context_I_Options field:

      if I_Opt_Len = 0 then
         Contexts.Table (C).Context_I_Options := null; -- just in case
         return;
      end if;

      Contexts.Table (C).Context_I_Options :=
         new Argument_List (1 .. I_Opt_Len  + 1);

      for I in 1 .. I_Opt_Len loop
         Contexts.Table (C).Context_I_Options (I) :=
            new String'("-I" & Contexts.Table (C).Source_Path (I).all);
      end loop;

      Contexts.Table (C).Context_I_Options (I_Opt_Len + 1) :=
         new String'("-I-");

   end Set_Search_Paths;

   ---------------------------------------------------
   -- Context Attributes Access and Update Routines --
   ---------------------------------------------------

   function Is_Associated (C : Context_Id) return Boolean is
   begin
      return C /= Non_Associated and then
             Contexts.Table (C).Is_Associated;
   end Is_Associated;

   function Is_Opened (C : Context_Id) return Boolean is
   begin
      return C /= Non_Associated and then
             Contexts.Table (C).Is_Opened;
   end Is_Opened;

   function Opened_At (C : Context_Id) return ASIS_OS_Time is
   begin
      return Contexts.Table (C).Opened_At;
   end Opened_At;

   function Context_Processing_Mode (C : Context_Id) return Context_Mode is
   begin
      return Contexts.Table (C).Mode;
   end Context_Processing_Mode;

   function Tree_Processing_Mode   (C : Context_Id) return Tree_Mode is
   begin
      return Contexts.Table (C).Tree_Processing;
   end Tree_Processing_Mode;

   function Source_Processing_Mode (C : Context_Id) return  Source_Mode is
   begin
      return Contexts.Table (C).Source_Processing;
   end Source_Processing_Mode;

   function Use_Default_Trees       (C : Context_Id) return Boolean is
   begin
      return Contexts.Table (C).Use_Default_Trees;
   end Use_Default_Trees;

   --------

   procedure Set_Is_Associated (C : Context_Id; Ass : Boolean) is
   begin
      Contexts.Table (C).Is_Associated := Ass;
   end Set_Is_Associated;

   procedure Set_Is_Opened     (C : Context_Id; Op  : Boolean) is
   begin
      Contexts.Table (C).Is_Opened := Op;
   end Set_Is_Opened;


   procedure Set_Context_Processing_Mode (C : Context_Id; M : Context_Mode) is
   begin
      Contexts.Table (C).Mode := M;
   end Set_Context_Processing_Mode;

   procedure Set_Tree_Processing_Mode   (C : Context_Id; M : Tree_Mode) is
   begin
      Contexts.Table (C).Tree_Processing := M;
   end Set_Tree_Processing_Mode;

   procedure Set_Source_Processing_Mode (C : Context_Id; M :  Source_Mode) is
   begin
      Contexts.Table (C).Source_Processing := M;
   end Set_Source_Processing_Mode;

   procedure Set_Use_Default_Trees       (C : Context_Id; B : Boolean) is
   begin
      Contexts.Table (C).Use_Default_Trees := B;
   end Set_Use_Default_Trees;

   procedure Set_Default_Context_Processing_Mode           (C : Context_Id) is
   begin
      Contexts.Table (C).Mode := All_Trees;
   end Set_Default_Context_Processing_Mode;

   procedure Set_Default_Tree_Processing_Mode   (C : Context_Id) is
   begin
      Contexts.Table (C).Tree_Processing := Pre_Created;
   end Set_Default_Tree_Processing_Mode;

   procedure Set_Default_Source_Processing_Mode (C : Context_Id) is
   begin
      Contexts.Table (C).Source_Processing := All_Sources;
   end Set_Default_Source_Processing_Mode;

-----------------
--  NEW STUFF  --
-----------------

   ----------------------------
   -- Backup_Current_Context --
   ----------------------------

   procedure Backup_Current_Context is
   begin
      if Current_Context /= Nil_Context_Id then
         Save_Context (Current_Context);
      end if;
   end Backup_Current_Context;

   -------------------
   -- Reset_Context --
   -------------------

   procedure Reset_Context (C : Context_Id) is
   begin
      if C = Nil_Context_Id then
         return;
      elsif C /= Current_Context then

         if Is_Opened (Current_Context) then
            Save_Context (Current_Context);
         end if;

         if Is_Opened (C) then
            Restore_Context (C);
         end if;

         Current_Context := C;
         --  we have to do also this:
         Current_Tree := Nil_Tree;
         --  otherwise node/tree access in a new Context may not reset the tree
         --  in case in tree Ids in the old and new Contexts are the same
      end if;
   end Reset_Context;

   ---------------------
   -- Restore_Context --
   ---------------------

   procedure Restore_Context (C : Context_Id) is
   begin
      A_Name_Chars.Restore
         (Contexts.Table (C).Back_Up.Context_Name_Chars);
      Unit_Table.Restore (Contexts.Table (C).Back_Up.Units);
      Tree_Table.Restore (Contexts.Table (C).Back_Up.Trees);

      --  restoring lists tables:
      A4G.A_Elists.Elmts.Restore
         (Contexts.Table (C).Back_Up.Context_Unit_Lists.Saved_Elmts);
      A4G.A_Elists.Elists.Restore
         (Contexts.Table (C).Back_Up.Context_Unit_Lists.Saved_Elists);
   end Restore_Context;

   ------------------
   -- Save_Context --
   ------------------

   procedure Save_Context (C : Context_Id) is
   begin
      if Is_Associated (C) then
         Contexts.Table (C).Back_Up.Context_Name_Chars := A_Name_Chars.Save;
         Contexts.Table (C).Back_Up.Units              := Unit_Table.Save;
         Contexts.Table (C).Back_Up.Trees              := Tree_Table.Save;

         --  saving lists tables:
         Contexts.Table (C).Back_Up.Context_Unit_Lists.Saved_Elmts :=
            A4G.A_Elists.Elmts.Save;
         Contexts.Table (C).Back_Up.Context_Unit_Lists.Saved_Elists :=
            A4G.A_Elists.Elists.Save;
      end if;
   end Save_Context;

   -------------------------
   -- Verify_Context_Name --
   -------------------------

   procedure Verify_Context_Name (Name : String; Cont : Context_Id) is
   begin
      --  no verification is performed now - we simply have no idea, what
      --  and how to verify :-I

      Set_Context_Name (Cont, Name);
   end Verify_Context_Name;

end A4G.Contt;
