+/* 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");
+
+SCM_SYMBOL (sym_compile_file, "compile-file");
+SCM_SYMBOL (sym_auto_compilation_options, "%auto-compilation-options");
+
+static SCM
+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 ());
+
+ comp_mod = scm_c_resolve_module ("system base compile");
+ compile_file = scm_module_variable (comp_mod, sym_compile_file);
+
+ if (scm_is_true (compile_file))
+ {
+ /* Auto-compile in the context of the current module. */
+ SCM res, opts;
+ SCM args[5];
+
+ opts = scm_module_variable (scm_the_root_module (),
+ sym_auto_compilation_options);
+ if (SCM_VARIABLEP (opts))
+ opts = SCM_VARIABLE_REF (opts);
+ else
+ opts = SCM_EOL;
+
+ args[0] = source;
+ args[1] = kw_opts;
+ args[2] = opts;
+ args[3] = kw_env;
+ args[4] = scm_current_module ();
+
+ /* 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 ());
+ return res;
+ }
+ else
+ {
+ scm_puts_unlocked (";;; it seems ", scm_current_error_port ());
+ scm_display (source, scm_current_error_port ());
+ scm_puts_unlocked ("\n;;; is part of the compiler; skipping auto-compilation\n",
+ scm_current_error_port ());
+ return SCM_BOOL_F;
+ }
+}
+
+static SCM
+auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
+{
+ SCM source = SCM_PACK_POINTER (data);
+ SCM oport, lines;
+
+ oport = scm_open_output_string ();
+ scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
+
+ scm_puts_unlocked (";;; WARNING: compilation of ", scm_current_warning_port ());
+ scm_display (source, scm_current_warning_port ());
+ scm_puts_unlocked (" failed:\n", scm_current_warning_port ());
+
+ lines = scm_string_split (scm_get_output_string (oport),
+ SCM_MAKE_CHAR ('\n'));
+ for (; scm_is_pair (lines); lines = scm_cdr (lines))
+ if (scm_c_string_length (scm_car (lines)))
+ {
+ scm_puts_unlocked (";;; ", scm_current_warning_port ());
+ scm_display (scm_car (lines), scm_current_warning_port ());
+ scm_newline (scm_current_warning_port ());
+ }
+
+ scm_close_port (oport);
+
+ return SCM_BOOL_F;
+}
+
+SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabled", 0, 0, 0,
+ (void), "")
+#define FUNC_NAME s_scm_sys_warn_auto_compilation_enabled
+{
+ static int message_shown = 0;
+
+ if (!message_shown)
+ {
+ scm_puts_unlocked (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n"
+ ";;; or pass the --no-auto-compile argument to disable.\n",
+ scm_current_warning_port ());
+ message_shown = 1;
+ }
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+static SCM
+scm_try_auto_compile (SCM source)
+{
+ if (scm_is_false (*scm_loc_load_should_auto_compile))
+ return SCM_BOOL_F;
+
+ scm_sys_warn_auto_compilation_enabled ();
+ return scm_c_catch (SCM_BOOL_T,
+ do_try_auto_compile,
+ SCM_UNPACK_POINTER (source),
+ auto_compile_catch_handler,
+ SCM_UNPACK_POINTER (source),
+ NULL, NULL);
+}
+
+/* See also (system base compile):compiled-file-name. */
+static SCM
+canonical_suffix (SCM fname)
+{
+ SCM canon;
+ size_t len;
+
+ canon = scm_canonicalize_path (fname);
+ len = scm_c_string_length (canon);
+
+ if (len > 1 && scm_is_eq (scm_c_string_ref (canon, 0), SCM_MAKE_CHAR ('/')))
+ return canon;
+ else if (len > 2 && scm_is_eq (scm_c_string_ref (canon, 1), SCM_MAKE_CHAR (':')))
+ return scm_string_append (scm_list_3 (scm_from_latin1_string ("/"),
+ scm_c_substring (canon, 0, 1),
+ scm_c_substring (canon, 2, len)));
+ else
+ return canon;
+}
+
+SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
+ (SCM args),