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-2013, 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       RTX,  --   RTX_RTSS_Kernel_Module
  59       SAG,  --   Support_Aggregates
  60       SAP,  --   Support_Atomic_Primitives
  61       SCA,  --   Support_Composite_Assign
  62       SCC,  --   Support_Composite_Compare
  63       SCD,  --   Stack_Check_Default
  64       SCL,  --   Stack_Check_Limits
  65       SCP,  --   Stack_Check_Probes
  66       SLS,  --   Support_Long_Shifts
  67       SNZ,  --   Signed_Zeros
  68       SSL,  --   Suppress_Standard_Library
  69       UAM,  --   Use_Ada_Main_Program_Name
  70       VMS,  --   OpenVMS
  71       VXF,  --   VAX Float
  72       ZCD); --   ZCX_By_Default
  73
  74    Targparm_Flags : array (Targparm_Tags) of Boolean := (others => False);
  75    --  Flag is set True if corresponding parameter is scanned
  76
  77    --  The following list of string constants gives the parameter names
  78
  79    AAM_Str : aliased constant Source_Buffer := "AAMP";
  80    ACR_Str : aliased constant Source_Buffer := "Always_Compatible_Rep";
  81    ASD_Str : aliased constant Source_Buffer := "Atomic_Sync_Default";
  82    BDC_Str : aliased constant Source_Buffer := "Backend_Divide_Checks";
  83    BOC_Str : aliased constant Source_Buffer := "Backend_Overflow_Checks";
  84    CLA_Str : aliased constant Source_Buffer := "Command_Line_Args";
  85    CLI_Str : aliased constant Source_Buffer := "CLI";
  86    CRT_Str : aliased constant Source_Buffer := "Configurable_Run_Time";
  87    D32_Str : aliased constant Source_Buffer := "Duration_32_Bits";
  88    DEN_Str : aliased constant Source_Buffer := "Denorm";
  89    EXS_Str : aliased constant Source_Buffer := "Exit_Status_Supported";
  90    FEL_Str : aliased constant Source_Buffer := "Frontend_Layout";
  91    FFO_Str : aliased constant Source_Buffer := "Fractional_Fixed_Ops";
  92    JVM_Str : aliased constant Source_Buffer := "JVM";
  93    MOV_Str : aliased constant Source_Buffer := "Machine_Overflows";
  94    MRN_Str : aliased constant Source_Buffer := "Machine_Rounds";
  95    PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks";
  96    RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module";
  97    SAG_Str : aliased constant Source_Buffer := "Support_Aggregates";
  98    SAP_Str : aliased constant Source_Buffer := "Support_Atomic_Primitives";
  99    SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign";
 100    SCC_Str : aliased constant Source_Buffer := "Support_Composite_Compare";
 101    SCD_Str : aliased constant Source_Buffer := "Stack_Check_Default";
 102    SCL_Str : aliased constant Source_Buffer := "Stack_Check_Limits";
 103    SCP_Str : aliased constant Source_Buffer := "Stack_Check_Probes";
 104    SLS_Str : aliased constant Source_Buffer := "Support_Long_Shifts";
 105    SNZ_Str : aliased constant Source_Buffer := "Signed_Zeros";
 106    SSL_Str : aliased constant Source_Buffer := "Suppress_Standard_Library";
 107    UAM_Str : aliased constant Source_Buffer := "Use_Ada_Main_Program_Name";
 108    VMS_Str : aliased constant Source_Buffer := "OpenVMS";
 109    VXF_Str : aliased constant Source_Buffer := "VAX_Float";
 110    ZCD_Str : aliased constant Source_Buffer := "ZCX_By_Default";
 111
 112    --  The following defines a set of pointers to the above strings,
 113    --  indexed by the tag values.
 114
 115    type Buffer_Ptr is access constant Source_Buffer;
 116    Targparm_Str : constant array (Targparm_Tags) of Buffer_Ptr :=
 117      (AAM_Str'Access,
 118       ACR_Str'Access,
 119       ASD_Str'Access,
 120       BDC_Str'Access,
 121       BOC_Str'Access,
 122       CLA_Str'Access,
 123       CLI_Str'Access,
 124       CRT_Str'Access,
 125       D32_Str'Access,
 126       DEN_Str'Access,
 127       EXS_Str'Access,
 128       FEL_Str'Access,
 129       FFO_Str'Access,
 130       JVM_Str'Access,
 131       MOV_Str'Access,
 132       MRN_Str'Access,
 133       PAS_Str'Access,
 134       RTX_Str'Access,
 135       SAG_Str'Access,
 136       SAP_Str'Access,
 137       SCA_Str'Access,
 138       SCC_Str'Access,
 139       SCD_Str'Access,
 140       SCL_Str'Access,
 141       SCP_Str'Access,
 142       SLS_Str'Access,
 143       SNZ_Str'Access,
 144       SSL_Str'Access,
 145       UAM_Str'Access,
 146       VMS_Str'Access,
 147       VXF_Str'Access,
 148       ZCD_Str'Access);
 149
 150    -----------------------
 151    -- Local Subprograms --
 152    -----------------------
 153
 154    procedure Set_Profile_Restrictions (P : Profile_Name);
 155    --  Set Restrictions_On_Target for the given profile
 156
 157    ---------------------------
 158    -- Get_Target_Parameters --
 159    ---------------------------
 160
 161    --  Version which reads in system.ads
 162
 163    procedure Get_Target_Parameters is
 164       Text : Source_Buffer_Ptr;
 165       Hi   : Source_Ptr;
 166
 167    begin
 168       if Parameters_Obtained then
 169          return;
 170       end if;
 171
 172       Name_Buffer (1 .. 10) := "system.ads";
 173       Name_Len := 10;
 174
 175       Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text);
 176
 177       if Text = null then
 178          Write_Line ("fatal error, run-time library not installed correctly");
 179          Write_Line ("cannot locate file system.ads");
 180          raise Unrecoverable_Error;
 181       end if;
 182
 183       Get_Target_Parameters
 184         (System_Text  => Text,
 185          Source_First => 0,
 186          Source_Last  => Hi);
 187    end Get_Target_Parameters;
 188
 189    --  Version where caller supplies system.ads text
 190
 191    procedure Get_Target_Parameters
 192      (System_Text  : Source_Buffer_Ptr;
 193       Source_First : Source_Ptr;
 194       Source_Last  : Source_Ptr)
 195    is
 196       P : Source_Ptr;
 197       --  Scans source buffer containing source of system.ads
 198
 199       Fatal : Boolean := False;
 200       --  Set True if a fatal error is detected
 201
 202       Result : Boolean;
 203       --  Records boolean from system line
 204
 205    begin
 206       if Parameters_Obtained then
 207          return;
 208       else
 209          Parameters_Obtained := True;
 210       end if;
 211
 212       Opt.Address_Is_Private := False;
 213
 214       P := Source_First;
 215       Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop
 216
 217          --  Skip comments quickly
 218
 219          if System_Text (P) = '-' then
 220             goto Line_Loop_Continue;
 221
 222          --  Test for type Address is private
 223
 224          elsif System_Text (P .. P + 26) = "   type Address is private;" then
 225             Opt.Address_Is_Private := True;
 226             P := P + 26;
 227             goto Line_Loop_Continue;
 228
 229          --  Test for pragma Profile (Ravenscar);
 230
 231          elsif System_Text (P .. P + 26) =
 232                  "pragma Profile (Ravenscar);"
 233          then
 234             Set_Profile_Restrictions (Ravenscar);
 235             Opt.Task_Dispatching_Policy := 'F';
 236             Opt.Locking_Policy          := 'C';
 237             P := P + 27;
 238             goto Line_Loop_Continue;
 239
 240          --  Test for pragma Profile (Restricted);
 241
 242          elsif System_Text (P .. P + 27) =
 243                  "pragma Profile (Restricted);"
 244          then
 245             Set_Profile_Restrictions (Restricted);
 246             P := P + 28;
 247             goto Line_Loop_Continue;
 248
 249          --  Test for pragma Restrictions
 250
 251          elsif System_Text (P .. P + 20) = "pragma Restrictions (" then
 252             P := P + 21;
 253
 254             Rloop : for K in All_Boolean_Restrictions loop
 255                declare
 256                   Rname : constant String := Restriction_Id'Image (K);
 257
 258                begin
 259                   for J in Rname'Range loop
 260                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 261                                                         /= Rname (J)
 262                      then
 263                         goto Rloop_Continue;
 264                      end if;
 265                   end loop;
 266
 267                   if System_Text (P + Rname'Length) = ')' then
 268                      Restrictions_On_Target.Set (K) := True;
 269                      goto Line_Loop_Continue;
 270                   end if;
 271                end;
 272
 273             <<Rloop_Continue>>
 274                null;
 275             end loop Rloop;
 276
 277             Ploop : for K in All_Parameter_Restrictions loop
 278                declare
 279                   Rname : constant String :=
 280                             All_Parameter_Restrictions'Image (K);
 281
 282                   V : Natural;
 283                   --  Accumulates value
 284
 285                begin
 286                   for J in Rname'Range loop
 287                      if Fold_Upper (System_Text (P + Source_Ptr (J - 1)))
 288                                                         /= Rname (J)
 289                      then
 290                         goto Ploop_Continue;
 291                      end if;
 292                   end loop;
 293
 294                   if System_Text (P + Rname'Length .. P + Rname'Length + 3) =
 295                                                       " => "
 296                   then
 297                      P := P + Rname'Length + 4;
 298
 299                      V := 0;
 300                      loop
 301                         if System_Text (P) in '0' .. '9' then
 302                            declare
 303                               pragma Unsuppress (Overflow_Check);
 304
 305                            begin
 306                               --  Accumulate next digit
 307
 308                               V := 10 * V +
 309                                    Character'Pos (System_Text (P)) -
 310                                    Character'Pos ('0');
 311
 312                            exception
 313                               --  On overflow, we just ignore the pragma since
 314                               --  that is the standard handling in this case.
 315
 316                               when Constraint_Error =>
 317                                  goto Line_Loop_Continue;
 318                            end;
 319
 320                         elsif System_Text (P) = '_' then
 321                            null;
 322
 323                         elsif System_Text (P) = ')' then
 324                            Restrictions_On_Target.Value (K) := V;
 325                            Restrictions_On_Target.Set (K) := True;
 326                            goto Line_Loop_Continue;
 327
 328                         else
 329                            exit Ploop;
 330                         end if;
 331
 332                         P := P + 1;
 333                      end loop;
 334
 335                   else
 336                      exit Ploop;
 337                   end if;
 338                end;
 339
 340             <<Ploop_Continue>>
 341                null;
 342             end loop Ploop;
 343
 344             Set_Standard_Error;
 345             Write_Line
 346                ("fatal error: system.ads is incorrectly formatted");
 347             Write_Str ("unrecognized or incorrect restrictions pragma: ");
 348
 349             while System_Text (P) /= ')'
 350                     and then
 351                   System_Text (P) /= ASCII.LF
 352             loop
 353                Write_Char (System_Text (P));
 354                P := P + 1;
 355             end loop;
 356
 357             Write_Eol;
 358             Fatal := True;
 359             Set_Standard_Output;
 360
 361          --  Test for pragma Detect_Blocking;
 362
 363          elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then
 364             P := P + 23;
 365             Opt.Detect_Blocking := True;
 366             goto Line_Loop_Continue;
 367
 368          --  Discard_Names
 369
 370          elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then
 371             P := P + 21;
 372             Opt.Global_Discard_Names := True;
 373             goto Line_Loop_Continue;
 374
 375          --  Locking Policy
 376
 377          elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then
 378             P := P + 23;
 379             Opt.Locking_Policy := System_Text (P);
 380             Opt.Locking_Policy_Sloc := System_Location;
 381             goto Line_Loop_Continue;
 382
 383          --  Normalize_Scalars
 384
 385          elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then
 386             P := P + 25;
 387             Opt.Normalize_Scalars := True;
 388             Opt.Init_Or_Norm_Scalars := True;
 389             goto Line_Loop_Continue;
 390
 391          --  Partition_Elaboration_Policy
 392
 393          elsif System_Text (P .. P + 36) =
 394                  "pragma Partition_Elaboration_Policy ("
 395          then
 396             P := P + 37;
 397             Opt.Partition_Elaboration_Policy := System_Text (P);
 398             Opt.Partition_Elaboration_Policy_Sloc := System_Location;
 399             goto Line_Loop_Continue;
 400
 401          --  Polling (On)
 402
 403          elsif System_Text (P .. P + 19) = "pragma Polling (On);" then
 404             P := P + 20;
 405             Opt.Polling_Required := True;
 406             goto Line_Loop_Continue;
 407
 408          --  Ignore pragma Pure (System)
 409
 410          elsif System_Text (P .. P + 20) = "pragma Pure (System);" then
 411             P := P + 21;
 412             goto Line_Loop_Continue;
 413
 414          --  Queuing Policy
 415
 416          elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then
 417             P := P + 23;
 418             Opt.Queuing_Policy := System_Text (P);
 419             Opt.Queuing_Policy_Sloc := System_Location;
 420             goto Line_Loop_Continue;
 421
 422          --  Suppress_Exception_Locations
 423
 424          elsif System_Text (P .. P + 35) =
 425                                    "pragma Suppress_Exception_Locations;"
 426          then
 427             P := P + 36;
 428             Opt.Exception_Locations_Suppressed := True;
 429             goto Line_Loop_Continue;
 430
 431          --  Task_Dispatching Policy
 432
 433          elsif System_Text (P .. P + 31) =
 434                                    "pragma Task_Dispatching_Policy ("
 435          then
 436             P := P + 32;
 437             Opt.Task_Dispatching_Policy := System_Text (P);
 438             Opt.Task_Dispatching_Policy_Sloc := System_Location;
 439             goto Line_Loop_Continue;
 440
 441          --  No other pragmas are permitted
 442
 443          elsif System_Text (P .. P + 6) = "pragma " then
 444             Set_Standard_Error;
 445             Write_Line ("unrecognized line in system.ads: ");
 446
 447             while System_Text (P) /= ')'
 448               and then System_Text (P) /= ASCII.LF
 449             loop
 450                Write_Char (System_Text (P));
 451                P := P + 1;
 452             end loop;
 453
 454             Write_Eol;
 455             Set_Standard_Output;
 456             Fatal := True;
 457
 458          --  See if we have a Run_Time_Name
 459
 460          elsif System_Text (P .. P + 38) =
 461                   "   Run_Time_Name : constant String := """
 462          then
 463             P := P + 39;
 464
 465             Name_Len := 0;
 466             while System_Text (P) in 'A' .. 'Z'
 467                     or else
 468                   System_Text (P) in 'a' .. 'z'
 469                     or else
 470                   System_Text (P) in '0' .. '9'
 471                     or else
 472                   System_Text (P) = ' '
 473                     or else
 474                   System_Text (P) = '_'
 475             loop
 476                Add_Char_To_Name_Buffer (System_Text (P));
 477                P := P + 1;
 478             end loop;
 479
 480             if System_Text (P) /= '"'
 481               or else System_Text (P + 1) /= ';'
 482               or else (System_Text (P + 2) /= ASCII.LF
 483                          and then
 484                        System_Text (P + 2) /= ASCII.CR)
 485             then
 486                Set_Standard_Error;
 487                Write_Line
 488                  ("incorrectly formatted Run_Time_Name in system.ads");
 489                Set_Standard_Output;
 490                Fatal := True;
 491
 492             else
 493                Run_Time_Name_On_Target := Name_Enter;
 494             end if;
 495
 496             goto Line_Loop_Continue;
 497
 498          --  See if we have an Executable_Extension
 499
 500          elsif System_Text (P .. P + 45) =
 501                   "   Executable_Extension : constant String := """
 502          then
 503             P := P + 46;
 504
 505             Name_Len := 0;
 506             while System_Text (P) /= '"'
 507               and then System_Text (P) /= ASCII.LF
 508             loop
 509                Add_Char_To_Name_Buffer (System_Text (P));
 510                P := P + 1;
 511             end loop;
 512
 513             if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then
 514                Set_Standard_Error;
 515                Write_Line
 516                  ("incorrectly formatted Executable_Extension in system.ads");
 517                Set_Standard_Output;
 518                Fatal := True;
 519
 520             else
 521                Executable_Extension_On_Target := Name_Enter;
 522             end if;
 523
 524             goto Line_Loop_Continue;
 525
 526          --  Next see if we have a configuration parameter
 527
 528          else
 529             Config_Param_Loop : for K in Targparm_Tags loop
 530                if System_Text (P + 3 .. P + 2 + Targparm_Str (K)'Length) =
 531                                                       Targparm_Str (K).all
 532                then
 533                   P := P + 3 + Targparm_Str (K)'Length;
 534
 535                   if Targparm_Flags (K) then
 536                      Set_Standard_Error;
 537                      Write_Line
 538                        ("fatal error: system.ads is incorrectly formatted");
 539                      Write_Str ("duplicate line for parameter: ");
 540
 541                      for J in Targparm_Str (K)'Range loop
 542                         Write_Char (Targparm_Str (K).all (J));
 543                      end loop;
 544
 545                      Write_Eol;
 546                      Set_Standard_Output;
 547                      Fatal := True;
 548
 549                   else
 550                      Targparm_Flags (K) := True;
 551                   end if;
 552
 553                   while System_Text (P) /= ':'
 554                      or else System_Text (P + 1) /= '='
 555                   loop
 556                      P := P + 1;
 557                   end loop;
 558
 559                   P := P + 2;
 560
 561                   while System_Text (P) = ' ' loop
 562                      P := P + 1;
 563                   end loop;
 564
 565                   Result := (System_Text (P) = 'T');
 566
 567                   case K is
 568                      when AAM => AAMP_On_Target                      := Result;
 569                      when ACR => Always_Compatible_Rep_On_Target     := Result;
 570                      when ASD => Atomic_Sync_Default_On_Target       := Result;
 571                      when BDC => Backend_Divide_Checks_On_Target     := Result;
 572                      when BOC => Backend_Overflow_Checks_On_Target   := Result;
 573                      when CLA => Command_Line_Args_On_Target         := Result;
 574                      when CLI =>
 575                         if Result then
 576                            VM_Target := CLI_Target;
 577                            Tagged_Type_Expansion := False;
 578                         end if;
 579                         --  This is wrong, this processing should be done in
 580                         --  Gnat1drv.Adjust_Global_Switches. It is not the
 581                         --  right level for targparm to know about tagged
 582                         --  type extension???
 583
 584                      when CRT => Configurable_Run_Time_On_Target     := Result;
 585                      when D32 => Duration_32_Bits_On_Target          := Result;
 586                      when DEN => Denorm_On_Target                    := Result;
 587                      when EXS => Exit_Status_Supported_On_Target     := Result;
 588                      when FEL => Frontend_Layout_On_Target           := Result;
 589                      when FFO => Fractional_Fixed_Ops_On_Target      := Result;
 590                      when JVM =>
 591                         if Result then
 592                            VM_Target := JVM_Target;
 593                            Tagged_Type_Expansion := False;
 594                         end if;
 595                         --  This is wrong, this processing should be done in
 596                         --  Gnat1drv.Adjust_Global_Switches. It is not the
 597                         --  right level for targparm to know about tagged
 598                         --  type extension???
 599
 600                      when MOV => Machine_Overflows_On_Target         := Result;
 601                      when MRN => Machine_Rounds_On_Target            := Result;
 602                      when PAS => Preallocated_Stacks_On_Target       := Result;
 603                      when RTX => RTX_RTSS_Kernel_Module_On_Target    := Result;
 604                      when SAG => Support_Aggregates_On_Target        := Result;
 605                      when SAP => Support_Atomic_Primitives_On_Target := Result;
 606                      when SCA => Support_Composite_Assign_On_Target  := Result;
 607                      when SCC => Support_Composite_Compare_On_Target := Result;
 608                      when SCD => Stack_Check_Default_On_Target       := Result;
 609                      when SCL => Stack_Check_Limits_On_Target        := Result;
 610                      when SCP => Stack_Check_Probes_On_Target        := Result;
 611                      when SLS => Support_Long_Shifts_On_Target       := Result;
 612                      when SSL => Suppress_Standard_Library_On_Target := Result;
 613                      when SNZ => Signed_Zeros_On_Target              := Result;
 614                      when UAM => Use_Ada_Main_Program_Name_On_Target := Result;
 615                      when VMS => OpenVMS_On_Target                   := Result;
 616                      when VXF => VAX_Float_On_Target                 := Result;
 617                      when ZCD => ZCX_By_Default_On_Target            := Result;
 618
 619                      goto Line_Loop_Continue;
 620                   end case;
 621
 622                   --  Here we are seeing a parameter we do not understand. We
 623                   --  simply ignore this (will happen when an old compiler is
 624                   --  used to compile a newer version of GNAT which does not
 625                   --  support the parameter).
 626                end if;
 627             end loop Config_Param_Loop;
 628          end if;
 629
 630          --  Here after processing one line of System spec
 631
 632          <<Line_Loop_Continue>>
 633
 634          while System_Text (P) /= CR and then System_Text (P) /= LF loop
 635             P := P + 1;
 636             exit when P >= Source_Last;
 637          end loop;
 638
 639          while System_Text (P) = CR or else System_Text (P) = LF loop
 640             P := P + 1;
 641             exit when P >= Source_Last;
 642          end loop;
 643
 644          if P >= Source_Last then
 645             Set_Standard_Error;
 646             Write_Line ("fatal error, system.ads not formatted correctly");
 647             Write_Line ("unexpected end of file");
 648             Set_Standard_Output;
 649             raise Unrecoverable_Error;
 650          end if;
 651       end loop Line_Loop;
 652
 653       --  Now that OpenVMS_On_Target has been given its definitive value,
 654       --  change the multi-unit index character from '~' to '$' for OpenVMS.
 655
 656       if OpenVMS_On_Target then
 657          Multi_Unit_Index_Character := '$';
 658       end if;
 659
 660       if Fatal then
 661          raise Unrecoverable_Error;
 662       end if;
 663    end Get_Target_Parameters;
 664
 665    ------------------------------
 666    -- Set_Profile_Restrictions --
 667    ------------------------------
 668
 669    procedure Set_Profile_Restrictions (P : Profile_Name) is
 670       R : Restriction_Flags  renames Profile_Info (P).Set;
 671       V : Restriction_Values renames Profile_Info (P).Value;
 672    begin
 673       for J in R'Range loop
 674          if R (J) then
 675             Restrictions_On_Target.Set (J) := True;
 676
 677             if J in All_Parameter_Restrictions then
 678                Restrictions_On_Target.Value (J) := V (J);
 679             end if;
 680          end if;
 681       end loop;
 682    end Set_Profile_Restrictions;
 683
 684 end Targparm;