gdb/guile/scm-breakpoint.c

   1 /* Scheme interface to breakpoints.
   2
   3    Copyright (C) 2008-2023 Free Software Foundation, Inc.
   4
   5    This file is part of GDB.
   6
   7    This program is free software; you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation; either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    This program is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  19
  20 /* See README file in this directory for implementation notes, coding
  21    conventions, et.al.  */
  22
  23 #include "defs.h"
  24 #include "value.h"
  25 #include "breakpoint.h"
  26 #include "gdbcmd.h"
  27 #include "gdbthread.h"
  28 #include "observable.h"
  29 #include "cli/cli-script.h"
  30 #include "ada-lang.h"
  31 #include "arch-utils.h"
  32 #include "language.h"
  33 #include "guile-internal.h"
  34 #include "location.h"
  35
  36 /* The <gdb:breakpoint> smob.
  37    N.B.: The name of this struct is known to breakpoint.h.
  38
  39    Note: Breakpoints are added to gdb using a two step process:
  40    1) Call make-breakpoint to create a <gdb:breakpoint> object.
  41    2) Call register-breakpoint! to add the breakpoint to gdb.
  42    It is done this way so that the constructor, make-breakpoint, doesn't have
  43    any side-effects.  This means that the smob needs to store everything
  44    that was passed to make-breakpoint.  */
  45
  46 typedef struct gdbscm_breakpoint_object
  47 {
  48   /* This always appears first.  */
  49   gdb_smob base;
  50
  51   /* Non-zero if this breakpoint was created with make-breakpoint.  */
  52   int is_scheme_bkpt;
  53
  54   /* For breakpoints created with make-breakpoint, these are the parameters
  55      that were passed to make-breakpoint.  These values are not used except
  56      to register the breakpoint with GDB.  */
  57   struct
  58   {
  59     /* The string representation of the breakpoint.
  60        Space for this lives in GC space.  */
  61     char *location;
  62
  63     /* The kind of breakpoint.
  64        At the moment this can only be one of bp_breakpoint, bp_watchpoint.  */
  65     enum bptype type;
  66
  67     /* If a watchpoint, the kind of watchpoint.  */
  68     enum target_hw_bp_type access_type;
  69
  70     /* Non-zero if the breakpoint is an "internal" breakpoint.  */
  71     int is_internal;
  72
  73     /* Non-zero if the breakpoint is temporary.  */
  74     int is_temporary;
  75   } spec;
  76
  77   /* The breakpoint number according to gdb.
  78      For breakpoints created from Scheme, this has the value -1 until the
  79      breakpoint is registered with gdb.
  80      This is recorded here because BP will be NULL when deleted.  */
  81   int number;
  82
  83   /* The gdb breakpoint object, or NULL if the breakpoint has not been
  84      registered yet, or has been deleted.  */
  85   struct breakpoint *bp;
  86
  87   /* Backlink to our containing <gdb:breakpoint> smob.
  88      This is needed when we are deleted, we need to unprotect the object
  89      from GC.  */
  90   SCM containing_scm;
  91
  92   /* A stop condition or #f.  */
  93   SCM stop;
  94 } breakpoint_smob;
  95
  96 static const char breakpoint_smob_name[] = "gdb:breakpoint";
  97
  98 /* The tag Guile knows the breakpoint smob by.  */
  99 static scm_t_bits breakpoint_smob_tag;
 100
 101 /* Variables used to pass information between the breakpoint_smob
 102    constructor and the breakpoint-created hook function.  */
 103 static SCM pending_breakpoint_scm = SCM_BOOL_F;
 104
 105 /* Keywords used by create-breakpoint!.  */
 106 static SCM type_keyword;
 107 static SCM wp_class_keyword;
 108 static SCM internal_keyword;
 109 static SCM temporary_keyword;
 110 \f
 111 /* Administrivia for breakpoint smobs.  */
 112
 113 /* The smob "free" function for <gdb:breakpoint>.  */
 114
 115 static size_t
 116 bpscm_free_breakpoint_smob (SCM self)
 117 {
 118   breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
 119
 120   if (bp_smob->bp)
 121     bp_smob->bp->scm_bp_object = NULL;
 122
 123   /* Not necessary, done to catch bugs.  */
 124   bp_smob->bp = NULL;
 125   bp_smob->containing_scm = SCM_UNDEFINED;
 126   bp_smob->stop = SCM_UNDEFINED;
 127
 128   return 0;
 129 }
 130
 131 /* Return the name of TYPE.
 132    This doesn't handle all types, just the ones we export.  */
 133
 134 static const char *
 135 bpscm_type_to_string (enum bptype type)
 136 {
 137   switch (type)
 138     {
 139     case bp_none: return "BP_NONE";
 140     case bp_breakpoint: return "BP_BREAKPOINT";
 141     case bp_watchpoint: return "BP_WATCHPOINT";
 142     case bp_hardware_watchpoint: return "BP_HARDWARE_WATCHPOINT";
 143     case bp_read_watchpoint: return "BP_READ_WATCHPOINT";
 144     case bp_access_watchpoint: return "BP_ACCESS_WATCHPOINT";
 145     case bp_catchpoint: return "BP_CATCHPOINT";
 146     default: return "internal/other";
 147     }
 148 }
 149
 150 /* Return the name of ENABLE_STATE.  */
 151
 152 static const char *
 153 bpscm_enable_state_to_string (enum enable_state enable_state)
 154 {
 155   switch (enable_state)
 156     {
 157     case bp_disabled: return "disabled";
 158     case bp_enabled: return "enabled";
 159     case bp_call_disabled: return "call_disabled";
 160     default: return "unknown";
 161     }
 162 }
 163
 164 /* The smob "print" function for <gdb:breakpoint>.  */
 165
 166 static int
 167 bpscm_print_breakpoint_smob (SCM self, SCM port, scm_print_state *pstate)
 168 {
 169   breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (self);
 170   struct breakpoint *b = bp_smob->bp;
 171
 172   gdbscm_printf (port, "#<%s", breakpoint_smob_name);
 173
 174   /* Only print what we export to the user.
 175      The rest are possibly internal implementation details.  */
 176
 177   gdbscm_printf (port, " #%d", bp_smob->number);
 178
 179   /* Careful, the breakpoint may be invalid.  */
 180   if (b != NULL)
 181     {
 182       gdbscm_printf (port, " %s %s %s",
 183                      bpscm_type_to_string (b->type),
 184                      bpscm_enable_state_to_string (b->enable_state),
 185                      b->silent ? "silent" : "noisy");
 186
 187       gdbscm_printf (port, " hit:%d", b->hit_count);
 188       gdbscm_printf (port, " ignore:%d", b->ignore_count);
 189
 190       if (b->locspec != nullptr)
 191         {
 192           const char *str = b->locspec->to_string ();
 193           if (str != nullptr)
 194             gdbscm_printf (port, " @%s", str);
 195         }
 196     }
 197
 198   scm_puts (">", port);
 199
 200   scm_remember_upto_here_1 (self);
 201
 202   /* Non-zero means success.  */
 203   return 1;
 204 }
 205
 206 /* Low level routine to create a <gdb:breakpoint> object.  */
 207
 208 static SCM
 209 bpscm_make_breakpoint_smob (void)
 210 {
 211   breakpoint_smob *bp_smob = (breakpoint_smob *)
 212     scm_gc_malloc (sizeof (breakpoint_smob), breakpoint_smob_name);
 213   SCM bp_scm;
 214
 215   memset (bp_smob, 0, sizeof (*bp_smob));
 216   bp_smob->number = -1;
 217   bp_smob->stop = SCM_BOOL_F;
 218   bp_scm = scm_new_smob (breakpoint_smob_tag, (scm_t_bits) bp_smob);
 219   bp_smob->containing_scm = bp_scm;
 220   gdbscm_init_gsmob (&bp_smob->base);
 221
 222   return bp_scm;
 223 }
 224
 225 /* Return non-zero if we want a Scheme wrapper for breakpoint B.
 226    If FROM_SCHEME is non-zero,this is called for a breakpoint created
 227    by the user from Scheme.  Otherwise it is zero.  */
 228
 229 static int
 230 bpscm_want_scm_wrapper_p (struct breakpoint *bp, int from_scheme)
 231 {
 232   /* Don't create <gdb:breakpoint> objects for internal GDB breakpoints.  */
 233   if (bp->number < 0 && !from_scheme)
 234     return 0;
 235
 236   /* The others are not supported.  */
 237   if (bp->type != bp_breakpoint
 238       && bp->type != bp_watchpoint
 239       && bp->type != bp_hardware_watchpoint
 240       && bp->type != bp_read_watchpoint
 241       && bp->type != bp_access_watchpoint
 242       && bp->type != bp_catchpoint)
 243     return 0;
 244
 245   return 1;
 246 }
 247
 248 /* Install the Scheme side of a breakpoint, CONTAINING_SCM, in
 249    the gdb side BP.  */
 250
 251 static void
 252 bpscm_attach_scm_to_breakpoint (struct breakpoint *bp, SCM containing_scm)
 253 {
 254   breakpoint_smob *bp_smob;
 255
 256   bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (containing_scm);
 257   bp_smob->number = bp->number;
 258   bp_smob->bp = bp;
 259   bp_smob->containing_scm = containing_scm;
 260   bp_smob->bp->scm_bp_object = bp_smob;
 261
 262   /* The owner of this breakpoint is not in GC-controlled memory, so we need
 263      to protect it from GC until the breakpoint is deleted.  */
 264   scm_gc_protect_object (containing_scm);
 265 }
 266
 267 /* Return non-zero if SCM is a breakpoint smob.  */
 268
 269 static int
 270 bpscm_is_breakpoint (SCM scm)
 271 {
 272   return SCM_SMOB_PREDICATE (breakpoint_smob_tag, scm);
 273 }
 274
 275 /* (breakpoint? scm) -> boolean */
 276
 277 static SCM
 278 gdbscm_breakpoint_p (SCM scm)
 279 {
 280   return scm_from_bool (bpscm_is_breakpoint (scm));
 281 }
 282
 283 /* Returns the <gdb:breakpoint> object in SELF.
 284    Throws an exception if SELF is not a <gdb:breakpoint> object.  */
 285
 286 static SCM
 287 bpscm_get_breakpoint_arg_unsafe (SCM self, int arg_pos, const char *func_name)
 288 {
 289   SCM_ASSERT_TYPE (bpscm_is_breakpoint (self), self, arg_pos, func_name,
 290                    breakpoint_smob_name);
 291
 292   return self;
 293 }
 294
 295 /* Returns a pointer to the breakpoint smob of SELF.
 296    Throws an exception if SELF is not a <gdb:breakpoint> object.  */
 297
 298 static breakpoint_smob *
 299 bpscm_get_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
 300                                       const char *func_name)
 301 {
 302   SCM bp_scm = bpscm_get_breakpoint_arg_unsafe (self, arg_pos, func_name);
 303   breakpoint_smob *bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (bp_scm);
 304
 305   return bp_smob;
 306 }
 307
 308 /* Return non-zero if breakpoint BP_SMOB is valid.  */
 309
 310 static int
 311 bpscm_is_valid (breakpoint_smob *bp_smob)
 312 {
 313   return bp_smob->bp != NULL;
 314 }
 315
 316 /* Returns the breakpoint smob in SELF, verifying it's valid.
 317    Throws an exception if SELF is not a <gdb:breakpoint> object,
 318    or is invalid.  */
 319
 320 static breakpoint_smob *
 321 bpscm_get_valid_breakpoint_smob_arg_unsafe (SCM self, int arg_pos,
 322                                             const char *func_name)
 323 {
 324   breakpoint_smob *bp_smob
 325     = bpscm_get_breakpoint_smob_arg_unsafe (self, arg_pos, func_name);
 326
 327   if (!bpscm_is_valid (bp_smob))
 328     {
 329       gdbscm_invalid_object_error (func_name, arg_pos, self,
 330                                    _("<gdb:breakpoint>"));
 331     }
 332
 333   return bp_smob;
 334 }
 335 \f
 336 /* Breakpoint methods.  */
 337
 338 /* (make-breakpoint string [#:type integer] [#:wp-class integer]
 339     [#:internal boolean] [#:temporary boolean]) -> <gdb:breakpoint>
 340
 341    The result is the <gdb:breakpoint> Scheme object.
 342    The breakpoint is not available to be used yet, however.
 343    It must still be added to gdb with register-breakpoint!.  */
 344
 345 static SCM
 346 gdbscm_make_breakpoint (SCM location_scm, SCM rest)
 347 {
 348   const SCM keywords[] = {
 349     type_keyword, wp_class_keyword, internal_keyword,
 350     temporary_keyword, SCM_BOOL_F
 351   };
 352   char *s;
 353   char *location;
 354   int type_arg_pos = -1, access_type_arg_pos = -1,
 355       internal_arg_pos = -1, temporary_arg_pos = -1;
 356   int type = bp_breakpoint;
 357   int access_type = hw_write;
 358   int internal = 0;
 359   int temporary = 0;
 360   SCM result;
 361   breakpoint_smob *bp_smob;
 362
 363   gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "s#iitt",
 364                               location_scm, &location, rest,
 365                               &type_arg_pos, &type,
 366                               &access_type_arg_pos, &access_type,
 367                               &internal_arg_pos, &internal,
 368                               &temporary_arg_pos, &temporary);
 369
 370   result = bpscm_make_breakpoint_smob ();
 371   bp_smob = (breakpoint_smob *) SCM_SMOB_DATA (result);
 372
 373   s = location;
 374   location = gdbscm_gc_xstrdup (s);
 375   xfree (s);
 376
 377   switch (type)
 378     {
 379     case bp_breakpoint:
 380       if (access_type_arg_pos > 0)
 381         {
 382           gdbscm_misc_error (FUNC_NAME, access_type_arg_pos,
 383                              scm_from_int (access_type),
 384                              _("access type with breakpoint is not allowed"));
 385         }
 386       break;
 387     case bp_watchpoint:
 388       switch (access_type)
 389         {
 390         case hw_write:
 391         case hw_access:
 392         case hw_read:
 393           break;
 394         default:
 395           gdbscm_out_of_range_error (FUNC_NAME, access_type_arg_pos,
 396                                      scm_from_int (access_type),
 397                                      _("invalid watchpoint class"));
 398         }
 399       break;
 400     case bp_none:
 401     case bp_hardware_watchpoint:
 402     case bp_read_watchpoint:
 403     case bp_access_watchpoint:
 404     case bp_catchpoint:
 405       {
 406         const char *type_name = bpscm_type_to_string ((enum bptype) type);
 407         gdbscm_misc_error (FUNC_NAME, type_arg_pos,
 408                            gdbscm_scm_from_c_string (type_name),
 409                            _("unsupported breakpoint type"));
 410       }
 411       break;
 412     default:
 413       gdbscm_out_of_range_error (FUNC_NAME, type_arg_pos,
 414                                  scm_from_int (type),
 415                                  _("invalid breakpoint type"));
 416     }
 417
 418   bp_smob->is_scheme_bkpt = 1;
 419   bp_smob->spec.location = location;
 420   bp_smob->spec.type = (enum bptype) type;
 421   bp_smob->spec.access_type = (enum target_hw_bp_type) access_type;
 422   bp_smob->spec.is_internal = internal;
 423   bp_smob->spec.is_temporary = temporary;
 424
 425   return result;
 426 }
 427
 428 /* (register-breakpoint! <gdb:breakpoint>) -> unspecified
 429
 430    It is an error to register a breakpoint created outside of Guile,
 431    or an already-registered breakpoint.  */
 432
 433 static SCM
 434 gdbscm_register_breakpoint_x (SCM self)
 435 {
 436   breakpoint_smob *bp_smob
 437     = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 438   gdbscm_gdb_exception except {};
 439   const char *location, *copy;
 440
 441   /* We only support registering breakpoints created with make-breakpoint.  */
 442   if (!bp_smob->is_scheme_bkpt)
 443     scm_misc_error (FUNC_NAME, _("not a Scheme breakpoint"), SCM_EOL);
 444
 445   if (bpscm_is_valid (bp_smob))
 446     scm_misc_error (FUNC_NAME, _("breakpoint is already registered"), SCM_EOL);
 447
 448   pending_breakpoint_scm = self;
 449   location = bp_smob->spec.location;
 450   copy = skip_spaces (location);
 451   location_spec_up locspec
 452     = string_to_location_spec_basic (&copy,
 453                                      current_language,
 454                                      symbol_name_match_type::WILD);
 455
 456   try
 457     {
 458       int internal = bp_smob->spec.is_internal;
 459       int temporary = bp_smob->spec.is_temporary;
 460
 461       switch (bp_smob->spec.type)
 462         {
 463         case bp_breakpoint:
 464           {
 465             const breakpoint_ops *ops =
 466               breakpoint_ops_for_location_spec (locspec.get (), false);
 467             create_breakpoint (get_current_arch (),
 468                                locspec.get (), NULL, -1, -1, NULL, false,
 469                                0,
 470                                temporary, bp_breakpoint,
 471                                0,
 472                                AUTO_BOOLEAN_TRUE,
 473                                ops,
 474                                0, 1, internal, 0);
 475             break;
 476           }
 477         case bp_watchpoint:
 478           {
 479             enum target_hw_bp_type access_type = bp_smob->spec.access_type;
 480
 481             if (access_type == hw_write)
 482               watch_command_wrapper (location, 0, internal);
 483             else if (access_type == hw_access)
 484               awatch_command_wrapper (location, 0, internal);
 485             else if (access_type == hw_read)
 486               rwatch_command_wrapper (location, 0, internal);
 487             else
 488               gdb_assert_not_reached ("invalid access type");
 489             break;
 490           }
 491         default:
 492           gdb_assert_not_reached ("invalid breakpoint type");
 493         }
 494     }
 495   catch (const gdb_exception &ex)
 496     {
 497       except = unpack (ex);
 498     }
 499
 500   /* Ensure this gets reset, even if there's an error.  */
 501   pending_breakpoint_scm = SCM_BOOL_F;
 502   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 503
 504   return SCM_UNSPECIFIED;
 505 }
 506
 507 /* (delete-breakpoint! <gdb:breakpoint>) -> unspecified
 508    Scheme function which deletes (removes) the underlying GDB breakpoint
 509    from GDB's list of breakpoints.  This triggers the breakpoint_deleted
 510    observer which will call gdbscm_breakpoint_deleted; that function cleans
 511    up the Scheme bits.  */
 512
 513 static SCM
 514 gdbscm_delete_breakpoint_x (SCM self)
 515 {
 516   breakpoint_smob *bp_smob
 517     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 518
 519   gdbscm_gdb_exception exc {};
 520   try
 521     {
 522       delete_breakpoint (bp_smob->bp);
 523     }
 524   catch (const gdb_exception &except)
 525     {
 526       exc = unpack (except);
 527     }
 528
 529   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 530   return SCM_UNSPECIFIED;
 531 }
 532
 533 /* iterate_over_breakpoints function for gdbscm_breakpoints.  */
 534
 535 static void
 536 bpscm_build_bp_list (struct breakpoint *bp, SCM *list)
 537 {
 538   breakpoint_smob *bp_smob = bp->scm_bp_object;
 539
 540   /* Lazily create wrappers for breakpoints created outside Scheme.  */
 541
 542   if (bp_smob == NULL)
 543     {
 544       if (bpscm_want_scm_wrapper_p (bp, 0))
 545         {
 546           SCM bp_scm;
 547
 548           bp_scm = bpscm_make_breakpoint_smob ();
 549           bpscm_attach_scm_to_breakpoint (bp, bp_scm);
 550           /* Refetch it.  */
 551           bp_smob = bp->scm_bp_object;
 552         }
 553     }
 554
 555   /* Not all breakpoints will have a companion Scheme object.
 556      Only breakpoints that trigger the created_breakpoint observer call,
 557      and satisfy certain conditions (see bpscm_want_scm_wrapper_p),
 558      get a companion object (this includes Scheme-created breakpoints).  */
 559
 560   if (bp_smob != NULL)
 561     *list = scm_cons (bp_smob->containing_scm, *list);
 562 }
 563
 564 /* (breakpoints) -> list
 565    Return a list of all breakpoints.  */
 566
 567 static SCM
 568 gdbscm_breakpoints (void)
 569 {
 570   SCM list = SCM_EOL;
 571
 572   for (breakpoint &bp : all_breakpoints ())
 573     bpscm_build_bp_list (&bp, &list);
 574
 575   return scm_reverse_x (list, SCM_EOL);
 576 }
 577
 578 /* (breakpoint-valid? <gdb:breakpoint>) -> boolean
 579    Returns #t if SELF is still valid.  */
 580
 581 static SCM
 582 gdbscm_breakpoint_valid_p (SCM self)
 583 {
 584   breakpoint_smob *bp_smob
 585     = bpscm_get_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 586
 587   return scm_from_bool (bpscm_is_valid (bp_smob));
 588 }
 589
 590 /* (breakpoint-enabled? <gdb:breakpoint>) -> boolean */
 591
 592 static SCM
 593 gdbscm_breakpoint_enabled_p (SCM self)
 594 {
 595   breakpoint_smob *bp_smob
 596     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 597
 598   return scm_from_bool (bp_smob->bp->enable_state == bp_enabled);
 599 }
 600
 601 /* (set-breakpoint-enabled? <gdb:breakpoint> boolean) -> unspecified */
 602
 603 static SCM
 604 gdbscm_set_breakpoint_enabled_x (SCM self, SCM newvalue)
 605 {
 606   breakpoint_smob *bp_smob
 607     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 608
 609   SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
 610                    _("boolean"));
 611
 612   gdbscm_gdb_exception exc {};
 613   try
 614     {
 615       if (gdbscm_is_true (newvalue))
 616         enable_breakpoint (bp_smob->bp);
 617       else
 618         disable_breakpoint (bp_smob->bp);
 619     }
 620   catch (const gdb_exception &except)
 621     {
 622       exc = unpack (except);
 623     }
 624
 625   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 626   return SCM_UNSPECIFIED;
 627 }
 628
 629 /* (breakpoint-silent? <gdb:breakpoint>) -> boolean */
 630
 631 static SCM
 632 gdbscm_breakpoint_silent_p (SCM self)
 633 {
 634   breakpoint_smob *bp_smob
 635     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 636
 637   return scm_from_bool (bp_smob->bp->silent);
 638 }
 639
 640 /* (set-breakpoint-silent?! <gdb:breakpoint> boolean) -> unspecified */
 641
 642 static SCM
 643 gdbscm_set_breakpoint_silent_x (SCM self, SCM newvalue)
 644 {
 645   breakpoint_smob *bp_smob
 646     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 647
 648   SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
 649                    _("boolean"));
 650
 651   gdbscm_gdb_exception exc {};
 652   try
 653     {
 654       breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
 655     }
 656   catch (const gdb_exception &except)
 657     {
 658       exc = unpack (except);
 659     }
 660
 661   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 662   return SCM_UNSPECIFIED;
 663 }
 664
 665 /* (breakpoint-ignore-count <gdb:breakpoint>) -> integer */
 666
 667 static SCM
 668 gdbscm_breakpoint_ignore_count (SCM self)
 669 {
 670   breakpoint_smob *bp_smob
 671     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 672
 673   return scm_from_long (bp_smob->bp->ignore_count);
 674 }
 675
 676 /* (set-breakpoint-ignore-count! <gdb:breakpoint> integer)
 677      -> unspecified */
 678
 679 static SCM
 680 gdbscm_set_breakpoint_ignore_count_x (SCM self, SCM newvalue)
 681 {
 682   breakpoint_smob *bp_smob
 683     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 684   long value;
 685
 686   SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
 687                    newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
 688
 689   value = scm_to_long (newvalue);
 690   if (value < 0)
 691     value = 0;
 692
 693   gdbscm_gdb_exception exc {};
 694   try
 695     {
 696       set_ignore_count (bp_smob->number, (int) value, 0);
 697     }
 698   catch (const gdb_exception &except)
 699     {
 700       exc = unpack (except);
 701     }
 702
 703   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 704   return SCM_UNSPECIFIED;
 705 }
 706
 707 /* (breakpoint-hit-count <gdb:breakpoint>) -> integer */
 708
 709 static SCM
 710 gdbscm_breakpoint_hit_count (SCM self)
 711 {
 712   breakpoint_smob *bp_smob
 713     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 714
 715   return scm_from_long (bp_smob->bp->hit_count);
 716 }
 717
 718 /* (set-breakpoint-hit-count! <gdb:breakpoint> integer) -> unspecified */
 719
 720 static SCM
 721 gdbscm_set_breakpoint_hit_count_x (SCM self, SCM newvalue)
 722 {
 723   breakpoint_smob *bp_smob
 724     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 725   long value;
 726
 727   SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
 728                    newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
 729
 730   value = scm_to_long (newvalue);
 731   if (value < 0)
 732     value = 0;
 733
 734   if (value != 0)
 735     {
 736       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 737                                  _("hit-count must be zero"));
 738     }
 739
 740   bp_smob->bp->hit_count = 0;
 741
 742   return SCM_UNSPECIFIED;
 743 }
 744
 745 /* (breakpoint-thread <gdb:breakpoint>) -> integer */
 746
 747 static SCM
 748 gdbscm_breakpoint_thread (SCM self)
 749 {
 750   breakpoint_smob *bp_smob
 751     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 752
 753   if (bp_smob->bp->thread == -1)
 754     return SCM_BOOL_F;
 755
 756   return scm_from_long (bp_smob->bp->thread);
 757 }
 758
 759 /* (set-breakpoint-thread! <gdb:breakpoint> integer) -> unspecified */
 760
 761 static SCM
 762 gdbscm_set_breakpoint_thread_x (SCM self, SCM newvalue)
 763 {
 764   breakpoint_smob *bp_smob
 765     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 766   long id;
 767
 768   if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
 769     {
 770       id = scm_to_long (newvalue);
 771       if (!valid_global_thread_id (id))
 772         {
 773           gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 774                                      _("invalid thread id"));
 775         }
 776
 777       if (bp_smob->bp->task != -1)
 778         scm_misc_error (FUNC_NAME,
 779                         _("cannot set both task and thread attributes"),
 780                         SCM_EOL);
 781     }
 782   else if (gdbscm_is_false (newvalue))
 783     id = -1;
 784   else
 785     SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
 786
 787   if (bp_smob->bp->inferior != -1 && id != -1)
 788     scm_misc_error (FUNC_NAME,
 789                     _("Cannot have both 'thread' and 'inferior' "
 790                       "conditions on a breakpoint"), SCM_EOL);
 791
 792   breakpoint_set_thread (bp_smob->bp, id);
 793
 794   return SCM_UNSPECIFIED;
 795 }
 796
 797 /* (breakpoint-task <gdb:breakpoint>) -> integer */
 798
 799 static SCM
 800 gdbscm_breakpoint_task (SCM self)
 801 {
 802   breakpoint_smob *bp_smob
 803     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 804
 805   if (bp_smob->bp->task == -1)
 806     return SCM_BOOL_F;
 807
 808   return scm_from_long (bp_smob->bp->task);
 809 }
 810
 811 /* (set-breakpoint-task! <gdb:breakpoint> integer) -> unspecified */
 812
 813 static SCM
 814 gdbscm_set_breakpoint_task_x (SCM self, SCM newvalue)
 815 {
 816   breakpoint_smob *bp_smob
 817     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 818   long id;
 819   int valid_id = 0;
 820
 821   if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
 822     {
 823       id = scm_to_long (newvalue);
 824
 825       gdbscm_gdb_exception exc {};
 826       try
 827         {
 828           valid_id = valid_task_id (id);
 829         }
 830       catch (const gdb_exception &except)
 831         {
 832           exc = unpack (except);
 833         }
 834
 835       GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 836       if (! valid_id)
 837         {
 838           gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 839                                      _("invalid task id"));
 840         }
 841
 842       if (bp_smob->bp->thread != -1)
 843         scm_misc_error (FUNC_NAME,
 844                         _("cannot set both task and thread attributes"),
 845                         SCM_EOL);
 846     }
 847   else if (gdbscm_is_false (newvalue))
 848     id = -1;
 849   else
 850     SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
 851
 852   gdbscm_gdb_exception exc {};
 853   try
 854     {
 855       breakpoint_set_task (bp_smob->bp, id);
 856     }
 857   catch (const gdb_exception &except)
 858     {
 859       exc = unpack (except);
 860     }
 861
 862   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
 863   return SCM_UNSPECIFIED;
 864 }
 865
 866 /* (breakpoint-location <gdb:breakpoint>) -> string */
 867
 868 static SCM
 869 gdbscm_breakpoint_location (SCM self)
 870 {
 871   breakpoint_smob *bp_smob
 872     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 873
 874   if (bp_smob->bp->type != bp_breakpoint)
 875     return SCM_BOOL_F;
 876
 877   const char *str = bp_smob->bp->locspec->to_string ();
 878   if (str == nullptr)
 879     str = "";
 880
 881   return gdbscm_scm_from_c_string (str);
 882 }
 883
 884 /* (breakpoint-expression <gdb:breakpoint>) -> string
 885    This is only valid for watchpoints.
 886    Returns #f for non-watchpoints.  */
 887
 888 static SCM
 889 gdbscm_breakpoint_expression (SCM self)
 890 {
 891   breakpoint_smob *bp_smob
 892     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 893   struct watchpoint *wp;
 894
 895   if (!is_watchpoint (bp_smob->bp))
 896     return SCM_BOOL_F;
 897
 898   wp = (struct watchpoint *) bp_smob->bp;
 899
 900   const char *str = wp->exp_string.get ();
 901   if (! str)
 902     str = "";
 903
 904   return gdbscm_scm_from_c_string (str);
 905 }
 906
 907 /* (breakpoint-condition <gdb:breakpoint>) -> string */
 908
 909 static SCM
 910 gdbscm_breakpoint_condition (SCM self)
 911 {
 912   breakpoint_smob *bp_smob
 913     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 914   char *str;
 915
 916   str = bp_smob->bp->cond_string.get ();
 917   if (! str)
 918     return SCM_BOOL_F;
 919
 920   return gdbscm_scm_from_c_string (str);
 921 }
 922
 923 /* (set-breakpoint-condition! <gdb:breakpoint> string|#f)
 924    -> unspecified */
 925
 926 static SCM
 927 gdbscm_set_breakpoint_condition_x (SCM self, SCM newvalue)
 928 {
 929   breakpoint_smob *bp_smob
 930     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 931
 932   SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
 933                    newvalue, SCM_ARG2, FUNC_NAME,
 934                    _("string or #f"));
 935
 936   return gdbscm_wrap ([=]
 937     {
 938       gdb::unique_xmalloc_ptr<char> exp
 939         = (gdbscm_is_false (newvalue)
 940            ? nullptr
 941            : gdbscm_scm_to_c_string (newvalue));
 942
 943       set_breakpoint_condition (bp_smob->bp, exp ? exp.get () : "", 0, false);
 944
 945       return SCM_UNSPECIFIED;
 946     });
 947 }
 948
 949 /* (breakpoint-stop <gdb:breakpoint>) -> procedure or #f */
 950
 951 static SCM
 952 gdbscm_breakpoint_stop (SCM self)
 953 {
 954   breakpoint_smob *bp_smob
 955     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 956
 957   return bp_smob->stop;
 958 }
 959
 960 /* (set-breakpoint-stop! <gdb:breakpoint> procedure|#f)
 961    -> unspecified */
 962
 963 static SCM
 964 gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
 965 {
 966   breakpoint_smob *bp_smob
 967     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 968   const struct extension_language_defn *extlang = NULL;
 969
 970   SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
 971                    || gdbscm_is_false (newvalue),
 972                    newvalue, SCM_ARG2, FUNC_NAME,
 973                    _("procedure or #f"));
 974
 975   if (bp_smob->bp->cond_string != NULL)
 976     extlang = get_ext_lang_defn (EXT_LANG_GDB);
 977   if (extlang == NULL)
 978     extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
 979   if (extlang != NULL)
 980     {
 981       char *error_text
 982         = xstrprintf (_("Only one stop condition allowed.  There is"
 983                         " currently a %s stop condition defined for"
 984                         " this breakpoint."),
 985                       ext_lang_capitalized_name (extlang)).release ();
 986
 987       scm_dynwind_begin ((scm_t_dynwind_flags) 0);
 988       gdbscm_dynwind_xfree (error_text);
 989       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
 990       /* The following line, while unnecessary, is present for completeness
 991          sake.  */
 992       scm_dynwind_end ();
 993     }
 994
 995   bp_smob->stop = newvalue;
 996
 997   return SCM_UNSPECIFIED;
 998 }
 999
