URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [targparm.adb] - Blame information for rev 523

Go to most recent revision | Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                        GNAT RUN-TIME COMPONENTS                          --
--                                                                          --
--                             T A R G P A R M                              --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 1999-2009, 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
      BDC,  --   Backend_Divide_Checks
      BOC,  --   Backend_Overflow_Checks
      CLA,  --   Command_Line_Args
      CLI,  --   CLI (.NET)
      CRT,  --   Configurable_Run_Times
      D32,  --   Duration_32_Bits
      DEN,  --   Denorm
      EXS,  --   Exit_Status_Supported
      FEL,  --   Frontend_Layout
      FFO,  --   Fractional_Fixed_Ops
      JVM,  --   JVM
      MOV,  --   Machine_Overflows
      MRN,  --   Machine_Rounds
      PAS,  --   Preallocated_Stacks
      RTX,  --   RTX_RTSS_Kernel_Module
      S64,  --   Support_64_Bit_Divides
      SAG,  --   Support_Aggregates
      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
      VMS,  --   OpenVMS
      ZCD,  --   ZCX_By_Default
      ZCG); --   GCC_ZCX_Support
 
   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";
   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";
   CLI_Str : aliased constant Source_Buffer := "CLI";
   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";
   FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
   JVM_Str : aliased constant Source_Buffer := "JVM";
   MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
   MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
   PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
   RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module";
   S64_Str : aliased constant Source_Buffer := "Support_64_Bit_Divides";
   SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
   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";
   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";
 
   --  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,
      BDC_Str'Access,
      BOC_Str'Access,
      CLA_Str'Access,
      CLI_Str'Access,
      CRT_Str'Access,
      D32_Str'Access,
      DEN_Str'Access,
      EXS_Str'Access,
      FEL_Str'Access,
      FFO_Str'Access,
      JVM_Str'Access,
      MOV_Str'Access,
      MRN_Str'Access,
      PAS_Str'Access,
      RTX_Str'Access,
      S64_Str'Access,
      SAG_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,
      VMS_Str'Access,
      ZCD_Str'Access,
      ZCG_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 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);
   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)
   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
 
   begin
      if Parameters_Obtained then
         return;
      else
         Parameters_Obtained := True;
      end if;
 
      Opt.Address_Is_Private := False;
 
      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 (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;
 
            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;
 
            Ploop : for K in All_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;
 
            Set_Standard_Error;
            Write_Line
               ("fatal error: system.ads is incorrectly formatted");
            Write_Str ("unrecognized or incorrect restrictions pragma: ");
 
            while System_Text (P) /= ')'
                    and then
                  System_Text (P) /= ASCII.LF
            loop
               Write_Char (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;
 
         --  Polling (On)
 
         elsif System_Text (P .. P + 19) = "pragma Polling (On);" then
            P := P + 20;
            Opt.Polling_Required := True;
            goto Line_Loop_Continue;
 
         --  Ignore pragma Pure (System)
 
         elsif System_Text (P .. P + 20) = "pragma Pure (System);" then
            P := P + 21;
            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 pragmas are permitted
 
         elsif System_Text (P .. P + 6) = "pragma " then
            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 BDC => Backend_Divide_Checks_On_Target     := Result;
                     when BOC => Backend_Overflow_Checks_On_Target   := Result;
                     when CLA => Command_Line_Args_On_Target         := Result;
                     when CLI =>
                        if Result then
                           VM_Target := CLI_Target;
                           Tagged_Type_Expansion := False;
                        end if;
 
                     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 FFO => Fractional_Fixed_Ops_On_Target      := Result;
                     when JVM =>
                        if Result then
                           VM_Target := JVM_Target;
                           Tagged_Type_Expansion := False;
                        end if;
 
                     when MOV => Machine_Overflows_On_Target         := Result;
                     when MRN => Machine_Rounds_On_Target            := Result;
                     when PAS => Preallocated_Stacks_On_Target       := Result;
                     when RTX => RTX_RTSS_Kernel_Module_On_Target    := Result;
                     when S64 => Support_64_Bit_Divides_On_Target    := Result;
                     when SAG => Support_Aggregates_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 VMS => OpenVMS_On_Target                   := Result;
                     when ZCD => ZCX_By_Default_On_Target            := Result;
                     when ZCG => GCC_ZCX_Support_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;
 
      --  Now that OpenVMS_On_Target has been given its definitive value,
      --  change the multi-unit index character from '~' to '$' for OpenVMS.
 
      if OpenVMS_On_Target then
         Multi_Unit_Index_Character := '$';
      end if;
 
      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;

Browse

Tools

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [targparm.adb] - Blame information for rev 523

Line No.	Rev	Author	Line
1	281	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT RUN-TIME COMPONENTS --`
4			`-- --`
5			`-- T A R G P A R M --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 1999-2009, Free Software Foundation, Inc. --`
10			`-- --`
11			`-- GNAT is free software; you can redistribute it and/or modify it under --`
12			`-- terms of the GNU General Public License as published by the Free Soft- --`
13			`-- ware Foundation; either version 3, or (at your option) any later ver- --`
14			`-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --`
15			`-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --`
16			`-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --`
17			`-- for more details. You should have received a copy of the GNU General --`
18			`-- Public License distributed with GNAT; see file COPYING3. If not, go to --`
19			`-- http://www.gnu.org/licenses for a complete copy of the license. --`
20			`-- --`
21			`-- GNAT was originally developed by the GNAT team at New York University. --`
22			`-- Extensive contributions were provided by Ada Core Technologies Inc. --`
23			`-- --`
24			`------------------------------------------------------------------------------`
25
26			`with Csets; use Csets;`
27			`with Opt; use Opt;`
28			`with Osint; use Osint;`
29			`with Output; use Output;`
30
31			`package body Targparm is`
32			`use ASCII;`
33
34			`Parameters_Obtained : Boolean := False;`
35			`-- Set True after first call to Get_Target_Parameters. Used to avoid`
36			`-- reading system.ads more than once, since it cannot change.`
37
38			`-- The following array defines a tag name for each entry`
39
40			`type Targparm_Tags is`
41			`(AAM, -- AAMP`
42			`ACR, -- Always_Compatible_Rep`
43			`BDC, -- Backend_Divide_Checks`
44			`BOC, -- Backend_Overflow_Checks`
45			`CLA, -- Command_Line_Args`
46			`CLI, -- CLI (.NET)`
47			`CRT, -- Configurable_Run_Times`
48			`D32, -- Duration_32_Bits`
49			`DEN, -- Denorm`
50			`EXS, -- Exit_Status_Supported`
51			`FEL, -- Frontend_Layout`
52			`FFO, -- Fractional_Fixed_Ops`
53			`JVM, -- JVM`
54			`MOV, -- Machine_Overflows`
55			`MRN, -- Machine_Rounds`
56			`PAS, -- Preallocated_Stacks`
57			`RTX, -- RTX_RTSS_Kernel_Module`
58			`S64, -- Support_64_Bit_Divides`
59			`SAG, -- Support_Aggregates`
60			`SCA, -- Support_Composite_Assign`
61			`SCC, -- Support_Composite_Compare`
62			`SCD, -- Stack_Check_Default`
63			`SCL, -- Stack_Check_Limits`
64			`SCP, -- Stack_Check_Probes`
65			`SLS, -- Support_Long_Shifts`
66			`SNZ, -- Signed_Zeros`
67			`SSL, -- Suppress_Standard_Library`
68			`UAM, -- Use_Ada_Main_Program_Name`
69			`VMS, -- OpenVMS`
70			`ZCD, -- ZCX_By_Default`
71			`ZCG); -- GCC_ZCX_Support`
72
73			`Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);`
74			`-- Flag is set True if corresponding parameter is scanned`
75
76			`-- The following list of string constants gives the parameter names`
77
78			`AAM_Str : aliased constant Source_Buffer := "AAMP";`
79			`ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";`
80			`BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";`
81			`BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";`
82			`CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";`
83			`CLI_Str : aliased constant Source_Buffer := "CLI";`
84			`CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";`
85			`D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";`
86			`DEN_Str : aliased constant Source_Buffer := "Denorm";`
87			`EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";`
88			`FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";`
89			`FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";`
90			`JVM_Str : aliased constant Source_Buffer := "JVM";`
91			`MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";`
92			`MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";`
93			`PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";`
94			`RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module";`
95			`S64_Str : aliased constant Source_Buffer := "Support_64_Bit_Divides";`
96			`SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";`
97			`SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";`
98			`SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";`
99			`SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";`
100			`SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";`
101			`SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";`
102			`SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";`
103			`SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";`
104			`SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";`
105			`UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";`
106			`VMS_Str : aliased constant Source_Buffer := "OpenVMS";`
107			`ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";`
108			`ZCG_Str : aliased constant Source_Buffer := "GCC_ZCX_Support";`
109
110			`-- The following defines a set of pointers to the above strings,`
111			`-- indexed by the tag values.`
112
113			`type Buffer_Ptr is access constant Source_Buffer;`
114			`Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=`
115			`(AAM_Str'Access,`
116			`ACR_Str'Access,`
117			`BDC_Str'Access,`
118			`BOC_Str'Access,`
119			`CLA_Str'Access,`
120			`CLI_Str'Access,`
121			`CRT_Str'Access,`
122			`D32_Str'Access,`
123			`DEN_Str'Access,`
124			`EXS_Str'Access,`
125			`FEL_Str'Access,`
126			`FFO_Str'Access,`
127			`JVM_Str'Access,`
128			`MOV_Str'Access,`
129			`MRN_Str'Access,`
130			`PAS_Str'Access,`
131			`RTX_Str'Access,`
132			`S64_Str'Access,`
133			`SAG_Str'Access,`
134			`SCA_Str'Access,`
135			`SCC_Str'Access,`
136			`SCD_Str'Access,`
137			`SCL_Str'Access,`
138			`SCP_Str'Access,`
139			`SLS_Str'Access,`
140			`SNZ_Str'Access,`
141			`SSL_Str'Access,`
142			`UAM_Str'Access,`
143			`VMS_Str'Access,`
144			`ZCD_Str'Access,`
145			`ZCG_Str'Access);`
146
147			`-----------------------`
148			`-- Local Subprograms --`
149			`-----------------------`
150
151			`procedure Set_Profile_Restrictions (P : Profile_Name);`
152			`-- Set Restrictions_On_Target for the given profile`
153
154			`---------------------------`
155			`-- Get_Target_Parameters --`
156			`---------------------------`
157
158			`-- Version which reads in system.ads`
159
160			`procedure Get_Target_Parameters is`
161			`Text : Source_Buffer_Ptr;`
162			`Hi : Source_Ptr;`
163
164			`begin`
165			`if Parameters_Obtained then`
166			`return;`
167			`end if;`
168
169			`Name_Buffer (1 .. 10) := "system.ads";`
170			`Name_Len := 10;`
171
172			`Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);`
173
174			`if Text = null then`
175			`Write_Line ("fatal error, run-time library not installed correctly");`
176			`Write_Line ("cannot locate file system.ads");`
177			`raise Unrecoverable_Error;`
178			`end if;`
179
180			`Get_Target_Parameters`
181			`(System_Text => Text,`
182			`Source_First => 0,`
183			`Source_Last => Hi);`
184			`end Get_Target_Parameters;`
185
186			`-- Version where caller supplies system.ads text`
187
188			`procedure Get_Target_Parameters`
189			`(System_Text : Source_Buffer_Ptr;`
190			`Source_First : Source_Ptr;`
191			`Source_Last : Source_Ptr)`
192			`is`
193			`P : Source_Ptr;`
194			`-- Scans source buffer containing source of system.ads`
195
196			`Fatal : Boolean := False;`
197			`-- Set True if a fatal error is detected`
198
199			`Result : Boolean;`
200			`-- Records boolean from system line`
201
202			`begin`
203			`if Parameters_Obtained then`
204			`return;`
205			`else`
206			`Parameters_Obtained := True;`
207			`end if;`
208
209			`Opt.Address_Is_Private := False;`
210
211			`P := Source_First;`
212			`Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop`
213
214			`-- Skip comments quickly`
215
216			`if System_Text (P) = '-' then`
217			`goto Line_Loop_Continue;`
218
219			`-- Test for type Address is private`
220
221			`elsif System_Text (P .. P + 26) = " type Address is private;" then`
222			`Opt.Address_Is_Private := True;`
223			`P := P + 26;`
224			`goto Line_Loop_Continue;`
225
226			`-- Test for pragma Profile (Ravenscar);`
227
228			`elsif System_Text (P .. P + 26) =`
229			`"pragma Profile (Ravenscar);"`
230			`then`
231			`Set_Profile_Restrictions (Ravenscar);`
232			`Opt.Task_Dispatching_Policy := 'F';`
233			`Opt.Locking_Policy := 'C';`
234			`P := P + 27;`
235			`goto Line_Loop_Continue;`
236
237			`-- Test for pragma Profile (Restricted);`
238
239			`elsif System_Text (P .. P + 27) =`
240			`"pragma Profile (Restricted);"`
241			`then`
242			`Set_Profile_Restrictions (Restricted);`
243			`P := P + 28;`
244			`goto Line_Loop_Continue;`
245
246			`-- Test for pragma Restrictions`
247
248			`elsif System_Text (P .. P + 20) = "pragma Restrictions (" then`
249			`P := P + 21;`
250
251			`Rloop : for K in All_Boolean_Restrictions loop`
252			`declare`
253			`Rname : constant String := Restriction_Id'Image (K);`
254
255			`begin`
256			`for J in Rname'Range loop`
257			`if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))`
258			`/= Rname (J)`
259			`then`
260			`goto Rloop_Continue;`
261			`end if;`
262			`end loop;`
263
264			`if System_Text (P + Rname'Length) = ')' then`
265			`Restrictions_On_Target.Set (K) := True;`
266			`goto Line_Loop_Continue;`
267			`end if;`
268			`end;`
269
270			`<<Rloop_Continue>>`
271			`null;`
272			`end loop Rloop;`
273
274			`Ploop : for K in All_Parameter_Restrictions loop`
275			`declare`
276			`Rname : constant String :=`
277			`All_Parameter_Restrictions'Image (K);`
278
279			`V : Natural;`
280			`-- Accumulates value`
281
282			`begin`
283			`for J in Rname'Range loop`
284			`if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))`
285			`/= Rname (J)`
286			`then`
287			`goto Ploop_Continue;`
288			`end if;`
289			`end loop;`
290
291			`if System_Text (P + Rname'Length .. P + Rname'Length + 3) =`
292			`" => "`
293			`then`
294			`P := P + Rname'Length + 4;`
295
296			`V := 0;`
297			`loop`
298			`if System_Text (P) in '0' .. '9' then`
299			`declare`
300			`pragma Unsuppress (Overflow_Check);`
301
302			`begin`
303			`-- Accumulate next digit`
304
305			`V := 10 * V +`
306			`Character'Pos (System_Text (P)) -`
307			`Character'Pos ('0');`
308
309			`exception`
310			`-- On overflow, we just ignore the pragma since`
311			`-- that is the standard handling in this case.`
312
313			`when Constraint_Error =>`
314			`goto Line_Loop_Continue;`
315			`end;`
316
317			`elsif System_Text (P) = '_' then`
318			`null;`
319
320			`elsif System_Text (P) = ')' then`
321			`Restrictions_On_Target.Value (K) := V;`
322			`Restrictions_On_Target.Set (K) := True;`
323			`goto Line_Loop_Continue;`
324
325			`else`
326			`exit Ploop;`
327			`end if;`
328
329			`P := P + 1;`
330			`end loop;`
331
332			`else`
333			`exit Ploop;`
334			`end if;`
335			`end;`
336
337			`<<Ploop_Continue>>`
338			`null;`
339			`end loop Ploop;`
340
341			`Set_Standard_Error;`
342			`Write_Line`
343			`("fatal error: system.ads is incorrectly formatted");`
344			`Write_Str ("unrecognized or incorrect restrictions pragma: ");`
345
346			`while System_Text (P) /= ')'`
347			`and then`
348			`System_Text (P) /= ASCII.LF`
349			`loop`
350			`Write_Char (System_Text (P));`
351			`P := P + 1;`
352			`end loop;`
353
354			`Write_Eol;`
355			`Fatal := True;`
356			`Set_Standard_Output;`
357
358			`-- Test for pragma Detect_Blocking;`
359
360			`elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then`
361			`P := P + 23;`
362			`Opt.Detect_Blocking := True;`
363			`goto Line_Loop_Continue;`
364
365			`-- Discard_Names`
366
367			`elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then`
368			`P := P + 21;`
369			`Opt.Global_Discard_Names := True;`
370			`goto Line_Loop_Continue;`
371
372			`-- Locking Policy`
373
374			`elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then`
375			`P := P + 23;`
376			`Opt.Locking_Policy := System_Text (P);`
377			`Opt.Locking_Policy_Sloc := System_Location;`
378			`goto Line_Loop_Continue;`
379
380			`-- Normalize_Scalars`
381
382			`elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then`
383			`P := P + 25;`
384			`Opt.Normalize_Scalars := True;`
385			`Opt.Init_Or_Norm_Scalars := True;`
386			`goto Line_Loop_Continue;`
387
388			`-- Polling (On)`
389
390			`elsif System_Text (P .. P + 19) = "pragma Polling (On);" then`
391			`P := P + 20;`
392			`Opt.Polling_Required := True;`
393			`goto Line_Loop_Continue;`
394
395			`-- Ignore pragma Pure (System)`
396
397			`elsif System_Text (P .. P + 20) = "pragma Pure (System);" then`
398			`P := P + 21;`
399			`goto Line_Loop_Continue;`
400
401			`-- Queuing Policy`
402
403			`elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then`
404			`P := P + 23;`
405			`Opt.Queuing_Policy := System_Text (P);`
406			`Opt.Queuing_Policy_Sloc := System_Location;`
407			`goto Line_Loop_Continue;`
408
409			`-- Suppress_Exception_Locations`
410
411			`elsif System_Text (P .. P + 35) =`
412			`"pragma Suppress_Exception_Locations;"`
413			`then`
414			`P := P + 36;`
415			`Opt.Exception_Locations_Suppressed := True;`
416			`goto Line_Loop_Continue;`
417
418			`-- Task_Dispatching Policy`
419
420			`elsif System_Text (P .. P + 31) =`
421			`"pragma Task_Dispatching_Policy ("`
422			`then`
423			`P := P + 32;`
424			`Opt.Task_Dispatching_Policy := System_Text (P);`
425			`Opt.Task_Dispatching_Policy_Sloc := System_Location;`
426			`goto Line_Loop_Continue;`
427
428			`-- No other pragmas are permitted`
429
430			`elsif System_Text (P .. P + 6) = "pragma " then`
431			`Set_Standard_Error;`
432			`Write_Line ("unrecognized line in system.ads: ");`
433
434			`while System_Text (P) /= ')'`
435			`and then System_Text (P) /= ASCII.LF`
436			`loop`
437			`Write_Char (System_Text (P));`
438			`P := P + 1;`
439			`end loop;`
440
441			`Write_Eol;`
442			`Set_Standard_Output;`
443			`Fatal := True;`
444
445			`-- See if we have a Run_Time_Name`
446
447			`elsif System_Text (P .. P + 38) =`
448			`" Run_Time_Name : constant String := """`
449			`then`
450			`P := P + 39;`
451
452			`Name_Len := 0;`
453			`while System_Text (P) in 'A' .. 'Z'`
454			`or else`
455			`System_Text (P) in 'a' .. 'z'`
456			`or else`
457			`System_Text (P) in '0' .. '9'`
458			`or else`
459			`System_Text (P) = ' '`
460			`or else`
461			`System_Text (P) = '_'`
462			`loop`
463			`Add_Char_To_Name_Buffer (System_Text (P));`
464			`P := P + 1;`
465			`end loop;`
466
467			`if System_Text (P) /= '"'`
468			`or else System_Text (P + 1) /= ';'`
469			`or else (System_Text (P + 2) /= ASCII.LF`
470			`and then`
471			`System_Text (P + 2) /= ASCII.CR)`
472			`then`
473			`Set_Standard_Error;`
474			`Write_Line`
475			`("incorrectly formatted Run_Time_Name in system.ads");`
476			`Set_Standard_Output;`
477			`Fatal := True;`
478
479			`else`
480			`Run_Time_Name_On_Target := Name_Enter;`
481			`end if;`
482
483			`goto Line_Loop_Continue;`
484
485			`-- See if we have an Executable_Extension`
486
487			`elsif System_Text (P .. P + 45) =`
488			`" Executable_Extension : constant String := """`
489			`then`
490			`P := P + 46;`
491
492			`Name_Len := 0;`
493			`while System_Text (P) /= '"'`
494			`and then System_Text (P) /= ASCII.LF`
495			`loop`
496			`Add_Char_To_Name_Buffer (System_Text (P));`
497			`P := P + 1;`
498			`end loop;`
499
500			`if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then`
501			`Set_Standard_Error;`
502			`Write_Line`
503			`("incorrectly formatted Executable_Extension in system.ads");`
504			`Set_Standard_Output;`
505			`Fatal := True;`
506
507			`else`
508			`Executable_Extension_On_Target := Name_Enter;`
509			`end if;`
510
511			`goto Line_Loop_Continue;`
512
513			`-- Next see if we have a configuration parameter`
514
515			`else`
516			`Config_Param_Loop : for K in Targparm_Tags loop`
517			`if System_Text (P + 3 .. P + 2 + Targparm_Str (K)'Length) =`
518			`Targparm_Str (K).all`
519			`then`
520			`P := P + 3 + Targparm_Str (K)'Length;`
521
522			`if Targparm_Flags (K) then`
523			`Set_Standard_Error;`
524			`Write_Line`
525			`("fatal error: system.ads is incorrectly formatted");`
526			`Write_Str ("duplicate line for parameter: ");`
527
528			`for J in Targparm_Str (K)'Range loop`
529			`Write_Char (Targparm_Str (K).all (J));`
530			`end loop;`
531
532			`Write_Eol;`
533			`Set_Standard_Output;`
534			`Fatal := True;`
535
536			`else`
537			`Targparm_Flags (K) := True;`
538			`end if;`
539
540			`while System_Text (P) /= ':'`
541			`or else System_Text (P + 1) /= '='`
542			`loop`
543			`P := P + 1;`
544			`end loop;`
545
546			`P := P + 2;`
547
548			`while System_Text (P) = ' ' loop`
549			`P := P + 1;`
550			`end loop;`
551
552			`Result := (System_Text (P) = 'T');`
553
554			`case K is`
555			`when AAM => AAMP_On_Target := Result;`
556			`when ACR => Always_Compatible_Rep_On_Target := Result;`
557			`when BDC => Backend_Divide_Checks_On_Target := Result;`
558			`when BOC => Backend_Overflow_Checks_On_Target := Result;`
559			`when CLA => Command_Line_Args_On_Target := Result;`
560			`when CLI =>`
561			`if Result then`
562			`VM_Target := CLI_Target;`
563			`Tagged_Type_Expansion := False;`
564			`end if;`
565
566			`when CRT => Configurable_Run_Time_On_Target := Result;`
567			`when D32 => Duration_32_Bits_On_Target := Result;`
568			`when DEN => Denorm_On_Target := Result;`
569			`when EXS => Exit_Status_Supported_On_Target := Result;`
570			`when FEL => Frontend_Layout_On_Target := Result;`
571			`when FFO => Fractional_Fixed_Ops_On_Target := Result;`
572			`when JVM =>`
573			`if Result then`
574			`VM_Target := JVM_Target;`
575			`Tagged_Type_Expansion := False;`
576			`end if;`
577
578			`when MOV => Machine_Overflows_On_Target := Result;`
579			`when MRN => Machine_Rounds_On_Target := Result;`
580			`when PAS => Preallocated_Stacks_On_Target := Result;`
581			`when RTX => RTX_RTSS_Kernel_Module_On_Target := Result;`
582			`when S64 => Support_64_Bit_Divides_On_Target := Result;`
583			`when SAG => Support_Aggregates_On_Target := Result;`
584			`when SCA => Support_Composite_Assign_On_Target := Result;`
585			`when SCC => Support_Composite_Compare_On_Target := Result;`
586			`when SCD => Stack_Check_Default_On_Target := Result;`
587			`when SCL => Stack_Check_Limits_On_Target := Result;`
588			`when SCP => Stack_Check_Probes_On_Target := Result;`
589			`when SLS => Support_Long_Shifts_On_Target := Result;`
590			`when SSL => Suppress_Standard_Library_On_Target := Result;`
591			`when SNZ => Signed_Zeros_On_Target := Result;`
592			`when UAM => Use_Ada_Main_Program_Name_On_Target := Result;`
593			`when VMS => OpenVMS_On_Target := Result;`
594			`when ZCD => ZCX_By_Default_On_Target := Result;`
595			`when ZCG => GCC_ZCX_Support_On_Target := Result;`
596
597			`goto Line_Loop_Continue;`
598			`end case;`
599
600			`-- Here we are seeing a parameter we do not understand. We`
601			`-- simply ignore this (will happen when an old compiler is`
602			`-- used to compile a newer version of GNAT which does not`
603			`-- support the parameter).`
604			`end if;`
605			`end loop Config_Param_Loop;`
606			`end if;`
607
608			`-- Here after processing one line of System spec`
609
610			`<<Line_Loop_Continue>>`
611
612			`while System_Text (P) /= CR and then System_Text (P) /= LF loop`
613			`P := P + 1;`
614			`exit when P >= Source_Last;`
615			`end loop;`
616
617			`while System_Text (P) = CR or else System_Text (P) = LF loop`
618			`P := P + 1;`
619			`exit when P >= Source_Last;`
620			`end loop;`
621
622			`if P >= Source_Last then`
623			`Set_Standard_Error;`
624			`Write_Line ("fatal error, system.ads not formatted correctly");`
625			`Write_Line ("unexpected end of file");`
626			`Set_Standard_Output;`
627			`raise Unrecoverable_Error;`
628			`end if;`
629			`end loop Line_Loop;`
630
631			`-- Now that OpenVMS_On_Target has been given its definitive value,`
632			`-- change the multi-unit index character from '~' to '$' for OpenVMS.`
633
634			`if OpenVMS_On_Target then`
635			`Multi_Unit_Index_Character := '$';`
636			`end if;`
637
638			`if Fatal then`
639			`raise Unrecoverable_Error;`
640			`end if;`
641			`end Get_Target_Parameters;`
642
643			`------------------------------`
644			`-- Set_Profile_Restrictions --`
645			`------------------------------`
646
647			`procedure Set_Profile_Restrictions (P : Profile_Name) is`
648			`R : Restriction_Flags renames Profile_Info (P).Set;`
649			`V : Restriction_Values renames Profile_Info (P).Value;`
650			`begin`
651			`for J in R'Range loop`
652			`if R (J) then`
653			`Restrictions_On_Target.Set (J) := True;`
654
655			`if J in All_Parameter_Restrictions then`
656			`Restrictions_On_Target.Value (J) := V (J);`
657			`end if;`
658			`end if;`
659			`end loop;`
660			`end Set_Profile_Restrictions;`
661
662			`end Targparm;`