Insert breakpoint even when the raw breakpoint is found
[deliverable/binutils-gdb.git] / gdb / guile / scm-exception.c
index c892884b54cea94b11bee3733d7ef777040a338a..94ef0ec21710789520c4514214e8a8a5bdfa8d5c 100644 (file)
@@ -1,6 +1,6 @@
 /* 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.
 
@@ -30,7 +30,6 @@
 
 #include "defs.h"
 #include <signal.h>
-#include "gdb_assert.h"
 #include "guile-internal.h"
 
 /* The <gdb:exception> smob.
@@ -64,6 +63,9 @@ static SCM memory_error_symbol;
 /* 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)).
@@ -101,17 +103,6 @@ static unsigned long gdbscm_exception_count = 0;
 \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
@@ -368,12 +359,23 @@ gdbscm_out_of_range_error (const char *subr, int arg_pos, SCM bad_value,
 
 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
@@ -402,6 +404,15 @@ gdbscm_memory_error_p (SCM key)
   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.  */
@@ -509,7 +520,7 @@ gdbscm_print_exception_message (SCM port, SCM frame, SCM key, SCM args)
    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)
@@ -524,7 +535,7 @@ 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))
@@ -624,22 +635,22 @@ gdbscm_percent_exception_count (void)
 
 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." },
 
@@ -648,11 +659,13 @@ 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." },
@@ -665,7 +678,6 @@ gdbscm_initialize_exceptions (void)
 {
   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);
@@ -675,6 +687,8 @@ gdbscm_initialize_exceptions (void)
 
   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");
 
This page took 0.026093 seconds and 4 git commands to generate.