/* GDB/Scheme exception support.
- Copyright (C) 2014 Free Software Foundation, Inc.
+ Copyright (C) 2014-2016 Free Software Foundation, Inc.
This file is part of GDB.
#include "defs.h"
#include <signal.h>
-#include "gdb_assert.h"
#include "guile-internal.h"
/* The <gdb:exception> smob.
/* User interrupt, e.g., RETURN_QUIT in struct gdb_exception. */
static SCM signal_symbol;
+/* A user error, e.g., bad arg to gdb command. */
+static SCM user_error_symbol;
+
/* Printing the stack is done by first capturing the stack and recording it in
a <gdb:exception> object with this key and with the ARGS field set to
(cons real-key (cons stack real-args)).
\f
/* Administrivia for exception smobs. */
-/* The smob "mark" function for <gdb:exception>. */
-
-static SCM
-exscm_mark_exception_smob (SCM self)
-{
- exception_smob *e_smob = (exception_smob *) SCM_SMOB_DATA (self);
-
- scm_gc_mark (e_smob->key);
- return e_smob->args;
-}
-
/* The smob "print" function for <gdb:exception>. */
static int
SCM
gdbscm_make_misc_error (const char *subr, int arg_pos, SCM bad_value,
- const char *error)
+ const char *error)
{
return gdbscm_make_arg_error (scm_misc_error_key,
subr, arg_pos, bad_value, NULL, error);
}
+/* Throw a misc-error error. */
+
+void
+gdbscm_misc_error (const char *subr, int arg_pos, SCM bad_value,
+ const char *error)
+{
+ SCM exception = gdbscm_make_misc_error (subr, arg_pos, bad_value, error);
+
+ gdbscm_throw (exception);
+}
+
/* Return a <gdb:exception> object for gdb:memory-error. */
SCM
return scm_is_eq (key, memory_error_symbol);
}
+/* Return non-zero if KEY is gdb:user-error.
+ Note: This is an excp_matcher_func function. */
+
+int
+gdbscm_user_error_p (SCM key)
+{
+ return scm_is_eq (key, user_error_symbol);
+}
+
/* Wrapper around scm_throw to throw a gdb:exception.
This function does not return.
This function cannot be called from inside TRY_CATCH. */
KEY, ARGS are the standard arguments to scm_throw, et.al.
Basically this function is just a wrapper around calling
- %print-exception-with-args. */
+ %print-exception-with-stack. */
void
gdbscm_print_exception_with_stack (SCM port, SCM stack, SCM key, SCM args)
percent_print_exception_with_stack_var
= scm_c_private_variable (gdbscm_init_module_name,
percent_print_exception_with_stack_name);
- /* If we can't find %print-exception-with-args, there's a problem on the
+ /* If we can't find %print-exception-with-stack, there's a problem on the
Scheme side. Don't kill GDB, just flag an error and leave it at
that. */
if (gdbscm_is_false (percent_print_exception_with_stack_var))
static const scheme_function exception_functions[] =
{
- { "make-exception", 2, 0, 0, gdbscm_make_exception,
+ { "make-exception", 2, 0, 0, as_a_scm_t_subr (gdbscm_make_exception),
"\
Create a <gdb:exception> object.\n\
\n\
Arguments: key args\n\
These are the standard key,args arguments of \"throw\"." },
- { "exception?", 1, 0, 0, gdbscm_exception_p,
+ { "exception?", 1, 0, 0, as_a_scm_t_subr (gdbscm_exception_p),
"\
Return #t if the object is a <gdb:exception> object." },
- { "exception-key", 1, 0, 0, gdbscm_exception_key,
+ { "exception-key", 1, 0, 0, as_a_scm_t_subr (gdbscm_exception_key),
"\
Return the exception's key." },
- { "exception-args", 1, 0, 0, gdbscm_exception_args,
+ { "exception-args", 1, 0, 0, as_a_scm_t_subr (gdbscm_exception_args),
"\
Return the exception's arg list." },
static const scheme_function private_exception_functions[] =
{
- { "%exception-print-style", 0, 0, 0, gdbscm_percent_exception_print_style,
+ { "%exception-print-style", 0, 0, 0,
+ as_a_scm_t_subr (gdbscm_percent_exception_print_style),
"\
Return the value of the \"guile print-stack\" option." },
- { "%exception-count", 0, 0, 0, gdbscm_percent_exception_count,
+ { "%exception-count", 0, 0, 0,
+ as_a_scm_t_subr (gdbscm_percent_exception_count),
"\
Return a count of the number of <gdb:exception> objects created.\n\
This is for debugging purposes." },
{
exception_smob_tag = gdbscm_make_smob_type (exception_smob_name,
sizeof (exception_smob));
- scm_set_smob_mark (exception_smob_tag, exscm_mark_exception_smob);
scm_set_smob_print (exception_smob_tag, exscm_print_exception_smob);
gdbscm_define_functions (exception_functions, 1);
memory_error_symbol = scm_from_latin1_symbol ("gdb:memory-error");
+ user_error_symbol = scm_from_latin1_symbol ("gdb:user-error");
+
gdbscm_invalid_object_error_symbol
= scm_from_latin1_symbol ("gdb:invalid-object-error");