[Ada] Add a new gnat tool vxlink

VxLink is a helper tool used as a wrapper around g++/gcc to build
VxWorks DKM (Downloadable Kernel Modules).

Such DKM is a partially linked object that includes entry points for
constructors and destructors.

This tool thus uses g++ to generate an intermediate partially linked
object, retrieves the list of constructors and destructors in it and
produces a C file that lists those ctors/dtors in a way that is
understood be VxWorks kernel. It then links this file with the
intermediate object to produce a valid DKM.

2018-08-21  Jerome Lambourg  <lambourg@adacore.com>

gcc/ada/

	* vxlink-bind.adb, vxlink-bind.ads, vxlink-link.adb,
	vxlink-link.ads, vxlink-main.adb, vxlink.adb, vxlink.ads: Add a
	new tool vxlink to handle VxWorks constructors in DKMs.
	* gcc-interface/Makefile.in: add rules to build vxlink

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@263736 138bc75d-0d04-0410-961f-82ee72b054a4

9 files changed, 1189 insertions, 0 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 503aa062230..8d0da5a6e35 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2018-08-21  Jerome Lambourg  <lambourg@adacore.com>
+
+	* vxlink-bind.adb, vxlink-bind.ads, vxlink-link.adb,
+	vxlink-link.ads, vxlink-main.adb, vxlink.adb, vxlink.ads: Add a
+	new tool vxlink to handle VxWorks constructors in DKMs.
+	* gcc-interface/Makefile.in: add rules to build vxlink
+
 2018-08-21  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch6.adb (Analyze_Subprogram_Body_Helper, Mask_Type):
diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in
index 9a52e6d8edb..4d870c2f9ce 100644
--- a/gcc/ada/gcc-interface/Makefile.in
+++ b/gcc/ada/gcc-interface/Makefile.in
@@ -441,6 +441,11 @@ ifeq ($(ENABLE_VXADDR2LINE),true)
 	  TOOLSCASE=cross top_buildir=../../.. \
 	  ../../vxaddr2line$(exeext)
 endif
+ifeq ($(ENABLE_VXLINK),true)
+	$(MAKE) -C tools -f ../Makefile $(TOOLS_FLAGS_TO_PASS) \
+	  TOOLSCASE=cross top_build=../../.. \
+	  ../../vxlink$(exeext)
+endif
 
 common-tools: ../stamp-tools
 	$(GNATMAKE) -j0 -c -b $(ADA_INCLUDES) \
@@ -478,6 +483,12 @@ common-tools: ../stamp-tools
 	$(GNATLINK) -v vxaddr2line -o $@ \
 	  --GCC="$(CC) $(ADA_INCLUDES)" --LINK="$(GCC_LINK)" ../targext.o $(CLIB)
 
+../../vxlink$(exeext): ../stamp-tools
+	$(GNATMAKE) -c  $(ADA_INCLUDES) vxlink-main --GCC="$(CC) $(ALL_ADAFLAGS)"
+	$(GNATBIND) $(ADA_INCLUDES) $(GNATBIND_FLAGS) vxlink-main
+	$(GNATLINK) -v vxlink-main -o $@ \
+	  --GCC="$(CC) $(ADA_INCLUDES)" --LINK="$(GCC_LINK)"
+
 gnatmake-re: ../stamp-tools
 	$(GNATMAKE) -j0 $(ADA_INCLUDES) -u sdefault --GCC="$(CC) $(MOST_ADA_FLAGS)"
 	$(GNATMAKE) -j0 -c $(ADA_INCLUDES) gnatmake --GCC="$(CC) $(ALL_ADAFLAGS)"
