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