-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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 2, or (at your option) any later ver- --
+-- 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 COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- 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 Csets;
with Debug; use Debug;
with Fmap;
-with Gnatvsn; use Gnatvsn;
+with Fname; use Fname;
with Namet; use Namet;
with Opt; use Opt;
with Osint; use Osint;
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
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
Mapping_File : String_Ptr := null;
+ 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-.
+ -- 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 --
-- Define those restrictions that should be output if the gnatbind
-- -r switch is used. Not all restrictions are output for the reasons
- -- given above in the list, and this array is used to test whether
+ -- 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_Exceptions => True,
+ (No_Exception_Propagation => True,
+ -- Modifies code resulting in different exception semantics
+
+ No_Exceptions => True,
-- Has unexpected Suppress (All_Checks) effect
No_Implicit_Conditionals => True,
Max_Storage_At_Blocking => True,
-- Not checkable at compile time
- others => False);
+ others => False);
Additional_Restrictions_Listed : Boolean := False;
-- Set True if we have listed header for restrictions
- begin
- -- Loop through 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.
- for R in All_Restrictions loop
- if not No_Restriction_List (R) then
+ ------------------------------
+ -- Restriction_Could_Be_Set --
+ ------------------------------
- -- We list a restriction if it is not violated, or if
- -- it is violated but the violation count is exactly known.
+ function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is
+ CR : Restrictions_Info renames Cumulative_Restrictions;
- if Cumulative_Restrictions.Violated (R) = False
- or else (R in All_Parameter_Restrictions
- and then
- Cumulative_Restrictions.Unknown (R) = False)
- 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;
+ 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;
- Write_Str ("pragma Restrictions (");
+ -- We can list the restriction if it is not set
- declare
- S : constant String := Restriction_Id'Image (R);
- begin
- Name_Len := S'Length;
- Name_Buffer (1 .. Name_Len) := S;
- end;
+ elsif not CR.Set (R) then
+ return True;
- Set_Casing (Mixed_Case);
- Write_Str (Name_Buffer (1 .. Name_Len));
+ -- We can list the restriction if is set to a greater value
+ -- than the maximum value known for the violation.
- if R in All_Parameter_Restrictions then
- Write_Str (" => ");
- Write_Int (Int (Cumulative_Restrictions.Count (R)));
+ else
+ return CR.Value (R) > CR.Count (R);
end if;
- Write_Str (");");
+ -- 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;
-------------------
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.
"procedure names missing in -L");
end if;
- -- -Sin -Slo -Shi -Sxx
+ -- -Sin -Slo -Shi -Sxx -Sev
elsif Argv'Length = 4
and then Argv (2) = 'S'
then
null;
- -- Invalid -S switch, let Switch give error, set defalut of IN
+ -- Invalid -S switch, let Switch give error, set default of IN
else
Scan_Binder_Switches (Argv);
-- -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.
+ -- All other options are single character and are handled by
+ -- Scan_Binder_Switches.
else
Scan_Binder_Switches (Argv);
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
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);
- Scan_Bind_Arg (Next_Argv);
+
+ 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
-- Output usage if requested
if Usage_Requested then
- Bindusg;
+ Bindusg.Display;
end if;
-- Check that the Ada binder file specified has extension .adb and that
Osint.Add_Default_Search_Dirs;
-- Carry out package initializations. These are initializations which
- -- might logically be performed at elaboration time, but Namet at
- -- least can't be done that way (because it is used in the Compiler),
- -- and we decide to be consistent. Like elaboration, the order in
- -- which these calls are made is in some cases important.
+ -- might logically be performed at elaboration time, but Namet at least
+ -- can't be done that way (because it is used in the Compiler), and we
+ -- decide to be consistent. Like elaboration, the order in which these
+ -- calls are made is in some cases important.
Csets.Initialize;
Namet.Initialize;
if Verbose_Mode then
Write_Eol;
- Write_Str ("GNATBIND ");
- Write_Str (Gnat_Version_String);
- Write_Str (" Copyright 1995-2004 Free Software Foundation, Inc.");
- Write_Eol;
+ Display_Version ("GNATBIND", "1995");
end if;
-- Output usage information if no files
if not More_Lib_Files then
- Bindusg;
+ Bindusg.Display;
Exit_Program (E_Fatal);
end if;
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: ");
Id := Scan_ALI
(F => Main_Lib_File,
T => Text,
- Ignore_ED => Force_RM_Elaboration_Order,
+ Ignore_ED => False,
Err => False,
Ignore_Errors => Debug_Flag_I);
end;
-- Set standard configuration parameters
- Suppress_Standard_Library_On_Target := True;
- Configurable_Run_Time_Mode := True;
+ 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
-- ALI files.
for Index in ALIs.First .. ALIs.Last loop
- ALIs.Table (Index).Interface := False;
+ ALIs.Table (Index).SAL_Interface := False;
end loop;
-- Add System.Standard_Library to list to ensure that these files are
Scan_ALI
(F => Std_Lib_File,
T => Text,
- Ignore_ED => Force_RM_Elaboration_Order,
+ Ignore_ED => False,
Err => False,
Ignore_Errors => Debug_Flag_I);
end;
Read_ALI (Index);
end loop;
- -- Warn if -f switch used
-
- if Force_RM_Elaboration_Order then
- Error_Msg
- ("?-f is obsolescent and should not be used");
- Error_Msg
- ("?may result in missing run-time elaboration checks");
- Error_Msg
- ("?use -gnatE, pragma Suppress (Elaboration_Checks) instead");
- end if;
-
-- Quit if some file needs compiling
if No_Object_Specified then
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
- Error_Msg_Name_1 := Main_Lib_File;
- Error_Msg ("% does not contain a unit that can be a main program");
+ Error_Msg_File_1 := Main_Lib_File;
+ Error_Msg ("{ does not contain a unit that can be a main program");
end if;
-- Perform consistency and correctness checks
Find_Elab_Order;
if Errors_Detected = 0 then
+ -- Display elaboration order if -l was specified
+
if Elab_Order_Output then
- Write_Eol;
- Write_Str ("ELABORATION ORDER");
- Write_Eol;
+ 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)).Interface then
- Write_Str (" ");
+ 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;
- Write_Eol;
+ 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
+ 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
+
+ -- Do not include the sources of the runtime
+
+ if not Is_Internal_File_Name
+ (Units.Table (Elab_Order.Table (J)).Sfile)
+ then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Str
+ (Get_Name_String
+ (Units.Table (Elab_Order.Table (J)).Sfile));
+ 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 ???
+ -- Note also that subunits may appear repeatedly in the list,
+ -- if the parent unit appears in the context of several units
+ -- in the closure.
+
+ for J in Sdep.First .. Sdep.Last loop
+ if Sdep.Table (J).Subunit_Name /= No_Name
+ and then not Is_Internal_File_Name (Sdep.Table (J).Sfile)
+ then
+ if not Zero_Formatting then
+ Write_Str (" ");
+ end if;
+
+ Write_Str (Get_Name_String (Sdep.Table (J).Sfile));
+ Write_Eol;
+ end if;
+ end loop;
+
+ if not Zero_Formatting then
+ Write_Eol;
+ end if;
+ end if;
end if;
end if;
Total_Warnings := Total_Warnings + Warnings_Detected;
end;
- -- All done. Set proper exit status.
+ -- 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
- Exit_Program (E_Success);
+ -- Do not call Exit_Program (E_Success), so that finalization occurs
+ -- normally.
+
+ null;
end if;
end Gnatbind;
OSDN Git Service
