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