char *
gdbscm_exception_message_to_string (SCM exception)
{
SCM port = scm_open_output_string ();
SCM key, args;
char *result;
gdb_assert (gdbscm_is_exception (exception));
key = gdbscm_exception_key (exception);
args = gdbscm_exception_args (exception);
if (scm_is_eq (key, with_stack_error_symbol)
/* Don't crash on a badly generated gdb:with-stack exception. */
&& scm_is_pair (args)
&& scm_is_pair (scm_cdr (args)))
{
key = scm_car (args);
args = scm_cddr (args);
}
gdbscm_print_exception_message (port, SCM_BOOL_F, key, args);
result = gdbscm_scm_to_c_string (scm_get_output_string (port));
scm_close_port (port);
return result;
}
static void
ppscm_print_exception_unless_memory_error (SCM exception,
struct ui_file *stream)
{
if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
{
char *msg = gdbscm_exception_message_to_string (exception);
struct cleanup *cleanup = make_cleanup (xfree, msg);
/* This "shouldn't happen", but play it safe. */
if (msg == NULL || *msg == '\0')
fprintf_filtered (stream, _("<error reading variable>"));
else
{
/* Remove the trailing newline. We could instead call a special
routine for printing memory error messages, but this is easy
enough for now. */
size_t len = strlen (msg);
if (msg[len - 1] == '\n')
msg[len - 1] = '\0';
fprintf_filtered (stream, _("<error reading variable: %s>"), msg);
}
do_cleanups (cleanup);
}
else
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
}
void
gdbscm_throw (SCM exception)
{
scm_throw (gdbscm_exception_key (exception),
gdbscm_exception_args (exception));
gdb_assert_not_reached ("scm_throw returned");
}
static void
ppscm_print_exception_unless_memory_error (SCM exception,
struct ui_file *stream)
{
if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
{
gdb::unique_xmalloc_ptr<char> msg
= gdbscm_exception_message_to_string (exception);
/* This "shouldn't happen", but play it safe. */
if (msg == NULL || msg.get ()[0] == '\0')
fprintf_filtered (stream, _("<error reading variable>"));
else
{
/* Remove the trailing newline. We could instead call a special
routine for printing memory error messages, but this is easy
enough for now. */
char *msg_text = msg.get ();
size_t len = strlen (msg_text);
if (msg_text[len - 1] == '\n')
msg_text[len - 1] = '\0';
fprintf_filtered (stream, _("<error reading variable: %s>"), msg_text);
}
}
else
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
}
void
gdbscm_print_gdb_exception (SCM port, SCM exception)
{
gdb_assert (gdbscm_is_exception (exception));
gdbscm_print_exception_with_stack (port, SCM_BOOL_T,
gdbscm_exception_key (exception),
gdbscm_exception_args (exception));
}
static void
pascm_signal_setshow_error (SCM exception, const char *msg)
{
/* Don't print the stack if this was an error signalled by the command
itself. */
if (gdbscm_user_error_p (gdbscm_exception_key (exception)))
{
char *excp_text = gdbscm_exception_message_to_string (exception);
make_cleanup (xfree, excp_text);
error ("%s", excp_text);
}
else
{
gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
error ("%s", msg);
}
}
static void
cmdscm_function (struct cmd_list_element *command, char *args, int from_tty)
{
command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
SCM arg_scm, tty_scm, result;
gdb_assert (c_smob != NULL);
if (args == NULL)
args = "";
arg_scm = gdbscm_scm_from_string (args, strlen (args), host_charset (), 1);
if (gdbscm_is_exception (arg_scm))
error (_("Could not convert arguments to Scheme string."));
tty_scm = scm_from_bool (from_tty);
result = gdbscm_safe_call_3 (c_smob->invoke, c_smob->containing_scm,
arg_scm, tty_scm, gdbscm_user_error_p);
if (gdbscm_is_exception (result))
{
/* Don't print the stack if this was an error signalled by the command
itself. */
if (gdbscm_user_error_p (gdbscm_exception_key (result)))
{
char *msg = gdbscm_exception_message_to_string (result);
make_cleanup (xfree, msg);
error ("%s", msg);
}
else
{
gdbscm_print_gdb_exception (SCM_BOOL_F, result);
error (_("Error occurred in Scheme-implemented GDB command."));
}
}
}
