1 /* Copyright (C) 1995,1996,1998,1999,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public License
5 * as published by the Free Software Foundation; either version 3 of
6 * the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful, but
9 * WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
29 #include "libguile/_scm.h"
30 #include "libguile/private-gc.h" /* scm_getenv_int */
31 #include "libguile/libpath.h"
32 #include "libguile/fports.h"
33 #include "libguile/read.h"
34 #include "libguile/eval.h"
35 #include "libguile/throw.h"
36 #include "libguile/alist.h"
37 #include "libguile/dynwind.h"
38 #include "libguile/root.h"
39 #include "libguile/strings.h"
40 #include "libguile/modules.h"
41 #include "libguile/chars.h"
42 #include "libguile/srfi-13.h"
44 #include "libguile/validate.h"
45 #include "libguile/load.h"
46 #include "libguile/fluids.h"
48 #include "libguile/vm.h" /* for load-compiled/vm */
50 #include <sys/types.h>
55 #endif /* HAVE_UNISTD_H */
59 #endif /* HAVE_PWD_H */
66 /* Loading a file, given an absolute filename. */
68 /* Hook to run when we load a file, perhaps to announce the fact somewhere.
69 Applied to the full name of the file. */
70 static SCM
*scm_loc_load_hook
;
72 /* The current reader (a fluid). */
73 static SCM the_reader
= SCM_BOOL_F
;
76 SCM_DEFINE (scm_primitive_load
, "primitive-load", 1, 0, 0,
78 "Load the file named @var{filename} and evaluate its contents in\n"
79 "the top-level environment. The load paths are not searched;\n"
80 "@var{filename} must either be a full pathname or be a pathname\n"
81 "relative to the current directory. If the variable\n"
82 "@code{%load-hook} is defined, it should be bound to a procedure\n"
83 "that will be called before any code is loaded. See the\n"
84 "documentation for @code{%load-hook} later in this section.")
85 #define FUNC_NAME s_scm_primitive_load
87 SCM hook
= *scm_loc_load_hook
;
89 SCM_VALIDATE_STRING (1, filename
);
90 if (scm_is_true (hook
) && scm_is_false (scm_procedure_p (hook
)))
91 SCM_MISC_ERROR ("value of %load-hook is neither a procedure nor #f",
94 if (!scm_is_false (hook
))
95 scm_call_1 (hook
, filename
);
98 SCM port
= scm_open_file (filename
, scm_from_locale_string ("r"));
99 scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE
);
100 scm_i_dynwind_current_load_port (port
);
102 encoding
= scm_i_scan_for_encoding (port
);
104 scm_i_set_port_encoding_x (port
, encoding
);
106 /* The file has no encoding declared. We'll presume Latin-1. */
107 scm_i_set_port_encoding_x (port
, NULL
);
113 /* Lookup and use the current reader to read the next
115 reader
= scm_fluid_ref (the_reader
);
116 if (reader
== SCM_BOOL_F
)
117 form
= scm_read (port
);
119 form
= scm_call_1 (reader
, port
);
121 if (SCM_EOF_OBJECT_P (form
))
124 scm_primitive_eval_x (form
);
128 scm_close_port (port
);
130 return SCM_UNSPECIFIED
;
135 scm_c_primitive_load (const char *filename
)
137 return scm_primitive_load (scm_from_locale_string (filename
));
141 /* Builtin path to scheme library files. */
142 #ifdef SCM_PKGDATA_DIR
143 SCM_DEFINE (scm_sys_package_data_dir
, "%package-data-dir", 0, 0, 0,
145 "Return the name of the directory where Scheme packages, modules and\n"
146 "libraries are kept. On most Unix systems, this will be\n"
147 "@samp{/usr/local/share/guile}.")
148 #define FUNC_NAME s_scm_sys_package_data_dir
150 return scm_from_locale_string (SCM_PKGDATA_DIR
);
153 #endif /* SCM_PKGDATA_DIR */
155 #ifdef SCM_LIBRARY_DIR
156 SCM_DEFINE (scm_sys_library_dir
, "%library-dir", 0,0,0,
158 "Return the directory where the Guile Scheme library files are installed.\n"
159 "E.g., may return \"/usr/share/guile/1.3.5\".")
160 #define FUNC_NAME s_scm_sys_library_dir
162 return scm_from_locale_string (SCM_LIBRARY_DIR
);
165 #endif /* SCM_LIBRARY_DIR */
168 SCM_DEFINE (scm_sys_site_dir
, "%site-dir", 0,0,0,
170 "Return the directory where the Guile site files are installed.\n"
171 "E.g., may return \"/usr/share/guile/site\".")
172 #define FUNC_NAME s_scm_sys_site_dir
174 return scm_from_locale_string (SCM_SITE_DIR
);
177 #endif /* SCM_SITE_DIR */
182 /* Initializing the load path, and searching it. */
184 /* List of names of directories we search for files to load. */
185 static SCM
*scm_loc_load_path
;
187 /* List of extensions we try adding to the filenames. */
188 static SCM
*scm_loc_load_extensions
;
190 /* Like %load-path and %load-extensions, but for compiled files. */
191 static SCM
*scm_loc_load_compiled_path
;
192 static SCM
*scm_loc_load_compiled_extensions
;
194 /* Whether we should try to auto-compile. */
195 static SCM
*scm_loc_load_should_autocompile
;
197 /* The fallback path for autocompilation */
198 static SCM
*scm_loc_compile_fallback_path
;
200 SCM_DEFINE (scm_parse_path
, "parse-path", 1, 1, 0,
201 (SCM path
, SCM tail
),
202 "Parse @var{path}, which is expected to be a colon-separated\n"
203 "string, into a list and return the resulting list with\n"
204 "@var{tail} appended. If @var{path} is @code{#f}, @var{tail}\n"
206 #define FUNC_NAME s_scm_parse_path
209 SCM sep
= SCM_MAKE_CHAR (';');
211 SCM sep
= SCM_MAKE_CHAR (':');
214 if (SCM_UNBNDP (tail
))
216 return (scm_is_false (path
)
218 : scm_append_x (scm_list_2 (scm_string_split (path
, sep
), tail
)));
223 /* Initialize the global variable %load-path, given the value of the
224 SCM_SITE_DIR and SCM_LIBRARY_DIR preprocessor symbols and the
225 GUILE_LOAD_PATH environment variable. */
227 scm_init_load_path ()
233 #ifdef SCM_LIBRARY_DIR
234 env
= getenv ("GUILE_SYSTEM_PATH");
235 if (env
&& strcmp (env
, "") == 0)
236 /* special-case interpret system-path=="" as meaning no system path instead
240 path
= scm_parse_path (scm_from_locale_string (env
), path
);
242 path
= scm_list_3 (scm_from_locale_string (SCM_LIBRARY_DIR
),
243 scm_from_locale_string (SCM_SITE_DIR
),
244 scm_from_locale_string (SCM_PKGDATA_DIR
));
246 env
= getenv ("GUILE_SYSTEM_COMPILED_PATH");
247 if (env
&& strcmp (env
, "") == 0)
251 cpath
= scm_parse_path (scm_from_locale_string (env
), cpath
);
253 cpath
= scm_cons (scm_from_locale_string (SCM_CCACHE_DIR
), cpath
);
255 #endif /* SCM_LIBRARY_DIR */
264 #define FALLBACK_DIR \
265 "guile/ccache/" SCM_EFFECTIVE_VERSION "-" SCM_OBJCODE_MACHINE_VERSION_STRING
267 if ((e
= getenv ("XDG_CACHE_HOME")))
268 snprintf (cachedir
, sizeof(cachedir
), "%s/" FALLBACK_DIR
, e
);
269 else if ((e
= getenv ("HOME")))
270 snprintf (cachedir
, sizeof(cachedir
), "%s/.cache/" FALLBACK_DIR
, e
);
272 else if ((pwd
= getpwuid (getuid ())) && pwd
->pw_dir
)
273 snprintf (cachedir
, sizeof(cachedir
), "%s/.cache/" FALLBACK_DIR
,
275 #endif /* HAVE_GETPWENT */
280 *scm_loc_compile_fallback_path
= scm_from_locale_string (cachedir
);
283 env
= getenv ("GUILE_LOAD_PATH");
285 path
= scm_parse_path (scm_from_locale_string (env
), path
);
287 env
= getenv ("GUILE_LOAD_COMPILED_PATH");
289 cpath
= scm_parse_path (scm_from_locale_string (env
), cpath
);
291 *scm_loc_load_path
= path
;
292 *scm_loc_load_compiled_path
= cpath
;
295 SCM scm_listofnullstr
;
297 /* Utility functions for assembling C strings in a buffer.
306 stringbuf_free (void *data
)
308 struct stringbuf
*buf
= (struct stringbuf
*)data
;
313 stringbuf_grow (struct stringbuf
*buf
)
315 size_t ptroff
= buf
->ptr
- buf
->buf
;
317 buf
->buf
= scm_realloc (buf
->buf
, buf
->buf_len
);
318 buf
->ptr
= buf
->buf
+ ptroff
;
322 stringbuf_cat_locale_string (struct stringbuf
*buf
, SCM str
)
324 size_t max_len
= buf
->buf_len
- (buf
->ptr
- buf
->buf
) - 1;
325 size_t len
= scm_to_locale_stringbuf (str
, buf
->ptr
, max_len
);
328 /* buffer is too small, double its size and try again.
330 stringbuf_grow (buf
);
331 stringbuf_cat_locale_string (buf
, str
);
335 /* string fits, terminate it and check for embedded '\0'.
337 buf
->ptr
[len
] = '\0';
338 if (strlen (buf
->ptr
) != len
)
339 scm_misc_error (NULL
,
340 "string contains #\\nul character: ~S",
347 stringbuf_cat (struct stringbuf
*buf
, char *str
)
349 size_t max_len
= buf
->buf_len
- (buf
->ptr
- buf
->buf
) - 1;
350 size_t len
= strlen (str
);
353 /* buffer is too small, double its size and try again.
355 stringbuf_grow (buf
);
356 stringbuf_cat (buf
, str
);
360 /* string fits, copy it into buffer.
362 strcpy (buf
->ptr
, str
);
369 scm_c_string_has_an_ext (char *str
, size_t len
, SCM extensions
)
371 for (; !scm_is_null (extensions
); extensions
= SCM_CDR (extensions
))
376 ext
= scm_to_locale_string (SCM_CAR (extensions
));
377 extlen
= strlen (ext
);
378 match
= (len
> extlen
&& str
[len
- extlen
- 1] == '.'
379 && strncmp (str
+ (len
- extlen
), ext
, extlen
) == 0);
387 /* Search PATH for a directory containing a file named FILENAME.
388 The file must be readable, and not a directory.
389 If we find one, return its full filename; otherwise, return #f.
390 If FILENAME is absolute, return it unchanged.
391 If given, EXTENSIONS is a list of strings; for each directory
392 in PATH, we search for FILENAME concatenated with each EXTENSION. */
393 SCM_DEFINE (scm_search_path
, "search-path", 2, 0, 1,
394 (SCM path
, SCM filename
, SCM rest
),
395 "Search @var{path} for a directory containing a file named\n"
396 "@var{filename}. The file must be readable, and not a directory.\n"
397 "If we find one, return its full filename; otherwise, return\n"
398 "@code{#f}. If @var{filename} is absolute, return it unchanged.\n"
399 "If given, @var{extensions} is a list of strings; for each\n"
400 "directory in @var{path}, we search for @var{filename}\n"
401 "concatenated with each @var{extension}.")
402 #define FUNC_NAME s_scm_search_path
404 struct stringbuf buf
;
405 char *filename_chars
;
407 SCM extensions
, require_exts
;
408 SCM result
= SCM_BOOL_F
;
410 if (SCM_UNBNDP (rest
) || scm_is_null (rest
))
412 /* Called either by Scheme code that didn't provide the optional
413 arguments, or C code that used the Guile 1.8 signature (2 required,
414 1 optional arg) and passed '() or nothing as the EXTENSIONS
416 extensions
= SCM_EOL
;
417 require_exts
= SCM_UNDEFINED
;
421 if (scm_is_null (SCM_CAR (rest
)) || scm_is_pair (SCM_CAR (rest
)))
423 /* Called by Scheme code written for 1.9. */
424 extensions
= SCM_CAR (rest
);
425 if (scm_is_null (SCM_CDR (rest
)))
426 require_exts
= SCM_UNDEFINED
;
429 require_exts
= SCM_CADR (rest
);
430 if (SCM_UNLIKELY (!scm_is_null (SCM_CDDR (rest
))))
431 scm_wrong_num_args (scm_from_locale_string (FUNC_NAME
));
436 /* Called by C code that uses the 1.8 signature, i.e., which
437 expects the 3rd argument to be EXTENSIONS. */
439 require_exts
= SCM_UNDEFINED
;
443 if (SCM_UNBNDP (extensions
))
444 extensions
= SCM_EOL
;
446 SCM_VALIDATE_LIST (3, extensions
);
448 if (SCM_UNBNDP (require_exts
))
449 require_exts
= SCM_BOOL_F
;
451 scm_dynwind_begin (0);
453 filename_chars
= scm_to_locale_string (filename
);
454 filename_len
= strlen (filename_chars
);
455 scm_dynwind_free (filename_chars
);
457 /* If FILENAME is absolute, return it unchanged. */
459 if (((filename_len
>= 1) &&
460 (filename_chars
[0] == '/' || filename_chars
[0] == '\\')) ||
461 ((filename_len
>= 3) && filename_chars
[1] == ':' &&
462 ((filename_chars
[0] >= 'a' && filename_chars
[0] <= 'z') ||
463 (filename_chars
[0] >= 'A' && filename_chars
[0] <= 'Z')) &&
464 (filename_chars
[2] == '/' || filename_chars
[2] == '\\')))
466 if (filename_len
>= 1 && filename_chars
[0] == '/')
470 if (scm_is_true (require_exts
) &&
471 !scm_c_string_has_an_ext (filename_chars
, filename_len
,
479 /* If FILENAME has an extension, don't try to add EXTENSIONS to it. */
483 for (endp
= filename_chars
+ filename_len
- 1;
484 endp
>= filename_chars
;
489 if (scm_is_true (require_exts
) &&
490 !scm_c_string_has_an_ext (filename_chars
, filename_len
,
493 /* This filename has an extension, but not one of the right
498 /* This filename already has an extension, so cancel the
499 list of extensions. */
500 extensions
= SCM_EOL
;
504 else if (*endp
== '/' || *endp
== '\\')
506 else if (*endp
== '/')
508 /* This filename has no extension, so keep the current list
514 /* This simplifies the loop below a bit.
516 if (scm_is_null (extensions
))
517 extensions
= scm_listofnullstr
;
520 buf
.buf
= scm_malloc (buf
.buf_len
);
521 scm_dynwind_unwind_handler (stringbuf_free
, &buf
, SCM_F_WIND_EXPLICITLY
);
523 /* Try every path element.
525 for (; scm_is_pair (path
); path
= SCM_CDR (path
))
527 SCM dir
= SCM_CAR (path
);
532 stringbuf_cat_locale_string (&buf
, dir
);
534 /* Concatenate the path name and the filename. */
537 if ((buf
.ptr
> buf
.buf
) && (buf
.ptr
[-1] != '/') && (buf
.ptr
[-1] != '\\'))
539 if ((buf
.ptr
> buf
.buf
) && (buf
.ptr
[-1] != '/'))
541 stringbuf_cat (&buf
, "/");
543 stringbuf_cat (&buf
, filename_chars
);
544 sans_ext_len
= buf
.ptr
- buf
.buf
;
546 /* Try every extension. */
547 for (exts
= extensions
; scm_is_pair (exts
); exts
= SCM_CDR (exts
))
549 SCM ext
= SCM_CAR (exts
);
552 buf
.ptr
= buf
.buf
+ sans_ext_len
;
553 stringbuf_cat_locale_string (&buf
, ext
);
555 /* If the file exists at all, we should return it. If the
556 file is inaccessible, then that's an error. */
558 if (stat (buf
.buf
, &mode
) == 0
559 && ! (mode
.st_mode
& S_IFDIR
))
561 result
= scm_from_locale_string (buf
.buf
);
566 if (!SCM_NULL_OR_NIL_P (exts
))
567 scm_wrong_type_arg_msg (NULL
, 0, extensions
, "proper list");
570 if (!SCM_NULL_OR_NIL_P (path
))
571 scm_wrong_type_arg_msg (NULL
, 0, path
, "proper list");
580 /* Search %load-path for a directory containing a file named FILENAME.
581 The file must be readable, and not a directory.
582 If we find one, return its full filename; otherwise, return #f.
583 If FILENAME is absolute, return it unchanged. */
584 SCM_DEFINE (scm_sys_search_load_path
, "%search-load-path", 1, 0, 0,
586 "Search @var{%load-path} for the file named @var{filename},\n"
587 "which must be readable by the current user. If @var{filename}\n"
588 "is found in the list of paths to search or is an absolute\n"
589 "pathname, return its full pathname. Otherwise, return\n"
590 "@code{#f}. Filenames may have any of the optional extensions\n"
591 "in the @code{%load-extensions} list; @code{%search-load-path}\n"
592 "will try each extension automatically.")
593 #define FUNC_NAME s_scm_sys_search_load_path
595 SCM path
= *scm_loc_load_path
;
596 SCM exts
= *scm_loc_load_extensions
;
597 SCM_VALIDATE_STRING (1, filename
);
599 if (scm_ilength (path
) < 0)
600 SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL
);
601 if (scm_ilength (exts
) < 0)
602 SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL
);
603 return scm_search_path (path
, filename
, exts
);
609 compiled_is_fresh (SCM full_filename
, SCM compiled_filename
)
611 char *source
, *compiled
;
612 struct stat stat_source
, stat_compiled
;
615 source
= scm_to_locale_string (full_filename
);
616 compiled
= scm_to_locale_string (compiled_filename
);
618 if (stat (source
, &stat_source
) == 0
619 && stat (compiled
, &stat_compiled
) == 0
620 && stat_source
.st_mtime
== stat_compiled
.st_mtime
)
626 scm_puts (";;; note: source file ", scm_current_error_port ());
627 scm_puts (source
, scm_current_error_port ());
628 scm_puts ("\n;;; newer than compiled ", scm_current_error_port ());
629 scm_puts (compiled
, scm_current_error_port ());
630 scm_puts ("\n", scm_current_error_port ());
639 SCM_KEYWORD (kw_env
, "env");
642 do_try_autocompile (void *data
)
644 SCM source
= PTR2SCM (data
);
645 SCM comp_mod
, compile_file
;
647 scm_puts (";;; compiling ", scm_current_error_port ());
648 scm_display (source
, scm_current_error_port ());
649 scm_newline (scm_current_error_port ());
651 comp_mod
= scm_c_resolve_module ("system base compile");
652 compile_file
= scm_module_variable
653 (comp_mod
, scm_from_locale_symbol ("compile-file"));
655 if (scm_is_true (compile_file
))
657 /* Auto-compile in the context of the current module. */
658 SCM res
= scm_call_3 (scm_variable_ref (compile_file
), source
,
659 kw_env
, scm_current_module ());
660 scm_puts (";;; compiled ", scm_current_error_port ());
661 scm_display (res
, scm_current_error_port ());
662 scm_newline (scm_current_error_port ());
667 scm_puts (";;; it seems ", scm_current_error_port ());
668 scm_display (source
, scm_current_error_port ());
669 scm_puts ("\n;;; is part of the compiler; skipping autocompilation\n",
670 scm_current_error_port ());
676 autocompile_catch_handler (void *data
, SCM tag
, SCM throw_args
)
678 SCM source
= PTR2SCM (data
);
679 scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
680 scm_display (source
, scm_current_error_port ());
681 scm_puts (" failed:\n", scm_current_error_port ());
682 scm_puts (";;; key ", scm_current_error_port ());
683 scm_write (tag
, scm_current_error_port ());
684 scm_puts (", throw args ", scm_current_error_port ());
685 scm_write (throw_args
, scm_current_error_port ());
686 scm_newline (scm_current_error_port ());
690 SCM_DEFINE (scm_sys_warn_autocompilation_enabled
, "%warn-autocompilation-enabled", 0, 0, 0,
692 #define FUNC_NAME s_scm_sys_warn_autocompilation_enabled
694 static int message_shown
= 0;
698 scm_puts (";;; note: autocompilation is enabled, set GUILE_AUTO_COMPILE=0\n"
699 ";;; or pass the --no-autocompile argument to disable.\n",
700 scm_current_error_port ());
704 return SCM_UNSPECIFIED
;
709 scm_try_autocompile (SCM source
)
711 if (scm_is_false (*scm_loc_load_should_autocompile
))
714 scm_sys_warn_autocompilation_enabled ();
715 return scm_c_catch (SCM_BOOL_T
,
718 autocompile_catch_handler
,
723 SCM_DEFINE (scm_primitive_load_path
, "primitive-load-path", 0, 0, 1,
725 "Search @var{%load-path} for the file named @var{filename} and\n"
726 "load it into the top-level environment. If @var{filename} is a\n"
727 "relative pathname and is not found in the list of search paths,\n"
728 "an error is signalled, unless the optional argument\n"
729 "@var{exception_on_not_found} is @code{#f}, in which case\n"
730 "@code{#f} is returned instead.")
731 #define FUNC_NAME s_scm_primitive_load_path
733 SCM filename
, exception_on_not_found
;
734 SCM full_filename
, compiled_filename
;
735 int compiled_is_fallback
= 0;
737 if (scm_is_string (args
))
739 /* C code written for 1.8 and earlier expects this function to take a
740 single argument (the file name). */
742 exception_on_not_found
= SCM_UNDEFINED
;
746 /* Starting from 1.9, this function takes 1 required and 1 optional
750 SCM_VALIDATE_LIST_COPYLEN (SCM_ARG1
, args
, len
);
751 if (len
< 1 || len
> 2)
752 scm_error_num_args_subr (FUNC_NAME
);
754 filename
= SCM_CAR (args
);
755 SCM_VALIDATE_STRING (SCM_ARG1
, filename
);
757 exception_on_not_found
= len
> 1 ? SCM_CADR (args
) : SCM_UNDEFINED
;
760 if (SCM_UNBNDP (exception_on_not_found
))
761 exception_on_not_found
= SCM_BOOL_T
;
763 full_filename
= scm_sys_search_load_path (filename
);
765 scm_search_path (*scm_loc_load_compiled_path
,
767 scm_list_2 (*scm_loc_load_compiled_extensions
,
770 if (scm_is_false (compiled_filename
)
771 && scm_is_true (full_filename
)
772 && scm_is_true (*scm_loc_compile_fallback_path
)
773 && scm_is_pair (*scm_loc_load_compiled_extensions
)
774 && scm_is_string (scm_car (*scm_loc_load_compiled_extensions
)))
776 SCM fallback
= scm_string_append
777 (scm_list_3 (*scm_loc_compile_fallback_path
,
779 scm_car (*scm_loc_load_compiled_extensions
)));
780 if (scm_is_true (scm_stat (fallback
, SCM_BOOL_F
)))
782 compiled_filename
= fallback
;
783 compiled_is_fallback
= 1;
787 if (scm_is_false (full_filename
) && scm_is_false (compiled_filename
))
789 if (scm_is_true (exception_on_not_found
))
790 SCM_MISC_ERROR ("Unable to find file ~S in load path",
791 scm_list_1 (filename
));
796 if (scm_is_false (full_filename
)
797 || (scm_is_true (compiled_filename
)
798 && compiled_is_fresh (full_filename
, compiled_filename
)))
799 return scm_load_compiled_with_vm (compiled_filename
);
801 /* Perhaps there was the installed .go that was stale, but our fallback is
802 fresh. Let's try that. Duplicating code, but perhaps that's OK. */
804 if (!compiled_is_fallback
805 && scm_is_true (*scm_loc_compile_fallback_path
)
806 && scm_is_pair (*scm_loc_load_compiled_extensions
)
807 && scm_is_string (scm_car (*scm_loc_load_compiled_extensions
)))
809 SCM fallback
= scm_string_append
810 (scm_list_3 (*scm_loc_compile_fallback_path
,
812 scm_car (*scm_loc_load_compiled_extensions
)));
813 if (scm_is_true (scm_stat (fallback
, SCM_BOOL_F
))
814 && compiled_is_fresh (full_filename
, fallback
))
816 scm_puts (";;; found fresh local cache at ", scm_current_error_port ());
817 scm_display (fallback
, scm_current_error_port ());
818 scm_newline (scm_current_error_port ());
819 return scm_load_compiled_with_vm (fallback
);
823 /* Otherwise, we bottom out here. */
825 SCM freshly_compiled
= scm_try_autocompile (full_filename
);
827 if (scm_is_true (freshly_compiled
))
828 return scm_load_compiled_with_vm (freshly_compiled
);
830 return scm_primitive_load (full_filename
);
836 scm_c_primitive_load_path (const char *filename
)
838 return scm_primitive_load_path (scm_from_locale_string (filename
));
842 scm_init_eval_in_scheme (void)
844 SCM eval_scm
, eval_go
;
845 eval_scm
= scm_search_path (*scm_loc_load_path
,
846 scm_from_locale_string ("ice-9/eval.scm"),
848 eval_go
= scm_search_path (*scm_loc_load_compiled_path
,
849 scm_from_locale_string ("ice-9/eval.go"),
852 if (scm_is_true (eval_scm
) && scm_is_true (eval_go
)
853 && compiled_is_fresh (eval_scm
, eval_go
))
854 scm_load_compiled_with_vm (eval_go
);
856 /* if we have no eval.go, we shouldn't load any compiled code at all */
857 *scm_loc_load_compiled_path
= SCM_EOL
;
861 /* Information about the build environment. */
863 SCM_VARIABLE_INIT (sys_host_type
, "%host-type",
864 scm_from_locale_string (HOST_TYPE
));
867 /* Initialize the scheme variable %guile-build-info, based on data
868 provided by the Makefile, via libpath.h. */
872 static struct { char *name
; char *value
; } info
[] = SCM_BUILD_INFO
;
873 SCM
*loc
= SCM_VARIABLE_LOC (scm_c_define ("%guile-build-info", SCM_EOL
));
876 for (i
= 0; i
< (sizeof (info
) / sizeof (info
[0])); i
++)
878 SCM key
= scm_from_locale_symbol (info
[i
].name
);
879 SCM val
= scm_from_locale_string (info
[i
].value
);
880 *loc
= scm_acons (key
, val
, *loc
);
888 scm_listofnullstr
= scm_list_1 (scm_nullstr
);
889 scm_loc_load_path
= SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL
));
890 scm_loc_load_extensions
891 = SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
892 scm_list_2 (scm_from_locale_string (".scm"),
894 scm_loc_load_compiled_path
895 = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-path", SCM_EOL
));
896 scm_loc_load_compiled_extensions
897 = SCM_VARIABLE_LOC (scm_c_define ("%load-compiled-extensions",
898 scm_list_1 (scm_from_locale_string (".go"))));
899 scm_loc_load_hook
= SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F
));
901 scm_loc_compile_fallback_path
902 = SCM_VARIABLE_LOC (scm_c_define ("%compile-fallback-path", SCM_BOOL_F
));
903 scm_loc_load_should_autocompile
904 = SCM_VARIABLE_LOC (scm_c_define ("%load-should-autocompile", SCM_BOOL_F
));
906 the_reader
= scm_make_fluid ();
907 scm_fluid_set_x (the_reader
, SCM_BOOL_F
);
908 scm_c_define("current-reader", the_reader
);
910 scm_c_define ("load-compiled",
911 scm_c_make_gsubr ("load-compiled/vm", 1, 0, 0,
912 scm_load_compiled_with_vm
));
916 #include "libguile/load.x"
920 scm_init_load_should_autocompile ()
922 *scm_loc_load_should_autocompile
=
923 scm_from_bool (scm_getenv_int ("GUILE_AUTO_COMPILE", 1));