gcc/ada/targparm.adb

   1 ------------------------------------------------------------------------------
   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-2014, 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       ASD,  --   Atomic_Sync_Default
  44       BDC,  --   Backend_Divide_Checks
  45       BOC,  --   Backend_Overflow_Checks
  46       CLA,  --   Command_Line_Args
  47       CLI,  --   CLI (.NET)
  48       CRT,  --   Configurable_Run_Times
  49       D32,  --   Duration_32_Bits
  50       DEN,  --   Denorm
  51       EXS,  --   Exit_Status_Supported
  52       FEL,  --   Frontend_Layout
  53       FFO,  --   Fractional_Fixed_Ops
  54       JVM,  --   JVM
  55       MOV,  --   Machine_Overflows
  56       MRN,  --   Machine_Rounds
  57       PAS,  --   Preallocated_Stacks
  58       SAG,  --   Support_Aggregates
  59       SAP,  --   Support_Atomic_Primitives
  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       ZCD); --   ZCX_By_Default
  70
  71    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
  72    --  Flag is set True if corresponding parameter is scanned
  73
  74    --  The following list of string constants gives the parameter names
  75
  76    AAM_Str : aliased constant Source_Buffer := "AAMP";
  77    ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";
  78    ASD_Str : aliased constant Source_Buffer := "Atomic_Sync_Default";
  79    BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
  80    BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
  81    CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
  82    CLI_Str : aliased constant Source_Buffer := "CLI";
  83    CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
  84    D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
  85    DEN_Str : aliased constant Source_Buffer := "Denorm";
  86    EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
  87    FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
  88    FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
  89    JVM_Str : aliased constant Source_Buffer := "JVM";
  90    MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
  91    MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
  92    PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
  93    SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
  94    SAP_Str : aliased constant Source_Buffer := "Support_Atomic_Primitives";
  95    SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
  96    SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
  97    SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
  98    SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
  99    SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
 100    SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
 101    SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
 102    SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
 103    UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
 104    ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
 105
 106    --  The following defines a set of pointers to the above strings,
 107    --  indexed by the tag values.
 108
 109    type Buffer_Ptr is access constant Source_Buffer;
 110    Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
 111      (AAM_Str'Access,
 112       ACR_Str'Access,
 113       ASD_Str'Access,
 114       BDC_Str'Access,
 115       BOC_Str'Access,
 116       CLA_Str'Access,
 117       CLI_Str'Access,
 118       CRT_Str'Access,
 119       D32_Str'Access,
 120       DEN_Str'Access,
 121       EXS_Str'Access,
 122       FEL_Str'Access,
 123       FFO_Str'Access,
 124       JVM_Str'Access,
 125       MOV_Str'Access,
 126       MRN_Str'Access,
 127       PAS_Str'Access,
 128       SAG_Str'Access,
 129       SAP_Str'Access,
 130       SCA_Str'Access,
 131       SCC_Str'Access,
 132       SCD_Str'Access,
 133       SCL_Str'Access,
 134       SCP_Str'Access,
 135       SLS_Str'Access,
 136       SNZ_Str'Access,
 137       SSL_Str'Access,
 138       UAM_Str'Access,
 139       ZCD_Str'Access);
 140
 141    -----------------------
 142    -- Local Subprograms --
 143    -----------------------
 144
 145    procedure Set_Profile_Restrictions (P : Profile_Name);
 146    --  Set Restrictions_On_Target for the given profile
 147
 148    ---------------------------
 149    -- Get_Target_Parameters --
 150    ---------------------------
 151
 152    --  Version which reads in system.ads
 153
 154    procedure Get_Target_Parameters
 155      (Make_Id : Make_Id_Type := null;
 156       Make_SC : Make_SC_Type := null;
 157       Set_RND : Set_RND_Type := null)
 158    is
 159       Text : Source_Buffer_Ptr;
 160       Hi   : Source_Ptr;
 161
 162    begin
 163       if Parameters_Obtained then
 164          return;
 165       end if;
 166
 167       Name_Buffer (1 .. 10) := "system.ads";
 168       Name_Len := 10;
 169
 170       Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
 171
 172       if Text = null then
 173          Write_Line ("fatal error, run-time library not installed correctly");
 174          Write_Line ("cannot locate file system.ads");
 175          raise Unrecoverable_Error;
 176       end if;
 177
 178       Get_Target_Parameters
 179         (System_Text  => Text,
 180          Source_First => 0,
 181          Source_Last  => Hi,
 182          Make_Id      => Make_Id,
 183          Make_SC      => Make_SC,
 184          Set_RND      => Set_RND);
 185    end Get_Target_Parameters;
 186
 187    --  Version where caller supplies system.ads text
 188
 189    procedure Get_Target_Parameters
 190      (System_Text  : Source_Buffer_Ptr;
 191       Source_First : Source_Ptr;
 192       Source_Last  : Source_Ptr;
 193       Make_Id      : Make_Id_Type := null;
 194       Make_SC      : Make_SC_Type := null;
 195       Set_RND      : Set_RND_Type := null)
 196    is
 197       P : Source_Ptr;
 198       --  Scans source buffer containing source of system.ads
 199
 200       Fatal : Boolean := False;
 201       --  Set True if a fatal error is detected
 202
 203       Result : Boolean;
 204       --  Records boolean from system line
 205
 206    begin
 207       if Parameters_Obtained then
 208          return;
 209       else
 210          Parameters_Obtained := True;
 211       end if;
 212
 213       Opt.Address_Is_Private := False;
 214
 215       --  Loop through source lines
 216
 217       --  Note: in the case or pragmas, we are only interested in pragmas that
 218       --  appear as configuration pragmas. These are left justified, so they
 219       --  do not have three spaces at the start. Pragmas appearing within the
 220       --  package (like Pure and No_Elaboration_Code_All) will have the three
 221       --  spaces at the start and so will be ignored.
 222
 223       --  For a special exception, see processing for pragma Pure below
 224
 225       P := Source_First;
 226       Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop
 227
 228          --  Skip comments quickly
 229
 230          if System_Text (P) = '-' then
 231             goto Line_Loop_Continue;
 232
 233          --  Test for type Address is private
 234
 235          elsif System_Text (P .. P + 26) = "   type Address is private;" then
 236             Opt.Address_Is_Private := True;
 237             P := P + 26;
 238             goto Line_Loop_Continue;
 239
 240          --  Test for pragma Profile (Ravenscar);
 241
 242          elsif System_Text (P .. P + 26) =
 243                  "pragma Profile (Ravenscar);"
 244          then
 245             Set_Profile_Restrictions (Ravenscar);
 246             Opt.Task_Dispatching_Policy := 'F';
 247             Opt.Locking_Policy          := 'C';
 248             P := P + 27;
 249             goto Line_Loop_Continue;
 250
 251          --  Test for pragma Profile (Restricted);
 252
 253          elsif System_Text (P .. P + 27) =
 254                  "pragma Profile (Restricted);"
 255          then
 256             Set_Profile_Restrictions (Restricted);
 257             P := P + 28;
 258             goto Line_Loop_Continue;
 259
 260          --  Test for pragma Restrictions
 261
 262          elsif System_Text (P .. P + 20) = "pragma Restrictions (" then
 263             P := P + 21;
 264
 265             Rloop : for K in All_Boolean_Restrictions loop
 266                declare
 267                   Rname : constant String := Restriction_Id'Image (K);
 268
 269                begin
 270                   for J in Rname'Range loop
 271                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 272                                                         /= Rname (J)
 273                      then
 274                         goto Rloop_Continue;
 275                      end if;
 276                   end loop;
 277
 278                   if System_Text (P + Rname'Length) = ')' then
 279                      Restrictions_On_Target.Set (K) := True;
 280                      goto Line_Loop_Continue;
 281                   end if;
 282                end;
 283
 284             <<Rloop_Continue>>
 285                null;
 286             end loop Rloop;
 287
 288             Ploop : for K in All_Parameter_Restrictions loop
 289                declare
 290                   Rname : constant String :=
 291                             All_Parameter_Restrictions'Image (K);
 292
 293                   V : Natural;
 294                   --  Accumulates value
 295
 296                begin
 297                   for J in Rname'Range loop
 298                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 299                                                         /= Rname (J)
 300                      then
 301                         goto Ploop_Continue;
 302                      end if;
 303                   end loop;
 304
 305                   if System_Text (P + Rname'Length .. P + Rname'Length + 3) =
 306                                                       " => "
 307                   then
 308                      P := P + Rname'Length + 4;
 309
 310                      V := 0;
 311                      loop
 312                         if System_Text (P) in '0' .. '9' then
 313                            declare
 314                               pragma Unsuppress (Overflow_Check);
 315
 316                            begin
 317                               --  Accumulate next digit
 318
 319                               V := 10 * V +
 320                                    Character'Pos (System_Text (P)) -
 321                                    Character'Pos ('0');
 322
 323                            exception
 324                               --  On overflow, we just ignore the pragma since
 325                               --  that is the standard handling in this case.
 326
 327                               when Constraint_Error =>
 328                                  goto Line_Loop_Continue;
 329                            end;
 330
 331                         elsif System_Text (P) = '_' then
 332                            null;
 333
 334                         elsif System_Text (P) = ')' then
 335                            Restrictions_On_Target.Value (K) := V;
 336                            Restrictions_On_Target.Set (K) := True;
 337                            goto Line_Loop_Continue;
 338
 339                         else
 340                            exit Ploop;
 341                         end if;
 342
 343                         P := P + 1;
 344                      end loop;
 345
 346                   else
 347                      exit Ploop;
 348                   end if;
 349                end;
 350
 351             <<Ploop_Continue>>
 352                null;
 353             end loop Ploop;
 354
 355             --  No_Dependence case
 356
 357             if System_Text (P .. P + 16) = "No_Dependence => " then
 358                P := P + 17;
 359
 360                --  Skip this processing (and simply ignore No_Dependence lines)
 361                --  if caller did not supply the three subprograms we need to
 362                --  process these lines.
 363
 364                if Make_Id = null then
 365                   goto Line_Loop_Continue;
 366                end if;
 367
 368                --  We have scanned out "pragma Restrictions (No_Dependence =>"
 369
 370                declare
 371                   Unit  : Node_Id;
 372                   Id    : Node_Id;
 373                   Start : Source_Ptr;
 374
 375                begin
 376                   Unit := Empty;
 377
 378                   --  Loop through components of name, building up Unit
 379
 380                   loop
 381                      Start := P;
 382                      while System_Text (P) /= '.'
 383                              and then
 384                            System_Text (P) /= ')'
 385                      loop
 386                         P := P + 1;
 387                      end loop;
 388
 389                      Id := Make_Id (System_Text (Start .. P - 1));
 390
 391                      --  If first name, just capture the identifier
 392
 393                      if Unit = Empty then
 394                         Unit := Id;
 395                      else
 396                         Unit := Make_SC (Unit, Id);
 397                      end if;
 398
 399                      exit when System_Text (P) = ')';
 400                      P := P + 1;
 401                   end loop;
 402
 403                   Set_RND (Unit);
 404                   goto Line_Loop_Continue;
 405                end;
 406             end if;
 407
 408             --  Here if unrecognizable restrictions pragma form
 409
 410             Set_Standard_Error;
 411             Write_Line
 412                ("fatal error: system.ads is incorrectly formatted");
 413             Write_Str ("unrecognized or incorrect restrictions pragma: ");
 414
 415             while System_Text (P) /= ')'
 416                     and then
 417                   System_Text (P) /= ASCII.LF
 418             loop
 419                Write_Char (System_Text (P));
 420                P := P + 1;
 421             end loop;
 422
 423             Write_Eol;
 424             Fatal := True;
 425             Set_Standard_Output;
 426
 427          --  Test for pragma Detect_Blocking;
 428
 429          elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then
 430             P := P + 23;
 431             Opt.Detect_Blocking := True;
 432             goto Line_Loop_Continue;
 433
 434          --  Discard_Names
 435
 436          elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then
 437             P := P + 21;
 438             Opt.Global_Discard_Names := True;
 439             goto Line_Loop_Continue;
 440
 441          --  Locking Policy
 442
 443          elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then
 444             P := P + 23;
 445             Opt.Locking_Policy := System_Text (P);
 446             Opt.Locking_Policy_Sloc := System_Location;
 447             goto Line_Loop_Continue;
 448
 449          --  Normalize_Scalars
 450
 451          elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then
 452             P := P + 25;
 453             Opt.Normalize_Scalars := True;
 454             Opt.Init_Or_Norm_Scalars := True;
 455             goto Line_Loop_Continue;
 456
 457          --  Partition_Elaboration_Policy
 458
 459          elsif System_Text (P .. P + 36) =
 460                  "pragma Partition_Elaboration_Policy ("
 461          then
 462             P := P + 37;
 463             Opt.Partition_Elaboration_Policy := System_Text (P);
 464             Opt.Partition_Elaboration_Policy_Sloc := System_Location;
 465             goto Line_Loop_Continue;
 466
 467          --  Polling (On)
 468
 469          elsif System_Text (P .. P + 19) = "pragma Polling (On);" then
 470             P := P + 20;
 471             Opt.Polling_Required := True;
 472             goto Line_Loop_Continue;
 473
 474          --  Queuing Policy
 475
 476          elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then
 477             P := P + 23;
 478             Opt.Queuing_Policy := System_Text (P);
 479             Opt.Queuing_Policy_Sloc := System_Location;
 480             goto Line_Loop_Continue;
 481
 482          --  Suppress_Exception_Locations
 483
 484          elsif System_Text (P .. P + 35) =
 485                                    "pragma Suppress_Exception_Locations;"
 486          then
 487             P := P + 36;
 488             Opt.Exception_Locations_Suppressed := True;
 489             goto Line_Loop_Continue;
 490
 491          --  Task_Dispatching Policy
 492
 493          elsif System_Text (P .. P + 31) =
 494                                    "pragma Task_Dispatching_Policy ("
 495          then
 496             P := P + 32;
 497             Opt.Task_Dispatching_Policy := System_Text (P);
 498             Opt.Task_Dispatching_Policy_Sloc := System_Location;
 499             goto Line_Loop_Continue;
 500
 501          --  No other configuration pragmas are permitted
 502
 503          elsif System_Text (P .. P + 6) = "pragma " then
 504
 505             --  Special exception, we allow pragma Pure (System) appearing in
 506             --  column one. This is an obsolete usage which may show up in old
 507             --  tests with an obsolete version of system.ads, so we recognize
 508             --  and ignore it to make life easier in handling such tests.
 509
 510             if System_Text (P .. P + 20) = "pragma Pure (System);" then
 511                P := P + 21;
 512                goto Line_Loop_Continue;
 513             end if;
 514
 515             Set_Standard_Error;
 516             Write_Line ("unrecognized line in system.ads: ");
 517
 518             while System_Text (P) /= ')'
 519               and then System_Text (P) /= ASCII.LF
 520             loop
 521                Write_Char (System_Text (P));
 522                P := P + 1;
 523             end loop;
 524
 525             Write_Eol;
 526             Set_Standard_Output;
 527             Fatal := True;
 528
 529          --  See if we have a Run_Time_Name
 530
 531          elsif System_Text (P .. P + 38) =
 532                   "   Run_Time_Name : constant String := """
 533          then
 534             P := P + 39;
 535
 536             Name_Len := 0;
 537             while System_Text (P) in 'A' .. 'Z'
 538                     or else
 539                   System_Text (P) in 'a' .. 'z'
 540                     or else
 541                   System_Text (P) in '0' .. '9'
 542                     or else
 543                   System_Text (P) = ' '
 544                     or else
 545                   System_Text (P) = '_'
 546             loop
 547                Add_Char_To_Name_Buffer (System_Text (P));
 548                P := P + 1;
 549             end loop;
 550
 551             if System_Text (P) /= '"'
 552               or else System_Text (P + 1) /= ';'
 553               or else (System_Text (P + 2) /= ASCII.LF
 554                          and then
 555                        System_Text (P + 2) /= ASCII.CR)
 556             then
 557                Set_Standard_Error;
 558                Write_Line
 559                  ("incorrectly formatted Run_Time_Name in system.ads");
 560                Set_Standard_Output;
 561                Fatal := True;
 562
 563             else
 564                Run_Time_Name_On_Target := Name_Enter;
 565             end if;
 566
 567             goto Line_Loop_Continue;
 568
 569          --  See if we have an Executable_Extension
 570
 571          elsif System_Text (P .. P + 45) =
 572                   "   Executable_Extension : constant String := """
 573          then
 574             P := P + 46;
 575
 576             Name_Len := 0;
 577             while System_Text (P) /= '"'
 578               and then System_Text (P) /= ASCII.LF
 579             loop
 580                Add_Char_To_Name_Buffer (System_Text (P));
 581                P := P + 1;
 582             end loop;
 583
 584             if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then
 585                Set_Standard_Error;
 586                Write_Line
 587                  ("incorrectly formatted Executable_Extension in system.ads");
 588                Set_Standard_Output;
 589                Fatal := True;
 590
 591             else
 592                Executable_Extension_On_Target := Name_Enter;
 593             end if;
 594
 595             goto Line_Loop_Continue;
 596
 597          --  Next see if we have a configuration parameter
 598
 599          else
 600             Config_Param_Loop : for K in Targparm_Tags loop
 601                if System_Text (P + 3 .. P + 2 + Targparm_Str (K)'Length) =
 602                                                       Targparm_Str (K).all
 603                then
 604                   P := P + 3 + Targparm_Str (K)'Length;
 605
 606                   if Targparm_Flags (K) then
 607                      Set_Standard_Error;
 608                      Write_Line
 609                        ("fatal error: system.ads is incorrectly formatted");
 610                      Write_Str ("duplicate line for parameter: ");
 611
 612                      for J in Targparm_Str (K)'Range loop
 613                         Write_Char (Targparm_Str (K).all (J));
 614                      end loop;
 615
 616                      Write_Eol;
 617                      Set_Standard_Output;
 618                      Fatal := True;
 619
 620                   else
 621                      Targparm_Flags (K) := True;
 622                   end if;
 623
 624                   while System_Text (P) /= ':'
 625                      or else System_Text (P + 1) /= '='
 626                   loop
 627                      P := P + 1;
 628                   end loop;
 629
 630                   P := P + 2;
 631
 632                   while System_Text (P) = ' ' loop
 633                      P := P + 1;
 634                   end loop;
 635
 636                   Result := (System_Text (P) = 'T');
 637
 638                   case K is
 639                      when AAM => AAMP_On_Target                      := Result;
 640                      when ACR => Always_Compatible_Rep_On_Target     := Result;
 641                      when ASD => Atomic_Sync_Default_On_Target       := Result;
 642                      when BDC => Backend_Divide_Checks_On_Target     := Result;
 643                      when BOC => Backend_Overflow_Checks_On_Target   := Result;
 644                      when CLA => Command_Line_Args_On_Target         := Result;
 645                      when CLI =>
 646                         if Result then
 647                            VM_Target := CLI_Target;
 648                            Tagged_Type_Expansion := False;
 649                         end if;
 650                         --  This is wrong, this processing should be done in
 651                         --  Gnat1drv.Adjust_Global_Switches. It is not the
 652                         --  right level for targparm to know about tagged
 653                         --  type extension???
 654
 655                      when CRT => Configurable_Run_Time_On_Target     := Result;
 656                      when D32 => Duration_32_Bits_On_Target          := Result;
 657                      when DEN => Denorm_On_Target                    := Result;
 658                      when EXS => Exit_Status_Supported_On_Target     := Result;
 659                      when FEL => Frontend_Layout_On_Target           := Result;
 660                      when FFO => Fractional_Fixed_Ops_On_Target      := Result;
 661
 662                      when JVM =>
 663                         if Result then
 664                            VM_Target := JVM_Target;
 665                            Tagged_Type_Expansion := False;
 666                         end if;
 667                         --  This is wrong, this processing should be done in
 668                         --  Gnat1drv.Adjust_Global_Switches. It is not the
 669                         --  right level for targparm to know about tagged
 670                         --  type extension???
 671
 672                      when MOV => Machine_Overflows_On_Target         := Result;
 673                      when MRN => Machine_Rounds_On_Target            := Result;
 674                      when PAS => Preallocated_Stacks_On_Target       := Result;
 675                      when SAG => Support_Aggregates_On_Target        := Result;
 676                      when SAP => Support_Atomic_Primitives_On_Target := Result;
 677                      when SCA => Support_Composite_Assign_On_Target  := Result;
 678                      when SCC => Support_Composite_Compare_On_Target := Result;
 679                      when SCD => Stack_Check_Default_On_Target       := Result;
 680                      when SCL => Stack_Check_Limits_On_Target        := Result;
 681                      when SCP => Stack_Check_Probes_On_Target        := Result;
 682                      when SLS => Support_Long_Shifts_On_Target       := Result;
 683                      when SSL => Suppress_Standard_Library_On_Target := Result;
 684                      when SNZ => Signed_Zeros_On_Target              := Result;
 685                      when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
 686                      when ZCD => ZCX_By_Default_On_Target            := Result;
 687
 688                      goto Line_Loop_Continue;
 689                   end case;
 690
 691                   --  Here we are seeing a parameter we do not understand. We
 692                   --  simply ignore this (will happen when an old compiler is
 693                   --  used to compile a newer version of GNAT which does not
 694                   --  support the parameter).
 695                end if;
 696             end loop Config_Param_Loop;
 697          end if;
 698
 699          --  Here after processing one line of System spec
 700
 701          <<Line_Loop_Continue>>
 702
 703          while System_Text (P) /= CR and then System_Text (P) /= LF loop
 704             P := P + 1;
 705             exit when P >= Source_Last;
 706          end loop;
 707
 708          while System_Text (P) = CR or else System_Text (P) = LF loop
 709             P := P + 1;
 710             exit when P >= Source_Last;
 711          end loop;
 712
 713          if P >= Source_Last then
 714             Set_Standard_Error;
 715             Write_Line ("fatal error, system.ads not formatted correctly");
 716             Write_Line ("unexpected end of file");
 717             Set_Standard_Output;
 718             raise Unrecoverable_Error;
 719          end if;
 720       end loop Line_Loop;
 721
 722       if Fatal then
 723          raise Unrecoverable_Error;
 724       end if;
 725    end Get_Target_Parameters;
 726
 727    ------------------------------
 728    -- Set_Profile_Restrictions --
 729    ------------------------------
 730
 731    procedure Set_Profile_Restrictions (P : Profile_Name) is
 732       R : Restriction_Flags  renames Profile_Info (P).Set;
 733       V : Restriction_Values renames Profile_Info (P).Value;
 734    begin
 735       for J in R'Range loop
 736          if R (J) then
 737             Restrictions_On_Target.Set (J) := True;
 738
 739             if J in All_Parameter_Restrictions then
 740                Restrictions_On_Target.Value (J) := V (J);
 741             end if;
 742          end if;
 743       end loop;
 744    end Set_Profile_Restrictions;
 745
 746 end Targparm;