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