mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

load-path will skip over stale .go files and keep going

Browse source 
* libguile/load.c (compiled_is_fresh): Write warnings to warning port.
  Move up in the file.
  (search_path): Add ability to skip over matching files in the path
  that are stale, relative to some other corresponding file.
  (scm_search_path, scm_sys_search_load_path): Adapt to search_path
  changes.
  (do_try_auto_compile): Write status to warning port.
  (scm_primitive_load_path): Use new search_path ability to skip over
  stale files.  Allows updates to source files to use freshly-compiled
  bootstrap files, when building Guile itself.  Also allows
  simplification of fallback logic.
  (scm_init_eval_in_scheme): Skip stale eval.go files in the path.
This commit is contained in:
Andy Wingo 2015-11-11 15:38:45 +01:00
parent 25738ec35d
commit 13edcf57a0
1 changed files with 100 additions and 97 deletions
Download patch file Download diff file Expand all files Collapse all files

187
libguile/load.c
View file

@ -541,16 +541,53 @@ is_absolute_file_name (SCM filename)
return 0; return 0;
} }
/* Return true if COMPILED_FILENAME is newer than source file
FULL_FILENAME, false otherwise. */
static int
compiled_is_fresh (SCM full_filename, SCM compiled_filename,
struct stat *stat_source, struct stat *stat_compiled)
{
int compiled_is_newer;
struct timespec source_mtime, compiled_mtime;
source_mtime = get_stat_mtime (stat_source);
compiled_mtime = get_stat_mtime (stat_compiled);
if (source_mtime.tv_sec < compiled_mtime.tv_sec
|| (source_mtime.tv_sec == compiled_mtime.tv_sec
&& source_mtime.tv_nsec <= compiled_mtime.tv_nsec))
compiled_is_newer = 1;
else
{
compiled_is_newer = 0;
scm_puts_unlocked (";;; note: source file ", scm_current_warning_port ());
scm_display (full_filename, scm_current_warning_port ());
scm_puts_unlocked ("\n;;; newer than compiled ", scm_current_warning_port ());
scm_display (compiled_filename, scm_current_warning_port ());
scm_puts_unlocked ("\n", scm_current_warning_port ());
}
return compiled_is_newer;
}
/* Search PATH for a directory containing a file named FILENAME. /* Search PATH for a directory containing a file named FILENAME.
The file must be readable, and not a directory. The file must be readable, and not a directory.
If we find one, return its full pathname; otherwise, return #f. If we find one, return its full pathname; otherwise, return #f.
If FILENAME is absolute, return it unchanged. If FILENAME is absolute, return it unchanged.
We also fill *stat_buf corresponding to the returned pathname. We also fill *stat_buf corresponding to the returned pathname.
If given, EXTENSIONS is a list of strings; for each directory 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 SOURCE_FILE_NAME is SCM_BOOL_F, then return the first matching
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.
*/
static SCM static SCM
search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
struct stat *stat_buf) struct stat *stat_buf,
SCM source_file_name, struct stat *source_stat_buf,
int *found_stale_file)
{ {
struct stringbuf buf; struct stringbuf buf;
char *filename_chars; char *filename_chars;
@ -653,8 +690,27 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts,
if (stat (buf.buf, stat_buf) == 0 if (stat (buf.buf, stat_buf) == 0
&& ! (stat_buf->st_mode & S_IFDIR)) && ! (stat_buf->st_mode & S_IFDIR))
{ {
result = SCM found =
scm_from_locale_string (scm_i_mirror_backslashes (buf.buf)); scm_from_locale_string (scm_i_mirror_backslashes (buf.buf));
if (scm_is_true (source_file_name) &&
!compiled_is_fresh (source_file_name, found,
source_stat_buf, stat_buf))
{
if (found_stale_file)
*found_stale_file = 1;
continue;
}
if (found_stale_file && *found_stale_file)
{
scm_puts_unlocked (";;; found fresh compiled file at ",
scm_current_warning_port ());
scm_display (found, scm_current_warning_port ());
scm_newline (scm_current_warning_port ());
}
result = found;
goto end; goto end;
} }
} }
@ -724,7 +780,8 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1,
if (SCM_UNBNDP (require_exts)) if (SCM_UNBNDP (require_exts))
require_exts = SCM_BOOL_F; 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,
SCM_BOOL_F, NULL, NULL);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -749,40 +806,11 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
SCM_VALIDATE_STRING (1, filename); SCM_VALIDATE_STRING (1, filename);
return search_path (*scm_loc_load_path, filename, *scm_loc_load_extensions, return search_path (*scm_loc_load_path, filename, *scm_loc_load_extensions,
SCM_BOOL_F, &stat_buf); SCM_BOOL_F, &stat_buf, SCM_BOOL_F, NULL, NULL);
} }
#undef FUNC_NAME #undef FUNC_NAME
/* Return true if COMPILED_FILENAME is newer than source file
FULL_FILENAME, false otherwise. */
static int
compiled_is_fresh (SCM full_filename, SCM compiled_filename,
struct stat *stat_source, struct stat *stat_compiled)
{
int compiled_is_newer;
struct timespec source_mtime, compiled_mtime;
source_mtime = get_stat_mtime (stat_source);
compiled_mtime = get_stat_mtime (stat_compiled);
if (source_mtime.tv_sec < compiled_mtime.tv_sec
|| (source_mtime.tv_sec == compiled_mtime.tv_sec
&& source_mtime.tv_nsec <= compiled_mtime.tv_nsec))
compiled_is_newer = 1;
else
{
compiled_is_newer = 0;
scm_puts_unlocked (";;; note: source file ", scm_current_error_port ());
scm_display (full_filename, scm_current_error_port ());
scm_puts_unlocked ("\n;;; newer than compiled ", scm_current_error_port ());
scm_display (compiled_filename, scm_current_error_port ());
scm_puts_unlocked ("\n", scm_current_error_port ());
}
return compiled_is_newer;
}
SCM_KEYWORD (kw_env, "env"); SCM_KEYWORD (kw_env, "env");
SCM_KEYWORD (kw_opts, "opts"); SCM_KEYWORD (kw_opts, "opts");
@ -795,9 +823,9 @@ do_try_auto_compile (void *data)
SCM source = SCM_PACK_POINTER (data); SCM source = SCM_PACK_POINTER (data);
SCM comp_mod, compile_file; SCM comp_mod, compile_file;
scm_puts_unlocked (";;; compiling ", scm_current_error_port ()); scm_puts_unlocked (";;; compiling ", scm_current_warning_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_warning_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_warning_port ());
comp_mod = scm_c_resolve_module ("system base compile"); comp_mod = scm_c_resolve_module ("system base compile");
compile_file = scm_module_variable (comp_mod, sym_compile_file); compile_file = scm_module_variable (comp_mod, sym_compile_file);
@ -824,17 +852,17 @@ do_try_auto_compile (void *data)
/* Assume `*current-warning-prefix*' has an appropriate value. */ /* Assume `*current-warning-prefix*' has an appropriate value. */
res = scm_call_n (scm_variable_ref (compile_file), args, 5); res = scm_call_n (scm_variable_ref (compile_file), args, 5);
scm_puts_unlocked (";;; compiled ", scm_current_error_port ()); scm_puts_unlocked (";;; compiled ", scm_current_warning_port ());
scm_display (res, scm_current_error_port ()); scm_display (res, scm_current_warning_port ());
scm_newline (scm_current_error_port ()); scm_newline (scm_current_warning_port ());
return res; return res;
} }
else else
{ {
scm_puts_unlocked (";;; it seems ", scm_current_error_port ()); scm_puts_unlocked (";;; it seems ", scm_current_warning_port ());
scm_display (source, scm_current_error_port ()); scm_display (source, scm_current_warning_port ());
scm_puts_unlocked ("\n;;; is part of the compiler; skipping auto-compilation\n", scm_puts_unlocked ("\n;;; is part of the compiler; skipping auto-compilation\n",
scm_current_error_port ()); scm_current_warning_port ());
return SCM_BOOL_F; return SCM_BOOL_F;
} }
} }
@ -946,9 +974,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
{ {
SCM filename, exception_on_not_found; SCM filename, exception_on_not_found;
SCM full_filename, compiled_filename; SCM full_filename, compiled_filename;
int compiled_is_fallback = 0;
SCM hook = *scm_loc_load_hook; SCM hook = *scm_loc_load_hook;
struct stat stat_source, stat_compiled; struct stat stat_source, stat_compiled;
int found_stale_compiled_file = 0;
if (scm_is_true (hook) && scm_is_false (scm_procedure_p (hook))) 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", SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
@ -982,12 +1010,13 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
full_filename = search_path (*scm_loc_load_path, filename, full_filename = search_path (*scm_loc_load_path, filename,
*scm_loc_load_extensions, SCM_BOOL_F, *scm_loc_load_extensions, SCM_BOOL_F,
&stat_source); &stat_source, SCM_BOOL_F, NULL, NULL);
compiled_filename = compiled_filename =
search_path (*scm_loc_load_compiled_path, filename, search_path (*scm_loc_load_compiled_path, filename,
*scm_loc_load_compiled_extensions, SCM_BOOL_T, *scm_loc_load_compiled_extensions, SCM_BOOL_T,
&stat_compiled); &stat_compiled, full_filename, &stat_source,
&found_stale_compiled_file);
if (scm_is_false (compiled_filename) if (scm_is_false (compiled_filename)
&& scm_is_true (full_filename) && scm_is_true (full_filename)
@ -1005,10 +1034,18 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
scm_car (*scm_loc_load_compiled_extensions))); scm_car (*scm_loc_load_compiled_extensions)));
fallback_chars = scm_to_locale_string (fallback); fallback_chars = scm_to_locale_string (fallback);
if (stat (fallback_chars, &stat_compiled) == 0) if (stat (fallback_chars, &stat_compiled) == 0
&& compiled_is_fresh (full_filename, fallback,
&stat_source, &stat_compiled))
{ {
if (found_stale_compiled_file)
{
scm_puts_unlocked (";;; found fresh local cache at ",
scm_current_warning_port ());
scm_display (fallback, scm_current_warning_port ());
scm_newline (scm_current_warning_port ());
}
compiled_filename = fallback; compiled_filename = fallback;
compiled_is_fallback = 1;
} }
free (fallback_chars); free (fallback_chars);
} }
@ -1028,45 +1065,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
scm_call_1 (hook, (scm_is_true (full_filename) scm_call_1 (hook, (scm_is_true (full_filename)
? full_filename : compiled_filename)); ? full_filename : compiled_filename));
if (scm_is_false (full_filename) if (scm_is_true (compiled_filename))
|| (scm_is_true (compiled_filename)
&& compiled_is_fresh (full_filename, compiled_filename,
&stat_source, &stat_compiled)))
return scm_load_compiled_with_vm (compiled_filename); return scm_load_compiled_with_vm (compiled_filename);
else
/* 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. */
if (!compiled_is_fallback
&& scm_is_true (*scm_loc_compile_fallback_path)
&& scm_is_false (*scm_loc_fresh_auto_compile)
&& scm_is_pair (*scm_loc_load_compiled_extensions)
&& scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
{
SCM fallback;
char *fallback_chars;
int stat_ret;
fallback = scm_string_append
(scm_list_3 (*scm_loc_compile_fallback_path,
canonical_suffix (full_filename),
scm_car (*scm_loc_load_compiled_extensions)));
fallback_chars = scm_to_locale_string (fallback);
stat_ret = stat (fallback_chars, &stat_compiled);
free (fallback_chars);
if (stat_ret == 0 && compiled_is_fresh (full_filename, fallback,
&stat_source, &stat_compiled))
{
scm_puts_unlocked (";;; 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);
}
}
/* Otherwise, we bottom out here. */
{ {
SCM freshly_compiled = scm_try_auto_compile (full_filename); SCM freshly_compiled = scm_try_auto_compile (full_filename);
@ -1089,20 +1090,22 @@ scm_init_eval_in_scheme (void)
{ {
SCM eval_scm, eval_go; SCM eval_scm, eval_go;
struct stat stat_source, stat_compiled; struct stat stat_source, stat_compiled;
int found_stale_eval_go = 0;
eval_scm = search_path (*scm_loc_load_path, eval_scm = search_path (*scm_loc_load_path,
scm_from_locale_string ("ice-9/eval.scm"), scm_from_locale_string ("ice-9/eval.scm"),
SCM_EOL, SCM_BOOL_F, &stat_source); SCM_EOL, SCM_BOOL_F, &stat_source,
SCM_BOOL_F, NULL, NULL);
eval_go = search_path (*scm_loc_load_compiled_path, eval_go = search_path (*scm_loc_load_compiled_path,
scm_from_locale_string ("ice-9/eval.go"), scm_from_locale_string ("ice-9/eval.go"),
SCM_EOL, SCM_BOOL_F, &stat_compiled); SCM_EOL, SCM_BOOL_F, &stat_compiled,
eval_scm, &stat_source, &found_stale_eval_go);
if (scm_is_true (eval_scm) && scm_is_true (eval_go) if (scm_is_true (eval_go))
&& compiled_is_fresh (eval_scm, eval_go,
&stat_source, &stat_compiled))
scm_load_compiled_with_vm (eval_go); scm_load_compiled_with_vm (eval_go);
else else
/* if we have no eval.go, we shouldn't load any compiled code at all */ /* 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; *scm_loc_load_compiled_path = SCM_EOL;
} }