| blob | 739fbee2f4993deb8a22e2339493b35d012f767f |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- M A K E --
6 -- --
7 -- B o d y --
8 -- --
9 -- $Revision: 1.5 $
10 -- --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 -- --
27 ------------------------------------------------------------------------------
70 -- Make control characters visible
73 -- Every program depends on this package, that must then be checked,
74 -- especially when -f and -a are used.
76 -------------------------
77 -- Note on terminology --
78 -------------------------
80 -- In this program, we use the phrase "termination" of a file name to
81 -- refer to the suffix that appears after the unit name portion. Very
82 -- often this is simply the extension, but in some cases, the sequence
83 -- may be more complex, for example in main.1.ada, the termination in
84 -- this name is ".1.ada" and in main_.ada the termination is "_.ada".
86 -------------------------------------
87 -- Queue (Q) Manipulation Routines --
88 -------------------------------------
90 -- The Q is used in Compile_Sources below. Its implementation uses the
91 -- GNAT generic package Table (basically an extensible array). Q_Front
92 -- points to the first valid element in the Q, whereas Q.First is the first
93 -- element ever enqueued, while Q.Last - 1 is the last element in the Q.
94 --
95 -- +---+--------------+---+---+---+-----------+---+--------
96 -- Q | | ........ | | | | ....... | |
97 -- +---+--------------+---+---+---+-----------+---+--------
98 -- ^ ^ ^
99 -- Q.First Q_Front Q.Last - 1
100 --
101 -- The elements comprised between Q.First and Q_Front - 1 are the
102 -- elements that have been enqueued and then dequeued, while the
103 -- elements between Q_Front and Q.Last - 1 are the elements currently
104 -- in the Q. When the Q is initialized Q_Front = Q.First = Q.Last.
105 -- After Compile_Sources has terminated its execution, Q_Front = Q.Last
106 -- and the elements contained between Q.Front and Q.Last-1 are those that
107 -- were explored and thus marked by Compile_Sources. Whenever the Q is
108 -- reinitialized, the elements between Q.First and Q.Last - 1 are unmarked.
111 -- Must be called to (re)initialize the Q.
113 procedure Insert_Q
116 -- Inserts Source_File at the end of Q. Provide Source_Unit when
117 -- possible for external use (gnatdist).
120 -- Returns True if Q is empty.
122 procedure Extract_From_Q
125 -- Extracts the first element from the Q.
127 procedure Insert_Project_Sources
130 -- If Into_Q is True, insert all sources of the project file that are not
131 -- already marked into the Q. If Into_Q is False, call Osint.Add_File for
132 -- all sources of the project file.
135 -- Will be set to false after Init_Q has been called once.
138 -- Points to the first valid element in the Q.
146 -- File is the name of the file to compile. Unit is for gnatdist
147 -- use in order to easily get the unit name of a file to compile
148 -- when its name is krunched or declared in gnat.adc.
157 -- This is the actual Q.
159 -- The following instantiations and variables are necessary to save what
160 -- is found on the command line, in case there is a project file specified.
206 -- Call Add_Src_Search_Dir.
207 -- Output one line when in verbose mode.
213 -- Call Add_Lib_Search_Dir.
214 -- Output one line when in verbose mode.
224 -- File is the name of the file for which a compilation failed.
225 -- Unit is for gnatdist use in order to easily get the unit name
226 -- of a file when its name is krunched or declared in gnat.adc.
227 -- Found is False if the compilation failed because the file could
228 -- not be found.
237 -- Full name of all the source files for which compilation fails.
243 -- File is the name of the file for which a special set of compilation
244 -- arguments (Args) is required.
253 -- Compilation arguments of all the source files for which an entry has
254 -- been found in the project file.
264 -- Maximum number of characters per line, when displaying a path
269 -- Flags to indicate what step should be executed.
270 -- Can be set to False with the switches -c, -b and -l.
271 -- These flags are reset to True for each invokation of procedure Gnatmake.
273 ----------------------
274 -- Marking Routines --
275 ----------------------
278 -- Mark Source_File. Marking is used to signal that Source_File has
279 -- already been inserted in the Q.
282 -- Returns True if Source_File was previously marked.
285 -- Unmarks Source_File.
287 -------------------
288 -- Misc Routines --
289 -------------------
292 -- Prints to standard output the list of object dependencies. This list
293 -- can be used directly in a Makefile. A call to Compile_Sources must
294 -- precede the call to List_Depend. Also because this routine uses the
295 -- ALI files that were originally loaded and scanned by Compile_Sources,
296 -- no additional ALI files should be scanned between the two calls (i.e.
297 -- between the call to Compile_Sources and List_Depend.)
300 -- Prints out the program name followed by a colon, N and S.
303 -- Prints out the list of all files for which the compilation failed.
305 procedure Verbose_Msg
311 -- If the verbose flag (Verbose_Mode) is set then print Prefix to standard
312 -- output followed by N1 and S1. If N2 /= No_Name then N2 is then printed
313 -- after S1. S2 is printed last. Both N1 and N2 are printed in quotation
314 -- marks.
316 -----------------------
317 -- Gnatmake Routines --
318 -----------------------
325 -- Note that the notion of GNAT lib dir is no longer used. The code
326 -- related to it has not been removed to give an idea on how to use
327 -- the directory prefix marking mechanism.
329 -- An Ada library directory is a directory containing ali and object
330 -- files but no source files for the bodies (the specs can be in the
331 -- same or some other directory). These directories are specified
332 -- in the Gnatmake command line with the switch "-Adir" (to specify the
333 -- spec location -Idir cab be used). Gnatmake skips the missing sources
334 -- whose ali are in Ada library directories. For an explanation of why
335 -- Gnatmake behaves that way, see the spec of Make.Compile_Sources.
336 -- The directory lookup penalty is incurred every single time this
337 -- routine is called.
340 -- Verify that an external assignment switch is syntactically correct.
341 -- Correct forms are
342 -- -Xname=value
343 -- -X"name=other value"
344 -- Assumptions: 'First = 1, Argv (1 .. 2) = "-X"
345 -- When this function returns True, the external assignment has
346 -- been entered by a call to Prj.Ext.Add, so that in a project
347 -- file, External ("name") will return "value".
350 -- Get directory prefix of this file and get lib mark stored in name
351 -- table for this directory. Then check if an Ada lib mark has been set.
353 procedure Mark_Dir_Path
356 -- Invoke Mark_Directory on each directory of the path.
358 procedure Mark_Directory
361 -- Store Dir in name table and set lib mark as name info to identify
362 -- Ada libraries.
365 -- Returns the object file name suitable for switch -o.
367 procedure Set_Ada_Paths
370 -- Set, if necessary, env. variables ADA_INCLUDE_PATH and
371 -- ADA_OBJECTS_PATH.
372 --
373 -- Note: this will modify these environment variables only
374 -- for the current gnatmake process and all of its children
375 -- (invocations of the compiler, the binder and the linker).
376 -- The caller process ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
377 -- not affected.
379 procedure Set_Library_For
382 -- If Project is a library project, add the correct
383 -- -L and -l switches to the linker invocation.
387 -- Add the -L and -l switches to the linker for all
388 -- of the library projects.
390 ----------------------------------------------------
391 -- Compiler, Binder & Linker Data and Subprograms --
392 ----------------------------------------------------
397 -- Default compiler, binder, linker programs
402 -- Given by the command line. Will be used, if non null.
410 -- Path for compiler, binder, linker programs, defaulted now for gnatdist.
411 -- Changed later if overridden on command line.
421 Object_Suffix : constant String := Get_Object_Suffix.all;
422 Executable_Suffix : constant String := Get_Executable_Suffix.all;
424 Display_Executed_Programs : Boolean := True;
425 -- Set to True if name of commands should be output on stderr.
427 Output_File_Name_Seen : Boolean := False;
428 -- Set to True after having scanned the file_name for
429 -- switch "-o file_name"
431 File_Name_Seen : Boolean := False;
432 -- Set to true after having seen at least one file name.
433 -- Used in Scan_Make_Arg only, but must be a global variable.
435 type Make_Program_Type is (None, Compiler, Binder, Linker);
437 Program_Args : Make_Program_Type := None;
438 -- Used to indicate if we are scanning gcc, gnatbind, or gnatbl
439 -- options within the gnatmake command line.
440 -- Used in Scan_Make_Arg only, but must be a global variable.
442 procedure Add_Switches
443 (The_Package : Package_Id;
444 File_Name : String;
445 Program : Make_Program_Type);
446 procedure Add_Switch
447 (S : String_Access;
448 Program : Make_Program_Type;
449 Append_Switch : Boolean := True;
450 And_Save : Boolean := True);
451 procedure Add_Switch
452 (S : String;
453 Program : Make_Program_Type;
454 Append_Switch : Boolean := True;
455 And_Save : Boolean := True);
456 -- Make invokes one of three programs (the compiler, the binder or the
457 -- linker). For the sake of convenience, some program specific switches
458 -- can be passed directly on the gnatmake commande line. This procedure
459 -- records these switches so that gnamake can pass them to the right
460 -- program. S is the switch to be added at the end of the command line
461 -- for Program if Append_Switch is True. If Append_Switch is False S is
462 -- added at the beginning of the command line.
464 procedure Check
465 (Lib_File : File_Name_Type;
466 ALI : out ALI_Id;
467 O_File : out File_Name_Type;
468 O_Stamp : out Time_Stamp_Type);
469 -- Determines whether the library file Lib_File is up-to-date or not. The
470 -- full name (with path information) of the object file corresponding to
471 -- Lib_File is returned in O_File. Its time stamp is saved in O_Stamp.
472 -- ALI is the ALI_Id corresponding to Lib_File. If Lib_File in not
473 -- up-to-date, then the corresponding source file needs to be recompiled.
474 -- In this case ALI = No_ALI_Id.
476 procedure Check_Linker_Options
477 (E_Stamp : Time_Stamp_Type;
478 O_File : out File_Name_Type;
479 O_Stamp : out Time_Stamp_Type);
480 -- Checks all linker options for linker files that are newer
481 -- than E_Stamp. If such objects are found, the youngest object
482 -- is returned in O_File and its stamp in O_Stamp.
483 --
484 -- If no obsolete linker files were found, the first missing
485 -- linker file is returned in O_File and O_Stamp is empty.
486 -- Otherwise O_File is No_File.
488 procedure Display (Program : String; Args : Argument_List);
489 -- Displays Program followed by the arguments in Args if variable
490 -- Display_Executed_Programs is set. The lower bound of Args must be 1.
492 --------------------
493 -- Add_Object_Dir --
494 --------------------
496 procedure Add_Object_Dir (N : String) is
497 begin
498 Add_Lib_Search_Dir (N);
500 if Opt.Verbose_Mode then
501 Write_Str ("Adding object directory """);
502 Write_Str (N);
503 Write_Str (""".");
504 Write_Eol;
505 end if;
506 end Add_Object_Dir;
508 --------------------
509 -- Add_Source_Dir --
510 --------------------
512 procedure Add_Source_Dir (N : String) is
513 begin
514 Add_Src_Search_Dir (N);
516 if Opt.Verbose_Mode then
517 Write_Str ("Adding source directory """);
518 Write_Str (N);
519 Write_Str (""".");
520 Write_Eol;
521 end if;
522 end Add_Source_Dir;
524 ----------------
525 -- Add_Switch --
526 ----------------
528 procedure Add_Switch
529 (S : String_Access;
530 Program : Make_Program_Type;
531 Append_Switch : Boolean := True;
532 And_Save : Boolean := True)
533 is
534 generic
535 with package T is new Table.Table (<>);
536 function Generic_Position return Integer;
537 -- Generic procedure that adds S at the end or beginning of T depending
538 -- of the value of the boolean Append_Switch.
540 ----------------------
541 -- Generic_Position --
542 ----------------------
544 function Generic_Position return Integer is
545 begin
546 T.Increment_Last;
548 if Append_Switch then
549 return Integer (T.Last);
550 else
551 for J in reverse T.Table_Index_Type'Succ (T.First) .. T.Last loop
552 T.Table (J) := T.Table (T.Table_Index_Type'Pred (J));
553 end loop;
555 return Integer (T.First);
556 end if;
557 end Generic_Position;
559 function Gcc_Switches_Pos is new Generic_Position (Gcc_Switches);
560 function Binder_Switches_Pos is new Generic_Position (Binder_Switches);
561 function Linker_Switches_Pos is new Generic_Position (Linker_Switches);
563 function Saved_Gcc_Switches_Pos is new
564 Generic_Position (Saved_Gcc_Switches);
566 function Saved_Binder_Switches_Pos is new
567 Generic_Position (Saved_Binder_Switches);
569 function Saved_Linker_Switches_Pos is new
570 Generic_Position (Saved_Linker_Switches);
572 -- Start of processing for Add_Switch
574 begin
575 if And_Save then
576 case Program is
577 when Compiler =>
578 Saved_Gcc_Switches.Table (Saved_Gcc_Switches_Pos) := S;
580 when Binder =>
581 Saved_Binder_Switches.Table (Saved_Binder_Switches_Pos) := S;
583 when Linker =>
584 Saved_Linker_Switches.Table (Saved_Linker_Switches_Pos) := S;
586 when None =>
587 raise Program_Error;
588 end case;
590 else
591 case Program is
592 when Compiler =>
593 Gcc_Switches.Table (Gcc_Switches_Pos) := S;
595 when Binder =>
596 Binder_Switches.Table (Binder_Switches_Pos) := S;
598 when Linker =>
599 Linker_Switches.Table (Linker_Switches_Pos) := S;
601 when None =>
602 raise Program_Error;
603 end case;
604 end if;
605 end Add_Switch;
607 procedure Add_Switch
608 (S : String;
609 Program : Make_Program_Type;
610 Append_Switch : Boolean := True;
611 And_Save : Boolean := True)
612 is
613 begin
620 ------------------
621 -- Add_Switches --
622 ------------------
624 procedure Add_Switches
628 is
642 begin
646 Switches :=
674 Scan_Make_Arg
692 Scan_Make_Arg
699 ----------
700 -- Bind --
701 ----------
708 begin
711 -- Optimize the simple case where the gnatbind command line looks like
712 -- gnatbind -aO. -I- file.ali --into-> gnatbind file.adb
718 then
721 else
726 -- It is completely pointless to re-check source file time stamps.
727 -- This has been done already by gnatmake
737 Display (Gnatbind.all, Bind_Args (Args'First .. Bind_Last));
739 if Gnatbind_Path = null then
740 Osint.Fail ("error, unable to locate " & Gnatbind.all);
741 end if;
743 GNAT.OS_Lib.Spawn
744 (Gnatbind_Path.all, Bind_Args (Args'First .. Bind_Last), Success);
746 if not Success then
747 raise Bind_Failed;
748 end if;
749 end Bind;
751 -----------
752 -- Check --
753 -----------
755 procedure Check
756 (Lib_File : File_Name_Type;
757 ALI : out ALI_Id;
758 O_File : out File_Name_Type;
759 O_Stamp : out Time_Stamp_Type)
760 is
761 function First_New_Spec (A : ALI_Id) return File_Name_Type;
762 -- Looks in the with table entries of A and returns the spec file name
763 -- of the first withed unit (subprogram) for which no spec existed when
764 -- A was generated but for which there exists one now, implying that A
765 -- is now obsolete. If no such unit is found No_File is returned.
766 -- Otherwise the spec file name of the unit is returned.
767 --
768 -- **WARNING** in the event of Uname format modifications, one *MUST*
769 -- make sure this function is also updated.
770 --
771 -- Note: This function should really be in ali.adb and use Uname
772 -- services, but this causes the whole compiler to be dragged along
773 -- for gnatbind and gnatmake.
775 --------------------
776 -- First_New_Spec --
777 --------------------
779 function First_New_Spec (A : ALI_Id) return File_Name_Type is
780 Spec_File_Name : File_Name_Type := No_File;
782 function New_Spec (Uname : Unit_Name_Type) return Boolean;
783 -- Uname is the name of the spec or body of some ada unit.
784 -- This function returns True if the Uname is the name of a body
785 -- which has a spec not mentioned inali file A. If True is returned
786 -- Spec_File_Name above is set to the name of this spec file.
788 --------------
789 -- New_Spec --
790 --------------
792 function New_Spec (Uname : Unit_Name_Type) return Boolean is
793 Spec_Name : Unit_Name_Type;
794 File_Name : File_Name_Type;
796 begin
797 -- Test whether Uname is the name of a body unit (ie ends with %b)
799 Get_Name_String (Uname);
800 pragma
804 return False;
805 end if;
807 -- Convert unit name into spec name
809 -- ??? this code seems dubious in presence of pragma
810 -- Source_File_Name since there is no more direct relationship
811 -- between unit name and file name.
813 -- ??? Further, what about alternative subunit naming
816 Spec_Name := Name_Find;
817 File_Name := Get_File_Name (Spec_Name, Subunit => False);
819 -- Look if File_Name is mentioned in A's sdep list.
820 -- If not look if the file exists. If it does return True.
822 for D in
823 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
824 loop
825 if Sdep.Table (D).Sfile = File_Name then
826 return False;
827 end if;
828 end loop;
830 if Full_Source_Name (File_Name) /= No_File then
831 Spec_File_Name := File_Name;
832 return True;
833 end if;
835 return False;
836 end New_Spec;
838 -- Start of processing for First_New_Spec
840 begin
841 U_Chk : for U in
842 ALIs.Table (A).First_Unit .. ALIs.Table (A).Last_Unit
843 loop
844 exit U_Chk when Units.Table (U).Utype = Is_Body_Only
845 and then New_Spec (Units.Table (U).Uname);
847 for W in Units.Table (U).First_With
848 ..
849 Units.Table (U).Last_With
850 loop
851 exit U_Chk when
852 Withs.Table (W).Afile /= No_File
853 and then New_Spec (Withs.Table (W).Uname);
854 end loop;
855 end loop U_Chk;
857 return Spec_File_Name;
858 end First_New_Spec;
860 ---------------------------------
861 -- Data declarations for Check --
862 ---------------------------------
864 Full_Lib_File : File_Name_Type;
865 -- Full name of current library file
867 Full_Obj_File : File_Name_Type;
868 -- Full name of the object file corresponding to Lib_File.
870 Lib_Stamp : Time_Stamp_Type;
871 -- Time stamp of the current ada library file.
873 Obj_Stamp : Time_Stamp_Type;
874 -- Time stamp of the current object file.
876 Modified_Source : File_Name_Type;
877 -- The first source in Lib_File whose current time stamp differs
878 -- from that stored in Lib_File.
880 New_Spec : File_Name_Type;
881 -- If Lib_File contains in its W (with) section a body (for a
882 -- subprogram) for which there exists a spec and the spec did not
883 -- appear in the Sdep section of Lib_File, New_Spec contains the file
884 -- name of this new spec.
886 Source_Name : Name_Id;
887 Text : Text_Buffer_Ptr;
889 Prev_Switch : Character;
890 -- First character of previous switch processed
892 Arg : Arg_Id := Arg_Id'First;
893 -- Current index in Args.Table for a given unit (init to stop warning)
895 Switch_Found : Boolean;
896 -- True if a given switch has been found
898 Num_Args : Integer;
899 -- Number of compiler arguments processed
901 Special_Arg : Argument_List_Access;
902 -- Special arguments if any of a given compilation file
904 -- Start of processing for Check
906 begin
907 pragma Assert (Lib_File /= No_File);
909 Text := Read_Library_Info (Lib_File);
910 Full_Lib_File := Full_Library_Info_Name;
911 Full_Obj_File := Full_Object_File_Name;
912 Lib_Stamp := Current_Library_File_Stamp;
913 Obj_Stamp := Current_Object_File_Stamp;
915 if Full_Lib_File = No_File then
916 Verbose_Msg (Lib_File, "being checked ...", Prefix => " ");
917 else
918 Verbose_Msg (Full_Lib_File, "being checked ...", Prefix => " ");
919 end if;
921 ALI := No_ALI_Id;
922 O_File := Full_Obj_File;
923 O_Stamp := Obj_Stamp;
925 if Text = null then
926 if Full_Lib_File = No_File then
927 Verbose_Msg (Lib_File, "missing.");
930 Verbose_Msg (Full_Obj_File, "missing.");
932 else
933 Verbose_Msg
934 (Full_Lib_File, "(" & String (Lib_Stamp) & ") newer than",
935 Full_Obj_File, "(" & String (Obj_Stamp) & ")");
936 end if;
938 else
939 ALI := Scan_ALI (Lib_File, Text, Ignore_ED => False, Err => True);
940 Free (Text);
942 if ALI = No_ALI_Id then
943 Verbose_Msg (Full_Lib_File, "incorrectly formatted ALI file");
944 return;
946 elsif ALIs.Table (ALI).Ver (1 .. ALIs.Table (ALI).Ver_Len) /=
947 Library_Version
948 then
949 Verbose_Msg (Full_Lib_File, "compiled with old GNAT version");
950 ALI := No_ALI_Id;
951 return;
952 end if;
954 -- Don't take Ali file into account if it was generated without
955 -- object.
957 if Opt.Operating_Mode /= Opt.Check_Semantics
958 and then ALIs.Table (ALI).No_Object
959 then
960 Verbose_Msg (Full_Lib_File, "has no corresponding object");
961 ALI := No_ALI_Id;
962 return;
963 end if;
965 -- Check for matching compiler switches if needed
967 if Opt.Check_Switches then
968 Prev_Switch := ASCII.Nul;
969 Num_Args := 0;
971 Get_Name_String (ALIs.Table (ALI).Sfile);
973 for J in 1 .. Special_Args.Last loop
974 if Special_Args.Table (J).File.all =
975 Name_Buffer (1 .. Name_Len)
976 then
977 Special_Arg := Special_Args.Table (J).Args;
978 exit;
979 end if;
980 end loop;
982 if Main_Project /= No_Project then
983 null;
984 end if;
986 if Special_Arg = null then
987 for J in Gcc_Switches.First .. Gcc_Switches.Last loop
989 -- Skip non switches, -I and -o switches
992 or else
993 Gcc_Switches.Table (J) (1) = Switch_Character)
996 then
997 Num_Args := Num_Args + 1;
999 -- Comparing switches is delicate because gcc reorders
1000 -- a number of switches, according to lang-specs.h, but
1001 -- gnatmake doesn't have the sufficient knowledge to
1002 -- perform the same reordering. Instead, we ignore orders
1003 -- between different "first letter" switches, but keep
1004 -- orders between same switches, e.g -O -O2 is different
1005 -- than -O2 -O, but -g -O is equivalent to -O -g.
1007 if Gcc_Switches.Table (J) (2) /= Prev_Switch then
1008 Prev_Switch := Gcc_Switches.Table (J) (2);
1009 Arg :=
1010 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1011 end if;
1013 Switch_Found := False;
1015 for K in Arg ..
1016 Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1017 loop
1018 if Gcc_Switches.Table (J).all = Args.Table (K).all then
1019 Arg := K + 1;
1020 Switch_Found := True;
1021 exit;
1022 end if;
1023 end loop;
1025 if not Switch_Found then
1026 if Opt.Verbose_Mode then
1027 Verbose_Msg (ALIs.Table (ALI).Sfile,
1028 "switch mismatch");
1029 end if;
1031 ALI := No_ALI_Id;
1032 return;
1033 end if;
1034 end if;
1035 end loop;
1037 else
1038 for J in Special_Arg'Range loop
1040 -- Skip non switches, -I and -o switches
1043 or else Special_Arg (J) (1) = Switch_Character)
1046 then
1047 Num_Args := Num_Args + 1;
1049 if Special_Arg (J) (2) /= Prev_Switch then
1050 Prev_Switch := Special_Arg (J) (2);
1051 Arg :=
1052 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg;
1053 end if;
1055 Switch_Found := False;
1057 for K in Arg ..
1058 Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg
1059 loop
1060 if Special_Arg (J).all = Args.Table (K).all then
1061 Arg := K + 1;
1062 Switch_Found := True;
1063 exit;
1064 end if;
1065 end loop;
1067 if not Switch_Found then
1068 if Opt.Verbose_Mode then
1069 Verbose_Msg (ALIs.Table (ALI).Sfile,
1070 "switch mismatch");
1071 end if;
1073 ALI := No_ALI_Id;
1074 return;
1075 end if;
1076 end if;
1077 end loop;
1078 end if;
1080 if Num_Args /=
1081 Integer (Units.Table (ALIs.Table (ALI).First_Unit).Last_Arg -
1082 Units.Table (ALIs.Table (ALI).First_Unit).First_Arg + 1)
1083 then
1084 if Opt.Verbose_Mode then
1085 Verbose_Msg (ALIs.Table (ALI).Sfile,
1086 "different number of switches");
1087 end if;
1089 ALI := No_ALI_Id;
1090 return;
1091 end if;
1092 end if;
1094 -- Get the source files and their time stamps. Note that some
1095 -- sources may be missing if ALI is out-of-date.
1097 Set_Source_Table (ALI);
1099 Modified_Source := Time_Stamp_Mismatch (ALI);
1101 if Modified_Source /= No_File then
1102 ALI := No_ALI_Id;
1104 if Opt.Verbose_Mode then
1105 Source_Name := Full_Source_Name (Modified_Source);
1107 if Source_Name /= No_File then
1108 Verbose_Msg (Source_Name, "time stamp mismatch");
1109 else
1110 Verbose_Msg (Modified_Source, "missing");
1111 end if;
1112 end if;
1114 else
1115 New_Spec := First_New_Spec (ALI);
1117 if New_Spec /= No_File then
1118 ALI := No_ALI_Id;
1120 if Opt.Verbose_Mode then
1121 Source_Name := Full_Source_Name (New_Spec);
1123 if Source_Name /= No_File then
1124 Verbose_Msg (Source_Name, "new spec");
1125 else
1126 Verbose_Msg (New_Spec, "old spec missing");
1127 end if;
1128 end if;
1129 end if;
1130 end if;
1131 end if;
1132 end Check;
1134 --------------------------
1135 -- Check_Linker_Options --
1136 --------------------------
1138 procedure Check_Linker_Options
1139 (E_Stamp : Time_Stamp_Type;
1140 O_File : out File_Name_Type;
1141 O_Stamp : out Time_Stamp_Type)
1142 is
1143 procedure Check_File (File : File_Name_Type);
1144 -- Update O_File and O_Stamp if the given file is younger than E_Stamp
1145 -- and O_Stamp, or if O_File is No_File and File does not exist.
1147 function Get_Library_File (Name : String) return File_Name_Type;
1148 -- Return the full file name including path of a library based
1149 -- on the name specified with the -l linker option, using the
1150 -- Ada object path. Return No_File if no such file can be found.
1152 type Char_Array is array (Natural) of Character;
1153 type Char_Array_Access is access constant Char_Array;
1155 Template : Char_Array_Access;
1156 pragma Import (C, Template, "__gnat_library_template");
1158 ----------------
1159 -- Check_File --
1160 ----------------
1162 procedure Check_File (File : File_Name_Type) is
1163 Stamp : Time_Stamp_Type;
1164 Name : File_Name_Type := File;
1166 begin
1167 Get_Name_String (Name);
1169 -- Remove any trailing NUL characters
1171 while Name_Len >= Name_Buffer'First
1172 and then Name_Buffer (Name_Len) = NUL
1173 loop
1174 Name_Len := Name_Len - 1;
1175 end loop;
1177 if Name_Len <= 0 then
1178 return;
1180 elsif Name_Buffer (1) = Get_Switch_Character
1182 then
1183 -- Do not check if File is a switch other than "-l"
1186 return;
1187 end if;
1189 -- The argument is a library switch, get actual name. It
1190 -- is necessary to make a copy of the relevant part of
1191 -- Name_Buffer as Get_Library_Name uses Name_Buffer as well.
1193 declare
1194 Base_Name : constant String := Name_Buffer (3 .. Name_Len);
1196 begin
1197 Name := Get_Library_File (Base_Name);
1198 end;
1200 if Name = No_File then
1201 return;
1202 end if;
1203 end if;
1205 Stamp := File_Stamp (Name);
1207 -- Find the youngest object file that is younger than the
1208 -- executable. If no such file exist, record the first object
1209 -- file that is not found.
1211 if (O_Stamp < Stamp and then E_Stamp < Stamp)
1213 then
1214 O_Stamp := Stamp;
1215 O_File := Name;
1217 -- Strip the trailing NUL if present
1219 Get_Name_String (O_File);
1221 if Name_Buffer (Name_Len) = NUL then
1222 Name_Len := Name_Len - 1;
1223 O_File := Name_Find;
1224 end if;
1225 end if;
1226 end Check_File;
1228 ----------------------
1229 -- Get_Library_Name --
1230 ----------------------
1232 -- See comments in a-adaint.c about template syntax
1234 function Get_Library_File (Name : String) return File_Name_Type is
1235 File : File_Name_Type := No_File;
1237 begin
1238 Name_Len := 0;
1240 for Ptr in Template'Range loop
1241 case Template (Ptr) is
1243 Add_Str_To_Name_Buffer (Name);
1246 File := Full_Lib_File_Name (Name_Find);
1247 exit when File /= No_File;
1248 Name_Len := 0;
1250 when NUL =>
1251 exit;
1253 when others =>
1254 Add_Char_To_Name_Buffer (Template (Ptr));
1255 end case;
1256 end loop;
1258 -- The for loop exited because the end of the template
1259 -- was reached. File contains the last possible file name
1260 -- for the library.
1262 if File = No_File and then Name_Len > 0 then
1263 File := Full_Lib_File_Name (Name_Find);
1264 end if;
1266 return File;
1267 end Get_Library_File;
1269 -- Start of processing for Check_Linker_Options
1271 begin
1272 O_File := No_File;
1275 -- Process linker options from the ALI files.
1277 for Opt in 1 .. Linker_Options.Last loop
1278 Check_File (Linker_Options.Table (Opt).Name);
1279 end loop;
1281 -- Process options given on the command line.
1283 for Opt in Linker_Switches.First .. Linker_Switches.Last loop
1285 -- Check if the previous Opt has one of the two switches
1286 -- that take an extra parameter. (See GCC manual.)
1288 if Opt = Linker_Switches.First
1289 or else (Linker_Switches.Table (Opt - 1).all /= "-u"
1290 and then
1291 Linker_Switches.Table (Opt - 1).all /= "-Xlinker")
1292 then
1293 Name_Len := 0;
1294 Add_Str_To_Name_Buffer (Linker_Switches.Table (Opt).all);
1295 Check_File (Name_Find);
1296 end if;
1297 end loop;
1299 end Check_Linker_Options;
1301 ---------------------
1302 -- Compile_Sources --
1303 ---------------------
1305 procedure Compile_Sources
1306 (Main_Source : File_Name_Type;
1307 Args : Argument_List;
1308 First_Compiled_File : out Name_Id;
1309 Most_Recent_Obj_File : out Name_Id;
1310 Most_Recent_Obj_Stamp : out Time_Stamp_Type;
1311 Main_Unit : out Boolean;
1312 Compilation_Failures : out Natural;
1313 Check_Readonly_Files : Boolean := False;
1314 Do_Not_Execute : Boolean := False;
1315 Force_Compilations : Boolean := False;
1316 Keep_Going : Boolean := False;
1317 In_Place_Mode : Boolean := False;
1318 Initialize_ALI_Data : Boolean := True;
1319 Max_Process : Positive := 1)
1320 is
1321 function Compile
1322 (S : Name_Id;
1323 L : Name_Id;
1324 Args : Argument_List)
1325 return Process_Id;
1326 -- Compiles S using Args. If S is a GNAT predefined source
1327 -- "-gnatpg" is added to Args. Non blocking call. L corresponds to the
1328 -- expected library file name. Process_Id of the process spawned to
1329 -- execute the compile.
1331 type Compilation_Data is record
1332 Pid : Process_Id;
1333 Full_Source_File : File_Name_Type;
1334 Lib_File : File_Name_Type;
1335 Source_Unit : Unit_Name_Type;
1336 end record;
1338 Running_Compile : array (1 .. Max_Process) of Compilation_Data;
1339 -- Used to save information about outstanding compilations.
1341 Outstanding_Compiles : Natural := 0;
1342 -- Current number of outstanding compiles
1344 Source_Unit : Unit_Name_Type;
1345 -- Current source unit
1347 Source_File : File_Name_Type;
1348 -- Current source file
1350 Full_Source_File : File_Name_Type;
1351 -- Full name of the current source file
1353 Lib_File : File_Name_Type;
1354 -- Current library file
1356 Full_Lib_File : File_Name_Type;
1357 -- Full name of the current library file
1359 Obj_File : File_Name_Type;
1360 -- Full name of the object file corresponding to Lib_File.
1362 Obj_Stamp : Time_Stamp_Type;
1363 -- Time stamp of the current object file.
1365 Sfile : File_Name_Type;
1366 -- Contains the source file of the units withed by Source_File
1368 ALI : ALI_Id;
1369 -- ALI Id of the current ALI file
1371 Compilation_OK : Boolean;
1372 Need_To_Compile : Boolean;
1374 Pid : Process_Id;
1375 Text : Text_Buffer_Ptr;
1377 Data : Prj.Project_Data;
1379 Arg_Index : Natural;
1380 -- Index in Special_Args.Table of a given compilation file
1382 Need_To_Check_Standard_Library : Boolean := Check_Readonly_Files;
1384 procedure Add_Process
1385 (Pid : Process_Id;
1386 Sfile : File_Name_Type;
1387 Afile : File_Name_Type;
1388 Uname : Unit_Name_Type);
1389 -- Adds process Pid to the current list of outstanding compilation
1390 -- processes and record the full name of the source file Sfile that
1391 -- we are compiling, the name of its library file Afile and the
1392 -- name of its unit Uname.
1394 procedure Await_Compile
1395 (Sfile : out File_Name_Type;
1396 Afile : out File_Name_Type;
1397 Uname : out Unit_Name_Type;
1398 OK : out Boolean);
1399 -- Awaits that an outstanding compilation process terminates. When
1400 -- it does set Sfile to the name of the source file that was compiled
1401 -- Afile to the name of its library file and Uname to the name of its
1402 -- unit. Note that this time stamp can be used to check whether the
1403 -- compilation did generate an object file. OK is set to True if the
1404 -- compilation succeeded. Note that Sfile, Afile and Uname could be
1405 -- resp. No_File, No_File and No_Name if there were no compilations
1406 -- to wait for.
1408 procedure Collect_Arguments_And_Compile;
1409 -- Collect arguments from project file (if any) and compile
1411 package Good_ALI is new Table.Table (
1412 Table_Component_Type => ALI_Id,
1413 Table_Index_Type => Natural,
1414 Table_Low_Bound => 1,
1415 Table_Initial => 50,
1416 Table_Increment => 100,
1417 Table_Name => "Make.Good_ALI");
1418 -- Contains the set of valid ALI files that have not yet been scanned.
1420 procedure Record_Good_ALI (A : ALI_Id);
1421 -- Records in the previous set the Id of an ALI file.
1423 function Good_ALI_Present return Boolean;
1424 -- Returns True if any ALI file was recorded in the previous set.
1426 function Get_Next_Good_ALI return ALI_Id;
1427 -- Returns the next good ALI_Id record;
1429 procedure Record_Failure
1430 (File : File_Name_Type;
1431 Unit : Unit_Name_Type;
1432 Found : Boolean := True);
1433 -- Records in the previous table that the compilation for File failed.
1434 -- If Found is False then the compilation of File failed because we
1435 -- could not find it. Records also Unit when possible.
1437 function Bad_Compilation_Count return Natural;
1438 -- Returns the number of compilation failures.
1440 procedure Debug_Msg (S : String; N : Name_Id);
1441 -- If Debug.Debug_Flag_W is set outputs string S followed by name N.
1443 function Configuration_Pragmas_Switch
1444 (For_Project : Project_Id)
1445 return Argument_List;
1446 -- Return an argument list of one element, if there is a configuration
1447 -- pragmas file to be specified for For_Project,
1448 -- otherwise return an empty argument list.
1450 -----------------
1451 -- Add_Process --
1452 -----------------
1454 procedure Add_Process
1455 (Pid : Process_Id;
1456 Sfile : File_Name_Type;
1457 Afile : File_Name_Type;
1458 Uname : Unit_Name_Type)
1459 is
1460 OC1 : constant Positive := Outstanding_Compiles + 1;
1462 begin
1463 pragma Assert (OC1 <= Max_Process);
1464 pragma Assert (Pid /= Invalid_Pid);
1466 Running_Compile (OC1).Pid := Pid;
1467 Running_Compile (OC1).Full_Source_File := Sfile;
1468 Running_Compile (OC1).Lib_File := Afile;
1469 Running_Compile (OC1).Source_Unit := Uname;
1471 Outstanding_Compiles := OC1;
1472 end Add_Process;
1474 --------------------
1475 -- Await_Compile --
1476 -------------------
1478 procedure Await_Compile
1479 (Sfile : out File_Name_Type;
1480 Afile : out File_Name_Type;
1481 Uname : out File_Name_Type;
1482 OK : out Boolean)
1483 is
1484 Pid : Process_Id;
1486 begin
1487 pragma Assert (Outstanding_Compiles > 0);
1489 Sfile := No_File;
1490 Afile := No_File;
1491 Uname := No_Name;
1492 OK := False;
1494 Wait_Process (Pid, OK);
1496 if Pid = Invalid_Pid then
1497 return;
1498 end if;
1500 for J in Running_Compile'First .. Outstanding_Compiles loop
1501 if Pid = Running_Compile (J).Pid then
1502 Sfile := Running_Compile (J).Full_Source_File;
1503 Afile := Running_Compile (J).Lib_File;
1504 Uname := Running_Compile (J).Source_Unit;
1506 -- To actually remove this Pid and related info from
1507 -- Running_Compile replace its entry with the last valid
1508 -- entry in Running_Compile.
1510 if J = Outstanding_Compiles then
1511 null;
1513 else
1514 Running_Compile (J) :=
1515 Running_Compile (Outstanding_Compiles);
1516 end if;
1518 Outstanding_Compiles := Outstanding_Compiles - 1;
1519 return;
1520 end if;
1521 end loop;
1523 raise Program_Error;
1524 end Await_Compile;
1526 ---------------------------
1527 -- Bad_Compilation_Count --
1528 ---------------------------
1530 function Bad_Compilation_Count return Natural is
1531 begin
1532 return Bad_Compilation.Last - Bad_Compilation.First + 1;
1533 end Bad_Compilation_Count;
1535 -----------------------------------
1536 -- Collect_Arguments_And_Compile --
1537 -----------------------------------
1539 procedure Collect_Arguments_And_Compile is
1540 begin
1541 -- If no project file is used, then just call Compile with
1542 -- the specified Args.
1544 if Main_Project = No_Project then
1545 Pid := Compile (Full_Source_File, Lib_File, Args);
1547 -- A project file was used
1549 else
1550 -- First check if the current source is an immediate
1551 -- source of a project file.
1553 if Opt.Verbose_Mode then
1554 Write_Eol;
1555 Write_Line ("Establishing Project context.");
1556 end if;
1558 declare
1559 Source_File_Name : constant String :=
1560 Name_Buffer (1 .. Name_Len);
1561 Current_Project : Prj.Project_Id;
1562 Path_Name : File_Name_Type := Source_File;
1563 Compiler_Package : Prj.Package_Id;
1564 Switches : Prj.Variable_Value;
1565 Object_File : String_Access;
1567 begin
1568 if Opt.Verbose_Mode then
1569 Write_Str ("Checking if the Project File exists for """);
1570 Write_Str (Source_File_Name);
1571 Write_Line (""".");
1572 end if;
1574 Prj.Env.
1575 Get_Reference
1576 (Source_File_Name => Source_File_Name,
1577 Project => Current_Project,
1578 Path => Path_Name);
1580 if Current_Project = No_Project then
1582 -- The current source is not an immediate source of any
1583 -- project file. Call Compile with the specified Args plus
1584 -- the saved gcc switches.
1586 if Opt.Verbose_Mode then
1587 Write_Str ("No Project File.");
1588 Write_Eol;
1589 end if;
1591 Pid := Compile
1592 (Full_Source_File,
1593 Lib_File,
1594 Args & The_Saved_Gcc_Switches.all);
1596 -- We now know the project of the current source
1598 else
1599 -- Set ADA_INCLUDE_PATH and ADA_OBJECTS_PATH if the project
1600 -- has changed.
1602 -- Note: this will modify these environment variables only
1603 -- for the current gnatmake process and all of its children
1604 -- (invocations of the compiler, the binder and the linker).
1606 -- The caller's ADA_INCLUDE_PATH and ADA_OBJECTS_PATH are
1607 -- not affected.
1609 Set_Ada_Paths (Current_Project, True);
1611 Data := Projects.Table (Current_Project);
1613 -- Check if it is a library project that needs to be
1614 -- processed, only if it is not the main project.
1616 if MLib.Tgt.Libraries_Are_Supported
1617 and then Current_Project /= Main_Project
1618 and then Data.Library
1619 and then not Data.Flag1
1620 then
1621 -- Add to the Q all sources of the project that have
1622 -- not been marked
1624 Insert_Project_Sources
1625 (The_Project => Current_Project, Into_Q => True);
1627 -- Now mark the project as processed
1629 Data.Flag1 := True;
1630 Projects.Table (Current_Project).Flag1 := True;
1631 end if;
1633 Get_Name_String (Data.Object_Directory);
1636 or else Name_Buffer (Name_Len) = Directory_Separator
1637 then
1638 Object_File :=
1639 new String'
1643 else
1644 Object_File :=
1646 (Name_Buffer (1 .. Name_Len) &
1647 Directory_Separator &
1648 Object_File_Name (Source_File_Name));
1649 end if;
1651 if Opt.Verbose_Mode then
1652 Write_Str ("Project file is """);
1653 Write_Str (Get_Name_String (Data.Name));
1654 Write_Str (""".");
1655 Write_Eol;
1656 end if;
1658 -- We know look for package Compiler
1659 -- and get the switches from this package.
1661 if Opt.Verbose_Mode then
1662 Write_Str ("Checking package Compiler.");
1663 Write_Eol;
1664 end if;
1666 Compiler_Package :=
1667 Prj.Util.Value_Of
1668 (Name => Name_Compiler,
1669 In_Packages => Data.Decl.Packages);
1671 if Compiler_Package /= No_Package then
1673 if Opt.Verbose_Mode then
1674 Write_Str ("Getting the switches.");
1675 Write_Eol;
1676 end if;
1678 -- If package Gnatmake.Compiler exists, we get
1679 -- the specific switches for the current source,
1680 -- or the global switches, if any.
1682 declare
1683 Defaults : constant Array_Element_Id :=
1684 Prj.Util.Value_Of
1685 (Name => Name_Default_Switches,
1686 In_Arrays =>
1687 Packages.Table
1688 (Compiler_Package) .Decl.Arrays);
1690 Switches_Array : constant Array_Element_Id :=
1691 Prj.Util.Value_Of
1692 (Name => Name_Switches,
1693 In_Arrays =>
1694 Packages.Table
1695 (Compiler_Package).
1696 Decl.Arrays);
1698 begin
1699 Switches :=
1700 Prj.Util.Value_Of
1701 (Index => Source_File,
1702 In_Array => Switches_Array);
1704 if Switches = Nil_Variable_Value then
1705 Switches :=
1706 Prj.Util.Value_Of
1707 (Index => Name_Ada, In_Array => Defaults);
1708 end if;
1709 end;
1710 end if;
1712 case Switches.Kind is
1714 -- We have a list of switches. We add to Args
1715 -- these switches, plus the saved gcc switches.
1717 when List =>
1719 declare
1720 Current : String_List_Id := Switches.Values;
1721 Element : String_Element;
1722 Number : Natural := 0;
1724 begin
1725 while Current /= Nil_String loop
1726 Element := String_Elements.Table (Current);
1727 Number := Number + 1;
1728 Current := Element.Next;
1729 end loop;
1731 declare
1732 New_Args : Argument_List (1 .. Number);
1734 begin
1735 Current := Switches.Values;
1737 for Index in New_Args'Range loop
1738 Element := String_Elements.Table (Current);
1739 String_To_Name_Buffer (Element.Value);
1740 New_Args (Index) :=
1745 Pid := Compile
1747 Lib_File,
1749 Configuration_Pragmas_Switch
1755 -- We have a single switch. We add to Args
1756 -- this switch, plus the saved gcc switches.
1761 declare
1764 (Name_Buffer (1 .. Name_Len)));
1766 begin
1767 Pid := Compile
1768 (Path_Name,
1769 Lib_File,
1770 Args &
1771 Output_Flag &
1772 Object_File &
1773 New_Args &
1774 Configuration_Pragmas_Switch (Current_Project) &
1775 The_Saved_Gcc_Switches.all);
1776 end;
1778 -- We have no switches from Gnatmake.Compiler.
1779 -- We add to Args the saved gcc switches.
1781 when Undefined =>
1782 if Opt.Verbose_Mode then
1783 Write_Str ("There are no switches.");
1784 Write_Eol;
1785 end if;
1787 Pid := Compile
1788 (Path_Name,
1789 Lib_File,
1790 Args & Output_Flag & Object_File &
1791 Configuration_Pragmas_Switch (Current_Project) &
1792 The_Saved_Gcc_Switches.all);
1793 end case;
1794 end if;
1795 end;
1796 end if;
1797 end Collect_Arguments_And_Compile;
1799 -------------
1800 -- Compile --
1801 -------------
1803 function Compile (S : Name_Id; L : Name_Id; Args : Argument_List)
1804 return Process_Id
1805 is
1806 Comp_Args : Argument_List (Args'First .. Args'Last + 7);
1807 Comp_Next : Integer := Args'First;
1808 Comp_Last : Integer;
1810 function Ada_File_Name (Name : Name_Id) return Boolean;
1811 -- Returns True if Name is the name of an ada source file
1812 -- (i.e. suffix is .ads or .adb)
1814 -------------------
1815 -- Ada_File_Name --
1816 -------------------
1818 function Ada_File_Name (Name : Name_Id) return Boolean is
1819 begin
1820 Get_Name_String (Name);
1821 return
1822 Name_Len > 4
1823 and then Name_Buffer (Name_Len - 3 .. Name_Len - 1) = ".ad"
1825 or else
1827 end Ada_File_Name;
1829 -- Start of processing for Compile
1831 begin
1832 Comp_Args (Comp_Next) := Comp_Flag;
1833 Comp_Next := Comp_Next + 1;
1835 -- Optimize the simple case where the gcc command line looks like
1836 -- gcc -c -I. ... -I- file.adb --into-> gcc -c ... file.adb
1838 if Args (Args'First).all = "-I" & Normalized_CWD
1839 and then Args (Args'Last).all = "-I-"
1840 and then S = Strip_Directory (S)
1841 then
1842 Comp_Last := Comp_Next + Args'Length - 3;
1843 Comp_Args (Comp_Next .. Comp_Last) :=
1844 Args (Args'First + 1 .. Args'Last - 1);
1846 else
1847 Comp_Last := Comp_Next + Args'Length - 1;
1848 Comp_Args (Comp_Next .. Comp_Last) := Args;
1849 end if;
1851 -- Set -gnatpg for predefined files (for this purpose the renamings
1852 -- such as Text_IO do not count as predefined). Note that we strip
1853 -- the directory name from the source file name becase the call to
1854 -- Fname.Is_Predefined_File_Name cannot deal with directory prefixes.
1856 declare
1857 Fname : constant File_Name_Type := Strip_Directory (S);
1859 begin
1860 if Is_Predefined_File_Name (Fname, False) then
1861 if Check_Readonly_Files then
1862 Comp_Last := Comp_Last + 1;
1863 Comp_Args (Comp_Last) := GNAT_Flag;
1865 else
1866 Fail
1867 ("not allowed to compile """ &
1868 Get_Name_String (Fname) &
1869 """; use -a switch.");
1870 end if;
1871 end if;
1872 end;
1874 -- Now check if the file name has one of the suffixes familiar to
1875 -- the gcc driver. If this is not the case then add the ada flag
1876 -- "-x ada".
1878 if not Ada_File_Name (S) then
1879 Comp_Last := Comp_Last + 1;
1880 Comp_Args (Comp_Last) := Ada_Flag_1;
1881 Comp_Last := Comp_Last + 1;
1882 Comp_Args (Comp_Last) := Ada_Flag_2;
1883 end if;
1885 if L /= Strip_Directory (L) then
1887 -- Build -o argument.
1889 Get_Name_String (L);
1891 for J in reverse 1 .. Name_Len loop
1893 Name_Len := J + Object_Suffix'Length - 1;
1894 Name_Buffer (J .. Name_Len) := Object_Suffix;
1895 exit;
1896 end if;
1897 end loop;
1899 Comp_Last := Comp_Last + 1;
1900 Comp_Args (Comp_Last) := Output_Flag;
1901 Comp_Last := Comp_Last + 1;
1910 Display (Gcc.all, Comp_Args (Args'First .. Comp_Last));
1912 if Gcc_Path = null then
1913 Osint.Fail ("error, unable to locate " & Gcc.all);
1914 end if;
1916 return
1917 GNAT.OS_Lib.Non_Blocking_Spawn
1918 (Gcc_Path.all, Comp_Args (Args'First .. Comp_Last));
1919 end Compile;
1921 ----------------------------------
1922 -- Configuration_Pragmas_Switch --
1923 ----------------------------------
1925 function Configuration_Pragmas_Switch
1926 (For_Project : Project_Id)
1927 return Argument_List
1928 is
1929 begin
1930 Prj.Env.Create_Config_Pragmas_File (For_Project, Main_Project);
1932 if Projects.Table (For_Project).Config_File_Name /= No_Name then
1933 return
1935 Get_Name_String
1938 else
1943 ---------------
1944 -- Debug_Msg --
1945 ---------------
1948 begin
1954 Write_Eol;
1958 -----------------------
1959 -- Get_Next_Good_ALI --
1960 -----------------------
1965 begin
1972 ----------------------
1973 -- Good_ALI_Present --
1974 ----------------------
1977 begin
1981 --------------------
1982 -- Record_Failure --
1983 --------------------
1985 procedure Record_Failure
1989 is
1990 begin
1995 ---------------------
1996 -- Record_Good_ALI --
1997 ---------------------
2000 begin
2005 -- Start of processing for Compile_Sources
2007 begin
2010 -- Package and Queue initializations.
2015 Init_Q;
2018 Initialize_ALI;
2019 Initialize_ALI_Source;
2022 -- The following two flags affect the behavior of ALI.Set_Source_Table.
2023 -- We set Opt.Check_Source_Files to True to ensure that source file
2024 -- time stamps are checked, and we set Opt.All_Sources to False to
2025 -- avoid checking the presence of the source files listed in the
2026 -- source dependency section of an ali file (which would be a mistake
2027 -- since the ali file may be obsolete).
2032 -- If the main source is marked, there is nothing to compile.
2033 -- This can happen when we have several main subprograms.
2034 -- For the first main, we always insert in the Q.
2045 -- Keep looping until there is no more work to do (the Q is empty)
2046 -- and all the outstanding compilations have terminated
2050 -- If the user does not want to keep going in case of errors then
2051 -- wait for the remaining outstanding compiles and then exit.
2055 Await_Compile
2066 -- PHASE 1: Check if there is more work that we can do (ie the Q
2067 -- is non empty). If there is, do it only if we have not yet used
2068 -- up all the available processes.
2076 -- If the library file is an Ada library skip it
2080 then
2083 -- If the library file is a read-only library skip it
2086 and then not Check_Readonly_Files
2088 then
2089 Verbose_Msg
2092 -- The source file that we are checking cannot be located
2097 -- Source and library files can be located but are internal
2098 -- files
2100 elsif not Check_Readonly_Files
2103 then
2106 Fail
2112 Verbose_Msg
2115 -- The source file that we are checking can be located
2117 else
2118 -- Don't waste any time if we have to recompile anyway
2130 -- The ALI file is up-to-date. Record its Id.
2134 -- Record the time stamp of the most recent object file
2135 -- as long as no (re)compilations are needed.
2140 then
2145 else
2146 -- Is this the first file we have to compile?
2159 -- If the library file was not found, then save the
2160 -- library file near the source file.
2175 -- If the library file was found, then save the
2176 -- library file in the same place.
2178 else
2184 -- Check for special compilation flags
2189 -- Start the compilation and record it. We can do this
2190 -- because there is at least one free process.
2192 Collect_Arguments_And_Compile;
2194 -- Make sure we could successfully start the compilation
2198 else
2199 Add_Process
2206 -- PHASE 2: Now check if we should wait for a compilation to
2207 -- finish. This is the case if all the available processes are
2208 -- busy compiling sources or there is nothing else to do
2209 -- (that is the Q is empty and there are no good ALIs to process).
2213 and then not Good_ALI_Present
2215 then
2216 Await_Compile
2222 else
2223 -- Re-read the updated library file
2227 -- If no ALI file was generated by this compilation nothing
2228 -- more to do, otherwise scan the ali file and record it.
2229 -- If the scan fails, a previous ali file is inconsistent with
2230 -- the unit just compiled.
2233 ALI :=
2237 Inform
2240 else
2245 -- If we could not read the ALI file that was just generated
2246 -- then there could be a problem reading either the ALI or the
2247 -- corresponding object file (if Opt.Check_Object_Consistency
2248 -- is set Read_Library_Info checks that the time stamp of the
2249 -- object file is more recent than that of the ALI). For an
2250 -- example of problems caught by this test see [6625-009].
2252 else
2253 Inform
2263 -- PHASE 3: Check if we recorded good ALI files. If yes process
2264 -- them now in the order in which they have been recorded. There
2265 -- are two occasions in which we record good ali files. The first is
2266 -- in phase 1 when, after scanning an existing ALI file we realise
2267 -- it is up-to-date, the second instance is after a successful
2268 -- compilation.
2273 -- If we are processing the library file corresponding to the
2274 -- main source file check if this source can be a main unit.
2280 -- The following adds the standard library (s-stalib) to the
2281 -- list of files to be handled by gnatmake: this file and any
2282 -- files it depends on are always included in every bind,
2283 -- except in No_Run_Time mode, even if they are not
2284 -- in the explicit dependency list.
2286 -- However, to avoid annoying output about s-stalib.ali being
2287 -- read only, when "-v" is used, we add the standard library
2288 -- only when "-a" is used.
2294 declare
2297 begin
2300 Standard_Library_Package_Body_Name;
2311 -- Now insert in the Q the unmarked source files (i.e. those
2312 -- which have neever been inserted in the Q and hence never
2313 -- considered).
2317 loop
2320 loop
2329 elsif not Check_Readonly_Files
2331 then
2334 else
2350 Write_Eol;
2356 -- Compilation is finished
2358 -- Delete any temporary configuration pragma file
2361 declare
2364 begin
2369 Write_Str (Get_Name_String
2374 Delete_File
2379 -- Make sure that we don't have a config file for this
2380 -- project, in case when there are several mains.
2381 -- In this case, we will recreate another config file:
2382 -- we cannot reuse the one that we just deleted!
2394 -------------
2395 -- Display --
2396 -------------
2399 begin
2410 Write_Eol;
2414 ----------------------
2415 -- Display_Commands --
2416 ----------------------
2419 begin
2423 -------------
2424 -- Empty_Q --
2425 -------------
2428 begin
2435 Write_Eol;
2440 Write_Eol;
2446 ---------------------
2447 -- Extract_Failure --
2448 ---------------------
2450 procedure Extract_Failure
2454 is
2455 begin
2462 --------------------
2463 -- Extract_From_Q --
2464 --------------------
2466 procedure Extract_From_Q
2469 is
2473 begin
2478 Write_Eol;
2486 --------------
2487 -- Gnatmake --
2488 --------------
2492 -- The source file containing the main compilation unit
2497 -- Set to True by Compile_Sources if the Main_Source_File can be a
2498 -- main unit.
2501 -- The ali file corresponding to Main_Source_File
2504 -- The file name of an executable
2507 -- Non_Std_Executable is set to True when there is a possibility
2508 -- that the linker will not choose the correct executable file name.
2511 -- Executable_Obsolete is set to True for the first obsolete main
2512 -- and is never reset to False. Any subsequent main will always
2513 -- be rebuild (if we rebuild mains), even in the case when it is not
2514 -- really necessary, because it is too hard to decide.
2516 begin
2528 -- Do not check for an object file (".o") when compiling to
2529 -- Java bytecode since ".class" files are generated instead.
2531 Opt.Check_Object_Consistency := False;
2532 end if;
2534 if Opt.Verbose_Mode then
2535 Write_Eol;
2536 Write_Str ("GNATMAKE ");
2537 Write_Str (Gnatvsn.Gnat_Version_String);
2538 Write_Str (" Copyright 1995-2001 Free Software Foundation, Inc.");
2539 Write_Eol;
2540 end if;
2542 -- If no mains have been specified on the command line,
2543 -- and we are using a project file, we either find the main(s)
2544 -- in the attribute Main of the main project, or we put all
2545 -- the sources of the project file as mains.
2547 if Main_Project /= No_Project and then Osint.Number_Of_Files = 0 then
2548 Name_Len := 4;
2549 Name_Buffer (1 .. 4) := "main";
2551 declare
2552 Main_Id : constant Name_Id := Name_Find;
2554 Mains : constant Prj.Variable_Value :=
2555 Prj.Util.Value_Of
2556 (Variable_Name => Main_Id,
2557 In_Variables =>
2558 Projects.Table (Main_Project).Decl.Attributes);
2560 Value : String_List_Id := Mains.Values;
2562 begin
2563 -- The attribute Main is an empty list or not specified,
2564 -- or else gnatmake was invoked with the switch "-u".
2566 if Value = Prj.Nil_String or else Unique_Compile then
2568 -- First make sure that the binder and the linker
2569 -- will not be invoked.
2571 Do_Bind_Step := False;
2572 Do_Link_Step := False;
2574 -- Put all the sources in the queue
2576 Insert_Project_Sources
2577 (The_Project => Main_Project, Into_Q => False);
2579 else
2580 -- The attribute Main is not an empty list.
2581 -- Put all the main subprograms in the list as if there were
2582 -- specified on the command line.
2584 while Value /= Prj.Nil_String loop
2585 String_To_Name_Buffer (String_Elements.Table (Value).Value);
2586 Osint.Add_File (Name_Buffer (1 .. Name_Len));
2587 Value := String_Elements.Table (Value).Next;
2588 end loop;
2590 end if;
2591 end;
2593 end if;
2595 -- Output usage information if no files. Note that this can happen
2596 -- in the case of a project file that contains only subunits.
2598 if Osint.Number_Of_Files = 0 then
2599 Makeusg;
2600 Exit_Program (E_Fatal);
2602 end if;
2604 -- If -l was specified behave as if -n was specified
2606 if Opt.List_Dependencies then
2607 Opt.Do_Not_Execute := True;
2608 end if;
2610 -- Note that Osint.Next_Main_Source will always return the (possibly
2611 -- abbreviated file) without any directory information.
2613 Main_Source_File := Next_Main_Source;
2615 if Project_File_Name = null then
2616 Add_Switch ("-I-", Compiler, And_Save => True);
2617 Add_Switch ("-I-", Binder, And_Save => True);
2618 end if;
2620 if Opt.Look_In_Primary_Dir then
2622 Add_Switch
2623 ("-I" &
2624 Normalize_Directory_Name
2625 (Get_Primary_Src_Search_Directory.all).all,
2626 Compiler, Append_Switch => False,
2627 And_Save => False);
2629 Add_Switch ("-aO" & Normalized_CWD,
2630 Binder,
2631 Append_Switch => False,
2632 And_Save => False);
2633 end if;
2635 -- If the user wants a program without a main subprogram, add the
2636 -- appropriate switch to the binder.
2638 if Opt.No_Main_Subprogram then
2639 Add_Switch ("-z", Binder, And_Save => True);
2640 end if;
2642 if Main_Project /= No_Project then
2644 -- Find the file name of the main unit
2646 declare
2647 Main_Source_File_Name : constant String :=
2648 Get_Name_String (Main_Source_File);
2649 Main_Unit_File_Name : constant String :=
2650 Prj.Env.File_Name_Of_Library_Unit_Body
2651 (Name => Main_Source_File_Name,
2652 Project => Main_Project);
2654 The_Packages : constant Package_Id :=
2655 Projects.Table (Main_Project).Decl.Packages;
2657 Gnatmake : constant Prj.Package_Id :=
2658 Prj.Util.Value_Of
2659 (Name => Name_Builder,
2660 In_Packages => The_Packages);
2662 Binder_Package : constant Prj.Package_Id :=
2663 Prj.Util.Value_Of
2664 (Name => Name_Binder,
2665 In_Packages => The_Packages);
2667 Linker_Package : constant Prj.Package_Id :=
2668 Prj.Util.Value_Of
2669 (Name => Name_Linker,
2670 In_Packages => The_Packages);
2672 begin
2673 -- We fail if we cannot find the main source file
2674 -- as an immediate source of the main project file.
2676 if Main_Unit_File_Name = "" then
2680 else
2681 -- Remove any directory information from the main
2682 -- source file name.
2684 declare
2685 Pos : Natural := Main_Unit_File_Name'Last;
2687 begin
2688 loop
2689 exit when Pos < Main_Unit_File_Name'First or else
2690 Main_Unit_File_Name (Pos) = Directory_Separator;
2691 Pos := Pos - 1;
2692 end loop;
2694 Name_Len := Main_Unit_File_Name'Last - Pos;
2696 Name_Buffer (1 .. Name_Len) :=
2697 Main_Unit_File_Name
2698 (Pos + 1 .. Main_Unit_File_Name'Last);
2700 Main_Source_File := Name_Find;
2702 -- We only output the main source file if there is only one
2704 if Opt.Verbose_Mode and then Osint.Number_Of_Files = 1 then
2706 Write_Str (Main_Unit_File_Name
2707 (Pos + 1 .. Main_Unit_File_Name'Last));
2709 end if;
2710 end;
2711 end if;
2713 -- If there is a package gnatmake in the main project file, add
2714 -- the switches from it. We also add the switches from packages
2715 -- gnatbind and gnatlink, if any.
2717 if Gnatmake /= No_Package then
2719 -- If there is only one main, we attempt to get the gnatmake
2720 -- switches for this main (if any). If there are no specific
2721 -- switch for this particular main, get the general gnatmake
2722 -- switches (if any).
2724 if Osint.Number_Of_Files = 1 then
2725 if Opt.Verbose_Mode then
2727 Write_Str (Main_Unit_File_Name);
2729 end if;
2731 Add_Switches
2732 (File_Name => Main_Unit_File_Name,
2733 The_Package => Gnatmake,
2734 Program => None);
2736 else
2737 -- If there are several mains, we always get the general
2738 -- gnatmake switches (if any).
2741 -- we are guaranteed to always get the gneneral switches.
2743 Add_Switches
2745 The_Package => Gnatmake,
2746 Program => None);
2747 end if;
2749 end if;
2751 if Binder_Package /= No_Package then
2753 -- If there is only one main, we attempt to get the gnatbind
2754 -- switches for this main (if any). If there are no specific
2755 -- switch for this particular main, get the general gnatbind
2756 -- switches (if any).
2758 if Osint.Number_Of_Files = 1 then
2759 if Opt.Verbose_Mode then
2761 Write_Str (Main_Unit_File_Name);
2763 end if;
2765 Add_Switches
2766 (File_Name => Main_Unit_File_Name,
2767 The_Package => Binder_Package,
2768 Program => Binder);
2770 else
2771 -- If there are several mains, we always get the general
2772 -- gnatbind switches (if any).
2775 -- we are guaranteed to always get the gneneral switches.
2777 Add_Switches
2779 The_Package => Binder_Package,
2780 Program => Binder);
2781 end if;
2783 end if;
2785 if Linker_Package /= No_Package then
2787 -- If there is only one main, we attempt to get the
2788 -- gnatlink switches for this main (if any). If there are
2789 -- no specific switch for this particular main, we get the
2790 -- general gnatlink switches (if any).
2792 if Osint.Number_Of_Files = 1 then
2793 if Opt.Verbose_Mode then
2795 Write_Str (Main_Unit_File_Name);
2797 end if;
2799 Add_Switches
2800 (File_Name => Main_Unit_File_Name,
2801 The_Package => Linker_Package,
2802 Program => Linker);
2804 else
2805 -- If there are several mains, we always get the general
2806 -- gnatlink switches (if any).
2809 -- we are guaranteed to always get the general switches.
2811 Add_Switches
2813 The_Package => Linker_Package,
2814 Program => Linker);
2815 end if;
2816 end if;
2817 end;
2818 end if;
2820 Display_Commands (not Opt.Quiet_Output);
2822 -- We now put in the Binder_Switches and Linker_Switches tables,
2823 -- the binder and linker switches of the command line that have been
2824 -- put in the Saved_ tables. If a project file was used, then the
2825 -- command line switches will follow the project file switches.
2827 for J in 1 .. Saved_Binder_Switches.Last loop
2828 Add_Switch
2829 (Saved_Binder_Switches.Table (J),
2830 Binder,
2831 And_Save => False);
2832 end loop;
2834 for J in 1 .. Saved_Linker_Switches.Last loop
2835 Add_Switch
2836 (Saved_Linker_Switches.Table (J),
2837 Linker,
2838 And_Save => False);
2839 end loop;
2841 -- If no project file is used, we just put the gcc switches
2842 -- from the command line in the Gcc_Switches table.
2844 if Main_Project = No_Project then
2845 for J in 1 .. Saved_Gcc_Switches.Last loop
2846 Add_Switch
2847 (Saved_Gcc_Switches.Table (J),
2848 Compiler,
2849 And_Save => False);
2850 end loop;
2852 else
2853 -- And we put the command line gcc switches in the variable
2854 -- The_Saved_Gcc_Switches. They are going to be used later
2855 -- in procedure Compile_Sources.
2857 The_Saved_Gcc_Switches :=
2858 new Argument_List (1 .. Saved_Gcc_Switches.Last + 1);
2860 for J in 1 .. Saved_Gcc_Switches.Last loop
2861 The_Saved_Gcc_Switches (J) := Saved_Gcc_Switches.Table (J);
2862 end loop;
2864 -- We never use gnat.adc when a project file is used
2866 The_Saved_Gcc_Switches (The_Saved_Gcc_Switches'Last) :=
2867 No_gnat_adc;
2868 end if;
2870 -- If there was a --GCC, --GNATBIND or --GNATLINK switch on
2871 -- the command line, then we have to use it, even if there was
2872 -- another switch in the project file.
2874 if Saved_Gcc /= null then
2875 Gcc := Saved_Gcc;
2876 end if;
2878 if Saved_Gnatbind /= null then
2879 Gnatbind := Saved_Gnatbind;
2880 end if;
2882 if Saved_Gnatlink /= null then
2883 Gnatlink := Saved_Gnatlink;
2884 end if;
2886 Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
2887 Gnatbind_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
2888 Gnatlink_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
2890 -- If we have specified -j switch both from the project file
2891 -- and on the command line, the one from the command line takes
2892 -- precedence.
2894 if Saved_Maximum_Processes = 0 then
2895 Saved_Maximum_Processes := Opt.Maximum_Processes;
2896 end if;
2898 -- If either -c, -b or -l has been specified, we will not necessarily
2899 -- execute all steps.
2901 if Compile_Only or else Bind_Only or else Link_Only then
2902 Do_Compile_Step := Do_Compile_Step and Compile_Only;
2903 Do_Bind_Step := Do_Bind_Step and Bind_Only;
2904 Do_Link_Step := Do_Link_Step and Link_Only;
2906 -- If -c has been specified, but not -b, ignore any potential -l
2908 if Do_Compile_Step and then not Do_Bind_Step then
2909 Do_Link_Step := False;
2910 end if;
2911 end if;
2913 -- Here is where the make process is started
2915 -- We do the same process for each main
2917 Multiple_Main_Loop : for N_File in 1 .. Osint.Number_Of_Files loop
2919 if Do_Compile_Step then
2920 Recursive_Compilation_Step : declare
2921 Args : Argument_List (1 .. Gcc_Switches.Last);
2923 First_Compiled_File : Name_Id;
2925 Youngest_Obj_File : Name_Id;
2926 Youngest_Obj_Stamp : Time_Stamp_Type;
2928 Executable_Stamp : Time_Stamp_Type;
2929 -- Executable is the final executable program.
2931 begin
2932 Executable := No_File;
2933 Non_Std_Executable := False;
2935 for J in 1 .. Gcc_Switches.Last loop
2936 Args (J) := Gcc_Switches.Table (J);
2937 end loop;
2939 -- Look inside the linker switches to see if the name
2940 -- of the final executable program was specified.
2942 for J in Linker_Switches.First .. Linker_Switches.Last loop
2943 if Linker_Switches.Table (J).all = Output_Flag.all then
2944 pragma Assert (J < Linker_Switches.Last);
2946 -- We cannot specify a single executable for several
2947 -- main subprograms!
2949 if Osint.Number_Of_Files > 1 then
2950 Fail
2953 end if;
2955 Name_Len := Linker_Switches.Table (J + 1)'Length;
2956 Name_Buffer (1 .. Name_Len) :=
2957 Linker_Switches.Table (J + 1).all;
2959 -- If target has an executable suffix and it has not been
2960 -- specified then it is added here.
2962 if Executable_Suffix'Length /= 0
2963 and then Linker_Switches.Table (J + 1)
2964 (Name_Len - Executable_Suffix'Length + 1
2965 .. Name_Len) /= Executable_Suffix
2966 then
2967 Name_Buffer (Name_Len + 1 ..
2968 Name_Len + Executable_Suffix'Length) :=
2969 Executable_Suffix;
2970 Name_Len := Name_Len + Executable_Suffix'Length;
2971 end if;
2973 Executable := Name_Enter;
2976 end if;
2977 end loop;
2979 -- If the name of the final executable program was not
2980 -- specified then construct it from the main input file.
2982 if Executable = No_File then
2983 if Main_Project = No_Project then
2984 Executable :=
2985 Executable_Name (Strip_Suffix (Main_Source_File));
2987 else
2988 -- If we are using a project file, we attempt to
2989 -- remove the body (or spec) termination of the main
2990 -- subprogram. We find it the the naming scheme of the
2991 -- project file. This will avoid to generate an
2995 declare
2996 Body_Append : constant String :=
2997 Get_Name_String
2998 (Projects.Table
2999 (Main_Project).
3000 Naming.Current_Impl_Suffix);
3001 Spec_Append : constant String :=
3002 Get_Name_String
3003 (Projects.Table
3004 (Main_Project).
3005 Naming.Current_Spec_Suffix);
3007 begin
3008 Get_Name_String (Main_Source_File);
3010 if Name_Len > Body_Append'Length
3011 and then Name_Buffer
3012 (Name_Len - Body_Append'Length + 1 .. Name_Len) =
3013 Body_Append
3014 then
3015 -- We have found the body termination. We remove it
3016 -- add the executable termination (if any) and set
3017 -- Non_Std_Executable.
3019 Name_Len := Name_Len - Body_Append'Length;
3020 Executable := Executable_Name (Name_Find);
3021 Non_Std_Executable := True;
3023 elsif Name_Len > Spec_Append'Length
3024 and then
3025 Name_Buffer
3026 (Name_Len - Spec_Append'Length + 1 .. Name_Len) =
3027 Spec_Append
3028 then
3029 -- We have found the spec termination. We remove
3030 -- it, add the executable termination (if any),
3031 -- and set Non_Std_Executable.
3033 Name_Len := Name_Len - Spec_Append'Length;
3034 Executable := Executable_Name (Name_Find);
3035 Non_Std_Executable := True;
3037 else
3038 Executable :=
3039 Executable_Name (Strip_Suffix (Main_Source_File));
3040 end if;
3041 end;
3042 end if;
3043 end if;
3045 -- Now we invoke Compile_Sources for the current main
3047 Compile_Sources
3048 (Main_Source => Main_Source_File,
3049 Args => Args,
3050 First_Compiled_File => First_Compiled_File,
3051 Most_Recent_Obj_File => Youngest_Obj_File,
3052 Most_Recent_Obj_Stamp => Youngest_Obj_Stamp,
3053 Main_Unit => Is_Main_Unit,
3054 Compilation_Failures => Compilation_Failures,
3055 Check_Readonly_Files => Opt.Check_Readonly_Files,
3056 Do_Not_Execute => Opt.Do_Not_Execute,
3057 Force_Compilations => Opt.Force_Compilations,
3058 In_Place_Mode => Opt.In_Place_Mode,
3059 Keep_Going => Opt.Keep_Going,
3060 Initialize_ALI_Data => True,
3061 Max_Process => Saved_Maximum_Processes);
3063 if Opt.Verbose_Mode then
3065 Write_Eol;
3066 end if;
3068 if Compilation_Failures /= 0 then
3069 List_Bad_Compilations;
3070 raise Compilation_Failed;
3071 end if;
3073 -- Regenerate libraries, if any and if object files
3074 -- have been regenerated
3076 if Main_Project /= No_Project
3077 and then MLib.Tgt.Libraries_Are_Supported
3078 then
3080 for Proj in Projects.First .. Projects.Last loop
3082 if Proj /= Main_Project
3083 and then Projects.Table (Proj).Flag1
3084 then
3085 MLib.Prj.Build_Library (For_Project => Proj);
3086 end if;
3088 end loop;
3090 end if;
3092 if Opt.List_Dependencies then
3093 if First_Compiled_File /= No_File then
3094 Inform
3095 (First_Compiled_File,
3097 else
3098 List_Depend;
3099 end if;
3101 elsif First_Compiled_File = No_File
3102 and then not Do_Bind_Step
3103 and then not Opt.Quiet_Output
3104 and then Osint.Number_Of_Files = 1
3105 then
3106 if Unique_Compile then
3108 else
3110 end if;
3112 elsif Opt.Do_Not_Execute
3113 and then First_Compiled_File /= No_File
3114 then
3115 Write_Name (First_Compiled_File);
3116 Write_Eol;
3117 end if;
3119 -- Stop after compile step if any of:
3121 -- 1) -n (Do_Not_Execute) specified
3123 -- 2) -l (List_Dependencies) specified (also sets
3124 -- Do_Not_Execute above, so this is probably superfluous).
3126 -- 3) -c (Compile_Only) specified, but not -b (Bind_Only)
3128 -- 4) Made unit cannot be a main unit
3130 if (Opt.Do_Not_Execute
3131 or Opt.List_Dependencies
3132 or not Do_Bind_Step
3133 or not Is_Main_Unit)
3134 and then not No_Main_Subprogram
3135 then
3136 if Osint.Number_Of_Files = 1 then
3137 return;
3139 else
3140 goto Next_Main;
3141 end if;
3142 end if;
3144 -- If the objects were up-to-date check if the executable file
3145 -- is also up-to-date. For now always bind and link on the JVM
3146 -- since there is currently no simple way to check the
3147 -- up-to-date status of objects
3149 if not Hostparm.Java_VM
3150 and then First_Compiled_File = No_File
3151 then
3152 Executable_Stamp := File_Stamp (Executable);
3154 -- Once Executable_Obsolete is set to True, it is never
3155 -- reset to False, because it is too hard to accurately
3156 -- decide if a subsequent main need to be rebuilt or not.
3158 Executable_Obsolete :=
3159 Executable_Obsolete
3160 or else Youngest_Obj_Stamp > Executable_Stamp;
3162 if not Executable_Obsolete then
3164 -- If no Ada object files obsolete the executable, check
3165 -- for younger or missing linker files.
3167 Check_Linker_Options
3168 (Executable_Stamp,
3169 Youngest_Obj_File,
3170 Youngest_Obj_Stamp);
3172 Executable_Obsolete := Youngest_Obj_File /= No_File;
3173 end if;
3175 -- Return if the executable is up to date
3176 -- and otherwise motivate the relink/rebind.
3178 if not Executable_Obsolete then
3179 if not Opt.Quiet_Output then
3181 end if;
3183 if Osint.Number_Of_Files = 1 then
3184 return;
3186 else
3187 goto Next_Main;
3188 end if;
3189 end if;
3191 if Executable_Stamp (1) = ' ' then
3194 elsif Youngest_Obj_Stamp (1) = ' ' then
3195 Verbose_Msg
3196 (Youngest_Obj_File,
3200 elsif Youngest_Obj_Stamp > Executable_Stamp then
3201 Verbose_Msg
3202 (Youngest_Obj_File,
3204 Executable,
3207 else
3208 Verbose_Msg
3212 end if;
3213 end if;
3214 end Recursive_Compilation_Step;
3216 end if;
3218 -- If we are here, it means that we need to rebuilt the current
3219 -- main. So we set Executable_Obsolete to True to make sure that
3220 -- the subsequent mains will be rebuilt.
3222 Executable_Obsolete := True;
3224 Main_ALI_In_Place_Mode_Step :
3225 declare
3226 ALI_File : File_Name_Type;
3227 Src_File : File_Name_Type;
3229 begin
3230 Src_File := Strip_Directory (Main_Source_File);
3231 ALI_File := Lib_File_Name (Src_File);
3232 Main_ALI_File := Full_Lib_File_Name (ALI_File);
3234 -- When In_Place_Mode, the library file can be located in the
3235 -- Main_Source_File directory which may not be present in the
3236 -- library path. In this case, use the corresponding library file
3237 -- name.
3239 if Main_ALI_File = No_File and then Opt.In_Place_Mode then
3240 Get_Name_String (Get_Directory (Full_Source_Name (Src_File)));
3241 Get_Name_String_And_Append (ALI_File);
3242 Main_ALI_File := Name_Find;
3243 Main_ALI_File := Full_Lib_File_Name (Main_ALI_File);
3244 end if;
3246 pragma Assert (Main_ALI_File /= No_File);
3247 end Main_ALI_In_Place_Mode_Step;
3249 if Do_Bind_Step then
3250 Bind_Step : declare
3251 Args : Argument_List
3252 (Binder_Switches.First .. Binder_Switches.Last);
3254 begin
3255 -- Get all the binder switches
3257 for J in Binder_Switches.First .. Binder_Switches.Last loop
3258 Args (J) := Binder_Switches.Table (J);
3259 end loop;
3261 if Main_Project /= No_Project then
3263 -- Put all the source directories in ADA_INCLUDE_PATH,
3264 -- and all the object directories in ADA_OBJECTS_PATH
3266 Set_Ada_Paths (Main_Project, False);
3267 end if;
3269 Bind (Main_ALI_File, Args);
3270 end Bind_Step;
3272 end if;
3274 if Do_Link_Step then
3276 Link_Step : declare
3277 There_Are_Libraries : Boolean := False;
3278 Linker_Switches_Last : constant Integer := Linker_Switches.Last;
3280 begin
3282 if Main_Project /= No_Project then
3284 if MLib.Tgt.Libraries_Are_Supported then
3285 Set_Libraries (Main_Project, There_Are_Libraries);
3286 end if;
3288 if There_Are_Libraries then
3290 -- Add -L<lib_dir> -lgnarl -lgnat -Wl,-rpath,<lib_dir>
3292 Linker_Switches.Increment_Last;
3293 Linker_Switches.Table (Linker_Switches.Last) :=
3295 Linker_Switches.Increment_Last;
3296 Linker_Switches.Table (Linker_Switches.Last) :=
3298 Linker_Switches.Increment_Last;
3299 Linker_Switches.Table (Linker_Switches.Last) :=
3302 declare
3303 Option : constant String_Access :=
3304 MLib.Tgt.Linker_Library_Path_Option
3305 (MLib.Utl.Lib_Directory);
3307 begin
3308 if Option /= null then
3309 Linker_Switches.Increment_Last;
3310 Linker_Switches.Table (Linker_Switches.Last) :=
3311 Option;
3312 end if;
3314 end;
3316 end if;
3318 -- Put the object directories in ADA_OBJECTS_PATH
3320 Set_Ada_Paths (Main_Project, False);
3321 end if;
3323 declare
3324 Args : Argument_List
3325 (Linker_Switches.First .. Linker_Switches.Last + 2);
3327 begin
3328 -- Get all the linker switches
3330 for J in Linker_Switches.First .. Linker_Switches.Last loop
3331 Args (J) := Linker_Switches.Table (J);
3332 end loop;
3334 -- And invoke the linker
3336 if Non_Std_Executable then
3338 Args (Linker_Switches.Last + 2) :=
3339 new String'(Get_Name_String (Executable));
3340 Link (Main_ALI_File, Args);
3342 else
3343 Link
3344 (Main_ALI_File,
3345 Args (Linker_Switches.First .. Linker_Switches.Last));
3346 end if;
3348 end;
3350 Linker_Switches.Set_Last (Linker_Switches_Last);
3351 end Link_Step;
3353 end if;
3355 -- We go to here when we skip the bind and link steps.
3357 <<Next_Main>>
3359 -- We go to the next main, if we did not process the last one
3361 if N_File < Osint.Number_Of_Files then
3362 Main_Source_File := Next_Main_Source;
3364 if Main_Project /= No_Project then
3366 -- Find the file name of the main unit
3368 declare
3369 Main_Source_File_Name : constant String :=
3370 Get_Name_String (Main_Source_File);
3372 Main_Unit_File_Name : constant String :=
3373 Prj.Env.
3374 File_Name_Of_Library_Unit_Body
3375 (Name => Main_Source_File_Name,
3376 Project => Main_Project);
3378 begin
3379 -- We fail if we cannot find the main source file
3380 -- as an immediate source of the main project file.
3384 """ is not a unit of project " &
3385 Project_File_Name.all & ".");
3387 else
3388 -- Remove any directory information from the main
3389 -- source file name.
3391 declare
3392 Pos : Natural := Main_Unit_File_Name'Last;
3394 begin
3395 loop
3396 exit when Pos < Main_Unit_File_Name'First
3397 or else
3398 Main_Unit_File_Name (Pos) = Directory_Separator;
3399 Pos := Pos - 1;
3400 end loop;
3402 Name_Len := Main_Unit_File_Name'Last - Pos;
3404 Name_Buffer (1 .. Name_Len) :=
3405 Main_Unit_File_Name
3406 (Pos + 1 .. Main_Unit_File_Name'Last);
3408 Main_Source_File := Name_Find;
3409 end;
3410 end if;
3411 end;
3412 end if;
3413 end if;
3414 end loop Multiple_Main_Loop;
3416 Exit_Program (E_Success);
3418 exception
3419 when Bind_Failed =>
3420 Osint.Fail ("*** bind failed.");
3422 when Compilation_Failed =>
3423 Exit_Program (E_Fatal);
3425 when Link_Failed =>
3426 Osint.Fail ("*** link failed.");
3428 when X : others =>
3429 Write_Line (Exception_Information (X));
3430 Osint.Fail ("INTERNAL ERROR. Please report.");
3432 end Gnatmake;
3434 --------------------
3435 -- In_Ada_Lib_Dir --
3436 --------------------
3438 function In_Ada_Lib_Dir (File : File_Name_Type) return Boolean is
3439 D : constant Name_Id := Get_Directory (File);
3440 B : constant Byte := Get_Name_Table_Byte (D);
3442 begin
3443 return (B and Ada_Lib_Dir) /= 0;
3444 end In_Ada_Lib_Dir;
3446 ------------
3447 -- Inform --
3448 ------------
3450 procedure Inform (N : Name_Id := No_Name; Msg : String) is
3451 begin
3452 Osint.Write_Program_Name;
3454 Write_Str (": ");
3456 if N /= No_Name then
3457 Write_Str ("""");
3458 Write_Name (N);
3459 Write_Str (""" ");
3460 end if;
3462 Write_Str (Msg);
3463 Write_Eol;
3464 end Inform;
3466 ------------
3467 -- Init_Q --
3468 ------------
3470 procedure Init_Q is
3471 begin
3472 First_Q_Initialization := False;
3473 Q_Front := Q.First;
3474 Q.Set_Last (Q.First);
3475 end Init_Q;
3477 ----------------
3478 -- Initialize --
3479 ----------------
3481 procedure Initialize is
3482 Next_Arg : Positive;
3484 begin
3485 -- Override default initialization of Check_Object_Consistency
3486 -- since this is normally False for GNATBIND, but is True for
3487 -- GNATMAKE since we do not need to check source consistency
3488 -- again once GNATMAKE has looked at the sources to check.
3490 Opt.Check_Object_Consistency := True;
3492 -- Package initializations. The order of calls is important here.
3494 Output.Set_Standard_Error;
3495 Osint.Initialize (Osint.Make);
3497 Gcc_Switches.Init;
3498 Binder_Switches.Init;
3499 Linker_Switches.Init;
3501 Csets.Initialize;
3502 Namet.Initialize;
3504 Snames.Initialize;
3506 Prj.Initialize;
3508 Next_Arg := 1;
3509 Scan_Args : while Next_Arg <= Argument_Count loop
3510 Scan_Make_Arg (Argument (Next_Arg), And_Save => True);
3511 Next_Arg := Next_Arg + 1;
3512 end loop Scan_Args;
3514 if Usage_Requested then
3515 Makeusg;
3516 end if;
3518 -- Test for trailing -o switch
3520 if Opt.Output_File_Name_Present
3521 and then not Output_File_Name_Seen
3522 then
3523 Fail ("output file name missing after -o");
3524 end if;
3526 if Project_File_Name /= null then
3528 -- A project file was specified by a -P switch
3530 if Opt.Verbose_Mode then
3531 Write_Eol;
3532 Write_Str ("Parsing Project File """);
3533 Write_Str (Project_File_Name.all);
3534 Write_Str (""".");
3535 Write_Eol;
3536 end if;
3538 -- Avoid looking in the current directory for ALI files
3540 -- Opt.Look_In_Primary_Dir := False;
3542 -- Set the project parsing verbosity to whatever was specified
3543 -- by a possible -vP switch.
3545 Prj.Pars.Set_Verbosity (To => Current_Verbosity);
3547 -- Parse the project file.
3548 -- If there is an error, Main_Project will still be No_Project.
3550 Prj.Pars.Parse
3551 (Project => Main_Project,
3552 Project_File_Name => Project_File_Name.all);
3554 if Main_Project = No_Project then
3555 Fail ("""" & Project_File_Name.all &
3556 """ processing failed");
3557 end if;
3559 if Opt.Verbose_Mode then
3560 Write_Eol;
3561 Write_Str ("Parsing of Project File """);
3562 Write_Str (Project_File_Name.all);
3563 Write_Str (""" is finished.");
3564 Write_Eol;
3565 end if;
3567 -- We add the source directories and the object directories
3568 -- to the search paths.
3570 Add_Source_Directories (Main_Project);
3571 Add_Object_Directories (Main_Project);
3573 end if;
3575 Osint.Add_Default_Search_Dirs;
3577 -- Mark the GNAT libraries if needed.
3579 -- Source file lookups should be cached for efficiency.
3580 -- Source files are not supposed to change.
3582 Osint.Source_File_Data (Cache => True);
3584 -- Read gnat.adc file to initialize Fname.UF
3586 Fname.UF.Initialize;
3588 begin
3589 Fname.SF.Read_Source_File_Name_Pragmas;
3591 exception
3592 when Err : SFN_Scan.Syntax_Error_In_GNAT_ADC =>
3593 Osint.Fail (Exception_Message (Err));
3594 end;
3596 end Initialize;
3598 -----------------------------------
3599 -- Insert_Project_Sources_Into_Q --
3600 -----------------------------------
3602 procedure Insert_Project_Sources
3603 (The_Project : Project_Id;
3604 Into_Q : Boolean)
3605 is
3606 Unit : Com.Unit_Data;
3607 Sfile : Name_Id;
3609 begin
3610 -- For all the sources in the project files,
3612 for Id in Com.Units.First .. Com.Units.Last loop
3613 Unit := Com.Units.Table (Id);
3614 Sfile := No_Name;
3616 -- If there is a source for the body,
3618 if Unit.File_Names (Com.Body_Part).Name /= No_Name then
3620 -- And it is a source of the specified project
3622 if Unit.File_Names (Com.Body_Part).Project = The_Project then
3624 -- If we don't have a spec, we cannot consider the source
3625 -- if it is a subunit
3627 if Unit.File_Names (Com.Specification).Name = No_Name then
3628 declare
3629 Src_Ind : Source_File_Index;
3631 begin
3632 Src_Ind := Sinput.L.Load_Source_File
3633 (Unit.File_Names (Com.Body_Part).Name);
3635 -- If it is a subunit, discard it
3637 if Sinput.L.Source_File_Is_Subunit (Src_Ind) then
3638 Sfile := No_Name;
3640 else
3641 Sfile := Unit.File_Names (Com.Body_Part).Name;
3642 end if;
3643 end;
3645 else
3646 Sfile := Unit.File_Names (Com.Body_Part).Name;
3647 end if;
3648 end if;
3650 elsif Unit.File_Names (Com.Specification).Name /= No_Name
3651 and then Unit.File_Names (Com.Specification).Project = The_Project
3652 then
3653 -- If there is no source for the body, but there is a source
3654 -- for the spec, then we take this one.
3656 Sfile := Unit.File_Names (Com.Specification).Name;
3657 end if;
3659 -- If Into_Q is True, we insert into the Q
3661 if Into_Q then
3663 -- For the first source inserted into the Q, we need
3664 -- to initialize the Q, but not for the subsequent sources.
3666 if First_Q_Initialization then
3667 Init_Q;
3668 end if;
3670 -- And of course, we only insert in the Q if the source
3671 -- is not marked.
3673 if Sfile /= No_Name and then not Is_Marked (Sfile) then
3674 Insert_Q (Sfile);
3675 Mark (Sfile);
3676 end if;
3678 elsif Sfile /= No_Name then
3680 -- If Into_Q is False, we add the source as it it were
3681 -- specified on the command line.
3683 Osint.Add_File (Get_Name_String (Sfile));
3684 end if;
3685 end loop;
3686 end Insert_Project_Sources;
3688 --------------
3689 -- Insert_Q --
3690 --------------
3692 procedure Insert_Q
3693 (Source_File : File_Name_Type;
3694 Source_Unit : Unit_Name_Type := No_Name)
3695 is
3696 begin
3697 if Debug.Debug_Flag_Q then
3698 Write_Str (" Q := Q + [ ");
3699 Write_Name (Source_File);
3700 Write_Str (" ] ");
3701 Write_Eol;
3702 end if;
3704 Q.Table (Q.Last).File := Source_File;
3705 Q.Table (Q.Last).Unit := Source_Unit;
3706 Q.Increment_Last;
3707 end Insert_Q;
3709 ----------------------------
3710 -- Is_External_Assignment --
3711 ----------------------------
3713 function Is_External_Assignment (Argv : String) return Boolean is
3714 Start : Positive := 3;
3715 Finish : Natural := Argv'Last;
3716 Equal_Pos : Natural;
3718 begin
3719 if Argv'Last < 5 then
3720 return False;
3724 return False;
3725 else
3726 Start := 4;
3727 Finish := Argv'Last - 1;
3728 end if;
3729 end if;
3731 Equal_Pos := Start;
3734 Equal_Pos := Equal_Pos + 1;
3735 end loop;
3737 if Equal_Pos = Start
3738 or else Equal_Pos >= Finish
3739 then
3740 return False;
3742 else
3743 Prj.Ext.Add
3744 (External_Name => Argv (Start .. Equal_Pos - 1),
3745 Value => Argv (Equal_Pos + 1 .. Finish));
3746 return True;
3747 end if;
3748 end Is_External_Assignment;
3750 ---------------
3751 -- Is_Marked --
3752 ---------------
3754 function Is_Marked (Source_File : File_Name_Type) return Boolean is
3755 begin
3756 return Get_Name_Table_Byte (Source_File) /= 0;
3757 end Is_Marked;
3759 ----------
3760 -- Link --
3761 ----------
3763 procedure Link (ALI_File : File_Name_Type; Args : Argument_List) is
3764 Link_Args : Argument_List (Args'First .. Args'Last + 1);
3765 Success : Boolean;
3767 begin
3768 Link_Args (Args'Range) := Args;
3770 Get_Name_String (ALI_File);
3786 ---------------------------
3787 -- List_Bad_Compilations --
3788 ---------------------------
3791 begin
3797 else
3803 -----------------
3804 -- List_Depend --
3805 -----------------
3816 begin
3817 Set_Standard_Output;
3822 -- We have to provide the full library file name in In_Place_Mode
3840 and then not Check_Readonly_Files
3841 then
3843 else
3853 Write_Eol;
3854 Line_Pos := 0;
3855 end if;
3857 Line_Pos := Line_Pos + Len + 1;
3860 Write_Name (Src_Name);
3861 end if;
3862 end loop;
3864 Write_Eol;
3865 end loop;
3867 Set_Standard_Error;
3868 end List_Depend;
3870 ----------
3871 -- Mark --
3872 ----------
3874 procedure Mark (Source_File : File_Name_Type) is
3875 begin
3876 Set_Name_Table_Byte (Source_File, 1);
3877 end Mark;
3879 -------------------
3880 -- Mark_Dir_Path --
3881 -------------------
3883 procedure Mark_Dir_Path
3884 (Path : String_Access;
3885 Mark : Lib_Mark_Type)
3886 is
3887 Dir : String_Access;
3889 begin
3890 if Path /= null then
3891 Osint.Get_Next_Dir_In_Path_Init (Path);
3893 loop
3894 Dir := Osint.Get_Next_Dir_In_Path (Path);
3895 exit when Dir = null;
3896 Mark_Directory (Dir.all, Mark);
3897 end loop;
3898 end if;
3899 end Mark_Dir_Path;
3901 --------------------
3902 -- Mark_Directory --
3903 --------------------
3905 procedure Mark_Directory
3906 (Dir : String;
3907 Mark : Lib_Mark_Type)
3908 is
3909 N : Name_Id;
3910 B : Byte;
3912 begin
3913 -- Dir last character is supposed to be a directory separator.
3915 Name_Len := Dir'Length;
3916 Name_Buffer (1 .. Name_Len) := Dir;
3918 if not Is_Directory_Separator (Name_Buffer (Name_Len)) then
3919 Name_Len := Name_Len + 1;
3920 Name_Buffer (Name_Len) := Directory_Separator;
3921 end if;
3923 -- Add flags to the already existing flags
3925 N := Name_Find;
3926 B := Get_Name_Table_Byte (N);
3927 Set_Name_Table_Byte (N, B or Mark);
3928 end Mark_Directory;
3930 ----------------------
3931 -- Object_File_Name --
3932 ----------------------
3934 function Object_File_Name (Source : String) return String is
3935 Pos : Natural := Source'Last;
3937 begin
3938 while Pos >= Source'First and then
3939 Source (Pos) /= '.' loop
3940 Pos := Pos - 1;
3941 end loop;
3943 if Pos >= Source'First then
3944 Pos := Pos - 1;
3945 end if;
3947 return Source (Source'First .. Pos) & Object_Suffix;
3948 end Object_File_Name;
3950 -------------------
3951 -- Scan_Make_Arg --
3952 -------------------
3954 procedure Scan_Make_Arg (Argv : String; And_Save : Boolean) is
3955 begin
3956 pragma Assert (Argv'First = 1);
3958 if Argv'Length = 0 then
3959 return;
3960 end if;
3962 -- If the previous switch has set the Output_File_Name_Present
3963 -- flag (that is we have seen a -o), then the next argument is
3964 -- the name of the output executable.
3966 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
3967 Output_File_Name_Seen := True;
3969 if Argv (1) = Switch_Character or else Argv (1) = '-' then
3971 else
3974 -- Automatically add the executable suffix if it has not been
3975 -- specified explicitly.
3977 if Executable_Suffix'Length /= 0
3978 and then Argv (Argv'Last - Executable_Suffix'Length + 1
3979 .. Argv'Last) /= Executable_Suffix
3980 then
3981 Add_Switch
3982 (Argv & Executable_Suffix,
3983 Linker,
3984 And_Save => And_Save);
3985 else
3986 Add_Switch (Argv, Linker, And_Save => And_Save);
3987 end if;
3988 end if;
3990 -- Then check if we are dealing with a -cargs, -bargs or -largs
3992 elsif (Argv (1) = Switch_Character or else Argv (1) = '-')
3996 then
3997 if not File_Name_Seen then
4000 end if;
4002 case Argv (2) is
4003 when 'c' => Program_Args := Compiler;
4004 when 'b' => Program_Args := Binder;
4005 when 'l' => Program_Args := Linker;
4007 when others =>
4008 raise Program_Error;
4009 end case;
4011 -- A special test is needed for the -o switch within a -largs
4012 -- since that is another way to specify the name of the final
4013 -- executable.
4015 elsif Program_Args = Linker
4016 and then (Argv (1) = Switch_Character or else Argv (1) = '-')
4018 then
4021 -- Check to see if we are reading switches after a -cargs,
4022 -- -bargs or -largs switch. If yes save it.
4024 elsif Program_Args /= None then
4026 -- Check to see if we are reading -I switches in order
4027 -- to take into account in the src & lib search directories.
4031 Opt.Look_In_Primary_Dir := False;
4033 elsif Program_Args = Compiler then
4035 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
4037 end if;
4039 elsif Program_Args = Binder then
4040 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
4042 end if;
4043 end if;
4045 Add_Switch (Argv, Program_Args, And_Save => And_Save);
4047 -- Handle non-default compiler, binder, linker
4052 then
4053 declare
4055 Argument_String_To_List
4058 begin
4061 else
4066 Add_Switch
4068 Compiler,
4075 then
4076 declare
4078 Argument_String_To_List
4081 begin
4084 else
4089 Add_Switch
4096 then
4097 declare
4099 Argument_String_To_List
4101 begin
4104 else
4113 else
4117 -- If we have seen a regular switch process it
4124 -- -I-
4129 -- Forbid -?- or -??- where ? is any character
4133 then
4136 -- -Idir
4143 Binder,
4146 -- No need to pass any source dir to the binder
4147 -- since gnatmake call it with the -x flag
4148 -- (ie do not check source time stamp)
4150 -- -aIdir (to gcc this is like a -I switch)
4155 Compiler,
4158 -- -aOdir
4164 -- -aLdir (to gnatbind this is like a -aO switch)
4170 Binder,
4173 -- -Adir (to gnatbind this is like a -aO switch, to gcc like a -I)
4180 Compiler,
4183 Binder,
4186 -- -Ldir
4191 -- For -gxxxxx,-pg : give the switch to both the compiler and the
4192 -- linker (except for -gnatxxx which is only for the compiler)
4194 elsif
4198 then
4202 -- -d
4206 then
4209 -- -j (need to save the result)
4218 -- -m
4222 then
4225 -- -u
4229 then
4235 -- -Pprj (only once, and only on the command line)
4239 then
4245 -- It could be a tool other than gnatmake (i.e, gnatdist)
4246 -- or a -P switch inside a project file.
4248 Fail
4252 else
4254 end if;
4256 -- -S (Assemble)
4258 -- Since no object file is created, don't check object
4259 -- consistency.
4262 and then Argv'Last = 2
4263 then
4264 Opt.Check_Object_Consistency := False;
4265 Add_Switch (Argv, Compiler, And_Save => And_Save);
4267 -- -vPx (verbosity of the parsing of the project files)
4269 elsif Argv'Last = 4
4270 and then Argv (2 .. 3) = "vP"
4272 then
4273 if And_Save then
4274 case Argv (4) is
4276 Current_Verbosity := Prj.Default;
4278 Current_Verbosity := Prj.Medium;
4280 Current_Verbosity := Prj.High;
4281 when others =>
4282 null;
4283 end case;
4284 end if;
4286 -- -Wx (need to save the result)
4289 Scan_Make_Switches (Argv);
4291 if And_Save then
4292 Saved_WC_Encoding_Method := Wide_Character_Encoding_Method;
4293 Saved_WC_Encoding_Method_Set := True;
4294 end if;
4296 -- -Xext=val (External assignment)
4299 and then Is_External_Assignment (Argv)
4300 then
4301 -- Is_External_Assignment has side effects
4302 -- when it returns True;
4304 null;
4306 -- If -gnath is present, then generate the usage information
4307 -- right now for the compiler, and do not pass this option
4308 -- on to the compiler calls.
4310 elsif Argv = "-gnath" then
4311 null;
4313 -- If -gnatc is specified, make sure the bind step and the link
4314 -- step are not executed.
4316 elsif Argv'Length >= 6 and then Argv (2 .. 6) = "gnatc" then
4318 -- If -gnatc is specified, make sure the bind step and the link
4319 -- step are not executed.
4321 Add_Switch (Argv, Compiler, And_Save => And_Save);
4322 Opt.Operating_Mode := Opt.Check_Semantics;
4323 Opt.Check_Object_Consistency := False;
4324 Opt.Compile_Only := True;
4325 Do_Bind_Step := False;
4326 Do_Link_Step := False;
4328 elsif Argv (2 .. Argv'Last) = "nostdlib" then
4330 -- Don't pass -nostdlib to gnatlink, it will disable
4331 -- linking with all standard library files.
4333 Opt.No_Stdlib := True;
4334 Add_Switch (Argv, Binder, And_Save => And_Save);
4336 elsif Argv (2 .. Argv'Last) = "nostdinc" then
4338 -- Pass -nostdinv to the Compiler and to gnatbind
4340 Opt.No_Stdinc := True;
4341 Add_Switch (Argv, Compiler, And_Save => And_Save);
4342 Add_Switch (Argv, Binder, And_Save => And_Save);
4344 -- By default all switches with more than one character
4350 and then Argv (2 .. Argv'Last) /= "M"
4352 then
4353 Add_Switch (Argv, Compiler, And_Save => And_Save);
4355 -- All other options are handled by Scan_Make_Switches
4357 else
4358 Scan_Make_Switches (Argv);
4359 end if;
4361 -- If not a switch it must be a file name
4363 else
4364 File_Name_Seen := True;
4365 Set_Main_File_Name (Argv);
4366 end if;
4367 end Scan_Make_Arg;
4369 -------------------
4370 -- Set_Ada_Paths --
4371 -------------------
4373 procedure Set_Ada_Paths
4374 (For_Project : Prj.Project_Id;
4375 Including_Libraries : Boolean)
4376 is
4377 New_Ada_Include_Path : constant String_Access :=
4378 Prj.Env.Ada_Include_Path (For_Project);
4380 New_Ada_Objects_Path : constant String_Access :=
4381 Prj.Env.Ada_Objects_Path
4382 (For_Project, Including_Libraries);
4384 begin
4385 -- If ADA_INCLUDE_PATH needs to be changed (we are not using the same
4386 -- project file), set the new ADA_INCLUDE_PATH
4388 if New_Ada_Include_Path /= Current_Ada_Include_Path then
4389 Current_Ada_Include_Path := New_Ada_Include_Path;
4391 if Original_Ada_Include_Path'Length = 0 then
4392 Setenv ("ADA_INCLUDE_PATH",
4393 New_Ada_Include_Path.all);
4395 else
4396 -- If there existed an ADA_INCLUDE_PATH at the invocation of
4397 -- gnatmake, concatenate new ADA_INCLUDE_PATH with the original.
4399 Setenv ("ADA_INCLUDE_PATH",
4400 Original_Ada_Include_Path.all &
4401 Path_Separator &
4402 New_Ada_Include_Path.all);
4403 end if;
4405 if Opt.Verbose_Mode then
4406 declare
4407 Include_Path : constant String_Access :=
4408 Getenv ("ADA_INCLUDE_PATH");
4410 begin
4411 -- Display the new ADA_INCLUDE_PATH
4413 Write_Str ("ADA_INCLUDE_PATH = """);
4414 Prj.Util.Write_Str
4415 (S => Include_Path.all,
4416 Max_Length => Max_Line_Length,
4417 Separator => Path_Separator);
4418 Write_Str ("""");
4419 Write_Eol;
4420 end;
4421 end if;
4422 end if;
4424 -- If ADA_OBJECTS_PATH needs to be changed (we are not using the same
4425 -- project file), set the new ADA_OBJECTS_PATH
4427 if New_Ada_Objects_Path /= Current_Ada_Objects_Path then
4428 Current_Ada_Objects_Path := New_Ada_Objects_Path;
4430 if Original_Ada_Objects_Path'Length = 0 then
4431 Setenv ("ADA_OBJECTS_PATH",
4432 New_Ada_Objects_Path.all);
4434 else
4435 -- If there existed an ADA_OBJECTS_PATH at the invocation of
4436 -- gnatmake, concatenate new ADA_OBJECTS_PATH with the original.
4438 Setenv ("ADA_OBJECTS_PATH",
4439 Original_Ada_Objects_Path.all &
4440 Path_Separator &
4441 New_Ada_Objects_Path.all);
4442 end if;
4444 if Opt.Verbose_Mode then
4445 declare
4446 Objects_Path : constant String_Access :=
4447 Getenv ("ADA_OBJECTS_PATH");
4449 begin
4450 -- Display the new ADA_OBJECTS_PATH
4452 Write_Str ("ADA_OBJECTS_PATH = """);
4453 Prj.Util.Write_Str
4454 (S => Objects_Path.all,
4455 Max_Length => Max_Line_Length,
4456 Separator => Path_Separator);
4457 Write_Str ("""");
4458 Write_Eol;
4459 end;
4460 end if;
4461 end if;
4463 end Set_Ada_Paths;
4465 ---------------------
4466 -- Set_Library_For --
4467 ---------------------
4469 procedure Set_Library_For
4470 (Project : Project_Id;
4471 There_Are_Libraries : in out Boolean)
4472 is
4473 begin
4474 -- Case of library project
4476 if Projects.Table (Project).Library then
4477 There_Are_Libraries := True;
4479 -- Add the -L switch
4481 Linker_Switches.Increment_Last;
4482 Linker_Switches.Table (Linker_Switches.Last) :=
4484 Get_Name_String
4487 -- Add the -l switch
4492 Get_Name_String
4493 (Projects.Table (Project).Library_Name));
4495 -- Add the Wl,-rpath switch if library non static
4497 if Projects.Table (Project).Library_Kind /= Static then
4498 declare
4499 Option : constant String_Access :=
4500 MLib.Tgt.Linker_Library_Path_Option
4501 (Get_Name_String
4502 (Projects.Table (Project).Library_Dir));
4504 begin
4505 if Option /= null then
4506 Linker_Switches.Increment_Last;
4507 Linker_Switches.Table (Linker_Switches.Last) :=
4508 Option;
4509 end if;
4511 end;
4513 end if;
4515 end if;
4516 end Set_Library_For;
4518 ------------
4519 -- Unmark --
4520 ------------
4522 procedure Unmark (Source_File : File_Name_Type) is
4523 begin
4524 Set_Name_Table_Byte (Source_File, 0);
4525 end Unmark;
4527 -----------------
4528 -- Verbose_Msg --
4529 -----------------
4531 procedure Verbose_Msg
4532 (N1 : Name_Id;
4533 S1 : String;
4534 N2 : Name_Id := No_Name;
4535 S2 : String := "";
4536 Prefix : String := " -> ")
4537 is
4538 begin
4539 if not Opt.Verbose_Mode then
4540 return;
4541 end if;
4543 Write_Str (Prefix);
4544 Write_Str ("""");
4545 Write_Name (N1);
4546 Write_Str (""" ");
4547 Write_Str (S1);
4549 if N2 /= No_Name then
4550 Write_Str (" """);
4551 Write_Name (N2);
4552 Write_Str (""" ");
4553 end if;
4555 Write_Str (S2);
4556 Write_Eol;
4557 end Verbose_Msg;
4559 end Make;