------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T L I N K -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1996-2002 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, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, 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 Ada.Exceptions; use Ada.Exceptions; with ALI; use ALI; with Gnatvsn; use Gnatvsn; with Hostparm; with Namet; use Namet; with Osint; use Osint; with Output; use Output; with Switch; use Switch; with System; use System; with Table; with Types; with Ada.Command_Line; use Ada.Command_Line; with GNAT.OS_Lib; use GNAT.OS_Lib; with Interfaces.C_Streams; use Interfaces.C_Streams; procedure Gnatlink is 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. subtype chars_ptr is System.Address; 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 Object_List_File_Supported : Boolean; pragma Import (C, Object_List_File_Supported, "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 : in String) return String; -- Return just the file name part without the extension (if present). procedure Delete (Name : in String); -- Wrapper to unlink as status is ignored by this application. procedure Error_Msg (Message : in String); -- Output the error or warning Message procedure Exit_With_Error (Error : in 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 : in String); -- Reads the binder file and extracts linker arguments. function Value (chars : chars_ptr) return String; -- Return NUL-terminated string chars as an Ada string. procedure Write_Usage; -- Show user the program options. --------------- -- Base_Name -- --------------- function Base_Name (File_Name : in 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 : in String) is Status : int; begin Status := unlink (Name'Address); end Delete; --------------- -- Error_Msg -- --------------- procedure Error_Msg (Message : in 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 : in String) is begin Error_Msg (Error); Exit_Program (E_Fatal); end Exit_With_Error; ------------------ -- Process_Args -- ------------------ procedure Process_Args is Next_Arg : Integer; begin -- Loop through arguments of gnatlink command Next_Arg := 1; loop exit when Next_Arg > Argument_Count; Process_One_Arg : declare Arg : String := Argument (Next_Arg); begin -- Case of argument which is a switch -- We definitely need section by section comments here ??? if 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 (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 = 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 : 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 '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 '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 : 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 : String := Program_Args.all (J).all; AF : 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; -- 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 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; elsif Is_Regular_File (Arg & ".ali") and then Ali_File_Name = null then Ali_File_Name := new String'(Arg & ".ali"); 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); 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; end Process_Args; ------------------------- -- Process_Binder_File -- ------------------------- procedure Process_Binder_File (Name : in String) is Fd : FILEs; Link_Bytes : Integer := 0; Link_Max : Integer; pragma Import (C, Link_Max, "link_max"); Next_Line : String (1 .. 1000); Nlast : Integer; Nfirst : Integer; Objs_Begin : Integer := 0; Objs_End : Integer := 0; Status : int; N : Integer; GNAT_Static : Boolean := False; -- Save state of -static option. GNAT_Shared : Boolean := False; -- Save state of -shared option. Run_Path_Option_Ptr : Address; pragma Import (C, Run_Path_Option_Ptr, "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 : Address; pragma Import (C, Object_Library_Ext_Ptr, "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 : Address; pragma Import (C, Object_File_Option_Ptr, "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, "using_gnu_linker"); -- Predicate indicating whether this target uses the GNU linker. In -- this case we must output a GNU linker compatible response file. procedure Get_Next_Line; -- Read the next line from the binder file without the line -- terminator. function Is_Option_Present (Opt : in String) return Boolean; -- Return true if the option Opt is already present in -- Linker_Options table. 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; function Is_Option_Present (Opt : in 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; -- 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 -- No_Run_Time 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; end loop; Objs_End := Linker_Objects.Last; -- 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); -- 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 ... ) 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 Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address, Linker_Objects.Table (J).all'Length); Status := Write (Tname_FD, ASCII.LF'Address, 1); 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); -- 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. 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 if; -- Process switches and options if Next_Line (Nfirst .. Nlast) /= End_Info then loop if 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. elsif not 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" then -- 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 : String := "lib" & Next_Line (Nfirst + 2 .. Nlast) & Object_Lib_Extension; 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 shared gnatlib desired, add the -- appropriate system specific switch -- so that it can be located at runtime. declare Run_Path_Opt : constant String := Value (Run_Path_Option_Ptr); begin 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. Linker_Options.Increment_Last; Linker_Options.Table (Linker_Options.Last) := new String'(Run_Path_Opt & File_Path (1 .. File_Path'Length - File_Name'Length)); end if; Linker_Options.Increment_Last; Linker_Options.Table (Linker_Options.Last) := new String'(Next_Line (Nfirst .. Nlast)); end; 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; 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; Status := fclose (Fd); end Process_Binder_File; ----------- -- Value -- ----------- function Value (chars : chars_ptr) return String is function Strlen (chars : chars_ptr) return Natural; pragma Import (C, Strlen); begin if chars = Null_Address then return ""; else declare subtype Result_Type is String (1 .. Strlen (chars)); Result : Result_Type; for Result'Address use chars; begin return Result; end; end if; end Value; ----------------- -- Write_Usage -- ----------------- procedure Write_Usage is begin 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 (" -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"); 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 if Argument_Count = 0 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; Process_Args; -- 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 ("Required 'name'.ali not present."); end if; if not Is_Regular_File (Ali_File_Name.all) then Exit_With_Error (Ali_File_Name.all & " not found."); -- Read the ALI file of the main subprogram if the binder generated -- file is in Ada, it need 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 elsif Ada_Bind_File and then Compile_Bind_File and then Standard_Gcc then -- Do some initializations Initialize_ALI; Namet.Initialize; 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 -- Osint.Add_Default_Search_Dirs; -- Load the ALI file T := Read_Library_Info (F, True); -- Read it A := Scan_ALI (F, T, False, False, False); 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 if not Is_Front_End_Switch (Args.Table (Index).all) then Binder_Options_From_ALI.Increment_Last; Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := String_Access (Args.Table (Index)); end if; end loop; end if; end; end if; if Verbose_Mode then Write_Eol; Write_Str ("GNATLINK "); Write_Str (Gnat_Version_String); Write_Str (" Copyright 1996-2002 Free Software Foundation, Inc."); Write_Eol; end if; -- If there wasn't an output specified, then use the base name of -- the .ali file name. if Output_File_Name = null then Output_File_Name := new String'(Base_Name (Ali_File_Name.all) & Get_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 that if the executable name is not gnatlink, this is a cross -- tool. 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; -- Perform consistency checks -- Transform the .ali file name into the binder output file name. Make_Binder_File_Names : declare Fname : 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 : Integer := Get_Maximum_File_Name_Length; Second_Char : Character; -- Second character of name of files begin -- Set proper second character of file name if not Ada_Bind_File then Second_Char := '_'; elsif Hostparm.OpenVMS then Second_Char := '$'; else Second_Char := '~'; 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 - 2 loop Fname_Len := Fname_Len - 1; end loop; end if; if Ada_Bind_File then Binder_Spec_Src_File := new String'('b' & Second_Char & Fname (Fname'First .. Fname'First + Fname_Len - 1) & ".ads"); Binder_Body_Src_File := new String'('b' & Second_Char & Fname (Fname'First .. Fname'First + Fname_Len - 1) & ".adb"); Binder_Ali_File := new String'('b' & Second_Char & Fname (Fname'First .. Fname'First + Fname_Len - 1) & ".ali"); else Binder_Body_Src_File := new String'('b' & Second_Char & Fname (Fname'First .. Fname'First + Fname_Len - 1) & ".c"); end if; Binder_Obj_File := new String'('b' & Second_Char & Fname (Fname'First .. Fname'First + Fname_Len - 1) & Get_Object_Suffix.all); 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. for J in Linker_Options.First .. 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; -- 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 .. 27) = "--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; end loop; -- 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;