+/* Load BOOT_SCM_FILE, the first Scheme file that gets loaded. */
+
+static SCM
+boot_guile_support (void *boot_scm_file)
+{
+ /* Load boot.scm without compiling it (there's no need to compile it).
+ The other files should have been compiled already, and boot.scm is
+ expected to adjust '%load-compiled-path' accordingly. If they haven't
+ been compiled, Guile will auto-compile them. The important thing to keep
+ in mind is that there's a >= 100x speed difference between compiled and
+ non-compiled files. */
+ return scm_c_primitive_load ((const char *) boot_scm_file);
+}
+
+/* Return non-zero if ARGS has the "standard" format for throw args.
+ The standard format is:
+ (function format-string (format-string-args-list) ...).
+ FUNCTION is #f if no function was recorded. */
+
+static int
+standard_throw_args_p (SCM args)
+{
+ if (gdbscm_is_true (scm_list_p (args))
+ && scm_ilength (args) >= 3)
+ {
+ /* The function in which the error occurred. */
+ SCM arg0 = scm_list_ref (args, scm_from_int (0));
+ /* The format string. */
+ SCM arg1 = scm_list_ref (args, scm_from_int (1));
+ /* The arguments of the format string. */
+ SCM arg2 = scm_list_ref (args, scm_from_int (2));
+
+ if ((scm_is_string (arg0) || gdbscm_is_false (arg0))
+ && scm_is_string (arg1)
+ && gdbscm_is_true (scm_list_p (arg2)))
+ return 1;
+ }
+
+ return 0;
+}
+
+/* Print the error recorded in a "standard" throw args. */
+
+static void
+print_standard_throw_error (SCM args)
+{
+ /* The function in which the error occurred. */
+ SCM arg0 = scm_list_ref (args, scm_from_int (0));
+ /* The format string. */
+ SCM arg1 = scm_list_ref (args, scm_from_int (1));
+ /* The arguments of the format string. */
+ SCM arg2 = scm_list_ref (args, scm_from_int (2));
+
+ /* ARG0 is #f if no function was recorded. */
+ if (gdbscm_is_true (arg0))
+ {
+ scm_simple_format (scm_current_error_port (),
+ scm_from_latin1_string (_("Error in function ~s:~%")),
+ scm_list_1 (arg0));
+ }
+ scm_simple_format (scm_current_error_port (), arg1, arg2);
+}
+
+/* Print the error message recorded in KEY, ARGS, the arguments to throw.
+ Normally we let Scheme print the error message.
+ This function is used when Scheme initialization fails.
+ We can still use the Scheme C API though. */
+
+static void
+print_throw_error (SCM key, SCM args)
+{
+ /* IWBN to call gdbscm_print_exception_with_stack here, but Guile didn't
+ boot successfully so play it safe and avoid it. The "format string" and
+ its args are embedded in ARGS, but the content of ARGS depends on KEY.
+ Make sure ARGS has the expected canonical content before trying to use
+ it. */
+ if (standard_throw_args_p (args))
+ print_standard_throw_error (args);
+ else
+ {
+ scm_simple_format (scm_current_error_port (),
+ scm_from_latin1_string (_("Throw to key `~a' with args `~s'.~%")),
+ scm_list_2 (key, args));
+ }
+}
+
+/* Handle an exception thrown while loading BOOT_SCM_FILE. */
+
+static SCM
+handle_boot_error (void *boot_scm_file, SCM key, SCM args)
+{
+ fprintf_unfiltered (gdb_stderr, ("Exception caught while booting Guile.\n"));
+
+ print_throw_error (key, args);
+
+ fprintf_unfiltered (gdb_stderr, "\n");
+ warning (_("Could not complete Guile gdb module initialization from:\n"
+ "%s.\n"
+ "Limited Guile support is available.\n"
+ "Suggest passing --data-directory=/path/to/gdb/data-directory."),
+ (const char *) boot_scm_file);
+
+ return SCM_UNSPECIFIED;
+}
+