------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--   G N A T P P . E N V I R O N M E N T . P R E P A R E _ C O N T E X T    --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2003, ACT Europe                       --
--                                                                          --
-- GNATPP is free software; you can redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNATPP is  distributed in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY or  FITNESS  FOR A  PARTICULAR  PURPOSE. See the GNU General Public --
-- License  for more details. You  should  have  received a copy of the GNU --
-- General Public License  distributed with GNAT; see file COPYING. If not, --
-- write  to  the Free  Software  Foundation,  59 Temple Place - Suite 330, --
-- Boston,                                                                  --
--                                                                          --
-- GNATPP is maintained by ACT Europe (http://www.act-europe.fr).           --
--                                                                          --
------------------------------------------------------------------------------

--  This version of Prepare_Context is supposed to be used for the non
--  GNSA-based gnatpp version

separate (GNATPP.Environment)
procedure Prepare_Context is
   use type Asis.Errors.Error_Kinds;

   procedure Create_Tree_If_Needed;
   --  Checks if we can reuse the tree and if we can not - creates it

   procedure Create_Tree_If_Needed is
      Dot_Idx : Natural := Short_Source_Name'Last;
   begin

      for J in reverse Short_Source_Name'Range loop

         if Short_Source_Name (J) = '.' then
            Dot_Idx := J - 1;
            exit;
         end if;

      end loop;

      Tree_File_Name :=
         new String'(Short_Source_Name (Short_Source_Name'First .. Dot_Idx) &
                     ".adt");

      ALI_File_Name := new String'(Tree_File_Name.all);
      ALI_File_Name (ALI_File_Name'Last - 3 .. ALI_File_Name'Last) := ".ali";

      if Is_Regular_File (Tree_File_Name.all) then

         Tree_Reused := True;

         if Verbose_Mode then
            Put (Standard_Error,
                "Going to reuse the tree file " & Tree_File_Name.all);
            New_Line (Standard_Error);
         end if;

      else
         Create_Tree;
      end if;

   end Create_Tree_If_Needed;

begin
   Create_Tree_If_Needed;

   Initialize ("-sv");

   Associate (The_Context => The_Context,
              Name        => "",
              Parameters  => "-C1 " & To_Wide_String (Tree_File_Name.all));

   begin
      Open (The_Context);

      if Tree_Reused then
         Check_Tree_Reusing;
      end if;

   exception
      when Ex : Program_Error | ASIS_Failed =>
         --  The reason may be that the tree is reused and it is obsolete
         --  (that is, inconsistent with sources) or created by the old
         --  version of the compiler. So we try to recreate it.

         if Tree_Reused and then
            (Exception_Identity (Ex) /= ASIS_Failed'Identity or else
              Status = Asis.Errors.Use_Error)
         then

            if Verbose_Mode then
               Put (Standard_Error,
                  "gnatpp: trying to recreate the tree for " &
                   Arg_Source_Name.all);
               New_Line (Standard_Error);
            end if;

            Tree_Reused := False;

            Create_Tree;

            Open (The_Context);

            Set_Status;
         else
            raise;
         end if;

   end;

exception
   when Parameter_Error =>
      --  This exception comes form Create_Tree after generating the
      --  diagnostic message
      raise Fatal_Error;
   when Ex : others =>
      Put (Standard_Error, "gnatpp: unexpected bug when opening a context");
      New_Line (Standard_Error);
      Report_Unhandled_Exception (Ex);
      raise Fatal_Error;
end Prepare_Context;
