autocompile -> auto-compile
[bpt/guile.git] / libguile / load.c
index 0e4894e..cec59d1 100644 (file)
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -62,6 +62,8 @@
 #define R_OK 4
 #endif
 
+#include <stat-time.h>
+
 \f
 /* Loading a file, given an absolute filename.  */
 
@@ -167,8 +169,9 @@ SCM_DEFINE (scm_sys_library_dir, "%library-dir", 0,0,0,
 #ifdef SCM_SITE_DIR
 SCM_DEFINE (scm_sys_site_dir, "%site-dir", 0,0,0,
             (),
-           "Return the directory where the Guile site files are installed.\n"
-           "E.g., may return \"/usr/share/guile/site\".")
+           "Return the directory where users should install Scheme code for use\n"
+            "with this version of Guile.\n\n"
+           "E.g., may return \"/usr/share/guile/site/" SCM_EFFECTIVE_VERSION "\".")
 #define FUNC_NAME s_scm_sys_site_dir
 {
   return scm_from_locale_string (SCM_SITE_DIR);
@@ -176,6 +179,18 @@ SCM_DEFINE (scm_sys_site_dir, "%site-dir", 0,0,0,
 #undef FUNC_NAME
 #endif /* SCM_SITE_DIR */
 
+#ifdef SCM_GLOBAL_SITE_DIR
+SCM_DEFINE (scm_sys_global_site_dir, "%global-site-dir", 0,0,0,
+            (),
+           "Return the directory where users should install Scheme code for use\n"
+            "with all versions of Guile.\n\n"
+           "E.g., may return \"/usr/share/guile/site\".")
+#define FUNC_NAME s_scm_sys_global_site_dir
+{
+  return scm_from_locale_string (SCM_GLOBAL_SITE_DIR);
+}
+#undef FUNC_NAME
+#endif /* SCM_GLOBAL_SITE_DIR */
 
 
 \f
@@ -192,9 +207,9 @@ static SCM *scm_loc_load_compiled_path;
 static SCM *scm_loc_load_compiled_extensions;
 
 /* Whether we should try to auto-compile. */
-static SCM *scm_loc_load_should_autocompile;
+static SCM *scm_loc_load_should_auto_compile;
 
-/* The fallback path for autocompilation */
+/* The fallback path for auto-compilation */
 static SCM *scm_loc_compile_fallback_path;
 
 SCM_DEFINE (scm_parse_path, "parse-path", 1, 1, 0, 
@@ -239,8 +254,9 @@ scm_init_load_path ()
   else if (env)
     path = scm_parse_path (scm_from_locale_string (env), path);
   else
-    path = scm_list_3 (scm_from_locale_string (SCM_LIBRARY_DIR),
+    path = scm_list_4 (scm_from_locale_string (SCM_LIBRARY_DIR),
                        scm_from_locale_string (SCM_SITE_DIR),
+                       scm_from_locale_string (SCM_GLOBAL_SITE_DIR),
                        scm_from_locale_string (SCM_PKGDATA_DIR));
 
   env = getenv ("GUILE_SYSTEM_COMPILED_PATH");
@@ -605,41 +621,55 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
 #undef FUNC_NAME
 
 
+/* Return true if COMPILED_FILENAME is newer than source file
+   FULL_FILENAME, false otherwise.  Also return false if one of the
+   files cannot be stat'd.  */
 static int
 compiled_is_fresh (SCM full_filename, SCM compiled_filename)
 {
   char *source, *compiled;
   struct stat stat_source, stat_compiled;
-  int res;
+  int compiled_is_newer;
 
   source = scm_to_locale_string (full_filename);
   compiled = scm_to_locale_string (compiled_filename);
-    
+
   if (stat (source, &stat_source) == 0
-      && stat (compiled, &stat_compiled) == 0
-      && stat_source.st_mtime == stat_compiled.st_mtime) 
+      && stat (compiled, &stat_compiled) == 0)
     {
-      res = 1;
+      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 (";;; note: source file ", scm_current_error_port ());
+         scm_puts (source, scm_current_error_port ());
+         scm_puts ("\n;;;       newer than compiled ", scm_current_error_port ());
+         scm_puts (compiled, scm_current_error_port ());
+         scm_puts ("\n", scm_current_error_port ());
+       }
     }
   else
-    {
-      scm_puts (";;; note: source file ", scm_current_error_port ());
-      scm_puts (source, scm_current_error_port ());
-      scm_puts ("\n;;;       newer than compiled ", scm_current_error_port ());
-      scm_puts (compiled, scm_current_error_port ());
-      scm_puts ("\n", scm_current_error_port ());
-      res = 0;
-    }
+    /* At least one of the files isn't accessible.  */
+    compiled_is_newer = 0;
 
   free (source);
   free (compiled);
-  return res;
+
+  return compiled_is_newer;
 }
 
 SCM_KEYWORD (kw_env, "env");
 
 static SCM
-do_try_autocompile (void *data)
+do_try_auto_compile (void *data)
 {
   SCM source = PTR2SCM (data);
   SCM comp_mod, compile_file;
@@ -650,7 +680,7 @@ do_try_autocompile (void *data)
 
   comp_mod = scm_c_resolve_module ("system base compile");
   compile_file = scm_module_variable
-    (comp_mod, scm_from_locale_symbol ("compile-file"));
+    (comp_mod, scm_from_latin1_symbol ("compile-file"));
 
   if (scm_is_true (compile_file))
     {
@@ -666,14 +696,14 @@ do_try_autocompile (void *data)
     {
       scm_puts (";;; it seems ", scm_current_error_port ());
       scm_display (source, scm_current_error_port ());
-      scm_puts ("\n;;; is part of the compiler; skipping autocompilation\n",
+      scm_puts ("\n;;; is part of the compiler; skipping auto-compilation\n",
                 scm_current_error_port ());
       return SCM_BOOL_F;
     }
 }
 
 static SCM
-autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
+auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
 {
   SCM source = PTR2SCM (data);
   scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
@@ -687,16 +717,16 @@ autocompile_catch_handler (void *data, SCM tag, SCM throw_args)
   return SCM_BOOL_F;
 }
 
-SCM_DEFINE (scm_sys_warn_autocompilation_enabled, "%warn-autocompilation-enabled", 0, 0, 0,
+SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabled", 0, 0, 0,
            (void), "")
-#define FUNC_NAME s_scm_sys_warn_autocompilation_enabled
+#define FUNC_NAME s_scm_sys_warn_auto_compilation_enabled
 {
   static int message_shown = 0;
 
   if (!message_shown)
     {
-      scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
-                ";;;       or pass the --no-autocompile argument to disable.\n",
+      scm_puts (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n"
+                ";;;       or pass the --no-auto-compile argument to disable.\n",
                 scm_current_error_port ());
       message_shown = 1;
     }
@@ -706,16 +736,16 @@ SCM_DEFINE (scm_sys_warn_autocompilation_enabled, "%warn-autocompilation-enabled
 #undef FUNC_NAME
 
 static SCM
-scm_try_autocompile (SCM source)
+scm_try_auto_compile (SCM source)
 {
-  if (scm_is_false (*scm_loc_load_should_autocompile))
+  if (scm_is_false (*scm_loc_load_should_auto_compile))
     return SCM_BOOL_F;
 
-  scm_sys_warn_autocompilation_enabled ();
+  scm_sys_warn_auto_compilation_enabled ();
   return scm_c_catch (SCM_BOOL_T,
-                      do_try_autocompile,
+                      do_try_auto_compile,
                       SCM2PTR (source),
-                      autocompile_catch_handler,
+                      auto_compile_catch_handler,
                       SCM2PTR (source),
                       NULL, NULL);
 }
@@ -761,6 +791,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
     exception_on_not_found = SCM_BOOL_T;
 
   full_filename = scm_sys_search_load_path (filename);
+  if (scm_is_string (full_filename))
+    full_filename = scm_canonicalize_path (full_filename);
+
   compiled_filename =
     scm_search_path (*scm_loc_load_compiled_path,
                     filename,
@@ -822,7 +855,7 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
 
   /* Otherwise, we bottom out here. */
   {
-    SCM freshly_compiled = scm_try_autocompile (full_filename);
+    SCM freshly_compiled = scm_try_auto_compile (full_filename);
 
     if (scm_is_true (freshly_compiled))
       return scm_load_compiled_with_vm (freshly_compiled);
@@ -900,8 +933,8 @@ scm_init_load ()
 
   scm_loc_compile_fallback_path
     = SCM_VARIABLE_LOC (scm_c_define ("%compile-fallback-path", SCM_BOOL_F));
-  scm_loc_load_should_autocompile
-    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F));
+  scm_loc_load_should_auto_compile
+    = SCM_VARIABLE_LOC (scm_c_define ("%load-should-auto-compile", SCM_BOOL_F));
 
   the_reader = scm_make_fluid ();
   scm_fluid_set_x (the_reader, SCM_BOOL_F);
@@ -917,9 +950,9 @@ scm_init_load ()
 }
 
 void
-scm_init_load_should_autocompile ()
+scm_init_load_should_auto_compile ()
 {
-  *scm_loc_load_should_autocompile =
+  *scm_loc_load_should_auto_compile =
     scm_from_bool (scm_getenv_int ("GUILE_AUTO_COMPILE", 1));
 }