[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH v4] Skip invalid compiled file found, continue searching path
From: |
Jan Nieuwenhuizen |
Subject: |
Re: [PATCH v4] Skip invalid compiled file found, continue searching path. |
Date: |
Mon, 14 Mar 2016 17:10:02 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.5 (gnu/linux) |
Jan Nieuwenhuizen writes:
The previous version v3 works for skipping modules after guile
has booted, this v4 also handles skipping any wrong `eval.go'.
I have included some error feedback when you set
GUILE_DEBUG_GO=1
mainly to inspect and review the functionality, I suggest to get all
that out again.
Greetings,
Jan
>From 515d23b52baacc62bebdf5986292303596674d16 Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <address@hidden>
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 <libguile.h>
-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
--
Jan Nieuwenhuizen <address@hidden> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.nl
Re: [PATCH] Append effective version to GUILE_LOAD[_COMPILED]_PATH, Mikael Djurfeldt, 2016/03/16