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 <[EMAIL PROTECTED]>
+
+ * configure.in: Add --enable-relocation option. Default off.
+
2005-06-05 Marius Vollmer <[EMAIL PROTECTED]>
From Jan Nieuwenhuizen <[EMAIL PROTECTED]>. 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 <[EMAIL PROTECTED]>
+
+ 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 <[EMAIL PROTECTED]>
* 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 <[EMAIL PROTECTED]> | GNU LilyPond - The music typesetter
http://www.xs4all.nl/~jantien | http://www.lilypond.org
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/guile-devel
