--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/ada/vxlink-bind.adb	Thu Oct 25 07:37:49 2018 +0900
@@ -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;