diff gcc/ada/vxlink-link.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/vxlink-link.adb	Thu Oct 25 07:37:49 2018 +0900
@@ -0,0 +1,194 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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;