diff --git a/gcc/ada/vxlink-bind.adb b/gcc/ada/vxlink-bind.adb
new file mode 100644
index 00000000000..9f456944506
--- /dev/null
+++ b/gcc/ada/vxlink-bind.adb
@@ -0,0 +1,390 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                          V X L I N K . B I N D                           --
+--                                                                          --
+--                                 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.Text_IO;       use Ada.Text_IO;
+with Ada.IO_Exceptions;
+with Ada.Strings.Fixed;
+
+with GNAT.Regpat;       use GNAT.Regpat;
+
+package body VxLink.Bind is
+
+   function Split_Lines (S : String) return Strings_List.Vector;
+
+   function Split (S : String; C : Character) return Strings_List.Vector;
+
+   function Parse_Nm_Output (S : String) return Symbol_Sets.Set;
+
+   procedure Emit_Module_Dtor
+     (FP : File_Type);
+
+   procedure Emit_CDtor
+     (FP  : File_Type;
+      Var : String;
+      Set : Symbol_Sets.Set);
+
+   -----------------
+   -- Split_Lines --
+   -----------------
+
+   function Split_Lines (S : String) return Strings_List.Vector
+   is
+      Last : Natural := S'First;
+      Ret  : Strings_List.Vector;
+   begin
+      for J in S'Range loop
+         if S (J) = ASCII.CR
+           and then J < S'Last
+           and then S (J + 1) = ASCII.LF
+         then
+            Ret.Append (S (Last .. J - 1));
+            Last := J + 2;
+         elsif S (J) = ASCII.LF then
+            Ret.Append (S (Last .. J - 1));
+            Last := J + 1;
+         end if;
+      end loop;
+
+      if Last <= S'Last then
+         Ret.Append (S (Last .. S'Last));
+      end if;
+
+      return Ret;
+   end Split_Lines;
+
+   -----------
+   -- Split --
+   -----------
+
+   function Split (S : String; C : Character) return Strings_List.Vector
+   is
+      Last : Natural := S'First;
+      Ret  : Strings_List.Vector;
+   begin
+      for J in S'Range loop
+         if S (J) = C then
+            if J > Last then
+               Ret.Append (S (Last .. J - 1));
+            end if;
+
+            Last := J + 1;
+         end if;
+      end loop;
+
+      if Last <= S'Last then
+         Ret.Append (S (Last .. S'Last));
+      end if;
+
+      return Ret;
+   end Split;
+
+   ---------------------
+   -- Parse_Nm_Output --
+   ---------------------
+
+   function Parse_Nm_Output (S : String) return Symbol_Sets.Set
+   is
+      Nm_Regexp        : constant Pattern_Matcher :=
+                           Compile ("^[0-9A-Za-z]* ([a-zA-Z]) (.*)$");
+      type CDTor_Type is
+        (CTOR_Diab,
+         CTOR_Gcc,
+         DTOR_Diab,
+         DTOR_Gcc);
+      subtype CTOR_Type is CDTor_Type range CTOR_Diab .. CTOR_Gcc;
+      CTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
+                           Compile ("^__?STI__*([0-9]+)_");
+      CTOR_GCC_Regexp  : aliased constant Pattern_Matcher :=
+                           Compile ("^__?GLOBAL_.I._*([0-9]+)_");
+      DTOR_DIAB_Regexp : aliased constant Pattern_Matcher :=
+                           Compile ("^__?STD__*([0-9]+)_");
+      DTOR_GCC_Regexp  : aliased constant Pattern_Matcher :=
+                           Compile ("^__?GLOBAL_.D._*([0-9]+)_");
+      type Regexp_Access is access constant Pattern_Matcher;
+      CDTor_Regexps    : constant array (CDTor_Type) of Regexp_Access :=
+                           (CTOR_Diab => CTOR_DIAB_Regexp'Access,
+                            CTOR_Gcc  => CTOR_GCC_Regexp'Access,
+                            DTOR_Diab => DTOR_DIAB_Regexp'Access,
+                            DTOR_Gcc  => DTOR_GCC_Regexp'Access);
+      Result           : Symbol_Sets.Set;
+
+   begin
+      for Line of Split_Lines (S) loop
+         declare
+            Sym     : Symbol;
+            Nm_Grps : Match_Array (0 .. 2);
+            Ctor_Grps : Match_Array (0 .. 1);
+         begin
+            Match (Nm_Regexp, Line, Nm_Grps);
+
+            if Nm_Grps (0) /= No_Match then
+               declare
+                  Sym_Type : constant Character :=
+                               Line (Nm_Grps (1).First);
+                  Sym_Name : constant String :=
+                               Line (Nm_Grps (2).First .. Nm_Grps (2).Last);
+               begin
+                  Sym :=
+                    (Name     => To_Unbounded_String (Sym_Name),
+                     Cat      => Sym_Type,
+                     Internal => False,
+                     Kind     => Sym_Other,
+                     Priority => -1);
+
+                  for J in CDTor_Regexps'Range loop
+                     Match (CDTor_Regexps (J).all, Sym_Name, Ctor_Grps);
+
+                     if Ctor_Grps (0) /= No_Match then
+                        if J in CTOR_Type then
+                           Sym.Kind := Sym_Ctor;
+                        else
+                           Sym.Kind := Sym_Dtor;
+                        end if;
+
+                        Sym.Priority := Integer'Value
+                          (Line (Ctor_Grps (1).First .. Ctor_Grps (1).Last));
+
+                        exit;
+                     end if;
+                  end loop;
+
+                  Result.Include (Sym);
+               end;
+            end if;
+         end;
+      end loop;
+
+      return Result;
+   end Parse_Nm_Output;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize
+     (Binder      : out VxLink_Binder;
+      Object_File : String)
+   is
+      Args                   : Arguments_List;
+      Module_Dtor_Not_Needed : Boolean := False;
+      Module_Dtor_Needed     : Boolean := False;
+
+   begin
+      Args.Append (Nm);
+      Args.Append (Object_File);
+
+      declare
+         Output  : constant String := Run (Args);
+         Symbols : Symbol_Sets.Set;
+      begin
+         if Is_Error_State then
+            return;
+         end if;
+
+         Symbols := Parse_Nm_Output (Output);
+
+         for Sym of Symbols loop
+            if Sym.Kind = Sym_Ctor then
+               Binder.Constructors.Insert (Sym);
+            elsif Sym.Kind = Sym_Dtor then
+               Binder.Destructors.Insert (Sym);
+            elsif Match ("_?__.*_atexit$", To_String (Sym.Name)) then
+               if Sym.Cat = 'T' then
+                  Module_Dtor_Not_Needed := True;
+               elsif Sym.Cat = 'U' then
+                  Module_Dtor_Needed := True;
+               end if;
+            end if;
+         end loop;
+
+         Binder.Module_Dtor_Needed :=
+           not Module_Dtor_Not_Needed and then Module_Dtor_Needed;
+      end;
+   end Initialize;
+
+   --------------------
+   -- Parse_Tag_File --
+   --------------------
+
+   procedure Parse_Tag_File
+     (Binder : in out VxLink_Binder;
+      File   : String)
+   is
+      FP   : Ada.Text_IO.File_Type;
+
+   begin
+      Open
+        (FP,
+         Mode => In_File,
+         Name => File);
+      loop
+         declare
+            Line   : constant String :=
+                      Ada.Strings.Fixed.Trim
+                        (Get_Line (FP), Ada.Strings.Both);
+            Tokens : Strings_List.Vector;
+
+         begin
+            if Line'Length = 0 then
+               --  Skip empty lines
+               null;
+
+            elsif Line (Line'First) = '#' then
+               --  Skip comment
+               null;
+
+            else
+               Tokens := Split (Line, ' ');
+               if Tokens.First_Element = "section" then
+                  --  Sections are not used for tags, only when building
+                  --  kernels. So skip for now
+                  null;
+               else
+                  Binder.Tags_List.Append (Line);
+               end if;
+            end if;
+         end;
+      end loop;
+
+   exception
+      when Ada.IO_Exceptions.End_Error =>
+         Close (FP);
+      when others =>
+         Log_Error ("Cannot open file " & File &
+                      ". DKM tags won't be generated");
+   end Parse_Tag_File;
+
+   ----------------------
+   -- Emit_Module_Dtor --
+   ----------------------
+
+   procedure Emit_Module_Dtor
+     (FP : File_Type)
+   is
+      Dtor_Name : constant String := "_GLOBAL__D_65536_0_cxa_finalize";
+   begin
+      Put_Line (FP, "extern void __cxa_finalize(void *);");
+      Put_Line (FP, "static void " & Dtor_Name & "()");
+      Put_Line (FP, "{");
+      Put_Line (FP, "  __cxa_finalize(&__dso_handle);");
+      Put_Line (FP, "}");
+      Put_Line (FP, "");
+   end Emit_Module_Dtor;
+
+   ----------------
+   -- Emit_CDtor --
+   ----------------
+
+   procedure Emit_CDtor
+     (FP  : File_Type;
+      Var : String;
+      Set : Symbol_Sets.Set)
+   is
+   begin
+      for Sym of Set loop
+         if not Sym.Internal then
+            Put_Line (FP, "extern void " & To_String (Sym.Name) & "();");
+         end if;
+      end loop;
+
+      New_Line (FP);
+
+      Put_Line (FP, "extern void (*" & Var & "[])();");
+      Put_Line (FP, "void (*" & Var & "[])() =");
+      Put_Line (FP, "  {");
+      for Sym of Set loop
+         Put_Line (FP, "  " & To_String (Sym.Name) & ",");
+      end loop;
+      Put_Line (FP, "  0};");
+      New_Line (FP);
+   end Emit_CDtor;
+
+   ---------------
+   -- Emit_CTDT --
+   ---------------
+
+   procedure Emit_CTDT
+     (Binder    : in out VxLink_Binder;
+      Namespace : String)
+   is
+      FP         : Ada.Text_IO.File_Type;
+      CDtor_File : constant String := Namespace & "-cdtor.c";
+   begin
+      Binder.CTDT_File := To_Unbounded_String (CDtor_File);
+      Create
+        (File => FP,
+         Name => CDtor_File);
+      Put_Line (FP, "#if defined(_HAVE_TOOL_XTORS)");
+      Put_Line (FP, "#include <vxWorks.h>");
+      if Binder.Module_Dtor_Needed then
+         Put_Line (FP, "#define _WRS_NEED_CALL_CXA_FINALIZE");
+      end if;
+      Put_Line (FP, "#include TOOL_HEADER (toolXtors.h)");
+      Put_Line (FP, "#else");
+      Put_Line (FP, "");
+
+      if Binder.Module_Dtor_Needed then
+         Emit_Module_Dtor (FP);
+      end if;
+
+      Emit_CDtor (FP, "_ctors", Binder.Constructors);
+      Emit_CDtor (FP, "_dtors", Binder.Destructors);
+
+      Put_Line (FP, "#endif");
+
+      if not Binder.Tags_List.Is_Empty then
+         New_Line (FP);
+         Put_Line (FP, "/* build variables */");
+         Put_Line (FP, "__asm(""  .section \"".wrs_build_vars\"",\""a\"""");");
+         for Tag of Binder.Tags_List loop
+            Put_Line (FP, "__asm(""  .ascii \""" & Tag & "\"""");");
+            Put_Line (FP, "__asm(""  .byte 0"");");
+         end loop;
+         Put_Line (FP, "__asm(""  .ascii \""end\"""");");
+         Put_Line (FP, "__asm(""  .byte 0"");");
+      end if;
+
+      Close (FP);
+
+   exception
+      when others =>
+         Close (FP);
+         Set_Error_State ("Internal error");
+         raise;
+   end Emit_CTDT;
+
+   ---------------
+   -- CTDT_File --
+   ---------------
+
+   function CTDT_File (Binder : VxLink_Binder) return String
+   is
+   begin
+      return To_String (Binder.CTDT_File);
+   end CTDT_File;
+
+end VxLink.Bind;
diff --git a/gcc/ada/vxlink-bind.ads b/gcc/ada/vxlink-bind.ads
new file mode 100644
index 00000000000..7e6a1b09e48
--- /dev/null
+++ b/gcc/ada/vxlink-bind.ads
@@ -0,0 +1,87 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                          V X L I N K . B I N D                           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     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;
+
+private with Ada.Containers.Ordered_Sets;
+private with Ada.Strings.Unbounded;
+
+package VxLink.Bind is
+
+   type VxLink_Binder is private;
+
+   procedure Initialize
+     (Binder      : out VxLink_Binder;
+      Object_File : String);
+
+   procedure Parse_Tag_File
+     (Binder : in out VxLink_Binder;
+      File   : String);
+
+   procedure Emit_CTDT
+     (Binder    : in out VxLink_Binder;
+      Namespace : String);
+
+   function CTDT_File (Binder : VxLink_Binder) return String;
+
+private
+
+   use Ada.Strings.Unbounded;
+
+   type Symbol_Kind is (Sym_Ctor, Sym_Dtor, Sym_Other);
+
+   type Symbol is record
+      Name     : Unbounded_String;
+      Cat      : Character;
+      Internal : Boolean;
+      Kind     : Symbol_Kind;
+      Priority : Integer;
+   end record;
+
+   function "=" (S1, S2 : Symbol) return Boolean
+   is (S1.Name = S2.Name and then S1.Cat = S2.Cat);
+
+   function "<" (S1, S2 : Symbol) return Boolean
+   is (if S1.Priority /= S2.Priority
+       then S1.Priority < S2.Priority
+       elsif S1.Name /= S2.Name
+       then S1.Name < S2.Name
+       else S1.Cat < S2.Cat);
+
+   package Symbol_Sets is new Ada.Containers.Ordered_Sets
+     (Symbol,
+      "<" => "<",
+      "=" => "=");
+
+   type VxLink_Binder is record
+      CTDT_File          : Unbounded_String;
+      Constructors       : Symbol_Sets.Set;
+      Destructors        : Symbol_Sets.Set;
+      Module_Dtor_Needed : Boolean;
+      EH_Frame_Needed    : Boolean;
+      Tags_List          : Strings_List.Vector;
+   end record;
+
+end VxLink.Bind;
diff --git a/gcc/ada/vxlink-link.adb b/gcc/ada/vxlink-link.adb
new file mode 100644
index 00000000000..5211074aee8
--- /dev/null
+++ b/gcc/ada/vxlink-link.adb
@@ -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;
diff --git a/gcc/ada/vxlink-link.ads b/gcc/ada/vxlink-link.ads
new file mode 100644
index 00000000000..4c46f487270
--- /dev/null
+++ b/gcc/ada/vxlink-link.ads
@@ -0,0 +1,63 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                          V X L I N K . L I N K                           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     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;
+
+private with Ada.Strings.Unbounded;
+
+package VxLink.Link is
+
+   type VxLink_Linker is private;
+
+   procedure Initialize
+     (Linker : out VxLink_Linker);
+
+   function Needs_CDtor (Linker : VxLink_Linker) return Boolean;
+
+   function Partial_Object (Linker : VxLink_Linker) return String;
+
+   function Namespace (Linker : VxLink_Linker) return String;
+
+   procedure Do_Initial_Link
+     (Linker : VxLink_Linker);
+
+   procedure Do_Final_Link
+     (Linker   : VxLink_Linker;
+      Ctdt_Obj : String);
+
+private
+
+   use Ada.Strings.Unbounded;
+
+   type VxLink_Linker is record
+      Args_Leading  : Arguments_List;
+      Args_Trailing : Arguments_List;
+      Add_CDtors    : Boolean := True;
+      Dest_Object   : Unbounded_String;
+      Dest_Base     : Unbounded_String;
+      Partial_Obj   : Unbounded_String;
+   end record;
+
+end VxLink.Link;
diff --git a/gcc/ada/vxlink-main.adb b/gcc/ada/vxlink-main.adb
new file mode 100644
index 00000000000..04a22c3ef0c
--- /dev/null
+++ b/gcc/ada/vxlink-main.adb
@@ -0,0 +1,81 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                          V X L I N K . M A I N                           --
+--                                                                          --
+--                                 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  VxLink is a helper tool used as a wrapper around g++/gcc to build VxWorks
+--  DKM (Downloadable Kernel Modules).
+--  Such DKM is a partially linked object that contains entry points for
+--  constructors and destructors. This tool thus uses g++ to generate an
+--  intermediate partially linked object, retrieves the list of constructors
+--  and destructors in it and produces a C file that lists those ctors/dtors
+--  in a way that is understood be VxWorks kernel. It then links this file
+--  with the intermediate object to produce a valid DKM.
+
+pragma Ada_2012;
+
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
+with VxLink.Link; use VxLink.Link;
+with VxLink.Bind; use VxLink.Bind;
+
+procedure VxLink.Main is
+   Linker  : VxLink_Linker;
+   Binder  : VxLink_Binder;
+   VSB_Dir : String_Access := Getenv ("VSB_DIR");
+begin
+   Initialize (Linker);
+
+   if Is_Error_State then
+      return;
+   end if;
+
+   Do_Initial_Link (Linker);
+
+   if Is_Error_State then
+      return;
+   end if;
+
+   if not Needs_CDtor (Linker) then
+      --  Initial link is enough, let's return
+      return;
+   end if;
+
+   if VSB_Dir /= null and then VSB_Dir'Length > 0 then
+      declare
+         DKM_Tag_File : constant String :=
+                          Normalize_Pathname
+                            ("krnl/tags/dkm.tags", VSB_Dir.all);
+      begin
+         if Is_Regular_File (DKM_Tag_File) then
+            Parse_Tag_File (Binder, DKM_Tag_File);
+         end if;
+      end;
+   end if;
+
+   Initialize (Binder, Object_File => Partial_Object (Linker));
+   Emit_CTDT (Binder, Namespace => Namespace (Linker));
+
+   Do_Final_Link (Linker, CTDT_File (Binder));
+   Free (VSB_Dir);
+end VxLink.Main;
diff --git a/gcc/ada/vxlink.adb b/gcc/ada/vxlink.adb
new file mode 100644
index 00000000000..400ad225b8e
--- /dev/null
+++ b/gcc/ada/vxlink.adb
@@ -0,0 +1,288 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               V X 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;
+with Ada.Strings.Unbounded;     use Ada.Strings.Unbounded;
+with Ada.Text_IO;
+
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.Expect;               use GNAT.Expect;
+with GNAT.OS_Lib;               use GNAT.OS_Lib;
+
+package body VxLink is
+
+   Target_Triplet : Unbounded_String := Null_Unbounded_String;
+   Verbose        : Boolean := False;
+   Error_State    : Boolean := False;
+
+   function Triplet return String;
+
+   function Which (Exe : String) return String;
+
+   -------------
+   -- Triplet --
+   -------------
+
+   function Triplet return String is
+   begin
+      if Target_Triplet = Null_Unbounded_String then
+         declare
+            Exe : constant String := File_Name (Ada.Command_Line.Command_Name);
+         begin
+            for J in reverse Exe'Range loop
+               if Exe (J) = '-' then
+                  Target_Triplet := To_Unbounded_String (Exe (Exe'First .. J));
+                  exit;
+               end if;
+            end loop;
+         end;
+      end if;
+
+      return To_String (Target_Triplet);
+   end Triplet;
+
+   -----------
+   -- Which --
+   -----------
+
+   function Which (Exe : String) return String
+   is
+      Suffix   : GNAT.OS_Lib.String_Access := Get_Executable_Suffix;
+      Basename : constant String := Exe & Suffix.all;
+      Path     : GNAT.OS_Lib.String_Access := Getenv ("PATH");
+      Last     : Natural := Path'First;
+
+   begin
+      Free (Suffix);
+
+      for J in Path'Range loop
+         if Path (J) = Path_Separator then
+            declare
+               Full : constant String := Normalize_Pathname
+                 (Name           => Basename,
+                  Directory      => Path (Last .. J - 1),
+                  Resolve_Links  => False,
+                  Case_Sensitive => True);
+            begin
+               if Is_Executable_File (Full) then
+                  Free (Path);
+
+                  return Full;
+               end if;
+            end;
+
+            Last := J + 1;
+         end if;
+      end loop;
+
+      Free (Path);
+
+      return "";
+   end Which;
+
+   -----------------
+   -- Set_Verbose --
+   -----------------
+
+   procedure Set_Verbose (Value : Boolean)
+   is
+   begin
+      Verbose := Value;
+   end Set_Verbose;
+
+   ----------------
+   -- Is_Verbose --
+   ----------------
+
+   function Is_Verbose return Boolean
+   is
+   begin
+      return Verbose;
+   end Is_Verbose;
+
+   ---------------------
+   -- Set_Error_State --
+   ---------------------
+
+   procedure Set_Error_State (Message : String)
+   is
+   begin
+      Log_Error ("Error: " & Message);
+      Error_State := True;
+      Ada.Command_Line.Set_Exit_Status (1);
+   end Set_Error_State;
+
+   --------------------
+   -- Is_Error_State --
+   --------------------
+
+   function Is_Error_State return Boolean
+   is
+   begin
+      return Error_State;
+   end Is_Error_State;
+
+   --------------
+   -- Log_Info --
+   --------------
+
+   procedure Log_Info (S : String)
+   is
+   begin
+      if Verbose then
+         Ada.Text_IO.Put_Line (S);
+      end if;
+   end Log_Info;
+
+   ---------------
+   -- Log_Error --
+   ---------------
+
+   procedure Log_Error (S : String)
+   is
+   begin
+      Ada.Text_IO.Put_Line (Ada.Text_IO.Standard_Error, S);
+   end Log_Error;
+
+   ---------
+   -- Run --
+   ---------
+
+   procedure Run (Arguments : Arguments_List)
+   is
+      Output : constant String := Run (Arguments);
+   begin
+      if not Is_Error_State then
+         --  In case of erroneous execution, the function version of run will
+         --  have already displayed the output
+         Ada.Text_IO.Put (Output);
+      end if;
+   end Run;
+
+   ---------
+   -- Run --
+   ---------
+
+   function Run (Arguments : Arguments_List) return String
+   is
+      Args       : GNAT.OS_Lib.Argument_List_Access :=
+                     new GNAT.OS_Lib.Argument_List
+                       (1 .. Natural (Arguments.Length) - 1);
+      Base       : constant String := Base_Name (Arguments.First_Element);
+      Status     : aliased Integer := 0;
+      Debug_Line : Unbounded_String;
+      Add_Quotes : Boolean;
+
+   begin
+      if Verbose then
+         Append (Debug_Line, Base);
+      end if;
+
+      for J in Arguments.First_Index + 1 .. Arguments.Last_Index loop
+         declare
+            Arg : String renames Arguments.Element (J);
+         begin
+            Args (J - 1) := new String'(Arg);
+
+            if Verbose then
+               Add_Quotes := False;
+
+               for K in Arg'Range loop
+                  if Arg (K) = ' ' then
+                     Add_Quotes := True;
+                     exit;
+                  end if;
+               end loop;
+
+               Append (Debug_Line, ' ');
+
+               if Add_Quotes then
+                  Append (Debug_Line, '"' & Arg & '"');
+               else
+                  Append (Debug_Line, Arg);
+               end if;
+            end if;
+         end;
+      end loop;
+
+      if Verbose then
+         Ada.Text_IO.Put_Line (To_String (Debug_Line));
+      end if;
+
+      declare
+         Ret : constant String :=
+                 Get_Command_Output
+                   (Command    => Arguments.First_Element,
+                    Arguments  => Args.all,
+                    Input      => "",
+                    Status     => Status'Access,
+                    Err_To_Out => True);
+      begin
+         GNAT.OS_Lib.Free (Args);
+
+         if Status /= 0 then
+            Ada.Text_IO.Put_Line (Ret);
+            Set_Error_State
+              (Base_Name (Arguments.First_Element) &
+                 " returned" & Status'Image);
+         end if;
+
+         return Ret;
+      end;
+   end Run;
+
+   ---------
+   -- Gcc --
+   ---------
+
+   function Gcc return String
+   is
+   begin
+      return Which (Triplet & "gcc");
+   end Gcc;
+
+   ---------
+   -- Gxx --
+   ---------
+
+   function Gxx return String
+   is
+   begin
+      return Which (Triplet & "g++");
+   end Gxx;
+
+   --------
+   -- Nm --
+   --------
+
+   function Nm return String
+   is
+   begin
+      return Which (Triplet & "nm");
+   end Nm;
+
+end VxLink;
diff --git a/gcc/ada/vxlink.ads b/gcc/ada/vxlink.ads
new file mode 100644
index 00000000000..37ae5d7023a
--- /dev/null
+++ b/gcc/ada/vxlink.ads
@@ -0,0 +1,68 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                               V X L I N K                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  See vxlink-main.adb for a description of the tool.
+--
+--  This package contains only common utility functions used by the other
+--  child packages.
+
+pragma Ada_2012;
+
+with Ada.Containers.Indefinite_Vectors;
+
+package VxLink is
+
+   package Strings_List is new Ada.Containers.Indefinite_Vectors
+     (Positive, String);
+
+   subtype Arguments_List is Strings_List.Vector;
+
+   procedure Set_Verbose (Value : Boolean);
+   function Is_Verbose return Boolean;
+
+   procedure Set_Error_State (Message : String);
+   function Is_Error_State return Boolean;
+
+   procedure Log_Info (S : String);
+   procedure Log_Error (S : String);
+
+   procedure Run (Arguments : Arguments_List);
+
+   function Run (Arguments : Arguments_List) return String;
+
+   function Gcc return String;
+   --  Current toolchain's gcc command
+
+   function Gxx return String;
+   --  Current toolchain's g++ command
+
+   function Nm return String;
+   --  Current toolchain's nm command
+
+   function Ends_With (Str, Suffix : String) return Boolean
+   is (Str'Length >= Suffix'Length
+       and then Str (Str'Last - Suffix'Length + 1 .. Str'Last) = Suffix);
+
+end VxLink;