[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 From-SVN: r263736
This commit is contained in:
Jerome Lambourg
Pierre-Marie de Rodat
parent
084e3bd183
commit
5ec8edb56e
|
|
@ -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):
|
||||
|
|
|
|||
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
Loading…
Reference in New Issue