1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- M A K E _ U T I L -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2004-2019, 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 Atree; use Atree; 27with Debug; 28with Errutil; 29with Osint; use Osint; 30with Output; use Output; 31with Opt; use Opt; 32with Table; 33 34with Ada.Command_Line; use Ada.Command_Line; 35 36with GNAT.Case_Util; use GNAT.Case_Util; 37with GNAT.Directory_Operations; use GNAT.Directory_Operations; 38with GNAT.HTable; 39 40package body Make_Util is 41 42 --------- 43 -- Add -- 44 --------- 45 46 procedure Add 47 (Option : String_Access; 48 To : in out String_List_Access; 49 Last : in out Natural) 50 is 51 begin 52 if Last = To'Last then 53 declare 54 New_Options : constant String_List_Access := 55 new String_List (1 .. To'Last * 2); 56 57 begin 58 New_Options (To'Range) := To.all; 59 60 -- Set all elements of the original options to null to avoid 61 -- deallocation of copies. 62 63 To.all := (others => null); 64 65 Free (To); 66 To := New_Options; 67 end; 68 end if; 69 70 Last := Last + 1; 71 To (Last) := Option; 72 end Add; 73 74 procedure Add 75 (Option : String; 76 To : in out String_List_Access; 77 Last : in out Natural) 78 is 79 begin 80 Add (Option => new String'(Option), To => To, Last => Last); 81 end Add; 82 83 ------------------------- 84 -- Base_Name_Index_For -- 85 ------------------------- 86 87 function Base_Name_Index_For 88 (Main : String; 89 Main_Index : Int; 90 Index_Separator : Character) return File_Name_Type 91 is 92 Result : File_Name_Type; 93 94 begin 95 Name_Len := 0; 96 Add_Str_To_Name_Buffer (Base_Name (Main)); 97 98 -- Remove the extension, if any, that is the last part of the base name 99 -- starting with a dot and following some characters. 100 101 for J in reverse 2 .. Name_Len loop 102 if Name_Buffer (J) = '.' then 103 Name_Len := J - 1; 104 exit; 105 end if; 106 end loop; 107 108 -- Add the index info, if index is different from 0 109 110 if Main_Index > 0 then 111 Add_Char_To_Name_Buffer (Index_Separator); 112 113 declare 114 Img : constant String := Main_Index'Img; 115 begin 116 Add_Str_To_Name_Buffer (Img (2 .. Img'Last)); 117 end; 118 end if; 119 120 Result := Name_Find; 121 return Result; 122 end Base_Name_Index_For; 123 124 ----------------- 125 -- Create_Name -- 126 ----------------- 127 128 function Create_Name (Name : String) return File_Name_Type is 129 begin 130 Name_Len := 0; 131 Add_Str_To_Name_Buffer (Name); 132 return Name_Find; 133 end Create_Name; 134 135 function Create_Name (Name : String) return Name_Id is 136 begin 137 Name_Len := 0; 138 Add_Str_To_Name_Buffer (Name); 139 return Name_Find; 140 end Create_Name; 141 142 function Create_Name (Name : String) return Path_Name_Type is 143 begin 144 Name_Len := 0; 145 Add_Str_To_Name_Buffer (Name); 146 return Name_Find; 147 end Create_Name; 148 149 --------------------------- 150 -- Ensure_Absolute_Path -- 151 --------------------------- 152 153 procedure Ensure_Absolute_Path 154 (Switch : in out String_Access; 155 Parent : String; 156 Do_Fail : Fail_Proc; 157 For_Gnatbind : Boolean := False; 158 Including_Non_Switch : Boolean := True; 159 Including_RTS : Boolean := False) 160 is 161 begin 162 if Switch /= null then 163 declare 164 Sw : String (1 .. Switch'Length); 165 Start : Positive; 166 167 begin 168 Sw := Switch.all; 169 170 if Sw (1) = '-' then 171 if Sw'Length >= 3 172 and then (Sw (2) = 'I' 173 or else (not For_Gnatbind 174 and then (Sw (2) = 'L' 175 or else 176 Sw (2) = 'A'))) 177 then 178 Start := 3; 179 180 if Sw = "-I-" then 181 return; 182 end if; 183 184 elsif Sw'Length >= 4 185 and then 186 (Sw (2 .. 3) = "aL" or else 187 Sw (2 .. 3) = "aO" or else 188 Sw (2 .. 3) = "aI" 189 or else (For_Gnatbind and then Sw (2 .. 3) = "A=")) 190 then 191 Start := 4; 192 193 elsif Including_RTS 194 and then Sw'Length >= 7 195 and then Sw (2 .. 6) = "-RTS=" 196 then 197 Start := 7; 198 199 else 200 return; 201 end if; 202 203 -- Because relative path arguments to --RTS= may be relative to 204 -- the search directory prefix, those relative path arguments 205 -- are converted only when they include directory information. 206 207 if not Is_Absolute_Path (Sw (Start .. Sw'Last)) then 208 if Parent'Length = 0 then 209 Do_Fail 210 ("relative search path switches (""" 211 & Sw 212 & """) are not allowed"); 213 214 elsif Including_RTS then 215 for J in Start .. Sw'Last loop 216 if Sw (J) = Directory_Separator then 217 Switch := 218 new String' 219 (Sw (1 .. Start - 1) 220 & Parent 221 & Directory_Separator 222 & Sw (Start .. Sw'Last)); 223 return; 224 end if; 225 end loop; 226 227 else 228 Switch := 229 new String' 230 (Sw (1 .. Start - 1) 231 & Parent 232 & Directory_Separator 233 & Sw (Start .. Sw'Last)); 234 end if; 235 end if; 236 237 elsif Including_Non_Switch then 238 if not Is_Absolute_Path (Sw) then 239 if Parent'Length = 0 then 240 Do_Fail 241 ("relative paths (""" & Sw & """) are not allowed"); 242 else 243 Switch := new String'(Parent & Directory_Separator & Sw); 244 end if; 245 end if; 246 end if; 247 end; 248 end if; 249 end Ensure_Absolute_Path; 250 251 ---------------------------- 252 -- Executable_Prefix_Path -- 253 ---------------------------- 254 255 function Executable_Prefix_Path return String is 256 Exec_Name : constant String := Command_Name; 257 258 function Get_Install_Dir (S : String) return String; 259 -- S is the executable name preceded by the absolute or relative path, 260 -- e.g. "c:\usr\bin\gcc.exe". Returns the absolute directory where "bin" 261 -- lies (in the example "C:\usr"). If the executable is not in a "bin" 262 -- directory, return "". 263 264 --------------------- 265 -- Get_Install_Dir -- 266 --------------------- 267 268 function Get_Install_Dir (S : String) return String is 269 Exec : String := S; 270 Path_Last : Integer := 0; 271 272 begin 273 for J in reverse Exec'Range loop 274 if Exec (J) = Directory_Separator then 275 Path_Last := J - 1; 276 exit; 277 end if; 278 end loop; 279 280 if Path_Last >= Exec'First + 2 then 281 To_Lower (Exec (Path_Last - 2 .. Path_Last)); 282 end if; 283 284 if Path_Last < Exec'First + 2 285 or else Exec (Path_Last - 2 .. Path_Last) /= "bin" 286 or else (Path_Last - 3 >= Exec'First 287 and then Exec (Path_Last - 3) /= Directory_Separator) 288 then 289 return ""; 290 end if; 291 292 return Normalize_Pathname 293 (Exec (Exec'First .. Path_Last - 4), 294 Resolve_Links => Opt.Follow_Links_For_Dirs) 295 & Directory_Separator; 296 end Get_Install_Dir; 297 298 -- Beginning of Executable_Prefix_Path 299 300 begin 301 -- First determine if a path prefix was placed in front of the 302 -- executable name. 303 304 for J in reverse Exec_Name'Range loop 305 if Exec_Name (J) = Directory_Separator then 306 return Get_Install_Dir (Exec_Name); 307 end if; 308 end loop; 309 310 -- If we get here, the user has typed the executable name with no 311 -- directory prefix. 312 313 declare 314 Path : String_Access := Locate_Exec_On_Path (Exec_Name); 315 begin 316 if Path = null then 317 return ""; 318 else 319 declare 320 Dir : constant String := Get_Install_Dir (Path.all); 321 begin 322 Free (Path); 323 return Dir; 324 end; 325 end if; 326 end; 327 end Executable_Prefix_Path; 328 329 ------------------ 330 -- Fail_Program -- 331 ------------------ 332 333 procedure Fail_Program 334 (S : String; 335 Flush_Messages : Boolean := True) 336 is 337 begin 338 if Flush_Messages and not No_Exit_Message then 339 if Total_Errors_Detected /= 0 or else Warnings_Detected /= 0 then 340 Errutil.Finalize; 341 end if; 342 end if; 343 344 Finish_Program (E_Fatal, S => S); 345 end Fail_Program; 346 347 -------------------- 348 -- Finish_Program -- 349 -------------------- 350 351 procedure Finish_Program 352 (Exit_Code : Osint.Exit_Code_Type := Osint.E_Success; 353 S : String := "") 354 is 355 begin 356 if S'Length > 0 then 357 if Exit_Code /= E_Success then 358 if No_Exit_Message then 359 Osint.Exit_Program (E_Fatal); 360 else 361 Osint.Fail (S); 362 end if; 363 364 elsif not No_Exit_Message then 365 Write_Str (S); 366 end if; 367 end if; 368 369 -- Output Namet statistics 370 371 Namet.Finalize; 372 373 Exit_Program (Exit_Code); 374 end Finish_Program; 375 376 ---------- 377 -- Hash -- 378 ---------- 379 380 function Hash is new GNAT.HTable.Hash (Header_Num => Header_Num); 381 -- Used in implementation of other functions Hash below 382 383 ---------- 384 -- Hash -- 385 ---------- 386 387 function Hash (Name : File_Name_Type) return Header_Num is 388 begin 389 return Hash (Get_Name_String (Name)); 390 end Hash; 391 392 function Hash (Name : Name_Id) return Header_Num is 393 begin 394 return Hash (Get_Name_String (Name)); 395 end Hash; 396 397 function Hash (Name : Path_Name_Type) return Header_Num is 398 begin 399 return Hash (Get_Name_String (Name)); 400 end Hash; 401 402 ------------ 403 -- Inform -- 404 ------------ 405 406 procedure Inform (N : File_Name_Type; Msg : String) is 407 begin 408 Inform (Name_Id (N), Msg); 409 end Inform; 410 411 procedure Inform (N : Name_Id := No_Name; Msg : String) is 412 begin 413 Osint.Write_Program_Name; 414 415 Write_Str (": "); 416 417 if N /= No_Name then 418 Write_Str (""""); 419 420 declare 421 Name : constant String := Get_Name_String (N); 422 begin 423 if Debug.Debug_Flag_F and then Is_Absolute_Path (Name) then 424 Write_Str (File_Name (Name)); 425 else 426 Write_Str (Name); 427 end if; 428 end; 429 430 Write_Str (""" "); 431 end if; 432 433 Write_Str (Msg); 434 Write_Eol; 435 end Inform; 436 437 ----------- 438 -- Mains -- 439 ----------- 440 441 package body Mains is 442 443 package Names is new Table.Table 444 (Table_Component_Type => Main_Info, 445 Table_Index_Type => Integer, 446 Table_Low_Bound => 1, 447 Table_Initial => 10, 448 Table_Increment => 100, 449 Table_Name => "Makeutl.Mains.Names"); 450 -- The table that stores the mains 451 452 Current : Natural := 0; 453 -- The index of the last main retrieved from the table 454 455 Count_Of_Mains_With_No_Tree : Natural := 0; 456 -- Number of main units for which we do not know the project tree 457 458 -------------- 459 -- Add_Main -- 460 -------------- 461 462 procedure Add_Main (Name : String; Index : Int := 0) is 463 begin 464 Name_Len := 0; 465 Add_Str_To_Name_Buffer (Name); 466 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 467 468 Names.Increment_Last; 469 Names.Table (Names.Last) := (Name_Find, Index); 470 471 Mains.Count_Of_Mains_With_No_Tree := 472 Mains.Count_Of_Mains_With_No_Tree + 1; 473 end Add_Main; 474 475 ------------ 476 -- Delete -- 477 ------------ 478 479 procedure Delete is 480 begin 481 Names.Set_Last (0); 482 Mains.Reset; 483 end Delete; 484 485 --------------- 486 -- Next_Main -- 487 --------------- 488 489 function Next_Main return String is 490 Info : constant Main_Info := Next_Main; 491 begin 492 if Info = No_Main_Info then 493 return ""; 494 else 495 return Get_Name_String (Info.File); 496 end if; 497 end Next_Main; 498 499 function Next_Main return Main_Info is 500 begin 501 if Current >= Names.Last then 502 return No_Main_Info; 503 else 504 Current := Current + 1; 505 506 declare 507 Orig_Main : constant File_Name_Type := 508 Names.Table (Current).File; 509 Current_Main : File_Name_Type; 510 511 begin 512 if Strip_Suffix (Orig_Main) = Orig_Main then 513 Get_Name_String (Orig_Main); 514 Add_Str_To_Name_Buffer (".adb"); 515 Current_Main := Name_Find; 516 517 if Full_Source_Name (Current_Main) = No_File then 518 Get_Name_String (Orig_Main); 519 Add_Str_To_Name_Buffer (".ads"); 520 Current_Main := Name_Find; 521 522 if Full_Source_Name (Current_Main) /= No_File then 523 Names.Table (Current).File := Current_Main; 524 end if; 525 526 else 527 Names.Table (Current).File := Current_Main; 528 end if; 529 end if; 530 end; 531 532 return Names.Table (Current); 533 end if; 534 end Next_Main; 535 536 --------------------- 537 -- Number_Of_Mains -- 538 --------------------- 539 540 function Number_Of_Mains return Natural is 541 begin 542 return Names.Last; 543 end Number_Of_Mains; 544 545 ----------- 546 -- Reset -- 547 ----------- 548 549 procedure Reset is 550 begin 551 Current := 0; 552 end Reset; 553 554 -------------------------- 555 -- Set_Multi_Unit_Index -- 556 -------------------------- 557 558 procedure Set_Multi_Unit_Index 559 (Index : Int := 0) 560 is 561 begin 562 if Index /= 0 then 563 if Names.Last = 0 then 564 Fail_Program 565 ("cannot specify a multi-unit index but no main " 566 & "on the command line"); 567 568 elsif Names.Last > 1 then 569 Fail_Program 570 ("cannot specify several mains with a multi-unit index"); 571 572 else 573 Names.Table (Names.Last).Index := Index; 574 end if; 575 end if; 576 end Set_Multi_Unit_Index; 577 578 end Mains; 579 580 ----------------------- 581 -- Path_Or_File_Name -- 582 ----------------------- 583 584 function Path_Or_File_Name (Path : Path_Name_Type) return String is 585 Path_Name : constant String := Get_Name_String (Path); 586 begin 587 if Debug.Debug_Flag_F then 588 return File_Name (Path_Name); 589 else 590 return Path_Name; 591 end if; 592 end Path_Or_File_Name; 593 594 ------------------- 595 -- Unit_Index_Of -- 596 ------------------- 597 598 function Unit_Index_Of (ALI_File : File_Name_Type) return Int is 599 Start : Natural; 600 Finish : Natural; 601 Result : Int := 0; 602 603 begin 604 Get_Name_String (ALI_File); 605 606 -- First, find the last dot 607 608 Finish := Name_Len; 609 610 while Finish >= 1 and then Name_Buffer (Finish) /= '.' loop 611 Finish := Finish - 1; 612 end loop; 613 614 if Finish = 1 then 615 return 0; 616 end if; 617 618 -- Now check that the dot is preceded by digits 619 620 Start := Finish; 621 Finish := Finish - 1; 622 while Start >= 1 and then Name_Buffer (Start - 1) in '0' .. '9' loop 623 Start := Start - 1; 624 end loop; 625 626 -- If there are no digits, or if the digits are not preceded by the 627 -- character that precedes a unit index, this is not the ALI file of 628 -- a unit in a multi-unit source. 629 630 if Start > Finish 631 or else Start = 1 632 or else Name_Buffer (Start - 1) /= Multi_Unit_Index_Character 633 then 634 return 0; 635 end if; 636 637 -- Build the index from the digit(s) 638 639 while Start <= Finish loop 640 Result := Result * 10 + 641 Character'Pos (Name_Buffer (Start)) - Character'Pos ('0'); 642 Start := Start + 1; 643 end loop; 644 645 return Result; 646 end Unit_Index_Of; 647 648 ----------------- 649 -- Verbose_Msg -- 650 ----------------- 651 652 procedure Verbose_Msg 653 (N1 : Name_Id; 654 S1 : String; 655 N2 : Name_Id := No_Name; 656 S2 : String := ""; 657 Prefix : String := " -> "; 658 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) 659 is 660 begin 661 if not Opt.Verbose_Mode 662 or else Minimum_Verbosity > Opt.Verbosity_Level 663 then 664 return; 665 end if; 666 667 Write_Str (Prefix); 668 Write_Str (""""); 669 Write_Name (N1); 670 Write_Str (""" "); 671 Write_Str (S1); 672 673 if N2 /= No_Name then 674 Write_Str (" """); 675 Write_Name (N2); 676 Write_Str (""" "); 677 end if; 678 679 Write_Str (S2); 680 Write_Eol; 681 end Verbose_Msg; 682 683 procedure Verbose_Msg 684 (N1 : File_Name_Type; 685 S1 : String; 686 N2 : File_Name_Type := No_File; 687 S2 : String := ""; 688 Prefix : String := " -> "; 689 Minimum_Verbosity : Opt.Verbosity_Level_Type := Opt.Low) 690 is 691 begin 692 Verbose_Msg 693 (Name_Id (N1), S1, Name_Id (N2), S2, Prefix, Minimum_Verbosity); 694 end Verbose_Msg; 695 696 ----------- 697 -- Queue -- 698 ----------- 699 700 package body Queue is 701 702 type Q_Record is record 703 Info : Source_Info; 704 Processed : Boolean; 705 end record; 706 707 package Q is new Table.Table 708 (Table_Component_Type => Q_Record, 709 Table_Index_Type => Natural, 710 Table_Low_Bound => 1, 711 Table_Initial => 1000, 712 Table_Increment => 100, 713 Table_Name => "Makeutl.Queue.Q"); 714 -- This is the actual Queue 715 716 type Mark_Key is record 717 File : File_Name_Type; 718 Index : Int; 719 end record; 720 -- Identify either a mono-unit source (when Index = 0) or a specific 721 -- unit (index = 1's origin index of unit) in a multi-unit source. 722 723 Max_Mask_Num : constant := 2048; 724 subtype Mark_Num is Union_Id range 0 .. Max_Mask_Num - 1; 725 726 function Hash (Key : Mark_Key) return Mark_Num; 727 728 package Marks is new GNAT.HTable.Simple_HTable 729 (Header_Num => Mark_Num, 730 Element => Boolean, 731 No_Element => False, 732 Key => Mark_Key, 733 Hash => Hash, 734 Equal => "="); 735 -- A hash table to keep tracks of the marked units. 736 -- These are the units that have already been processed, when using the 737 -- gnatmake format. When using the gprbuild format, we can directly 738 -- store in the source_id whether the file has already been processed. 739 740 procedure Mark (Source_File : File_Name_Type; Index : Int := 0); 741 -- Mark a unit, identified by its source file and, when Index is not 0, 742 -- the index of the unit in the source file. Marking is used to signal 743 -- that the unit has already been inserted in the Q. 744 745 function Is_Marked 746 (Source_File : File_Name_Type; 747 Index : Int := 0) return Boolean; 748 -- Returns True if the unit was previously marked 749 750 Q_Processed : Natural := 0; 751 Q_Initialized : Boolean := False; 752 753 Q_First : Natural := 1; 754 -- Points to the first valid element in the queue 755 756 procedure Debug_Display (S : Source_Info); 757 -- A debug display for S 758 759 function Was_Processed (S : Source_Info) return Boolean; 760 -- Whether S has already been processed. This marks the source as 761 -- processed, if it hasn't already been processed. 762 763 ------------------- 764 -- Was_Processed -- 765 ------------------- 766 767 function Was_Processed (S : Source_Info) return Boolean is 768 begin 769 if Is_Marked (S.File, S.Index) then 770 return True; 771 end if; 772 773 Mark (S.File, Index => S.Index); 774 775 return False; 776 end Was_Processed; 777 778 ------------------- 779 -- Debug_Display -- 780 ------------------- 781 782 procedure Debug_Display (S : Source_Info) is 783 begin 784 Write_Name (S.File); 785 786 if S.Index /= 0 then 787 Write_Str (", "); 788 Write_Int (S.Index); 789 end if; 790 end Debug_Display; 791 792 ---------- 793 -- Hash -- 794 ---------- 795 796 function Hash (Key : Mark_Key) return Mark_Num is 797 begin 798 return Union_Id (Key.File) mod Max_Mask_Num; 799 end Hash; 800 801 --------------- 802 -- Is_Marked -- 803 --------------- 804 805 function Is_Marked 806 (Source_File : File_Name_Type; 807 Index : Int := 0) return Boolean 808 is 809 begin 810 return Marks.Get (K => (File => Source_File, Index => Index)); 811 end Is_Marked; 812 813 ---------- 814 -- Mark -- 815 ---------- 816 817 procedure Mark (Source_File : File_Name_Type; Index : Int := 0) is 818 begin 819 Marks.Set (K => (File => Source_File, Index => Index), E => True); 820 end Mark; 821 822 ------------- 823 -- Extract -- 824 ------------- 825 826 procedure Extract 827 (Found : out Boolean; 828 Source : out Source_Info) 829 is 830 begin 831 Found := False; 832 833 if Q_First <= Q.Last then 834 Source := Q.Table (Q_First).Info; 835 Q.Table (Q_First).Processed := True; 836 Q_First := Q_First + 1; 837 Found := True; 838 end if; 839 840 if Found then 841 Q_Processed := Q_Processed + 1; 842 end if; 843 844 if Found and then Debug.Debug_Flag_Q then 845 Write_Str (" Q := Q - [ "); 846 Debug_Display (Source); 847 Write_Str (" ]"); 848 Write_Eol; 849 850 Write_Str (" Q_First ="); 851 Write_Int (Int (Q_First)); 852 Write_Eol; 853 854 Write_Str (" Q.Last ="); 855 Write_Int (Int (Q.Last)); 856 Write_Eol; 857 end if; 858 end Extract; 859 860 --------------- 861 -- Processed -- 862 --------------- 863 864 function Processed return Natural is 865 begin 866 return Q_Processed; 867 end Processed; 868 869 ---------------- 870 -- Initialize -- 871 ---------------- 872 873 procedure Initialize (Force : Boolean := False) is 874 begin 875 if Force or else not Q_Initialized then 876 Q_Initialized := True; 877 Q.Init; 878 Q_Processed := 0; 879 Q_First := 1; 880 end if; 881 end Initialize; 882 883 ------------ 884 -- Insert -- 885 ------------ 886 887 function Insert (Source : Source_Info) return Boolean is 888 begin 889 -- Only insert in the Q if it is not already done, to avoid 890 -- simultaneous compilations if -jnnn is used. 891 892 if Was_Processed (Source) then 893 return False; 894 end if; 895 896 Q.Append (New_Val => (Info => Source, Processed => False)); 897 898 if Debug.Debug_Flag_Q then 899 Write_Str (" Q := Q + [ "); 900 Debug_Display (Source); 901 Write_Str (" ] "); 902 Write_Eol; 903 904 Write_Str (" Q_First ="); 905 Write_Int (Int (Q_First)); 906 Write_Eol; 907 908 Write_Str (" Q.Last ="); 909 Write_Int (Int (Q.Last)); 910 Write_Eol; 911 end if; 912 913 return True; 914 end Insert; 915 916 procedure Insert (Source : Source_Info) is 917 Discard : Boolean; 918 begin 919 Discard := Insert (Source); 920 end Insert; 921 922 -------------- 923 -- Is_Empty -- 924 -------------- 925 926 function Is_Empty return Boolean is 927 begin 928 return Q_Processed >= Q.Last; 929 end Is_Empty; 930 931 ---------- 932 -- Size -- 933 ---------- 934 935 function Size return Natural is 936 begin 937 return Q.Last; 938 end Size; 939 940 ------------- 941 -- Element -- 942 ------------- 943 944 function Element (Rank : Positive) return File_Name_Type is 945 begin 946 if Rank <= Q.Last then 947 return Q.Table (Rank).Info.File; 948 else 949 return No_File; 950 end if; 951 end Element; 952 953 ------------------ 954 -- Remove_Marks -- 955 ------------------ 956 957 procedure Remove_Marks is 958 begin 959 Marks.Reset; 960 end Remove_Marks; 961 962 end Queue; 963 964end Make_Util; 965