Support installation in a different path that configured one.

5 files changed, 262 insertions, 27 deletions

diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile
index ec01aaf1e..ebf23c2d1 100644
--- a/translate/ghdldrv/Makefile
+++ b/translate/ghdldrv/Makefile
@@ -94,7 +94,8 @@ default_pathes.ads: default_pathes.ads.in Makefile
 	 -e "s%@COMPILER_MCODE@%$$curdir/ghdl1-mcode%" \
 	 -e "s%@COMPILER_LLVM@%$$curdir/ghdl1-llvm%" \
 	 -e "s%@POST_PROCESSOR@%$$curdir/../ortho/oread/oread-gcc%" \
-	 -e "s%@PREFIX@%$$curdir/lib/%" < $< > $@
+	 -e "s%@INSTALL_PREFIX@%%" \
+	 -e "s%@LIB_PREFIX@%$$curdir/lib/%" < $< > $@
 
 bootstrap.old: force
 	$(RM) ../../libraries/std-obj87.cf
diff --git a/translate/ghdldrv/default_pathes.ads.in b/translate/ghdldrv/default_pathes.ads.in
index 4e6c1a7ec..7f471a5ed 100644
--- a/translate/ghdldrv/default_pathes.ads.in
+++ b/translate/ghdldrv/default_pathes.ads.in
@@ -21,11 +21,13 @@ package Default_Pathes is
    --  Accept long lines.
    pragma Style_Checks ("M999");
 
+   Install_Prefix : constant String :=
+     "@INSTALL_PREFIX@";
+   Lib_Prefix : constant String :=
+     "@LIB_PREFIX@";
+
    Compiler_Gcc : constant String :=
      "@COMPILER_GCC@";
-   Prefix : constant String :=
-     "@PREFIX@";
-
    Compiler_Mcode : constant String :=
      "@COMPILER_MCODE@";
    Compiler_Llvm : constant String :=
diff --git a/translate/ghdldrv/ghdldrv.adb b/translate/ghdldrv/ghdldrv.adb
index eb4de290a..72bac2601 100644
--- a/translate/ghdldrv/ghdldrv.adb
+++ b/translate/ghdldrv/ghdldrv.adb
@@ -19,6 +19,7 @@ with Ada.Command_Line; use Ada.Command_Line;
 with Ada.Text_IO; use Ada.Text_IO;
 with Ada.Characters.Latin_1;
 with GNAT.OS_Lib; use GNAT.OS_Lib;
+with GNAT.Directory_Operations;
 with GNAT.Table;
 with GNAT.Dynamic_Tables;
 with Libraries;
@@ -275,7 +276,7 @@ package body Ghdldrv is
    --  Lines starting with a '#' are ignored (comments)
    --  Lines starting with a '>' are directory lines
    --  If first character of a line is a '@', it is replaced with
-   --    the prefix_path.
+   --    the lib_prefix_path.
    --  If TO_OBJ is true, then each file is converted to an object file name
    --   (suffix is replaced by the object file extension).
    procedure Add_File_List (Filename : String; To_Obj : Boolean)
@@ -506,8 +507,8 @@ package body Ghdldrv is
       raise Option_Error;
    end Tool_Not_Found;
 
-   procedure Set_Tools_Name
-   is
+   --  Set the compiler command according to the configuration (and swicthes).
+   procedure Set_Tools_Name is
    begin
       --  Set tools name.
       if Compiler_Cmd = null then
@@ -527,14 +528,203 @@ package body Ghdldrv is
       end if;
    end Set_Tools_Name;
 
