File : gnatbind.adb
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-2016, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
25
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 Table;
49 with Targparm; use Targparm;
50 with Types; use Types;
51
52 with System.Case_Util; use System.Case_Util;
53 with System.OS_Lib; use System.OS_Lib;
54
55 with Ada.Command_Line.Response_File; use Ada.Command_Line;
56
57 procedure Gnatbind is
58
59 Total_Errors : Nat := 0;
60 -- Counts total errors in all files
61
62 Total_Warnings : Nat := 0;
63 -- Total warnings in all files
64
65 Main_Lib_File : File_Name_Type;
66 -- Current main library file
67
68 First_Main_Lib_File : File_Name_Type := No_File;
69 -- The first library file, that should be a main subprogram if neither -n
70 -- nor -z are used.
71
72 Std_Lib_File : File_Name_Type;
73 -- Standard library
74
75 Text : Text_Buffer_Ptr;
76
77 Output_File_Name_Seen : Boolean := False;
78 Output_File_Name : String_Ptr := new String'("");
79
80 Mapping_File : String_Ptr := null;
81
82 package Closure_Sources is new Table.Table
83 (Table_Component_Type => File_Name_Type,
84 Table_Index_Type => Natural,
85 Table_Low_Bound => 1,
86 Table_Initial => 10,
87 Table_Increment => 100,
88 Table_Name => "Gnatbind.Closure_Sources");
89 -- Table to record the sources in the closure, to avoid duplications. Used
90 -- only with switch -R.
91
92 procedure Add_Artificial_ALI_File (Name : String);
93 -- Artificially add ALI file Name in the closure
94
95 function Gnatbind_Supports_Auto_Init return Boolean;
96 -- Indicates if automatic initialization of elaboration procedure
97 -- through the constructor mechanism is possible on the platform.
98
99 procedure List_Applicable_Restrictions;
100 -- List restrictions that apply to this partition if option taken
101
102 procedure Scan_Bind_Arg (Argv : String);
103 -- Scan and process binder specific arguments. Argv is a single argument.
104 -- All the one character arguments are still handled by Switch. This
105 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
106
107 generic
108 with procedure Action (Argv : String);
109 procedure Generic_Scan_Bind_Args;
110 -- Iterate through the args calling Action on each one, taking care of
111 -- response files.
112
113 procedure Write_Arg (S : String);
114 -- Passed to Generic_Scan_Bind_Args to print args
115
116 function Is_Cross_Compiler return Boolean;
117 -- Returns True iff this is a cross-compiler
118
119 -----------------------------
120 -- Add_Artificial_ALI_File --
121 -----------------------------
122
123 procedure Add_Artificial_ALI_File (Name : String) is
124 Id : ALI_Id;
125 pragma Warnings (Off, Id);
126
127 begin
128 Name_Len := Name'Length;
129 Name_Buffer (1 .. Name_Len) := Name;
130 Std_Lib_File := Name_Find;
131 Text := Read_Library_Info (Std_Lib_File, True);
132
133 Id :=
134 Scan_ALI
135 (F => Std_Lib_File,
136 T => Text,
137 Ignore_ED => False,
138 Err => False,
139 Ignore_Errors => Debug_Flag_I);
140
141 Free (Text);
142 end Add_Artificial_ALI_File;
143
144 ---------------------------------
145 -- Gnatbind_Supports_Auto_Init --
146 ---------------------------------
147
148 function Gnatbind_Supports_Auto_Init return Boolean is
149 function gnat_binder_supports_auto_init return Integer;
150 pragma Import (C, gnat_binder_supports_auto_init,
151 "__gnat_binder_supports_auto_init");
152 begin
153 return gnat_binder_supports_auto_init /= 0;
154 end Gnatbind_Supports_Auto_Init;
155
156 -----------------------
157 -- Is_Cross_Compiler --
158 -----------------------
159
160 function Is_Cross_Compiler return Boolean is
161 Cross_Compiler : Integer;
162 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
163 begin
164 return Cross_Compiler = 1;
165 end Is_Cross_Compiler;
166
167 ----------------------------------
168 -- List_Applicable_Restrictions --
169 ----------------------------------
170
171 procedure List_Applicable_Restrictions is
172
173 -- Define those restrictions that should be output if the gnatbind
174 -- -r switch is used. Not all restrictions are output for the reasons
175 -- given below in the list, and this array is used to test whether
176 -- the corresponding pragma should be listed. True means that it
177 -- should not be listed.
178
179 No_Restriction_List : constant array (All_Restrictions) of Boolean :=
180 (No_Standard_Allocators_After_Elaboration => True,
181 -- This involves run-time conditions not checkable at compile time
182
183 No_Anonymous_Allocators => True,
184 -- Premature, since we have not implemented this yet
185
186 No_Exception_Propagation => True,
187 -- Modifies code resulting in different exception semantics
188
189 No_Exceptions => True,
190 -- Has unexpected Suppress (All_Checks) effect
191
192 No_Implicit_Conditionals => True,
193 -- This could modify and pessimize generated code
194
195 No_Implicit_Dynamic_Code => True,
196 -- This could modify and pessimize generated code
197
198 No_Implicit_Loops => True,
199 -- This could modify and pessimize generated code
200
201 No_Recursion => True,
202 -- Not checkable at compile time
203
204 No_Reentrancy => True,
205 -- Not checkable at compile time
206
207 Max_Entry_Queue_Length => True,
208 -- Not checkable at compile time
209
210 Max_Storage_At_Blocking => True,
211 -- Not checkable at compile time
212
213 -- The following three should not be partition-wide, so the
214 -- following tests are junk to be removed eventually ???
215
216 No_Specification_Of_Aspect => True,
217 -- Requires a parameter value, not a count
218
219 No_Use_Of_Attribute => True,
220 -- Requires a parameter value, not a count
221
222 No_Use_Of_Pragma => True,
223 -- Requires a parameter value, not a count
224
225 others => False);
226
227 Additional_Restrictions_Listed : Boolean := False;
228 -- Set True if we have listed header for restrictions
229
230 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
231 -- Returns True if the given restriction can be listed as an additional
232 -- restriction that could be set.
233
234 ------------------------------
235 -- Restriction_Could_Be_Set --
236 ------------------------------
237
238 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
239 CR : Restrictions_Info renames Cumulative_Restrictions;
240
241 begin
242 case R is
243
244 -- Boolean restriction
245
246 when All_Boolean_Restrictions =>
247
248 -- The condition for listing a boolean restriction as an
249 -- additional restriction that could be set is that it is
250 -- not violated by any unit, and not already set.
251
252 return CR.Violated (R) = False and then CR.Set (R) = False;
253
254 -- Parameter restriction
255
256 when All_Parameter_Restrictions =>
257
258 -- If the restriction is violated and the level of violation is
259 -- unknown, the restriction can definitely not be listed.
260
261 if CR.Violated (R) and then CR.Unknown (R) then
262 return False;
263
264 -- We can list the restriction if it is not set
265
266 elsif not CR.Set (R) then
267 return True;
268
269 -- We can list the restriction if is set to a greater value
270 -- than the maximum value known for the violation.
271
272 else
273 return CR.Value (R) > CR.Count (R);
274 end if;
275
276 -- No other values for R possible
277
278 when others =>
279 raise Program_Error;
280
281 end case;
282 end Restriction_Could_Be_Set;
283
284 -- Start of processing for List_Applicable_Restrictions
285
286 begin
287 -- Loop through restrictions
288
289 for R in All_Restrictions loop
290 if not No_Restriction_List (R)
291 and then Restriction_Could_Be_Set (R)
292 then
293 if not Additional_Restrictions_Listed then
294 Write_Eol;
295 Write_Line
296 ("The following additional restrictions may be" &
297 " applied to this partition:");
298 Additional_Restrictions_Listed := True;
299 end if;
300
301 Write_Str ("pragma Restrictions (");
302
303 declare
304 S : constant String := Restriction_Id'Image (R);
305 begin
306 Name_Len := S'Length;
307 Name_Buffer (1 .. Name_Len) := S;
308 end;
309
310 Set_Casing (Mixed_Case);
311 Write_Str (Name_Buffer (1 .. Name_Len));
312
313 if R in All_Parameter_Restrictions then
314 Write_Str (" => ");
315 Write_Int (Int (Cumulative_Restrictions.Count (R)));
316 end if;
317
318 Write_Str (");");
319 Write_Eol;
320 end if;
321 end loop;
322 end List_Applicable_Restrictions;
323
324 -------------------
325 -- Scan_Bind_Arg --
326 -------------------
327
328 procedure Scan_Bind_Arg (Argv : String) is
329 pragma Assert (Argv'First = 1);
330
331 begin
332 -- Now scan arguments that are specific to the binder and are not
333 -- handled by the common circuitry in Switch.
334
335 if Opt.Output_File_Name_Present
336 and then not Output_File_Name_Seen
337 then
338 Output_File_Name_Seen := True;
339
340 if Argv'Length = 0
341 or else (Argv'Length >= 1 and then Argv (1) = '-')
342 then
343 Fail ("output File_Name missing after -o");
344
345 else
346 Output_File_Name := new String'(Argv);
347 end if;
348
349 elsif Argv'Length >= 2 and then Argv (1) = '-' then
350
351 -- -I-
352
353 if Argv (2 .. Argv'Last) = "I-" then
354 Opt.Look_In_Primary_Dir := False;
355
356 -- -Idir
357
358 elsif Argv (2) = 'I' then
359 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
360 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
361
362 -- -Ldir
363
364 elsif Argv (2) = 'L' then
365 if Argv'Length >= 3 then
366
367 Opt.Bind_For_Library := True;
368 Opt.Ada_Init_Name :=
369 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
370 Opt.Ada_Final_Name :=
371 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
372 Opt.Ada_Main_Name :=
373 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
374
375 -- This option (-Lxxx) implies -n
376
377 Opt.Bind_Main_Program := False;
378
379 else
380 Fail
381 ("Prefix of initialization and finalization " &
382 "procedure names missing in -L");
383 end if;
384
385 -- -Sin -Slo -Shi -Sxx -Sev
386
387 elsif Argv'Length = 4
388 and then Argv (2) = 'S'
389 then
390 declare
391 C1 : Character := Argv (3);
392 C2 : Character := Argv (4);
393
394 begin
395 -- Fold to upper case
396
397 if C1 in 'a' .. 'z' then
398 C1 := Character'Val (Character'Pos (C1) - 32);
399 end if;
400
401 if C2 in 'a' .. 'z' then
402 C2 := Character'Val (Character'Pos (C2) - 32);
403 end if;
404
405 -- Test valid option and set mode accordingly
406
407 if C1 = 'E' and then C2 = 'V' then
408 null;
409
410 elsif C1 = 'I' and then C2 = 'N' then
411 null;
412
413 elsif C1 = 'L' and then C2 = 'O' then
414 null;
415
416 elsif C1 = 'H' and then C2 = 'I' then
417 null;
418
419 elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
420 and then
421 (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
422 then
423 null;
424
425 -- Invalid -S switch, let Switch give error, set default of IN
426
427 else
428 Scan_Binder_Switches (Argv);
429 C1 := 'I';
430 C2 := 'N';
431 end if;
432
433 Initialize_Scalars_Mode1 := C1;
434 Initialize_Scalars_Mode2 := C2;
435 end;
436
437 -- -aIdir
438
439 elsif Argv'Length >= 3
440 and then Argv (2 .. 3) = "aI"
441 then
442 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
443
444 -- -aOdir
445
446 elsif Argv'Length >= 3
447 and then Argv (2 .. 3) = "aO"
448 then
449 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
450
451 -- -nostdlib
452
453 elsif Argv (2 .. Argv'Last) = "nostdlib" then
454 Opt.No_Stdlib := True;
455
456 -- -nostdinc
457
458 elsif Argv (2 .. Argv'Last) = "nostdinc" then
459 Opt.No_Stdinc := True;
460
461 -- -static
462
463 elsif Argv (2 .. Argv'Last) = "static" then
464 Opt.Shared_Libgnat := False;
465
466 -- -shared
467
468 elsif Argv (2 .. Argv'Last) = "shared" then
469 Opt.Shared_Libgnat := True;
470
471 -- -F=mapping_file
472
473 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
474 if Mapping_File /= null then
475 Fail ("cannot specify several mapping files");
476 end if;
477
478 Mapping_File := new String'(Argv (4 .. Argv'Last));
479
480 -- -Mname
481
482 elsif Argv'Length >= 3 and then Argv (2) = 'M' then
483 if not Is_Cross_Compiler then
484 Write_Line
485 ("gnatbind: -M not expected to be used on native platforms");
486 end if;
487
488 Opt.Bind_Alternate_Main_Name := True;
489 Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
490
491 -- All other options are single character and are handled by
492 -- Scan_Binder_Switches.
493
494 else
495 Scan_Binder_Switches (Argv);
496 end if;
497
498 -- Not a switch, so must be a file name (if non-empty)
499
500 elsif Argv'Length /= 0 then
501 if Argv'Length > 4
502 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
503 then
504 Add_File (Argv);
505 else
506 Add_File (Argv & ".ali");
507 end if;
508 end if;
509 end Scan_Bind_Arg;
510
511 ----------------------------
512 -- Generic_Scan_Bind_Args --
513 ----------------------------
514
515 procedure Generic_Scan_Bind_Args is
516 Next_Arg : Positive := 1;
517
518 begin
519 -- Use low level argument routines to avoid dragging in secondary stack
520
521 while Next_Arg < Arg_Count loop
522 declare
523 Next_Argv : String (1 .. Len_Arg (Next_Arg));
524
525 begin
526 Fill_Arg (Next_Argv'Address, Next_Arg);
527
528 if Next_Argv'Length > 0 then
529 if Next_Argv (1) = '@' then
530 if Next_Argv'Length > 1 then
531 declare
532 Arguments : constant Argument_List :=
533 Response_File.Arguments_From
534 (Response_File_Name =>
535 Next_Argv (2 .. Next_Argv'Last),
536 Recursive => True,
537 Ignore_Non_Existing_Files => True);
538 begin
539 for J in Arguments'Range loop
540 Action (Arguments (J).all);
541 end loop;
542 end;
543 end if;
544
545 else
546 Action (Next_Argv);
547 end if;
548 end if;
549 end;
550
551 Next_Arg := Next_Arg + 1;
552 end loop;
553 end Generic_Scan_Bind_Args;
554
555 ---------------
556 -- Write_Arg --
557 ---------------
558
559 procedure Write_Arg (S : String) is
560 begin
561 Write_Str (" " & S);
562 end Write_Arg;
563
564 procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
565 procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
566
567 procedure Check_Version_And_Help is
568 new Check_Version_And_Help_G (Bindusg.Display);
569
570 -- Start of processing for Gnatbind
571
572 begin
573 -- Set default for Shared_Libgnat option
574
575 declare
576 Shared_Libgnat_Default : Character;
577 pragma Import
578 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
579
580 SHARED : constant Character := 'H';
581 STATIC : constant Character := 'T';
582
583 begin
584 pragma Assert
585 (Shared_Libgnat_Default = SHARED
586 or else
587 Shared_Libgnat_Default = STATIC);
588 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
589 end;
590
591 -- Carry out package initializations. These are initializations which
592 -- might logically be performed at elaboration time, and we decide to be
593 -- consistent. Like elaboration, the order in which these calls are made
594 -- is in some cases important.
595
596 Csets.Initialize;
597 Snames.Initialize;
598
599 -- Scan the switches and arguments. Note that Snames must already be
600 -- initialized (for processing of the -V switch).
601
602 -- First, scan to detect --version and/or --help
603
604 Check_Version_And_Help ("GNATBIND", "1992");
605
606 -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
607 -- to Put_Bind_Args.
608
609 Scan_Bind_Args;
610
611 if Verbose_Mode then
612 Write_Str (Command_Name);
613 Put_Bind_Args;
614 Write_Eol;
615 end if;
616
617 if Use_Pragma_Linker_Constructor then
618 if Bind_Main_Program then
619 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
620
621 elsif not Gnatbind_Supports_Auto_Init then
622 Fail ("automatic initialisation of elaboration " &
623 "not supported on this platform");
624 end if;
625 end if;
626
627 -- Test for trailing -o switch
628
629 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
630 Fail ("output file name missing after -o");
631 end if;
632
633 -- Output usage if requested
634
635 if Usage_Requested then
636 Bindusg.Display;
637 end if;
638
639 -- Check that the binder file specified has extension .adb
640
641 if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
642 Check_Extensions : declare
643 Length : constant Natural := Output_File_Name'Length;
644 Last : constant Natural := Output_File_Name'Last;
645 begin
646 if Length <= 4
647 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
648 then
649 Fail ("output file name should have .adb extension");
650 end if;
651 end Check_Extensions;
652 end if;
653
654 Osint.Add_Default_Search_Dirs;
655
656 -- Acquire target parameters
657
658 Targparm.Get_Target_Parameters;
659
660 -- Initialize Cumulative_Restrictions with the restrictions on the target
661 -- scanned from the system.ads file. Then as we read ALI files, we will
662 -- accumulate additional restrictions specified in other files.
663
664 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
665
666 -- Acquire configurable run-time mode
667
668 if Configurable_Run_Time_On_Target then
669 Configurable_Run_Time_Mode := True;
670 end if;
671
672 -- Output copyright notice if in verbose mode
673
674 if Verbose_Mode then
675 Write_Eol;
676 Display_Version ("GNATBIND", "1995");
677 end if;
678
679 -- Output usage information if no arguments
680
681 if not More_Lib_Files then
682 if Argument_Count = 0 then
683 Bindusg.Display;
684 else
685 Write_Line ("try ""gnatbind --help"" for more information.");
686 end if;
687
688 Exit_Program (E_Fatal);
689 end if;
690
691 -- If a mapping file was specified, initialize the file mapping
692
693 if Mapping_File /= null then
694 Fmap.Initialize (Mapping_File.all);
695 end if;
696
697 -- The block here is to catch the Unrecoverable_Error exception in the
698 -- case where we exceed the maximum number of permissible errors or some
699 -- other unrecoverable error occurs.
700
701 begin
702 -- Initialize binder packages
703
704 Initialize_Binderr;
705 Initialize_ALI;
706 Initialize_ALI_Source;
707
708 if Verbose_Mode then
709 Write_Eol;
710 end if;
711
712 -- Input ALI files
713
714 while More_Lib_Files loop
715 Main_Lib_File := Next_Main_Lib_File;
716
717 if First_Main_Lib_File = No_File then
718 First_Main_Lib_File := Main_Lib_File;
719 end if;
720
721 if Verbose_Mode then
722 if Check_Only then
723 Write_Str ("Checking: ");
724 else
725 Write_Str ("Binding: ");
726 end if;
727
728 Write_Name (Main_Lib_File);
729 Write_Eol;
730 end if;
731
732 Text := Read_Library_Info (Main_Lib_File, True);
733
734 declare
735 Id : ALI_Id;
736 pragma Warnings (Off, Id);
737
738 begin
739 Id := Scan_ALI
740 (F => Main_Lib_File,
741 T => Text,
742 Ignore_ED => False,
743 Err => False,
744 Ignore_Errors => Debug_Flag_I,
745 Directly_Scanned => True);
746 end;
747
748 Free (Text);
749 end loop;
750
751 -- No_Run_Time mode
752
753 if No_Run_Time_Mode then
754
755 -- Set standard configuration parameters
756
757 Suppress_Standard_Library_On_Target := True;
758 Configurable_Run_Time_Mode := True;
759 end if;
760
761 -- For main ALI files, even if they are interfaces, we get their
762 -- dependencies. To be sure, we reset the Interface flag for all main
763 -- ALI files.
764
765 for Index in ALIs.First .. ALIs.Last loop
766 ALIs.Table (Index).SAL_Interface := False;
767 end loop;
768
769 -- Add System.Standard_Library to list to ensure that these files are
770 -- included in the bind, even if not directly referenced from Ada code
771 -- This is suppressed if the appropriate targparm switch is set. Be sure
772 -- in any case that System is in the closure, as it may contains linker
773 -- options. Note that it will be automatically added if s-stalib is
774 -- added.
775
776 if not Suppress_Standard_Library_On_Target then
777 Add_Artificial_ALI_File ("s-stalib.ali");
778 else
779 Add_Artificial_ALI_File ("system.ali");
780 end if;
781
782 -- Load ALIs for all dependent units
783
784 for Index in ALIs.First .. ALIs.Last loop
785 Read_Withed_ALIs (Index);
786 end loop;
787
788 -- Quit if some file needs compiling
789
790 if No_Object_Specified then
791 raise Unrecoverable_Error;
792 end if;
793
794 -- Quit with message if we had a GNATprove file
795
796 if GNATprove_Mode_Specified then
797 Error_Msg ("one or more files compiled in GNATprove mode");
798 raise Unrecoverable_Error;
799 end if;
800
801 -- Output list of ALI files in closure
802
803 if Output_ALI_List then
804 if ALI_List_Filename /= null then
805 Set_List_File (ALI_List_Filename.all);
806 end if;
807
808 for Index in ALIs.First .. ALIs.Last loop
809 declare
810 Full_Afile : constant File_Name_Type :=
811 Find_File (ALIs.Table (Index).Afile, Library);
812 begin
813 Write_Name (Full_Afile);
814 Write_Eol;
815 end;
816 end loop;
817
818 if ALI_List_Filename /= null then
819 Close_List_File;
820 end if;
821 end if;
822
823 -- Build source file table from the ALI files we have read in
824
825 Set_Source_Table;
826
827 -- If there is main program to bind, set Main_Lib_File to the first
828 -- library file, and the name from which to derive the binder generate
829 -- file to the first ALI file.
830
831 if Bind_Main_Program then
832 Main_Lib_File := First_Main_Lib_File;
833 Set_Current_File_Name_Index (To => 1);
834 end if;
835
836 -- Check that main library file is a suitable main program
837
838 if Bind_Main_Program
839 and then ALIs.Table (ALIs.First).Main_Program = None
840 and then not No_Main_Subprogram
841 then
842 Get_Name_String
843 (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
844
845 declare
846 Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
847 begin
848 To_Mixed (Unit_Name);
849 Get_Name_String (ALIs.Table (ALIs.First).Sfile);
850 Add_Str_To_Name_Buffer (":1: ");
851 Add_Str_To_Name_Buffer (Unit_Name);
852 Add_Str_To_Name_Buffer (" cannot be used as a main program");
853 Write_Line (Name_Buffer (1 .. Name_Len));
854 Errors_Detected := Errors_Detected + 1;
855 end;
856 end if;
857
858 -- Perform consistency and correctness checks
859
860 Check_Duplicated_Subunits;
861 Check_Versions;
862 Check_Consistency;
863 Check_Configuration_Consistency;
864
865 -- List restrictions that could be applied to this partition
866
867 if List_Restrictions then
868 List_Applicable_Restrictions;
869 end if;
870
871 -- Complete bind if no errors
872
873 if Errors_Detected = 0 then
874 Find_Elab_Order;
875
876 if Errors_Detected = 0 then
877 -- Display elaboration order if -l was specified
878
879 if Elab_Order_Output then
880 if not Zero_Formatting then
881 Write_Eol;
882 Write_Str ("ELABORATION ORDER");
883 Write_Eol;
884 end if;
885
886 for J in Elab_Order.First .. Elab_Order.Last loop
887 if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
888 if not Zero_Formatting then
889 Write_Str (" ");
890 end if;
891
892 Write_Unit_Name
893 (Units.Table (Elab_Order.Table (J)).Uname);
894 Write_Eol;
895 end if;
896 end loop;
897
898 if not Zero_Formatting then
899 Write_Eol;
900 end if;
901 end if;
902
903 if not Check_Only then
904 Gen_Output_File (Output_File_Name.all);
905 end if;
906
907 -- Display list of sources in the closure (except predefined
908 -- sources) if -R was used.
909
910 if List_Closure then
911 List_Closure_Display : declare
912 Source : File_Name_Type;
913
914 function Put_In_Sources (S : File_Name_Type) return Boolean;
915 -- Check if S is already in table Sources and put in Sources
916 -- if it is not. Return False if the source is already in
917 -- Sources, and True if it is added.
918
919 --------------------
920 -- Put_In_Sources --
921 --------------------
922
923 function Put_In_Sources
924 (S : File_Name_Type) return Boolean
925 is
926 begin
927 for J in 1 .. Closure_Sources.Last loop
928 if Closure_Sources.Table (J) = S then
929 return False;
930 end if;
931 end loop;
932
933 Closure_Sources.Append (S);
934 return True;
935 end Put_In_Sources;
936
937 -- Start of processing for List_Closure_Display
938
939 begin
940 Closure_Sources.Init;
941
942 if not Zero_Formatting then
943 Write_Eol;
944 Write_Str ("REFERENCED SOURCES");
945 Write_Eol;
946 end if;
947
948 for J in reverse Elab_Order.First .. Elab_Order.Last loop
949 Source := Units.Table (Elab_Order.Table (J)).Sfile;
950
951 -- Do not include same source more than once
952
953 if Put_In_Sources (Source)
954
955 -- Do not include run-time units unless -Ra switch set
956
957 and then (List_Closure_All
958 or else not Is_Internal_File_Name (Source))
959 then
960 if not Zero_Formatting then
961 Write_Str (" ");
962 end if;
963
964 Write_Str (Get_Name_String (Source));
965 Write_Eol;
966 end if;
967 end loop;
968
969 -- Subunits do not appear in the elaboration table because
970 -- they are subsumed by their parent units, but we need to
971 -- list them for other tools. For now they are listed after
972 -- other files, rather than right after their parent, since
973 -- there is no easy link between the elaboration table and
974 -- the ALIs table ??? As subunits may appear repeatedly in
975 -- the list, if the parent unit appears in the context of
976 -- several units in the closure, duplicates are suppressed.
977
978 for J in Sdep.First .. Sdep.Last loop
979 Source := Sdep.Table (J).Sfile;
980
981 if Sdep.Table (J).Subunit_Name /= No_Name
982 and then Put_In_Sources (Source)
983 and then not Is_Internal_File_Name (Source)
984 then
985 if not Zero_Formatting then
986 Write_Str (" ");
987 end if;
988
989 Write_Str (Get_Name_String (Source));
990 Write_Eol;
991 end if;
992 end loop;
993
994 if not Zero_Formatting then
995 Write_Eol;
996 end if;
997 end List_Closure_Display;
998 end if;
999 end if;
1000 end if;
1001
1002 Total_Errors := Total_Errors + Errors_Detected;
1003 Total_Warnings := Total_Warnings + Warnings_Detected;
1004
1005 exception
1006 when Unrecoverable_Error =>
1007 Total_Errors := Total_Errors + Errors_Detected;
1008 Total_Warnings := Total_Warnings + Warnings_Detected;
1009 end;
1010
1011 -- All done. Set proper exit status
1012
1013 Finalize_Binderr;
1014 Namet.Finalize;
1015
1016 if Total_Errors > 0 then
1017 Exit_Program (E_Errors);
1018
1019 elsif Total_Warnings > 0 then
1020 Exit_Program (E_Warnings);
1021
1022 else
1023 -- Do not call Exit_Program (E_Success), so that finalization occurs
1024 -- normally.
1025
1026 null;
1027 end if;
1028 end Gnatbind;