------------------------------------------------------------------------------
--                                                                          --
--                        GNAT RUN-TIME COMPONENTS                          --
--                                                                          --
--                             T A R G P A R M                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.15 $
--                                                                          --
--          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
--                                                                          --
------------------------------------------------------------------------------

with Namet;    use Namet;
with Output;   use Output;
with Sinput;   use Sinput;
with Sinput.L; use Sinput.L;
with Fname.UF; use Fname.UF;
with Types;    use Types;

package body Targparm is

   type Targparm_Tags is
     (AAM, CLA, DEN, DSP, FEL, HIM, LSI, MOV,
      MRN, SCD, SCP, SNZ, UAM, VMS, ZCD, ZCG, ZCF);

   Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
   --  Flag is set True if corresponding parameter is scanned

   AAM_Str : aliased constant Source_Buffer := "AAMP";
   CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
   DEN_Str : aliased constant Source_Buffer := "Denorm";
   DSP_Str : aliased constant Source_Buffer := "Functions_Return_By_DSP";
   FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
   HIM_Str : aliased constant Source_Buffer := "High_Integrity_Mode";
   LSI_Str : aliased constant Source_Buffer := "Long_Shifts_Inlined";
   MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
   MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
   SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
   SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
   SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
   UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
   VMS_Str : aliased constant Source_Buffer := "OpenVMS";
   ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
   ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";
   ZCF_Str : aliased constant Source_Buffer := "Front_End_ZCX_Support";

   type Buffer_Ptr is access constant Source_Buffer;
   Targparm_Str : array (Targparm_Tags) of Buffer_Ptr :=
     (AAM_Str'Access,
      CLA_Str'Access,
      DEN_Str'Access,
      DSP_Str'Access,
      FEL_Str'Access,
      HIM_Str'Access,
      LSI_Str'Access,
      MOV_Str'Access,
      MRN_Str'Access,
      SCD_Str'Access,
      SCP_Str'Access,
      SNZ_Str'Access,
      UAM_Str'Access,
      VMS_Str'Access,
      ZCD_Str'Access,
      ZCG_Str'Access,
      ZCF_Str'Access);

   ---------------------------
   -- Get_Target_Parameters --
   ---------------------------

   procedure Get_Target_Parameters is
      use ASCII;

      S : Source_File_Index;
      N : Name_Id;
      T : Source_Buffer_Ptr;
      P : Source_Ptr;
      Z : Source_Ptr;

      Fatal : Boolean := False;
      --  Set True if a fatal error is detected

      Result : Boolean;
      --  Records boolean from system line

   begin
      Name_Buffer (1 .. 6) := "system";
      Name_Len := 6;
      N := File_Name_Of_Spec (Name_Find);
      S := Load_Source_File (N);

      if S = No_Source_File then
         Write_Line ("fatal error, run-time library not installed correctly");
         Write_Str ("cannot locate file ");
         Write_Line (Name_Buffer (1 .. Name_Len));
         raise Unrecoverable_Error;

      --  This must always be the first source file read, and we have defined
      --  a constant Types.System_Source_File_Index as 1 to reflect this.

      else
         pragma Assert (S = System_Source_File_Index);
         null;
      end if;

      P := Source_First (S);
      Z := Source_Last  (S);
      T := Source_Text  (S);

      while T (P .. P + 10) /= "end System;" loop

         for K in Targparm_Tags loop
            if T (P + 3 .. P + 2 + Targparm_Str (K)'Length) =
                                                   Targparm_Str (K).all
            then
               P := P + 3 + Targparm_Str (K)'Length;

               if Targparm_Flags (K) then
                  Set_Standard_Error;
                  Write_Line
                    ("fatal error: system.ads is incorrectly formatted");
                  Write_Str ("duplicate line for parameter: ");

                  for J in Targparm_Str (K)'Range loop
                     Write_Char (Targparm_Str (K).all (J));
                  end loop;

                  Write_Eol;
                  Set_Standard_Output;
                  Fatal := True;

               else
                  Targparm_Flags (K) := True;
               end if;

               while T (P) /= ':' or else T (P + 1) /= '=' loop
                  P := P + 1;
               end loop;

               P := P + 2;

               while T (P) = ' ' loop
                  P := P + 1;
               end loop;

               Result := (T (P) = 'T');

               case K is
                  when AAM => AAMP_On_Target                      := Result;
                  when CLA => Command_Line_Args_On_Target         := Result;
                  when DEN => Denorm_On_Target                    := Result;
                  when DSP => Functions_Return_By_DSP_On_Target   := Result;
                  when FEL => Frontend_Layout_On_Target           := Result;
                  when HIM => High_Integrity_Mode_On_Target       := Result;
                  when LSI => Long_Shifts_Inlined_On_Target       := Result;
                  when MOV => Machine_Overflows_On_Target         := Result;
                  when MRN => Machine_Rounds_On_Target            := Result;
                  when SCD => Stack_Check_Default_On_Target       := Result;
                  when SCP => Stack_Check_Probes_On_Target        := Result;
                  when SNZ => Signed_Zeros_On_Target              := Result;
                  when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
                  when VMS => OpenVMS_On_Target                   := Result;
                  when ZCD => ZCX_By_Default_On_Target            := Result;
                  when ZCG => GCC_ZCX_Support_On_Target           := Result;
                  when ZCF => Front_End_ZCX_Support_On_Target     := Result;
               end case;

               exit;
            end if;
         end loop;

         while T (P) /= CR and then T (P) /= LF loop
            P := P + 1;
            exit when P >= Z;
         end loop;

         while T (P) = CR or else T (P) = LF loop
            P := P + 1;
            exit when P >= Z;
         end loop;

         if P >= Z then
            Set_Standard_Error;
            Write_Line ("fatal error, system.ads not formatted correctly");
            Set_Standard_Output;
            raise Unrecoverable_Error;
         end if;
      end loop;

      for K in Targparm_Tags loop
         if not Targparm_Flags (K) then
            Set_Standard_Error;
            Write_Line
              ("fatal error: system.ads is incorrectly formatted");
            Write_Str ("missing line for parameter: ");

            for J in Targparm_Str (K)'Range loop
               Write_Char (Targparm_Str (K).all (J));
            end loop;

            Write_Eol;
            Set_Standard_Output;
            Fatal := True;
         end if;
      end loop;

      if Fatal then
         raise Unrecoverable_Error;
      end if;
   end Get_Target_Parameters;

end Targparm;