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-2020, 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;
  28 with Osint;         use Osint;
  29 with Output;        use Output;
  30 with System.OS_Lib; use System.OS_Lib;
  31
  32 package body Targparm is
  33    use ASCII;
  34
  35    Parameters_Obtained : Boolean := False;
  36    --  Set True after first call to Get_Target_Parameters. Used to avoid
  37    --  reading system.ads more than once, since it cannot change.
  38
  39    --  The following array defines a tag name for each entry
  40
  41    type Targparm_Tags is
  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       CRT,  --   Configurable_Run_Times
  48       D32,  --   Duration_32_Bits
  49       DEN,  --   Denorm
  50       EXS,  --   Exit_Status_Supported
  51       FEX,  --   Frontend_Exceptions
  52       MOV,  --   Machine_Overflows
  53       MRN,  --   Machine_Rounds
  54       PAS,  --   Preallocated_Stacks
  55       SAG,  --   Support_Aggregates
  56       SAP,  --   Support_Atomic_Primitives
  57       SCA,  --   Support_Composite_Assign
  58       SCC,  --   Support_Composite_Compare
  59       SCD,  --   Stack_Check_Default
  60       SCL,  --   Stack_Check_Limits
  61       SCP,  --   Stack_Check_Probes
  62       SLS,  --   Support_Long_Shifts
  63       SNZ,  --   Signed_Zeros
  64       SSL,  --   Suppress_Standard_Library
  65       UAM,  --   Use_Ada_Main_Program_Name
  66       ZCX); --   ZCX_By_Default
  67
  68    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
  69    --  Flag is set True if corresponding parameter is scanned
  70
  71    --  The following list of string constants gives the parameter names
  72
  73    ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";
  74    ASD_Str : aliased constant Source_Buffer := "Atomic_Sync_Default";
  75    BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
  76    BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
  77    CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
  78    CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
  79    D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
  80    DEN_Str : aliased constant Source_Buffer := "Denorm";
  81    EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
  82    FEX_Str : aliased constant Source_Buffer := "Frontend_Exceptions";
  83    MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
  84    MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
  85    PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
  86    SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
  87    SAP_Str : aliased constant Source_Buffer := "Support_Atomic_Primitives";
  88    SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
  89    SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
  90    SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
  91    SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
  92    SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
  93    SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
  94    SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
  95    SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
  96    UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
  97    ZCX_Str : aliased constant Source_Buffer := "ZCX_By_Default";
  98
  99    --  The following defines a set of pointers to the above strings,
 100    --  indexed by the tag values.
 101
 102    type Buffer_Ptr is access constant Source_Buffer;
 103    Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
 104      (ACR => ACR_Str'Access,
 105       ASD => ASD_Str'Access,
 106       BDC => BDC_Str'Access,
 107       BOC => BOC_Str'Access,
 108       CLA => CLA_Str'Access,
 109       CRT => CRT_Str'Access,
 110       D32 => D32_Str'Access,
 111       DEN => DEN_Str'Access,
 112       EXS => EXS_Str'Access,
 113       FEX => FEX_Str'Access,
 114       MOV => MOV_Str'Access,
 115       MRN => MRN_Str'Access,
 116       PAS => PAS_Str'Access,
 117       SAG => SAG_Str'Access,
 118       SAP => SAP_Str'Access,
 119       SCA => SCA_Str'Access,
 120       SCC => SCC_Str'Access,
 121       SCD => SCD_Str'Access,
 122       SCL => SCL_Str'Access,
 123       SCP => SCP_Str'Access,
 124       SLS => SLS_Str'Access,
 125       SNZ => SNZ_Str'Access,
 126       SSL => SSL_Str'Access,
 127       UAM => UAM_Str'Access,
 128       ZCX => ZCX_Str'Access);
 129
 130    -----------------------
 131    -- Local Subprograms --
 132    -----------------------
 133
 134    procedure Set_Profile_Restrictions (P : Profile_Name);
 135    --  Set Restrictions_On_Target for the given profile
 136
 137    ---------------------------
 138    -- Get_Target_Parameters --
 139    ---------------------------
 140
 141    --  Version that reads in system.ads
 142
 143    procedure Get_Target_Parameters
 144      (Make_Id : Make_Id_Type := null;
 145       Make_SC : Make_SC_Type := null;
 146       Set_NOD : Set_NOD_Type := null;
 147       Set_NSA : Set_NSA_Type := null;
 148       Set_NUA : Set_NUA_Type := null;
 149       Set_NUP : Set_NUP_Type := null)
 150    is
 151       FD   : File_Descriptor;
 152       Hi   : Source_Ptr;
 153       Text : Source_Buffer_Ptr;
 154
 155    begin
 156       if Parameters_Obtained then
 157          return;
 158       end if;
 159
 160       Name_Buffer (1 .. 10) := "system.ads";
 161       Name_Len := 10;
 162
 163       Read_Source_File (Name_Find, 0, Hi, Text, FD);
 164
 165       if Null_Source_Buffer_Ptr (Text) then
 166          Write_Line ("fatal error, run-time library not installed correctly");
 167
 168          if FD = Null_FD then
 169             Write_Line ("cannot locate file system.ads");
 170          else
 171             Write_Line ("no read access for file system.ads");
 172          end if;
 173
 174          raise Unrecoverable_Error;
 175       end if;
 176
 177       Get_Target_Parameters
 178         (System_Text  => Text,
 179          Source_First => 0,
 180          Source_Last  => Hi,
 181          Make_Id      => Make_Id,
 182          Make_SC      => Make_SC,
 183          Set_NOD      => Set_NOD,
 184          Set_NSA      => Set_NSA,
 185          Set_NUA      => Set_NUA,
 186          Set_NUP      => Set_NUP);
 187    end Get_Target_Parameters;
 188
 189    --  Version where caller supplies system.ads text
 190
 191    procedure Get_Target_Parameters
 192      (System_Text  : Source_Buffer_Ptr;
 193       Source_First : Source_Ptr;
 194       Source_Last  : Source_Ptr;
 195       Make_Id      : Make_Id_Type := null;
 196       Make_SC      : Make_SC_Type := null;
 197       Set_NOD      : Set_NOD_Type := null;
 198       Set_NSA      : Set_NSA_Type := null;
 199       Set_NUA      : Set_NUA_Type := null;
 200       Set_NUP      : Set_NUP_Type := null)
 201    is
 202       pragma Assert (System_Text'First = Source_First);
 203       pragma Assert (System_Text'Last = Source_Last);
 204
 205       P : Source_Ptr;
 206       --  Scans source buffer containing source of system.ads
 207
 208       Fatal : Boolean := False;
 209       --  Set True if a fatal error is detected
 210
 211       Result : Boolean;
 212       --  Records boolean from system line
 213
 214       OK : Boolean;
 215       --  Status result from Set_NUP/NSA/NUA call
 216
 217       PR_Start : Source_Ptr;
 218       --  Pointer to ( following pragma Restrictions
 219
 220       procedure Collect_Name;
 221       --  Scan a name starting at System_Text (P), and put Name in Name_Buffer,
 222       --  with Name_Len being length, folded to lower case. On return, P points
 223       --  just past the last character (which should be a right paren).
 224
 225       function Looking_At (S : Source_Buffer) return Boolean;
 226       --  True if P points to the same text as S in System_Text
 227
 228       function Looking_At_Skip (S : Source_Buffer) return Boolean;
 229       --  True if P points to the same text as S in System_Text,
 230       --  and if True, moves P forward to skip S as a side effect.
 231
 232       ------------------
 233       -- Collect_Name --
 234       ------------------
 235
 236       procedure Collect_Name is
 237       begin
 238          Name_Len := 0;
 239          loop
 240             if System_Text (P) in 'a' .. 'z'
 241               or else
 242                 System_Text (P) = '_'
 243               or else
 244                 System_Text (P) in '0' .. '9'
 245             then
 246                Name_Buffer (Name_Len + 1) := System_Text (P);
 247
 248             elsif System_Text (P) in 'A' .. 'Z' then
 249                Name_Buffer (Name_Len + 1) :=
 250                  Character'Val (Character'Pos (System_Text (P)) + 32);
 251
 252             else
 253                exit;
 254             end if;
 255
 256             P := P + 1;
 257             Name_Len := Name_Len + 1;
 258          end loop;
 259       end Collect_Name;
 260
 261       ----------------
 262       -- Looking_At --
 263       ----------------
 264
 265       function Looking_At (S : Source_Buffer) return Boolean is
 266          Last : constant Source_Ptr := P + S'Length - 1;
 267       begin
 268          return Last <= System_Text'Last
 269            and then System_Text (P .. Last) = S;
 270       end Looking_At;
 271
 272       ---------------------
 273       -- Looking_At_Skip --
 274       ---------------------
 275
 276       function Looking_At_Skip (S : Source_Buffer) return Boolean is
 277          Result : constant Boolean := Looking_At (S);
 278       begin
 279          if Result then
 280             P := P + S'Length;
 281          end if;
 282
 283          return Result;
 284       end Looking_At_Skip;
 285
 286    --  Start of processing for Get_Target_Parameters
 287
 288    begin
 289       if Parameters_Obtained then
 290          return;
 291       end if;
 292
 293       Parameters_Obtained := True;
 294       Opt.Address_Is_Private := False;
 295
 296       --  Loop through source lines
 297
 298       --  Note: in the case or pragmas, we are only interested in pragmas that
 299       --  appear as configuration pragmas. These are left justified, so they
 300       --  do not have three spaces at the start. Pragmas appearing within the
 301       --  package (like Pure and No_Elaboration_Code_All) will have the three
 302       --  spaces at the start and so will be ignored.
 303
 304       --  For a special exception, see processing for pragma Pure below
 305
 306       P := Source_First;
 307
 308       while not Looking_At ("end System;") loop
 309          --  Skip comments
 310
 311          if Looking_At ("-") then
 312             goto Line_Loop_Continue;
 313
 314          --  Test for type Address is private
 315
 316          elsif Looking_At_Skip ("   type Address is private;") then
 317             Opt.Address_Is_Private := True;
 318             goto Line_Loop_Continue;
 319
 320          --  Test for pragma Profile (Ravenscar);
 321
 322          elsif Looking_At_Skip ("pragma Profile (Ravenscar);") then
 323             Set_Profile_Restrictions (Ravenscar);
 324             Opt.Task_Dispatching_Policy := 'F';
 325             Opt.Locking_Policy          := 'C';
 326             goto Line_Loop_Continue;
 327
 328          --  Test for pragma Profile (Jorvik);
 329
 330          elsif Looking_At_Skip ("pragma Profile (Jorvik);") then
 331             Set_Profile_Restrictions (Jorvik);
 332             Opt.Task_Dispatching_Policy := 'F';
 333             Opt.Locking_Policy          := 'C';
 334             goto Line_Loop_Continue;
 335
 336          --  Test for pragma Profile (GNAT_Extended_Ravenscar);
 337
 338          elsif Looking_At_Skip
 339            ("pragma Profile (GNAT_Extended_Ravenscar);")
 340          then
 341             Set_Profile_Restrictions (GNAT_Extended_Ravenscar);
 342             Opt.Task_Dispatching_Policy := 'F';
 343             Opt.Locking_Policy          := 'C';
 344             goto Line_Loop_Continue;
 345
 346          --  Test for pragma Profile (GNAT_Ravenscar_EDF);
 347
 348          elsif Looking_At_Skip ("pragma Profile (GNAT_Ravenscar_EDF);") then
 349             Set_Profile_Restrictions (GNAT_Ravenscar_EDF);
 350             Opt.Task_Dispatching_Policy := 'E';
 351             Opt.Locking_Policy          := 'C';
 352             goto Line_Loop_Continue;
 353
 354          --  Test for pragma Profile (Restricted);
 355
 356          elsif Looking_At_Skip ("pragma Profile (Restricted);") then
 357             Set_Profile_Restrictions (Restricted);
 358             goto Line_Loop_Continue;
 359
 360          --  Test for pragma Restrictions
 361
 362          elsif Looking_At_Skip ("pragma Restrictions (") then
 363             PR_Start := P - 1;
 364
 365             --  Boolean restrictions
 366
 367             for K in All_Boolean_Restrictions loop
 368                declare
 369                   Rname : constant String := Restriction_Id'Image (K);
 370
 371                begin
 372                   for J in Rname'Range loop
 373                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 374                                                         /= Rname (J)
 375                      then
 376                         goto Rloop_Continue;
 377                      end if;
 378                   end loop;
 379
 380                   if System_Text (P + Rname'Length) = ')' then
 381                      Restrictions_On_Target.Set (K) := True;
 382                      goto Line_Loop_Continue;
 383                   end if;
 384                end;
 385
 386                <<Rloop_Continue>> null;
 387             end loop;
 388
 389             --  Restrictions taking integer parameter
 390
 391             Ploop : for K in Integer_Parameter_Restrictions loop
 392                declare
 393                   Rname : constant String :=
 394                             All_Parameter_Restrictions'Image (K);
 395
 396                   V : Natural;
 397                   --  Accumulates value
 398
 399                begin
 400                   for J in Rname'Range loop
 401                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 402                                                         /= Rname (J)
 403                      then
 404                         goto Ploop_Continue;
 405                      end if;
 406                   end loop;
 407
 408                   if System_Text (P + Rname'Length .. P + Rname'Length + 3) =
 409                                                       " => "
 410                   then
 411                      P := P + Rname'Length + 4;
 412
 413                      V := 0;
 414                      loop
 415                         if System_Text (P) in '0' .. '9' then
 416                            declare
 417                               pragma Unsuppress (Overflow_Check);
 418
 419                            begin
 420                               --  Accumulate next digit
 421
 422                               V := 10 * V +
 423                                    Character'Pos (System_Text (P)) -
 424                                    Character'Pos ('0');
 425
 426                            exception
 427                               --  On overflow, we just ignore the pragma since
 428                               --  that is the standard handling in this case.
 429
 430                               when Constraint_Error =>
 431                                  goto Line_Loop_Continue;
 432                            end;
 433
 434                         elsif System_Text (P) = '_' then
 435                            null;
 436
 437                         elsif System_Text (P) = ')' then
 438                            Restrictions_On_Target.Value (K) := V;
 439                            Restrictions_On_Target.Set (K) := True;
 440                            goto Line_Loop_Continue;
 441
 442                         else
 443                            exit Ploop;
 444                         end if;
 445
 446                         P := P + 1;
 447                      end loop;
 448
 449                   else
 450                      exit Ploop;
 451                   end if;
 452                end;
 453
 454                <<Ploop_Continue>> null;
 455             end loop Ploop;
 456
 457             --  No_Dependence case
 458
 459             if Looking_At_Skip ("No_Dependence => ") then
 460                --  Skip this processing (and simply ignore No_Dependence lines)
 461                --  if caller did not supply the three subprograms we need to
 462                --  process these lines.
 463
 464                if Make_Id = null then
 465                   goto Line_Loop_Continue;
 466                end if;
 467
 468                --  We have scanned out "pragma Restrictions (No_Dependence =>"
 469
 470                declare
 471                   Unit  : Node_Id;
 472                   Id    : Node_Id;
 473                   Start : Source_Ptr;
 474
 475                begin
 476                   Unit := Empty;
 477
 478                   --  Loop through components of name, building up Unit
 479
 480                   loop
 481                      Start := P;
 482                      while System_Text (P) /= '.'
 483                              and then
 484                            System_Text (P) /= ')'
 485                      loop
 486                         P := P + 1;
 487                      end loop;
 488
 489                      Id := Make_Id (System_Text (Start .. P - 1));
 490
 491                      --  If first name, just capture the identifier
 492
 493                      if Unit = Empty then
 494                         Unit := Id;
 495                      else
 496                         Unit := Make_SC (Unit, Id);
 497                      end if;
 498
 499                      exit when System_Text (P) = ')';
 500                      P := P + 1;
 501                   end loop;
 502
 503                   Set_NOD (Unit);
 504                   goto Line_Loop_Continue;
 505                end;
 506
 507             --  No_Specification_Of_Aspect case
 508
 509             elsif Looking_At_Skip ("No_Specification_Of_Aspect => ") then
 510                --  Skip this processing (and simply ignore the pragma), if
 511                --  caller did not supply the subprogram we need to process
 512                --  such lines.
 513
 514                if Set_NSA = null then
 515                   goto Line_Loop_Continue;
 516                end if;
 517
 518                --  We have scanned
 519                --    "pragma Restrictions (No_Specification_Of_Aspect =>"
 520
 521                Collect_Name;
 522
 523                if System_Text (P) /= ')' then
 524                   goto Bad_Restrictions_Pragma;
 525
 526                else
 527                   Set_NSA (Name_Find, OK);
 528
 529                   if OK then
 530                      goto Line_Loop_Continue;
 531                   else
 532                      goto Bad_Restrictions_Pragma;
 533                   end if;
 534                end if;
 535
 536             --  No_Use_Of_Attribute case
 537
 538             elsif Looking_At_Skip ("No_Use_Of_Attribute => ") then
 539                --  Skip this processing (and simply ignore No_Use_Of_Attribute
 540                --  lines) if caller did not supply the subprogram we need to
 541                --  process such lines.
 542
 543                if Set_NUA = null then
 544                   goto Line_Loop_Continue;
 545                end if;
 546
 547                --  We have scanned
 548                --    "pragma Restrictions (No_Use_Of_Attribute =>"
 549
 550                Collect_Name;
 551
 552                if System_Text (P) /= ')' then
 553                   goto Bad_Restrictions_Pragma;
 554
 555                else
 556                   Set_NUA (Name_Find, OK);
 557
 558                   if OK then
 559                      goto Line_Loop_Continue;
 560                   else
 561                      goto Bad_Restrictions_Pragma;
 562                   end if;
 563                end if;
 564
 565             --  No_Use_Of_Pragma case
 566
 567             elsif Looking_At_Skip ("No_Use_Of_Pragma => ") then
 568                --  Skip this processing (and simply ignore No_Use_Of_Pragma
 569                --  lines) if caller did not supply the subprogram we need to
 570                --  process such lines.
 571
 572                if Set_NUP = null then
 573                   goto Line_Loop_Continue;
 574                end if;
 575
 576                --  We have scanned
 577                --    "pragma Restrictions (No_Use_Of_Pragma =>"
 578
 579                Collect_Name;
 580
 581                if System_Text (P) /= ')' then
 582                   goto Bad_Restrictions_Pragma;
 583
 584                else
 585                   Set_NUP (Name_Find, OK);
 586
 587                   if OK then
 588                      goto Line_Loop_Continue;
 589                   else
 590                      goto Bad_Restrictions_Pragma;
 591                   end if;
 592                end if;
 593             end if;
 594
 595             --  Here if unrecognizable restrictions pragma form
 596
 597             <<Bad_Restrictions_Pragma>>
 598
 599             Set_Standard_Error;
 600             Write_Line
 601                ("fatal error: system.ads is incorrectly formatted");
 602             Write_Str ("unrecognized or incorrect restrictions pragma: ");
 603
 604             P := PR_Start;
 605             loop
 606                exit when System_Text (P) = ASCII.LF;
 607                Write_Char (System_Text (P));
 608                exit when System_Text (P) = ')';
 609                P := P + 1;
 610             end loop;
 611
 612             Write_Eol;
 613             Fatal := True;
 614             Set_Standard_Output;
 615
 616          --  Test for pragma Detect_Blocking;
 617
 618          elsif Looking_At_Skip ("pragma Detect_Blocking;") then
 619             Opt.Detect_Blocking := True;
 620             goto Line_Loop_Continue;
 621
 622          --  Discard_Names
 623
 624          elsif Looking_At_Skip ("pragma Discard_Names;") then
 625             Opt.Global_Discard_Names := True;
 626             goto Line_Loop_Continue;
 627
 628          --  Locking Policy
 629
 630          elsif Looking_At_Skip ("pragma Locking_Policy (") then
 631             Opt.Locking_Policy := System_Text (P);
 632             Opt.Locking_Policy_Sloc := System_Location;
 633             goto Line_Loop_Continue;
 634
 635          --  Normalize_Scalars
 636
 637          elsif Looking_At_Skip ("pragma Normalize_Scalars;") then
 638             Opt.Normalize_Scalars := True;
 639             Opt.Init_Or_Norm_Scalars := True;
 640             goto Line_Loop_Continue;
 641
 642          --  Partition_Elaboration_Policy
 643
 644          elsif Looking_At_Skip ("pragma Partition_Elaboration_Policy (") then
 645             Opt.Partition_Elaboration_Policy := System_Text (P);
 646             Opt.Partition_Elaboration_Policy_Sloc := System_Location;
 647             goto Line_Loop_Continue;
 648
 649          --  Queuing Policy
 650
 651          elsif Looking_At_Skip ("pragma Queuing_Policy (") then
 652             Opt.Queuing_Policy := System_Text (P);
 653             Opt.Queuing_Policy_Sloc := System_Location;
 654             goto Line_Loop_Continue;
 655
 656          --  Suppress_Exception_Locations
 657
 658          elsif Looking_At_Skip ("pragma Suppress_Exception_Locations;") then
 659             Opt.Exception_Locations_Suppressed := True;
 660             goto Line_Loop_Continue;
 661
 662          --  Task_Dispatching Policy
 663
 664          elsif Looking_At_Skip ("pragma Task_Dispatching_Policy (") then
 665             Opt.Task_Dispatching_Policy := System_Text (P);
 666             Opt.Task_Dispatching_Policy_Sloc := System_Location;
 667             goto Line_Loop_Continue;
 668
 669          --  No other configuration pragmas are permitted
 670
 671          elsif Looking_At ("pragma ") then
 672             --  Special exception, we allow pragma Pure (System) appearing in
 673             --  column one. This is an obsolete usage which may show up in old
 674             --  tests with an obsolete version of system.ads, so we recognize
 675             --  and ignore it to make life easier in handling such tests.
 676
 677             if Looking_At_Skip ("pragma Pure (System);") then
 678                goto Line_Loop_Continue;
 679             end if;
 680
 681             Set_Standard_Error;
 682             Write_Line ("unrecognized line in system.ads: ");
 683
 684             while System_Text (P) /= ')'
 685               and then System_Text (P) /= ASCII.LF
 686             loop
 687                Write_Char (System_Text (P));
 688                P := P + 1;
 689             end loop;
 690
 691             Write_Eol;
 692             Set_Standard_Output;
 693             Fatal := True;
 694
 695          --  See if we have a Run_Time_Name
 696
 697          elsif Looking_At_Skip
 698            ("   Run_Time_Name : constant String := """)
 699          then
 700             Name_Len := 0;
 701             while System_Text (P) in 'A' .. 'Z'
 702                     or else
 703                   System_Text (P) in 'a' .. 'z'
 704                     or else
 705                   System_Text (P) in '0' .. '9'
 706                     or else
 707                   System_Text (P) = ' '
 708                     or else
 709                   System_Text (P) = '_'
 710             loop
 711                Add_Char_To_Name_Buffer (System_Text (P));
 712                P := P + 1;
 713             end loop;
 714
 715             if System_Text (P) /= '"'
 716               or else System_Text (P + 1) /= ';'
 717               or else (System_Text (P + 2) /= ASCII.LF
 718                          and then
 719                        System_Text (P + 2) /= ASCII.CR)
 720             then
 721                Set_Standard_Error;
 722                Write_Line
 723                  ("incorrectly formatted Run_Time_Name in system.ads");
 724                Set_Standard_Output;
 725                Fatal := True;
 726
 727             else
 728                Run_Time_Name_On_Target := Name_Enter;
 729             end if;
 730
 731             goto Line_Loop_Continue;
 732
 733          --  See if we have an Executable_Extension
 734
 735          elsif Looking_At_Skip
 736            ("   Executable_Extension : constant String := """)
 737          then
 738             Name_Len := 0;
 739             while System_Text (P) /= '"'
 740               and then System_Text (P) /= ASCII.LF
 741             loop
 742                Add_Char_To_Name_Buffer (System_Text (P));
 743                P := P + 1;
 744             end loop;
 745
 746             if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then
 747                Set_Standard_Error;
 748                Write_Line
 749                  ("incorrectly formatted Executable_Extension in system.ads");
 750                Set_Standard_Output;
 751                Fatal := True;
 752
 753             else
 754                Executable_Extension_On_Target := Name_Enter;
 755             end if;
 756
 757             goto Line_Loop_Continue;
 758
 759          --  Next see if we have a configuration parameter
 760
 761          else
 762             Config_Param_Loop : for K in Targparm_Tags loop
 763                if Looking_At_Skip ("   " & Targparm_Str (K).all) then
 764                   if Targparm_Flags (K) then
 765                      Set_Standard_Error;
 766                      Write_Line
 767                        ("fatal error: system.ads is incorrectly formatted");
 768                      Write_Str ("duplicate line for parameter: ");
 769
 770                      for J in Targparm_Str (K)'Range loop
 771                         Write_Char (Targparm_Str (K).all (J));
 772                      end loop;
 773
 774                      Write_Eol;
 775                      Set_Standard_Output;
 776                      Fatal := True;
 777
 778                   else
 779                      Targparm_Flags (K) := True;
 780                   end if;
 781
 782                   while System_Text (P) /= ':'
 783                      or else System_Text (P + 1) /= '='
 784                   loop
 785                      P := P + 1;
 786                   end loop;
 787
 788                   P := P + 2;
 789
 790                   while System_Text (P) = ' ' loop
 791                      P := P + 1;
 792                   end loop;
 793
 794                   Result := (System_Text (P) = 'T');
 795
 796                   case K is
 797                      when ACR => Always_Compatible_Rep_On_Target     := Result;
 798                      when ASD => Atomic_Sync_Default_On_Target       := Result;
 799                      when BDC => Backend_Divide_Checks_On_Target     := Result;
 800                      when BOC => Backend_Overflow_Checks_On_Target   := Result;
 801                      when CLA => Command_Line_Args_On_Target         := Result;
 802                      when CRT => Configurable_Run_Time_On_Target     := Result;
 803                      when D32 => Duration_32_Bits_On_Target          := Result;
 804                      when DEN => Denorm_On_Target                    := Result;
 805                      when EXS => Exit_Status_Supported_On_Target     := Result;
 806                      when FEX => Frontend_Exceptions_On_Target       := Result;
 807                      when MOV => Machine_Overflows_On_Target         := Result;
 808                      when MRN => Machine_Rounds_On_Target            := Result;
 809                      when PAS => Preallocated_Stacks_On_Target       := Result;
 810                      when SAG => Support_Aggregates_On_Target        := Result;
 811                      when SAP => Support_Atomic_Primitives_On_Target := Result;
 812                      when SCA => Support_Composite_Assign_On_Target  := Result;
 813                      when SCC => Support_Composite_Compare_On_Target := Result;
 814                      when SCD => Stack_Check_Default_On_Target       := Result;
 815                      when SCL => Stack_Check_Limits_On_Target        := Result;
 816                      when SCP => Stack_Check_Probes_On_Target        := Result;
 817                      when SLS => Support_Long_Shifts_On_Target       := Result;
 818                      when SSL => Suppress_Standard_Library_On_Target := Result;
 819                      when SNZ => Signed_Zeros_On_Target              := Result;
 820                      when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
 821                      when ZCX => ZCX_By_Default_On_Target            := Result;
 822
 823                      goto Line_Loop_Continue;
 824                   end case;
 825
 826                   --  Here we are seeing a parameter we do not understand. We
 827                   --  simply ignore this (will happen when an old compiler is
 828                   --  used to compile a newer version of GNAT which does not
 829                   --  support the parameter).
 830                end if;
 831             end loop Config_Param_Loop;
 832          end if;
 833
 834          --  Here after processing one line of System spec
 835
 836          <<Line_Loop_Continue>>
 837
 838          while P < Source_Last
 839            and then System_Text (P) /= CR
 840            and then System_Text (P) /= LF
 841          loop
 842             P := P + 1;
 843          end loop;
 844
 845          while P < Source_Last
 846            and then (System_Text (P) = CR
 847                        or else System_Text (P) = LF)
 848          loop
 849             P := P + 1;
 850          end loop;
 851
 852          if P >= Source_Last then
 853             Set_Standard_Error;
 854             Write_Line ("fatal error, system.ads not formatted correctly");
 855             Write_Line ("unexpected end of file");
 856             Set_Standard_Output;
 857             raise Unrecoverable_Error;
 858          end if;
 859       end loop;
 860
 861       if Fatal then
 862          raise Unrecoverable_Error;
 863       end if;
 864    end Get_Target_Parameters;
 865
 866    ------------------------------
 867    -- Set_Profile_Restrictions --
 868    ------------------------------
 869
 870    procedure Set_Profile_Restrictions (P : Profile_Name) is
 871       R : Restriction_Flags  renames Profile_Info (P).Set;
 872       V : Restriction_Values renames Profile_Info (P).Value;
 873    begin
 874       for J in R'Range loop
 875          if R (J) then
 876             Restrictions_On_Target.Set (J) := True;
 877
 878             if J in All_Parameter_Restrictions then
 879                Restrictions_On_Target.Value (J) := V (J);
 880             end if;
 881          end if;
 882       end loop;
 883    end Set_Profile_Restrictions;
 884
 885 end Targparm;