From: Jerome Lambourg Date: Tue, 21 Aug 2018 14:49:49 +0000 (+0000) Subject: [Ada] Add a new gnat tool vxlink X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5ec8edb56ea77f8627b6fc7b9f95751d27cd9162;p=gcc.git [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 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 From-SVN: r263736 --- 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 + + * 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 * 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 "); + 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;