Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

------------------------------------------------------------------------------

--                                                                          --

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                                                                          --

--                             G N A T B I N D                              --

--                             G N A T B I N D                              --

--                                                                          --

--                                                                          --

--                                 B o d y                                  --

--                                 B o d y                                  --

--                                                                          --

--                                                                          --

--          Copyright (C) 1992-2009, 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 --

-- 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- --

-- 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- --

-- 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- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- 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 --

-- 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 --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

--                                                                          --

------------------------------------------------------------------------------

------------------------------------------------------------------------------

with ALI;      use ALI;

with ALI;      use ALI;

with ALI.Util; use ALI.Util;

with ALI.Util; use ALI.Util;

with Bcheck;   use Bcheck;

with Bcheck;   use Bcheck;

with Binde;    use Binde;

with Binde;    use Binde;

with Binderr;  use Binderr;

with Binderr;  use Binderr;

with Bindgen;  use Bindgen;

with Bindgen;  use Bindgen;

with Bindusg;

with Bindusg;

with Butil;    use Butil;

with Butil;    use Butil;

with Casing;   use Casing;

with Casing;   use Casing;

with Csets;

with Csets;

with Debug;    use Debug;

with Debug;    use Debug;

with Fmap;

with Fmap;

with Fname;    use Fname;

with Fname;    use Fname;

with Namet;    use Namet;

with Namet;    use Namet;

with Opt;      use Opt;

with Opt;      use Opt;

with Osint;    use Osint;

with Osint;    use Osint;

with Osint.B;  use Osint.B;

with Osint.B;  use Osint.B;

with Output;   use Output;

with Output;   use Output;

with Rident;   use Rident;

with Rident;   use Rident;

with Snames;

with Snames;

with Switch;   use Switch;

with Switch;   use Switch;

with Switch.B; use Switch.B;

with Switch.B; use Switch.B;

with Targparm; use Targparm;

with Targparm; use Targparm;

with Types;    use Types;

with Types;    use Types;

with System.Case_Util; use System.Case_Util;

with System.Case_Util; use System.Case_Util;

with System.OS_Lib;    use System.OS_Lib;

with System.OS_Lib;    use System.OS_Lib;

with Ada.Command_Line.Response_File; use Ada.Command_Line;

with Ada.Command_Line.Response_File; use Ada.Command_Line;

procedure Gnatbind is

