diff options
author | Dan Albert <danalbert@google.com> | 2015-06-17 11:09:54 -0700 |
---|---|---|
committer | Dan Albert <danalbert@google.com> | 2015-06-17 14:15:22 -0700 |
commit | f378ebf14df0952eae870c9865bab8326aa8f137 (patch) | |
tree | 31794503eb2a8c64ea5f313b93100f1163afcffb /gcc-4.2.1/gcc/ada/gnatlink.adb | |
parent | 2c58169824949d3a597d9fa81931e001ef9b1bd0 (diff) | |
download | toolchain_gcc-f378ebf14df0952eae870c9865bab8326aa8f137.tar.gz toolchain_gcc-f378ebf14df0952eae870c9865bab8326aa8f137.tar.bz2 toolchain_gcc-f378ebf14df0952eae870c9865bab8326aa8f137.zip |
Delete old versions of GCC.
Change-Id: I710f125d905290e1024cbd67f48299861790c66c
Diffstat (limited to 'gcc-4.2.1/gcc/ada/gnatlink.adb')
-rw-r--r-- | gcc-4.2.1/gcc/ada/gnatlink.adb | 1914 |
1 files changed, 0 insertions, 1914 deletions
diff --git a/gcc-4.2.1/gcc/ada/gnatlink.adb b/gcc-4.2.1/gcc/ada/gnatlink.adb deleted file mode 100644 index a2e638238..000000000 --- a/gcc-4.2.1/gcc/ada/gnatlink.adb +++ /dev/null @@ -1,1914 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- G N A T L I N K -- --- -- --- B o d y -- --- -- --- Copyright (C) 1996-2006, 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- -- --- 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, 51 Franklin Street, Fifth Floor, -- --- Boston, MA 02110-1301, USA. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Gnatlink usage: please consult the gnat documentation - -with ALI; use ALI; -with Csets; -with Gnatvsn; use Gnatvsn; -with Hostparm; -with Indepsw; use Indepsw; -with Namet; use Namet; -with Opt; -with Osint; use Osint; -with Output; use Output; -with Snames; -with Switch; use Switch; -with System; use System; -with Table; -with Targparm; use Targparm; -with Types; - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Exceptions; use Ada.Exceptions; -with GNAT.OS_Lib; use GNAT.OS_Lib; -with Interfaces.C_Streams; use Interfaces.C_Streams; -with Interfaces.C.Strings; use Interfaces.C.Strings; -with System.CRTL; - -procedure Gnatlink is - pragma Ident (Gnatvsn.Gnat_Static_Version_String); - - Shared_Libgcc_String : constant String := "-shared-libgcc"; - Shared_Libgcc : constant String_Access := - new String'(Shared_Libgcc_String); - -- Used to invoke gcc when the binder is invoked with -shared - - package Gcc_Linker_Options is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Gcc_Linker_Options"); - -- Comments needed ??? - - package Libpath is new Table.Table ( - Table_Component_Type => Character, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 4096, - Table_Increment => 2, - Table_Name => "Gnatlink.Libpath"); - -- Comments needed ??? - - package Linker_Options is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Linker_Options"); - -- Comments needed ??? - - package Linker_Objects is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Linker_Objects"); - -- This table collects the objects file to be passed to the linker. In the - -- case where the linker command line is too long then programs objects - -- are put on the Response_File_Objects table. Note that the binder object - -- file and the user's objects remain in this table. This is very - -- important because on the GNU linker command line the -L switch is not - -- used to look for objects files but -L switch is used to look for - -- objects listed in the response file. This is not a problem with the - -- applications objects as they are specified with a fullname. - - package Response_File_Objects is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Response_File_Objects"); - -- This table collects the objects file that are to be put in the response - -- file. Only application objects are collected there (see details in - -- Linker_Objects table comments) - - package Binder_Options_From_ALI is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Binder_Options_From_ALI"); - -- This table collects the switches from the ALI file of the main - -- subprogram. - - package Binder_Options is new Table.Table ( - Table_Component_Type => String_Access, - Table_Index_Type => Integer, - Table_Low_Bound => 1, -- equals low bound of Argument_List for Spawn - Table_Initial => 20, - Table_Increment => 100, - Table_Name => "Gnatlink.Binder_Options"); - -- This table collects the arguments to be passed to compile the binder - -- generated file. - - Gcc : String_Access := Program_Name ("gcc"); - - Read_Mode : constant String := "r" & ASCII.Nul; - - Begin_Info : String := "-- BEGIN Object file/option list"; - End_Info : String := "-- END Object file/option list "; - -- Note: above lines are modified in C mode, see option processing - - Gcc_Path : String_Access; - Linker_Path : String_Access; - - Output_File_Name : String_Access; - Ali_File_Name : String_Access; - Binder_Spec_Src_File : String_Access; - Binder_Body_Src_File : String_Access; - Binder_Ali_File : String_Access; - Binder_Obj_File : String_Access; - - Tname : Temp_File_Name; - Tname_FD : File_Descriptor := Invalid_FD; - -- Temporary file used by linker to pass list of object files on - -- certain systems with limitations on size of arguments. - - Debug_Flag_Present : Boolean := False; - Verbose_Mode : Boolean := False; - Very_Verbose_Mode : Boolean := False; - - Ada_Bind_File : Boolean := True; - -- Set to True if bind file is generated in Ada - - Standard_Gcc : Boolean := True; - - Compile_Bind_File : Boolean := True; - -- Set to False if bind file is not to be compiled - - Create_Map_File : Boolean := False; - -- Set to True by switch -M. The map file name is derived from - -- the ALI file name (mainprog.ali => mainprog.map). - - Object_List_File_Supported : Boolean; - pragma Import - (C, Object_List_File_Supported, "__gnat_objlist_file_supported"); - -- Predicate indicating whether the linker has an option whereby the - -- names of object files can be passed to the linker in a file. - - Object_List_File_Required : Boolean := False; - -- Set to True to force generation of a response file - - function Base_Name (File_Name : String) return String; - -- Return just the file name part without the extension (if present) - - procedure Delete (Name : String); - -- Wrapper to unlink as status is ignored by this application - - procedure Error_Msg (Message : String); - -- Output the error or warning Message - - procedure Exit_With_Error (Error : String); - -- Output Error and exit program with a fatal condition - - procedure Process_Args; - -- Go through all the arguments and build option tables - - procedure Process_Binder_File (Name : String); - -- Reads the binder file and extracts linker arguments - - procedure Write_Header; - -- Show user the program name, version and copyright - - procedure Write_Usage; - -- Show user the program options - - --------------- - -- Base_Name -- - --------------- - - function Base_Name (File_Name : String) return String is - Findex1 : Natural; - Findex2 : Natural; - - begin - Findex1 := File_Name'First; - - -- The file might be specified by a full path name. However, - -- we want the path to be stripped away. - - for J in reverse File_Name'Range loop - if Is_Directory_Separator (File_Name (J)) then - Findex1 := J + 1; - exit; - end if; - end loop; - - Findex2 := File_Name'Last; - while Findex2 > Findex1 - and then File_Name (Findex2) /= '.' - loop - Findex2 := Findex2 - 1; - end loop; - - if Findex2 = Findex1 then - Findex2 := File_Name'Last + 1; - end if; - - return File_Name (Findex1 .. Findex2 - 1); - end Base_Name; - - ------------ - -- Delete -- - ------------ - - procedure Delete (Name : String) is - Status : int; - pragma Unreferenced (Status); - begin - Status := unlink (Name'Address); - -- Is it really right to ignore an error here ??? - end Delete; - - --------------- - -- Error_Msg -- - --------------- - - procedure Error_Msg (Message : String) is - begin - Write_Str (Base_Name (Command_Name)); - Write_Str (": "); - Write_Str (Message); - Write_Eol; - end Error_Msg; - - --------------------- - -- Exit_With_Error -- - --------------------- - - procedure Exit_With_Error (Error : String) is - begin - Error_Msg (Error); - Exit_Program (E_Fatal); - end Exit_With_Error; - - ------------------ - -- Process_Args -- - ------------------ - - procedure Process_Args is - Next_Arg : Integer; - Skip_Next : Boolean := False; - -- Set to true if the next argument is to be added into the list of - -- linker's argument without parsing it. - - begin - -- Loop through arguments of gnatlink command - - Next_Arg := 1; - loop - exit when Next_Arg > Argument_Count; - - Process_One_Arg : declare - Arg : constant String := Argument (Next_Arg); - - begin - -- Case of argument which is a switch - - -- We definitely need section by section comments here ??? - - if Skip_Next then - - -- This argument must not be parsed, just add it to the - -- list of linker's options. - - Skip_Next := False; - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - elsif Arg'Length /= 0 and then Arg (1) = '-' then - if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then - Exit_With_Error - ("invalid switch: """ & Arg & """ (gnat not needed here)"); - end if; - - if Arg = "-Xlinker" then - - -- Next argument should be sent directly to the linker. - -- We do not want to parse it here. - - Skip_Next := True; - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - elsif Arg (2) = 'g' - and then (Arg'Length < 5 or else Arg (2 .. 5) /= "gnat") - then - Debug_Flag_Present := True; - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - Linker_Options.Table (Linker_Options.Last); - - elsif Arg'Length >= 3 and then Arg (2) = 'M' then - declare - Switches : String_List_Access; - - begin - Convert (Map_File, Arg (3 .. Arg'Last), Switches); - - if Switches /= null then - for J in Switches'Range loop - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - Switches (J); - end loop; - end if; - end; - - elsif Arg'Length = 2 then - case Arg (2) is - when 'A' => - Ada_Bind_File := True; - Begin_Info := "-- BEGIN Object file/option list"; - End_Info := "-- END Object file/option list "; - - when 'b' => - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - Linker_Options.Table (Linker_Options.Last); - - Next_Arg := Next_Arg + 1; - - if Next_Arg > Argument_Count then - Exit_With_Error ("Missing argument for -b"); - end if; - - Get_Machine_Name : declare - Name_Arg : constant String_Access := - new String'(Argument (Next_Arg)); - - begin - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - Name_Arg; - - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - Name_Arg; - - end Get_Machine_Name; - - when 'C' => - Ada_Bind_File := False; - Begin_Info := "/* BEGIN Object file/option list"; - End_Info := " END Object file/option list */"; - - when 'f' => - if Object_List_File_Supported then - Object_List_File_Required := True; - else - Exit_With_Error - ("Object list file not supported on this target"); - end if; - - when 'M' => - Create_Map_File := True; - - when 'n' => - Compile_Bind_File := False; - - when 'o' => - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - Next_Arg := Next_Arg + 1; - - if Next_Arg > Argument_Count then - Exit_With_Error ("Missing argument for -o"); - end if; - - Output_File_Name := new String'(Argument (Next_Arg)); - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - Output_File_Name; - - when 'R' => - Opt.Run_Path_Option := False; - - when 'v' => - - -- Support "double" verbose mode. Second -v - -- gets sent to the linker and binder phases. - - if Verbose_Mode then - Very_Verbose_Mode := True; - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - Linker_Options.Table (Linker_Options.Last); - - else - Verbose_Mode := True; - - end if; - - when others => - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - end case; - - elsif Arg (2) = 'B' then - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - Linker_Options.Table (Linker_Options.Last); - - elsif Arg'Length >= 7 and then Arg (1 .. 7) = "--LINK=" then - if Arg'Length = 7 then - Exit_With_Error ("Missing argument for --LINK="); - end if; - - Linker_Path := - GNAT.OS_Lib.Locate_Exec_On_Path (Arg (8 .. Arg'Last)); - - if Linker_Path = null then - Exit_With_Error - ("Could not locate linker: " & Arg (8 .. Arg'Last)); - end if; - - elsif Arg'Length > 6 and then Arg (1 .. 6) = "--GCC=" then - declare - Program_Args : constant Argument_List_Access := - Argument_String_To_List - (Arg (7 .. Arg'Last)); - - begin - Gcc := new String'(Program_Args.all (1).all); - Standard_Gcc := False; - - -- Set appropriate flags for switches passed - - for J in 2 .. Program_Args.all'Last loop - declare - Arg : constant String := Program_Args.all (J).all; - AF : constant Integer := Arg'First; - - begin - if Arg'Length /= 0 and then Arg (AF) = '-' then - if Arg (AF + 1) = 'g' - and then (Arg'Length = 2 - or else Arg (AF + 2) in '0' .. '3' - or else Arg (AF + 2 .. Arg'Last) = "coff") - then - Debug_Flag_Present := True; - end if; - end if; - - -- Add directory to source search dirs so that - -- Get_Target_Parameters can find system.ads - - if Arg (AF .. AF + 1) = "-I" - and then Arg'Length > 2 - then - Add_Src_Search_Dir (Arg (AF + 2 .. Arg'Last)); - end if; - - -- Pass to gcc for compiling binder generated file - -- No use passing libraries, it will just generate - -- a warning - - if not (Arg (AF .. AF + 1) = "-l" - or else Arg (AF .. AF + 1) = "-L") - then - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := - new String'(Arg); - end if; - - -- Pass to gcc for linking program - - Gcc_Linker_Options.Increment_Last; - Gcc_Linker_Options.Table - (Gcc_Linker_Options.Last) := new String'(Arg); - end; - end loop; - end; - - -- Send all multi-character switches not recognized as - -- a special case by gnatlink to the linker/loader stage. - - else - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - end if; - - -- Here if argument is a file name rather than a switch - - else - -- If explicit ali file, capture it - - if Arg'Length > 4 - and then Arg (Arg'Last - 3 .. Arg'Last) = ".ali" - then - if Ali_File_Name = null then - Ali_File_Name := new String'(Arg); - else - Exit_With_Error ("cannot handle more than one ALI file"); - end if; - - -- If target object file, record object file - - elsif Arg'Length > Get_Target_Object_Suffix.all'Length - and then Arg - (Arg'Last - - Get_Target_Object_Suffix.all'Length + 1 .. Arg'Last) - = Get_Target_Object_Suffix.all - then - Linker_Objects.Increment_Last; - Linker_Objects.Table (Linker_Objects.Last) := - new String'(Arg); - - -- If host object file, record object file - -- e.g. accept foo.o as well as foo.obj on VMS target - - elsif Arg'Length > Get_Object_Suffix.all'Length - and then Arg - (Arg'Last - Get_Object_Suffix.all'Length + 1 .. Arg'Last) - = Get_Object_Suffix.all - then - Linker_Objects.Increment_Last; - Linker_Objects.Table (Linker_Objects.Last) := - new String'(Arg); - - -- If corresponding ali file exists, capture it - - elsif Ali_File_Name = null - and then Is_Regular_File (Arg & ".ali") - then - Ali_File_Name := new String'(Arg & ".ali"); - - -- Otherwise assume this is a linker options entry, but - -- see below for interesting adjustment to this assumption. - - else - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Arg); - end if; - end if; - end Process_One_Arg; - - Next_Arg := Next_Arg + 1; - end loop; - - -- If Ada bind file, then compile it with warnings suppressed, because - -- otherwise the with of the main program may cause junk warnings. - - if Ada_Bind_File then - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := new String'("-gnatws"); - end if; - - -- If we did not get an ali file at all, and we had at least one - -- linker option, then assume that was the intended ali file after - -- all, so that we get a nicer message later on. - - if Ali_File_Name = null - and then Linker_Options.Last >= Linker_Options.First - then - Ali_File_Name := - new String'(Linker_Options.Table (Linker_Options.First).all & - ".ali"); - end if; - end Process_Args; - - ------------------------- - -- Process_Binder_File -- - ------------------------- - - procedure Process_Binder_File (Name : String) is - Fd : FILEs; - -- Binder file's descriptor - - Link_Bytes : Integer := 0; - -- Projected number of bytes for the linker command line - - Link_Max : Integer; - pragma Import (C, Link_Max, "__gnat_link_max"); - -- Maximum number of bytes on the command line supported by the OS - -- linker. Passed this limit the response file mechanism must be used - -- if supported. - - Next_Line : String (1 .. 1000); - -- Current line value - - Nlast : Integer; - Nfirst : Integer; - -- Current line slice (the slice does not contain line terminator) - - Last : Integer; - -- Current line last character for shared libraries (without version) - - Objs_Begin : Integer := 0; - -- First object file index in Linker_Objects table - - Objs_End : Integer := 0; - -- Last object file index in Linker_Objects table - - Status : int; - -- Used for various Interfaces.C_Streams calls - - Closing_Status : Boolean; - -- For call to Close - - GNAT_Static : Boolean := False; - -- Save state of -static option - - GNAT_Shared : Boolean := False; - -- Save state of -shared option - - Xlinker_Was_Previous : Boolean := False; - -- Indicate that "-Xlinker" was the option preceding the current - -- option. If True, then the current option is never suppressed. - - -- Rollback data - - -- These data items are used to store current binder file context. - -- The context is composed of the file descriptor position and the - -- current line together with the slice indexes (first and last - -- position) for this line. The rollback data are used by the - -- Store_File_Context and Rollback_File_Context routines below. - -- The file context mechanism interact only with the Get_Next_Line - -- call. For example: - - -- Store_File_Context; - -- Get_Next_Line; - -- Rollback_File_Context; - -- Get_Next_Line; - - -- Both Get_Next_Line calls above will read the exact same data from - -- the file. In other words, Next_Line, Nfirst and Nlast variables - -- will be set with the exact same values. - - RB_File_Pos : long; -- File position - RB_Next_Line : String (1 .. 1000); -- Current line content - RB_Nlast : Integer; -- Slice last index - RB_Nfirst : Integer; -- Slice first index - - Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option"); - -- Pointer to string representing the native linker option which - -- specifies the path where the dynamic loader should find shared - -- libraries. Equal to null string if this system doesn't support it. - - Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import - (C, Object_Library_Ext_Ptr, "__gnat_object_library_extension"); - -- Pointer to string specifying the default extension for - -- object libraries, e.g. Unix uses ".a", VMS uses ".olb". - - Object_File_Option_Ptr : Interfaces.C.Strings.chars_ptr; - pragma Import (C, Object_File_Option_Ptr, "__gnat_object_file_option"); - -- Pointer to a string representing the linker option which specifies - -- the response file. - - Using_GNU_Linker : Boolean; - pragma Import (C, Using_GNU_Linker, "__gnat_using_gnu_linker"); - -- Predicate indicating whether this target uses the GNU linker. In - -- this case we must output a GNU linker compatible response file. - - Opening : aliased constant String := """"; - Closing : aliased constant String := '"' & ASCII.LF; - -- Needed to quote object paths in object list files when GNU linker - -- is used. - - procedure Get_Next_Line; - -- Read the next line from the binder file without the line - -- terminator. - - function Index (S, Pattern : String) return Natural; - -- Return the last occurrence of Pattern in S, or 0 if none - - function Is_Option_Present (Opt : String) return Boolean; - -- Return true if the option Opt is already present in - -- Linker_Options table. - - procedure Store_File_Context; - -- Store current file context, Fd position and current line data. - -- The file context is stored into the rollback data above (RB_*). - -- Store_File_Context can be called at any time, only the last call - -- will be used (i.e. this routine overwrites the file context). - - procedure Rollback_File_Context; - -- Restore file context from rollback data. This routine must be called - -- after Store_File_Context. The binder file context will be restored - -- with the data stored by the last Store_File_Context call. - - ------------------- - -- Get_Next_Line -- - ------------------- - - procedure Get_Next_Line is - Fchars : chars; - - begin - Fchars := fgets (Next_Line'Address, Next_Line'Length, Fd); - - if Fchars = System.Null_Address then - Exit_With_Error ("Error reading binder output"); - end if; - - Nfirst := Next_Line'First; - Nlast := Nfirst; - while Nlast <= Next_Line'Last - and then Next_Line (Nlast) /= ASCII.LF - and then Next_Line (Nlast) /= ASCII.CR - loop - Nlast := Nlast + 1; - end loop; - - Nlast := Nlast - 1; - end Get_Next_Line; - - ----------- - -- Index -- - ----------- - - function Index (S, Pattern : String) return Natural is - Len : constant Natural := Pattern'Length; - - begin - for J in reverse S'First .. S'Last - Len + 1 loop - if Pattern = S (J .. J + Len - 1) then - return J; - end if; - end loop; - - return 0; - end Index; - - ----------------------- - -- Is_Option_Present -- - ----------------------- - - function Is_Option_Present (Opt : String) return Boolean is - begin - for I in 1 .. Linker_Options.Last loop - - if Linker_Options.Table (I).all = Opt then - return True; - end if; - - end loop; - - return False; - end Is_Option_Present; - - --------------------------- - -- Rollback_File_Context -- - --------------------------- - - procedure Rollback_File_Context is - begin - Next_Line := RB_Next_Line; - Nfirst := RB_Nfirst; - Nlast := RB_Nlast; - Status := fseek (Fd, RB_File_Pos, Interfaces.C_Streams.SEEK_SET); - - if Status = -1 then - Exit_With_Error ("Error setting file position"); - end if; - end Rollback_File_Context; - - ------------------------ - -- Store_File_Context -- - ------------------------ - - procedure Store_File_Context is - use type System.CRTL.long; - begin - RB_Next_Line := Next_Line; - RB_Nfirst := Nfirst; - RB_Nlast := Nlast; - RB_File_Pos := ftell (Fd); - - if RB_File_Pos = -1 then - Exit_With_Error ("Error getting file position"); - end if; - end Store_File_Context; - - -- Start of processing for Process_Binder_File - - begin - Fd := fopen (Name'Address, Read_Mode'Address); - - if Fd = NULL_Stream then - Exit_With_Error ("Failed to open binder output"); - end if; - - -- Skip up to the Begin Info line - - loop - Get_Next_Line; - exit when Next_Line (Nfirst .. Nlast) = Begin_Info; - end loop; - - loop - Get_Next_Line; - - -- Go to end when end line is reached (this will happen in - -- High_Integrity_Mode where no -L switches are generated) - - exit when Next_Line (Nfirst .. Nlast) = End_Info; - - if Ada_Bind_File then - Next_Line (Nfirst .. Nlast - 8) := - Next_Line (Nfirst + 8 .. Nlast); - Nlast := Nlast - 8; - end if; - - -- Go to next section when switches are reached - - exit when Next_Line (1) = '-'; - - -- Otherwise we have another object file to collect - - Linker_Objects.Increment_Last; - - -- Mark the positions of first and last object files in case - -- they need to be placed with a named file on systems having - -- linker line limitations. - - if Objs_Begin = 0 then - Objs_Begin := Linker_Objects.Last; - end if; - - Linker_Objects.Table (Linker_Objects.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - - Link_Bytes := Link_Bytes + Nlast - Nfirst + 2; - -- Nlast - Nfirst + 1, for the size, plus one for the space between - -- each arguments. - end loop; - - Objs_End := Linker_Objects.Last; - - -- Let's continue to compute the Link_Bytes, the linker options are - -- part of command line length. - - Store_File_Context; - - while Next_Line (Nfirst .. Nlast) /= End_Info loop - Link_Bytes := Link_Bytes + Nlast - Nfirst + 2; - -- See comment above - Get_Next_Line; - end loop; - - Rollback_File_Context; - - -- On systems that have limitations on handling very long linker lines - -- we make use of the system linker option which takes a list of object - -- file names from a file instead of the command line itself. What we do - -- is to replace the list of object files by the special linker option - -- which then reads the object file list from a file instead. The option - -- to read from a file instead of the command line is only triggered if - -- a conservative threshold is passed. - - if Object_List_File_Required - or else (Object_List_File_Supported - and then Link_Bytes > Link_Max) - then - -- Create a temporary file containing the Ada user object files - -- needed by the link. This list is taken from the bind file - -- and is output one object per line for maximal compatibility with - -- linkers supporting this option. - - Create_Temp_File (Tname_FD, Tname); - - -- ??? File descriptor should be checked to not be Invalid_FD. - -- ??? Status of Write and Close operations should be checked, and - -- failure should occur if a status is wrong. - - -- If target is using the GNU linker we must add a special header - -- and footer in the response file. - - -- The syntax is : INPUT (object1.o object2.o ... ) - - -- Because the GNU linker does not like name with characters such - -- as '!', we must put the object paths between double quotes. - - if Using_GNU_Linker then - declare - GNU_Header : aliased constant String := "INPUT ("; - - begin - Status := Write (Tname_FD, GNU_Header'Address, - GNU_Header'Length); - end; - end if; - - for J in Objs_Begin .. Objs_End loop - - -- Opening quote for GNU linker - - if Using_GNU_Linker then - Status := Write (Tname_FD, Opening'Address, 1); - end if; - - Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address, - Linker_Objects.Table (J).all'Length); - - -- Closing quote for GNU linker - - if Using_GNU_Linker then - Status := Write (Tname_FD, Closing'Address, 2); - - else - Status := Write (Tname_FD, ASCII.LF'Address, 1); - end if; - - Response_File_Objects.Increment_Last; - Response_File_Objects.Table (Response_File_Objects.Last) := - Linker_Objects.Table (J); - end loop; - - -- Handle GNU linker response file footer - - if Using_GNU_Linker then - declare - GNU_Footer : aliased constant String := ")"; - - begin - Status := Write (Tname_FD, GNU_Footer'Address, - GNU_Footer'Length); - end; - end if; - - Close (Tname_FD, Closing_Status); - - -- Add the special objects list file option together with the name - -- of the temporary file (removing the null character) to the objects - -- file table. - - Linker_Objects.Table (Objs_Begin) := - new String'(Value (Object_File_Option_Ptr) & - Tname (Tname'First .. Tname'Last - 1)); - - -- The slots containing these object file names are then removed - -- from the objects table so they do not appear in the link. They - -- are removed by moving up the linker options and non-Ada object - -- files appearing after the Ada object list in the table. - - declare - N : Integer; - - begin - N := Objs_End - Objs_Begin + 1; - - for J in Objs_End + 1 .. Linker_Objects.Last loop - Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J); - end loop; - - Linker_Objects.Set_Last (Linker_Objects.Last - N + 1); - end; - end if; - - -- Process switches and options - - if Next_Line (Nfirst .. Nlast) /= End_Info then - Xlinker_Was_Previous := False; - - loop - if Xlinker_Was_Previous - or else Next_Line (Nfirst .. Nlast) = "-Xlinker" - then - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - - elsif Next_Line (Nfirst .. Nlast) = "-static" then - GNAT_Static := True; - - elsif Next_Line (Nfirst .. Nlast) = "-shared" then - GNAT_Shared := True; - - -- Add binder options only if not already set on the command - -- line. This rule is a way to control the linker options order. - - -- The following test needs comments, why is it VMS specific. - -- The above comment looks out of date ??? - - elsif not (OpenVMS_On_Target - and then - Is_Option_Present (Next_Line (Nfirst .. Nlast))) - then - if Nlast > Nfirst + 2 and then - Next_Line (Nfirst .. Nfirst + 1) = "-L" - then - -- Construct a library search path for use later - -- to locate static gnatlib libraries. - - if Libpath.Last > 1 then - Libpath.Increment_Last; - Libpath.Table (Libpath.Last) := Path_Separator; - end if; - - for I in Nfirst + 2 .. Nlast loop - Libpath.Increment_Last; - Libpath.Table (Libpath.Last) := Next_Line (I); - end loop; - - Linker_Options.Increment_Last; - - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - - elsif Next_Line (Nfirst .. Nlast) = "-ldecgnat" - or else Next_Line (Nfirst .. Nlast) = "-lgnarl" - or else Next_Line (Nfirst .. Nlast) = "-lgnat" - or else Next_Line - (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) = - Shared_Lib ("gnarl") - or else Next_Line - (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) = - Shared_Lib ("gnat") - then - -- If it is a shared library, remove the library version. - -- We will be looking for the static version of the library - -- as it is in the same directory as the shared version. - - if Next_Line (Nlast - Library_Version'Length + 1 .. Nlast) - = Library_Version - then - -- Set Last to point to last character before the - -- library version. - - Last := Nlast - Library_Version'Length - 1; - else - Last := Nlast; - end if; - - -- Given a Gnat standard library, search the - -- library path to find the library location - - declare - File_Path : String_Access; - - Object_Lib_Extension : constant String := - Value (Object_Library_Ext_Ptr); - - File_Name : constant String := "lib" & - Next_Line (Nfirst + 2 .. Last) & - Object_Lib_Extension; - - Run_Path_Opt : constant String := - Value (Run_Path_Option_Ptr); - - GCC_Index : Natural; - Run_Path_Opt_Index : Natural := 0; - - begin - File_Path := - Locate_Regular_File (File_Name, - String (Libpath.Table (1 .. Libpath.Last))); - - if File_Path /= null then - if GNAT_Static then - - -- If static gnatlib found, explicitly - -- specify to overcome possible linker - -- default usage of shared version. - - Linker_Options.Increment_Last; - - Linker_Options.Table (Linker_Options.Last) := - new String'(File_Path.all); - - elsif GNAT_Shared then - if Opt.Run_Path_Option then - -- If shared gnatlib desired, add the - -- appropriate system specific switch - -- so that it can be located at runtime. - - if Run_Path_Opt'Length /= 0 then - -- Output the system specific linker command - -- that allows the image activator to find - -- the shared library at runtime. - -- Also add path to find libgcc_s.so, if - -- relevant. - - -- To find the location of the shared version - -- of libgcc, we look for "gcc-lib" in the - -- path of the library. However, this - -- subdirectory is no longer present in - -- in recent version of GCC. So, we look for - -- the last subdirectory "lib" in the path. - - GCC_Index := - Index (File_Path.all, "gcc-lib"); - - if GCC_Index /= 0 then - -- The shared version of libgcc is - -- located in the parent directory. - - GCC_Index := GCC_Index - 1; - - else - GCC_Index := - Index (File_Path.all, "/lib/"); - - if GCC_Index = 0 then - GCC_Index := - Index (File_Path.all, - Directory_Separator & - "lib" & - Directory_Separator); - end if; - - -- We have found a subdirectory "lib", - -- this is where the shared version of - -- libgcc should be located. - - if GCC_Index /= 0 then - GCC_Index := GCC_Index + 3; - end if; - end if; - - -- Look for an eventual run_path_option in - -- the linker switches. - - for J in reverse 1 .. Linker_Options.Last loop - if Linker_Options.Table (J) /= null - and then - Linker_Options.Table (J)'Length - > Run_Path_Opt'Length - and then - Linker_Options.Table (J) - (1 .. Run_Path_Opt'Length) = - Run_Path_Opt - then - -- We have found a already specified - -- run_path_option: we will add to this - -- switch, because only one - -- run_path_option should be specified. - - Run_Path_Opt_Index := J; - exit; - end if; - end loop; - - -- If there is no run_path_option, we need - -- to add one. - - if Run_Path_Opt_Index = 0 then - Linker_Options.Increment_Last; - end if; - - if GCC_Index = 0 then - if Run_Path_Opt_Index = 0 then - Linker_Options.Table - (Linker_Options.Last) := - new String' - (Run_Path_Opt - & File_Path - (1 .. File_Path'Length - - File_Name'Length)); - - else - Linker_Options.Table - (Run_Path_Opt_Index) := - new String' - (Linker_Options.Table - (Run_Path_Opt_Index).all - & Path_Separator - & File_Path - (1 .. File_Path'Length - - File_Name'Length)); - end if; - - else - if Run_Path_Opt_Index = 0 then - Linker_Options.Table - (Linker_Options.Last) := - new String'(Run_Path_Opt - & File_Path - (1 .. File_Path'Length - - File_Name'Length) - & Path_Separator - & File_Path (1 .. GCC_Index)); - - else - Linker_Options.Table - (Run_Path_Opt_Index) := - new String' - (Linker_Options.Table - (Run_Path_Opt_Index).all - & Path_Separator - & File_Path - (1 .. File_Path'Length - - File_Name'Length) - & Path_Separator - & File_Path (1 .. GCC_Index)); - end if; - end if; - end if; - end if; - - -- Then we add the appropriate -l switch - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - end if; - - else - -- If gnatlib library not found, then - -- add it anyway in case some other - -- mechanimsm may find it. - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - end if; - end; - else - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); - end if; - end if; - - Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker"; - - Get_Next_Line; - exit when Next_Line (Nfirst .. Nlast) = End_Info; - - if Ada_Bind_File then - Next_Line (Nfirst .. Nlast - 8) := - Next_Line (Nfirst + 8 .. Nlast); - Nlast := Nlast - 8; - end if; - end loop; - end if; - - -- If -shared was specified, invoke gcc with -shared-libgcc - - if GNAT_Shared then - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc; - end if; - - Status := fclose (Fd); - end Process_Binder_File; - - ------------------ - -- Write_Header -- - ------------------ - - procedure Write_Header is - begin - if Verbose_Mode then - Write_Eol; - Write_Str ("GNATLINK "); - Write_Str (Gnat_Version_String); - Write_Eol; - Write_Str ("Copyright 1995-" & - Current_Year & - ", Free Software Foundation, Inc"); - Write_Eol; - end if; - end Write_Header; - - ----------------- - -- Write_Usage -- - ----------------- - - procedure Write_Usage is - begin - Write_Header; - - Write_Str ("Usage: "); - Write_Str (Base_Name (Command_Name)); - Write_Str (" switches mainprog.ali [non-Ada-objects] [linker-options]"); - Write_Eol; - Write_Eol; - Write_Line (" mainprog.ali the ALI file of the main program"); - Write_Eol; - Write_Line (" -A Binder generated source file is in Ada (default)"); - Write_Line (" -C Binder generated source file is in C"); - Write_Line (" -f force object file list to be generated"); - Write_Line (" -g Compile binder source file with debug information"); - Write_Line (" -n Do not compile the binder source file"); - Write_Line (" -R Do not use a run_path_option"); - Write_Line (" -v verbose mode"); - Write_Line (" -v -v very verbose mode"); - Write_Eol; - Write_Line (" -o nam Use 'nam' as the name of the executable"); - Write_Line (" -b target Compile the binder source to run on target"); - Write_Line (" -Bdir Load compiler executables from dir"); - - if Is_Supported (Map_File) then - Write_Line (" -Mmap Create map file map"); - Write_Line (" -M Create map file mainprog.map"); - end if; - - Write_Line (" --GCC=comp Use comp as the compiler"); - Write_Line (" --LINK=nam Use 'nam' for the linking rather than 'gcc'"); - Write_Eol; - Write_Line (" [non-Ada-objects] list of non Ada object files"); - Write_Line (" [linker-options] other options for the linker"); - end Write_Usage; - --- Start of processing for Gnatlink - -begin - -- Add the directory where gnatlink is invoked in front of the - -- path, if gnatlink is invoked with directory information. - -- Only do this if the platform is not VMS, where the notion of path - -- does not really exist. - - if not Hostparm.OpenVMS then - declare - Command : constant String := Command_Name; - - begin - for Index in reverse Command'Range loop - if Command (Index) = Directory_Separator then - declare - Absolute_Dir : constant String := - Normalize_Pathname - (Command (Command'First .. Index)); - - PATH : constant String := - Absolute_Dir & - Path_Separator & - Getenv ("PATH").all; - - begin - Setenv ("PATH", PATH); - end; - - exit; - end if; - end loop; - end; - end if; - - Process_Args; - - if Argument_Count = 0 - or else - (Verbose_Mode and then Argument_Count = 1) - then - Write_Usage; - Exit_Program (E_Fatal); - end if; - - if Hostparm.Java_VM then - Gcc := new String'("jgnat"); - Ada_Bind_File := True; - Begin_Info := "-- BEGIN Object file/option list"; - End_Info := "-- END Object file/option list "; - end if; - - -- We always compile with -c - - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-c"); - - -- If the main program is in Ada it is compiled with the following - -- switches: - - -- -gnatA stops reading gnat.adc, since we don't know what - -- pagmas would work, and we do not need it anyway. - - -- -gnatWb allows brackets coding for wide characters - - -- -gnatiw allows wide characters in identifiers. This is needed - -- because bindgen uses brackets encoding for all upper - -- half and wide characters in identifier names. - - if Ada_Bind_File then - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatA"); - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatWb"); - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatiw"); - end if; - - -- Locate all the necessary programs and verify required files are present - - Gcc_Path := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all); - - if Gcc_Path = null then - Exit_With_Error ("Couldn't locate " & Gcc.all); - end if; - - if Linker_Path = null then - Linker_Path := Gcc_Path; - end if; - - if Ali_File_Name = null then - Exit_With_Error ("no ali file given for link"); - end if; - - if not Is_Regular_File (Ali_File_Name.all) then - Exit_With_Error (Ali_File_Name.all & " not found"); - end if; - - -- Get target parameters - - Namet.Initialize; - Csets.Initialize; - Snames.Initialize; - Osint.Add_Default_Search_Dirs; - Targparm.Get_Target_Parameters; - - -- Read the ALI file of the main subprogram if the binder generated - -- file needs to be compiled and no --GCC= switch has been specified. - -- Fetch the back end switches from this ALI file and use these switches - -- to compile the binder generated file - - if Compile_Bind_File and then Standard_Gcc then - - Initialize_ALI; - Name_Len := Ali_File_Name'Length; - Name_Buffer (1 .. Name_Len) := Ali_File_Name.all; - - declare - use Types; - F : constant File_Name_Type := Name_Find; - T : Text_Buffer_Ptr; - A : ALI_Id; - - begin - -- Load the ALI file - - T := Read_Library_Info (F, True); - - -- Read it. Note that we ignore errors, since we only want very - -- limited information from the ali file, and likely a slightly - -- wrong version will be just fine, though in normal operation - -- we don't expect this to happen! - - A := Scan_ALI - (F, - T, - Ignore_ED => False, - Err => False, - Ignore_Errors => True); - - if A /= No_ALI_Id then - for - Index in Units.Table (ALIs.Table (A).First_Unit).First_Arg .. - Units.Table (ALIs.Table (A).First_Unit).Last_Arg - loop - -- Do not compile with the front end switches except for --RTS - -- if the binder generated file is in Ada. - - declare - Arg : String_Ptr renames Args.Table (Index); - begin - if not Is_Front_End_Switch (Arg.all) - or else - (Ada_Bind_File - and then Arg'Length > 5 - and then Arg (Arg'First + 2 .. Arg'First + 5) = "RTS=") - then - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table - (Binder_Options_From_ALI.Last) := String_Access (Arg); - end if; - end; - end loop; - end if; - end; - end if; - - Write_Header; - - -- If no output name specified, then use the base name of .ali file name - - if Output_File_Name = null then - Output_File_Name := - new String'(Base_Name (Ali_File_Name.all) - & Get_Target_Debuggable_Suffix.all); - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'("-o"); - - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Output_File_Name.all); - end if; - - -- Warn if main program is called "test", as that may be a built-in command - -- on Unix. On non-Unix systems executables have a suffix, so the warning - -- will not appear. However, do not warn in the case of a cross compiler. - - -- Assume this is a cross tool if the executable name is not gnatlink - - if Base_Name (Command_Name) = "gnatlink" - and then Output_File_Name.all = "test" - then - Error_Msg ("warning: executable name """ & Output_File_Name.all - & """ may conflict with shell command"); - end if; - - -- If -M switch was specified, add the switches to create the map file - - if Create_Map_File then - declare - Map_Name : constant String := Base_Name (Ali_File_Name.all) & ".map"; - Switches : String_List_Access; - - begin - Convert (Map_File, Map_Name, Switches); - - if Switches /= null then - for J in Switches'Range loop - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := Switches (J); - end loop; - end if; - end; - end if; - - -- Perform consistency checks - - -- Transform the .ali file name into the binder output file name - - Make_Binder_File_Names : declare - Fname : constant String := Base_Name (Ali_File_Name.all); - Fname_Len : Integer := Fname'Length; - - function Get_Maximum_File_Name_Length return Integer; - pragma Import (C, Get_Maximum_File_Name_Length, - "__gnat_get_maximum_file_name_length"); - - Maximum_File_Name_Length : constant Integer := - Get_Maximum_File_Name_Length; - - Bind_File_Prefix : Types.String_Ptr; - -- Contains prefix used for bind files - - begin - -- Set prefix - - if not Ada_Bind_File then - Bind_File_Prefix := new String'("b_"); - elsif OpenVMS_On_Target then - Bind_File_Prefix := new String'("b__"); - else - Bind_File_Prefix := new String'("b~"); - end if; - - -- If the length of the binder file becomes too long due to - -- the addition of the "b?" prefix, then truncate it. - - if Maximum_File_Name_Length > 0 then - while Fname_Len > - Maximum_File_Name_Length - Bind_File_Prefix.all'Length - loop - Fname_Len := Fname_Len - 1; - end loop; - end if; - - declare - Fnam : constant String := - Bind_File_Prefix.all & - Fname (Fname'First .. Fname'First + Fname_Len - 1); - - begin - if Ada_Bind_File then - Binder_Spec_Src_File := new String'(Fnam & ".ads"); - Binder_Body_Src_File := new String'(Fnam & ".adb"); - Binder_Ali_File := new String'(Fnam & ".ali"); - else - Binder_Body_Src_File := new String'(Fnam & ".c"); - end if; - - Binder_Obj_File := new String'(Fnam & Get_Target_Object_Suffix.all); - end; - - if Fname_Len /= Fname'Length then - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := new String'("-o"); - Binder_Options.Increment_Last; - Binder_Options.Table (Binder_Options.Last) := Binder_Obj_File; - end if; - end Make_Binder_File_Names; - - Process_Binder_File (Binder_Body_Src_File.all & ASCII.NUL); - - -- Compile the binder file. This is fast, so we always do it, unless - -- specifically told not to by the -n switch - - if Compile_Bind_File then - Bind_Step : declare - Success : Boolean; - Args : Argument_List - (1 .. Binder_Options_From_ALI.Last + Binder_Options.Last + 1); - - begin - for J in 1 .. Binder_Options_From_ALI.Last loop - Args (J) := Binder_Options_From_ALI.Table (J); - end loop; - - for J in 1 .. Binder_Options.Last loop - Args (Binder_Options_From_ALI.Last + J) := - Binder_Options.Table (J); - end loop; - - Args (Args'Last) := Binder_Body_Src_File; - - if Verbose_Mode then - Write_Str (Base_Name (Gcc_Path.all)); - - for J in Args'Range loop - Write_Str (" "); - Write_Str (Args (J).all); - end loop; - - Write_Eol; - end if; - - GNAT.OS_Lib.Spawn (Gcc_Path.all, Args, Success); - - if not Success then - Exit_Program (E_Fatal); - end if; - end Bind_Step; - end if; - - -- Now, actually link the program - - -- Skip this step for now on the JVM since the Java interpreter will do - -- the actual link at run time. We might consider packing all class files - -- in a .zip file during this step. - - if not Hostparm.Java_VM then - Link_Step : declare - Num_Args : Natural := - (Linker_Options.Last - Linker_Options.First + 1) + - (Gcc_Linker_Options.Last - Gcc_Linker_Options.First + 1) + - (Linker_Objects.Last - Linker_Objects.First + 1); - Stack_Op : Boolean := False; - IDENT_Op : Boolean := False; - - begin - -- Remove duplicate stack size setting from the Linker_Options - -- table. The stack setting option "-Xlinker --stack=R,C" can be - -- found in one line when set by a pragma Linker_Options or in two - -- lines ("-Xlinker" then "--stack=R,C") when set on the command - -- line. We also check for the "-Wl,--stack=R" style option. - - -- We must remove the second stack setting option instance - -- because the one on the command line will always be the first - -- one. And any subsequent stack setting option will overwrite the - -- previous one. This is done especially for GNAT/NT where we set - -- the stack size for tasking programs by a pragma in the NT - -- specific tasking package System.Task_Primitives.Oparations. - - -- Note: This is not a FOR loop that runs from Linker_Options.First - -- to Linker_Options.Last, since operations within the loop can - -- modify the length of the table. - - Clean_Link_Option_Set : declare - J : Natural := Linker_Options.First; - Shared_Libgcc_Seen : Boolean := False; - - begin - while J <= Linker_Options.Last loop - - if Linker_Options.Table (J).all = "-Xlinker" - and then J < Linker_Options.Last - and then Linker_Options.Table (J + 1)'Length > 8 - and then Linker_Options.Table (J + 1) (1 .. 8) = "--stack=" - then - if Stack_Op then - Linker_Options.Table (J .. Linker_Options.Last - 2) := - Linker_Options.Table (J + 2 .. Linker_Options.Last); - Linker_Options.Decrement_Last; - Linker_Options.Decrement_Last; - Num_Args := Num_Args - 2; - - else - Stack_Op := True; - end if; - end if; - - -- Remove duplicate -shared-libgcc switch - - if Linker_Options.Table (J).all = Shared_Libgcc_String then - if Shared_Libgcc_Seen then - Linker_Options.Table (J .. Linker_Options.Last - 1) := - Linker_Options.Table (J + 1 .. Linker_Options.Last); - Linker_Options.Decrement_Last; - Num_Args := Num_Args - 1; - - else - Shared_Libgcc_Seen := True; - end if; - end if; - - -- Here we just check for a canonical form that matches the - -- pragma Linker_Options set in the NT runtime. - - if (Linker_Options.Table (J)'Length > 17 - and then Linker_Options.Table (J) (1 .. 17) - = "-Xlinker --stack=") - or else - (Linker_Options.Table (J)'Length > 12 - and then Linker_Options.Table (J) (1 .. 12) - = "-Wl,--stack=") - then - if Stack_Op then - Linker_Options.Table (J .. Linker_Options.Last - 1) := - Linker_Options.Table (J + 1 .. Linker_Options.Last); - Linker_Options.Decrement_Last; - Num_Args := Num_Args - 1; - - else - Stack_Op := True; - end if; - end if; - - -- Remove duplicate IDENTIFICATION directives (VMS) - - if Linker_Options.Table (J)'Length > 27 - and then Linker_Options.Table (J) (1 .. 28) - = "--for-linker=IDENTIFICATION=" - then - if IDENT_Op then - Linker_Options.Table (J .. Linker_Options.Last - 1) := - Linker_Options.Table (J + 1 .. Linker_Options.Last); - Linker_Options.Decrement_Last; - Num_Args := Num_Args - 1; - else - IDENT_Op := True; - end if; - end if; - - J := J + 1; - end loop; - end Clean_Link_Option_Set; - - -- Prepare arguments for call to linker - - Call_Linker : declare - Success : Boolean; - Args : Argument_List (1 .. Num_Args + 1); - Index : Integer := Args'First; - - begin - Args (Index) := Binder_Obj_File; - - -- Add the object files and any -largs libraries - - for J in Linker_Objects.First .. Linker_Objects.Last loop - Index := Index + 1; - Args (Index) := Linker_Objects.Table (J); - end loop; - - -- Add the linker options from the binder file - - for J in Linker_Options.First .. Linker_Options.Last loop - Index := Index + 1; - Args (Index) := Linker_Options.Table (J); - end loop; - - -- Finally add the libraries from the --GCC= switch - - for J in Gcc_Linker_Options.First .. Gcc_Linker_Options.Last loop - Index := Index + 1; - Args (Index) := Gcc_Linker_Options.Table (J); - end loop; - - if Verbose_Mode then - Write_Str (Linker_Path.all); - - for J in Args'Range loop - Write_Str (" "); - Write_Str (Args (J).all); - end loop; - - Write_Eol; - - -- If we are on very verbose mode (-v -v) and a response file - -- is used we display its content. - - if Very_Verbose_Mode and then Tname_FD /= Invalid_FD then - Write_Eol; - Write_Str ("Response file (" & - Tname (Tname'First .. Tname'Last - 1) & - ") content : "); - Write_Eol; - - for J in - Response_File_Objects.First .. - Response_File_Objects.Last - loop - Write_Str (Response_File_Objects.Table (J).all); - Write_Eol; - end loop; - - Write_Eol; - end if; - end if; - - GNAT.OS_Lib.Spawn (Linker_Path.all, Args, Success); - - -- Delete the temporary file used in conjuction with linking if - -- one was created. See Process_Bind_File for details. - - if Tname_FD /= Invalid_FD then - Delete (Tname); - end if; - - if not Success then - Error_Msg ("cannot call " & Linker_Path.all); - Exit_Program (E_Fatal); - end if; - end Call_Linker; - end Link_Step; - end if; - - -- Only keep the binder output file and it's associated object - -- file if compiling with the -g option. These files are only - -- useful if debugging. - - if not Debug_Flag_Present then - if Binder_Ali_File /= null then - Delete (Binder_Ali_File.all & ASCII.NUL); - end if; - - if Binder_Spec_Src_File /= null then - Delete (Binder_Spec_Src_File.all & ASCII.NUL); - end if; - - Delete (Binder_Body_Src_File.all & ASCII.NUL); - - if not Hostparm.Java_VM then - Delete (Binder_Obj_File.all & ASCII.NUL); - end if; - end if; - - Exit_Program (E_Success); - -exception - when X : others => - Write_Line (Exception_Information (X)); - Exit_With_Error ("INTERNAL ERROR. Please report"); -end Gnatlink; |