diff options
Diffstat (limited to 'libguile/load.c')
-rw-r--r-- | libguile/load.c | 127 |
1 files changed, 95 insertions, 32 deletions
diff --git a/libguile/load.c b/libguile/load.c index 081c364e6..ebf79a9eb 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -198,6 +198,19 @@ SCM_DEFINE (scm_sys_global_site_dir, "%global-site-dir", 0,0,0, #undef FUNC_NAME #endif /* SCM_GLOBAL_SITE_DIR */ +#ifdef SCM_SITE_CCACHE_DIR +SCM_DEFINE (scm_sys_site_ccache_dir, "%site-ccache-dir", 0,0,0, + (), + "Return the directory where users should install compiled\n" + "@code{.go} files for use with this version of Guile.\n\n" + "E.g., may return \"/usr/lib/guile/" SCM_EFFECTIVE_VERSION "/site-ccache\".") +#define FUNC_NAME s_scm_sys_site_ccache_dir +{ + return scm_from_locale_string (SCM_SITE_CCACHE_DIR); +} +#undef FUNC_NAME +#endif /* SCM_SITE_CCACHE_DIR */ + /* Initializing the load path, and searching it. */ @@ -447,6 +460,60 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM extensions) return 0; } +#ifdef __MINGW32__ +#define FILE_NAME_SEPARATOR_STRING "\\" +#else +#define FILE_NAME_SEPARATOR_STRING "/" +#endif + +static int +is_file_name_separator (SCM c) +{ + if (scm_is_eq (c, SCM_MAKE_CHAR ('/'))) + return 1; +#ifdef __MINGW32__ + if (scm_is_eq (c, SCM_MAKE_CHAR ('\\'))) + return 1; +#endif + return 0; +} + +static int +is_drive_letter (SCM c) +{ +#ifdef __MINGW32__ + if (SCM_CHAR (c) >= 'a' && SCM_CHAR (c) <= 'z') + return 1; + else if (SCM_CHAR (c) >= 'A' && SCM_CHAR (c) <= 'Z') + return 1; +#endif + return 0; +} + +static int +is_absolute_file_name (SCM filename) +{ + size_t filename_len = scm_c_string_length (filename); + + if (filename_len >= 1 + && is_file_name_separator (scm_c_string_ref (filename, 0)) +#ifdef __MINGW32__ + /* On Windows, one initial separator indicates a drive-relative + path. Two separators indicate a Universal Naming Convention + (UNC) path. UNC paths are always absolute. */ + && filename_len >= 2 + && is_file_name_separator (scm_c_string_ref (filename, 1)) +#endif + ) + return 1; + if (filename_len >= 3 + && is_drive_letter (scm_c_string_ref (filename, 0)) + && scm_is_eq (scm_c_string_ref (filename, 1), SCM_MAKE_CHAR (':')) + && is_file_name_separator (scm_c_string_ref (filename, 2))) + return 1; + return 0; +} + /* 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. @@ -477,16 +544,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, scm_dynwind_free (filename_chars); /* If FILENAME is absolute and is still valid, return it unchanged. */ -#ifdef __MINGW32__ - if (((filename_len >= 1) && - (filename_chars[0] == '/' || filename_chars[0] == '\\')) || - ((filename_len >= 3) && filename_chars[1] == ':' && - ((filename_chars[0] >= 'a' && filename_chars[0] <= 'z') || - (filename_chars[0] >= 'A' && filename_chars[0] <= 'Z')) && - (filename_chars[2] == '/' || filename_chars[2] == '\\'))) -#else - if (filename_len >= 1 && filename_chars[0] == '/') -#endif + if (is_absolute_file_name (filename)) { if ((scm_is_false (require_exts) || scm_c_string_has_an_ext (filename_chars, filename_len, @@ -520,11 +578,7 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, extensions = SCM_EOL; break; } -#ifdef __MINGW32__ - else if (*endp == '/' || *endp == '\\') -#else - else if (*endp == '/') -#endif + else if (is_file_name_separator (SCM_MAKE_CHAR (*endp))) /* This filename has no extension, so keep the current list of extensions. */ break; @@ -553,12 +607,9 @@ search_path (SCM path, SCM filename, SCM extensions, SCM require_exts, /* Concatenate the path name and the filename. */ -#ifdef __MINGW32__ - if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/') && (buf.ptr[-1] != '\\')) -#else - if ((buf.ptr > buf.buf) && (buf.ptr[-1] != '/')) -#endif - stringbuf_cat (&buf, "/"); + if (buf.ptr > buf.buf + && !is_file_name_separator (SCM_MAKE_CHAR (buf.ptr[-1]))) + stringbuf_cat (&buf, FILE_NAME_SEPARATOR_STRING); stringbuf_cat (&buf, filename_chars); sans_ext_len = buf.ptr - buf.buf; @@ -823,24 +874,36 @@ scm_try_auto_compile (SCM source) NULL, NULL); } -/* See also (system base compile):compiled-file-name. */ +/* The auto-compilation code will residualize a .go file in the cache + dir: by default, $HOME/.cache/guile/2.0/ccache/PATH.go. This + function determines the PATH to use as a key into the compilation + cache. See also (system base compile):compiled-file-name. */ static SCM canonical_suffix (SCM fname) { SCM canon; - size_t len; + /* CANON should be absolute. */ 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; +#ifdef __MINGW32__ + { + size_t len = scm_c_string_length (canon); + + /* On Windows, an absolute file name that doesn't start with a + separator starts with a drive component. Transform the drive + component to a file name element: c:\foo -> \c\foo. */ + if (len >= 2 + && is_absolute_file_name (canon) + && !is_file_name_separator (scm_c_string_ref (canon, 0))) + return scm_string_append + (scm_list_3 (scm_from_latin1_string (FILE_NAME_SEPARATOR_STRING), + scm_c_substring (canon, 0, 1), + scm_c_substring (canon, 2, len))); + } +#endif + + return canon; } SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, |