dynamic argv0 relocation

[Jan Nieuwenhuizen]

Hi,

It would be nice if guile/libguile would have/support dynamic
relocation based on the location of the executable (be it guile or
lilypond).

For installations on Windows and autopackage installations on Linux,
the install prefix is determined at install time.  On Linux, this can
be fixed with wrappers (not very elegant), but on Windows (read: lots
of flavours, lots of different problems) that can hardly be done, if
at all.

Below is an attempt that works, but I'm not sure about the api nor the
implementation.  What do you think?

Jan.

Index: ChangeLog
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/ChangeLog,v
retrieving revision 1.464
diff -p -u -r1.464 ChangeLog
--- ChangeLog   5 Jun 2005 18:15:30 -0000       1.464
+++ ChangeLog   10 Jun 2005 12:27:07 -0000
@@ -1,3 +1,7 @@
+2005-06-08  Jan Nieuwenhuizen  <address@hidden>
+
+       * configure.in: Add --enable-relocation option.  Default off.
+
 2005-06-05  Marius Vollmer  <address@hidden>
 
        From  Jan Nieuwenhuizen <address@hidden>.  Thanks!
Index: configure.in
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/configure.in,v
retrieving revision 1.267
diff -p -u -r1.267 configure.in
--- configure.in        5 Jun 2005 18:15:21 -0000       1.267
+++ configure.in        10 Jun 2005 12:27:07 -0000
@@ -1030,6 +1030,18 @@ esac
 AC_MSG_CHECKING(what kind of threads to support)
 AC_MSG_RESULT($with_threads)
 
+## Dynamic relocation, based on argv[0].
+reloc_p=no
+AC_ARG_ENABLE(relocation,
+    [  --enable-relocation     compile with dynamic relocation.  Default: off],
+    [reloc_p=$enableval])
+
+if test "$reloc_p" = "yes"; then
+   AC_DEFINE([ARGV0_RELOCATION], [1], [Dynamic relocation])
+   AC_DEFINE_UNQUOTED([PATH_SEPARATOR], "$PATH_SEPARATOR", [Path separator])
+   AC_DEFINE_UNQUOTED([GUILE_EFFECTIVE_VERSION], "$GUILE_EFFECTIVE_VERSION", 
[GUILE_EFFECTIVE_VERSION])
+fi # $reloc_b
+
 ## Cross building      
 if test "$cross_compiling" = "yes"; then
   AC_MSG_CHECKING(cc for build)
Index: libguile/ChangeLog
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/ChangeLog,v
retrieving revision 1.2280
diff -p -u -r1.2280 ChangeLog
--- libguile/ChangeLog  6 Jun 2005 19:55:08 -0000       1.2280
+++ libguile/ChangeLog  10 Jun 2005 12:27:09 -0000
@@ -1,3 +1,18 @@
+2005-06-09  Jan Nieuwenhuizen  <address@hidden>
+
+       Experimental relocation patch.
+
+       * load.c (scm_init_argv0_relocation)[ARGV0_RELOCATION]: New
+       function.
+       
+       (scm_init_load_path)[ARGV0_RELOCATION]: Use it.
+
+       * load.c (scm_c_argv0_relocation)[ARGV0_RELOCATION]:
+       
+       * guile.c (main)[ARGV0_RELOCATION]: Use it to append from
+       executable location derived scm library directory.
+       [__MINGW32__|__CYGWIN__]: Append directory of executable to PATH.
+
 2005-06-06  Marius Vollmer  <address@hidden>
 
        * print.c (iprin1): When writing a string, collect all characters
Index: libguile/guile.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/guile.c,v
retrieving revision 1.19
diff -p -u -r1.19 guile.c
--- libguile/guile.c    23 May 2005 19:57:20 -0000      1.19
+++ libguile/guile.c    10 Jun 2005 12:27:09 -0000
@@ -71,6 +71,11 @@ main (int argc, char **argv)
   extern const lt_dlsymlist lt_preloaded_symbols[];
   lt_dlpreload_default (lt_preloaded_symbols);
 #endif
+
+#if ARGV0_RELOCATION
+  scm_c_argv0_relocation (argv[0]);
+#endif /* ARGV0_RELOCATION */
+
   scm_boot_guile (argc, argv, inner_main, 0);
   return 0; /* never reached */
 }
Index: libguile/load.c
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/load.c,v
retrieving revision 1.86
diff -p -u -r1.86 load.c
--- libguile/load.c     23 May 2005 19:57:20 -0000      1.86
+++ libguile/load.c     10 Jun 2005 12:27:09 -0000
@@ -180,6 +180,45 @@ SCM_DEFINE (scm_parse_path, "parse-path"
 }
 #undef FUNC_NAME
 
+#if ARGV0_RELOCATION
+#include "filesys.h"
+#if defined (__CYGWIN__) || defined (__MINGW32__)
+#include "posix.h"
+#endif
+
+char const *global_argv0 = 0;
+
+void
+scm_c_argv0_relocation (char const *argv0)
+{
+  global_argv0 = argv0;
+}
+
+SCM
+scm_init_argv0_relocation (char const* argv0)
+{
+  SCM bindir = scm_dirname (scm_from_locale_string (argv0));
+  SCM prefix = scm_dirname (bindir);
+  SCM libdir = scm_string_append (scm_list_2 (prefix,
+                                            scm_from_locale_string 
("/share/guile/" GUILE_EFFECTIVE_VERSION)));
+
+#if defined (__CYGWIN__) || defined (__MINGW32__)
+  {
+    SCM path;
+    char *env = getenv ("PATH");
+    if (env)
+      path = scm_string_append (scm_list_3 (scm_from_locale_string (env),
+                                           scm_from_locale_string 
(PATH_SEPARATOR),
+                                           bindir));
+    else
+      path = bindir;
+    scm_putenv (scm_string_append (scm_list_2 (scm_from_locale_string 
("PATH="), path)));
+  }
+#endif /* __CYGWIN__ || __MINGW32__ */
+    
+  return scm_list_1 (libdir);
+}
+#endif /* ARGV0_RELOCATION */
 
 /* Initialize the global variable %load-path, given the value of the
    SCM_SITE_DIR and SCM_LIBRARY_DIR preprocessor symbols and the
@@ -200,6 +239,11 @@ scm_init_load_path ()
   if (env)
     path = scm_parse_path (scm_from_locale_string (env), path);
 
+#if ARGV0_RELOCATION
+  if (global_argv0)
+    path = scm_append (scm_list_2 (path, scm_init_argv0_relocation 
(global_argv0)));
+#endif /* __CYGWIN__ || __MINGW32__ */
+  
   *scm_loc_load_path = path;
 }
 
Index: libguile/load.h
===================================================================
RCS file: /cvsroot/guile/guile/guile-core/libguile/load.h,v
retrieving revision 1.22
diff -p -u -r1.22 load.h
--- libguile/load.h     23 May 2005 19:57:20 -0000      1.22
+++ libguile/load.h     10 Jun 2005 12:27:09 -0000
@@ -26,6 +26,10 @@
 
 
 SCM_API SCM scm_parse_path (SCM path, SCM tail);
+#if ARGV0_RELOCATION
+SCM_API void scm_c_argv0_relocation (char const *argv0);
+SCM_API SCM scm_init_argv0_relocation (char const* argv0);
+#endif
 SCM_API void scm_init_load_path (void);
 SCM_API SCM scm_primitive_load (SCM filename);
 SCM_API SCM scm_c_primitive_load (const char *filename);


-- 
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond - The music typesetter
http://www.xs4all.nl/~jantien       | http://www.lilypond.org