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