From 8db5c10786bca404c5d1e129090ea9fea25531d2 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Thu, 14 Jul 2016 08:21:18 +0200 Subject: Add commands to build vpi modules (WIP) --- src/ghdldrv/default_pathes.ads.in | 3 + src/ghdldrv/ghdl_jit.adb | 2 + src/ghdldrv/ghdllocal.adb | 7 +- src/ghdldrv/ghdllocal.ads | 8 ++ src/ghdldrv/ghdlvpi.adb | 211 ++++++++++++++++++++++++++++++++++++++ src/ghdldrv/ghdlvpi.ads | 20 ++++ src/grt/grt-cvpi.c | 21 ++-- 7 files changed, 263 insertions(+), 9 deletions(-) create mode 100644 src/ghdldrv/ghdlvpi.adb create mode 100644 src/ghdldrv/ghdlvpi.ads (limited to 'src') diff --git a/src/ghdldrv/default_pathes.ads.in b/src/ghdldrv/default_pathes.ads.in index 7f471a5ed..a7c3d15f7 100644 --- a/src/ghdldrv/default_pathes.ads.in +++ b/src/ghdldrv/default_pathes.ads.in @@ -36,4 +36,7 @@ package Default_Pathes is "@COMPILER_DEBUG@"; Post_Processor : constant String := "@POST_PROCESSOR@"; + + Shared_Library_Extension : constant String := + "@SOEXT@"; end Default_Pathes; diff --git a/src/ghdldrv/ghdl_jit.adb b/src/ghdldrv/ghdl_jit.adb index ba7087492..d80b7a4f8 100644 --- a/src/ghdldrv/ghdl_jit.adb +++ b/src/ghdldrv/ghdl_jit.adb @@ -19,6 +19,7 @@ with Ghdlmain; with Ghdllocal; with Ghdlprint; with Ghdlrun; +with Ghdlvpi; with Ortho_Jit; procedure Ghdl_Jit is @@ -28,6 +29,7 @@ begin Ghdlmain.Version_String := new String'(Ortho_Jit.Get_Jit_Name & " code generator"); Ghdlrun.Register_Commands; + Ghdlvpi.Register_Commands; Ghdllocal.Register_Commands; Ghdlprint.Register_Commands; Ghdlmain.Register_Commands; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 15facb867..906bdc046 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -198,6 +198,11 @@ package body Ghdllocal is return Pathname'First - 1; end Get_Basename_Pos; + function Is_Basename (Pathname : String) return Boolean is + begin + return Get_Basename_Pos (Pathname) < Pathname'First; + end Is_Basename; + -- Simple lower case conversion, used to compare with "bin". function To_Lower (S : String) return String is @@ -336,7 +341,7 @@ package body Ghdllocal is -- If the command name is a relative path, deduce prefix from it -- and current path. - if Get_Basename_Pos (Prog_Path) >= Prog_Path'First then + if not Is_Basename (Prog_Path) then if Is_Executable_File (Prog_Path) then Set_Prefix_From_Program_Path (Get_Current_Dir & Directory_Separator & Prog_Path); diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 43f2de8cb..0809035b1 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -78,6 +78,11 @@ package Ghdllocal is -- if none. function Get_Basename_Pos (Pathname : String) return Natural; + -- Return TRUE iff PATHNAME is a command name: a path name without path + -- component. Usually these command names must be search on the command + -- path (PATH). + function Is_Basename (Pathname : String) return Boolean; + -- Build a filename based on FILE. If IN_WORK is true, the result is -- the concatenation of the workdir, the basename of FILE and SUFFIX. -- If IN_WORK is false, the result is the concatenation of FILE and SUFFIX. @@ -104,6 +109,9 @@ package Ghdllocal is -- Setup standard libaries path. If LOAD is true, then load them now. procedure Setup_Libraries (Load : Boolean); + -- Set Exec_Prefix from program name. Called by Setup_Libraries. + procedure Set_Exec_Prefix; + -- Setup library, analyze FILES, and if SAVE_LIBRARY is set save the -- work library only procedure Analyze_Files (Files : Argument_List; Save_Library : Boolean); diff --git a/src/ghdldrv/ghdlvpi.adb b/src/ghdldrv/ghdlvpi.adb new file mode 100644 index 000000000..12edcb2d5 --- /dev/null +++ b/src/ghdldrv/ghdlvpi.adb @@ -0,0 +1,211 @@ +-- GHDL driver - compile and link wrappers for VPI. +-- Copyright (C) 2016 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT 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 +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Text_IO; use Ada.Text_IO; +with GNAT.OS_Lib; use GNAT.OS_Lib; +with Ada.Command_Line; use Ada.Command_Line; +with Ghdlmain; use Ghdlmain; +with Ghdllocal; +with Default_Pathes; + +package body Ghdlvpi is + + -- A command that accepts '-v'. + type Command_Flag_Type is abstract new Command_Type with record + Flag_Verbose : Boolean := False; + end record; + + procedure Decode_Option (Cmd : in out Command_Flag_Type; + Option : String; + Arg : String; + Res : out Option_Res); + + procedure Decode_Option (Cmd : in out Command_Flag_Type; + Option : String; + Arg : String; + Res : out Option_Res) + is + pragma Unreferenced (Arg); + begin + if Option = "-v" then + Cmd.Flag_Verbose := True; + Res := Option_Ok; + else + Res := Option_Bad; + end if; + end Decode_Option; + + -- Return the include directory. + function Get_Vpi_Include_Dir return String is + begin + -- Compute install path + Ghdllocal.Set_Exec_Prefix; + + return Ghdllocal.Exec_Prefix.all & Directory_Separator & "include"; + end Get_Vpi_Include_Dir; + + -- Return the include directory. + function Get_Vpi_Lib_Dir return String is + begin + if Ghdllocal.Exec_Prefix = null then + -- Compute install path (only once). + Ghdllocal.Set_Exec_Prefix; + end if; + + return Ghdllocal.Exec_Prefix.all & Directory_Separator & "lib"; + end Get_Vpi_Lib_Dir; + + procedure Spawn_Compile (User_Args : Argument_List; + Extra_Args : Argument_List; + Verbose : Boolean) + is + Cargs : Argument_List (1 .. User_Args'Length + Extra_Args'Length); + Program_Name : String_Access; + Nbr_Args : Natural; + Status : Integer; + begin + Nbr_Args := 0; + + -- Extract compiler name. + if User_Args'First > User_Args'Last then + Error ("missing compiler name"); + else + Program_Name := User_Args (User_Args'First); + if Ghdllocal.Is_Basename (Program_Name.all) then + -- For a command name (without path component), search on the + -- path. + Program_Name := Locate_Exec_On_Path (Program_Name.all); + else + -- For a relative or absolute path, use the path directly. + null; + end if; + end if; + + -- Copy user args. + for I in User_Args'First + 1 .. User_Args'Last loop + Nbr_Args := Nbr_Args + 1; + Cargs (Nbr_Args) := User_Args (I); + end loop; + + -- Copy extra args. + for I in Extra_Args'Range loop + Nbr_Args := Nbr_Args + 1; + Cargs (Nbr_Args) := Extra_Args (I); + end loop; + + -- Display command (if verbose) + if Verbose then + Put (Program_Name.all); + for I in Cargs'First .. Nbr_Args loop + Put (' '); + Put (Cargs (I).all); + end loop; + New_Line; + end if; + + -- Execute command + Status := Spawn (Program_Name.all, Cargs (Cargs'First .. Nbr_Args)); + Set_Exit_Status (Exit_Status (Status)); + end Spawn_Compile; + + -- Command --vpi-compile + type Command_Vpi_Compile is new Command_Flag_Type with null record; + function Decode_Command (Cmd : Command_Vpi_Compile; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Vpi_Compile) return String; + procedure Perform_Action (Cmd : in out Command_Vpi_Compile; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Vpi_Compile; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--vpi-compile"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Vpi_Compile) return String + is + pragma Unreferenced (Cmd); + begin + return "--vpi-compile CMD ARGS Compile with VPI include path"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Vpi_Compile; + Args : Argument_List) + is + Extra_Args : Argument_List (1 .. 1); + begin + Extra_Args (1) := new String'("-I" & Get_Vpi_Include_Dir); + + Spawn_Compile (Args, Extra_Args, Cmd.Flag_Verbose); + end Perform_Action; + + -- Command --vpi-link + type Command_Vpi_Link is new Command_Flag_Type with null record; + function Decode_Command (Cmd : Command_Vpi_Link; Name : String) + return Boolean; + function Get_Short_Help (Cmd : Command_Vpi_Link) return String; + procedure Perform_Action (Cmd : in out Command_Vpi_Link; + Args : Argument_List); + + function Decode_Command (Cmd : Command_Vpi_Link; Name : String) + return Boolean + is + pragma Unreferenced (Cmd); + begin + return Name = "--vpi-link"; + end Decode_Command; + + function Get_Short_Help (Cmd : Command_Vpi_Link) return String + is + pragma Unreferenced (Cmd); + begin + return "--vpi-link CMD ARGS Link with VPI library"; + end Get_Short_Help; + + procedure Perform_Action (Cmd : in out Command_Vpi_Link; + Args : Argument_List) + is + use Default_Pathes; + Is_Unix : constant Boolean := Shared_Library_Extension = ".so"; + Is_Darwin : constant Boolean := Shared_Library_Extension = ".dylib"; + Extra_Args : Argument_List (1 .. 4); + Nbr : Natural; + begin + Extra_Args (1) := new String'("--shared"); + Extra_Args (2) := new String'("-L" & Get_Vpi_Lib_Dir); + Extra_Args (3) := new String'("-lghdlvpi"); + Nbr := 3; + + if Is_Unix or Is_Darwin then + -- On linux/unix, add rpath. + Nbr := Nbr + 1; + Extra_Args (Nbr) := new String' + ("-Wl,-rpath," & Get_Vpi_Lib_Dir); + end if; + + Spawn_Compile (Args, Extra_Args (1 .. Nbr), Cmd.Flag_Verbose); + end Perform_Action; + + procedure Register_Commands is + begin + Register_Command (new Command_Vpi_Compile); + Register_Command (new Command_Vpi_Link); + end Register_Commands; +end Ghdlvpi; diff --git a/src/ghdldrv/ghdlvpi.ads b/src/ghdldrv/ghdlvpi.ads new file mode 100644 index 000000000..24eafbf78 --- /dev/null +++ b/src/ghdldrv/ghdlvpi.ads @@ -0,0 +1,20 @@ +-- GHDL driver - compile and link wrappers for VPI. +-- Copyright (C) 2016 Tristan Gingold +-- +-- GHDL is free software; you can redistribute it and/or modify it under +-- the terms of the GNU General Public License as published by the Free +-- Software Foundation; either version 2, or (at your option) any later +-- version. +-- +-- GHDL is distributed in the hope that it will be useful, but WITHOUT 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 +-- along with GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +package Ghdlvpi is + procedure Register_Commands; +end Ghdlvpi; diff --git a/src/grt/grt-cvpi.c b/src/grt/grt-cvpi.c index e122e1b4c..2a1a6cd36 100644 --- a/src/grt/grt-cvpi.c +++ b/src/grt/grt-cvpi.c @@ -130,18 +130,19 @@ module_error (void) } #endif +#if defined (__APPLE__) +/* On Darwin: look in rpath. */ +#define LIBNAME "@rpath/libghdlvpi" DSO_EXT +#else +#define LIBNAME "libghdlvpi" DSO_EXT +#endif + +static const char libghdlvpi_name[] = LIBNAME; + int loadVpiModule (const char* modulename) { - static const char libghdlvpi_name[] = "@executable_path/libghdlvpi" DSO_EXT; static void *libghdlvpi_mod; - - static const char * const vpitablenames[] = - { - "_vlog_startup_routines", // with leading underscore: MacOSX - "vlog_startup_routines" // w/o leading underscore: Linux - }; - int i; void *vpimod; @@ -161,6 +162,10 @@ loadVpiModule (const char* modulename) No need to load the library several times. */ if (libghdlvpi_mod == NULL) { + /* TODO: on windows, use SetDllDirectory with: + - install dir (libdir) => add -DLIBDIR=xxx + - exec path\lib => see windows_default_path + */ libghdlvpi_mod = module_open (libghdlvpi_name); if (libghdlvpi_mod != NULL) { -- cgit v1.2.3