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-2014, 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 26with Csets; use Csets; 27with Opt; use Opt; 28with Osint; use Osint; 29with Output; use Output; 30 31package 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_RND : Set_RND_Type := null) 158 is 159 Text : Source_Buffer_Ptr; 160 Hi : Source_Ptr; 161 162 begin 163 if Parameters_Obtained then 164 return; 165 end if; 166 167 Name_Buffer (1 .. 10) := "system.ads"; 168 Name_Len := 10; 169 170 Read_Source_File (Name_Find, Lo => 0, Hi => Hi, Src => Text); 171 172 if Text = null then 173 Write_Line ("fatal error, run-time library not installed correctly"); 174 Write_Line ("cannot locate file system.ads"); 175 raise Unrecoverable_Error; 176 end if; 177 178 Get_Target_Parameters 179 (System_Text => Text, 180 Source_First => 0, 181 Source_Last => Hi, 182 Make_Id => Make_Id, 183 Make_SC => Make_SC, 184 Set_RND => Set_RND); 185 end Get_Target_Parameters; 186 187 -- Version where caller supplies system.ads text 188 189 procedure Get_Target_Parameters 190 (System_Text : Source_Buffer_Ptr; 191 Source_First : Source_Ptr; 192 Source_Last : Source_Ptr; 193 Make_Id : Make_Id_Type := null; 194 Make_SC : Make_SC_Type := null; 195 Set_RND : Set_RND_Type := null) 196 is 197 P : Source_Ptr; 198 -- Scans source buffer containing source of system.ads 199 200 Fatal : Boolean := False; 201 -- Set True if a fatal error is detected 202 203 Result : Boolean; 204 -- Records boolean from system line 205 206 begin 207 if Parameters_Obtained then 208 return; 209 else 210 Parameters_Obtained := True; 211 end if; 212 213 Opt.Address_Is_Private := False; 214 215 -- Loop through source lines 216 217 -- Note: in the case or pragmas, we are only interested in pragmas that 218 -- appear as configuration pragmas. These are left justified, so they 219 -- do not have three spaces at the start. Pragmas appearing within the 220 -- package (like Pure and No_Elaboration_Code_All) will have the three 221 -- spaces at the start and so will be ignored. 222 223 -- For a special exception, see processing for pragma Pure below 224 225 P := Source_First; 226 Line_Loop : while System_Text (P .. P + 10) /= "end System;" loop 227 228 -- Skip comments quickly 229 230 if System_Text (P) = '-' then 231 goto Line_Loop_Continue; 232 233 -- Test for type Address is private 234 235 elsif System_Text (P .. P + 26) = " type Address is private;" then 236 Opt.Address_Is_Private := True; 237 P := P + 26; 238 goto Line_Loop_Continue; 239 240 -- Test for pragma Profile (Ravenscar); 241 242 elsif System_Text (P .. P + 26) = 243 "pragma Profile (Ravenscar);" 244 then 245 Set_Profile_Restrictions (Ravenscar); 246 Opt.Task_Dispatching_Policy := 'F'; 247 Opt.Locking_Policy := 'C'; 248 P := P + 27; 249 goto Line_Loop_Continue; 250 251 -- Test for pragma Profile (Restricted); 252 253 elsif System_Text (P .. P + 27) = 254 "pragma Profile (Restricted);" 255 then 256 Set_Profile_Restrictions (Restricted); 257 P := P + 28; 258 goto Line_Loop_Continue; 259 260 -- Test for pragma Restrictions 261 262 elsif System_Text (P .. P + 20) = "pragma Restrictions (" then 263 P := P + 21; 264 265 Rloop : for K in All_Boolean_Restrictions loop 266 declare 267 Rname : constant String := Restriction_Id'Image (K); 268 269 begin 270 for J in Rname'Range loop 271 if Fold_Upper (System_Text (P + Source_Ptr (J - 1))) 272 /= Rname (J) 273 then 274 goto Rloop_Continue; 275 end if; 276 end loop; 277 278 if System_Text (P + Rname'Length) = ')' then 279 Restrictions_On_Target.Set (K) := True; 280 goto Line_Loop_Continue; 281 end if; 282 end; 283 284 <<Rloop_Continue>> 285 null; 286 end loop Rloop; 287 288 Ploop : for K in All_Parameter_Restrictions loop 289 declare 290 Rname : constant String := 291 All_Parameter_Restrictions'Image (K); 292 293 V : Natural; 294 -- Accumulates value 295 296 begin 297 for J in Rname'Range loop 298 if Fold_Upper (System_Text (P + Source_Ptr (J - 1))) 299 /= Rname (J) 300 then 301 goto Ploop_Continue; 302 end if; 303 end loop; 304 305 if System_Text (P + Rname'Length .. P + Rname'Length + 3) = 306 " => " 307 then 308 P := P + Rname'Length + 4; 309 310 V := 0; 311 loop 312 if System_Text (P) in '0' .. '9' then 313 declare 314 pragma Unsuppress (Overflow_Check); 315 316 begin 317 -- Accumulate next digit 318 319 V := 10 * V + 320 Character'Pos (System_Text (P)) - 321 Character'Pos ('0'); 322 323 exception 324 -- On overflow, we just ignore the pragma since 325 -- that is the standard handling in this case. 326 327 when Constraint_Error => 328 goto Line_Loop_Continue; 329 end; 330 331 elsif System_Text (P) = '_' then 332 null; 333 334 elsif System_Text (P) = ')' then 335 Restrictions_On_Target.Value (K) := V; 336 Restrictions_On_Target.Set (K) := True; 337 goto Line_Loop_Continue; 338 339 else 340 exit Ploop; 341 end if; 342 343 P := P + 1; 344 end loop; 345 346 else 347 exit Ploop; 348 end if; 349 end; 350 351 <<Ploop_Continue>> 352 null; 353 end loop Ploop; 354 355 -- No_Dependence case 356 357 if System_Text (P .. P + 16) = "No_Dependence => " then 358 P := P + 17; 359 360 -- Skip this processing (and simply ignore No_Dependence lines) 361 -- if caller did not supply the three subprograms we need to 362 -- process these lines. 363 364 if Make_Id = null then 365 goto Line_Loop_Continue; 366 end if; 367 368 -- We have scanned out "pragma Restrictions (No_Dependence =>" 369 370 declare 371 Unit : Node_Id; 372 Id : Node_Id; 373 Start : Source_Ptr; 374 375 begin 376 Unit := Empty; 377 378 -- Loop through components of name, building up Unit 379 380 loop 381 Start := P; 382 while System_Text (P) /= '.' 383 and then 384 System_Text (P) /= ')' 385 loop 386 P := P + 1; 387 end loop; 388 389 Id := Make_Id (System_Text (Start .. P - 1)); 390 391 -- If first name, just capture the identifier 392 393 if Unit = Empty then 394 Unit := Id; 395 else 396 Unit := Make_SC (Unit, Id); 397 end if; 398 399 exit when System_Text (P) = ')'; 400 P := P + 1; 401 end loop; 402 403 Set_RND (Unit); 404 goto Line_Loop_Continue; 405 end; 406 end if; 407 408 -- Here if unrecognizable restrictions pragma form 409 410 Set_Standard_Error; 411 Write_Line 412 ("fatal error: system.ads is incorrectly formatted"); 413 Write_Str ("unrecognized or incorrect restrictions pragma: "); 414 415 while System_Text (P) /= ')' 416 and then 417 System_Text (P) /= ASCII.LF 418 loop 419 Write_Char (System_Text (P)); 420 P := P + 1; 421 end loop; 422 423 Write_Eol; 424 Fatal := True; 425 Set_Standard_Output; 426 427 -- Test for pragma Detect_Blocking; 428 429 elsif System_Text (P .. P + 22) = "pragma Detect_Blocking;" then 430 P := P + 23; 431 Opt.Detect_Blocking := True; 432 goto Line_Loop_Continue; 433 434 -- Discard_Names 435 436 elsif System_Text (P .. P + 20) = "pragma Discard_Names;" then 437 P := P + 21; 438 Opt.Global_Discard_Names := True; 439 goto Line_Loop_Continue; 440 441 -- Locking Policy 442 443 elsif System_Text (P .. P + 22) = "pragma Locking_Policy (" then 444 P := P + 23; 445 Opt.Locking_Policy := System_Text (P); 446 Opt.Locking_Policy_Sloc := System_Location; 447 goto Line_Loop_Continue; 448 449 -- Normalize_Scalars 450 451 elsif System_Text (P .. P + 24) = "pragma Normalize_Scalars;" then 452 P := P + 25; 453 Opt.Normalize_Scalars := True; 454 Opt.Init_Or_Norm_Scalars := True; 455 goto Line_Loop_Continue; 456 457 -- Partition_Elaboration_Policy 458 459 elsif System_Text (P .. P + 36) = 460 "pragma Partition_Elaboration_Policy (" 461 then 462 P := P + 37; 463 Opt.Partition_Elaboration_Policy := System_Text (P); 464 Opt.Partition_Elaboration_Policy_Sloc := System_Location; 465 goto Line_Loop_Continue; 466 467 -- Polling (On) 468 469 elsif System_Text (P .. P + 19) = "pragma Polling (On);" then 470 P := P + 20; 471 Opt.Polling_Required := True; 472 goto Line_Loop_Continue; 473 474 -- Queuing Policy 475 476 elsif System_Text (P .. P + 22) = "pragma Queuing_Policy (" then 477 P := P + 23; 478 Opt.Queuing_Policy := System_Text (P); 479 Opt.Queuing_Policy_Sloc := System_Location; 480 goto Line_Loop_Continue; 481 482 -- Suppress_Exception_Locations 483 484 elsif System_Text (P .. P + 35) = 485 "pragma Suppress_Exception_Locations;" 486 then 487 P := P + 36; 488 Opt.Exception_Locations_Suppressed := True; 489 goto Line_Loop_Continue; 490 491 -- Task_Dispatching Policy 492 493 elsif System_Text (P .. P + 31) = 494 "pragma Task_Dispatching_Policy (" 495 then 496 P := P + 32; 497 Opt.Task_Dispatching_Policy := System_Text (P); 498 Opt.Task_Dispatching_Policy_Sloc := System_Location; 499 goto Line_Loop_Continue; 500 501 -- No other configuration pragmas are permitted 502 503 elsif System_Text (P .. P + 6) = "pragma " then 504 505 -- Special exception, we allow pragma Pure (System) appearing in 506 -- column one. This is an obsolete usage which may show up in old 507 -- tests with an obsolete version of system.ads, so we recognize 508 -- and ignore it to make life easier in handling such tests. 509 510 if System_Text (P .. P + 20) = "pragma Pure (System);" then 511 P := P + 21; 512 goto Line_Loop_Continue; 513 end if; 514 515 Set_Standard_Error; 516 Write_Line ("unrecognized line in system.ads: "); 517 518 while System_Text (P) /= ')' 519 and then System_Text (P) /= ASCII.LF 520 loop 521 Write_Char (System_Text (P)); 522 P := P + 1; 523 end loop; 524 525 Write_Eol; 526 Set_Standard_Output; 527 Fatal := True; 528 529 -- See if we have a Run_Time_Name 530 531 elsif System_Text (P .. P + 38) = 532 " Run_Time_Name : constant String := """ 533 then 534 P := P + 39; 535 536 Name_Len := 0; 537 while System_Text (P) in 'A' .. 'Z' 538 or else 539 System_Text (P) in 'a' .. 'z' 540 or else 541 System_Text (P) in '0' .. '9' 542 or else 543 System_Text (P) = ' ' 544 or else 545 System_Text (P) = '_' 546 loop 547 Add_Char_To_Name_Buffer (System_Text (P)); 548 P := P + 1; 549 end loop; 550 551 if System_Text (P) /= '"' 552 or else System_Text (P + 1) /= ';' 553 or else (System_Text (P + 2) /= ASCII.LF 554 and then 555 System_Text (P + 2) /= ASCII.CR) 556 then 557 Set_Standard_Error; 558 Write_Line 559 ("incorrectly formatted Run_Time_Name in system.ads"); 560 Set_Standard_Output; 561 Fatal := True; 562 563 else 564 Run_Time_Name_On_Target := Name_Enter; 565 end if; 566 567 goto Line_Loop_Continue; 568 569 -- See if we have an Executable_Extension 570 571 elsif System_Text (P .. P + 45) = 572 " Executable_Extension : constant String := """ 573 then 574 P := P + 46; 575 576 Name_Len := 0; 577 while System_Text (P) /= '"' 578 and then System_Text (P) /= ASCII.LF 579 loop 580 Add_Char_To_Name_Buffer (System_Text (P)); 581 P := P + 1; 582 end loop; 583 584 if System_Text (P) /= '"' or else System_Text (P + 1) /= ';' then 585 Set_Standard_Error; 586 Write_Line 587 ("incorrectly formatted Executable_Extension in system.ads"); 588 Set_Standard_Output; 589 Fatal := True; 590 591 else 592 Executable_Extension_On_Target := Name_Enter; 593 end if; 594 595 goto Line_Loop_Continue; 596 597 -- Next see if we have a configuration parameter 598 599 else 600 Config_Param_Loop : for K in Targparm_Tags loop 601 if System_Text (P + 3 .. P + 2 + Targparm_Str (K)'Length) = 602 Targparm_Str (K).all 603 then 604 P := P + 3 + Targparm_Str (K)'Length; 605 606 if Targparm_Flags (K) then 607 Set_Standard_Error; 608 Write_Line 609 ("fatal error: system.ads is incorrectly formatted"); 610 Write_Str ("duplicate line for parameter: "); 611 612 for J in Targparm_Str (K)'Range loop 613 Write_Char (Targparm_Str (K).all (J)); 614 end loop; 615 616 Write_Eol; 617 Set_Standard_Output; 618 Fatal := True; 619 620 else 621 Targparm_Flags (K) := True; 622 end if; 623 624 while System_Text (P) /= ':' 625 or else System_Text (P + 1) /= '=' 626 loop 627 P := P + 1; 628 end loop; 629 630 P := P + 2; 631 632 while System_Text (P) = ' ' loop 633 P := P + 1; 634 end loop; 635 636 Result := (System_Text (P) = 'T'); 637 638 case K is 639 when AAM => AAMP_On_Target := Result; 640 when ACR => Always_Compatible_Rep_On_Target := Result; 641 when ASD => Atomic_Sync_Default_On_Target := Result; 642 when BDC => Backend_Divide_Checks_On_Target := Result; 643 when BOC => Backend_Overflow_Checks_On_Target := Result; 644 when CLA => Command_Line_Args_On_Target := Result; 645 when CLI => 646 if Result then 647 VM_Target := CLI_Target; 648 Tagged_Type_Expansion := False; 649 end if; 650 -- This is wrong, this processing should be done in 651 -- Gnat1drv.Adjust_Global_Switches. It is not the 652 -- right level for targparm to know about tagged 653 -- type extension??? 654 655 when CRT => Configurable_Run_Time_On_Target := Result; 656 when D32 => Duration_32_Bits_On_Target := Result; 657 when DEN => Denorm_On_Target := Result; 658 when EXS => Exit_Status_Supported_On_Target := Result; 659 when FEL => Frontend_Layout_On_Target := Result; 660 when FFO => Fractional_Fixed_Ops_On_Target := Result; 661 662 when JVM => 663 if Result then 664 VM_Target := JVM_Target; 665 Tagged_Type_Expansion := False; 666 end if; 667 -- This is wrong, this processing should be done in 668 -- Gnat1drv.Adjust_Global_Switches. It is not the 669 -- right level for targparm to know about tagged 670 -- type extension??? 671 672 when MOV => Machine_Overflows_On_Target := Result; 673 when MRN => Machine_Rounds_On_Target := Result; 674 when PAS => Preallocated_Stacks_On_Target := Result; 675 when SAG => Support_Aggregates_On_Target := Result; 676 when SAP => Support_Atomic_Primitives_On_Target := Result; 677 when SCA => Support_Composite_Assign_On_Target := Result; 678 when SCC => Support_Composite_Compare_On_Target := Result; 679 when SCD => Stack_Check_Default_On_Target := Result; 680 when SCL => Stack_Check_Limits_On_Target := Result; 681 when SCP => Stack_Check_Probes_On_Target := Result; 682 when SLS => Support_Long_Shifts_On_Target := Result; 683 when SSL => Suppress_Standard_Library_On_Target := Result; 684 when SNZ => Signed_Zeros_On_Target := Result; 685 when UAM => Use_Ada_Main_Program_Name_On_Target := Result; 686 when ZCD => ZCX_By_Default_On_Target := Result; 687 688 goto Line_Loop_Continue; 689 end case; 690 691 -- Here we are seeing a parameter we do not understand. We 692 -- simply ignore this (will happen when an old compiler is 693 -- used to compile a newer version of GNAT which does not 694 -- support the parameter). 695 end if; 696 end loop Config_Param_Loop; 697 end if; 698 699 -- Here after processing one line of System spec 700 701 <<Line_Loop_Continue>> 702 703 while System_Text (P) /= CR and then System_Text (P) /= LF loop 704 P := P + 1; 705 exit when P >= Source_Last; 706 end loop; 707 708 while System_Text (P) = CR or else System_Text (P) = LF loop 709 P := P + 1; 710 exit when P >= Source_Last; 711 end loop; 712 713 if P >= Source_Last then 714 Set_Standard_Error; 715 Write_Line ("fatal error, system.ads not formatted correctly"); 716 Write_Line ("unexpected end of file"); 717 Set_Standard_Output; 718 raise Unrecoverable_Error; 719 end if; 720 end loop Line_Loop; 721 722 if Fatal then 723 raise Unrecoverable_Error; 724 end if; 725 end Get_Target_Parameters; 726 727 ------------------------------ 728 -- Set_Profile_Restrictions -- 729 ------------------------------ 730 731 procedure Set_Profile_Restrictions (P : Profile_Name) is 732 R : Restriction_Flags renames Profile_Info (P).Set; 733 V : Restriction_Values renames Profile_Info (P).Value; 734 begin 735 for J in R'Range loop 736 if R (J) then 737 Restrictions_On_Target.Set (J) := True; 738 739 if J in All_Parameter_Restrictions then 740 Restrictions_On_Target.Value (J) := V (J); 741 end if; 742 end if; 743 end loop; 744 end Set_Profile_Restrictions; 745 746end Targparm; 747