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