procedure Gnatbind is

   Total_Errors : Nat := 0;

   Total_Errors : Nat := 0;

   --  Counts total errors in all files

   --  Counts total errors in all files

   Total_Warnings : Nat := 0;

   Total_Warnings : Nat := 0;

   --  Total warnings in all files

   --  Total warnings in all files

   Main_Lib_File : File_Name_Type;

   Main_Lib_File : File_Name_Type;

   --  Current main library file

   --  Current main library file

   First_Main_Lib_File : File_Name_Type := No_File;

   First_Main_Lib_File : File_Name_Type := No_File;

   --  The first library file, that should be a main subprogram if neither -n

   --  The first library file, that should be a main subprogram if neither -n

   --  nor -z are used.

   --  nor -z are used.

   Std_Lib_File : File_Name_Type;

   Std_Lib_File : File_Name_Type;

   --  Standard library

   --  Standard library

   Text     : Text_Buffer_Ptr;

   Text     : Text_Buffer_Ptr;

   Next_Arg : Positive;

   Next_Arg : Positive;

   Output_File_Name_Seen : Boolean := False;

   Output_File_Name_Seen : Boolean := False;

   Output_File_Name      : String_Ptr := new String'("");

   Output_File_Name      : String_Ptr := new String'("");

   L_Switch_Seen : Boolean := False;

   L_Switch_Seen : Boolean := False;

   Mapping_File : String_Ptr := null;

   Mapping_File : String_Ptr := null;

   function Gnatbind_Supports_Auto_Init return Boolean;

   function Gnatbind_Supports_Auto_Init return Boolean;

   --  Indicates if automatic initialization of elaboration procedure

   --  Indicates if automatic initialization of elaboration procedure

   --  through the constructor mechanism is possible on the platform.

   --  through the constructor mechanism is possible on the platform.

   procedure List_Applicable_Restrictions;

   procedure List_Applicable_Restrictions;

   --  List restrictions that apply to this partition if option taken

   --  List restrictions that apply to this partition if option taken

   procedure Scan_Bind_Arg (Argv : String);

   procedure Scan_Bind_Arg (Argv : String);

   --  Scan and process binder specific arguments. Argv is a single argument.

   --  Scan and process binder specific arguments. Argv is a single argument.

   --  All the one character arguments are still handled by Switch. This

   --  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.

   --  routine handles -aO -aI and -I-. The lower bound of Argv must be 1.

   function Is_Cross_Compiler return Boolean;

   function Is_Cross_Compiler return Boolean;

   --  Returns True iff this is a cross-compiler

   --  Returns True iff this is a cross-compiler

   ---------------------------------

   ---------------------------------

   -- Gnatbind_Supports_Auto_Init --

   -- Gnatbind_Supports_Auto_Init --

   ---------------------------------

   ---------------------------------

   function Gnatbind_Supports_Auto_Init return Boolean is

   function Gnatbind_Supports_Auto_Init return Boolean is

      function gnat_binder_supports_auto_init return Integer;

      function gnat_binder_supports_auto_init return Integer;

      pragma Import (C, gnat_binder_supports_auto_init,

      pragma Import (C, gnat_binder_supports_auto_init,

                     "__gnat_binder_supports_auto_init");

                     "__gnat_binder_supports_auto_init");

   begin

   begin

      return gnat_binder_supports_auto_init /= 0;

      return gnat_binder_supports_auto_init /= 0;

   end Gnatbind_Supports_Auto_Init;

   end Gnatbind_Supports_Auto_Init;

   -----------------------

   -----------------------

   -- Is_Cross_Compiler --

   -- Is_Cross_Compiler --

   -----------------------

   -----------------------

   function Is_Cross_Compiler return Boolean is

   function Is_Cross_Compiler return Boolean is

      Cross_Compiler : Integer;

      Cross_Compiler : Integer;

      pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");

      pragma Import (C, Cross_Compiler, "__gnat_is_cross_compiler");

   begin

   begin

      return Cross_Compiler = 1;

      return Cross_Compiler = 1;

   end Is_Cross_Compiler;

   end Is_Cross_Compiler;

   ----------------------------------

   ----------------------------------

   -- List_Applicable_Restrictions --

   -- List_Applicable_Restrictions --

   ----------------------------------

   ----------------------------------

   procedure List_Applicable_Restrictions is

   procedure List_Applicable_Restrictions is

      --  Define those restrictions that should be output if the gnatbind

      --  Define those restrictions that should be output if the gnatbind

      --  -r switch is used. Not all restrictions are output for the reasons

      --  -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

      --  given below in the list, and this array is used to test whether

      --  the corresponding pragma should be listed. True means that it

      --  the corresponding pragma should be listed. True means that it

      --  should not be listed.

      --  should not be listed.

      No_Restriction_List : constant array (All_Restrictions) of Boolean :=

      No_Restriction_List : constant array (All_Restrictions) of Boolean :=

        (No_Exception_Propagation => True,

        (No_Exception_Propagation => True,

         --  Modifies code resulting in different exception semantics

         --  Modifies code resulting in different exception semantics

         No_Exceptions            => True,

         No_Exceptions            => True,

         --  Has unexpected Suppress (All_Checks) effect

         --  Has unexpected Suppress (All_Checks) effect

         No_Implicit_Conditionals => True,

         No_Implicit_Conditionals => True,

         --  This could modify and pessimize generated code

         --  This could modify and pessimize generated code

         No_Implicit_Dynamic_Code => True,

         No_Implicit_Dynamic_Code => True,

         --  This could modify and pessimize generated code

         --  This could modify and pessimize generated code

         No_Implicit_Loops        => True,

         No_Implicit_Loops        => True,

         --  This could modify and pessimize generated code

         --  This could modify and pessimize generated code

         No_Recursion             => True,

         No_Recursion             => True,

         --  Not checkable at compile time

         --  Not checkable at compile time

         No_Reentrancy            => True,

         No_Reentrancy            => True,

         --  Not checkable at compile time

         --  Not checkable at compile time

         Max_Entry_Queue_Length    => True,

         Max_Entry_Queue_Length    => True,

         --  Not checkable at compile time

         --  Not checkable at compile time

         Max_Storage_At_Blocking  => True,

         Max_Storage_At_Blocking  => True,

         --  Not checkable at compile time

         --  Not checkable at compile time

         others => False);

         others => False);

      Additional_Restrictions_Listed : Boolean := False;

      Additional_Restrictions_Listed : Boolean := False;

      --  Set True if we have listed header for restrictions

      --  Set True if we have listed header for restrictions

      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;

      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean;

      --  Returns True if the given restriction can be listed as an additional

      --  Returns True if the given restriction can be listed as an additional

      --  restriction that could be set.

      --  restriction that could be set.

      ------------------------------

      ------------------------------

      -- Restriction_Could_Be_Set --

      -- Restriction_Could_Be_Set --

      ------------------------------

      ------------------------------

      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is

      function Restriction_Could_Be_Set (R : Restriction_Id) return Boolean is

         CR : Restrictions_Info renames Cumulative_Restrictions;

         CR : Restrictions_Info renames Cumulative_Restrictions;

      begin

      begin

         case R is

         case R is

            --  Boolean restriction

            --  Boolean restriction

            when All_Boolean_Restrictions =>

            when All_Boolean_Restrictions =>

               --  The condition for listing a boolean restriction as an

               --  The condition for listing a boolean restriction as an

               --  additional restriction that could be set is that it is

               --  additional restriction that could be set is that it is

               --  not violated by any unit, and not already set.

               --  not violated by any unit, and not already set.

               return CR.Violated (R) = False and then CR.Set (R) = False;

               return CR.Violated (R) = False and then CR.Set (R) = False;

            --  Parameter restriction

            --  Parameter restriction

            when All_Parameter_Restrictions =>

            when All_Parameter_Restrictions =>

               --  If the restriction is violated and the level of violation is

               --  If the restriction is violated and the level of violation is

               --  unknown, the restriction can definitely not be listed.

               --  unknown, the restriction can definitely not be listed.

               if CR.Violated (R) and then CR.Unknown (R) then

               if CR.Violated (R) and then CR.Unknown (R) then

                  return False;

                  return False;

               --  We can list the restriction if it is not set

               --  We can list the restriction if it is not set

               elsif not CR.Set (R) then

               elsif not CR.Set (R) then

                  return True;

                  return True;

               --  We can list the restriction if is set to a greater value

               --  We can list the restriction if is set to a greater value

               --  than the maximum value known for the violation.

               --  than the maximum value known for the violation.

               else

               else

                  return CR.Value (R) > CR.Count (R);

                  return CR.Value (R) > CR.Count (R);

               end if;

               end if;

            --  No other values for R possible

            --  No other values for R possible

            when others =>

            when others =>

               raise Program_Error;

               raise Program_Error;

         end case;

         end case;

      end Restriction_Could_Be_Set;

      end Restriction_Could_Be_Set;

   --  Start of processing for List_Applicable_Restrictions

   --  Start of processing for List_Applicable_Restrictions

   begin

   begin

      --  Loop through restrictions

      --  Loop through restrictions

      for R in All_Restrictions loop

      for R in All_Restrictions loop

         if not No_Restriction_List (R)

         if not No_Restriction_List (R)

            and then Restriction_Could_Be_Set (R)

            and then Restriction_Could_Be_Set (R)

         then

         then

            if not Additional_Restrictions_Listed then

            if not Additional_Restrictions_Listed then

               Write_Eol;

               Write_Eol;

               Write_Line

               Write_Line

                 ("The following additional restrictions may be" &

                 ("The following additional restrictions may be" &

                  " applied to this partition:");

                  " applied to this partition:");

               Additional_Restrictions_Listed := True;

               Additional_Restrictions_Listed := True;

            end if;

            end if;

            Write_Str ("pragma Restrictions (");

            Write_Str ("pragma Restrictions (");

            declare

            declare

               S : constant String := Restriction_Id'Image (R);

               S : constant String := Restriction_Id'Image (R);

            begin

            begin

               Name_Len := S'Length;

               Name_Len := S'Length;

               Name_Buffer (1 .. Name_Len) := S;

               Name_Buffer (1 .. Name_Len) := S;

            end;

            end;

            Set_Casing (Mixed_Case);

            Set_Casing (Mixed_Case);

            Write_Str (Name_Buffer (1 .. Name_Len));

            Write_Str (Name_Buffer (1 .. Name_Len));

            if R in All_Parameter_Restrictions then

            if R in All_Parameter_Restrictions then

               Write_Str (" => ");

               Write_Str (" => ");

               Write_Int (Int (Cumulative_Restrictions.Count (R)));

               Write_Int (Int (Cumulative_Restrictions.Count (R)));

            end if;

            end if;

            Write_Str (");");

            Write_Str (");");

            Write_Eol;

            Write_Eol;

         end if;

         end if;

      end loop;

      end loop;

   end List_Applicable_Restrictions;

   end List_Applicable_Restrictions;

   -------------------

   -------------------

   -- Scan_Bind_Arg --

   -- Scan_Bind_Arg --

   -------------------

   -------------------

   procedure Scan_Bind_Arg (Argv : String) is

   procedure Scan_Bind_Arg (Argv : String) is

      pragma Assert (Argv'First = 1);

      pragma Assert (Argv'First = 1);

   begin

   begin

      --  Now scan arguments that are specific to the binder and are not

      --  Now scan arguments that are specific to the binder and are not

      --  handled by the common circuitry in Switch.

      --  handled by the common circuitry in Switch.

      if Opt.Output_File_Name_Present

      if Opt.Output_File_Name_Present

        and then not Output_File_Name_Seen

        and then not Output_File_Name_Seen

      then

      then

         Output_File_Name_Seen := True;

         Output_File_Name_Seen := True;

         if Argv'Length = 0

         if Argv'Length = 0

           or else (Argv'Length >= 1 and then Argv (1) = '-')

           or else (Argv'Length >= 1 and then Argv (1) = '-')

         then

         then

            Fail ("output File_Name missing after -o");

            Fail ("output File_Name missing after -o");

         else

         else

            Output_File_Name := new String'(Argv);

            Output_File_Name := new String'(Argv);

         end if;

         end if;

      elsif Argv'Length >= 2 and then Argv (1) = '-' then

      elsif Argv'Length >= 2 and then Argv (1) = '-' then

         --  -I-

         --  -I-

         if Argv (2 .. Argv'Last) = "I-" then

         if Argv (2 .. Argv'Last) = "I-" then

            Opt.Look_In_Primary_Dir := False;

            Opt.Look_In_Primary_Dir := False;

         --  -Idir

         --  -Idir

         elsif Argv (2) = 'I' then

         elsif Argv (2) = 'I' then

            Add_Src_Search_Dir (Argv (3 .. Argv'Last));

            Add_Src_Search_Dir (Argv (3 .. Argv'Last));

            Add_Lib_Search_Dir (Argv (3 .. Argv'Last));

            Add_Lib_Search_Dir (Argv (3 .. Argv'Last));

         --  -Ldir

         --  -Ldir

         elsif Argv (2) = 'L' then

         elsif Argv (2) = 'L' then

            if Argv'Length >= 3 then

            if Argv'Length >= 3 then

               --  Remember that the -L switch was specified, so that if this

               --  Remember that the -L switch was specified, so that if this

               --  is on OpenVMS, the export names are put in uppercase.

               --  is on OpenVMS, the export names are put in uppercase.

               --  This is not known before the target parameters are read.

               --  This is not known before the target parameters are read.

               L_Switch_Seen := True;

               L_Switch_Seen := True;

               Opt.Bind_For_Library := True;

               Opt.Bind_For_Library := True;

               Opt.Ada_Init_Name :=

               Opt.Ada_Init_Name :=

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Init_Suffix);

               Opt.Ada_Final_Name :=

               Opt.Ada_Final_Name :=

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Final_Suffix);

               Opt.Ada_Main_Name :=

               Opt.Ada_Main_Name :=

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);

                 new String'(Argv (3 .. Argv'Last) & Opt.Ada_Main_Name_Suffix);

               --  This option (-Lxxx) implies -n

               --  This option (-Lxxx) implies -n

               Opt.Bind_Main_Program := False;

               Opt.Bind_Main_Program := False;

            else

            else

               Fail

               Fail

                 ("Prefix of initialization and finalization " &

                 ("Prefix of initialization and finalization " &

                  "procedure names missing in -L");

                  "procedure names missing in -L");

            end if;

            end if;

         --  -Sin -Slo -Shi -Sxx -Sev

         --  -Sin -Slo -Shi -Sxx -Sev

         elsif Argv'Length = 4

         elsif Argv'Length = 4

           and then Argv (2) = 'S'

           and then Argv (2) = 'S'

         then

         then

            declare

            declare

               C1 : Character := Argv (3);

               C1 : Character := Argv (3);

               C2 : Character := Argv (4);

               C2 : Character := Argv (4);

            begin

            begin

               --  Fold to upper case

               --  Fold to upper case

               if C1 in 'a' .. 'z' then

               if C1 in 'a' .. 'z' then

                  C1 := Character'Val (Character'Pos (C1) - 32);

                  C1 := Character'Val (Character'Pos (C1) - 32);

               end if;

               end if;

               if C2 in 'a' .. 'z' then

               if C2 in 'a' .. 'z' then

                  C2 := Character'Val (Character'Pos (C2) - 32);

                  C2 := Character'Val (Character'Pos (C2) - 32);

               end if;

               end if;

               --  Test valid option and set mode accordingly

               --  Test valid option and set mode accordingly

               if C1 = 'E' and then C2 = 'V' then

               if C1 = 'E' and then C2 = 'V' then

                  null;

                  null;

               elsif C1 = 'I' and then C2 = 'N' then

               elsif C1 = 'I' and then C2 = 'N' then

                  null;

                  null;

               elsif C1 = 'L' and then C2 = 'O' then

               elsif C1 = 'L' and then C2 = 'O' then

                  null;

                  null;

               elsif C1 = 'H' and then C2 = 'I' then

               elsif C1 = 'H' and then C2 = 'I' then

                  null;

                  null;

               elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')

               elsif (C1 in '0' .. '9' or else C1 in 'A' .. 'F')

                       and then

                       and then

                     (C2 in '0' .. '9' or else C2 in 'A' .. 'F')

                     (C2 in '0' .. '9' or else C2 in 'A' .. 'F')

               then

               then

                  null;

                  null;

               --  Invalid -S switch, let Switch give error, set default of IN

               --  Invalid -S switch, let Switch give error, set default of IN

               else

               else

                  Scan_Binder_Switches (Argv);

                  Scan_Binder_Switches (Argv);

                  C1 := 'I';

                  C1 := 'I';

                  C2 := 'N';

                  C2 := 'N';

               end if;

               end if;

               Initialize_Scalars_Mode1 := C1;

               Initialize_Scalars_Mode1 := C1;

               Initialize_Scalars_Mode2 := C2;

               Initialize_Scalars_Mode2 := C2;

            end;

            end;

         --  -aIdir

         --  -aIdir

         elsif Argv'Length >= 3

         elsif Argv'Length >= 3

           and then Argv (2 .. 3) = "aI"

           and then Argv (2 .. 3) = "aI"

         then

         then

            Add_Src_Search_Dir (Argv (4 .. Argv'Last));

            Add_Src_Search_Dir (Argv (4 .. Argv'Last));

         --  -aOdir

         --  -aOdir

         elsif Argv'Length >= 3

         elsif Argv'Length >= 3

           and then Argv (2 .. 3) = "aO"

           and then Argv (2 .. 3) = "aO"

         then

         then

            Add_Lib_Search_Dir (Argv (4 .. Argv'Last));

            Add_Lib_Search_Dir (Argv (4 .. Argv'Last));

         --  -nostdlib

         --  -nostdlib

         elsif Argv (2 .. Argv'Last) = "nostdlib" then

         elsif Argv (2 .. Argv'Last) = "nostdlib" then

            Opt.No_Stdlib := True;

            Opt.No_Stdlib := True;

         --  -nostdinc

         --  -nostdinc

         elsif Argv (2 .. Argv'Last) = "nostdinc" then

         elsif Argv (2 .. Argv'Last) = "nostdinc" then

            Opt.No_Stdinc := True;

            Opt.No_Stdinc := True;

         --  -static

         --  -static

         elsif Argv (2 .. Argv'Last) = "static" then

         elsif Argv (2 .. Argv'Last) = "static" then

            Opt.Shared_Libgnat := False;

            Opt.Shared_Libgnat := False;

         --  -shared

         --  -shared

         elsif Argv (2 .. Argv'Last) = "shared" then

         elsif Argv (2 .. Argv'Last) = "shared" then

            Opt.Shared_Libgnat := True;

            Opt.Shared_Libgnat := True;

         --  -F=mapping_file

         --  -F=mapping_file

         elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then

         elsif Argv'Length >= 4 and then Argv (2 .. 3) = "F=" then

            if Mapping_File /= null then

            if Mapping_File /= null then

               Fail ("cannot specify several mapping files");

               Fail ("cannot specify several mapping files");

            end if;

            end if;

            Mapping_File := new String'(Argv (4 .. Argv'Last));

            Mapping_File := new String'(Argv (4 .. Argv'Last));

         --  -Mname

         --  -Mname

         elsif Argv'Length >= 3 and then Argv (2) = 'M' then

         elsif Argv'Length >= 3 and then Argv (2) = 'M' then

            if not Is_Cross_Compiler then

            if not Is_Cross_Compiler then

               Write_Line

               Write_Line

                 ("gnatbind: -M not expected to be used on native platforms");

                 ("gnatbind: -M not expected to be used on native platforms");

            end if;

            end if;

            Opt.Bind_Alternate_Main_Name := True;

            Opt.Bind_Alternate_Main_Name := True;

            Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));

            Opt.Alternate_Main_Name := new String'(Argv (3 .. Argv'Last));

         --  All other options are single character and are handled by

         --  All other options are single character and are handled by

         --  Scan_Binder_Switches.

         --  Scan_Binder_Switches.

         else

         else

            Scan_Binder_Switches (Argv);

            Scan_Binder_Switches (Argv);

         end if;

         end if;

      --  Not a switch, so must be a file name (if non-empty)

      --  Not a switch, so must be a file name (if non-empty)

      elsif Argv'Length /= 0 then

      elsif Argv'Length /= 0 then

         if Argv'Length > 4

         if Argv'Length > 4

           and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"

           and then Argv (Argv'Last - 3 .. Argv'Last) = ".ali"

         then

         then

            Add_File (Argv);

            Add_File (Argv);

         else

         else

            Add_File (Argv & ".ali");

            Add_File (Argv & ".ali");

         end if;

         end if;

      end if;

      end if;

   end Scan_Bind_Arg;

   end Scan_Bind_Arg;

   procedure Check_Version_And_Help is

   procedure Check_Version_And_Help is

      new Check_Version_And_Help_G (Bindusg.Display);

      new Check_Version_And_Help_G (Bindusg.Display);

--  Start of processing for Gnatbind

--  Start of processing for Gnatbind

begin

begin

   --  Set default for Shared_Libgnat option

   --  Set default for Shared_Libgnat option

   declare

   declare

      Shared_Libgnat_Default : Character;

      Shared_Libgnat_Default : Character;

      pragma Import

      pragma Import

        (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");

        (C, Shared_Libgnat_Default, "__gnat_shared_libgnat_default");

      SHARED : constant Character := 'H';

      SHARED : constant Character := 'H';

      STATIC : constant Character := 'T';

      STATIC : constant Character := 'T';

   begin

   begin

      pragma Assert

      pragma Assert

        (Shared_Libgnat_Default = SHARED

        (Shared_Libgnat_Default = SHARED

         or else

         or else

        Shared_Libgnat_Default = STATIC);

        Shared_Libgnat_Default = STATIC);

      Shared_Libgnat := (Shared_Libgnat_Default = SHARED);

      Shared_Libgnat := (Shared_Libgnat_Default = SHARED);

   end;

   end;

   --  Scan the switches and arguments

   --  Scan the switches and arguments

   --  First, scan to detect --version and/or --help

   --  First, scan to detect --version and/or --help

   Check_Version_And_Help ("GNATBIND", "1995");

   Check_Version_And_Help ("GNATBIND", "1995");

   --  Use low level argument routines to avoid dragging in the secondary stack

   --  Use low level argument routines to avoid dragging in the secondary stack

   Next_Arg := 1;

   Next_Arg := 1;

   Scan_Args : while Next_Arg < Arg_Count loop

   Scan_Args : while Next_Arg < Arg_Count loop

      declare

      declare

         Next_Argv : String (1 .. Len_Arg (Next_Arg));

         Next_Argv : String (1 .. Len_Arg (Next_Arg));

      begin

      begin

         Fill_Arg (Next_Argv'Address, Next_Arg);

         Fill_Arg (Next_Argv'Address, Next_Arg);

         if Next_Argv'Length > 0 then

         if Next_Argv'Length > 0 then

            if Next_Argv (1) = '@' then

            if Next_Argv (1) = '@' then

               if Next_Argv'Length > 1 then

               if Next_Argv'Length > 1 then

                  declare

                  declare

                     Arguments : constant Argument_List :=

                     Arguments : constant Argument_List :=

                                   Response_File.Arguments_From

                                   Response_File.Arguments_From

                                     (Response_File_Name        =>

                                     (Response_File_Name        =>

                                        Next_Argv (2 .. Next_Argv'Last),

                                        Next_Argv (2 .. Next_Argv'Last),

                                      Recursive                 => True,

                                      Recursive                 => True,

                                      Ignore_Non_Existing_Files => True);

                                      Ignore_Non_Existing_Files => True);

                  begin

                  begin

                     for J in Arguments'Range loop

                     for J in Arguments'Range loop

                        Scan_Bind_Arg (Arguments (J).all);

                        Scan_Bind_Arg (Arguments (J).all);

                     end loop;

                     end loop;

                  end;

                  end;

               end if;

               end if;

            else

            else

               Scan_Bind_Arg (Next_Argv);

               Scan_Bind_Arg (Next_Argv);

            end if;

            end if;

         end if;

         end if;

      end;

      end;

      Next_Arg := Next_Arg + 1;

      Next_Arg := Next_Arg + 1;

   end loop Scan_Args;

   end loop Scan_Args;

   if Use_Pragma_Linker_Constructor then

   if Use_Pragma_Linker_Constructor then

      if Bind_Main_Program then

      if Bind_Main_Program then

         Fail ("switch -a must be used in conjunction with -n or -Lxxx");

         Fail ("switch -a must be used in conjunction with -n or -Lxxx");

      elsif not Gnatbind_Supports_Auto_Init then

      elsif not Gnatbind_Supports_Auto_Init then

         Fail ("automatic initialisation of elaboration " &

         Fail ("automatic initialisation of elaboration " &

               "not supported on this platform");

               "not supported on this platform");

      end if;

      end if;

   end if;

   end if;

   --  Test for trailing -o switch

   --  Test for trailing -o switch

   if Opt.Output_File_Name_Present

   if Opt.Output_File_Name_Present

     and then not Output_File_Name_Seen

     and then not Output_File_Name_Seen

   then

   then

      Fail ("output file name missing after -o");

      Fail ("output file name missing after -o");

   end if;

   end if;

   --  Output usage if requested

   --  Output usage if requested

   if Usage_Requested then

   if Usage_Requested then

      Bindusg.Display;

      Bindusg.Display;

   end if;

   end if;

   --  Check that the Ada binder file specified has extension .adb and that

   --  Check that the Ada binder file specified has extension .adb and that

   --  the C binder file has extension .c

   --  the C binder file has extension .c

   if Opt.Output_File_Name_Present

   if Opt.Output_File_Name_Present

     and then Output_File_Name_Seen

     and then Output_File_Name_Seen

   then

   then

      Check_Extensions : declare

      Check_Extensions : declare

         Length : constant Natural := Output_File_Name'Length;

         Length : constant Natural := Output_File_Name'Length;

         Last   : constant Natural := Output_File_Name'Last;

         Last   : constant Natural := Output_File_Name'Last;

      begin

      begin

         if Ada_Bind_File then

         if Ada_Bind_File then

            if Length <= 4

            if Length <= 4

              or else Output_File_Name (Last - 3 .. Last) /= ".adb"

              or else Output_File_Name (Last - 3 .. Last) /= ".adb"

            then

            then

               Fail ("output file name should have .adb extension");

               Fail ("output file name should have .adb extension");

            end if;

            end if;

         else

         else

            if Length <= 2

            if Length <= 2

              or else Output_File_Name (Last - 1 .. Last) /= ".c"

              or else Output_File_Name (Last - 1 .. Last) /= ".c"

            then

            then

               Fail ("output file name should have .c extension");

               Fail ("output file name should have .c extension");

            end if;

            end if;

         end if;

         end if;

      end Check_Extensions;

      end Check_Extensions;

   end if;

   end if;

   Osint.Add_Default_Search_Dirs;

   Osint.Add_Default_Search_Dirs;

   --  Carry out package initializations. These are initializations which

   --  Carry out package initializations. These are initializations which

   --  might logically be performed at elaboration time, but Namet at least

   --  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

   --  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

   --  decide to be consistent. Like elaboration, the order in which these

   --  calls are made is in some cases important.

   --  calls are made is in some cases important.

   Csets.Initialize;

   Csets.Initialize;

   Namet.Initialize;

   Namet.Initialize;

   Snames.Initialize;

   Snames.Initialize;

   --  Acquire target parameters

   --  Acquire target parameters

   Targparm.Get_Target_Parameters;

   Targparm.Get_Target_Parameters;

   --  Initialize Cumulative_Restrictions with the restrictions on the target

   --  Initialize Cumulative_Restrictions with the restrictions on the target

   --  scanned from the system.ads file. Then as we read ALI files, we will

   --  scanned from the system.ads file. Then as we read ALI files, we will

   --  accumulate additional restrictions specified in other files.

   --  accumulate additional restrictions specified in other files.

   Cumulative_Restrictions := Targparm.Restrictions_On_Target;

   Cumulative_Restrictions := Targparm.Restrictions_On_Target;

   --  On OpenVMS, when -L is used, all external names used in pragmas Export

   --  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

   --  are in upper case. The reason is that on OpenVMS, the macro-assembler

   --  MACASM-32, used to build Stand-Alone Libraries, only understands

   --  MACASM-32, used to build Stand-Alone Libraries, only understands

   --  uppercase.

   --  uppercase.

   if L_Switch_Seen and then OpenVMS_On_Target then

   if L_Switch_Seen and then OpenVMS_On_Target then

      To_Upper (Opt.Ada_Init_Name.all);

      To_Upper (Opt.Ada_Init_Name.all);

      To_Upper (Opt.Ada_Final_Name.all);

      To_Upper (Opt.Ada_Final_Name.all);

      To_Upper (Opt.Ada_Main_Name.all);

      To_Upper (Opt.Ada_Main_Name.all);

   end if;

   end if;

   --  Acquire configurable run-time mode

   --  Acquire configurable run-time mode

   if Configurable_Run_Time_On_Target then

   if Configurable_Run_Time_On_Target then

      Configurable_Run_Time_Mode := True;

      Configurable_Run_Time_Mode := True;

   end if;

   end if;

   --  Output copyright notice if in verbose mode

   --  Output copyright notice if in verbose mode

   if Verbose_Mode then

   if Verbose_Mode then

      Write_Eol;

      Write_Eol;

      Display_Version ("GNATBIND", "1995");

      Display_Version ("GNATBIND", "1995");

   end if;

   end if;

   --  Output usage information if no files

   --  Output usage information if no files

   if not More_Lib_Files then

   if not More_Lib_Files then

      Bindusg.Display;

      Bindusg.Display;

      Exit_Program (E_Fatal);

      Exit_Program (E_Fatal);

   end if;

   end if;

   --  If a mapping file was specified, initialize the file mapping

   --  If a mapping file was specified, initialize the file mapping

   if Mapping_File /= null then

   if Mapping_File /= null then

      Fmap.Initialize (Mapping_File.all);

      Fmap.Initialize (Mapping_File.all);

   end if;

   end if;

   --  The block here is to catch the Unrecoverable_Error exception in the

   --  The block here is to catch the Unrecoverable_Error exception in the

   --  case where we exceed the maximum number of permissible errors or some

   --  case where we exceed the maximum number of permissible errors or some

   --  other unrecoverable error occurs.

   --  other unrecoverable error occurs.

   begin

   begin

      --  Initialize binder packages

      --  Initialize binder packages

      Initialize_Binderr;

      Initialize_Binderr;

      Initialize_ALI;

      Initialize_ALI;

      Initialize_ALI_Source;

      Initialize_ALI_Source;

      if Verbose_Mode then

      if Verbose_Mode then

         Write_Eol;

         Write_Eol;

      end if;

      end if;

      --  Input ALI files

      --  Input ALI files

      while More_Lib_Files loop

      while More_Lib_Files loop

         Main_Lib_File := Next_Main_Lib_File;

         Main_Lib_File := Next_Main_Lib_File;

         if First_Main_Lib_File = No_File then

         if First_Main_Lib_File = No_File then

            First_Main_Lib_File := Main_Lib_File;

            First_Main_Lib_File := Main_Lib_File;

         end if;

         end if;

         if Verbose_Mode then

         if Verbose_Mode then

            if Check_Only then

            if Check_Only then

               Write_Str ("Checking: ");

               Write_Str ("Checking: ");

            else

            else

               Write_Str ("Binding: ");

               Write_Str ("Binding: ");

            end if;

            end if;

            Write_Name (Main_Lib_File);

            Write_Name (Main_Lib_File);

            Write_Eol;

            Write_Eol;

         end if;

         end if;