gcc/ada/ * gnatbind.adb (Gnatbind): For No_Tasks_Unassigned_To_CPU, check that CPU has been set on the main subprogram. (Restriction_Could_Be_Set): Don't print No_Tasks_Unassigned_To_CPU if it would violate the above-mentioned rule. Up to now, all restrictions were checked by the compiler, with the binder just checking for consistency. But the compiler can't know which subprogram is the main, so it's impossible to check this one at compile time. * restrict.ads, restrict.adb: Misc refactoring. Change Warning to Warn, for consistency, since most already use Warn. (Set_Restriction): New convenience routine. * sem_ch13.adb (Attribute_CPU): Check No_Tasks_Unassigned_To_CPU. * sem_prag.adb (Pragma_CPU): Check No_Tasks_Unassigned_To_CPU. Misc refactoring. * tbuild.ads, tbuild.adb (Sel_Comp): New functions for building selected components.
962 lines
29 KiB
Ada
962 lines
29 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- GNAT COMPILER COMPONENTS --
|
|
-- --
|
|
-- G N A T B I N D --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1992-2020, 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 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,
|
|
Ignore_ED => False,
|
|
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_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;
|
|
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,
|
|
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. 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;
|