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