* tree-vect-loop-manip.c (vect_do_peeling): Do not use
[official-gcc.git] / gcc / ada / gnatbind.adb
blob4f5197d82bde94a0ff2c3fa92c1e8cf741f8bdad
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-2017, 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 Casing; use Casing;
34 with Csets;
35 with Debug; use Debug;
36 with Fmap;
37 with Namet; use Namet;
38 with Opt; use Opt;
40 with Osint; use Osint;
41 -- Note that we use low-level routines in Osint to read command-line
42 -- arguments. We cannot depend on Ada.Command_Line, because it contains modern
43 -- Ada features that would break bootstrapping with old base compilers.
45 with Osint.B; use Osint.B;
46 with Output; use Output;
47 with Rident; use Rident;
48 with Snames;
49 with Switch; use Switch;
50 with Switch.B; use Switch.B;
51 with Targparm; use Targparm;
52 with Types; use Types;
54 with System.Case_Util; use System.Case_Util;
55 with System.Response_File;
56 with System.OS_Lib; use System.OS_Lib;
58 procedure Gnatbind is
60 Total_Errors : Nat := 0;
61 -- Counts total errors in all files
63 Total_Warnings : Nat := 0;
64 -- Total warnings in all files
66 Main_Lib_File : File_Name_Type;
67 -- Current main library file
69 First_Main_Lib_File : File_Name_Type := No_File;
70 -- The first library file, that should be a main subprogram if neither -n
71 -- nor -z are used.
73 Text : Text_Buffer_Ptr;
75 Output_File_Name_Seen : Boolean := False;
76 Output_File_Name : String_Ptr := new String'("");
78 Mapping_File : String_Ptr := null;
80 procedure Add_Artificial_ALI_File (Name : String);
81 -- Artificially add ALI file Name in the closure
83 function Gnatbind_Supports_Auto_Init return Boolean;
84 -- Indicates if automatic initialization of elaboration procedure through
85 -- the constructor mechanism is possible on the platform.
87 function Is_Cross_Compiler return Boolean;
88 -- Returns True iff this is a cross-compiler
90 procedure List_Applicable_Restrictions;
91 -- List restrictions that apply to this partition if option taken
93 procedure Scan_Bind_Arg (Argv : String);
94 -- Scan and process binder specific arguments. Argv is a single argument.
95 -- All the one character arguments are still handled by Switch. This
96 -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
98 generic
99 with procedure Action (Argv : String);
100 procedure Generic_Scan_Bind_Args;
101 -- Iterate through the args calling Action on each one, taking care of
102 -- response files.
104 procedure Write_Arg (S : String);
105 -- Passed to Generic_Scan_Bind_Args to print args
107 -----------------------------
108 -- Add_Artificial_ALI_File --
109 -----------------------------
111 procedure Add_Artificial_ALI_File (Name : String) is
112 Id : ALI_Id;
113 pragma Warnings (Off, Id);
115 Std_Lib_File : File_Name_Type;
116 -- Standard library
118 begin
119 Name_Len := Name'Length;
120 Name_Buffer (1 .. Name_Len) := Name;
121 Std_Lib_File := Name_Find;
122 Text := Read_Library_Info (Std_Lib_File, True);
124 Id :=
125 Scan_ALI
126 (F => Std_Lib_File,
127 T => Text,
128 Ignore_ED => False,
129 Err => False,
130 Ignore_Errors => Debug_Flag_I);
132 Free (Text);
133 end Add_Artificial_ALI_File;
135 ---------------------------------
136 -- Gnatbind_Supports_Auto_Init --
137 ---------------------------------
139 function Gnatbind_Supports_Auto_Init return Boolean is
140 function gnat_binder_supports_auto_init return Integer;
141 pragma Import (C, gnat_binder_supports_auto_init,
142 "__gnat_binder_supports_auto_init");
144 begin
145 return gnat_binder_supports_auto_init /= 0;
146 end Gnatbind_Supports_Auto_Init;
148 -----------------------
149 -- Is_Cross_Compiler --
150 -----------------------
152 function Is_Cross_Compiler return Boolean is
153 Cross_Compiler : Integer;
154 pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
156 begin
157 return Cross_Compiler = 1;
158 end Is_Cross_Compiler;
160 ----------------------------------
161 -- List_Applicable_Restrictions --
162 ----------------------------------
164 procedure List_Applicable_Restrictions is
166 -- Define those restrictions that should be output if the gnatbind
167 -- -r switch is used. Not all restrictions are output for the reasons
168 -- given below in the list, and this array is used to test whether
169 -- the corresponding pragma should be listed. True means that it
170 -- should not be listed.
172 No_Restriction_List : constant array (All_Restrictions) of Boolean :=
173 (No_Standard_Allocators_After_Elaboration => True,
174 -- This involves run-time conditions not checkable at compile time
176 No_Anonymous_Allocators => True,
177 -- Premature, since we have not implemented this yet
179 No_Exception_Propagation => True,
180 -- Modifies code resulting in different exception semantics
182 No_Exceptions => True,
183 -- Has unexpected Suppress (All_Checks) effect
185 No_Implicit_Conditionals => True,
186 -- This could modify and pessimize generated code
188 No_Implicit_Dynamic_Code => True,
189 -- This could modify and pessimize generated code
191 No_Implicit_Loops => True,
192 -- This could modify and pessimize generated code
194 No_Recursion => True,
195 -- Not checkable at compile time
197 No_Reentrancy => True,
198 -- Not checkable at compile time
200 Max_Entry_Queue_Length => True,
201 -- Not checkable at compile time
203 Max_Storage_At_Blocking => True,
204 -- Not checkable at compile time
206 -- The following three should not be partition-wide, so the
207 -- following tests are junk to be removed eventually ???
209 No_Specification_Of_Aspect => True,
210 -- Requires a parameter value, not a count
212 No_Use_Of_Attribute => True,
213 -- Requires a parameter value, not a count
215 No_Use_Of_Pragma => True,
216 -- Requires a parameter value, not a count
218 others => False);
220 Additional_Restrictions_Listed : Boolean := False;
221 -- Set True if we have listed header for restrictions
223 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
224 -- Returns True if the given restriction can be listed as an additional
225 -- restriction that could be set.
227 ------------------------------
228 -- Restriction_Could_Be_Set --
229 ------------------------------
231 function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
232 CR : Restrictions_Info renames Cumulative_Restrictions;
234 begin
235 case R is
237 -- Boolean restriction
239 when All_Boolean_Restrictions =>
241 -- The condition for listing a boolean restriction as an
242 -- additional restriction that could be set is that it is
243 -- not violated by any unit, and not already set.
245 return CR.Violated (R) = False and then CR.Set (R) = False;
247 -- Parameter restriction
249 when All_Parameter_Restrictions =>
251 -- If the restriction is violated and the level of violation is
252 -- unknown, the restriction can definitely not be listed.
254 if CR.Violated (R) and then CR.Unknown (R) then
255 return False;
257 -- We can list the restriction if it is not set
259 elsif not CR.Set (R) then
260 return True;
262 -- We can list the restriction if is set to a greater value
263 -- than the maximum value known for the violation.
265 else
266 return CR.Value (R) > CR.Count (R);
267 end if;
269 -- No other values for R possible
271 when others =>
272 raise Program_Error;
273 end case;
274 end Restriction_Could_Be_Set;
276 -- Start of processing for List_Applicable_Restrictions
278 begin
279 -- Loop through restrictions
281 for R in All_Restrictions loop
282 if not No_Restriction_List (R)
283 and then Restriction_Could_Be_Set (R)
284 then
285 if not Additional_Restrictions_Listed then
286 Write_Eol;
287 Write_Line
288 ("The following additional restrictions may be applied to "
289 & "this partition:");
290 Additional_Restrictions_Listed := True;
291 end if;
293 Write_Str ("pragma Restrictions (");
295 declare
296 S : constant String := Restriction_Id'Image (R);
298 begin
299 Name_Len := S'Length;
300 Name_Buffer (1 .. Name_Len) := S;
301 end;
303 Set_Casing (Mixed_Case);
304 Write_Str (Name_Buffer (1 .. Name_Len));
306 if R in All_Parameter_Restrictions then
307 Write_Str (" => ");
308 Write_Int (Int (Cumulative_Restrictions.Count (R)));
309 end if;
311 Write_Str (");");
312 Write_Eol;
313 end if;
314 end loop;
315 end List_Applicable_Restrictions;
317 -------------------
318 -- Scan_Bind_Arg --
319 -------------------
321 procedure Scan_Bind_Arg (Argv : String) is
322 pragma Assert (Argv'First = 1);
324 begin
325 -- Now scan arguments that are specific to the binder and are not
326 -- handled by the common circuitry in Switch.
328 if Opt.Output_File_Name_Present
329 and then not Output_File_Name_Seen
330 then
331 Output_File_Name_Seen := True;
333 if Argv'Length = 0 or else Argv (1) = '-' then
334 Fail ("output File_Name missing after -o");
336 else
337 Output_File_Name := new String'(Argv);
338 end if;
340 elsif Argv'Length >= 2 and then Argv (1) = '-' then
342 -- -I-
344 if Argv (2 .. Argv'Last) = "I-" then
345 Opt.Look_In_Primary_Dir := False;
347 -- -Idir
349 elsif Argv (2) = 'I' then
350 Add_Src_Search_Dir (Argv (3 .. Argv'Last));
351 Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
353 -- -Ldir
355 elsif Argv (2) = 'L' then
356 if Argv'Length >= 3 then
358 Opt.Bind_For_Library := True;
359 Opt.Ada_Init_Name :=
360 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
361 Opt.Ada_Final_Name :=
362 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
363 Opt.Ada_Main_Name :=
364 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
366 -- This option (-Lxxx) implies -n
368 Opt.Bind_Main_Program := False;
370 else
371 Fail
372 ("Prefix of initialization and finalization procedure names "
373 & "missing in -L");
374 end if;
376 -- -Sin -Slo -Shi -Sxx -Sev
378 elsif Argv'Length = 4
379 and then Argv (2) = 'S'
380 then
381 declare
382 C1 : Character := Argv (3);
383 C2 : Character := Argv (4);
385 begin
386 -- Fold to upper case
388 if C1 in 'a' .. 'z' then
389 C1 := Character'Val (Character'Pos (C1) - 32);
390 end if;
392 if C2 in 'a' .. 'z' then
393 C2 := Character'Val (Character'Pos (C2) - 32);
394 end if;
396 -- Test valid option and set mode accordingly
398 if C1 = 'E' and then C2 = 'V' then
399 null;
401 elsif C1 = 'I' and then C2 = 'N' then
402 null;
404 elsif C1 = 'L' and then C2 = 'O' then
405 null;
407 elsif C1 = 'H' and then C2 = 'I' then
408 null;
410 elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
411 and then
412 (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
413 then
414 null;
416 -- Invalid -S switch, let Switch give error, set default of IN
418 else
419 Scan_Binder_Switches (Argv);
420 C1 := 'I';
421 C2 := 'N';
422 end if;
424 Initialize_Scalars_Mode1 := C1;
425 Initialize_Scalars_Mode2 := C2;
426 end;
428 -- -aIdir
430 elsif Argv'Length >= 3
431 and then Argv (2 .. 3) = "aI"
432 then
433 Add_Src_Search_Dir (Argv (4 .. Argv'Last));
435 -- -aOdir
437 elsif Argv'Length >= 3
438 and then Argv (2 .. 3) = "aO"
439 then
440 Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
442 -- -nostdlib
444 elsif Argv (2 .. Argv'Last) = "nostdlib" then
445 Opt.No_Stdlib := True;
447 -- -nostdinc
449 elsif Argv (2 .. Argv'Last) = "nostdinc" then
450 Opt.No_Stdinc := True;
452 -- -static
454 elsif Argv (2 .. Argv'Last) = "static" then
455 Opt.Shared_Libgnat := False;
457 -- -shared
459 elsif Argv (2 .. Argv'Last) = "shared" then
460 Opt.Shared_Libgnat := True;
462 -- -F=mapping_file
464 elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
465 if Mapping_File /= null then
466 Fail ("cannot specify several mapping files");
467 end if;
469 Mapping_File := new String'(Argv (4 .. Argv'Last));
471 -- -Mname
473 elsif Argv'Length >= 3 and then Argv (2) = 'M' then
474 if not Is_Cross_Compiler then
475 Write_Line
476 ("gnatbind: -M not expected to be used on native platforms");
477 end if;
479 Opt.Bind_Alternate_Main_Name := True;
480 Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
482 -- All other options are single character and are handled by
483 -- Scan_Binder_Switches.
485 else
486 Scan_Binder_Switches (Argv);
487 end if;
489 -- Not a switch, so must be a file name (if non-empty)
491 elsif Argv'Length /= 0 then
492 if Argv'Length > 4
493 and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
494 then
495 Add_File (Argv);
496 else
497 Add_File (Argv & ".ali");
498 end if;
499 end if;
500 end Scan_Bind_Arg;
502 ----------------------------
503 -- Generic_Scan_Bind_Args --
504 ----------------------------
506 procedure Generic_Scan_Bind_Args is
507 Next_Arg : Positive := 1;
509 begin
510 while Next_Arg < Arg_Count loop
511 declare
512 Next_Argv : String (1 .. Len_Arg (Next_Arg));
514 begin
515 Fill_Arg (Next_Argv'Address, Next_Arg);
517 if Next_Argv'Length > 0 then
518 if Next_Argv (1) = '@' then
519 if Next_Argv'Length > 1 then
520 declare
521 Arguments : constant Argument_List :=
522 System.Response_File.Arguments_From
523 (Response_File_Name =>
524 Next_Argv (2 .. Next_Argv'Last),
525 Recursive => True,
526 Ignore_Non_Existing_Files => True);
527 begin
528 for J in Arguments'Range loop
529 Action (Arguments (J).all);
530 end loop;
531 end;
532 end if;
534 else
535 Action (Next_Argv);
536 end if;
537 end if;
538 end;
540 Next_Arg := Next_Arg + 1;
541 end loop;
542 end Generic_Scan_Bind_Args;
544 ---------------
545 -- Write_Arg --
546 ---------------
548 procedure Write_Arg (S : String) is
549 begin
550 Write_Str (" " & S);
551 end Write_Arg;
553 procedure Check_Version_And_Help is
554 new Check_Version_And_Help_G (Bindusg.Display);
556 procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg);
557 procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg);
559 -- Start of processing for Gnatbind
561 begin
562 -- Set default for Shared_Libgnat option
564 declare
565 Shared_Libgnat_Default : Character;
566 pragma Import
567 (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
569 SHARED : constant Character := 'H';
570 STATIC : constant Character := 'T';
572 begin
573 pragma Assert
574 (Shared_Libgnat_Default = SHARED
575 or else
576 Shared_Libgnat_Default = STATIC);
577 Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
578 end;
580 -- Carry out package initializations. These are initializations which
581 -- might logically be performed at elaboration time, and we decide to be
582 -- consistent. Like elaboration, the order in which these calls are made
583 -- is in some cases important.
585 Csets.Initialize;
586 Snames.Initialize;
588 -- Scan the switches and arguments. Note that Snames must already be
589 -- initialized (for processing of the -V switch).
591 -- First, scan to detect --version and/or --help
593 Check_Version_And_Help ("GNATBIND", "1992");
595 -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether
596 -- to Put_Bind_Args.
598 Scan_Bind_Args;
600 if Verbose_Mode then
601 declare
602 Command_Name : String (1 .. Len_Arg (0));
603 begin
604 Fill_Arg (Command_Name'Address, 0);
605 Write_Str (Command_Name);
606 end;
608 Put_Bind_Args;
609 Write_Eol;
610 end if;
612 if Use_Pragma_Linker_Constructor then
613 if Bind_Main_Program then
614 Fail ("switch -a must be used in conjunction with -n or -Lxxx");
616 elsif not Gnatbind_Supports_Auto_Init then
617 Fail ("automatic initialisation of elaboration not supported on this "
618 & "platform");
619 end if;
620 end if;
622 -- Test for trailing -o switch
624 if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
625 Fail ("output file name missing after -o");
626 end if;
628 -- Output usage if requested
630 if Usage_Requested then
631 Bindusg.Display;
632 end if;
634 -- Check that the binder file specified has extension .adb
636 if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
637 Check_Extensions : declare
638 Length : constant Natural := Output_File_Name'Length;
639 Last : constant Natural := Output_File_Name'Last;
641 begin
642 if Length <= 4
643 or else Output_File_Name (Last - 3 .. Last) /= ".adb"
644 then
645 Fail ("output file name should have .adb extension");
646 end if;
647 end Check_Extensions;
648 end if;
650 Osint.Add_Default_Search_Dirs;
652 -- Acquire target parameters
654 Targparm.Get_Target_Parameters;
656 -- Initialize Cumulative_Restrictions with the restrictions on the target
657 -- scanned from the system.ads file. Then as we read ALI files, we will
658 -- accumulate additional restrictions specified in other files.
660 Cumulative_Restrictions := Targparm.Restrictions_On_Target;
662 -- Acquire configurable run-time mode
664 if Configurable_Run_Time_On_Target then
665 Configurable_Run_Time_Mode := True;
666 end if;
668 -- Output copyright notice if in verbose mode
670 if Verbose_Mode then
671 Write_Eol;
672 Display_Version ("GNATBIND", "1995");
673 end if;
675 -- Output usage information if no arguments
677 if not More_Lib_Files then
678 if Arg_Count = 0 then
679 Bindusg.Display;
680 else
681 Write_Line ("try ""gnatbind --help"" for more information.");
682 end if;
684 Exit_Program (E_Fatal);
685 end if;
687 -- If a mapping file was specified, initialize the file mapping
689 if Mapping_File /= null then
690 Fmap.Initialize (Mapping_File.all);
691 end if;
693 -- The block here is to catch the Unrecoverable_Error exception in the
694 -- case where we exceed the maximum number of permissible errors or some
695 -- other unrecoverable error occurs.
697 begin
698 -- Initialize binder packages
700 Initialize_Binderr;
701 Initialize_ALI;
702 Initialize_ALI_Source;
704 if Verbose_Mode then
705 Write_Eol;
706 end if;
708 -- Input ALI files
710 while More_Lib_Files loop
711 Main_Lib_File := Next_Main_Lib_File;
713 if First_Main_Lib_File = No_File then
714 First_Main_Lib_File := Main_Lib_File;
715 end if;
717 if Verbose_Mode then
718 if Check_Only then
719 Write_Str ("Checking: ");
720 else
721 Write_Str ("Binding: ");
722 end if;
724 Write_Name (Main_Lib_File);
725 Write_Eol;
726 end if;
728 Text := Read_Library_Info (Main_Lib_File, True);
730 declare
731 Id : ALI_Id;
732 pragma Warnings (Off, Id);
734 begin
735 Id := Scan_ALI
736 (F => Main_Lib_File,
737 T => Text,
738 Ignore_ED => False,
739 Err => False,
740 Ignore_Errors => Debug_Flag_I,
741 Directly_Scanned => True);
742 end;
744 Free (Text);
745 end loop;
747 -- No_Run_Time mode
749 if No_Run_Time_Mode then
751 -- Set standard configuration parameters
753 Suppress_Standard_Library_On_Target := True;
754 Configurable_Run_Time_Mode := True;
755 end if;
757 -- For main ALI files, even if they are interfaces, we get their
758 -- dependencies. To be sure, we reset the Interface flag for all main
759 -- ALI files.
761 for Index in ALIs.First .. ALIs.Last loop
762 ALIs.Table (Index).SAL_Interface := False;
763 end loop;
765 -- Add System.Standard_Library to list to ensure that these files are
766 -- included in the bind, even if not directly referenced from Ada code
767 -- This is suppressed if the appropriate targparm switch is set. Be sure
768 -- in any case that System is in the closure, as it may contain linker
769 -- options. Note that it will be automatically added if s-stalib is
770 -- added.
772 if not Suppress_Standard_Library_On_Target then
773 Add_Artificial_ALI_File ("s-stalib.ali");
774 else
775 Add_Artificial_ALI_File ("system.ali");
776 end if;
778 -- Load ALIs for all dependent units
780 for Index in ALIs.First .. ALIs.Last loop
781 Read_Withed_ALIs (Index);
782 end loop;
784 -- Quit if some file needs compiling
786 if No_Object_Specified then
787 raise Unrecoverable_Error;
788 end if;
790 -- Quit with message if we had a GNATprove file
792 if GNATprove_Mode_Specified then
793 Error_Msg ("one or more files compiled in GNATprove mode");
794 raise Unrecoverable_Error;
795 end if;
797 -- Output list of ALI files in closure
799 if Output_ALI_List then
800 if ALI_List_Filename /= null then
801 Set_List_File (ALI_List_Filename.all);
802 end if;
804 for Index in ALIs.First .. ALIs.Last loop
805 declare
806 Full_Afile : constant File_Name_Type :=
807 Find_File (ALIs.Table (Index).Afile, Library);
808 begin
809 Write_Name (Full_Afile);
810 Write_Eol;
811 end;
812 end loop;
814 if ALI_List_Filename /= null then
815 Close_List_File;
816 end if;
817 end if;
819 -- Build source file table from the ALI files we have read in
821 Set_Source_Table;
823 -- If there is main program to bind, set Main_Lib_File to the first
824 -- library file, and the name from which to derive the binder generate
825 -- file to the first ALI file.
827 if Bind_Main_Program then
828 Main_Lib_File := First_Main_Lib_File;
829 Set_Current_File_Name_Index (To => 1);
830 end if;
832 -- Check that main library file is a suitable main program
834 if Bind_Main_Program
835 and then ALIs.Table (ALIs.First).Main_Program = None
836 and then not No_Main_Subprogram
837 then
838 Get_Name_String
839 (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
841 declare
842 Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
843 begin
844 To_Mixed (Unit_Name);
845 Get_Name_String (ALIs.Table (ALIs.First).Sfile);
846 Add_Str_To_Name_Buffer (":1: ");
847 Add_Str_To_Name_Buffer (Unit_Name);
848 Add_Str_To_Name_Buffer (" cannot be used as a main program");
849 Write_Line (Name_Buffer (1 .. Name_Len));
850 Errors_Detected := Errors_Detected + 1;
851 end;
852 end if;
854 -- Perform consistency and correctness checks. Disable these in CodePeer
855 -- mode where we want to be more flexible.
857 if not CodePeer_Mode then
858 Check_Duplicated_Subunits;
859 Check_Versions;
860 Check_Consistency;
861 Check_Configuration_Consistency;
862 end if;
864 -- List restrictions that could be applied to this partition
866 if List_Restrictions then
867 List_Applicable_Restrictions;
868 end if;
870 -- Complete bind if no errors
872 if Errors_Detected = 0 then
873 declare
874 Elab_Order : Unit_Id_Table;
875 use Unit_Id_Tables;
877 begin
878 Find_Elab_Order (Elab_Order, First_Main_Lib_File);
880 if Errors_Detected = 0 and then not Check_Only then
881 Gen_Output_File
882 (Output_File_Name.all,
883 Elab_Order => Elab_Order.Table (First .. Last (Elab_Order)));
884 end if;
885 end;
886 end if;
888 Total_Errors := Total_Errors + Errors_Detected;
889 Total_Warnings := Total_Warnings + Warnings_Detected;
891 exception
892 when Unrecoverable_Error =>
893 Total_Errors := Total_Errors + Errors_Detected;
894 Total_Warnings := Total_Warnings + Warnings_Detected;
895 end;
897 -- All done. Set the proper exit status.
899 Finalize_Binderr;
900 Namet.Finalize;
902 if Total_Errors > 0 then
903 Exit_Program (E_Errors);
905 elsif Total_Warnings > 0 then
906 Exit_Program (E_Warnings);
908 else
909 -- Do not call Exit_Program (E_Success), so that finalization occurs
910 -- normally.
912 null;
913 end if;
914 end Gnatbind;