Skip to content

R
riscv-gcc-1
Commit 5ec8edb5 by Jerome Lambourg Committed by Pierre-Marie de Rodat
Options

[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
parent 084e3bd1
Showing with 799 additions and 0 deletions
gcc/ada/ChangeLog
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):
......
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)"
......
gcc/ada/vxlink-bind.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/vxlink-link.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/vxlink-link.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/vxlink-main.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/vxlink.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
gcc/ada/vxlink.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment