gcc/
[official-gcc.git] / gcc / ada / gnatbind.adb
blobb8bb524f2ec4ce5e1019cdf2c6f6b22cac448415
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- G N A T B I N D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with ALI; use ALI;
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;
32 with Bindusg;
33 with Butil; use Butil;
34 with Casing; use Casing;
35 with Csets;
36 with Debug; use Debug;
37 with Fmap;
38 with Fname; use Fname;
39 with Namet; use Namet;
40 with Opt; use Opt;
41 with Osint; use Osint;
42 with Osint.B; use Osint.B;
43 with Output; use Output;
44 with Rident; use Rident;
45 with Snames;
46 with Switch; use Switch;
47 with Switch.B; use Switch.B;
48 with Targparm; use Targparm;
49 with Types; use Types;
51 with System.Case_Util; use System.Case_Util;
52 with System.OS_Lib; use System.OS_Lib;
54 with Ada.Command_Line.Response_File; use Ada.Command_Line;
56 procedure Gnatbind is
58 Total_Errors : Nat := 0;
59 -- Counts total errors in all files
61 Total_Warnings : Nat := 0;
62 -- Total warnings in all files
64 Main_Lib_File : File_Name_Type;
65 -- Current main library file
67 First_Main_Lib_File : File_Name_Type := No_File;
68 -- The first library file, that should be a main subprogram if neither -n
69 -- nor -z are used.
71 Std_Lib_File : File_Name_Type;
72 -- Standard library
74 Text : Text_Buffer_Ptr;
75 Next_Arg : Positive;
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 function Gnatbind_Supports_Auto_Init return Boolean;
85 -- Indicates if automatic initialization of elaboration procedure
86 -- through the constructor mechanism is possible on the platform.
88 procedure List_Applicable_Restrictions;
89 -- List restrictions that apply to this partition if option taken
91 procedure Scan_Bind_Arg (Argv : String);
92 -- Scan and process binder specific arguments. Argv is a single argument.
93 -- All the one character arguments are still handled by Switch. This
94 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
96 function Is_Cross_Compiler return Boolean;
97 -- Returns True iff this is a cross-compiler
99 ---------------------------------
100 -- Gnatbind_Supports_Auto_Init --
101 ---------------------------------
103 function Gnatbind_Supports_Auto_Init return Boolean is
104 function gnat_binder_supports_auto_init return Integer;
105 pragma Import (C, gnat_binder_supports_auto_init,
106 "__gnat_binder_supports_auto_init");
107 begin
108 return gnat_binder_supports_auto_init /= 0;
109 end Gnatbind_Supports_Auto_Init;
111 -----------------------
112 -- Is_Cross_Compiler --
113 -----------------------
115 function Is_Cross_Compiler return Boolean is
116 Cross_Compiler : Integer;
117 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
118 begin
119 return Cross_Compiler = 1;
120 end Is_Cross_Compiler;
122 ----------------------------------
123 -- List_Applicable_Restrictions --
124 ----------------------------------
126 procedure List_Applicable_Restrictions is
128 -- Define those restrictions that should be output if the gnatbind
129 -- -r switch is used. Not all restrictions are output for the reasons
130 -- given below in the list, and this array is used to test whether
131 -- the corresponding pragma should be listed. True means that it
132 -- should not be listed.
134 No_Restriction_List : constant array (All_Restrictions) of Boolean :=
135 (No_Exception_Propagation => True,
136 -- Modifies code resulting in different exception semantics
138 No_Exceptions => True,
139 -- Has unexpected Suppress (All_Checks) effect
141 No_Implicit_Conditionals => True,
142 -- This could modify and pessimize generated code
144 No_Implicit_Dynamic_Code => True,
145 -- This could modify and pessimize generated code
147 No_Implicit_Loops => True,
148 -- This could modify and pessimize generated code
150 No_Recursion => True,
151 -- Not checkable at compile time
153 No_Reentrancy => True,
154 -- Not checkable at compile time
156 Max_Entry_Queue_Length => True,
157 -- Not checkable at compile time
159 Max_Storage_At_Blocking => True,
160 -- Not checkable at compile time
162 others => False);
164 Additional_Restrictions_Listed : Boolean := False;
165 -- Set True if we have listed header for restrictions
167 begin
168 -- Loop through restrictions
170 for R in All_Restrictions loop
171 if not No_Restriction_List (R) then
173 -- We list a restriction if it is not violated, or if
174 -- it is violated but the violation count is exactly known.
176 if Cumulative_Restrictions.Violated (R) = False
177 or else (R in All_Parameter_Restrictions
178 and then
179 Cumulative_Restrictions.Unknown (R) = False)
180 then
181 if not Additional_Restrictions_Listed then
182 Write_Eol;
183 Write_Line
184 ("The following additional restrictions may be" &
185 " applied to this partition:");
186 Additional_Restrictions_Listed := True;
187 end if;
189 Write_Str ("pragma Restrictions (");
191 declare
192 S : constant String := Restriction_Id'Image (R);
193 begin
194 Name_Len := S'Length;
195 Name_Buffer (1 .. Name_Len) := S;
196 end;
198 Set_Casing (Mixed_Case);
199 Write_Str (Name_Buffer (1 .. Name_Len));
201 if R in All_Parameter_Restrictions then
202 Write_Str (" => ");
203 Write_Int (Int (Cumulative_Restrictions.Count (R)));
204 end if;
206 Write_Str (");");
207 Write_Eol;
208 end if;
209 end if;
210 end loop;
211 end List_Applicable_Restrictions;
213 -------------------
214 -- Scan_Bind_Arg --
215 -------------------
217 procedure Scan_Bind_Arg (Argv : String) is
218 pragma Assert (Argv'First = 1);
220 begin
221 -- Now scan arguments that are specific to the binder and are not
222 -- handled by the common circuitry in Switch.
224 if Opt.Output_File_Name_Present
225 and then not Output_File_Name_Seen
226 then
227 Output_File_Name_Seen := True;
229 if Argv'Length = 0
230 or else (Argv'Length >= 1 and then Argv (1) = '-')
231 then
232 Fail ("output File_Name missing after -o");
234 else
235 Output_File_Name := new String'(Argv);
236 end if;
238 elsif Argv'Length >= 2 and then Argv (1) = '-' then
240 -- -I-
242 if Argv (2 .. Argv'Last) = "I-" then
243 Opt.Look_In_Primary_Dir := False;
245 -- -Idir
247 elsif Argv (2) = 'I' then
248 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
249 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
251 -- -Ldir
253 elsif Argv (2) = 'L' then
254 if Argv'Length >= 3 then
256 -- Remember that the -L switch was specified, so that if this
257 -- is on OpenVMS, the export names are put in uppercase.
258 -- This is not known before the target parameters are read.
260 L_Switch_Seen := True;
262 Opt.Bind_For_Library := True;
263 Opt.Ada_Init_Name :=
264 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
265 Opt.Ada_Final_Name :=
266 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
267 Opt.Ada_Main_Name :=
268 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
270 -- This option (-Lxxx) implies -n
272 Opt.Bind_Main_Program := False;
274 else
275 Fail
276 ("Prefix of initialization and finalization " &
277 "procedure names missing in -L");
278 end if;
280 -- -Sin -Slo -Shi -Sxx -Sev
282 elsif Argv'Length = 4
283 and then Argv (2) = 'S'
284 then
285 declare
286 C1 : Character := Argv (3);
287 C2 : Character := Argv (4);
289 begin
290 -- Fold to upper case
292 if C1 in 'a' .. 'z' then
293 C1 := Character'Val (Character'Pos (C1) - 32);
294 end if;
296 if C2 in 'a' .. 'z' then
297 C2 := Character'Val (Character'Pos (C2) - 32);
298 end if;
300 -- Test valid option and set mode accordingly
302 if C1 = 'E' and then C2 = 'V' then
303 null;
305 elsif C1 = 'I' and then C2 = 'N' then
306 null;
308 elsif C1 = 'L' and then C2 = 'O' then
309 null;
311 elsif C1 = 'H' and then C2 = 'I' then
312 null;
314 elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
315 and then
316 (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
317 then
318 null;
320 -- Invalid -S switch, let Switch give error, set defalut of IN
322 else
323 Scan_Binder_Switches (Argv);
324 C1 := 'I';
325 C2 := 'N';
326 end if;
328 Initialize_Scalars_Mode1 := C1;
329 Initialize_Scalars_Mode2 := C2;
330 end;
332 -- -aIdir
334 elsif Argv'Length >= 3
335 and then Argv (2 .. 3) = "aI"
336 then
337 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
339 -- -aOdir
341 elsif Argv'Length >= 3
342 and then Argv (2 .. 3) = "aO"
343 then
344 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
346 -- -nostdlib
348 elsif Argv (2 .. Argv'Last) = "nostdlib" then
349 Opt.No_Stdlib := True;
351 -- -nostdinc
353 elsif Argv (2 .. Argv'Last) = "nostdinc" then
354 Opt.No_Stdinc := True;
356 -- -static
358 elsif Argv (2 .. Argv'Last) = "static" then
359 Opt.Shared_Libgnat := False;
361 -- -shared
363 elsif Argv (2 .. Argv'Last) = "shared" then
364 Opt.Shared_Libgnat := True;
366 -- -F=mapping_file
368 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
369 if Mapping_File /= null then
370 Fail ("cannot specify several mapping files");
371 end if;
373 Mapping_File := new String'(Argv (4 .. Argv'Last));
375 -- -Mname
377 elsif Argv'Length >= 3 and then Argv (2) = 'M' then
378 if not Is_Cross_Compiler then
379 Write_Line
380 ("gnatbind: -M not expected to be used on native platforms");
381 end if;
383 Opt.Bind_Alternate_Main_Name := True;
384 Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
386 -- All other options are single character and are handled by
387 -- Scan_Binder_Switches.
389 else
390 Scan_Binder_Switches (Argv);
391 end if;
393 -- Not a switch, so must be a file name (if non-empty)
395 elsif Argv'Length /= 0 then
396 if Argv'Length > 4
397 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
398 then
399 Add_File (Argv);
400 else
401 Add_File (Argv & ".ali");
402 end if;
403 end if;
404 end Scan_Bind_Arg;
406 procedure Check_Version_And_Help is
407 new Check_Version_And_Help_G (Bindusg.Display);
409 -- Start of processing for Gnatbind
411 begin
413 -- Set default for Shared_Libgnat option
415 declare
416 Shared_Libgnat_Default : Character;
417 pragma Import
418 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
420 SHARED : constant Character := 'H';
421 STATIC : constant Character := 'T';
423 begin
424 pragma Assert
425 (Shared_Libgnat_Default = SHARED
426 or else
427 Shared_Libgnat_Default = STATIC);
428 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
429 end;
431 -- Scan the switches and arguments
433 -- First, scan to detect --version and/or --help
435 Check_Version_And_Help ("GNATBIND", "1995");
437 -- Use low level argument routines to avoid dragging in the secondary stack
439 Next_Arg := 1;
440 Scan_Args : while Next_Arg < Arg_Count loop
441 declare
442 Next_Argv : String (1 .. Len_Arg (Next_Arg));
443 begin
444 Fill_Arg (Next_Argv'Address, Next_Arg);
446 if Next_Argv'Length > 0 then
447 if Next_Argv (1) = '@' then
448 if Next_Argv'Length > 1 then
449 declare
450 Arguments : constant Argument_List :=
451 Response_File.Arguments_From
452 (Response_File_Name =>
453 Next_Argv (2 .. Next_Argv'Last),
454 Recursive => True,
455 Ignore_Non_Existing_Files => True);
456 begin
457 for J in Arguments'Range loop
458 Scan_Bind_Arg (Arguments (J).all);
459 end loop;
460 end;
461 end if;
463 else
464 Scan_Bind_Arg (Next_Argv);
465 end if;
466 end if;
467 end;
469 Next_Arg := Next_Arg + 1;
470 end loop Scan_Args;
472 if Use_Pragma_Linker_Constructor then
473 if Bind_Main_Program then
474 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
476 elsif not Gnatbind_Supports_Auto_Init then
477 Fail ("automatic initialisation of elaboration " &
478 "not supported on this platform");
479 end if;
480 end if;
482 -- Test for trailing -o switch
484 if Opt.Output_File_Name_Present
485 and then not Output_File_Name_Seen
486 then
487 Fail ("output file name missing after -o");
488 end if;
490 -- Output usage if requested
492 if Usage_Requested then
493 Bindusg.Display;
494 end if;
496 -- Check that the Ada binder file specified has extension .adb and that
497 -- the C binder file has extension .c
499 if Opt.Output_File_Name_Present
500 and then Output_File_Name_Seen
501 then
502 Check_Extensions : declare
503 Length : constant Natural := Output_File_Name'Length;
504 Last : constant Natural := Output_File_Name'Last;
506 begin
507 if Ada_Bind_File then
508 if Length <= 4
509 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
510 then
511 Fail ("output file name should have .adb extension");
512 end if;
514 else
515 if Length <= 2
516 or else Output_File_Name (Last - 1 .. Last) /= ".c"
517 then
518 Fail ("output file name should have .c extension");
519 end if;
520 end if;
521 end Check_Extensions;
522 end if;
524 Osint.Add_Default_Search_Dirs;
526 -- Carry out package initializations. These are initializations which
527 -- might logically be performed at elaboration time, but Namet at least
528 -- can't be done that way (because it is used in the Compiler), and we
529 -- decide to be consistent. Like elaboration, the order in which these
530 -- calls are made is in some cases important.
532 Csets.Initialize;
533 Namet.Initialize;
534 Snames.Initialize;
536 -- Acquire target parameters
538 Targparm.Get_Target_Parameters;
540 -- Initialize Cumulative_Restrictions with the restrictions on the target
541 -- scanned from the system.ads file. Then as we read ALI files, we will
542 -- accumulate additional restrictions specified in other files.
544 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
546 -- On OpenVMS, when -L is used, all external names used in pragmas Export
547 -- are in upper case. The reason is that on OpenVMS, the macro-assembler
548 -- MACASM-32, used to build Stand-Alone Libraries, only understands
549 -- uppercase.
551 if L_Switch_Seen and then OpenVMS_On_Target then
552 To_Upper (Opt.Ada_Init_Name.all);
553 To_Upper (Opt.Ada_Final_Name.all);
554 To_Upper (Opt.Ada_Main_Name.all);
555 end if;
557 -- Acquire configurable run-time mode
559 if Configurable_Run_Time_On_Target then
560 Configurable_Run_Time_Mode := True;
561 end if;
563 -- Output copyright notice if in verbose mode
565 if Verbose_Mode then
566 Write_Eol;
567 Display_Version ("GNATBIND", "1995");
568 end if;
570 -- Output usage information if no files
572 if not More_Lib_Files then
573 Bindusg.Display;
574 Exit_Program (E_Fatal);
575 end if;
577 -- If a mapping file was specified, initialize the file mapping
579 if Mapping_File /= null then
580 Fmap.Initialize (Mapping_File.all);
581 end if;
583 -- The block here is to catch the Unrecoverable_Error exception in the
584 -- case where we exceed the maximum number of permissible errors or some
585 -- other unrecoverable error occurs.
587 begin
588 -- Initialize binder packages
590 Initialize_Binderr;
591 Initialize_ALI;
592 Initialize_ALI_Source;
594 if Verbose_Mode then
595 Write_Eol;
596 end if;
598 -- Input ALI files
600 while More_Lib_Files loop
601 Main_Lib_File := Next_Main_Lib_File;
603 if First_Main_Lib_File = No_File then
604 First_Main_Lib_File := Main_Lib_File;
605 end if;
607 if Verbose_Mode then
608 if Check_Only then
609 Write_Str ("Checking: ");
610 else
611 Write_Str ("Binding: ");
612 end if;
614 Write_Name (Main_Lib_File);
615 Write_Eol;
616 end if;
618 Text := Read_Library_Info (Main_Lib_File, True);
620 declare
621 Id : ALI_Id;
622 pragma Warnings (Off, Id);
624 begin
625 Id := Scan_ALI
626 (F => Main_Lib_File,
627 T => Text,
628 Ignore_ED => False,
629 Err => False,
630 Ignore_Errors => Debug_Flag_I);
631 end;
633 Free (Text);
634 end loop;
636 -- No_Run_Time mode
638 if No_Run_Time_Mode then
640 -- Set standard configuration parameters
642 Suppress_Standard_Library_On_Target := True;
643 Configurable_Run_Time_Mode := True;
644 end if;
646 -- For main ALI files, even if they are interfaces, we get their
647 -- dependencies. To be sure, we reset the Interface flag for all main
648 -- ALI files.
650 for Index in ALIs.First .. ALIs.Last loop
651 ALIs.Table (Index).SAL_Interface := False;
652 end loop;
654 -- Add System.Standard_Library to list to ensure that these files are
655 -- included in the bind, even if not directly referenced from Ada code
656 -- This is suppressed if the appropriate targparm switch is set.
658 if not Suppress_Standard_Library_On_Target then
659 Name_Buffer (1 .. 12) := "s-stalib.ali";
660 Name_Len := 12;
661 Std_Lib_File := Name_Find;
662 Text := Read_Library_Info (Std_Lib_File, True);
664 declare
665 Id : ALI_Id;
666 pragma Warnings (Off, Id);
668 begin
669 Id :=
670 Scan_ALI
671 (F => Std_Lib_File,
672 T => Text,
673 Ignore_ED => False,
674 Err => False,
675 Ignore_Errors => Debug_Flag_I);
676 end;
678 Free (Text);
679 end if;
681 -- Acquire all information in ALI files that have been read in
683 for Index in ALIs.First .. ALIs.Last loop
684 Read_ALI (Index);
685 end loop;
687 -- Quit if some file needs compiling
689 if No_Object_Specified then
690 raise Unrecoverable_Error;
691 end if;
693 -- Build source file table from the ALI files we have read in
695 Set_Source_Table;
697 -- If there is main program to bind, set Main_Lib_File to the first
698 -- library file, and the name from which to derive the binder generate
699 -- file to the first ALI file.
701 if Bind_Main_Program then
702 Main_Lib_File := First_Main_Lib_File;
703 Set_Current_File_Name_Index (To => 1);
704 end if;
706 -- Check that main library file is a suitable main program
708 if Bind_Main_Program
709 and then ALIs.Table (ALIs.First).Main_Program = None
710 and then not No_Main_Subprogram
711 then
712 Error_Msg_File_1 := Main_Lib_File;
713 Error_Msg ("{ does not contain a unit that can be a main program");
714 end if;
716 -- Perform consistency and correctness checks
718 Check_Duplicated_Subunits;
719 Check_Versions;
720 Check_Consistency;
721 Check_Configuration_Consistency;
723 -- List restrictions that could be applied to this partition
725 if List_Restrictions then
726 List_Applicable_Restrictions;
727 end if;
729 -- Complete bind if no errors
731 if Errors_Detected = 0 then
732 Find_Elab_Order;
734 if Errors_Detected = 0 then
735 -- Display elaboration order if -l was specified
737 if Elab_Order_Output then
738 if not Zero_Formatting then
739 Write_Eol;
740 Write_Str ("ELABORATION ORDER");
741 Write_Eol;
742 end if;
744 for J in Elab_Order.First .. Elab_Order.Last loop
745 if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
746 if not Zero_Formatting then
747 Write_Str (" ");
748 end if;
750 Write_Unit_Name
751 (Units.Table (Elab_Order.Table (J)).Uname);
752 Write_Eol;
753 end if;
754 end loop;
756 if not Zero_Formatting then
757 Write_Eol;
758 end if;
759 end if;
761 if not Check_Only then
762 Gen_Output_File (Output_File_Name.all);
763 end if;
765 -- Display list of sources in the closure (except predefined
766 -- sources) if -R was used.
768 if List_Closure then
769 if not Zero_Formatting then
770 Write_Eol;
771 Write_Str ("REFERENCED SOURCES");
772 Write_Eol;
773 end if;
775 for J in reverse Elab_Order.First .. Elab_Order.Last loop
777 -- Do not include the sources of the runtime
779 if not Is_Internal_File_Name
780 (Units.Table (Elab_Order.Table (J)).Sfile)
781 then
782 if not Zero_Formatting then
783 Write_Str (" ");
784 end if;
786 Write_Str
787 (Get_Name_String
788 (Units.Table (Elab_Order.Table (J)).Sfile));
789 Write_Eol;
790 end if;
791 end loop;
793 if not Zero_Formatting then
794 Write_Eol;
795 end if;
796 end if;
797 end if;
798 end if;
800 Total_Errors := Total_Errors + Errors_Detected;
801 Total_Warnings := Total_Warnings + Warnings_Detected;
803 exception
804 when Unrecoverable_Error =>
805 Total_Errors := Total_Errors + Errors_Detected;
806 Total_Warnings := Total_Warnings + Warnings_Detected;
807 end;
809 -- All done. Set proper exit status
811 Finalize_Binderr;
812 Namet.Finalize;
814 if Total_Errors > 0 then
815 Exit_Program (E_Errors);
817 elsif Total_Warnings > 0 then
818 Exit_Program (E_Warnings);
820 else
821 -- Do not call Exit_Program (E_Success), so that finalization occurs
822 -- normally.
824 null;
825 end if;
827 end Gnatbind;