gdb/guile/scm-breakpoint.c

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