From d93b5bd21e99cda017e1b2d7b459e453113fbfa6 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen 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 * configure.in: Add --enable-relocation option. Default off. libguile/ ChangeLog 2005-06-09 Jan Nieuwenhuizen 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 (env), + scm_from_locale_string (PATH_SEPARATOR))); + 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 (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; *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