From f356b4dc8feef19fcab66967cd99575e6e96a4d5 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. --- libguile/load.c | 72 ++++++++++++++++++++++++++++++++++++++++++------------- libguile/loader.c | 42 ++++++++++++++++++++------------ libguile/loader.h | 2 +- libguile/vm.c | 8 ++++--- libguile/vm.h | 2 +- 5 files changed, 90 insertions(+), 36 deletions(-) diff --git a/libguile/load.c b/libguile/load.c index d26f9fc..4c3ae86 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,37 @@ 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 (module == SCM_BOOL_F && 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 (module != SCM_BOOL_F || 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 (module == SCM_BOOL_F && 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); } @@ -1095,14 +1135,14 @@ scm_init_eval_in_scheme (void) 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); + SCM_BOOL_F, NULL, NULL, 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, - eval_scm, &stat_source, &found_stale_eval_go); + eval_scm, &stat_source, &found_stale_eval_go, NULL); if (scm_is_true (eval_go)) - scm_load_compiled_with_vm (eval_go); + scm_load_compiled_with_vm (eval_go, SCM_BOOL_F); 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. */ 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