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