From mboxrd@z Thu Jan 1 00:00:00 1970 From: Jan Nieuwenhuizen Subject: [PATCH] Allow for incremental upgrade from guile-2.0 to guile-next. Date: Wed, 23 Mar 2016 22:25:06 +0100 Message-ID: <87egb0khu5.fsf@drakenvlieg.flower> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:33156) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1aiqHQ-0006yA-7O for guix-devel@gnu.org; Wed, 23 Mar 2016 17:25:32 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1aiqHM-0001kB-3S for guix-devel@gnu.org; Wed, 23 Mar 2016 17:25:28 -0400 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org --=-=-= Content-Type: text/plain Hi, Using Guile-2.0 and Guile-2.2 together is currently cumbersome, esp. on Guix, mainly because of incompatible .go files that must not be in the GUILE_LOAD_COMPILED_PATH. This patch allows using compiled .go files for guile and guile-next in one GUILE_LOAD_COMPILED_PATH by having guile skip any invalid .go files and thus allows for incremental upgrade to guile-2.2. Greetings, Jan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Allow-for-incremental-upgrade-from-guile-2.0-to-guil.patch >From bd96ca27dcc2df034bd888e471c6c6d1b228fb70 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Fri, 11 Mar 2016 21:41:17 +0100 Subject: [PATCH] Allow for incremental upgrade from guile-2.0 to guile-next. * gnu/packages/patches/guile-2.0-skip-invalid-go.patch, gnu/packages/patches/guile-2.0-install-versioned.patch, gnu/packages/patches/guile-skip-invalid-go.patch, gnu/packages/patches/guile-install-versioned.patch: New files. * gnu-system.am: Add them. * gnu/packages/guile.scm(guile-2.0, guile-next): Use them. Set GUILE_LOAD_COMPILED_PATH to include the other major's path. --- gnu-system.am | 4 + gnu/packages/guile.scm | 15 +- .../patches/guile-2.0-install-versioned.patch | 30 ++ .../patches/guile-2.0-skip-invalid-go.patch | 462 +++++++++++++++++++++ gnu/packages/patches/guile-install-versioned.patch | 30 ++ gnu/packages/patches/guile-skip-invalid-go.patch | 415 ++++++++++++++++++ 6 files changed, 952 insertions(+), 4 deletions(-) create mode 100644 gnu/packages/patches/guile-2.0-install-versioned.patch create mode 100644 gnu/packages/patches/guile-2.0-skip-invalid-go.patch create mode 100644 gnu/packages/patches/guile-install-versioned.patch create mode 100644 gnu/packages/patches/guile-skip-invalid-go.patch diff --git a/gnu-system.am b/gnu-system.am index 6cdc1e3..44b3d23 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -516,6 +516,10 @@ dist_patch_DATA = \ gnu/packages/patches/guile-present-coding.patch \ gnu/packages/patches/guile-relocatable.patch \ gnu/packages/patches/guile-rsvg-pkgconfig.patch \ + gnu/packages/patches/guile-2.0-skip-invalid-go.patch \ + gnu/packages/patches/guile-2.0-install-versioned.patch \ + gnu/packages/patches/guile-skip-invalid-go.patch \ + gnu/packages/patches/guile-install-versioned.patch \ gnu/packages/patches/gtk2-respect-GUIX_GTK2_PATH.patch \ gnu/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \ gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \ diff --git a/gnu/packages/guile.scm b/gnu/packages/guile.scm index fe043cb..4809147 100644 --- a/gnu/packages/guile.scm +++ b/gnu/packages/guile.scm @@ -132,7 +132,10 @@ without requiring the source code to be rewritten.") (sha256 (base32 "1qh3j7308qvsjgwf7h94yqgckpbgz2k3yqdkzsyhqcafvfka9l5f")) - (patches (list (search-patch "guile-arm-fixes.patch"))))) + (patches + (list (search-patch "guile-arm-fixes.patch") + (search-patch "guile-2.0-skip-invalid-go.patch") + (search-patch "guile-2.0-install-versioned.patch"))))) (build-system gnu-build-system) (native-inputs `(("pkgconfig" ,pkg-config))) (inputs `(("libffi" ,libffi) @@ -177,7 +180,8 @@ without requiring the source code to be rewritten.") (search-path-specification (variable "GUILE_LOAD_COMPILED_PATH") (files '("lib/guile/2.0/ccache" - "share/guile/site/2.0"))))) + "lib/guile/2.2/ccache" ;; allow guile-2.2 to run + "share/guile/site/2.0"))))) ;; document or remove (synopsis "Scheme implementation intended especially for extensions") (description @@ -211,7 +215,9 @@ without requiring the source code to be rewritten.") ;; from source, at the expense of significantly longer build ;; times (almost 3 hours on a 4-core Intel i5). (snippet '(for-each delete-file - (find-files "prebuilt" "\\.go$"))))) + (find-files "prebuilt" "\\.go$"))) + (patches (list (search-patch "guile-skip-invalid-go.patch") + (search-patch "guile-install-versioned.patch"))))) (synopsis "Snapshot of what will become version 2.2 of GNU Guile") (native-search-paths (list (search-path-specification @@ -220,7 +226,8 @@ without requiring the source code to be rewritten.") (search-path-specification (variable "GUILE_LOAD_COMPILED_PATH") (files '("lib/guile/2.2/ccache" - "share/guile/site/2.2"))))))) + "lib/guile/2.0/ccache" ;; allow guile-2.0 to run + "share/guile/site/2.2"))))))) ;; document or remove (define-public guile-for-guile-emacs (package (inherit guile-next) diff --git a/gnu/packages/patches/guile-2.0-install-versioned.patch b/gnu/packages/patches/guile-2.0-install-versioned.patch new file mode 100644 index 0000000..3760d60 --- /dev/null +++ b/gnu/packages/patches/guile-2.0-install-versioned.patch @@ -0,0 +1,30 @@ +From a749256538c7aed0172a2a4cc53ab70fee6094c7 Mon Sep 17 00:00:00 2001 +From: Jan Nieuwenhuizen +Date: Mon, 14 Mar 2016 07:42:59 +0100 +Subject: [PATCH] Install guile-EFFECTIVE_VERSION and guile-MAJOR_VERSION too. + +* libguile/Makefile.am (install-exec-hook): Add versioned symlinks for + guile executable. +--- + libguile/Makefile.am | 5 +++++ + 1 file changed, 5 insertions(+) + +diff --git a/libguile/Makefile.am b/libguile/Makefile.am +index 8cb7c0e..70bb161 100644 +--- a/libguile/Makefile.am ++++ b/libguile/Makefile.am +@@ -451,6 +451,11 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h \ + ## wiped out. + install-exec-hook: + rm -f $(DESTDIR)$(bindir)/guile-snarf.awk ++ cd $(DESTDIR)$(bindir) && \ ++ rm -f guile-$(GUILE_MAJOR_VERSION)$(EXEEXT) && \ ++ mv -f guile$(EXEEXT) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) && \ ++ $(LN_S) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) guile$(EXEEXT) && \ ++ $(LN_S) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) guile-$(GUILE_MAJOR_VERSION)$(EXEEXT) + + install-data-hook: libguile-2.0-gdb.scm + @$(MKDIR_P) $(DESTDIR)$(libdir) +-- +2.6.3 + diff --git a/gnu/packages/patches/guile-2.0-skip-invalid-go.patch b/gnu/packages/patches/guile-2.0-skip-invalid-go.patch new file mode 100644 index 0000000..68c5f64 --- /dev/null +++ b/gnu/packages/patches/guile-2.0-skip-invalid-go.patch @@ -0,0 +1,462 @@ +From ae80e57f4dd214af10112e1a9188fb5b90ab6143 Mon Sep 17 00:00:00 2001 +From: Jan Nieuwenhuizen +Date: Fri, 11 Mar 2016 14:58:09 +0100 +Subject: [PATCH] Skip invalid compiled file found, continue searching path. + +* libguile/vm.c (scm_load_compiled_with_vm): Add argument + FALSE_ON_ERROR. +* libguile/objcodes.c (make_objcode_from_file, scm_load_objcode): + (verify_cookie): Add argument nonzero_on_error. +* libguile/load.c (search_path): Take optional output argument + PATH_REMAINING. + (scm_primitive_load_path): Use it. Take optional argument + LOAD_COMPILED_PATH. Skip any invalid compiled file found and + continue searching scm_loc_load_compiled_path. + (internal_scm_init_eval_in_scheme): New function. Implementation + of scm_init_eval_in_scheme, taking path parameter to implement + skipping any invalid eval.go's in path. + (scm_init_eval_in_scheme): Use it. +--- + libguile/load.c | 106 ++++++++++++++++++++++++++++++++++++++++++---------- + libguile/objcodes.c | 57 ++++++++++++++++++---------- + libguile/objcodes.h | 2 +- + libguile/vm.c | 11 ++++-- + libguile/vm.h | 2 +- + 5 files changed, 134 insertions(+), 44 deletions(-) + +diff --git a/libguile/load.c b/libguile/load.c +index 0a49066..36a9c49 100644 +--- a/libguile/load.c ++++ b/libguile/load.c +@@ -548,10 +548,12 @@ is_absolute_file_name (SCM filename) + If FILENAME is absolute, return it unchanged. + We also fill *stat_buf corresponding to the returned pathname. + If given, EXTENSIONS is a list of strings; for each directory +- in PATH, we search for FILENAME concatenated with each EXTENSION. */ ++ in PATH, we search for FILENAME concatenated with each EXTENSION. ++ If PATH_REMAINING is not NULL, it is set to the tail of PATH that was ++ not skipped. */ + static SCM + search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, +- struct stat *stat_buf) ++ struct stat *stat_buf, SCM *path_remaining) + { + struct stringbuf buf; + char *filename_chars; +@@ -669,6 +671,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, + + end: + scm_dynwind_end (); ++ if (path_remaining) ++ *path_remaining = path; + return result; + } + +@@ -725,7 +729,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1, + if (SCM_UNBNDP (require_exts)) + require_exts = SCM_BOOL_F; + +- return search_path (path, filename, extensions, require_exts, &stat_buf); ++ return search_path (path, filename, extensions, require_exts, &stat_buf, NULL); + } + #undef FUNC_NAME + +@@ -750,7 +754,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0, + SCM_VALIDATE_STRING (1, filename); + + return search_path (*scm_loc_load_path, filename, *scm_loc_load_extensions, +- SCM_BOOL_F, &stat_buf); ++ SCM_BOOL_F, &stat_buf, NULL); + } + #undef FUNC_NAME + +@@ -942,7 +946,10 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + "depending on the optional second argument,\n" + "@var{exception_on_not_found}. If it is @code{#f}, @code{#f}\n" + "will be returned. If it is a procedure, it will be called\n" +- "with no arguments. Otherwise an error is signalled.") ++ "with no arguments. Otherwise an error is signalled." ++ "If the optional third argument,\n" ++ "@var{load_compiled_path} is given, use it to search for compiled files\n" ++ "instead of @var{*scm_loc_load_compiled_path}.") + #define FUNC_NAME s_scm_primitive_load_path + { + SCM filename, exception_on_not_found; +@@ -950,6 +957,8 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + int compiled_is_fallback = 0; + SCM hook = *scm_loc_load_hook; + struct stat stat_source, stat_compiled; ++ SCM load_compiled_path; ++ SCM load_compiled_path_remaining = SCM_EOL; + + if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) + SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", +@@ -961,21 +970,27 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + single argument (the file name). */ + filename = args; + exception_on_not_found = SCM_UNDEFINED; ++ load_compiled_path = *scm_loc_load_compiled_path; + } + else + { +- /* Starting from 1.9, this function takes 1 required and 1 optional +- argument. */ ++ /* Starting from 1.9, this function takes 1 required and 1 ++ optional argument. ++ ++ Starting from 2.1.2, this function takes 1 required and 2 ++ optional arguments. */ + long len; + + SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, args, len); +- if (len < 1 || len > 2) ++ if (len < 1 || len > 3) + scm_error_num_args_subr (FUNC_NAME); + + filename = SCM_CAR (args); + SCM_VALIDATE_STRING (SCM_ARG1, filename); + + exception_on_not_found = len > 1 ? SCM_CADR (args) : SCM_UNDEFINED; ++ load_compiled_path = len < 3 ? *scm_loc_load_compiled_path ++ : SCM_CADDR (args); + } + + if (SCM_UNBNDP (exception_on_not_found)) +@@ -983,12 +998,12 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + + full_filename = search_path (*scm_loc_load_path, filename, + *scm_loc_load_extensions, SCM_BOOL_F, +- &stat_source); ++ &stat_source, NULL); + + compiled_filename = +- search_path (*scm_loc_load_compiled_path, filename, ++ search_path (load_compiled_path, filename, + *scm_loc_load_compiled_extensions, SCM_BOOL_T, +- &stat_compiled); ++ &stat_compiled, &load_compiled_path_remaining); + + if (scm_is_false (compiled_filename) + && scm_is_true (full_filename) +@@ -1033,7 +1048,32 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + || (scm_is_true (compiled_filename) + && compiled_is_fresh (full_filename, compiled_filename, + &stat_source, &stat_compiled))) +- return scm_load_compiled_with_vm (compiled_filename); ++ { ++ SCM module = scm_load_compiled_with_vm (compiled_filename, SCM_BOOL_T); ++ if (scm_is_false (module) && getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts (";;; note: found broken .go ", ++ scm_current_warning_port ()); ++ scm_display (compiled_filename, scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ if (!scm_is_false (module) || scm_is_false (exception_on_not_found)) ++ return module; ++ if (scm_is_pair (load_compiled_path_remaining)) ++ load_compiled_path_remaining = SCM_CDR (load_compiled_path_remaining); ++ if (scm_is_false (module) && getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts (";;; skipping, continue on path ", ++ scm_current_warning_port ()); ++ scm_display (load_compiled_path_remaining, ++ scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ return scm_primitive_load_path (scm_list_3 ++ (filename, ++ exception_on_not_found, ++ load_compiled_path_remaining)); ++ } + + /* Perhaps there was the installed .go that was stale, but our fallback is + fresh. Let's try that. Duplicating code, but perhaps that's OK. */ +@@ -1063,7 +1103,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + scm_puts (";;; found fresh local cache at ", scm_current_warning_port ()); + scm_display (fallback, scm_current_warning_port ()); + scm_newline (scm_current_warning_port ()); +- return scm_load_compiled_with_vm (fallback); ++ return scm_load_compiled_with_vm (fallback, SCM_BOOL_T); + } + } + +@@ -1072,7 +1112,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + SCM freshly_compiled = scm_try_auto_compile (full_filename); + + if (scm_is_true (freshly_compiled)) +- return scm_load_compiled_with_vm (freshly_compiled); ++ return scm_load_compiled_with_vm (freshly_compiled, SCM_BOOL_F); + else + return scm_primitive_load (full_filename); + } +@@ -1085,28 +1125,56 @@ scm_c_primitive_load_path (const char *filename) + return scm_primitive_load_path (scm_from_locale_string (filename)); + } + +-void +-scm_init_eval_in_scheme (void) ++static void ++internal_scm_init_eval_in_scheme (SCM load_compiled_path) + { + SCM eval_scm, eval_go; + struct stat stat_source, stat_compiled; ++ SCM load_compiled_path_remaining = SCM_EOL; + + eval_scm = search_path (*scm_loc_load_path, + scm_from_locale_string ("ice-9/eval.scm"), +- SCM_EOL, SCM_BOOL_F, &stat_source); ++ SCM_EOL, SCM_BOOL_F, &stat_source, NULL); + eval_go = search_path (*scm_loc_load_compiled_path, + scm_from_locale_string ("ice-9/eval.go"), +- SCM_EOL, SCM_BOOL_F, &stat_compiled); ++ SCM_EOL, SCM_BOOL_F, &stat_compiled, ++ &load_compiled_path_remaining); + + if (scm_is_true (eval_scm) && scm_is_true (eval_go) + && compiled_is_fresh (eval_scm, eval_go, + &stat_source, &stat_compiled)) +- scm_load_compiled_with_vm (eval_go); ++ { ++ SCM module = scm_load_compiled_with_vm (eval_go, SCM_BOOL_T); ++ if (scm_is_pair (load_compiled_path_remaining)) ++ load_compiled_path_remaining = SCM_CDR (load_compiled_path_remaining); ++ if (scm_is_false (module)) ++ { ++ if (getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts (";;; note: found broken .go ", ++ scm_current_warning_port ()); ++ scm_display (eval_go, scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ scm_puts (";;; skipping, continue on path ", ++ scm_current_warning_port ()); ++ scm_display (load_compiled_path_remaining, ++ scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ internal_scm_init_eval_in_scheme (load_compiled_path_remaining); ++ } ++ } + else + /* if we have no eval.go, we shouldn't load any compiled code at all */ + *scm_loc_load_compiled_path = SCM_EOL; + } + ++void ++scm_init_eval_in_scheme (void) ++{ ++ internal_scm_init_eval_in_scheme (*scm_loc_load_compiled_path); ++} ++ + + /* Information about the build environment. */ + +diff --git a/libguile/objcodes.c b/libguile/objcodes.c +index e315f3e..d59c7b7 100644 +--- a/libguile/objcodes.c ++++ b/libguile/objcodes.c +@@ -95,8 +95,8 @@ to_native_order (uint32_t x, char endianness) + return bswap_32 (x); + } + +-static void +-verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) ++static int ++verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr, int nonzero_on_error) + #define FUNC_NAME "make_objcode_from_file" + { + /* The cookie ends with a version of the form M.N, where M is the +@@ -116,6 +116,8 @@ verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) + (void) munmap (map_addr, st->st_size); + #endif + } ++ if (nonzero_on_error) ++ return 1; + scm_misc_error (FUNC_NAME, "bad header on object file: ~s", args); + } + +@@ -131,13 +133,15 @@ verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) + (void) munmap (map_addr, st->st_size); + #endif + } +- ++ if (nonzero_on_error) ++ return 1; + scm_misc_error (FUNC_NAME, "objcode minor version too new (~a > ~a)", + scm_list_2 (scm_from_latin1_stringn (&minor_version, 1), + scm_from_latin1_string + (SCM_OBJCODE_MINOR_VERSION_STRING))); + } + } ++ return 0; + } + #undef FUNC_NAME + +@@ -149,8 +153,10 @@ verify_cookie (char *cookie, struct stat *st, int map_fd, void *map_addr) + - "native code" -- not currently used. + */ + ++#define SCM_BOOL_F_ELSE_SCM_SYSERROR(skip_p) {if (skip_p) {errno = 0; return SCM_BOOL_F;} SCM_SYSERROR;} ++ + static SCM +-make_objcode_from_file (int fd) ++make_objcode_from_file (int fd, int false_on_error) + #define FUNC_NAME "make_objcode_from_file" + { + int ret; +@@ -161,11 +167,15 @@ make_objcode_from_file (int fd) + + ret = fstat (fd, &st); + if (ret < 0) +- SCM_SYSERROR; ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (false_on_error); + + if (st.st_size <= sizeof (struct scm_objcode) + sizeof cookie) +- scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", +- scm_list_1 (SCM_I_MAKINUM (st.st_size))); ++ { ++ if (false_on_error) ++ return SCM_BOOL_F; ++ scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", ++ scm_list_1 (SCM_I_MAKINUM (st.st_size))); ++ } + + #ifdef HAVE_SYS_MMAN_H + { +@@ -179,7 +189,7 @@ make_objcode_from_file (int fd) + int errno_save = errno; + (void) close (fd); + errno = errno_save; +- SCM_SYSERROR; ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (false_on_error); + } + else + { +@@ -187,8 +197,9 @@ make_objcode_from_file (int fd) + data = (struct scm_objcode *) (addr + sizeof cookie); + } + +- verify_cookie (cookie, &st, fd, addr); +- ++ if (verify_cookie (cookie, &st, fd, addr, false_on_error) ++ && false_on_error) ++ return SCM_BOOL_F; + + if (data->len + data->metalen + != (st.st_size - sizeof (*data) - sizeof cookie)) +@@ -220,14 +231,16 @@ make_objcode_from_file (int fd) + int errno_save = errno; + (void) close (fd); + errno = errno_save; +- if (errno) +- SCM_SYSERROR; +- scm_misc_error (FUNC_NAME, "file truncated while reading", SCM_EOL); ++ if (!errno) ++ scm_misc_error (FUNC_NAME, "file truncated while reading", SCM_EOL); ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (false_on_error); + } + + (void) close (fd); + +- verify_cookie (cookie, &st, -1, NULL); ++ if (verify_cookie (cookie, &st, -1, NULL) ++ && false_on_error) ++ return SCM_BOOL_F; + + return scm_bytecode_to_native_objcode (bv); + } +@@ -235,7 +248,6 @@ make_objcode_from_file (int fd) + } + #undef FUNC_NAME + +- + SCM + scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr) + #define FUNC_NAME "make-objcode-slice" +@@ -354,22 +366,29 @@ scm_bytecode_to_native_objcode (SCM bytecode) + return bytecode_to_objcode (bytecode, NATIVE_ENDIANNESS, sizeof (void *)); + } + +-SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0, +- (SCM file), ++SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 1, 0, ++ (SCM file, SCM false_on_error), + "") + #define FUNC_NAME s_scm_load_objcode + { + int fd; + char *c_file; ++ int c_false_on_error; + + SCM_VALIDATE_STRING (1, file); + ++ if (SCM_UNBNDP (false_on_error)) ++ false_on_error = SCM_BOOL_F; ++ ++ c_false_on_error = scm_is_true (false_on_error); ++ + c_file = scm_to_locale_string (file); + fd = open (c_file, O_RDONLY | O_BINARY | O_CLOEXEC); + free (c_file); +- if (fd < 0) SCM_SYSERROR; ++ if (fd < 0) ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (c_false_on_error); + +- return make_objcode_from_file (fd); ++ return make_objcode_from_file (fd, c_false_on_error); + } + #undef FUNC_NAME + +diff --git a/libguile/objcodes.h b/libguile/objcodes.h +index 0cfc8e0..a6d2065 100644 +--- a/libguile/objcodes.h ++++ b/libguile/objcodes.h +@@ -61,7 +61,7 @@ struct scm_objcode + #define SCM_SET_OBJCODE_NATIVE_CODE(x, code) (SCM_SET_CELL_WORD_3 (x, code)) + + SCM_API SCM scm_c_make_objcode_slice (SCM parent, const scm_t_uint8 *ptr); +-SCM_API SCM scm_load_objcode (SCM file); ++SCM_API SCM scm_load_objcode (SCM file, SCM false_on_error); + SCM_API SCM scm_objcode_p (SCM obj); + SCM_API SCM scm_objcode_meta (SCM objcode); + SCM_API SCM scm_bytecode_to_objcode (SCM bytecode); +diff --git a/libguile/vm.c b/libguile/vm.c +index d4c8b5f..dc8fff9 100644 +--- a/libguile/vm.c ++++ b/libguile/vm.c +@@ -1071,11 +1071,14 @@ SCM_DEFINE (scm_call_with_vm, "call-with-vm", 2, 0, 1, + * Initialize + */ + +-SCM scm_load_compiled_with_vm (SCM file) ++SCM ++scm_load_compiled_with_vm (SCM file, SCM false_on_error) + { +- SCM program = scm_make_program (scm_load_objcode (file), +- SCM_BOOL_F, SCM_BOOL_F); +- ++ SCM program; ++ SCM objcode = scm_load_objcode (file, false_on_error); ++ if (scm_is_false (objcode) && scm_is_true (false_on_error)) ++ return SCM_BOOL_F; ++ program = scm_make_program (objcode, SCM_BOOL_F, SCM_BOOL_F); + return scm_c_vm_run (scm_the_vm (), program, NULL, 0); + } + +diff --git a/libguile/vm.h b/libguile/vm.h +index d354a53..56b05de 100644 +--- a/libguile/vm.h ++++ b/libguile/vm.h +@@ -101,7 +101,7 @@ struct scm_vm_cont { + #define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_PARTIAL) + #define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_REWINDABLE) + +-SCM_API SCM scm_load_compiled_with_vm (SCM file); ++SCM_API SCM scm_load_compiled_with_vm (SCM file, SCM false_on_error); + + SCM_INTERNAL SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs); + +-- +2.6.3 + diff --git a/gnu/packages/patches/guile-install-versioned.patch b/gnu/packages/patches/guile-install-versioned.patch new file mode 100644 index 0000000..986cde6 --- /dev/null +++ b/gnu/packages/patches/guile-install-versioned.patch @@ -0,0 +1,30 @@ +From b8ba5b84e9df796bd0ed62e105425419531d779e Mon Sep 17 00:00:00 2001 +From: Jan Nieuwenhuizen +Date: Mon, 14 Mar 2016 07:40:49 +0100 +Subject: [PATCH] Install guile-EFFECTIVE_VERSION and guile-MAJOR_VERSION too. + +* libguile/Makefile.am (install-exec-hook): Add versioned symlinks for + guile executable. +--- + libguile/Makefile.am | 5 +++++ + 1 file changed, 5 insertions(+) + +diff --git a/libguile/Makefile.am b/libguile/Makefile.am +index 3bc9952..32a4850 100644 +--- a/libguile/Makefile.am ++++ b/libguile/Makefile.am +@@ -464,6 +464,11 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = _scm.h \ + ## wiped out. + install-exec-hook: + rm -f $(DESTDIR)$(bindir)/guile-snarf.awk ++ cd $(DESTDIR)$(bindir) && \ ++ rm -f guile-$(GUILE_MAJOR_VERSION)$(EXEEXT) && \ ++ mv -f guile$(EXEEXT) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) && \ ++ $(LN_S) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) guile$(EXEEXT) && \ ++ $(LN_S) guile-$(GUILE_EFFECTIVE_VERSION)$(EXEEXT) guile-$(GUILE_MAJOR_VERSION)$(EXEEXT) + + install-data-hook: libguile-2.2-gdb.scm + @$(MKDIR_P) $(DESTDIR)$(libdir) +-- +2.6.3 + diff --git a/gnu/packages/patches/guile-skip-invalid-go.patch b/gnu/packages/patches/guile-skip-invalid-go.patch new file mode 100644 index 0000000..eaf4a29 --- /dev/null +++ b/gnu/packages/patches/guile-skip-invalid-go.patch @@ -0,0 +1,415 @@ +From 515d23b52baacc62bebdf5986292303596674d16 Mon Sep 17 00:00:00 2001 +From: Jan Nieuwenhuizen +Date: Fri, 11 Mar 2016 14:58:09 +0100 +Subject: [PATCH] Skip invalid compiled file found, continue searching path. + +* libguile/vm.c (scm_load_compiled_with_vm): Add argument + FALSE_ON_ERROR. +* libguile/loader.c (load_thunk_from_memory, scm_load_thunk_from_file, + map_file_contents): Idem. +* libguile/load.c (search_path): Take optional output argument + PATH_REMAINING. + (scm_primitive_load_path): Use it. Take optional argument + LOAD_COMPILED_PATH. Skip any invalid compiled file found and + continue searching scm_loc_load_compiled_path. + (internal_scm_init_eval_in_scheme): New function. Implementation + of scm_init_eval_in_scheme, taking path parameter to implement + skipping any invalid eval.go's in path. + (scm_init_eval_in_scheme): Use it. +--- + libguile/load.c | 107 ++++++++++++++++++++++++++++++++++++++++++++---------- + libguile/loader.c | 42 +++++++++++++-------- + libguile/loader.h | 2 +- + libguile/vm.c | 8 ++-- + libguile/vm.h | 2 +- + 5 files changed, 122 insertions(+), 39 deletions(-) + +diff --git a/libguile/load.c b/libguile/load.c +index d26f9fc..b9db988 100644 +--- a/libguile/load.c ++++ b/libguile/load.c +@@ -582,12 +582,15 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename, + file name that we find in the path. Otherwise only return a file if + it is newer than SOURCE_STAT_BUF, otherwise issuing a warning if we + see a stale file earlier in the path, setting *FOUND_STALE_FILE to 1. +- */ ++ ++ If PATH_REMAINING is not NULL, it is set to the tail of PATH that was ++ not skipped. */ + static SCM + search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, + struct stat *stat_buf, + SCM source_file_name, struct stat *source_stat_buf, +- int *found_stale_file) ++ int *found_stale_file, ++ SCM *path_remaining) + { + struct stringbuf buf; + char *filename_chars; +@@ -724,6 +727,8 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, + + end: + scm_dynwind_end (); ++ if (path_remaining) ++ *path_remaining = path; + return result; + } + +@@ -781,7 +786,7 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1, + require_exts = SCM_BOOL_F; + + return search_path (path, filename, extensions, require_exts, &stat_buf, +- SCM_BOOL_F, NULL, NULL); ++ SCM_BOOL_F, NULL, NULL, NULL); + } + #undef FUNC_NAME + +@@ -806,7 +811,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0, + SCM_VALIDATE_STRING (1, filename); + + return search_path (*scm_loc_load_path, filename, *scm_loc_load_extensions, +- SCM_BOOL_F, &stat_buf, SCM_BOOL_F, NULL, NULL); ++ SCM_BOOL_F, &stat_buf, SCM_BOOL_F, NULL, NULL, NULL); + } + #undef FUNC_NAME + +@@ -969,14 +974,19 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + "depending on the optional second argument,\n" + "@var{exception_on_not_found}. If it is @code{#f}, @code{#f}\n" + "will be returned. If it is a procedure, it will be called\n" +- "with no arguments. Otherwise an error is signalled.") ++ "with no arguments. Otherwise an error is signalled." ++ "If the optional third argument,\n" ++ "@var{load_compiled_path} is given, use it to search for compiled files\n" ++ "instead of @var{*scm_loc_load_compiled_path}.") + #define FUNC_NAME s_scm_primitive_load_path + { + SCM filename, exception_on_not_found; + SCM full_filename, compiled_filename; + SCM hook = *scm_loc_load_hook; + struct stat stat_source, stat_compiled; ++ SCM load_compiled_path; + int found_stale_compiled_file = 0; ++ SCM load_compiled_path_remaining = SCM_EOL; + + if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) + SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f", +@@ -988,21 +998,27 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + single argument (the file name). */ + filename = args; + exception_on_not_found = SCM_UNDEFINED; ++ load_compiled_path = *scm_loc_load_compiled_path; + } + else + { +- /* Starting from 1.9, this function takes 1 required and 1 optional +- argument. */ ++ /* Starting from 1.9, this function takes 1 required and 1 ++ optional argument. ++ ++ Starting from 2.1.2, this function takes 1 required and 2 ++ optional arguments. */ + long len; + + SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1, args, len); +- if (len < 1 || len > 2) ++ if (len < 1 || len > 3) + scm_error_num_args_subr (FUNC_NAME); + + filename = SCM_CAR (args); + SCM_VALIDATE_STRING (SCM_ARG1, filename); + + exception_on_not_found = len > 1 ? SCM_CADR (args) : SCM_UNDEFINED; ++ load_compiled_path = len < 3 ? *scm_loc_load_compiled_path ++ : SCM_CADDR (args); + } + + if (SCM_UNBNDP (exception_on_not_found)) +@@ -1010,13 +1026,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + + full_filename = search_path (*scm_loc_load_path, filename, + *scm_loc_load_extensions, SCM_BOOL_F, +- &stat_source, SCM_BOOL_F, NULL, NULL); ++ &stat_source, SCM_BOOL_F, NULL, NULL, NULL); + + compiled_filename = +- search_path (*scm_loc_load_compiled_path, filename, ++ search_path (load_compiled_path, filename, + *scm_loc_load_compiled_extensions, SCM_BOOL_T, + &stat_compiled, full_filename, &stat_source, +- &found_stale_compiled_file); ++ &found_stale_compiled_file, &load_compiled_path_remaining); + + if (scm_is_false (compiled_filename) + && scm_is_true (full_filename) +@@ -1066,13 +1082,38 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, + ? full_filename : compiled_filename)); + + if (scm_is_true (compiled_filename)) +- return scm_load_compiled_with_vm (compiled_filename); ++ { ++ SCM module = scm_load_compiled_with_vm (compiled_filename, SCM_BOOL_T); ++ if (scm_is_false (module) && getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts_unlocked (";;; note: found broken .go ", ++ scm_current_warning_port ()); ++ scm_display (compiled_filename, scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ if (!scm_is_false (module) || scm_is_false (exception_on_not_found)) ++ return module; ++ if (scm_is_pair (load_compiled_path_remaining)) ++ load_compiled_path_remaining = SCM_CDR (load_compiled_path_remaining); ++ if (scm_is_false (module) && getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts_unlocked (";;; skipping, continue on path ", ++ scm_current_warning_port ()); ++ scm_display (load_compiled_path_remaining, ++ scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ return scm_primitive_load_path (scm_list_3 ++ (filename, ++ exception_on_not_found, ++ load_compiled_path_remaining)); ++ } + else + { + SCM freshly_compiled = scm_try_auto_compile (full_filename); + + if (scm_is_true (freshly_compiled)) +- return scm_load_compiled_with_vm (freshly_compiled); ++ return scm_load_compiled_with_vm (freshly_compiled, SCM_BOOL_F); + else + return scm_primitive_load (full_filename); + } +@@ -1085,30 +1126,58 @@ scm_c_primitive_load_path (const char *filename) + return scm_primitive_load_path (scm_from_locale_string (filename)); + } + +-void +-scm_init_eval_in_scheme (void) ++static void ++internal_scm_init_eval_in_scheme (SCM load_compiled_path) + { + SCM eval_scm, eval_go; + struct stat stat_source, stat_compiled; + int found_stale_eval_go = 0; ++ SCM load_compiled_path_remaining = SCM_EOL; + + eval_scm = search_path (*scm_loc_load_path, + scm_from_locale_string ("ice-9/eval.scm"), + SCM_EOL, SCM_BOOL_F, &stat_source, +- SCM_BOOL_F, NULL, NULL); +- eval_go = search_path (*scm_loc_load_compiled_path, ++ SCM_BOOL_F, NULL, NULL, NULL); ++ eval_go = search_path (load_compiled_path, + scm_from_locale_string ("ice-9/eval.go"), + SCM_EOL, SCM_BOOL_F, &stat_compiled, +- eval_scm, &stat_source, &found_stale_eval_go); ++ eval_scm, &stat_source, &found_stale_eval_go, ++ &load_compiled_path_remaining); + + if (scm_is_true (eval_go)) +- scm_load_compiled_with_vm (eval_go); ++ { ++ SCM module = scm_load_compiled_with_vm (eval_go, SCM_BOOL_T); ++ if (scm_is_pair (load_compiled_path_remaining)) ++ load_compiled_path_remaining = SCM_CDR (load_compiled_path_remaining); ++ if (scm_is_false (module)) ++ { ++ if (getenv ("GUILE_DEBUG_GO")) ++ { ++ scm_puts_unlocked (";;; note: found broken .go ", ++ scm_current_warning_port ()); ++ scm_display (eval_go, scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ scm_puts_unlocked (";;; skipping, continue on path ", ++ scm_current_warning_port ()); ++ scm_display (load_compiled_path_remaining, ++ scm_current_warning_port ()); ++ scm_newline (scm_current_warning_port ()); ++ } ++ internal_scm_init_eval_in_scheme (load_compiled_path_remaining); ++ } ++ } + else + /* If we have no eval.go, we shouldn't load any compiled code at all + because we can't guarantee that tail calls will work. */ + *scm_loc_load_compiled_path = SCM_EOL; + } + ++void ++scm_init_eval_in_scheme (void) ++{ ++ internal_scm_init_eval_in_scheme (*scm_loc_load_compiled_path); ++} ++ + + /* Information about the build environment. */ + +diff --git a/libguile/loader.c b/libguile/loader.c +index 97effb3..bf72805 100644 +--- a/libguile/loader.c ++++ b/libguile/loader.c +@@ -340,9 +340,12 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr, + } + + #define ABORT(msg) do { err_msg = msg; goto cleanup; } while (0) ++#define NULL_ELSE_SCM_SYSERROR(skip_p) {if (skip_p) {errno = 0; return NULL;} SCM_SYSERROR;} ++#define SCM_BOOL_F_ELSE_SCM_SYSERROR(skip_p) {if (skip_p) {errno = 0; return SCM_BOOL_F;} SCM_SYSERROR;} + + static SCM +-load_thunk_from_memory (char *data, size_t len, int is_read_only) ++load_thunk_from_memory (char *data, size_t len, int is_read_only, ++ int false_on_error) + #define FUNC_NAME "load-thunk-from-memory" + { + Elf_Ehdr *header; +@@ -456,10 +459,10 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only) + + cleanup: + { +- if (errno) +- SCM_SYSERROR; +- scm_misc_error (FUNC_NAME, err_msg ? err_msg : "error loading ELF file", +- SCM_EOL); ++ if (!errno) ++ scm_misc_error (FUNC_NAME, err_msg ? err_msg : "error loading ELF file", ++ SCM_EOL); ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (false_on_error); + } + } + #undef FUNC_NAME +@@ -467,7 +470,7 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only) + #define SCM_PAGE_SIZE 4096 + + static char* +-map_file_contents (int fd, size_t len, int *is_read_only) ++map_file_contents (int fd, size_t len, int *is_read_only, int false_on_error) + #define FUNC_NAME "load-thunk-from-file" + { + char *data; +@@ -475,7 +478,7 @@ map_file_contents (int fd, size_t len, int *is_read_only) + #ifdef HAVE_SYS_MMAN_H + data = mmap (NULL, len, PROT_READ, MAP_PRIVATE, fd, 0); + if (data == MAP_FAILED) +- SCM_SYSERROR; ++ NULL_ELSE_SCM_SYSERROR (false_on_error); + *is_read_only = 1; + #else + if (lseek (fd, 0, SEEK_START) < 0) +@@ -483,7 +486,7 @@ map_file_contents (int fd, size_t len, int *is_read_only) + int errno_save = errno; + (void) close (fd); + errno = errno_save; +- SCM_SYSERROR; ++ NULL_ELSE_SCM_SYSERROR (false_on_error); + } + + /* Given that we are using the read fallback, optimistically assume +@@ -527,8 +530,8 @@ map_file_contents (int fd, size_t len, int *is_read_only) + } + #undef FUNC_NAME + +-SCM_DEFINE (scm_load_thunk_from_file, "load-thunk-from-file", 1, 0, 0, +- (SCM filename), ++SCM_DEFINE (scm_load_thunk_from_file, "load-thunk-from-file", 1, 1, 0, ++ (SCM filename, SCM false_on_error), + "") + #define FUNC_NAME s_scm_load_thunk_from_file + { +@@ -539,20 +542,29 @@ SCM_DEFINE (scm_load_thunk_from_file, "load-thunk-from-file", 1, 0, 0, + + SCM_VALIDATE_STRING (1, filename); + ++ if (SCM_UNBNDP (false_on_error)) ++ false_on_error = SCM_BOOL_F; ++ + c_filename = scm_to_locale_string (filename); + fd = open (c_filename, O_RDONLY | O_BINARY | O_CLOEXEC); + free (c_filename); +- if (fd < 0) SCM_SYSERROR; ++ if (fd < 0) ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (scm_is_true (false_on_error)); + + end = lseek (fd, 0, SEEK_END); + if (end < 0) +- SCM_SYSERROR; ++ SCM_BOOL_F_ELSE_SCM_SYSERROR (scm_is_true (false_on_error)); + +- data = map_file_contents (fd, end, &is_read_only); ++ data = map_file_contents (fd, end, &is_read_only, ++ scm_is_true (false_on_error)); + + (void) close (fd); + +- return load_thunk_from_memory (data, end, is_read_only); ++ if (data == NULL && scm_is_true (false_on_error)) ++ return SCM_BOOL_F; ++ ++ return load_thunk_from_memory (data, end, is_read_only, ++ scm_is_true (false_on_error)); + } + #undef FUNC_NAME + +@@ -574,7 +586,7 @@ SCM_DEFINE (scm_load_thunk_from_memory, "load-thunk-from-memory", 1, 0, 0, + + data = copy_and_align_elf_data (data, len); + +- return load_thunk_from_memory (data, len, 0); ++ return load_thunk_from_memory (data, len, 0, 0); + } + #undef FUNC_NAME + +diff --git a/libguile/loader.h b/libguile/loader.h +index 5c719cb..e332abc 100644 +--- a/libguile/loader.h ++++ b/libguile/loader.h +@@ -21,7 +21,7 @@ + + #include + +-SCM_API SCM scm_load_thunk_from_file (SCM filename); ++SCM_API SCM scm_load_thunk_from_file (SCM filename, SCM exception_on_not_found_p); + SCM_API SCM scm_load_thunk_from_memory (SCM bv); + + SCM_INTERNAL const scm_t_uint8 * +diff --git a/libguile/vm.c b/libguile/vm.c +index 33f12b4..d22990d 100644 +--- a/libguile/vm.c ++++ b/libguile/vm.c +@@ -1501,12 +1501,14 @@ SCM_DEFINE (scm_call_with_stack_overflow_handler, + */ + + SCM +-scm_load_compiled_with_vm (SCM file) ++scm_load_compiled_with_vm (SCM file, SCM false_on_error) + { +- return scm_call_0 (scm_load_thunk_from_file (file)); ++ SCM thunk = scm_load_thunk_from_file (file, false_on_error); ++ if (scm_is_false (thunk) && scm_is_true (false_on_error)) ++ return SCM_BOOL_F; ++ return scm_call_0 (thunk); + } + +- + void + scm_init_vm_builtin_properties (void) + { +diff --git a/libguile/vm.h b/libguile/vm.h +index 2ca4f2a..037b1cb 100644 +--- a/libguile/vm.h ++++ b/libguile/vm.h +@@ -93,7 +93,7 @@ struct scm_vm_cont { + #define SCM_VM_CONT_PARTIAL_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_PARTIAL) + #define SCM_VM_CONT_REWINDABLE_P(CONT) (SCM_VM_CONT_DATA (CONT)->flags & SCM_F_VM_CONT_REWINDABLE) + +-SCM_API SCM scm_load_compiled_with_vm (SCM file); ++SCM_API SCM scm_load_compiled_with_vm (SCM file, SCM false_on_error); + + SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc); + SCM_INTERNAL SCM scm_i_capture_current_stack (void); +-- +2.6.3 + -- 2.6.3 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20 --=-=-=--