------------------------------------------------------------------------------
--                                                                          --
--                        GNAT RUN-TIME COMPONENTS                          --
--                                                                          --
--                             T A R G P A R M                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1999-2015, 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 3,  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 COPYING3.  If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license.          --
--                                                                          --
-- GNAT was originally developed  by the GNAT team at  New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc.      --
--                                                                          --
------------------------------------------------------------------------------

with Csets;    use Csets;
with Opt;      use Opt;
with Osint;    use Osint;
with Output;   use Output;

package body Targparm is
   use ASCII;

   Parameters_Obtained : Boolean := False;
   --  Set True after first call to Get_Target_Parameters. Used to avoid
   --  reading system.ads more than once, since it cannot change.

   --  The following array defines a tag name for each entry

   type Targparm_Tags is
     (AAM,  --   AAMP
      ACR,  --   Always_Compatible_Rep
      ASD,  --   Atomic_Sync_Default
      BDC,  --   Backend_Divide_Checks
      BOC,  --   Backend_Overflow_Checks
      CLA,  --   Command_Line_Args
      CRT,  --   Configurable_Run_Times
      D32,  --   Duration_32_Bits
      DEN,  --   Denorm
      EXS,  --   Exit_Status_Supported
      FEL,  --   Frontend_Layout
      FEX,  --   Frontend_Exceptions
      FFO,  --   Fractional_Fixed_Ops
      MOV,  --   Machine_Overflows
      MRN,  --   Machine_Rounds
      PAS,  --   Preallocated_Stacks
      SAG,  --   Support_Aggregates
      SAP,  --   Support_Atomic_Primitives
      SCA,  --   Support_Composite_Assign
      SCC,  --   Support_Composite_Compare
      SCD,  --   Stack_Check_Default
      SCL,  --   Stack_Check_Limits
      SCP,  --   Stack_Check_Probes
      SLS,  --   Support_Long_Shifts
      SNZ,  --   Signed_Zeros
      SSL,  --   Suppress_Standard_Library
      UAM,  --   Use_Ada_Main_Program_Name
      ZCX); --   ZCX_By_Default

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

   --  The following list of string constants gives the parameter names

   AAM_Str : aliased constant Source_Buffer := "AAMP";
   ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";
   ASD_Str : aliased constant Source_Buffer := "Atomic_Sync_Default";
   BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
   BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
   CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
   CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
   D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
   DEN_Str : aliased constant Source_Buffer := "Denorm";
   EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
   FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
   FEX_Str : aliased constant Source_Buffer := "Frontend_Exceptions";
   FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
   MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
   MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
   PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
   SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
   SAP_Str : aliased constant Source_Buffer := "Support_Atomic_Primitives";
   SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
   SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
   SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
   SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
   SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
   SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
   SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
   SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
   UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
   ZCX_Str : aliased constant Source_Buffer := "ZCX_By_Default";

   --  The following defines a set of pointers to the above strings,
   --  indexed by the tag values.

   type Buffer_Ptr is access constant Source_Buffer;
   Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
     (AAM_Str'Access,
      ACR_Str'Access,
      ASD_Str'Access,
      BDC_Str'Access,
      BOC_Str'Access,
      CLA_Str'Access,
      CRT_Str'Access,
      D32_Str'Access,
      DEN_Str'Access,
      EXS_Str'Access,
      FEL_Str'Access,
      FEX_Str'Access,
      FFO_Str'Access,
      MOV_Str'Access,
      MRN_Str'Access,
      PAS_Str'Access,
      SAG_Str'Access,
      SAP_Str'Access,
      SCA_Str'Access,
      SCC_Str'Access,
      SCD_Str'Access,
      SCL_Str'Access,
      SCP_Str'Access,
      SLS_Str'Access,
      SNZ_Str'Access,
      SSL_Str'Access,
      UAM_Str'Access,
      ZCX_Str'Access);

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Set_Profile_Restrictions (P : Profile_Name);
   --  Set Restrictions_On_Target for the given profile

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

   --  Version which reads in system.ads

   procedure Get_Target_Parameters
     (Make_Id : Make_Id_Type := null;
      Make_SC : Make_SC_Type := null;
      Set_NOD : Set_NOD_Type := null;
      Set_NSA : Set_NSA_Type := null;
      Set_NUA : Set_NUA_Type := null;
      Set_NUP : Set_NUP_Type := null)
   is
      Text : Source_Buffer_Ptr;
      Hi   : Source_Ptr;

   begin
      if Parameters_Obtained then
         return;
      end if;

      Name_Buffer (1 .. 10) := "system.ads";
      Name_Len := 10;

      Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);

      if Text = null then
         Write_Line ("fatal error, run-time library not installed correctly");
         Write_Line ("cannot locate file system.ads");
         raise Unrecoverable_Error;
      end if;

      Get_Target_Parameters
        (System_Text  => Text,
         Source_First => 0,
         Source_Last  => Hi,
         Make_Id      => Make_Id,
         Make_SC      => Make_SC,
         Set_NOD      => Set_NOD,
         Set_NSA      => Set_NSA,
         Set_NUA      => Set_NUA,
         Set_NUP      => Set_NUP);
   end Get_Target_Parameters;

   --  Version where caller supplies system.ads text

   procedure Get_Target_Parameters
     (System_Text  : Source_Buffer_Ptr;
      Source_First : Source_Ptr;
      Source_Last  : Source_Ptr;
      Make_Id      : Make_Id_Type := null;
      Make_SC      : Make_SC_Type := null;
      Set_NOD      : Set_NOD_Type := null;
      Set_NSA      : Set_NSA_Type := null;
      Set_NUA      : Set_NUA_Type := null;
      Set_NUP      : Set_NUP_Type := null)
   is
      P : Source_Ptr;
      --  Scans source buffer containing source of system.ads

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

      Result : Boolean;
      --  Records boolean from system line

      OK : Boolean;
      --  Status result from Set_NUP/NSA/NUA call

      PR_Start : Source_Ptr;
      --  Pointer to ( following pragma Restrictions

      procedure Collect_Name;
      --  Scan a name starting at System_Text (P), and put Name in Name_Buffer,
      --  with Name_Len being length, folded to lower case. On return, P points
      --  just past the last character (which should be a right paren).

      ------------------
      -- Collect_Name --
      ------------------

      procedure Collect_Name is
      begin
         Name_Len := 0;
         loop
            if System_Text (P) in 'a' .. 'z'
              or else
                System_Text (P) = '_'
              or else
                System_Text (P) in '0' .. '9'
            then
               Name_Buffer (Name_Len + 1) := System_Text (P);

            elsif System_Text (P) in 'A' .. 'Z' then
               Name_Buffer (Name_Len + 1) :=
                 Character'Val (Character'Pos (System_Text (P)) + 32);

            else
               exit;
            end if;

            P := P + 1;
            Name_Len := Name_Len + 1;
         end loop;
      end Collect_Name;

   --  Start of processing for Get_Target_Parameters

   begin
      if Parameters_Obtained then
         return;
      else
         Parameters_Obtained := True;
      end if;

      Opt.Address_Is_Private := False;

      --  Loop through source lines

      --  Note: in the case or pragmas, we are only interested in pragmas that
      --  appear as configuration pragmas. These are left justified, so they
      --  do not have three spaces at the start. Pragmas appearing within the
      --  package (like Pure and No_Elaboration_Code_All) will have the three
      --  spaces at the start and so will be ignored.

      --  For a special exception, see processing for pragma Pure below

      P := Source_First;
      Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop

         --  Skip comments quickly

         if System_Text (P) = '-' then
            goto Line_Loop_Continue;

         --  Test for type Address is private

         elsif System_Text (P .. P + 26) = "   type Address is private;" then
            Opt.Address_Is_Private := True;
            P := P + 26;
            goto Line_Loop_Continue;

         --  Test for pragma Profile (Ravenscar);

         elsif System_Text (P .. P + 26) =
                 "pragma Profile (Ravenscar);"
         then
            Set_Profile_Restrictions (Ravenscar);
            Opt.Task_Dispatching_Policy := 'F';
            Opt.Locking_Policy          := 'C';
            P := P + 27;
            goto Line_Loop_Continue;

         --  Test for pragma Profile (GNAT_Extended_Ravenscar);

         elsif System_Text (P .. P + 40) =
                 "pragma Profile (GNAT_Extended_Ravenscar);"
         then
            Set_Profile_Restrictions (GNAT_Extended_Ravenscar);
            Opt.Task_Dispatching_Policy := 'F';
            Opt.Locking_Policy          := 'C';
            P := P + 27;
            goto Line_Loop_Continue;

         --  Test for pragma Profile (Restricted);

         elsif System_Text (P .. P + 27) =
                 "pragma Profile (Restricted);"
         then
            Set_Profile_Restrictions (Restricted);
            P := P + 28;
            goto Line_Loop_Continue;

         --  Test for pragma Restrictions

         elsif System_Text (P .. P + 20) = "pragma Restrictions (" then
            P := P + 21;
            PR_Start := P - 1;

            --  Boolean restrictions

            Rloop : for K in All_Boolean_Restrictions loop
               declare
                  Rname : constant String := Restriction_Id'Image (K);

               begin
                  for J in Rname'Range loop
                     if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
                                                        /= Rname (J)
                     then
                        goto Rloop_Continue;
                     end if;
                  end loop;

                  if System_Text (P + Rname'Length) = ')' then
                     Restrictions_On_Target.Set (K) := True;
                     goto Line_Loop_Continue;
                  end if;
               end;

            <<Rloop_Continue>>
               null;
            end loop Rloop;

            --  Restrictions taking integer parameter

            Ploop : for K in Integer_Parameter_Restrictions loop
               declare
                  Rname : constant String :=
                            All_Parameter_Restrictions'Image (K);

                  V : Natural;
                  --  Accumulates value

               begin
                  for J in Rname'Range loop
                     if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
                                                        /= Rname (J)
                     then
                        goto Ploop_Continue;
                     end if;
                  end loop;

                  if System_Text (P + Rname'Length .. P + Rname'Length + 3) =
                                                      " => "
                  then
                     P := P + Rname'Length + 4;

                     V := 0;
                     loop
                        if System_Text (P) in '0' .. '9' then
                           declare
                              pragma Unsuppress (Overflow_Check);

                           begin
                              --  Accumulate next digit

                              V := 10 * V +
                                   Character'Pos (System_Text (P)) -
                                   Character'Pos ('0');

                           exception
                              --  On overflow, we just ignore the pragma since
                              --  that is the standard handling in this case.

                              when Constraint_Error =>
                                 goto Line_Loop_Continue;
                           end;

                        elsif System_Text (P) = '_' then
                           null;

                        elsif System_Text (P) = ')' then
                           Restrictions_On_Target.Value (K) := V;
                           Restrictions_On_Target.Set (K) := True;
                           goto Line_Loop_Continue;

                        else
                           exit Ploop;
                        end if;

                        P := P + 1;
                     end loop;

                  else
                     exit Ploop;
                  end if;
               end;

            <<Ploop_Continue>>
               null;
            end loop Ploop;

            --  No_Dependence case

            if System_Text (P .. P + 16) = "No_Dependence => " then
               P := P + 17;

               --  Skip this processing (and simply ignore No_Dependence lines)
               --  if caller did not supply the three subprograms we need to
               --  process these lines.

               if Make_Id = null then
                  goto Line_Loop_Continue;
               end if;

               --  We have scanned out "pragma Restrictions (No_Dependence =>"

               declare
                  Unit  : Node_Id;
                  Id    : Node_Id;
                  Start : Source_Ptr;

               begin
                  Unit := Empty;

                  --  Loop through components of name, building up Unit

                  loop
                     Start := P;
                     while System_Text (P) /= '.'
                             and then
                           System_Text (P) /= ')'
                     loop
                        P := P + 1;
                     end loop;

                     Id := Make_Id (System_Text (Start .. P - 1));

                     --  If first name, just capture the identifier

                     if Unit = Empty then
                        Unit := Id;
                     else
                        Unit := Make_SC (Unit, Id);
                     end if;

                     exit when System_Text (P) = ')';
                     P := P + 1;
                  end loop;

                  Set_NOD (Unit);
                  goto Line_Loop_Continue;
               end;

            --  No_Specification_Of_Aspect case

            elsif System_Text (P .. P + 29) = "No_Specification_Of_Aspect => "
            then
               P := P + 30;

               --  Skip this processing (and simply ignore the pragma), if
               --  caller did not supply the subprogram we need to process
               --  such lines.

               if Set_NSA = null then
                  goto Line_Loop_Continue;
               end if;

               --  We have scanned
               --    "pragma Restrictions (No_Specification_Of_Aspect =>"

               Collect_Name;

               if System_Text (P) /= ')' then
                  goto Bad_Restrictions_Pragma;

               else
                  Set_NSA (Name_Find, OK);

                  if OK then
                     goto Line_Loop_Continue;
                  else
                     goto Bad_Restrictions_Pragma;
                  end if;
               end if;

            --  No_Use_Of_Attribute case

            elsif System_Text (P .. P + 22) = "No_Use_Of_Attribute => " then
               P := P + 23;

               --  Skip this processing (and simply ignore No_Use_Of_Attribute
               --  lines) if caller did not supply the subprogram we need to
               --  process such lines.

               if Set_NUA = null then
                  goto Line_Loop_Continue;
               end if;

               --  We have scanned
               --    "pragma Restrictions (No_Use_Of_Attribute =>"

               Collect_Name;

               if System_Text (P) /= ')' then
                  goto Bad_Restrictions_Pragma;

               else
                  Set_NUA (Name_Find, OK);

                  if OK then
                     goto Line_Loop_Continue;
                  else
                     goto Bad_Restrictions_Pragma;
                  end if;
               end if;

            --  No_Use_Of_Pragma case

            elsif System_Text (P .. P + 19) = "No_Use_Of_Pragma => " then
               P := P + 20;

               --  Skip this processing (and simply ignore No_Use_Of_Pragma
               --  lines) if caller did not supply the subprogram we need to
               --  process such lines.

               if Set_NUP = null then
                  goto Line_Loop_Continue;
               end if;

               --  We have scanned
               --    "pragma Restrictions (No_Use_Of_Pragma =>"

               Collect_Name;

               if System_Text (P) /= ')' then
                  goto Bad_Restrictions_Pragma;

               else
                  Set_NUP (Name_Find, OK);

                  if OK then
                     goto Line_Loop_Continue;
                  else
                     goto Bad_Restrictions_Pragma;
                  end if;
               end if;
            end if;

            --  Here if unrecognizable restrictions pragma form

            <<Bad_Restrictions_Pragma>>

            Set_Standard_Error;
            Write_Line
               ("fatal error: system.ads is incorrectly formatted");
            Write_Str ("unrecognized or incorrect restrictions pragma: ");

            P := PR_Start;
            loop
               exit when System_Text (P) = ASCII.LF;
               Write_Char (System_Text (P));
               exit when System_Text (P) = ')';
               P := P + 1;
            end loop;

            Write_Eol;
            Fatal := True;
            Set_Standard_Output;

         --  Test for pragma Detect_Blocking;

         elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then
            P := P + 23;
            Opt.Detect_Blocking := True;
            goto Line_Loop_Continue;

         --  Discard_Names

         elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then
            P := P + 21;
            Opt.Global_Discard_Names := True;
            goto Line_Loop_Continue;

         --  Locking Policy

         elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then
            P := P + 23;
            Opt.Locking_Policy := System_Text (P);
            Opt.Locking_Policy_Sloc := System_Location;
            goto Line_Loop_Continue;

         --  Normalize_Scalars

         elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then
            P := P + 25;
            Opt.Normalize_Scalars := True;
            Opt.Init_Or_Norm_Scalars := True;
            goto Line_Loop_Continue;

         --  Partition_Elaboration_Policy

         elsif System_Text (P .. P + 36) =
                 "pragma Partition_Elaboration_Policy ("
         then
            P := P + 37;
            Opt.Partition_Elaboration_Policy := System_Text (P);
            Opt.Partition_Elaboration_Policy_Sloc := System_Location;
            goto Line_Loop_Continue;

         --  Polling (On)

         elsif System_Text (P .. P + 19) = "pragma Polling (On);" then
            P := P + 20;
            Opt.Polling_Required := True;
            goto Line_Loop_Continue;

         --  Queuing Policy

         elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then
            P := P + 23;
            Opt.Queuing_Policy := System_Text (P);
            Opt.Queuing_Policy_Sloc := System_Location;
            goto Line_Loop_Continue;

         --  Suppress_Exception_Locations

         elsif System_Text (P .. P + 35) =
                                   "pragma Suppress_Exception_Locations;"
         then
            P := P + 36;
            Opt.Exception_Locations_Suppressed := True;
            goto Line_Loop_Continue;

         --  Task_Dispatching Policy

         elsif System_Text (P .. P + 31) =
                                   "pragma Task_Dispatching_Policy ("
         then
            P := P + 32;
            Opt.Task_Dispatching_Policy := System_Text (P);
            Opt.Task_Dispatching_Policy_Sloc := System_Location;
            goto Line_Loop_Continue;

         --  No other configuration pragmas are permitted

         elsif System_Text (P .. P + 6) = "pragma " then

            --  Special exception, we allow pragma Pure (System) appearing in
            --  column one. This is an obsolete usage which may show up in old
            --  tests with an obsolete version of system.ads, so we recognize
            --  and ignore it to make life easier in handling such tests.

            if System_Text (P .. P + 20) = "pragma Pure (System);" then
               P := P + 21;
               goto Line_Loop_Continue;
            end if;

            Set_Standard_Error;
            Write_Line ("unrecognized line in system.ads: ");

            while System_Text (P) /= ')'
              and then System_Text (P) /= ASCII.LF
            loop
               Write_Char (System_Text (P));
               P := P + 1;
            end loop;

            Write_Eol;
            Set_Standard_Output;
            Fatal := True;

         --  See if we have a Run_Time_Name

         elsif System_Text (P .. P + 38) =
                  "   Run_Time_Name : constant String := """
         then
            P := P + 39;

            Name_Len := 0;
            while System_Text (P) in 'A' .. 'Z'
                    or else
                  System_Text (P) in 'a' .. 'z'
                    or else
                  System_Text (P) in '0' .. '9'
                    or else
                  System_Text (P) = ' '
                    or else
                  System_Text (P) = '_'
            loop
               Add_Char_To_Name_Buffer (System_Text (P));
               P := P + 1;
            end loop;

            if System_Text (P) /= '"'
              or else System_Text (P + 1) /= ';'
              or else (System_Text (P + 2) /= ASCII.LF
                         and then
                       System_Text (P + 2) /= ASCII.CR)
            then
               Set_Standard_Error;
               Write_Line
                 ("incorrectly formatted Run_Time_Name in system.ads");
               Set_Standard_Output;
               Fatal := True;

            else
               Run_Time_Name_On_Target := Name_Enter;
            end if;

            goto Line_Loop_Continue;

         --  See if we have an Executable_Extension

         elsif System_Text (P .. P + 45) =
                  "   Executable_Extension : constant String := """
         then
            P := P + 46;

            Name_Len := 0;
            while System_Text (P) /= '"'
              and then System_Text (P) /= ASCII.LF
            loop
               Add_Char_To_Name_Buffer (System_Text (P));
               P := P + 1;
            end loop;

            if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then
               Set_Standard_Error;
               Write_Line
                 ("incorrectly formatted Executable_Extension in system.ads");
               Set_Standard_Output;
               Fatal := True;

            else
               Executable_Extension_On_Target := Name_Enter;
            end if;

            goto Line_Loop_Continue;

         --  Next see if we have a configuration parameter

         else
            Config_Param_Loop : for K in Targparm_Tags loop
               if System_Text (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 System_Text (P) /= ':'
                     or else System_Text (P + 1) /= '='
                  loop
                     P := P + 1;
                  end loop;

                  P := P + 2;

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

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

                  case K is
                     when AAM => AAMP_On_Target                      := Result;
                     when ACR => Always_Compatible_Rep_On_Target     := Result;
                     when ASD => Atomic_Sync_Default_On_Target       := Result;
                     when BDC => Backend_Divide_Checks_On_Target     := Result;
                     when BOC => Backend_Overflow_Checks_On_Target   := Result;
                     when CLA => Command_Line_Args_On_Target         := Result;
                     when CRT => Configurable_Run_Time_On_Target     := Result;
                     when D32 => Duration_32_Bits_On_Target          := Result;
                     when DEN => Denorm_On_Target                    := Result;
                     when EXS => Exit_Status_Supported_On_Target     := Result;
                     when FEL => Frontend_Layout_On_Target           := Result;
                     when FEX => Frontend_Exceptions_On_Target       := Result;
                     when FFO => Fractional_Fixed_Ops_On_Target      := Result;
                     when MOV => Machine_Overflows_On_Target         := Result;
                     when MRN => Machine_Rounds_On_Target            := Result;
                     when PAS => Preallocated_Stacks_On_Target       := Result;
                     when SAG => Support_Aggregates_On_Target        := Result;
                     when SAP => Support_Atomic_Primitives_On_Target := Result;
                     when SCA => Support_Composite_Assign_On_Target  := Result;
                     when SCC => Support_Composite_Compare_On_Target := Result;
                     when SCD => Stack_Check_Default_On_Target       := Result;
                     when SCL => Stack_Check_Limits_On_Target        := Result;
                     when SCP => Stack_Check_Probes_On_Target        := Result;
                     when SLS => Support_Long_Shifts_On_Target       := Result;
                     when SSL => Suppress_Standard_Library_On_Target := Result;
                     when SNZ => Signed_Zeros_On_Target              := Result;
                     when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
                     when ZCX => ZCX_By_Default_On_Target            := Result;

                     goto Line_Loop_Continue;
                  end case;

                  --  Here we are seeing a parameter we do not understand. We
                  --  simply ignore this (will happen when an old compiler is
                  --  used to compile a newer version of GNAT which does not
                  --  support the parameter).
               end if;
            end loop Config_Param_Loop;
         end if;

         --  Here after processing one line of System spec

         <<Line_Loop_Continue>>

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

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

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

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

   ------------------------------
   -- Set_Profile_Restrictions --
   ------------------------------

   procedure Set_Profile_Restrictions (P : Profile_Name) is
      R : Restriction_Flags  renames Profile_Info (P).Set;
      V : Restriction_Values renames Profile_Info (P).Value;
   begin
      for J in R'Range loop
         if R (J) then
            Restrictions_On_Target.Set (J) := True;

            if J in All_Parameter_Restrictions then
               Restrictions_On_Target.Value (J) := V (J);
            end if;
         end if;
      end loop;
   end Set_Profile_Restrictions;

end Targparm;