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