From d93b5bd21e99cda017e1b2d7b459e453113fbfa6 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Mon, 31 Jan 2011 21:05:48 +0100
Subject: [PATCH] Add dynamic relocation support, default off.

Set PATH, GUILE_LOAD_PATH, GUILE_LOAD_COMPILED_PATH according to
location of the guile executable.  Using this together with
-rpath $ORIGIN/../lib and not changing the general installed
directory layout, this enables relocatable binary packages,
for use in $HOME or for Windows.

2005-06-08  Jan Nieuwenhuizen  <janneke@gnu.org>

    * configure.in: Add --enable-relocation option.  Default off.

libguile/ ChangeLog

2005-06-09  Jan Nieuwenhuizen  <janneke@gnu.org>

    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.
---
 configure.ac     |   12 +++++++++++
 libguile/guile.c |    3 ++
 libguile/load.c  |   55 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/load.h  |    5 ++++
 4 files changed, 75 insertions(+), 0 deletions(-)

diff --git a/configure.ac b/configure.ac
index 5c70aa8..5fa6cf4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1452,6 +1452,18 @@ GUILE_THREAD_LOCAL_STORAGE
 fi # with_threads=pthreads
 
 
+## 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)
diff --git a/libguile/guile.c b/libguile/guile.c
index 6da547b..896adc4 100644
--- a/libguile/guile.c
+++ b/libguile/guile.c
@@ -67,6 +67,9 @@ inner_main (void *closure SCM_UNUSED, int argc, char **argv)
 int
 main (int argc, char **argv)
 {
+#if ARGV0_RELOCATION
+  scm_c_argv0_relocation (argv[0]);
+#endif /* ARGV0_RELOCATION */
   scm_boot_guile (argc, argv, inner_main, 0);
   return 0; /* never reached */
 }
diff --git a/libguile/load.c b/libguile/load.c
index cbf9dc0..9ad1008 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -234,6 +234,53 @@ SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0,
 }
 #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 datadir = scm_string_append (scm_list_2 (prefix,
+					     scm_from_locale_string ("/share/guile/" GUILE_EFFECTIVE_VERSION)));
+  SCM path;
+  char *env = getenv ("PATH");
+  if (env)
+    path = scm_string_append (scm_list_3 (bindir,
+					  scm_from_locale_string (PATH_SEPARATOR),
+					  scm_from_locale_string (env)));
+  else
+    path = bindir;
+  scm_putenv (scm_string_append (scm_list_2 (scm_from_locale_string ("PATH="), path)));
+
+  return scm_list_1 (datadir);
+}
+
+SCM
+scm_init_argv0_compiled_relocation (char const* argv0)
+{
+  SCM bindir = scm_dirname (scm_from_locale_string (argv0));
+  SCM prefix = scm_dirname (bindir);
+  SCM pkglibdir = scm_string_append (scm_list_2 (prefix,
+						 scm_from_locale_string ("/lib/guile")));
+  SCM ccachedir = scm_string_append (scm_list_2 (pkglibdir,
+						 scm_from_locale_string ("/" GUILE_EFFECTIVE_VERSION "/ccache")));
+
+  return scm_list_1 (ccachedir);
+}
+#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
@@ -304,6 +351,14 @@ scm_init_load_path ()
   if (env)
     cpath = scm_parse_path (scm_from_locale_string (env), cpath);
 
+#if ARGV0_RELOCATION
+  if (global_argv0)
+    {
+      path = scm_append (scm_list_2 (scm_init_argv0_relocation (global_argv0), path));
+      cpath = scm_append (scm_list_2 (scm_init_argv0_compiled_relocation (global_argv0), cpath));
+    }
+#endif /* __CYGWIN__ || __MINGW32__ */
+  
   *scm_loc_load_path = path;
   *scm_loc_load_compiled_path = cpath;
 }
diff --git a/libguile/load.h b/libguile/load.h
index d1afefb..ea29d3a 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -27,6 +27,11 @@
 
 
 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);
+SCM_API SCM scm_init_argv0_compiled_relocation (char const* argv0);
+#endif
 SCM_API SCM scm_primitive_load (SCM filename);
 SCM_API SCM scm_c_primitive_load (const char *filename);
 SCM_API SCM scm_sys_package_data_dir (void);
-- 
1.7.1