| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- G N A T B I N D -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2022, 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 Binderr; use Binderr; |
| with Bindgen; use Bindgen; |
| with Bindo; use Bindo; |
| with Bindusg; |
| with Casing; use Casing; |
| with Csets; |
| with Debug; use Debug; |
| with Fmap; |
| with Namet; use Namet; |
| with Opt; use Opt; |
| |
| with Osint; use Osint; |
| -- Note that we use low-level routines in Osint to read command-line |
| -- arguments. We cannot depend on Ada.Command_Line, because it contains modern |
| -- Ada features that would break bootstrapping with old base compilers. |
| |
| 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 Targparm; use Targparm; |
| with Types; use Types; |
| with Uintp; |
| |
| with System.Case_Util; use System.Case_Util; |
| with System.Response_File; |
| with System.OS_Lib; use System.OS_Lib; |
| |
| 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. |
| |
| Text : Text_Buffer_Ptr; |
| |
| Output_File_Name_Seen : Boolean := False; |
| Output_File_Name : String_Ptr := new String'(""); |
| |
| Mapping_File : String_Ptr := null; |
| |
| procedure Add_Artificial_ALI_File (Name : String); |
| -- Artificially add ALI file Name in the closure |
| |
| function Gnatbind_Supports_Auto_Init return Boolean; |
| -- Indicates if automatic initialization of elaboration procedure through |
| -- the constructor mechanism is possible on the platform. |
| |
| function Is_Cross_Compiler return Boolean; |
| -- Returns True iff this is a cross-compiler |
| |
| 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. |
| |
| generic |
| with procedure Action (Argv : String); |
| procedure Generic_Scan_Bind_Args; |
| -- Iterate through the args calling Action on each one, taking care of |
| -- response files. |
| |
| procedure Write_Arg (S : String); |
| -- Passed to Generic_Scan_Bind_Args to print args |
| |
| ----------------------------- |
| -- Add_Artificial_ALI_File -- |
| ----------------------------- |
| |
| procedure Add_Artificial_ALI_File (Name : String) is |
| Id : ALI_Id; |
| pragma Warnings (Off, Id); |
| |
| Std_Lib_File : File_Name_Type; |
| -- Standard library |
| |
| begin |
| Name_Len := Name'Length; |
| Name_Buffer (1 .. Name_Len) := Name; |
| Std_Lib_File := Name_Find; |
| Text := Read_Library_Info (Std_Lib_File, True); |
| |
| Id := |
| Scan_ALI |
| (F => Std_Lib_File, |
| T => Text, |
| Err => False, |
| Ignore_Errors => Debug_Flag_I); |
| |
| Free (Text); |
| end Add_Artificial_ALI_File; |
| |
| --------------------------------- |
| -- 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 be listed. |
| |
| Restrictions_To_List : constant array (All_Restrictions) of Boolean := |
| (No_Standard_Allocators_After_Elaboration => False, |
| -- This involves run-time conditions not checkable at compile time |
| |
| No_Anonymous_Allocators => False, |
| -- Premature, since we have not implemented this yet |
| |
| No_Exception_Propagation => False, |
| -- Modifies code resulting in different exception semantics |
| |
| No_Exceptions => False, |
| -- Has unexpected Suppress (All_Checks) effect |
| |
| No_Implicit_Conditionals => False, |
| -- This could modify and pessimize generated code |
| |
| No_Implicit_Dynamic_Code => False, |
| -- This could modify and pessimize generated code |
| |
| No_Implicit_Loops => False, |
| -- This could modify and pessimize generated code |
| |
| No_Recursion => False, |
| -- Not checkable at compile time |
| |
| No_Reentrancy => False, |
| -- Not checkable at compile time |
| |
| Max_Entry_Queue_Length => False, |
| -- Not checkable at compile time |
| |
| Max_Storage_At_Blocking => False, |
| -- Not checkable at compile time |
| |
| No_Implementation_Restrictions => False, |
| -- Listing this one would cause a chicken&egg problem; the program |
| -- doesn't use implementation-defined restrictions, but after |
| -- applying the listed restrictions, it probably WILL use them, |
| -- so No_Implementation_Restrictions will cause an error. |
| |
| -- The following three should not be partition-wide, so the |
| -- following tests are junk to be removed eventually ??? |
| |
| No_Specification_Of_Aspect => False, |
| -- Requires a parameter value, not a count |
| |
| No_Task_Hierarchy_Implicit => False, |
| -- A compiler implementation artifact, not a documented restriction |
| |
| No_Use_Of_Attribute => False, |
| -- Requires a parameter value, not a count |
| |
| No_Use_Of_Pragma => False, |
| -- Requires a parameter value, not a count |
| |
| SPARK_05 => False, |
| -- Obsolete restriction |
| |
| others => True); |
| |
| 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; |
| Result : Boolean; |
| begin |
| case R is |
| |
| -- Boolean restriction |
| |
| when All_Boolean_Restrictions => |
| |
| -- Print it if not violated by any unit, and not already set... |
| |
| Result := not CR.Violated (R) and then not CR.Set (R); |
| |
| -- ...except that for No_Tasks_Unassigned_To_CPU, we don't want |
| -- to print it if it would violate the restriction post |
| -- compilation. |
| |
| if R = No_Tasks_Unassigned_To_CPU |
| and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU |
| then |
| Result := False; |
| end if; |
| |
| -- 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 |
| Result := False; |
| |
| -- We can list the restriction if it is not set |
| |
| elsif not CR.Set (R) then |
| Result := True; |
| |
| -- We can list the restriction if is set to a greater value |
| -- than the maximum value known for the violation. |
| |
| else |
| Result := CR.Value (R) > CR.Count (R); |
| end if; |
| |
| -- No other values for R possible |
| |
| when others => |
| raise Program_Error; |
| end case; |
| |
| return Result; |
| end Restriction_Could_Be_Set; |
| |
| -- Start of processing for List_Applicable_Restrictions |
| |
| begin |
| -- Loop through restrictions |
| |
| for R in All_Restrictions loop |
| if Restrictions_To_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 (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 |
| |
| 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)); |
| |
| -- -minimal |
| |
| elsif Argv (2 .. Argv'Last) = "minimal" then |
| if not Is_Cross_Compiler then |
| Write_Line |
| ("gnatbind: -minimal not expected to be used on native " & |
| "platforms"); |
| end if; |
| |
| Opt.Minimal_Binder := True; |
| |
| -- -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)); |
| |
| -- -xdr |
| |
| elsif Argv (2 .. Argv'Last) = "xdr" then |
| Opt.XDR_Stream := True; |
| |
| -- 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; |
| |
| ---------------------------- |
| -- Generic_Scan_Bind_Args -- |
| ---------------------------- |
| |
| procedure Generic_Scan_Bind_Args is |
| Next_Arg : Positive := 1; |
| |
| begin |
| 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 := |
| System.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 |
| Action (Arguments (J).all); |
| end loop; |
| end; |
| end if; |
| |
| else |
| Action (Next_Argv); |
| end if; |
| end if; |
| end; |
| |
| Next_Arg := Next_Arg + 1; |
| end loop; |
| end Generic_Scan_Bind_Args; |
| |
| --------------- |
| -- Write_Arg -- |
| --------------- |
| |
| procedure Write_Arg (S : String) is |
| begin |
| Write_Str (" " & S); |
| end Write_Arg; |
| |
| procedure Check_Version_And_Help is |
| new Check_Version_And_Help_G (Bindusg.Display); |
| |
| procedure Put_Bind_Args is new Generic_Scan_Bind_Args (Write_Arg); |
| procedure Scan_Bind_Args is new Generic_Scan_Bind_Args (Scan_Bind_Arg); |
| |
| -- 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; |
| |
| -- 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; |
| Uintp.Initialize; |
| Snames.Initialize; |
| |
| -- Scan the switches and arguments. Note that Snames must already be |
| -- initialized (for processing of the -V switch). |
| |
| -- First, scan to detect --version and/or --help |
| |
| Check_Version_And_Help ("GNATBIND", "1992"); |
| |
| -- We need to Scan_Bind_Args first, to set Verbose_Mode, so we know whether |
| -- to Put_Bind_Args. |
| |
| Scan_Bind_Args; |
| |
| if Verbose_Mode then |
| declare |
| Command_Name : String (1 .. Len_Arg (0)); |
| begin |
| Fill_Arg (Command_Name'Address, 0); |
| Write_Str (Command_Name); |
| end; |
| |
| Put_Bind_Args; |
| Write_Eol; |
| end if; |
| |
| 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; |
| |
| -- 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; |
| |
| -- 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 arguments |
| |
| if not More_Lib_Files then |
| if Arg_Count = 0 then |
| Bindusg.Display; |
| else |
| Write_Line ("try ""gnatbind --help"" for more information."); |
| end if; |
| |
| 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, |
| 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. Be sure |
| -- in any case that System is in the closure, as it may contain linker |
| -- options. Note that it will be automatically added if s-stalib is |
| -- added. |
| |
| if not Suppress_Standard_Library_On_Target then |
| Add_Artificial_ALI_File ("s-stalib.ali"); |
| else |
| Add_Artificial_ALI_File ("system.ali"); |
| 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 |
| Error_Msg ("no object specified"); |
| raise Unrecoverable_Error; |
| end if; |
| |
| -- Quit with message if we had a GNATprove file |
| |
| if GNATprove_Mode_Specified then |
| Error_Msg ("one or more files compiled in GNATprove mode"); |
| 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. Disable these in CodePeer |
| -- mode where we want to be more flexible. |
| |
| if not CodePeer_Mode then |
| -- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU": |
| -- If the restriction No_Tasks_Unassigned_To_CPU applies, then |
| -- check that the main subprogram has a CPU assigned. |
| |
| if Cumulative_Restrictions.Set (No_Tasks_Unassigned_To_CPU) |
| and then ALIs.Table (ALIs.First).Main_CPU = No_Main_CPU |
| then |
| Error_Msg ("No_Tasks_Unassigned_To_CPU restriction requires CPU" & |
| " aspect to be specified for main procedure"); |
| end if; |
| |
| Check_Duplicated_Subunits; |
| Check_Versions; |
| Check_Consistency; |
| Check_Configuration_Consistency; |
| end if; |
| |
| -- 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 |
| declare |
| use Unit_Id_Tables; |
| Elab_Order : Unit_Id_Table; |
| |
| begin |
| Find_Elaboration_Order (Elab_Order, First_Main_Lib_File); |
| |
| if Errors_Detected = 0 and then not Check_Only then |
| Gen_Output_File |
| (Output_File_Name.all, |
| Elab_Order => Elab_Order.Table (First .. Last (Elab_Order))); |
| end if; |
| end; |
| 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 the 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; |
