aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.8.1/gcc/ada/gnatbind.adb
diff options
context:
space:
mode:
authorDan Albert <danalbert@google.com>2016-01-14 16:43:34 -0800
committerDan Albert <danalbert@google.com>2016-01-22 14:51:24 -0800
commit3186be22b6598fbd467b126347d1c7f48ccb7f71 (patch)
tree2b176d3ce027fa5340160978effeb88ec9054aaa /gcc-4.8.1/gcc/ada/gnatbind.adb
parenta45222a0e5951558bd896b0513bf638eb376e086 (diff)
downloadtoolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.tar.gz
toolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.tar.bz2
toolchain_gcc-3186be22b6598fbd467b126347d1c7f48ccb7f71.zip
Check in a pristine copy of GCC 4.8.1.
The copy of GCC that we use for Android is still not working for mingw. Rather than finding all the differences that have crept into our GCC, just check in a copy from ftp://ftp.gnu.org/gnu/gcc/gcc-4.9.3/gcc-4.8.1.tar.bz2. GCC 4.8.1 was chosen because it is what we have been using for mingw thus far, and the emulator doesn't yet work when upgrading to 4.9. Bug: http://b/26523949 Change-Id: Iedc0f05243d4332cc27ccd46b8a4b203c88dcaa3
Diffstat (limited to 'gcc-4.8.1/gcc/ada/gnatbind.adb')
-rw-r--r--gcc-4.8.1/gcc/ada/gnatbind.adb964
1 files changed, 964 insertions, 0 deletions
diff --git a/gcc-4.8.1/gcc/ada/gnatbind.adb b/gcc-4.8.1/gcc/ada/gnatbind.adb
new file mode 100644
index 000000000..c53d67ecf
--- /dev/null
+++ b/gcc-4.8.1/gcc/ada/gnatbind.adb
@@ -0,0 +1,964 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T B I N D --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- --
+-- GNAT is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with ALI; use ALI;
+with ALI.Util; use ALI.Util;
+with Bcheck; use Bcheck;
+with Binde; use Binde;
+with Binderr; use Binderr;
+with Bindgen; use Bindgen;
+with Bindusg;
+with Butil; use Butil;
+with Casing; use Casing;
+with Csets;
+with Debug; use Debug;
+with Fmap;
+with Fname; use Fname;
+with Namet; use Namet;
+with Opt; use Opt;
+with Osint; use Osint;
+with Osint.B; use Osint.B;
+with Output; use Output;
+with Rident; use Rident;
+with Snames;
+with Switch; use Switch;
+with Switch.B; use Switch.B;
+with Table;
+with Targparm; use Targparm;
+with Types; use Types;
+
+with System.Case_Util; use System.Case_Util;
+with System.OS_Lib; use System.OS_Lib;
+
+with Ada.Command_Line.Response_File; use Ada.Command_Line;
+
+procedure Gnatbind is
+
+ Total_Errors : Nat := 0;
+ -- Counts total errors in all files
+
+ Total_Warnings : Nat := 0;
+ -- Total warnings in all files
+
+ Main_Lib_File : File_Name_Type;
+ -- Current main library file
+
+ First_Main_Lib_File : File_Name_Type := No_File;
+ -- The first library file, that should be a main subprogram if neither -n
+ -- nor -z are used.
+
+ Std_Lib_File : File_Name_Type;
+ -- Standard library
+
+ Text : Text_Buffer_Ptr;
+ Next_Arg : Positive;
+
+ Output_File_Name_Seen : Boolean := False;
+ Output_File_Name : String_Ptr := new String'("");
+
+ L_Switch_Seen : Boolean := False;
+
+ Mapping_File : String_Ptr := null;
+
+ package Closure_Sources is new Table.Table
+ (Table_Component_Type => File_Name_Type,
+ Table_Index_Type => Natural,
+ Table_Low_Bound => 1,
+ Table_Initial => 10,
+ Table_Increment => 100,
+ Table_Name => "Gnatbind.Closure_Sources");
+ -- Table to record the sources in the closure, to avoid duplications. Used
+ -- only with switch -R.
+
+ function Gnatbind_Supports_Auto_Init return Boolean;
+ -- Indicates if automatic initialization of elaboration procedure
+ -- through the constructor mechanism is possible on the platform.
+
+ procedure List_Applicable_Restrictions;
+ -- List restrictions that apply to this partition if option taken
+
+ procedure Scan_Bind_Arg (Argv : String);
+ -- Scan and process binder specific arguments. Argv is a single argument.
+ -- All the one character arguments are still handled by Switch. This
+ -- routine handles -aO -aI and -I-. The lower bound of Argv must be 1.
+
+ function Is_Cross_Compiler return Boolean;
+ -- Returns True iff this is a cross-compiler
+
+ ---------------------------------
+ -- Gnatbind_Supports_Auto_Init --
+ ---------------------------------
+
+ function Gnatbind_Supports_Auto_Init return Boolean is
+ function gnat_binder_supports_auto_init return Integer;
+ pragma Import (C, gnat_binder_supports_auto_init,
+ "__gnat_binder_supports_auto_init");
+ begin
+ return gnat_binder_supports_auto_init /= 0;
+ end Gnatbind_Supports_Auto_Init;
+
+ -----------------------
+ -- Is_Cross_Compiler --
+ -----------------------
+
+ function Is_Cross_Compiler return Boolean is
+ Cross_Compiler : Integer;
+ pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");
+ begin
+ return Cross_Compiler = 1;
+ end Is_Cross_Compiler;
+
+ ----------------------------------
+ -- List_Applicable_Restrictions --
+ ----------------------------------
+
+ procedure List_Applicable_Restrictions is
+
+ -- Define those restrictions that should be output if the gnatbind
+ -- -r switch is used. Not all restrictions are output for the reasons
+ -- given below in the list, and this array is used to test whether
+ -- the corresponding pragma should be listed. True means that it
+ -- should not be listed.
+
+ No_Restriction_List : constant array (All_Restrictions) of Boolean :=
+ (No_Allocators_After_Elaboration => True,
+ -- This involves run-time conditions not checkable at compile time
+
+ No_Anonymous_Allocators => True,
+ -- Premature, since we have not implemented this yet
+
+ No_Exception_Propagation => True,
+ -- Modifies code resulting in different exception semantics
+
+ No_Exceptions => True,
+ -- Has unexpected Suppress (All_Checks) effect
+
+ No_Implicit_Conditionals => True,
+ -- This could modify and pessimize generated code
+
+ No_Implicit_Dynamic_Code => True,
+ -- This could modify and pessimize generated code
+
+ No_Implicit_Loops => True,
+ -- This could modify and pessimize generated code
+
+ No_Recursion => True,
+ -- Not checkable at compile time
+
+ No_Reentrancy => True,
+ -- Not checkable at compile time
+
+ Max_Entry_Queue_Length => True,
+ -- Not checkable at compile time
+
+ Max_Storage_At_Blocking => True,
+ -- Not checkable at compile time
+
+ others => False);
+
+ Additional_Restrictions_Listed : Boolean := False;
+ -- Set True if we have listed header for restrictions
+
+ function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;
+ -- Returns True if the given restriction can be listed as an additional
+ -- restriction that could be set.
+
+ ------------------------------
+ -- Restriction_Could_Be_Set --
+ ------------------------------
+
+ function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
+ CR : Restrictions_Info renames Cumulative_Restrictions;
+
+ begin
+ case R is
+
+ -- Boolean restriction
+
+ when All_Boolean_Restrictions =>
+
+ -- The condition for listing a boolean restriction as an
+ -- additional restriction that could be set is that it is
+ -- not violated by any unit, and not already set.
+
+ return CR.Violated (R) = False and then CR.Set (R) = False;
+
+ -- Parameter restriction
+
+ when All_Parameter_Restrictions =>
+
+ -- If the restriction is violated and the level of violation is
+ -- unknown, the restriction can definitely not be listed.
+
+ if CR.Violated (R) and then CR.Unknown (R) then
+ return False;
+
+ -- We can list the restriction if it is not set
+
+ elsif not CR.Set (R) then
+ return True;
+
+ -- We can list the restriction if is set to a greater value
+ -- than the maximum value known for the violation.
+
+ else
+ return CR.Value (R) > CR.Count (R);
+ end if;
+
+ -- No other values for R possible
+
+ when others =>
+ raise Program_Error;
+
+ end case;
+ end Restriction_Could_Be_Set;
+
+ -- Start of processing for List_Applicable_Restrictions
+
+ begin
+ -- Loop through restrictions
+
+ for R in All_Restrictions loop
+ if not No_Restriction_List (R)
+ and then Restriction_Could_Be_Set (R)
+ then
+ if not Additional_Restrictions_Listed then
+ Write_Eol;
+ Write_Line
+ ("The following additional restrictions may be" &
+ " applied to this partition:");
+ Additional_Restrictions_Listed := True;
+ end if;
+
+ Write_Str ("pragma Restrictions (");
+
+ declare
+ S : constant String := Restriction_Id'Image (R);
+ begin
+ Name_Len := S'Length;
+ Name_Buffer (1 .. Name_Len) := S;
+ end;
+
+ Set_Casing (Mixed_Case);
+ Write_Str (Name_Buffer (1 .. Name_Len));
+
+ if R in All_Parameter_Restrictions then
+ Write_Str (" => ");
+ Write_Int (Int (Cumulative_Restrictions.Count (R)));
+ end if;
+
+ Write_Str (");");
+ Write_Eol;
+ end if;
+ end loop;
+ end List_Applicable_Restrictions;
+
+ -------------------
+ -- Scan_Bind_Arg --
+ -------------------
+
+ procedure Scan_Bind_Arg (Argv : String) is
+ pragma Assert (Argv'First = 1);
+
+ begin
+ -- Now scan arguments that are specific to the binder and are not
+ -- handled by the common circuitry in Switch.
+
+ if Opt.Output_File_Name_Present
+ and then not Output_File_Name_Seen
+ then
+ Output_File_Name_Seen := True;
+
+ if Argv'Length = 0
+ or else (Argv'Length >= 1 and then Argv (1) = '-')
+ then
+ Fail ("output File_Name missing after -o");
+
+ else
+ Output_File_Name := new String'(Argv);
+ end if;
+
+ elsif Argv'Length >= 2 and then Argv (1) = '-' then
+
+ -- -I-
+
+ if Argv (2 .. Argv'Last) = "I-" then
+ Opt.Look_In_Primary_Dir := False;
+
+ -- -Idir
+
+ elsif Argv (2) = 'I' then
+ Add_Src_Search_Dir (Argv (3 .. Argv'Last));
+ Add_Lib_Search_Dir (Argv (3 .. Argv'Last));
+
+ -- -Ldir
+
+ elsif Argv (2) = 'L' then
+ if Argv'Length >= 3 then
+
+ -- Remember that the -L switch was specified, so that if this
+ -- is on OpenVMS, the export names are put in uppercase.
+ -- This is not known before the target parameters are read.
+
+ L_Switch_Seen := True;
+
+ Opt.Bind_For_Library := True;
+ Opt.Ada_Init_Name :=
+ new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);
+ Opt.Ada_Final_Name :=
+ new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);
+ Opt.Ada_Main_Name :=
+ new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);
+
+ -- This option (-Lxxx) implies -n
+
+ Opt.Bind_Main_Program := False;
+
+ else
+ Fail
+ ("Prefix of initialization and finalization " &
+ "procedure names missing in -L");
+ end if;
+
+ -- -Sin -Slo -Shi -Sxx -Sev
+
+ elsif Argv'Length = 4
+ and then Argv (2) = 'S'
+ then
+ declare
+ C1 : Character := Argv (3);
+ C2 : Character := Argv (4);
+
+ begin
+ -- Fold to upper case
+
+ if C1 in 'a' .. 'z' then
+ C1 := Character'Val (Character'Pos (C1) - 32);
+ end if;
+
+ if C2 in 'a' .. 'z' then
+ C2 := Character'Val (Character'Pos (C2) - 32);
+ end if;
+
+ -- Test valid option and set mode accordingly
+
+ if C1 = 'E' and then C2 = 'V' then
+ null;
+
+ elsif C1 = 'I' and then C2 = 'N' then
+ null;
+
+ elsif C1 = 'L' and then C2 = 'O' then
+ null;
+
+ elsif C1 = 'H' and then C2 = 'I' then
+ null;
+
+ elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')
+ and then
+ (C2 in '0' .. '9' or else C2 in 'A' .. 'F')
+ then
+ null;
+
+ -- Invalid -S switch, let Switch give error, set default of IN
+
+ else
+ Scan_Binder_Switches (Argv);
+ C1 := 'I';
+ C2 := 'N';
+ end if;
+
+ Initialize_Scalars_Mode1 := C1;
+ Initialize_Scalars_Mode2 := C2;
+ end;
+
+ -- -aIdir
+
+ elsif Argv'Length >= 3
+ and then Argv (2 .. 3) = "aI"
+ then
+ Add_Src_Search_Dir (Argv (4 .. Argv'Last));
+
+ -- -aOdir
+
+ elsif Argv'Length >= 3
+ and then Argv (2 .. 3) = "aO"
+ then
+ Add_Lib_Search_Dir (Argv (4 .. Argv'Last));
+
+ -- -nostdlib
+
+ elsif Argv (2 .. Argv'Last) = "nostdlib" then
+ Opt.No_Stdlib := True;
+
+ -- -nostdinc
+
+ elsif Argv (2 .. Argv'Last) = "nostdinc" then
+ Opt.No_Stdinc := True;
+
+ -- -static
+
+ elsif Argv (2 .. Argv'Last) = "static" then
+ Opt.Shared_Libgnat := False;
+
+ -- -shared
+
+ elsif Argv (2 .. Argv'Last) = "shared" then
+ Opt.Shared_Libgnat := True;
+
+ -- -F=mapping_file
+
+ elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then
+ if Mapping_File /= null then
+ Fail ("cannot specify several mapping files");
+ end if;
+
+ Mapping_File := new String'(Argv (4 .. Argv'Last));
+
+ -- -Mname
+
+ elsif Argv'Length >= 3 and then Argv (2) = 'M' then
+ if not Is_Cross_Compiler then
+ Write_Line
+ ("gnatbind: -M not expected to be used on native platforms");
+ end if;
+
+ Opt.Bind_Alternate_Main_Name := True;
+ Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));
+
+ -- All other options are single character and are handled by
+ -- Scan_Binder_Switches.
+
+ else
+ Scan_Binder_Switches (Argv);
+ end if;
+
+ -- Not a switch, so must be a file name (if non-empty)
+
+ elsif Argv'Length /= 0 then
+ if Argv'Length > 4
+ and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"
+ then
+ Add_File (Argv);
+ else
+ Add_File (Argv & ".ali");
+ end if;
+ end if;
+ end Scan_Bind_Arg;
+
+ procedure Check_Version_And_Help is
+ new Check_Version_And_Help_G (Bindusg.Display);
+
+-- Start of processing for Gnatbind
+
+begin
+ -- Set default for Shared_Libgnat option
+
+ declare
+ Shared_Libgnat_Default : Character;
+ pragma Import
+ (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");
+
+ SHARED : constant Character := 'H';
+ STATIC : constant Character := 'T';
+
+ begin
+ pragma Assert
+ (Shared_Libgnat_Default = SHARED
+ or else
+ Shared_Libgnat_Default = STATIC);
+ Shared_Libgnat := (Shared_Libgnat_Default = SHARED);
+ end;
+
+ -- Scan the switches and arguments
+
+ -- First, scan to detect --version and/or --help
+
+ Check_Version_And_Help ("GNATBIND", "1995");
+
+ -- Use low level argument routines to avoid dragging in the secondary stack
+
+ Next_Arg := 1;
+ Scan_Args : while Next_Arg < Arg_Count loop
+ declare
+ Next_Argv : String (1 .. Len_Arg (Next_Arg));
+ begin
+ Fill_Arg (Next_Argv'Address, Next_Arg);
+
+ if Next_Argv'Length > 0 then
+ if Next_Argv (1) = '@' then
+ if Next_Argv'Length > 1 then
+ declare
+ Arguments : constant Argument_List :=
+ Response_File.Arguments_From
+ (Response_File_Name =>
+ Next_Argv (2 .. Next_Argv'Last),
+ Recursive => True,
+ Ignore_Non_Existing_Files => True);
+ begin
+ for J in Arguments'Range loop
+ Scan_Bind_Arg (Arguments (J).all);
+ end loop;
+ end;
+ end if;
+
+ else
+ Scan_Bind_Arg (Next_Argv);
+ end if;
+ end if;
+ end;
+
+ Next_Arg := Next_Arg + 1;
+ end loop Scan_Args;
+
+ if Use_Pragma_Linker_Constructor then
+ if Bind_Main_Program then
+ Fail ("switch -a must be used in conjunction with -n or -Lxxx");
+
+ elsif not Gnatbind_Supports_Auto_Init then
+ Fail ("automatic initialisation of elaboration " &
+ "not supported on this platform");
+ end if;
+ end if;
+
+ -- Test for trailing -o switch
+
+ if Opt.Output_File_Name_Present and then not Output_File_Name_Seen then
+ Fail ("output file name missing after -o");
+ end if;
+
+ -- Output usage if requested
+
+ if Usage_Requested then
+ Bindusg.Display;
+ end if;
+
+ -- Check that the binder file specified has extension .adb
+
+ if Opt.Output_File_Name_Present and then Output_File_Name_Seen then
+ Check_Extensions : declare
+ Length : constant Natural := Output_File_Name'Length;
+ Last : constant Natural := Output_File_Name'Last;
+ begin
+ if Length <= 4
+ or else Output_File_Name (Last - 3 .. Last) /= ".adb"
+ then
+ Fail ("output file name should have .adb extension");
+ end if;
+ end Check_Extensions;
+ end if;
+
+ Osint.Add_Default_Search_Dirs;
+
+ -- Carry out package initializations. These are initializations which
+ -- might logically be performed at elaboration time, and we decide to be
+ -- consistent. Like elaboration, the order in which these calls are made
+ -- is in some cases important.
+
+ Csets.Initialize;
+ Snames.Initialize;
+
+ -- Acquire target parameters
+
+ Targparm.Get_Target_Parameters;
+
+ -- Initialize Cumulative_Restrictions with the restrictions on the target
+ -- scanned from the system.ads file. Then as we read ALI files, we will
+ -- accumulate additional restrictions specified in other files.
+
+ Cumulative_Restrictions := Targparm.Restrictions_On_Target;
+
+ -- On OpenVMS, when -L is used, all external names used in pragmas Export
+ -- are in upper case. The reason is that on OpenVMS, the macro-assembler
+ -- MACASM-32, used to build Stand-Alone Libraries, only understands
+ -- uppercase.
+
+ if L_Switch_Seen and then OpenVMS_On_Target then
+ To_Upper (Opt.Ada_Init_Name.all);
+ To_Upper (Opt.Ada_Final_Name.all);
+ To_Upper (Opt.Ada_Main_Name.all);
+ end if;
+
+ -- Acquire configurable run-time mode
+
+ if Configurable_Run_Time_On_Target then
+ Configurable_Run_Time_Mode := True;
+ end if;
+
+ -- Output copyright notice if in verbose mode
+
+ if Verbose_Mode then
+ Write_Eol;
+ Display_Version ("GNATBIND", "1995");
+ end if;
+
+ -- Output usage information if no files
+
+ if not More_Lib_Files then
+ Bindusg.Display;
+ Exit_Program (E_Fatal);
+ end if;
+
+ -- If a mapping file was specified, initialize the file mapping
+
+ if Mapping_File /= null then
+ Fmap.Initialize (Mapping_File.all);
+ end if;
+
+ -- The block here is to catch the Unrecoverable_Error exception in the
+ -- case where we exceed the maximum number of permissible errors or some
+ -- other unrecoverable error occurs.
+
+ begin
+ -- Initialize binder packages
+
+ Initialize_Binderr;
+ Initialize_ALI;
+ Initialize_ALI_Source;
+
+ if Verbose_Mode then
+ Write_Eol;
+ end if;
+
+ -- Input ALI files
+
+ while More_Lib_Files loop
+ Main_Lib_File := Next_Main_Lib_File;
+
+ if First_Main_Lib_File = No_File then
+ First_Main_Lib_File := Main_Lib_File;
+ end if;
+
+ if Verbose_Mode then
+ if Check_Only then
+ Write_Str ("Checking: ");
+ else
+ Write_Str ("Binding: ");
+ end if;
+
+ Write_Name (Main_Lib_File);
+ Write_Eol;
+ end if;
+
+ Text := Read_Library_Info (Main_Lib_File, True);
+
+ declare
+ Id : ALI_Id;
+ pragma Warnings (Off, Id);
+
+ begin
+ Id := Scan_ALI
+ (F => Main_Lib_File,
+ T => Text,
+ Ignore_ED => False,
+ Err => False,
+ Ignore_Errors => Debug_Flag_I,
+ Directly_Scanned => True);
+ end;
+
+ Free (Text);
+ end loop;
+
+ -- No_Run_Time mode
+
+ if No_Run_Time_Mode then
+
+ -- Set standard configuration parameters
+
+ Suppress_Standard_Library_On_Target := True;
+ Configurable_Run_Time_Mode := True;
+ end if;
+
+ -- For main ALI files, even if they are interfaces, we get their
+ -- dependencies. To be sure, we reset the Interface flag for all main
+ -- ALI files.
+
+ for Index in ALIs.First .. ALIs.Last loop
+ ALIs.Table (Index).SAL_Interface := False;
+ end loop;
+
+ -- Add System.Standard_Library to list to ensure that these files are
+ -- included in the bind, even if not directly referenced from Ada code
+ -- This is suppressed if the appropriate targparm switch is set.
+
+ if not Suppress_Standard_Library_On_Target then
+ Name_Buffer (1 .. 12) := "s-stalib.ali";
+ Name_Len := 12;
+ Std_Lib_File := Name_Find;
+ Text := Read_Library_Info (Std_Lib_File, True);
+
+ declare
+ Id : ALI_Id;
+ pragma Warnings (Off, Id);
+
+ begin
+ Id :=
+ Scan_ALI
+ (F => Std_Lib_File,
+ T => Text,
+ Ignore_ED => False,
+ Err => False,
+ Ignore_Errors => Debug_Flag_I);
+ end;
+
+ Free (Text);
+ end if;
+
+ -- Load ALIs for all dependent units
+
+ for Index in ALIs.First .. ALIs.Last loop
+ Read_Withed_ALIs (Index);
+ end loop;
+
+ -- Quit if some file needs compiling
+
+ if No_Object_Specified then
+ raise Unrecoverable_Error;
+ end if;
+
+ -- Output list of ALI files in closure
+
+ if Output_ALI_List then
+ if ALI_List_Filename /= null then
+ Set_List_File (ALI_List_Filename.all);
+ end if;
+
+ for Index in ALIs.First .. ALIs.Last loop
+ declare
+ Full_Afile : constant File_Name_Type :=
+ Find_File (ALIs.Table (Index).Afile, Library);
+ begin
+ Write_Name (Full_Afile);
+ Write_Eol;
+ end;
+ end loop;
+
+ if ALI_List_Filename /= null then
+ Close_List_File;
+ end if;
+ end if;
+
+ -- Build source file table from the ALI files we have read in
+
+ Set_Source_Table;
+
+ -- If there is main program to bind, set Main_Lib_File to the first
+ -- library file, and the name from which to derive the binder generate
+ -- file to the first ALI file.
+
+ if Bind_Main_Program then
+ Main_Lib_File := First_Main_Lib_File;
+ Set_Current_File_Name_Index (To => 1);
+ end if;
+
+ -- Check that main library file is a suitable main program
+
+ if Bind_Main_Program
+ and then ALIs.Table (ALIs.First).Main_Program = None
+ and then not No_Main_Subprogram
+ then
+ Get_Name_String
+ (Units.Table (ALIs.Table (ALIs.First).First_Unit).Uname);
+
+ declare
+ Unit_Name : String := Name_Buffer (1 .. Name_Len - 2);
+ begin
+ To_Mixed (Unit_Name);
+ Get_Name_String (ALIs.Table (ALIs.First).Sfile);
+ Add_Str_To_Name_Buffer (":1: ");
+ Add_Str_To_Name_Buffer (Unit_Name);
+ Add_Str_To_Name_Buffer (" cannot be used as a main program");
+ Write_Line (Name_Buffer (1 .. Name_Len));
+ Errors_Detected := Errors_Detected + 1;
+ end;
+ end if;
+
+ -- Perform consistency and correctness checks
+
+ Check_Duplicated_Subunits;
+ Check_Versions;
+ Check_Consistency;
+ Check_Configuration_Consistency;
+
+ -- List restrictions that could be applied to this partition
+
+ if List_Restrictions then
+ List_Applicable_Restrictions;
+ end if;
+
+ -- Complete bind if no errors
+
+ if Errors_Detected = 0 then
+ Find_Elab_Order;
+
+ if Errors_Detected = 0 then
+ -- Display elaboration order if -l was specified
+
+ if Elab_Order_Output then
+ if not Zero_Formatting then
+ Write_Eol;
+ Write_Str ("ELABORATION ORDER");
+ Write_Eol;
+ end if;
+
+ for J in Elab_Order.First .. Elab_Order.Last loop
+ if not Units.Table (Elab_Order.Table (J)).SAL_Interface then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Unit_Name
+ (Units.Table (Elab_Order.Table (J)).Uname);
+ Write_Eol;
+ end if;
+ end loop;
+
+ if not Zero_Formatting then
+ Write_Eol;
+ end if;
+ end if;
+
+ if not Check_Only then
+ Gen_Output_File (Output_File_Name.all);
+ end if;
+
+ -- Display list of sources in the closure (except predefined
+ -- sources) if -R was used.
+
+ if List_Closure then
+ List_Closure_Display : declare
+ Source : File_Name_Type;
+
+ function Put_In_Sources (S : File_Name_Type) return Boolean;
+ -- Check if S is already in table Sources and put in Sources
+ -- if it is not. Return False if the source is already in
+ -- Sources, and True if it is added.
+
+ --------------------
+ -- Put_In_Sources --
+ --------------------
+
+ function Put_In_Sources
+ (S : File_Name_Type) return Boolean is
+ begin
+ for J in 1 .. Closure_Sources.Last loop
+ if Closure_Sources.Table (J) = S then
+ return False;
+ end if;
+ end loop;
+
+ Closure_Sources.Append (S);
+ return True;
+ end Put_In_Sources;
+
+ -- Start of processing for List_Closure_Display
+
+ begin
+ Closure_Sources.Init;
+
+ if not Zero_Formatting then
+ Write_Eol;
+ Write_Str ("REFERENCED SOURCES");
+ Write_Eol;
+ end if;
+
+ for J in reverse Elab_Order.First .. Elab_Order.Last loop
+ Source := Units.Table (Elab_Order.Table (J)).Sfile;
+
+ -- Do not include the sources of the runtime and do not
+ -- include the same source several times.
+
+ if Put_In_Sources (Source)
+ and then not Is_Internal_File_Name (Source)
+ then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Str (Get_Name_String (Source));
+ Write_Eol;
+ end if;
+ end loop;
+
+ -- Subunits do not appear in the elaboration table because
+ -- they are subsumed by their parent units, but we need to
+ -- list them for other tools. For now they are listed after
+ -- other files, rather than right after their parent, since
+ -- there is no easy link between the elaboration table and
+ -- the ALIs table ??? As subunits may appear repeatedly in
+ -- the list, if the parent unit appears in the context of
+ -- several units in the closure, duplicates are suppressed.
+
+ for J in Sdep.First .. Sdep.Last loop
+ Source := Sdep.Table (J).Sfile;
+
+ if Sdep.Table (J).Subunit_Name /= No_Name
+ and then Put_In_Sources (Source)
+ and then not Is_Internal_File_Name (Source)
+ then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Str (Get_Name_String (Source));
+ Write_Eol;
+ end if;
+ end loop;
+
+ if not Zero_Formatting then
+ Write_Eol;
+ end if;
+ end List_Closure_Display;
+ end if;
+ end if;
+ end if;
+
+ Total_Errors := Total_Errors + Errors_Detected;
+ Total_Warnings := Total_Warnings + Warnings_Detected;
+
+ exception
+ when Unrecoverable_Error =>
+ Total_Errors := Total_Errors + Errors_Detected;
+ Total_Warnings := Total_Warnings + Warnings_Detected;
+ end;
+
+ -- All done. Set proper exit status
+
+ Finalize_Binderr;
+ Namet.Finalize;
+
+ if Total_Errors > 0 then
+ Exit_Program (E_Errors);
+
+ elsif Total_Warnings > 0 then
+ Exit_Program (E_Warnings);
+
+ else
+ -- Do not call Exit_Program (E_Success), so that finalization occurs
+ -- normally.
+
+ null;
+ end if;
+end Gnatbind;