ghdlsynth: add command to get libghdl paths.

4 files changed, 97 insertions, 22 deletions

diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb
index e082a8c4e..a022464d5 100644
--- a/src/ghdldrv/ghdlmain.adb
+++ b/src/ghdldrv/ghdlmain.adb
@@ -24,6 +24,7 @@ with Bug;
 with Types; use Types;
 with Errorout; use Errorout;
 with Errorout.Console;
+with Default_Paths;
 
 package body Ghdlmain is
    procedure Init (Cmd : in out Command_Type)
@@ -363,6 +364,37 @@ package body Ghdlmain is
       end if;
    end Decode_Command_Options;
 
+   Is_Windows : constant Boolean :=
+     Default_Paths.Shared_Library_Extension = ".dll";
+
+   function Convert_Path_To_Unix (Path : String) return String is
+   begin
+      if Is_Windows then
+         declare
+            Res : String := Path;
+         begin
+            --  Convert path separators.
+            for I in Res'Range loop
+               if Res (I) = '\' then
+                  Res (I) := '/';
+               end if;
+            end loop;
+            --  Convert C: to /C/
+            if Res'Length > 2
+              and then (Res (Res'First) in 'a' .. 'z'
+                          or else Res (Res'First) in 'A' .. 'Z')
+              and then Res (Res'First + 1) = ':'
+            then
+               Res (Res'First + 1) := '/';
+               return '/' & Res;
+            end if;
+            return Res;
+         end;
+      else
+         return Path;
+      end if;
+   end Convert_Path_To_Unix;
+
    procedure Main
    is
       use Ada.Command_Line;
diff --git a/src/ghdldrv/ghdlmain.ads b/src/ghdldrv/ghdlmain.ads
index 894c6aad4..24bd185be 100644
--- a/src/ghdldrv/ghdlmain.ads
+++ b/src/ghdldrv/ghdlmain.ads
@@ -99,6 +99,11 @@ package Ghdlmain is
    type String_Cst_Acc is access constant String;
    Version_String : String_Cst_Acc := null;
 
+   --  On windows, convert PATH to a unix path, so that a unix shell will
+   --  convert it correctly to a windows path.
+   --  Return PATH on non-windows platforms.
+   function Convert_Path_To_Unix (Path : String) return String;
+
    --  Registers all commands in this package.
    procedure Register_Commands;
 end Ghdlmain;
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 87fde5b43..3fd19c2b8 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -25,6 +25,8 @@ with Ghdlmain; use Ghdlmain;
 with Options; use Options;
 with Errorout;
 with Errorout.Console;
+with Version;
+with Default_Paths;
 
 with Libraries;
 with Flags;
@@ -261,9 +263,65 @@ package body Ghdlsynth is
       end case;
    end Perform_Action;
 
+   function Get_Libghdl_Name return String
+   is
+      Libghdl_Version : String := Version.Ghdl_Ver;
+   begin
+      for I in Libghdl_Version'Range loop
+         if Libghdl_Version (I) = '.' or Libghdl_Version (I) = '-' then
+            Libghdl_Version (I) := '_';
+         end if;
+      end loop;
+      return "libghdl-" & Libghdl_Version
+        & Default_Paths.Shared_Library_Extension;
+   end Get_Libghdl_Name;
+
+   function Get_Libghdl_Path return String is
+   begin
+      if Ghdllocal.Exec_Prefix = null then
+         --  Compute install path (only once).
+         Ghdllocal.Set_Exec_Prefix_From_Program_Name;
+      end if;
+
+      return Ghdllocal.Exec_Prefix.all & Directory_Separator & "lib"
+        & Directory_Separator & Get_Libghdl_Name;
+   end Get_Libghdl_Path;
+
+   function Get_Libghdl_Include_Dir return String is
+   begin
+      --  Compute install path
+      Ghdllocal.Set_Exec_Prefix_From_Program_Name;
+
+      return Ghdllocal.Exec_Prefix.all & Directory_Separator & "include";
+   end Get_Libghdl_Include_Dir;
+
    procedure Register_Commands is
    begin
       Ghdlmain.Register_Command (new Command_Synth);
+      Register_Command
+        (new Command_Str_Disp'
+           (Command_Type with
+            Cmd_Str => new String'
+              ("--libghdl-name"),
+            Help_Str => new String'
+              ("--libghdl-name  Display libghdl name"),
+            Disp => Get_Libghdl_Name'Access));
+      Register_Command
+        (new Command_Str_Disp'
+           (Command_Type with
+            Cmd_Str => new String'
+              ("--libghdl-library-path"),
+            Help_Str => new String'
+              ("--libghdl-library-path  Display libghdl library path"),
+            Disp => Get_Libghdl_Path'Access));
+      Register_Command
+        (new Command_Str_Disp'
+           (Command_Type with
+            Cmd_Str => new String'
+              ("--libghdl-include-dir"),
+            Help_Str => new String'
+              ("--libghdl-include-dir  Display libghdl include directory"),
+            Disp => Get_Libghdl_Include_Dir'Access));
    end Register_Commands;
 
    procedure Init_For_Ghdl_Synth is
diff --git a/src/ghdldrv/ghdlvpi.adb b/src/ghdldrv/ghdlvpi.adb
index 3ff5bff49..295b7300e 100644
--- a/src/ghdldrv/ghdlvpi.adb
+++ b/src/ghdldrv/ghdlvpi.adb
@@ -32,7 +32,6 @@ package body Ghdlvpi is
    --  of tuning for another OS.
    Is_Unix : constant Boolean := Shared_Library_Extension = ".so";
    Is_Darwin : constant Boolean := Shared_Library_Extension = ".dylib";
-   Is_Windows : constant Boolean := Shared_Library_Extension = ".dll";
 
    --  Return the include directory.
    function Get_Vpi_Include_Dir return String is
@@ -56,28 +55,9 @@ package body Ghdlvpi is
 
    --  Return the lib directory, but unixify the path (for a unix shell in
    --  windows).
-   function Get_Vpi_Lib_Dir_Unix return String
-   is
-      Res : String := Get_Vpi_Lib_Dir;
+   function Get_Vpi_Lib_Dir_Unix return String is
    begin
-      if Is_Windows then
-         --  Convert path separators.
-         for I in Res'Range loop
-            if Res (I) = '\' then
-               Res (I) := '/';
-            end if;
-         end loop;
-         if Res'Length > 2
-           and then (Res (Res'First) in 'a' .. 'z'
-                       or else Res (Res'First) in 'A' .. 'Z')
-           and then Res (Res'First + 1) = ':'
-         then
-            Res (Res'First + 1) := '/';
-            return '/' & Res;
-         end if;
-      end if;
-
-      return Res;
+      return Convert_Path_To_Unix (Get_Vpi_Lib_Dir);
    end Get_Vpi_Lib_Dir_Unix;
 
    function Get_Vpi_Cflags return Argument_List