1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
27 with ALI
.Util
; use ALI
.Util
;
28 with Bcheck
; use Bcheck
;
29 with Binde
; use Binde
;
30 with Binderr
; use Binderr
;
31 with Bindgen
; use Bindgen
;
33 with Butil
; use Butil
;
34 with Casing
; use Casing
;
36 with Debug
; use Debug
;
38 with Fname
; use Fname
;
39 with Namet
; use Namet
;
41 with Osint
; use Osint
;
42 with Osint
.B
; use Osint
.B
;
43 with Output
; use Output
;
44 with Rident
; use Rident
;
46 with Switch
; use Switch
;
47 with Switch
.B
; use Switch
.B
;
49 with Targparm
; use Targparm
;
50 with Types
; use Types
;
52 with System
.Case_Util
; use System
.Case_Util
;
53 with System
.OS_Lib
; use System
.OS_Lib
;
55 with Ada
.Command_Line
.Response_File
; use Ada
.Command_Line
;
59 Total_Errors
: Nat
:= 0;
60 -- Counts total errors in all files
62 Total_Warnings
: Nat
:= 0;
63 -- Total warnings in all files
65 Main_Lib_File
: File_Name_Type
;
66 -- Current main library file
68 First_Main_Lib_File
: File_Name_Type
:= No_File
;
69 -- The first library file, that should be a main subprogram if neither -n
72 Std_Lib_File
: File_Name_Type
;
75 Text
: Text_Buffer_Ptr
;
77 Output_File_Name_Seen
: Boolean := False;
78 Output_File_Name
: String_Ptr
:= new String'("");
80 L_Switch_Seen : Boolean := False;
82 Mapping_File : String_Ptr := null;
84 package Closure_Sources is new Table.Table
85 (Table_Component_Type => File_Name_Type,
86 Table_Index_Type => Natural,
89 Table_Increment => 100,
90 Table_Name => "Gnatbind.Closure_Sources");
91 -- Table to record the sources in the closure, to avoid duplications. Used
92 -- only with switch -R.
94 function Gnatbind_Supports_Auto_Init return Boolean;
95 -- Indicates if automatic initialization of elaboration procedure
96 -- through the constructor mechanism is possible on the platform.
98 procedure List_Applicable_Restrictions;
99 -- List restrictions that apply to this partition if option taken
101 procedure Scan_Bind_Arg (Argv : String);
102 -- Scan and process binder specific arguments. Argv is a single argument.
103 -- All the one character arguments are still handled by Switch. This
104 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
107 with procedure Action (Argv : String);
108 procedure Generic_Scan_Bind_Args;
109 -- Iterate through the args calling Action on each one, taking care of
112 procedure Write_Arg (S : String);
113 -- Passed to Generic_Scan_Bind_Args to print args
115 function Is_Cross_Compiler return Boolean;
116 -- Returns True iff this is a cross-compiler
118 ---------------------------------
119 -- Gnatbind_Supports_Auto_Init --
120 ---------------------------------
122 function Gnatbind_Supports_Auto_Init return Boolean is
123 function gnat_binder_supports_auto_init return Integer;
124 pragma Import (C, gnat_binder_supports_auto_init,
125 "__gnat_binder_supports_auto_init");
127 return gnat_binder_supports_auto_init /= 0;
128 end Gnatbind_Supports_Auto_Init;
130 -----------------------
131 -- Is_Cross_Compiler --
132 -----------------------
134 function Is_Cross_Compiler return Boolean is
135 Cross_Compiler : Integer;
136 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
138 return Cross_Compiler = 1;
139 end Is_Cross_Compiler;
141 ----------------------------------
142 -- List_Applicable_Restrictions --
143 ----------------------------------
145 procedure List_Applicable_Restrictions is
147 -- Define those restrictions that should be output if the gnatbind
148 -- -r switch is used. Not all restrictions are output for the reasons
149 -- given below in the list, and this array is used to test whether
150 -- the corresponding pragma should be listed. True means that it
151 -- should not be listed.
153 No_Restriction_List : constant array (All_Restrictions) of Boolean :=
154 (No_Standard_Allocators_After_Elaboration => True,
155 -- This involves run-time conditions not checkable at compile time
157 No_Anonymous_Allocators => True,
158 -- Premature, since we have not implemented this yet
160 No_Exception_Propagation => True,
161 -- Modifies code resulting in different exception semantics
163 No_Exceptions => True,
164 -- Has unexpected Suppress (All_Checks) effect
166 No_Implicit_Conditionals => True,
167 -- This could modify and pessimize generated code
169 No_Implicit_Dynamic_Code => True,
170 -- This could modify and pessimize generated code
172 No_Implicit_Loops => True,
173 -- This could modify and pessimize generated code
175 No_Recursion => True,
176 -- Not checkable at compile time
178 No_Reentrancy => True,
179 -- Not checkable at compile time
181 Max_Entry_Queue_Length => True,
182 -- Not checkable at compile time
184 Max_Storage_At_Blocking => True,
185 -- Not checkable at compile time
187 -- The following three should not be partition-wide, so the
188 -- following tests are junk to be removed eventually ???
190 No_Specification_Of_Aspect => True,
191 -- Requires a parameter value, not a count
193 No_Use_Of_Attribute => True,
194 -- Requires a parameter value, not a count
196 No_Use_Of_Pragma => True,
197 -- Requires a parameter value, not a count
201 Additional_Restrictions_Listed : Boolean := False;
202 -- Set True if we have listed header for restrictions
204 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
205 -- Returns True if the given restriction can be listed as an additional
206 -- restriction that could be set.
208 ------------------------------
209 -- Restriction_Could_Be_Set --
210 ------------------------------
212 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
213 CR : Restrictions_Info renames Cumulative_Restrictions;
218 -- Boolean restriction
220 when All_Boolean_Restrictions =>
222 -- The condition for listing a boolean restriction as an
223 -- additional restriction that could be set is that it is
224 -- not violated by any unit, and not already set.
226 return CR.Violated (R) = False and then CR.Set (R) = False;
228 -- Parameter restriction
230 when All_Parameter_Restrictions =>
232 -- If the restriction is violated and the level of violation is
233 -- unknown, the restriction can definitely not be listed.
235 if CR.Violated (R) and then CR.Unknown (R) then
238 -- We can list the restriction if it is not set
240 elsif not CR.Set (R) then
243 -- We can list the restriction if is set to a greater value
244 -- than the maximum value known for the violation.
247 return CR.Value (R) > CR.Count (R);
250 -- No other values for R possible
256 end Restriction_Could_Be_Set;
258 -- Start of processing for List_Applicable_Restrictions
261 -- Loop through restrictions
263 for R in All_Restrictions loop
264 if not No_Restriction_List (R)
265 and then Restriction_Could_Be_Set (R)
267 if not Additional_Restrictions_Listed then
270 ("The following additional restrictions may be" &
271 " applied to this partition:");
272 Additional_Restrictions_Listed := True;
275 Write_Str ("pragma Restrictions (");
278 S : constant String := Restriction_Id'Image (R);
280 Name_Len := S'Length;
281 Name_Buffer (1 .. Name_Len) := S;
284 Set_Casing (Mixed_Case);
285 Write_Str (Name_Buffer (1 .. Name_Len));
287 if R in All_Parameter_Restrictions then
289 Write_Int (Int (Cumulative_Restrictions.Count (R)));
296 end List_Applicable_Restrictions;
302 procedure Scan_Bind_Arg (Argv : String) is
303 pragma Assert (Argv'First = 1);
306 -- Now scan arguments that are specific to the binder and are not
307 -- handled by the common circuitry in Switch.
309 if Opt.Output_File_Name_Present
310 and then not Output_File_Name_Seen
312 Output_File_Name_Seen := True;
315 or else (Argv'Length >= 1 and then Argv (1) = '-')
317 Fail ("output File_Name missing after -o");
320 Output_File_Name := new String'(Argv
);
323 elsif Argv
'Length >= 2 and then Argv
(1) = '-' then
327 if Argv
(2 .. Argv
'Last) = "I-" then
328 Opt
.Look_In_Primary_Dir
:= False;
332 elsif Argv
(2) = 'I' then
333 Add_Src_Search_Dir
(Argv
(3 .. Argv
'Last));
334 Add_Lib_Search_Dir
(Argv
(3 .. Argv
'Last));
338 elsif Argv
(2) = 'L' then
339 if Argv
'Length >= 3 then
341 -- Remember that the -L switch was specified, so that if this
342 -- is on OpenVMS, the export names are put in uppercase.
343 -- This is not known before the target parameters are read.
345 L_Switch_Seen
:= True;
347 Opt
.Bind_For_Library
:= True;
349 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
350 Opt.Ada_Final_Name :=
351 new String'(Argv
(3 .. Argv
'Last) & Opt
.Ada_Final_Suffix
);
353 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
355 -- This option (-Lxxx) implies -n
357 Opt.Bind_Main_Program := False;
361 ("Prefix of initialization and finalization " &
362 "procedure names missing in -L");
365 -- -Sin -Slo -Shi -Sxx -Sev
367 elsif Argv'Length = 4
368 and then Argv (2) = 'S
'
371 C1 : Character := Argv (3);
372 C2 : Character := Argv (4);
375 -- Fold to upper case
377 if C1 in 'a
' .. 'z
' then
378 C1 := Character'Val (Character'Pos (C1) - 32);
381 if C2 in 'a
' .. 'z
' then
382 C2 := Character'Val (Character'Pos (C2) - 32);
385 -- Test valid option and set mode accordingly
387 if C1 = 'E
' and then C2 = 'V
' then
390 elsif C1 = 'I
' and then C2 = 'N
' then
393 elsif C1 = 'L
' and then C2 = 'O
' then
396 elsif C1 = 'H
' and then C2 = 'I
' then
399 elsif (C1 in '0' .. '9' or else C1 in 'A
' .. 'F
')
401 (C2 in '0' .. '9' or else C2 in 'A
' .. 'F
')
405 -- Invalid -S switch, let Switch give error, set default of IN
408 Scan_Binder_Switches (Argv);
413 Initialize_Scalars_Mode1 := C1;
414 Initialize_Scalars_Mode2 := C2;
419 elsif Argv'Length >= 3
420 and then Argv (2 .. 3) = "aI"
422 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
426 elsif Argv'Length >= 3
427 and then Argv (2 .. 3) = "aO"
429 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
433 elsif Argv (2 .. Argv'Last) = "nostdlib" then
434 Opt.No_Stdlib := True;
438 elsif Argv (2 .. Argv'Last) = "nostdinc" then
439 Opt.No_Stdinc := True;
443 elsif Argv (2 .. Argv'Last) = "static" then
444 Opt.Shared_Libgnat := False;
448 elsif Argv (2 .. Argv'Last) = "shared" then
449 Opt.Shared_Libgnat := True;
453 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
454 if Mapping_File /= null then
455 Fail ("cannot specify several mapping files");
458 Mapping_File := new String'(Argv
(4 .. Argv
'Last));
462 elsif Argv
'Length >= 3 and then Argv
(2) = 'M' then
463 if not Is_Cross_Compiler
then
465 ("gnatbind: -M not expected to be used on native platforms");
468 Opt
.Bind_Alternate_Main_Name
:= True;
469 Opt
.Alternate_Main_Name
:= new String'(Argv (3 .. Argv'Last));
471 -- All other options are single character and are handled by
472 -- Scan_Binder_Switches.
475 Scan_Binder_Switches (Argv);
478 -- Not a switch, so must be a file name (if non-empty)
480 elsif Argv'Length /= 0 then
482 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
486 Add_File (Argv & ".ali");
491 ----------------------------
492 -- Generic_Scan_Bind_Args --
493 ----------------------------
495 procedure Generic_Scan_Bind_Args is
496 Next_Arg : Positive := 1;
499 -- Use low level argument routines to avoid dragging in secondary stack
501 while Next_Arg < Arg_Count loop
503 Next_Argv : String (1 .. Len_Arg (Next_Arg));
506 Fill_Arg (Next_Argv'Address, Next_Arg);
508 if Next_Argv'Length > 0 then
509 if Next_Argv (1) = '@
' then
510 if Next_Argv'Length > 1 then
512 Arguments : constant Argument_List :=
513 Response_File.Arguments_From
514 (Response_File_Name =>
515 Next_Argv (2 .. Next_Argv'Last),
517 Ignore_Non_Existing_Files => True);
519 for J in Arguments'Range loop
520 Action (Arguments (J).all);
531 Next_Arg := Next_Arg + 1;
533 end Generic_Scan_Bind_Args;
539 procedure Write_Arg (S : String) is
544 procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
545 procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
547 procedure Check_Version_And_Help is
548 new Check_Version_And_Help_G (Bindusg.Display);
550 -- Start of processing for Gnatbind
553 -- Set default for Shared_Libgnat option
556 Shared_Libgnat_Default : Character;
558 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
560 SHARED : constant Character := 'H
';
561 STATIC : constant Character := 'T
';
565 (Shared_Libgnat_Default = SHARED
567 Shared_Libgnat_Default = STATIC);
568 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
571 -- Scan the switches and arguments
573 -- First, scan to detect --version and/or --help
575 Check_Version_And_Help ("GNATBIND", "1992");
577 -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
583 Write_Str (Command_Name);
588 if Use_Pragma_Linker_Constructor then
589 if Bind_Main_Program then
590 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
592 elsif not Gnatbind_Supports_Auto_Init then
593 Fail ("automatic initialisation of elaboration " &
594 "not supported on this platform");
598 -- Test for trailing -o switch
600 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
601 Fail ("output file name missing after -o");
604 -- Output usage if requested
606 if Usage_Requested then
610 -- Check that the binder file specified has extension .adb
612 if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
613 Check_Extensions : declare
614 Length : constant Natural := Output_File_Name'Length;
615 Last : constant Natural := Output_File_Name'Last;
618 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
620 Fail ("output file name should have .adb extension");
622 end Check_Extensions;
625 Osint.Add_Default_Search_Dirs;
627 -- Carry out package initializations. These are initializations which
628 -- might logically be performed at elaboration time, and we decide to be
629 -- consistent. Like elaboration, the order in which these calls are made
630 -- is in some cases important.
635 -- Acquire target parameters
637 Targparm.Get_Target_Parameters;
639 -- Initialize Cumulative_Restrictions with the restrictions on the target
640 -- scanned from the system.ads file. Then as we read ALI files, we will
641 -- accumulate additional restrictions specified in other files.
643 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
645 -- On OpenVMS, when -L is used, all external names used in pragmas Export
646 -- are in upper case. The reason is that on OpenVMS, the macro-assembler
647 -- MACASM-32, used to build Stand-Alone Libraries, only understands
650 if L_Switch_Seen and then OpenVMS_On_Target then
651 To_Upper (Opt.Ada_Init_Name.all);
652 To_Upper (Opt.Ada_Final_Name.all);
653 To_Upper (Opt.Ada_Main_Name.all);
656 -- Acquire configurable run-time mode
658 if Configurable_Run_Time_On_Target then
659 Configurable_Run_Time_Mode := True;
662 -- Output copyright notice if in verbose mode
666 Display_Version ("GNATBIND", "1995");
669 -- Output usage information if no files
671 if not More_Lib_Files then
673 Exit_Program (E_Fatal);
676 -- If a mapping file was specified, initialize the file mapping
678 if Mapping_File /= null then
679 Fmap.Initialize (Mapping_File.all);
682 -- The block here is to catch the Unrecoverable_Error exception in the
683 -- case where we exceed the maximum number of permissible errors or some
684 -- other unrecoverable error occurs.
687 -- Initialize binder packages
691 Initialize_ALI_Source;
699 while More_Lib_Files loop
700 Main_Lib_File := Next_Main_Lib_File;
702 if First_Main_Lib_File = No_File then
703 First_Main_Lib_File := Main_Lib_File;
708 Write_Str ("Checking: ");
710 Write_Str ("Binding: ");
713 Write_Name (Main_Lib_File);
717 Text := Read_Library_Info (Main_Lib_File, True);
721 pragma Warnings (Off, Id);
729 Ignore_Errors => Debug_Flag_I,
730 Directly_Scanned => True);
738 if No_Run_Time_Mode then
740 -- Set standard configuration parameters
742 Suppress_Standard_Library_On_Target := True;
743 Configurable_Run_Time_Mode := True;
746 -- For main ALI files, even if they are interfaces, we get their
747 -- dependencies. To be sure, we reset the Interface flag for all main
750 for Index in ALIs.First .. ALIs.Last loop
751 ALIs.Table (Index).SAL_Interface := False;
754 -- Add System.Standard_Library to list to ensure that these files are
755 -- included in the bind, even if not directly referenced from Ada code
756 -- This is suppressed if the appropriate targparm switch is set.
758 if not Suppress_Standard_Library_On_Target then
759 Name_Buffer (1 .. 12) := "s-stalib.ali";
761 Std_Lib_File := Name_Find;
762 Text := Read_Library_Info (Std_Lib_File, True);
766 pragma Warnings (Off, Id);
775 Ignore_Errors => Debug_Flag_I);
781 -- Load ALIs for all dependent units
783 for Index in ALIs.First .. ALIs.Last loop
784 Read_Withed_ALIs (Index);
787 -- Quit if some file needs compiling
789 if No_Object_Specified then
790 raise Unrecoverable_Error;
793 -- Output list of ALI files in closure
795 if Output_ALI_List then
796 if ALI_List_Filename /= null then
797 Set_List_File (ALI_List_Filename.all);
800 for Index in ALIs.First .. ALIs.Last loop
802 Full_Afile : constant File_Name_Type :=
803 Find_File (ALIs.Table (Index).Afile, Library);
805 Write_Name (Full_Afile);
810 if ALI_List_Filename /= null then
815 -- Build source file table from the ALI files we have read in
819 -- If there is main program to bind, set Main_Lib_File to the first
820 -- library file, and the name from which to derive the binder generate
821 -- file to the first ALI file.
823 if Bind_Main_Program then
824 Main_Lib_File := First_Main_Lib_File;
825 Set_Current_File_Name_Index (To => 1);
828 -- Check that main library file is a suitable main program
831 and then ALIs.Table (ALIs.First).Main_Program = None
832 and then not No_Main_Subprogram
835 (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
838 Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
840 To_Mixed (Unit_Name);
841 Get_Name_String (ALIs.Table (ALIs.First).Sfile);
842 Add_Str_To_Name_Buffer (":1: ");
843 Add_Str_To_Name_Buffer (Unit_Name);
844 Add_Str_To_Name_Buffer (" cannot be used as a main program");
845 Write_Line (Name_Buffer (1 .. Name_Len));
846 Errors_Detected := Errors_Detected + 1;
850 -- Perform consistency and correctness checks
852 Check_Duplicated_Subunits;
855 Check_Configuration_Consistency;
857 -- List restrictions that could be applied to this partition
859 if List_Restrictions then
860 List_Applicable_Restrictions;
863 -- Complete bind if no errors
865 if Errors_Detected = 0 then
868 if Errors_Detected = 0 then
869 -- Display elaboration order if -l was specified
871 if Elab_Order_Output then
872 if not Zero_Formatting then
874 Write_Str ("ELABORATION ORDER");
878 for J in Elab_Order.First .. Elab_Order.Last loop
879 if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
880 if not Zero_Formatting then
885 (Units.Table (Elab_Order.Table (J)).Uname);
890 if not Zero_Formatting then
895 if not Check_Only then
896 Gen_Output_File (Output_File_Name.all);
899 -- Display list of sources in the closure (except predefined
900 -- sources) if -R was used.
903 List_Closure_Display : declare
904 Source : File_Name_Type;
906 function Put_In_Sources (S : File_Name_Type) return Boolean;
907 -- Check if S is already in table Sources and put in Sources
908 -- if it is not. Return False if the source is already in
909 -- Sources, and True if it is added.
915 function Put_In_Sources
916 (S : File_Name_Type) return Boolean is
918 for J in 1 .. Closure_Sources.Last loop
919 if Closure_Sources.Table (J) = S then
924 Closure_Sources.Append (S);
928 -- Start of processing for List_Closure_Display
931 Closure_Sources.Init;
933 if not Zero_Formatting then
935 Write_Str ("REFERENCED SOURCES");
939 for J in reverse Elab_Order.First .. Elab_Order.Last loop
940 Source := Units.Table (Elab_Order.Table (J)).Sfile;
942 -- Do not include the sources of the runtime and do not
943 -- include the same source several times.
945 if Put_In_Sources (Source)
946 and then not Is_Internal_File_Name (Source)
948 if not Zero_Formatting then
952 Write_Str (Get_Name_String (Source));
957 -- Subunits do not appear in the elaboration table because
958 -- they are subsumed by their parent units, but we need to
959 -- list them for other tools. For now they are listed after
960 -- other files, rather than right after their parent, since
961 -- there is no easy link between the elaboration table and
962 -- the ALIs table ??? As subunits may appear repeatedly in
963 -- the list, if the parent unit appears in the context of
964 -- several units in the closure, duplicates are suppressed.
966 for J in Sdep.First .. Sdep.Last loop
967 Source := Sdep.Table (J).Sfile;
969 if Sdep.Table (J).Subunit_Name /= No_Name
970 and then Put_In_Sources (Source)
971 and then not Is_Internal_File_Name (Source)
973 if not Zero_Formatting then
977 Write_Str (Get_Name_String (Source));
982 if not Zero_Formatting then
985 end List_Closure_Display;
990 Total_Errors := Total_Errors + Errors_Detected;
991 Total_Warnings := Total_Warnings + Warnings_Detected;
994 when Unrecoverable_Error =>
995 Total_Errors := Total_Errors + Errors_Detected;
996 Total_Warnings := Total_Warnings + Warnings_Detected;
999 -- All done. Set proper exit status
1004 if Total_Errors > 0 then
1005 Exit_Program (E_Errors);
1007 elsif Total_Warnings > 0 then
1008 Exit_Program (E_Warnings);
1011 -- Do not call Exit_Program (E_Success), so that finalization occurs