1000 /* (breakpoint-commands <gdb:breakpoint>) -> string */
1001
1002 static SCM
1003 gdbscm_breakpoint_commands (SCM self)
1004 {
1005   breakpoint_smob *bp_smob
1006     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1007   struct breakpoint *bp;
1008   SCM result;
1009
1010   bp = bp_smob->bp;
1011
1012   if (bp->commands == NULL)
1013     return SCM_BOOL_F;
1014
1015   string_file buf;
1016
1017   gdbscm_gdb_exception exc {};
1018   try
1019     {
1020       ui_out_redirect_pop redir (current_uiout, &buf);
1021       print_command_lines (current_uiout, breakpoint_commands (bp), 0);
1022     }
1023   catch (const gdb_exception &except)
1024     {
1025       exc = unpack (except);
1026     }
1027
1028   GDBSCM_HANDLE_GDB_EXCEPTION (exc);
1029   result = gdbscm_scm_from_c_string (buf.c_str ());
1030
1031   return result;
1032 }
1033
1034 /* (breakpoint-type <gdb:breakpoint>) -> integer */
1035
1036 static SCM
1037 gdbscm_breakpoint_type (SCM self)
1038 {
1039   breakpoint_smob *bp_smob
1040     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1041
1042   return scm_from_long (bp_smob->bp->type);
1043 }
1044
1045 /* (breakpoint-visible? <gdb:breakpoint>) -> boolean */
1046
1047 static SCM
1048 gdbscm_breakpoint_visible (SCM self)
1049 {
1050   breakpoint_smob *bp_smob
1051     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1052
1053   return scm_from_bool (bp_smob->bp->number >= 0);
1054 }
1055
1056 /* (breakpoint-number <gdb:breakpoint>) -> integer */
1057
1058 static SCM
1059 gdbscm_breakpoint_number (SCM self)
1060 {
1061   breakpoint_smob *bp_smob
1062     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1063
1064   return scm_from_long (bp_smob->number);
1065 }
1066
1067 /* (breakpoint-temporary? <gdb:breakpoint>) -> boolean */
1068
1069 static SCM
1070 gdbscm_breakpoint_temporary (SCM self)
1071 {
1072   breakpoint_smob *bp_smob
1073     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1074
1075   return scm_from_bool (bp_smob->bp->disposition == disp_del
1076                         || bp_smob->bp->disposition == disp_del_at_next_stop);
1077 }
1078 \f
1079 /* Return TRUE if "stop" has been set for this breakpoint.
1080
1081    This is the extension_language_ops.breakpoint_has_cond "method".  */
1082
1083 int
1084 gdbscm_breakpoint_has_cond (const struct extension_language_defn *extlang,
1085                             struct breakpoint *b)
1086 {
1087   breakpoint_smob *bp_smob = b->scm_bp_object;
1088
1089   if (bp_smob == NULL)
1090     return 0;
1091
1092   return gdbscm_is_procedure (bp_smob->stop);
1093 }
1094
1095 /* Call the "stop" method in the breakpoint class.
1096    This must only be called if gdbscm_breakpoint_has_cond returns true.
1097    If the stop method returns #t, the inferior will be stopped at the
1098    breakpoint.  Otherwise the inferior will be allowed to continue
1099    (assuming other conditions don't indicate "stop").
1100
1101    This is the extension_language_ops.breakpoint_cond_says_stop "method".  */
1102
1103 enum ext_lang_bp_stop
1104 gdbscm_breakpoint_cond_says_stop
1105   (const struct extension_language_defn *extlang, struct breakpoint *b)
1106 {
1107   breakpoint_smob *bp_smob = b->scm_bp_object;
1108   SCM predicate_result;
1109   int stop;
1110
1111   if (bp_smob == NULL)
1112     return EXT_LANG_BP_STOP_UNSET;
1113   if (!gdbscm_is_procedure (bp_smob->stop))
1114     return EXT_LANG_BP_STOP_UNSET;
1115
1116   stop = 1;
1117
1118   predicate_result
1119     = gdbscm_safe_call_1 (bp_smob->stop, bp_smob->containing_scm, NULL);
1120
1121   if (gdbscm_is_exception (predicate_result))
1122     ; /* Exception already printed.  */
1123   /* If the "stop" function returns #f that means
1124      the Scheme breakpoint wants GDB to continue.  */
1125   else if (gdbscm_is_false (predicate_result))
1126     stop = 0;
1127
1128   return stop ? EXT_LANG_BP_STOP_YES : EXT_LANG_BP_STOP_NO;
1129 }
1130 \f
1131 /* Event callback functions.  */
1132
1133 /* Callback that is used when a breakpoint is created.
1134    For breakpoints created by Scheme, i.e., gdbscm_create_breakpoint_x, finish
1135    object creation by connecting the Scheme wrapper to the gdb object.
1136    We ignore breakpoints created from gdb or python here, we create the
1137    Scheme wrapper for those when there's a need to, e.g.,
1138    gdbscm_breakpoints.  */
1139
1140 static void
1141 bpscm_breakpoint_created (struct breakpoint *bp)
1142 {
1143   SCM bp_scm;
1144
1145   if (gdbscm_is_false (pending_breakpoint_scm))
1146     return;
1147
1148   /* Verify our caller error checked the user's request.  */
1149   gdb_assert (bpscm_want_scm_wrapper_p (bp, 1));
1150
1151   bp_scm = pending_breakpoint_scm;
1152   pending_breakpoint_scm = SCM_BOOL_F;
1153
1154   bpscm_attach_scm_to_breakpoint (bp, bp_scm);
1155 }
1156
1157 /* Callback that is used when a breakpoint is deleted.  This will
1158    invalidate the corresponding Scheme object.  */
1159
1160 static void
1161 bpscm_breakpoint_deleted (struct breakpoint *b)
1162 {
1163   int num = b->number;
1164   struct breakpoint *bp;
1165
1166   /* TODO: Why the lookup?  We have B.  */
1167
1168   bp = get_breakpoint (num);
1169   if (bp)
1170     {
1171       breakpoint_smob *bp_smob = bp->scm_bp_object;
1172
1173       if (bp_smob)
1174         {
1175           bp_smob->bp = NULL;
1176           bp_smob->number = -1;
1177           bp_smob->stop = SCM_BOOL_F;
1178           scm_gc_unprotect_object (bp_smob->containing_scm);
1179         }
1180     }
1181 }
1182 \f
1183 /* Initialize the Scheme breakpoint code.  */
1184
1185 static const scheme_integer_constant breakpoint_integer_constants[] =
1186 {
1187   { "BP_NONE", bp_none },
1188   { "BP_BREAKPOINT", bp_breakpoint },
1189   { "BP_WATCHPOINT", bp_watchpoint },
1190   { "BP_HARDWARE_WATCHPOINT", bp_hardware_watchpoint },
1191   { "BP_READ_WATCHPOINT", bp_read_watchpoint },
1192   { "BP_ACCESS_WATCHPOINT", bp_access_watchpoint },
1193   { "BP_CATCHPOINT", bp_catchpoint },
1194
1195   { "WP_READ", hw_read },
1196   { "WP_WRITE", hw_write },
1197   { "WP_ACCESS", hw_access },
1198
1199   END_INTEGER_CONSTANTS
1200 };
1201
1202 static const scheme_function breakpoint_functions[] =
1203 {
1204   { "make-breakpoint", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_breakpoint),
1205     "\
1206 Create a GDB breakpoint object.\n\
1207 \n\
1208   Arguments:\n\
1209     location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>] [#:temporary <bool>]\n\
1210   Returns:\n\
1211     <gdb:breakpoint> object" },
1212
1213   { "register-breakpoint!", 1, 0, 0,
1214     as_a_scm_t_subr (gdbscm_register_breakpoint_x),
1215     "\
1216 Register a <gdb:breakpoint> object with GDB." },
1217
1218   { "delete-breakpoint!", 1, 0, 0, as_a_scm_t_subr (gdbscm_delete_breakpoint_x),
1219     "\
1220 Delete the breakpoint from GDB." },
1221
1222   { "breakpoints", 0, 0, 0, as_a_scm_t_subr (gdbscm_breakpoints),
1223     "\
1224 Return a list of all GDB breakpoints.\n\
1225 \n\
1226   Arguments: none" },
1227
1228   { "breakpoint?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_p),
1229     "\
1230 Return #t if the object is a <gdb:breakpoint> object." },
1231
1232   { "breakpoint-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_valid_p),
1233     "\
1234 Return #t if the breakpoint has not been deleted from GDB." },
1235
1236   { "breakpoint-number", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_number),
1237     "\
1238 Return the breakpoint's number." },
1239
1240   { "breakpoint-temporary?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_temporary),
1241     "\
1242 Return #t if the breakpoint is a temporary breakpoint." },
1243
1244   { "breakpoint-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_type),
1245     "\
1246 Return the type of the breakpoint." },
1247
1248   { "breakpoint-visible?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_visible),
1249     "\
1250 Return #t if the breakpoint is visible to the user." },
1251
1252   { "breakpoint-location", 1, 0, 0,
1253     as_a_scm_t_subr (gdbscm_breakpoint_location),
1254     "\
1255 Return the location of the breakpoint as specified by the user." },
1256
1257   { "breakpoint-expression", 1, 0, 0,
1258     as_a_scm_t_subr (gdbscm_breakpoint_expression),
1259     "\
1260 Return the expression of the breakpoint as specified by the user.\n\
1261 Valid for watchpoints only, returns #f for non-watchpoints." },
1262
1263   { "breakpoint-enabled?", 1, 0, 0,
1264     as_a_scm_t_subr (gdbscm_breakpoint_enabled_p),
1265     "\
1266 Return #t if the breakpoint is enabled." },
1267
1268   { "set-breakpoint-enabled!", 2, 0, 0,
1269     as_a_scm_t_subr (gdbscm_set_breakpoint_enabled_x),
1270     "\
1271 Set the breakpoint's enabled state.\n\
1272 \n\
1273   Arguments: <gdb:breakpoint> boolean" },
1274
1275   { "breakpoint-silent?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_silent_p),
1276     "\
1277 Return #t if the breakpoint is silent." },
1278
1279   { "set-breakpoint-silent!", 2, 0, 0,
1280     as_a_scm_t_subr (gdbscm_set_breakpoint_silent_x),
1281     "\
1282 Set the breakpoint's silent state.\n\
1283 \n\
1284   Arguments: <gdb:breakpoint> boolean" },
1285
1286   { "breakpoint-ignore-count", 1, 0, 0,
1287     as_a_scm_t_subr (gdbscm_breakpoint_ignore_count),
1288     "\
1289 Return the breakpoint's \"ignore\" count." },
1290
1291   { "set-breakpoint-ignore-count!", 2, 0, 0,
1292     as_a_scm_t_subr (gdbscm_set_breakpoint_ignore_count_x),
1293     "\
1294 Set the breakpoint's \"ignore\" count.\n\
1295 \n\
1296   Arguments: <gdb:breakpoint> count" },
1297
1298   { "breakpoint-hit-count", 1, 0, 0,
1299     as_a_scm_t_subr (gdbscm_breakpoint_hit_count),
1300     "\
1301 Return the breakpoint's \"hit\" count." },
1302
1303   { "set-breakpoint-hit-count!", 2, 0, 0,
1304     as_a_scm_t_subr (gdbscm_set_breakpoint_hit_count_x),
1305     "\
1306 Set the breakpoint's \"hit\" count.  The value must be zero.\n\
1307 \n\
1308   Arguments: <gdb:breakpoint> 0" },
1309
1310   { "breakpoint-thread", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_thread),
1311     "\
1312 Return the breakpoint's global thread id or #f if there isn't one." },
1313
1314   { "set-breakpoint-thread!", 2, 0, 0,
1315     as_a_scm_t_subr (gdbscm_set_breakpoint_thread_x),
1316     "\
1317 Set the global thread id for this breakpoint.\n\
1318 \n\
1319   Arguments: <gdb:breakpoint> global-thread-id" },
1320
1321   { "breakpoint-task", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_task),
1322     "\
1323 Return the breakpoint's Ada task-id or #f if there isn't one." },
1324
1325   { "set-breakpoint-task!", 2, 0, 0,
1326     as_a_scm_t_subr (gdbscm_set_breakpoint_task_x),
1327     "\
1328 Set the breakpoint's Ada task-id.\n\
1329 \n\
1330   Arguments: <gdb:breakpoint> task-id" },
1331
1332   { "breakpoint-condition", 1, 0, 0,
1333     as_a_scm_t_subr (gdbscm_breakpoint_condition),
1334     "\
1335 Return the breakpoint's condition as specified by the user.\n\
1336 Return #f if there isn't one." },
1337
1338   { "set-breakpoint-condition!", 2, 0, 0,
1339     as_a_scm_t_subr (gdbscm_set_breakpoint_condition_x),
1340     "\
1341 Set the breakpoint's condition.\n\
1342 \n\
1343   Arguments: <gdb:breakpoint> condition\n\
1344     condition: a string" },
1345
1346   { "breakpoint-stop", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_stop),
1347     "\
1348 Return the breakpoint's stop predicate.\n\
1349 Return #f if there isn't one." },
1350
1351   { "set-breakpoint-stop!", 2, 0, 0,
1352     as_a_scm_t_subr (gdbscm_set_breakpoint_stop_x),
1353     "\
1354 Set the breakpoint's stop predicate.\n\
1355 \n\
1356   Arguments: <gdb:breakpoint> procedure\n\
1357     procedure: A procedure of one argument, the breakpoint.\n\
1358       Its result is true if program execution should stop." },
1359
1360   { "breakpoint-commands", 1, 0, 0,
1361     as_a_scm_t_subr (gdbscm_breakpoint_commands),
1362     "\
1363 Return the breakpoint's commands." },
1364
1365   END_FUNCTIONS
1366 };
1367
1368 void
1369 gdbscm_initialize_breakpoints (void)
1370 {
1371   breakpoint_smob_tag
1372     = gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
1373   scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
1374   scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
1375
1376   gdb::observers::breakpoint_created.attach (bpscm_breakpoint_created,
1377                                              "scm-breakpoint");
1378   gdb::observers::breakpoint_deleted.attach (bpscm_breakpoint_deleted,
1379                                              "scm-breakpoint");
1380
1381   gdbscm_define_integer_constants (breakpoint_integer_constants, 1);
1382   gdbscm_define_functions (breakpoint_functions, 1);
1383
1384   type_keyword = scm_from_latin1_keyword ("type");
1385   wp_class_keyword = scm_from_latin1_keyword ("wp-class");
1386   internal_keyword = scm_from_latin1_keyword ("internal");
1387   temporary_keyword = scm_from_latin1_keyword ("temporary");
1388 }