------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- V X L I N K . L I N K -- -- -- -- B o d y -- -- -- -- Copyright (C) 2018, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- -- for more details. You should have received a copy of the GNU General -- -- Public License distributed with GNAT; see file COPYING3. If not, go to -- -- http://www.gnu.org/licenses for a complete copy of the license. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ pragma Ada_2012; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; use GNAT.Directory_Operations; package body VxLink.Link is Gcc : constant String := VxLink.Gcc; ---------------- -- Initialize -- ---------------- procedure Initialize (Linker : out VxLink_Linker) is Leading : Boolean := True; Next_Is_Object : Boolean := False; begin for J in 1 .. Ada.Command_Line.Argument_Count loop declare Arg : String renames Argument (J); begin if Next_Is_Object then Next_Is_Object := False; Linker.Dest_Object := To_Unbounded_String (Arg); Leading := False; elsif Argument (J) = "-o" then Next_Is_Object := True; elsif Argument (J) = "-noauto-register" then -- Filter out this argument, and do not generate _ctors/_dtors Linker.Add_CDtors := False; elsif Arg = "-v" and then not Is_Verbose then -- first -v means VxLink should be verbose, two -v passes -v to -- the linker. Set_Verbose (True); else if Arg = "-nostdlib" or Arg = "-nostartfiles" then Linker.Add_CDtors := False; end if; if Leading then Linker.Args_Leading.Append (Arg); else Linker.Args_Trailing.Append (Arg); end if; end if; end; end loop; if Linker.Dest_Object = Null_Unbounded_String then Set_Error_State ("no output object is defined"); elsif Linker.Add_CDtors then -- We'll need to create intermediate artefacts, so we'll use the -- destination object as base namespace just in case we have -- several link operations in the same directory declare Obj : constant String := Base_Name (To_String (Linker.Dest_Object)); begin for J in reverse Obj'Range loop if Obj (J) = '.' then Linker.Dest_Base := To_Unbounded_String (Obj (Obj'First .. J - 1)); exit; end if; end loop; Linker.Partial_Obj := Linker.Dest_Base & "-partial.o"; end; end if; end Initialize; ----------------- -- Needs_CDtor -- ----------------- function Needs_CDtor (Linker : VxLink_Linker) return Boolean is begin return Linker.Add_CDtors; end Needs_CDtor; -------------------- -- Partial_Object -- -------------------- function Partial_Object (Linker : VxLink_Linker) return String is begin return To_String (Linker.Partial_Obj); end Partial_Object; --------------- -- Namespace -- --------------- function Namespace (Linker : VxLink_Linker) return String is begin return To_String (Linker.Dest_Base); end Namespace; --------------------- -- Do_Initial_Link -- --------------------- procedure Do_Initial_Link (Linker : VxLink_Linker) is Args : Arguments_List; Gxx_Path : constant String := Gxx; begin if Is_Error_State then return; end if; if Gxx_Path'Length /= 0 then Args.Append (Gxx); else Args.Append (Gcc); end if; Args.Append (Linker.Args_Leading); Args.Append ("-o"); if Linker.Add_CDtors then Args.Append (To_String (Linker.Partial_Obj)); else Args.Append (To_String (Linker.Dest_Object)); end if; Args.Append (Linker.Args_Trailing); if not Linker.Add_CDtors then Args.Append ("-nostartfiles"); end if; Run (Args); end Do_Initial_Link; ------------------- -- Do_Final_Link -- ------------------- procedure Do_Final_Link (Linker : VxLink_Linker; Ctdt_Obj : String) is Args : Arguments_List; begin if not Linker.Add_CDtors then return; end if; if Is_Error_State then return; end if; Args.Append (Gcc); Args.Append ("-nostdlib"); Args.Append (Ctdt_Obj); Args.Append (To_String (Linker.Partial_Obj)); Args.Append ("-o"); Args.Append (To_String (Linker.Dest_Object)); Run (Args); end Do_Final_Link; end VxLink.Link;