From 73b081531e9191876105c1e16d62868eb1c43b8a Mon Sep 17 00:00:00 2001
From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Sat, 22 Mar 2008 17:43:04 -0300
Subject: [PATCH] Relocate patch


 
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.in     |   12 +++++++++++
 libguile/guile.c |    5 ++++
 libguile/load.c  |   58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/load.h  |    4 +++
 4 files changed, 79 insertions(+), 0 deletions(-)

diff --git a/configure.ac b/configure.ac
index dd0628f..41c5c96 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1196,6 +1196,18 @@ AC_MSG_RESULT($works)
 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 c8341c2..116aa2f 100644
--- a/libguile/guile.c
+++ b/libguile/guile.c
@@ -66,6 +66,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 3e702c4..2341daf 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -195,6 +195,72 @@ 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 libdir = scm_string_append (scm_list_2 (prefix,
+					     scm_from_locale_string ("/lib")));
+
+#if 0 /* def SYSV */
+  {
+    SCM path;
+    char *env = getenv ("LD_LIBRARY_PATH");
+    if (env)
+      path = scm_string_append (scm_list_3 (scm_from_locale_string (env),
+					    scm_from_locale_string (PATH_SEPARATOR),
+					    datadir));
+    else
+      path = libdir;
+    scm_putenv (scm_string_append (scm_list_2 (scm_from_locale_string ("LD_LIBRARY_PATH="), path)));
+  }
+#elif 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 (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
@@ -215,6 +268,14 @@ 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)));
+      cpath = scm_append (scm_list_2 (cpath, scm_init_argv0_compiled_relocation (global_argv0)));
+    }
+#endif /* __CYGWIN__ || __MINGW32__ */
+  
   *scm_loc_load_path = path;
 }
 
--- a/libguile/load.h~	2010-12-14 19:15:17.000000000 +0100
+++ a/libguile/load.h	2011-01-26 17:33:13.797510681 +0100
@@ -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);