mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +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

197
libguile/load.c
View file

@ -541,16 +541,53 @@ is_absolute_file_name (SCM filename)
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.
The file must be readable, and not a directory.
If we find one, return its full pathname; otherwise, return #f.
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 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
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;
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
&& ! (stat_buf->st_mode & S_IFDIR))
{
result =
SCM found =
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;
}
}
@ -724,7 +780,8 @@ 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,
SCM_BOOL_F, NULL, NULL);
}
#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);
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
/* 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_opts, "opts");
@ -795,9 +823,9 @@ do_try_auto_compile (void *data)
SCM source = SCM_PACK_POINTER (data);
SCM comp_mod, compile_file;
scm_puts_unlocked (";;; compiling ", scm_current_error_port ());
scm_display (source, scm_current_error_port ());
scm_newline (scm_current_error_port ());
scm_puts_unlocked (";;; compiling ", scm_current_warning_port ());
scm_display (source, scm_current_warning_port ());
scm_newline (scm_current_warning_port ());
comp_mod = scm_c_resolve_module ("system base compile");
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. */
res = scm_call_n (scm_variable_ref (compile_file), args, 5);
scm_puts_unlocked (";;; compiled ", scm_current_error_port ());
scm_display (res, scm_current_error_port ());
scm_newline (scm_current_error_port ());
scm_puts_unlocked (";;; compiled ", scm_current_warning_port ());
scm_display (res, scm_current_warning_port ());
scm_newline (scm_current_warning_port ());
return res;
}
else
{
scm_puts_unlocked (";;; it seems ", scm_current_error_port ());
scm_display (source, scm_current_error_port ());
scm_puts_unlocked (";;; it seems ", scm_current_warning_port ());
scm_display (source, scm_current_warning_port ());
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;
}
}
@ -946,9 +974,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
{
SCM filename, exception_on_not_found;
SCM full_filename, compiled_filename;
int compiled_is_fallback = 0;
SCM hook = *scm_loc_load_hook;
struct stat stat_source, stat_compiled;
int found_stale_compiled_file = 0;
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",
@ -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,
*scm_loc_load_extensions, SCM_BOOL_F,
&stat_source);
&stat_source, SCM_BOOL_F, NULL, NULL);
compiled_filename =
search_path (*scm_loc_load_compiled_path, filename,
*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)
&& 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)));
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_is_fallback = 1;
}
free (fallback_chars);
}
@ -1028,53 +1065,17 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
scm_call_1 (hook, (scm_is_true (full_filename)
? full_filename : compiled_filename));
if (scm_is_false (full_filename)
|| (scm_is_true (compiled_filename)
&& compiled_is_fresh (full_filename, compiled_filename,
&stat_source, &stat_compiled)))
if (scm_is_true (compiled_filename))
return scm_load_compiled_with_vm (compiled_filename);
/* 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)))
else
{
SCM fallback;
char *fallback_chars;
int stat_ret;
SCM freshly_compiled = scm_try_auto_compile (full_filename);
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);
}
if (scm_is_true (freshly_compiled))
return scm_load_compiled_with_vm (freshly_compiled);
else
return scm_primitive_load (full_filename);
}
/* Otherwise, we bottom out here. */
{
SCM freshly_compiled = scm_try_auto_compile (full_filename);
if (scm_is_true (freshly_compiled))
return scm_load_compiled_with_vm (freshly_compiled);
else
return scm_primitive_load (full_filename);
}
}
#undef FUNC_NAME
@ -1089,20 +1090,22 @@ scm_init_eval_in_scheme (void)
{
SCM eval_scm, eval_go;
struct stat stat_source, stat_compiled;
int found_stale_eval_go = 0;
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,
SCM_BOOL_F, 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);
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)
&& compiled_is_fresh (eval_scm, eval_go,
&stat_source, &stat_compiled))
if (scm_is_true (eval_go))
scm_load_compiled_with_vm (eval_go);
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;
}