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