+   function Is_Directory_Separator (C : Character) return Boolean is
+   begin
+      return C = '/' or else C = Directory_Separator;
+   end Is_Directory_Separator;
+
+   function Get_Basename_Pos (Pathname : String) return Natural is
+   begin
+      for I in reverse Pathname'Range loop
+         if Is_Directory_Separator (Pathname (I)) then
+            return I;
+         end if;
+      end loop;
+      return 0;
+   end Get_Basename_Pos;
+
+   procedure Set_Prefix_From_Program_Path (Prog_Path : String)
+   is
+      Dir_Pos : Natural;
+   begin
+      Dir_Pos := Get_Basename_Pos (Prog_Path);
+      if Dir_Pos = 0 then
+         --  No directory in Prog_Path.  This is not expected.
+         return;
+      end if;
+
+      declare
+         Pathname : String :=
+           Normalize_Pathname (Prog_Path (Dir_Pos + 1 .. Prog_Path'Last),
+                               Prog_Path (Prog_Path'First .. Dir_Pos - 1));
+         Pos : Natural;
+      begin
+         --  Stop now in case of error.
+         if Pathname'Length = 0 then
+            return;
+         end if;
+
+         --  Skip executable name
+         Dir_Pos := Get_Basename_Pos (Pathname);
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         --  Simplify path:
+         --    /./ => /
+         --    // => /
+         Pos := Dir_Pos - 1;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos)) then
+               if Is_Directory_Separator (Pathname (Pos + 1)) then
+                  --  // => /
+                  Pathname (Pos .. Dir_Pos - 1) :=
+                    Pathname (Pos + 1 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 1;
+               elsif Pos + 2 <= Dir_Pos
+                 and then Pathname (Pos + 1) = '.'
+                 and then Is_Directory_Separator (Pathname (Pos + 2))
+               then
+                  --  /./ => /
+                  Pathname (Pos .. Dir_Pos - 2) :=
+                    Pathname (Pos + 2 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - 2;
+               end if;
+            end if;
+            Pos := Pos - 1;
+         end loop;
+
+         --  Simplify path:
+         --    /xxx/../ => /
+         --  This is done after the previous simplication to avoid to deal
+         --  with cases like /xxx//../ or /xxx/./../
+         Pos := Dir_Pos - 3;
+         while Pos >= Pathname'First loop
+            if Is_Directory_Separator (Pathname (Pos))
+              and then Pathname (Pos + 1) = '.'
+              and then Pathname (Pos + 2) = '.'
+              and then Is_Directory_Separator (Pathname (Pos + 3))
+            then
+               declare
+                  Pos2 : constant Natural :=
+                    Get_Basename_Pos (Pathname (Pathname'First .. Pos - 1));
+                  --  /xxxxxxxxxx/../
+                  --  ^          ^
+                  --  Pos2       Pos
+                  Len : Natural;
+               begin
+                  if Pos2 = 0 then
+                     --  Shouldn't happen.
+                     return;
+                  end if;
+                  Len := Pos + 3 - Pos2;
+                  Pathname (Pos2 + 1 .. Dir_Pos - Len) :=
+                    Pathname (Pos + 4 .. Dir_Pos);
+                  Dir_Pos := Dir_Pos - Len;
+                  if Pos2 < Pathname'First + 3 then
+                     exit;
+                  end if;
+                  Pos := Pos2 - 3;
+               end;
+            else
+               Pos := Pos - 1;
+            end if;
+         end loop;
+
+         --  Remove last '/'
+         Dir_Pos := Dir_Pos - 1;
+
+         --  Skip directory.
+         Dir_Pos := Get_Basename_Pos (Pathname (Pathname'First .. Dir_Pos));
+         if Dir_Pos = 0 then
+            return;
+         end if;
+
+         Exec_Prefix := new String'(Pathname (Pathname'First .. Dir_Pos - 1));
+      end;
+   end Set_Prefix_From_Program_Path;
+
+   --  Extract Exec_Prefix from executable name.
+   procedure Set_Exec_Prefix
+   is
+      use GNAT.Directory_Operations;
+      Prog_Path : constant String := Ada.Command_Line.Command_Name;
+      Exec_Path : String_Access;
+   begin
+      --  If the command name is an absolute path, deduce prefix from it.
+      if Is_Absolute_Path (Prog_Path) then
+         Set_Prefix_From_Program_Path (Prog_Path);
+         return;
+      end if;
+
+      --  If the command name is a relative path, deduce prefix from it
+      --  and current path.
+      if Get_Basename_Pos (Prog_Path) /= 0 then
+         if Is_Executable_File (Prog_Path) then
+            Set_Prefix_From_Program_Path
+              (Get_Current_Dir & Directory_Separator & Prog_Path);
+         end if;
+         return;
+      end if;
+
+      --  Look for program name on the path.
+      Exec_Path := Locate_Exec_On_Path (Prog_Path);
+      if Exec_Path /= null then
+         Set_Prefix_From_Program_Path (Exec_Path.all);
+         Free (Exec_Path);
+      end if;
+   end Set_Exec_Prefix;
+
+   function Locate_Exec_Tool (Toolname : String) return String_Access is
+   begin
+      if Is_Absolute_Path (Toolname) then
+         if Is_Executable_File (Toolname) then
+            return new String'(Toolname);
+         end if;
+      else
+         --  Try from install prefix
+         if Exec_Prefix /= null then
+            declare
+               Path : constant String :=
+                 Exec_Prefix.all & Directory_Separator & Toolname;
+            begin
+               if Is_Executable_File (Path) then
+                  return new String'(Path);
+               end if;
+            end;
+         end if;
+
+         --  Try configured prefix
+         declare
+            Path : constant String :=
+              Default_Pathes.Install_Prefix & Directory_Separator & Toolname;
+         begin
+            if Is_Executable_File (Path) then
+               return new String'(Path);
+            end if;
+         end;
+      end if;
+
+      --  Search the basename on path.
+      declare
+         Pos : constant Natural := Get_Basename_Pos (Toolname);
+      begin
+         if Pos = 0 then
+            return Locate_Exec_On_Path (Toolname);
+         else
+            return Locate_Exec_On_Path (Toolname (Pos .. Toolname'Last));
+         end if;
+      end;
+   end Locate_Exec_Tool;
+
    procedure Locate_Tools is
    begin
-      Compiler_Path := Locate_Exec_On_Path (Compiler_Cmd.all);
+      Compiler_Path := Locate_Exec_Tool (Compiler_Cmd.all);
       if Compiler_Path = null then
          Tool_Not_Found (Compiler_Cmd.all);
       end if;
       if Compile_Kind >= Compile_Debug then
-         Post_Processor_Path := Locate_Exec_On_Path (Post_Processor_Cmd.all);
+         Post_Processor_Path := Locate_Exec_Tool (Post_Processor_Cmd.all);
          if Post_Processor_Path = null then
             Tool_Not_Found (Post_Processor_Cmd.all);
          end if;
@@ -556,6 +746,7 @@ package body Ghdldrv is
       use Libraries;
    begin
       Set_Tools_Name;
+      Set_Exec_Prefix;
       Locate_Tools;
       Setup_Libraries (Load);
       for I in 2 .. Get_Nbr_Pathes loop
@@ -741,6 +932,7 @@ package body Ghdldrv is
       end if;
 
       Set_Tools_Name;
+      Put_Line ("Pathes at configuration:");
       Put ("compiler command: ");
       Put_Line (Compiler_Cmd.all);
       if Compile_Kind >= Compile_Debug then
@@ -753,14 +945,16 @@ package body Ghdldrv is
       end if;
       Put ("linker command: ");
       Put_Line (Linker_Cmd);
+      Put_Line ("default lib prefix: " & Default_Pathes.Lib_Prefix);
+
+      New_Line;
 
       Put ("command line prefix (--PREFIX): ");
-      if Prefix_Path = null then
+      if Switch_Prefix_Path = null then
          Put_Line ("(not set)");
       else
-         Put_Line (Prefix_Path.all);
+         Put_Line (Switch_Prefix_Path.all);
       end if;
-      Setup_Libraries (False);
 
       Put ("environment prefix (GHDL_PREFIX): ");
       if Prefix_Env = null then
@@ -769,9 +963,19 @@ package body Ghdldrv is
          Put_Line (Prefix_Env.all);
       end if;
 
-      Put_Line ("default prefix: " & Default_Pathes.Prefix);
-      Put_Line ("actual prefix: " & Prefix_Path.all);
+      Set_Exec_Prefix;
+      Setup_Libraries (False);
+
+      Put ("exec prefix (from program name): ");
+      if Exec_Prefix = null then
+         Put_Line ("(not found)");
+      else
+         Put_Line (Exec_Prefix.all);
+      end if;
+
+      New_Line;
 
+      Put_Line ("library prefix: " & Lib_Prefix_Path.all);
       Put ("library directory: ");
       Put_Line (Get_Machine_Path_Prefix);
       Locate_Tools;
@@ -787,6 +991,9 @@ package body Ghdldrv is
       end if;
       Put ("linker path: ");
       Put_Line (Linker_Path.all);
+
+      New_Line;
+
       Put_Line ("default library pathes:");
       for I in 2 .. Get_Nbr_Pathes loop
          Put (' ');
diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb
index d15de68f4..f46c963ce 100644
--- a/translate/ghdldrv/ghdllocal.adb
+++ b/translate/ghdldrv/ghdllocal.adb
@@ -123,7 +123,7 @@ package body Ghdllocal is
          Flag_Verbose := True;
          Res := Option_Ok;
       elsif Opt'Length > 9 and then Opt (1 .. 9) = "--PREFIX=" then
-         Prefix_Path := new String'(Opt (10 .. Opt'Last));
+         Switch_Prefix_Path := new String'(Opt (10 .. Opt'Last));
          Res := Option_Ok;
       elsif Opt = "--ieee=synopsys" then
          Flag_Ieee := Lib_Synopsys;
@@ -190,9 +190,9 @@ package body Ghdllocal is
    function Get_Machine_Path_Prefix return String is
    begin
       if Flag_32bit then
-         return Prefix_Path.all & "32";
+         return Lib_Prefix_Path.all & "32";
       else
-         return Prefix_Path.all;
+         return Lib_Prefix_Path.all;
       end if;
    end Get_Machine_Path_Prefix;
 
@@ -216,12 +216,31 @@ package body Ghdllocal is
 
       --  Set prefix path.
       --  If not set by command line, try environment variable.
-      if Prefix_Path = null then
-         Prefix_Path := Prefix_Env;
+      if Switch_Prefix_Path /= null then
+         Lib_Prefix_Path := Switch_Prefix_Path;
+      else
+         Lib_Prefix_Path := Prefix_Env;
       end if;
       --  Else try default path.
-      if Prefix_Path = null then
-         Prefix_Path := new String'(Default_Pathes.Prefix);
+      if Lib_Prefix_Path = null then
+         if Is_Absolute_Path (Default_Pathes.Lib_Prefix) then
+            Lib_Prefix_Path := new String'(Default_Pathes.Lib_Prefix);
+         else
+            if Exec_Prefix /= null then
+               Lib_Prefix_Path := new
+                 String'(Exec_Prefix.all & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+            if Lib_Prefix_Path = null
+              or else not Is_Directory (Lib_Prefix_Path.all)
+            then
+               Free (Lib_Prefix_Path);
+               Lib_Prefix_Path := new
+                 String'(Default_Pathes.Install_Prefix
+                           & Directory_Separator
+                           & Default_Pathes.Lib_Prefix);
+            end if;
+         end if;
       else
          -- Assume the user has set the correct path, so do not insert 32.
          Flag_32bit := False;
diff --git a/translate/ghdldrv/ghdllocal.ads b/translate/ghdldrv/ghdllocal.ads
index 46eff1a14..3e1cea5dc 100644
--- a/translate/ghdldrv/ghdllocal.ads
+++ b/translate/ghdldrv/ghdllocal.ads
@@ -35,6 +35,18 @@ package Ghdllocal is
    --  Disp detailled help.
    procedure Disp_Long_Help (Cmd : Command_Lib);
 
+   --  Value of --PREFIX
+   Switch_Prefix_Path : String_Access := null;
+
+   --  getenv ("GHDL_PREFIX").  Set by Setup_Libraries.
+   Prefix_Env : String_Access := null;
+
+   --  Installation prefix (deduced from executable path).
+   Exec_Prefix : String_Access;
+
+   --  Path prefix for libraries.
+   Lib_Prefix_Path : String_Access := null;
+
    --  Set with -v option.
    Flag_Verbose : Boolean := False;
 
@@ -53,12 +65,6 @@ package Ghdllocal is
    --  Prefix for elab files.
    Elab_Prefix : constant String := "e~";
 
-   --  Path prefix for libraries.
-   Prefix_Path : String_Access := null;
-
-   --  getenv ("GHDL_PREFIX").  Set by Setup_Libraries.
-   Prefix_Env : String_Access := null;
-
    Nul : constant Character := Character'Val (0);
 
    --  Return FILENAME without the extension.