Daily bump.
[official-gcc.git] / gcc / ada / gnatbind.adb
blob8a166991c5c00dbc1c74dcd44993998139885348
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 -- Start of processing for Gnatbind
408 begin
410 -- Set default for Shared_Libgnat option
412 declare
413 Shared_Libgnat_Default : Character;
414 pragma Import
415 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
417 SHARED : constant Character := 'H';
418 STATIC : constant Character := 'T';
420 begin
421 pragma Assert
422 (Shared_Libgnat_Default = SHARED
423 or else
424 Shared_Libgnat_Default = STATIC);
425 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
426 end;
428 -- Scan the switches and arguments
430 -- First, scan to detect --version and/or --help
432 Check_Version_And_Help ("GNATBIND", "1995", Bindusg.Display'Access);
434 -- Use low level argument routines to avoid dragging in the secondary stack
436 Next_Arg := 1;
437 Scan_Args : while Next_Arg < Arg_Count loop
438 declare
439 Next_Argv : String (1 .. Len_Arg (Next_Arg));
440 begin
441 Fill_Arg (Next_Argv'Address, Next_Arg);
443 if Next_Argv'Length > 0 then
444 if Next_Argv (1) = '@' then
445 if Next_Argv'Length > 1 then
446 declare
447 Arguments : constant Argument_List :=
448 Response_File.Arguments_From
449 (Response_File_Name =>
450 Next_Argv (2 .. Next_Argv'Last),
451 Recursive => True,
452 Ignore_Non_Existing_Files => True);
453 begin
454 for J in Arguments'Range loop
455 Scan_Bind_Arg (Arguments (J).all);
456 end loop;
457 end;
458 end if;
460 else
461 Scan_Bind_Arg (Next_Argv);
462 end if;
463 end if;
464 end;
466 Next_Arg := Next_Arg + 1;
467 end loop Scan_Args;
469 if Use_Pragma_Linker_Constructor then
470 if Bind_Main_Program then
471 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
473 elsif not Gnatbind_Supports_Auto_Init then
474 Fail ("automatic initialisation of elaboration " &
475 "not supported on this platform");
476 end if;
477 end if;
479 -- Test for trailing -o switch
481 if Opt.Output_File_Name_Present
482 and then not Output_File_Name_Seen
483 then
484 Fail ("output file name missing after -o");
485 end if;
487 -- Output usage if requested
489 if Usage_Requested then
490 Bindusg.Display;
491 end if;
493 -- Check that the Ada binder file specified has extension .adb and that
494 -- the C binder file has extension .c
496 if Opt.Output_File_Name_Present
497 and then Output_File_Name_Seen
498 then
499 Check_Extensions : declare
500 Length : constant Natural := Output_File_Name'Length;
501 Last : constant Natural := Output_File_Name'Last;
503 begin
504 if Ada_Bind_File then
505 if Length <= 4
506 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
507 then
508 Fail ("output file name should have .adb extension");
509 end if;
511 else
512 if Length <= 2
513 or else Output_File_Name (Last - 1 .. Last) /= ".c"
514 then
515 Fail ("output file name should have .c extension");
516 end if;
517 end if;
518 end Check_Extensions;
519 end if;
521 Osint.Add_Default_Search_Dirs;
523 -- Carry out package initializations. These are initializations which
524 -- might logically be performed at elaboration time, but Namet at least
525 -- can't be done that way (because it is used in the Compiler), and we
526 -- decide to be consistent. Like elaboration, the order in which these
527 -- calls are made is in some cases important.
529 Csets.Initialize;
530 Namet.Initialize;
531 Snames.Initialize;
533 -- Acquire target parameters
535 Targparm.Get_Target_Parameters;
537 -- Initialize Cumulative_Restrictions with the restrictions on the target
538 -- scanned from the system.ads file. Then as we read ALI files, we will
539 -- accumulate additional restrictions specified in other files.
541 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
543 -- On OpenVMS, when -L is used, all external names used in pragmas Export
544 -- are in upper case. The reason is that on OpenVMS, the macro-assembler
545 -- MACASM-32, used to build Stand-Alone Libraries, only understands
546 -- uppercase.
548 if L_Switch_Seen and then OpenVMS_On_Target then
549 To_Upper (Opt.Ada_Init_Name.all);
550 To_Upper (Opt.Ada_Final_Name.all);
551 To_Upper (Opt.Ada_Main_Name.all);
552 end if;
554 -- Acquire configurable run-time mode
556 if Configurable_Run_Time_On_Target then
557 Configurable_Run_Time_Mode := True;
558 end if;
560 -- Output copyright notice if in verbose mode
562 if Verbose_Mode then
563 Write_Eol;
564 Display_Version ("GNATBIND", "1995");
565 end if;
567 -- Output usage information if no files
569 if not More_Lib_Files then
570 Bindusg.Display;
571 Exit_Program (E_Fatal);
572 end if;
574 -- If a mapping file was specified, initialize the file mapping
576 if Mapping_File /= null then
577 Fmap.Initialize (Mapping_File.all);
578 end if;
580 -- The block here is to catch the Unrecoverable_Error exception in the
581 -- case where we exceed the maximum number of permissible errors or some
582 -- other unrecoverable error occurs.
584 begin
585 -- Initialize binder packages
587 Initialize_Binderr;
588 Initialize_ALI;
589 Initialize_ALI_Source;
591 if Verbose_Mode then
592 Write_Eol;
593 end if;
595 -- Input ALI files
597 while More_Lib_Files loop
598 Main_Lib_File := Next_Main_Lib_File;
600 if First_Main_Lib_File = No_File then
601 First_Main_Lib_File := Main_Lib_File;
602 end if;
604 if Verbose_Mode then
605 if Check_Only then
606 Write_Str ("Checking: ");
607 else
608 Write_Str ("Binding: ");
609 end if;
611 Write_Name (Main_Lib_File);
612 Write_Eol;
613 end if;
615 Text := Read_Library_Info (Main_Lib_File, True);
617 declare
618 Id : ALI_Id;
619 pragma Warnings (Off, Id);
621 begin
622 Id := Scan_ALI
623 (F => Main_Lib_File,
624 T => Text,
625 Ignore_ED => False,
626 Err => False,
627 Ignore_Errors => Debug_Flag_I);
628 end;
630 Free (Text);
631 end loop;
633 -- No_Run_Time mode
635 if No_Run_Time_Mode then
637 -- Set standard configuration parameters
639 Suppress_Standard_Library_On_Target := True;
640 Configurable_Run_Time_Mode := True;
641 end if;
643 -- For main ALI files, even if they are interfaces, we get their
644 -- dependencies. To be sure, we reset the Interface flag for all main
645 -- ALI files.
647 for Index in ALIs.First .. ALIs.Last loop
648 ALIs.Table (Index).SAL_Interface := False;
649 end loop;
651 -- Add System.Standard_Library to list to ensure that these files are
652 -- included in the bind, even if not directly referenced from Ada code
653 -- This is suppressed if the appropriate targparm switch is set.
655 if not Suppress_Standard_Library_On_Target then
656 Name_Buffer (1 .. 12) := "s-stalib.ali";
657 Name_Len := 12;
658 Std_Lib_File := Name_Find;
659 Text := Read_Library_Info (Std_Lib_File, True);
661 declare
662 Id : ALI_Id;
663 pragma Warnings (Off, Id);
665 begin
666 Id :=
667 Scan_ALI
668 (F => Std_Lib_File,
669 T => Text,
670 Ignore_ED => False,
671 Err => False,
672 Ignore_Errors => Debug_Flag_I);
673 end;
675 Free (Text);
676 end if;
678 -- Acquire all information in ALI files that have been read in
680 for Index in ALIs.First .. ALIs.Last loop
681 Read_ALI (Index);
682 end loop;
684 -- Quit if some file needs compiling
686 if No_Object_Specified then
687 raise Unrecoverable_Error;
688 end if;
690 -- Build source file table from the ALI files we have read in
692 Set_Source_Table;
694 -- If there is main program to bind, set Main_Lib_File to the first
695 -- library file, and the name from which to derive the binder generate
696 -- file to the first ALI file.
698 if Bind_Main_Program then
699 Main_Lib_File := First_Main_Lib_File;
700 Set_Current_File_Name_Index (To => 1);
701 end if;
703 -- Check that main library file is a suitable main program
705 if Bind_Main_Program
706 and then ALIs.Table (ALIs.First).Main_Program = None
707 and then not No_Main_Subprogram
708 then
709 Error_Msg_File_1 := Main_Lib_File;
710 Error_Msg ("{ does not contain a unit that can be a main program");
711 end if;
713 -- Perform consistency and correctness checks
715 Check_Duplicated_Subunits;
716 Check_Versions;
717 Check_Consistency;
718 Check_Configuration_Consistency;
720 -- List restrictions that could be applied to this partition
722 if List_Restrictions then
723 List_Applicable_Restrictions;
724 end if;
726 -- Complete bind if no errors
728 if Errors_Detected = 0 then
729 Find_Elab_Order;
731 if Errors_Detected = 0 then
732 -- Display elaboration order if -l was specified
734 if Elab_Order_Output then
735 if not Zero_Formatting then
736 Write_Eol;
737 Write_Str ("ELABORATION ORDER");
738 Write_Eol;
739 end if;
741 for J in Elab_Order.First .. Elab_Order.Last loop
742 if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
743 if not Zero_Formatting then
744 Write_Str (" ");
745 end if;
747 Write_Unit_Name
748 (Units.Table (Elab_Order.Table (J)).Uname);
749 Write_Eol;
750 end if;
751 end loop;
753 if not Zero_Formatting then
754 Write_Eol;
755 end if;
756 end if;
758 if not Check_Only then
759 Gen_Output_File (Output_File_Name.all);
760 end if;
762 -- Display list of sources in the closure (except predefined
763 -- sources) if -R was used.
765 if List_Closure then
766 if not Zero_Formatting then
767 Write_Eol;
768 Write_Str ("REFERENCED SOURCES");
769 Write_Eol;
770 end if;
772 for J in reverse Elab_Order.First .. Elab_Order.Last loop
774 -- Do not include the sources of the runtime
776 if not Is_Internal_File_Name
777 (Units.Table (Elab_Order.Table (J)).Sfile)
778 then
779 if not Zero_Formatting then
780 Write_Str (" ");
781 end if;
783 Write_Str
784 (Get_Name_String
785 (Units.Table (Elab_Order.Table (J)).Sfile));
786 Write_Eol;
787 end if;
788 end loop;
790 if not Zero_Formatting then
791 Write_Eol;
792 end if;
793 end if;
794 end if;
795 end if;
797 Total_Errors := Total_Errors + Errors_Detected;
798 Total_Warnings := Total_Warnings + Warnings_Detected;
800 exception
801 when Unrecoverable_Error =>
802 Total_Errors := Total_Errors + Errors_Detected;
803 Total_Warnings := Total_Warnings + Warnings_Detected;
804 end;
806 -- All done. Set proper exit status
808 Finalize_Binderr;
809 Namet.Finalize;
811 if Total_Errors > 0 then
812 Exit_Program (E_Errors);
814 elsif Total_Warnings > 0 then
815 Exit_Program (E_Warnings);
817 else
818 -- Do not call Exit_Program (E_Success), so that finalization occurs
819 -- normally.
821 null;
822 end if;
824 end Gnatbind;