gdb/guile/scm-breakpoint.c

   1 /* Scheme interface to breakpoints.
   2
   3    Copyright (C) 2008-2017 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 "observer.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   struct gdb_exception except = exception_none;
 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 = string_to_event_location_basic (&copy,
 428                                                            current_language);
 429
 430   TRY
 431     {
 432       int internal = bp_smob->spec.is_internal;
 433
 434       switch (bp_smob->spec.type)
 435         {
 436         case bp_breakpoint:
 437           {
 438             create_breakpoint (get_current_arch (),
 439                                eloc.get (), NULL, -1, NULL,
 440                                0,
 441                                0, bp_breakpoint,
 442                                0,
 443                                AUTO_BOOLEAN_TRUE,
 444                                &bkpt_breakpoint_ops,
 445                                0, 1, internal, 0);
 446             break;
 447           }
 448         case bp_watchpoint:
 449           {
 450             enum target_hw_bp_type access_type = bp_smob->spec.access_type;
 451
 452             if (access_type == hw_write)
 453               watch_command_wrapper (location, 0, internal);
 454             else if (access_type == hw_access)
 455               awatch_command_wrapper (location, 0, internal);
 456             else if (access_type == hw_read)
 457               rwatch_command_wrapper (location, 0, internal);
 458             else
 459               gdb_assert_not_reached ("invalid access type");
 460             break;
 461           }
 462         default:
 463           gdb_assert_not_reached ("invalid breakpoint type");
 464         }
 465     }
 466   CATCH (ex, RETURN_MASK_ALL)
 467     {
 468       except = ex;
 469     }
 470   END_CATCH
 471
 472   /* Ensure this gets reset, even if there's an error.  */
 473   pending_breakpoint_scm = SCM_BOOL_F;
 474   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 475
 476   return SCM_UNSPECIFIED;
 477 }
 478
 479 /* (delete-breakpoint! <gdb:breakpoint>) -> unspecified
 480    Scheme function which deletes (removes) the underlying GDB breakpoint
 481    from GDB's list of breakpoints.  This triggers the breakpoint_deleted
 482    observer which will call gdbscm_breakpoint_deleted; that function cleans
 483    up the Scheme bits.  */
 484
 485 static SCM
 486 gdbscm_delete_breakpoint_x (SCM self)
 487 {
 488   breakpoint_smob *bp_smob
 489     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 490
 491   TRY
 492     {
 493       delete_breakpoint (bp_smob->bp);
 494     }
 495   CATCH (except, RETURN_MASK_ALL)
 496     {
 497       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 498     }
 499   END_CATCH
 500
 501   return SCM_UNSPECIFIED;
 502 }
 503
 504 /* iterate_over_breakpoints function for gdbscm_breakpoints.  */
 505
 506 static int
 507 bpscm_build_bp_list (struct breakpoint *bp, void *arg)
 508 {
 509   SCM *list = (SCM *) arg;
 510   breakpoint_smob *bp_smob = bp->scm_bp_object;
 511
 512   /* Lazily create wrappers for breakpoints created outside Scheme.  */
 513
 514   if (bp_smob == NULL)
 515     {
 516       if (bpscm_want_scm_wrapper_p (bp, 0))
 517         {
 518           SCM bp_scm;
 519
 520           bp_scm = bpscm_make_breakpoint_smob ();
 521           bpscm_attach_scm_to_breakpoint (bp, bp_scm);
 522           /* Refetch it.  */
 523           bp_smob = bp->scm_bp_object;
 524         }
 525     }
 526
 527   /* Not all breakpoints will have a companion Scheme object.
 528      Only breakpoints that trigger the created_breakpoint observer call,
 529      and satisfy certain conditions (see bpscm_want_scm_wrapper_p),
 530      get a companion object (this includes Scheme-created breakpoints).  */
 531
 532   if (bp_smob != NULL)
 533     *list = scm_cons (bp_smob->containing_scm, *list);
 534
 535   return 0;
 536 }
 537
 538 /* (breakpoints) -> list
 539    Return a list of all breakpoints.  */
 540
 541 static SCM
 542 gdbscm_breakpoints (void)
 543 {
 544   SCM list = SCM_EOL;
 545
 546   /* If iterate_over_breakpoints returns non-NULL it means the iteration
 547      terminated early.
 548      In that case abandon building the list and return #f.  */
 549   if (iterate_over_breakpoints (bpscm_build_bp_list, &list) != NULL)
 550     return SCM_BOOL_F;
 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   TRY
 590     {
 591       if (gdbscm_is_true (newvalue))
 592         enable_breakpoint (bp_smob->bp);
 593       else
 594         disable_breakpoint (bp_smob->bp);
 595     }
 596   CATCH (except, RETURN_MASK_ALL)
 597     {
 598       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 599     }
 600   END_CATCH
 601
 602   return SCM_UNSPECIFIED;
 603 }
 604
 605 /* (breakpoint-silent? <gdb:breakpoint>) -> boolean */
 606
 607 static SCM
 608 gdbscm_breakpoint_silent_p (SCM self)
 609 {
 610   breakpoint_smob *bp_smob
 611     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 612
 613   return scm_from_bool (bp_smob->bp->silent);
 614 }
 615
 616 /* (set-breakpoint-silent?! <gdb:breakpoint> boolean) -> unspecified */
 617
 618 static SCM
 619 gdbscm_set_breakpoint_silent_x (SCM self, SCM newvalue)
 620 {
 621   breakpoint_smob *bp_smob
 622     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 623
 624   SCM_ASSERT_TYPE (gdbscm_is_bool (newvalue), newvalue, SCM_ARG2, FUNC_NAME,
 625                    _("boolean"));
 626
 627   TRY
 628     {
 629       breakpoint_set_silent (bp_smob->bp, gdbscm_is_true (newvalue));
 630     }
 631   CATCH (except, RETURN_MASK_ALL)
 632     {
 633       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 634     }
 635   END_CATCH
 636
 637   return SCM_UNSPECIFIED;
 638 }
 639
 640 /* (breakpoint-ignore-count <gdb:breakpoint>) -> integer */
 641
 642 static SCM
 643 gdbscm_breakpoint_ignore_count (SCM self)
 644 {
 645   breakpoint_smob *bp_smob
 646     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 647
 648   return scm_from_long (bp_smob->bp->ignore_count);
 649 }
 650
 651 /* (set-breakpoint-ignore-count! <gdb:breakpoint> integer)
 652      -> unspecified */
 653
 654 static SCM
 655 gdbscm_set_breakpoint_ignore_count_x (SCM self, SCM newvalue)
 656 {
 657   breakpoint_smob *bp_smob
 658     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 659   long value;
 660
 661   SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
 662                    newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
 663
 664   value = scm_to_long (newvalue);
 665   if (value < 0)
 666     value = 0;
 667
 668   TRY
 669     {
 670       set_ignore_count (bp_smob->number, (int) value, 0);
 671     }
 672   CATCH (except, RETURN_MASK_ALL)
 673     {
 674       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 675     }
 676   END_CATCH
 677
 678   return SCM_UNSPECIFIED;
 679 }
 680
 681 /* (breakpoint-hit-count <gdb:breakpoint>) -> integer */
 682
 683 static SCM
 684 gdbscm_breakpoint_hit_count (SCM self)
 685 {
 686   breakpoint_smob *bp_smob
 687     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 688
 689   return scm_from_long (bp_smob->bp->hit_count);
 690 }
 691
 692 /* (set-breakpoint-hit-count! <gdb:breakpoint> integer) -> unspecified */
 693
 694 static SCM
 695 gdbscm_set_breakpoint_hit_count_x (SCM self, SCM newvalue)
 696 {
 697   breakpoint_smob *bp_smob
 698     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 699   long value;
 700
 701   SCM_ASSERT_TYPE (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX),
 702                    newvalue, SCM_ARG2, FUNC_NAME, _("integer"));
 703
 704   value = scm_to_long (newvalue);
 705   if (value < 0)
 706     value = 0;
 707
 708   if (value != 0)
 709     {
 710       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 711                                  _("hit-count must be zero"));
 712     }
 713
 714   bp_smob->bp->hit_count = 0;
 715
 716   return SCM_UNSPECIFIED;
 717 }
 718
 719 /* (breakpoint-thread <gdb:breakpoint>) -> integer */
 720
 721 static SCM
 722 gdbscm_breakpoint_thread (SCM self)
 723 {
 724   breakpoint_smob *bp_smob
 725     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 726
 727   if (bp_smob->bp->thread == -1)
 728     return SCM_BOOL_F;
 729
 730   return scm_from_long (bp_smob->bp->thread);
 731 }
 732
 733 /* (set-breakpoint-thread! <gdb:breakpoint> integer) -> unspecified */
 734
 735 static SCM
 736 gdbscm_set_breakpoint_thread_x (SCM self, SCM newvalue)
 737 {
 738   breakpoint_smob *bp_smob
 739     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 740   long id;
 741
 742   if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
 743     {
 744       id = scm_to_long (newvalue);
 745       if (!valid_global_thread_id (id))
 746         {
 747           gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 748                                      _("invalid thread id"));
 749         }
 750     }
 751   else if (gdbscm_is_false (newvalue))
 752     id = -1;
 753   else
 754     SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
 755
 756   breakpoint_set_thread (bp_smob->bp, id);
 757
 758   return SCM_UNSPECIFIED;
 759 }
 760
 761 /* (breakpoint-task <gdb:breakpoint>) -> integer */
 762
 763 static SCM
 764 gdbscm_breakpoint_task (SCM self)
 765 {
 766   breakpoint_smob *bp_smob
 767     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 768
 769   if (bp_smob->bp->task == 0)
 770     return SCM_BOOL_F;
 771
 772   return scm_from_long (bp_smob->bp->task);
 773 }
 774
 775 /* (set-breakpoint-task! <gdb:breakpoint> integer) -> unspecified */
 776
 777 static SCM
 778 gdbscm_set_breakpoint_task_x (SCM self, SCM newvalue)
 779 {
 780   breakpoint_smob *bp_smob
 781     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 782   long id;
 783   int valid_id = 0;
 784
 785   if (scm_is_signed_integer (newvalue, LONG_MIN, LONG_MAX))
 786     {
 787       id = scm_to_long (newvalue);
 788
 789       TRY
 790         {
 791           valid_id = valid_task_id (id);
 792         }
 793       CATCH (except, RETURN_MASK_ALL)
 794         {
 795           GDBSCM_HANDLE_GDB_EXCEPTION (except);
 796         }
 797       END_CATCH
 798
 799       if (! valid_id)
 800         {
 801           gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG2, newvalue,
 802                                      _("invalid task id"));
 803         }
 804     }
 805   else if (gdbscm_is_false (newvalue))
 806     id = 0;
 807   else
 808     SCM_ASSERT_TYPE (0, newvalue, SCM_ARG2, FUNC_NAME, _("integer or #f"));
 809
 810   TRY
 811     {
 812       breakpoint_set_task (bp_smob->bp, id);
 813     }
 814   CATCH (except, RETURN_MASK_ALL)
 815     {
 816       GDBSCM_HANDLE_GDB_EXCEPTION (except);
 817     }
 818   END_CATCH
 819
 820   return SCM_UNSPECIFIED;
 821 }
 822
 823 /* (breakpoint-location <gdb:breakpoint>) -> string */
 824
 825 static SCM
 826 gdbscm_breakpoint_location (SCM self)
 827 {
 828   breakpoint_smob *bp_smob
 829     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 830   const char *str;
 831
 832   if (bp_smob->bp->type != bp_breakpoint)
 833     return SCM_BOOL_F;
 834
 835   str = event_location_to_string (bp_smob->bp->location.get ());
 836   if (! str)
 837     str = "";
 838
 839   return gdbscm_scm_from_c_string (str);
 840 }
 841
 842 /* (breakpoint-expression <gdb:breakpoint>) -> string
 843    This is only valid for watchpoints.
 844    Returns #f for non-watchpoints.  */
 845
 846 static SCM
 847 gdbscm_breakpoint_expression (SCM self)
 848 {
 849   breakpoint_smob *bp_smob
 850     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 851   struct watchpoint *wp;
 852
 853   if (!is_watchpoint (bp_smob->bp))
 854     return SCM_BOOL_F;
 855
 856   wp = (struct watchpoint *) bp_smob->bp;
 857
 858   const char *str = wp->exp_string;
 859   if (! str)
 860     str = "";
 861
 862   return gdbscm_scm_from_c_string (str);
 863 }
 864
 865 /* (breakpoint-condition <gdb:breakpoint>) -> string */
 866
 867 static SCM
 868 gdbscm_breakpoint_condition (SCM self)
 869 {
 870   breakpoint_smob *bp_smob
 871     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 872   char *str;
 873
 874   str = bp_smob->bp->cond_string;
 875   if (! str)
 876     return SCM_BOOL_F;
 877
 878   return gdbscm_scm_from_c_string (str);
 879 }
 880
 881 /* (set-breakpoint-condition! <gdb:breakpoint> string|#f)
 882    -> unspecified */
 883
 884 static SCM
 885 gdbscm_set_breakpoint_condition_x (SCM self, SCM newvalue)
 886 {
 887   breakpoint_smob *bp_smob
 888     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 889   char *exp;
 890   struct gdb_exception except = exception_none;
 891
 892   SCM_ASSERT_TYPE (scm_is_string (newvalue) || gdbscm_is_false (newvalue),
 893                    newvalue, SCM_ARG2, FUNC_NAME,
 894                    _("string or #f"));
 895
 896   if (gdbscm_is_false (newvalue))
 897     exp = NULL;
 898   else
 899     exp = gdbscm_scm_to_c_string (newvalue);
 900
 901   TRY
 902     {
 903       set_breakpoint_condition (bp_smob->bp, exp ? exp : "", 0);
 904     }
 905   CATCH (ex, RETURN_MASK_ALL)
 906     {
 907       except = ex;
 908     }
 909   END_CATCH
 910
 911   xfree (exp);
 912   GDBSCM_HANDLE_GDB_EXCEPTION (except);
 913
 914   return SCM_UNSPECIFIED;
 915 }
 916
 917 /* (breakpoint-stop <gdb:breakpoint>) -> procedure or #f */
 918
 919 static SCM
 920 gdbscm_breakpoint_stop (SCM self)
 921 {
 922   breakpoint_smob *bp_smob
 923     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 924
 925   return bp_smob->stop;
 926 }
 927
 928 /* (set-breakpoint-stop! <gdb:breakpoint> procedure|#f)
 929    -> unspecified */
 930
 931 static SCM
 932 gdbscm_set_breakpoint_stop_x (SCM self, SCM newvalue)
 933 {
 934   breakpoint_smob *bp_smob
 935     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 936   const struct extension_language_defn *extlang = NULL;
 937
 938   SCM_ASSERT_TYPE (gdbscm_is_procedure (newvalue)
 939                    || gdbscm_is_false (newvalue),
 940                    newvalue, SCM_ARG2, FUNC_NAME,
 941                    _("procedure or #f"));
 942
 943   if (bp_smob->bp->cond_string != NULL)
 944     extlang = get_ext_lang_defn (EXT_LANG_GDB);
 945   if (extlang == NULL)
 946     extlang = get_breakpoint_cond_ext_lang (bp_smob->bp, EXT_LANG_GUILE);
 947   if (extlang != NULL)
 948     {
 949       char *error_text
 950         = xstrprintf (_("Only one stop condition allowed.  There is"
 951                         " currently a %s stop condition defined for"
 952                         " this breakpoint."),
 953                       ext_lang_capitalized_name (extlang));
 954
 955       scm_dynwind_begin ((scm_t_dynwind_flags) 0);
 956       gdbscm_dynwind_xfree (error_text);
 957       gdbscm_out_of_range_error (FUNC_NAME, SCM_ARG1, self, error_text);
 958       /* The following line, while unnecessary, is present for completeness
 959          sake.  */
 960       scm_dynwind_end ();
 961     }
 962
 963   bp_smob->stop = newvalue;
 964
 965   return SCM_UNSPECIFIED;
 966 }
 967
 968 /* (breakpoint-commands <gdb:breakpoint>) -> string */
 969
 970 static SCM
 971 gdbscm_breakpoint_commands (SCM self)
 972 {
 973   breakpoint_smob *bp_smob
 974     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
 975   struct breakpoint *bp;
 976   long length;
 977   SCM result;
 978
 979   bp = bp_smob->bp;
 980
 981   if (bp->commands == NULL)
 982     return SCM_BOOL_F;
 983
 984   string_file buf;
 985
 986   current_uiout->redirect (&buf);
 987   TRY
 988     {
 989       print_command_lines (current_uiout, breakpoint_commands (bp), 0);
 990     }
 991   CATCH (except, RETURN_MASK_ALL)
 992     {
 993       current_uiout->redirect (NULL);
 994       gdbscm_throw_gdb_exception (except);
 995     }
 996   END_CATCH
 997
 998   current_uiout->redirect (NULL);
 999   result = gdbscm_scm_from_c_string (buf.c_str ());
1000
1001   return result;
1002 }
1003
1004 /* (breakpoint-type <gdb:breakpoint>) -> integer */
1005
1006 static SCM
1007 gdbscm_breakpoint_type (SCM self)
1008 {
1009   breakpoint_smob *bp_smob
1010     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1011
1012   return scm_from_long (bp_smob->bp->type);
1013 }
1014
1015 /* (breakpoint-visible? <gdb:breakpoint>) -> boolean */
1016
1017 static SCM
1018 gdbscm_breakpoint_visible (SCM self)
1019 {
1020   breakpoint_smob *bp_smob
1021     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1022
1023   return scm_from_bool (bp_smob->bp->number >= 0);
1024 }
1025
1026 /* (breakpoint-number <gdb:breakpoint>) -> integer */
1027
1028 static SCM
1029 gdbscm_breakpoint_number (SCM self)
1030 {
1031   breakpoint_smob *bp_smob
1032     = bpscm_get_valid_breakpoint_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
1033
1034   return scm_from_long (bp_smob->number);
1035 }
1036 \f
1037 /* Return TRUE if "stop" has been set for this breakpoint.
1038
1039    This is the extension_language_ops.breakpoint_has_cond "method".  */
1040
1041 int
1042 gdbscm_breakpoint_has_cond (const struct extension_language_defn *extlang,
1043                             struct breakpoint *b)
1044 {
1045   breakpoint_smob *bp_smob = b->scm_bp_object;
1046
1047   if (bp_smob == NULL)
1048     return 0;
1049
1050   return gdbscm_is_procedure (bp_smob->stop);
1051 }
1052
1053 /* Call the "stop" method in the breakpoint class.
1054    This must only be called if gdbscm_breakpoint_has_cond returns true.
1055    If the stop method returns #t, the inferior will be stopped at the
1056    breakpoint.  Otherwise the inferior will be allowed to continue
1057    (assuming other conditions don't indicate "stop").
1058
1059    This is the extension_language_ops.breakpoint_cond_says_stop "method".  */
1060
1061 enum ext_lang_bp_stop
1062 gdbscm_breakpoint_cond_says_stop
1063   (const struct extension_language_defn *extlang, struct breakpoint *b)
1064 {
1065   breakpoint_smob *bp_smob = b->scm_bp_object;
1066   SCM predicate_result;
1067   int stop;
1068
1069   if (bp_smob == NULL)
1070     return EXT_LANG_BP_STOP_UNSET;
1071   if (!gdbscm_is_procedure (bp_smob->stop))
1072     return EXT_LANG_BP_STOP_UNSET;
1073
1074   stop = 1;
1075
1076   predicate_result
1077     = gdbscm_safe_call_1 (bp_smob->stop, bp_smob->containing_scm, NULL);
1078
1079   if (gdbscm_is_exception (predicate_result))
1080     ; /* Exception already printed.  */
1081   /* If the "stop" function returns #f that means
1082      the Scheme breakpoint wants GDB to continue.  */
1083   else if (gdbscm_is_false (predicate_result))
1084     stop = 0;
1085
1086   return stop ? EXT_LANG_BP_STOP_YES : EXT_LANG_BP_STOP_NO;
1087 }
1088 \f
1089 /* Event callback functions.  */
1090
1091 /* Callback that is used when a breakpoint is created.
1092    For breakpoints created by Scheme, i.e., gdbscm_create_breakpoint_x, finish
1093    object creation by connecting the Scheme wrapper to the gdb object.
1094    We ignore breakpoints created from gdb or python here, we create the
1095    Scheme wrapper for those when there's a need to, e.g.,
1096    gdbscm_breakpoints.  */
1097
1098 static void
1099 bpscm_breakpoint_created (struct breakpoint *bp)
1100 {
1101   SCM bp_scm;
1102
1103   if (gdbscm_is_false (pending_breakpoint_scm))
1104     return;
1105
1106   /* Verify our caller error checked the user's request.  */
1107   gdb_assert (bpscm_want_scm_wrapper_p (bp, 1));
1108
1109   bp_scm = pending_breakpoint_scm;
1110   pending_breakpoint_scm = SCM_BOOL_F;
1111
1112   bpscm_attach_scm_to_breakpoint (bp, bp_scm);
1113 }
1114
1115 /* Callback that is used when a breakpoint is deleted.  This will
1116    invalidate the corresponding Scheme object.  */
1117
1118 static void
1119 bpscm_breakpoint_deleted (struct breakpoint *b)
1120 {
1121   int num = b->number;
1122   struct breakpoint *bp;
1123
1124   /* TODO: Why the lookup?  We have B.  */
1125
1126   bp = get_breakpoint (num);
1127   if (bp)
1128     {
1129       breakpoint_smob *bp_smob = bp->scm_bp_object;
1130
1131       if (bp_smob)
1132         {
1133           bp_smob->bp = NULL;
1134           bp_smob->number = -1;
1135           bp_smob->stop = SCM_BOOL_F;
1136           scm_gc_unprotect_object (bp_smob->containing_scm);
1137         }
1138     }
1139 }
1140 \f
1141 /* Initialize the Scheme breakpoint code.  */
1142
1143 static const scheme_integer_constant breakpoint_integer_constants[] =
1144 {
1145   { "BP_NONE", bp_none },
1146   { "BP_BREAKPOINT", bp_breakpoint },
1147   { "BP_WATCHPOINT", bp_watchpoint },
1148   { "BP_HARDWARE_WATCHPOINT", bp_hardware_watchpoint },
1149   { "BP_READ_WATCHPOINT", bp_read_watchpoint },
1150   { "BP_ACCESS_WATCHPOINT", bp_access_watchpoint },
1151
1152   { "WP_READ", hw_read },
1153   { "WP_WRITE", hw_write },
1154   { "WP_ACCESS", hw_access },
1155
1156   END_INTEGER_CONSTANTS
1157 };
1158
1159 static const scheme_function breakpoint_functions[] =
1160 {
1161   { "make-breakpoint", 1, 0, 1, as_a_scm_t_subr (gdbscm_make_breakpoint),
1162     "\
1163 Create a GDB breakpoint object.\n\
1164 \n\
1165   Arguments:\n\
1166     location [#:type <type>] [#:wp-class <wp-class>] [#:internal <bool>]\n\
1167   Returns:\n\
1168     <gdb:breakpoint object" },
1169
1170   { "register-breakpoint!", 1, 0, 0,
1171     as_a_scm_t_subr (gdbscm_register_breakpoint_x),
1172     "\
1173 Register a <gdb:breakpoint> object with GDB." },
1174
1175   { "delete-breakpoint!", 1, 0, 0, as_a_scm_t_subr (gdbscm_delete_breakpoint_x),
1176     "\
1177 Delete the breakpoint from GDB." },
1178
1179   { "breakpoints", 0, 0, 0, as_a_scm_t_subr (gdbscm_breakpoints),
1180     "\
1181 Return a list of all GDB breakpoints.\n\
1182 \n\
1183   Arguments: none" },
1184
1185   { "breakpoint?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_p),
1186     "\
1187 Return #t if the object is a <gdb:breakpoint> object." },
1188
1189   { "breakpoint-valid?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_valid_p),
1190     "\
1191 Return #t if the breakpoint has not been deleted from GDB." },
1192
1193   { "breakpoint-number", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_number),
1194     "\
1195 Return the breakpoint's number." },
1196
1197   { "breakpoint-type", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_type),
1198     "\
1199 Return the type of the breakpoint." },
1200
1201   { "breakpoint-visible?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_visible),
1202     "\
1203 Return #t if the breakpoint is visible to the user." },
1204
1205   { "breakpoint-location", 1, 0, 0,
1206     as_a_scm_t_subr (gdbscm_breakpoint_location),
1207     "\
1208 Return the location of the breakpoint as specified by the user." },
1209
1210   { "breakpoint-expression", 1, 0, 0,
1211     as_a_scm_t_subr (gdbscm_breakpoint_expression),
1212     "\
1213 Return the expression of the breakpoint as specified by the user.\n\
1214 Valid for watchpoints only, returns #f for non-watchpoints." },
1215
1216   { "breakpoint-enabled?", 1, 0, 0,
1217     as_a_scm_t_subr (gdbscm_breakpoint_enabled_p),
1218     "\
1219 Return #t if the breakpoint is enabled." },
1220
1221   { "set-breakpoint-enabled!", 2, 0, 0,
1222     as_a_scm_t_subr (gdbscm_set_breakpoint_enabled_x),
1223     "\
1224 Set the breakpoint's enabled state.\n\
1225 \n\
1226   Arguments: <gdb:breakpoint> boolean" },
1227
1228   { "breakpoint-silent?", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_silent_p),
1229     "\
1230 Return #t if the breakpoint is silent." },
1231
1232   { "set-breakpoint-silent!", 2, 0, 0,
1233     as_a_scm_t_subr (gdbscm_set_breakpoint_silent_x),
1234     "\
1235 Set the breakpoint's silent state.\n\
1236 \n\
1237   Arguments: <gdb:breakpoint> boolean" },
1238
1239   { "breakpoint-ignore-count", 1, 0, 0,
1240     as_a_scm_t_subr (gdbscm_breakpoint_ignore_count),
1241     "\
1242 Return the breakpoint's \"ignore\" count." },
1243
1244   { "set-breakpoint-ignore-count!", 2, 0, 0,
1245     as_a_scm_t_subr (gdbscm_set_breakpoint_ignore_count_x),
1246     "\
1247 Set the breakpoint's \"ignore\" count.\n\
1248 \n\
1249   Arguments: <gdb:breakpoint> count" },
1250
1251   { "breakpoint-hit-count", 1, 0, 0,
1252     as_a_scm_t_subr (gdbscm_breakpoint_hit_count),
1253     "\
1254 Return the breakpoint's \"hit\" count." },
1255
1256   { "set-breakpoint-hit-count!", 2, 0, 0,
1257     as_a_scm_t_subr (gdbscm_set_breakpoint_hit_count_x),
1258     "\
1259 Set the breakpoint's \"hit\" count.  The value must be zero.\n\
1260 \n\
1261   Arguments: <gdb:breakpoint> 0" },
1262
1263   { "breakpoint-thread", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_thread),
1264     "\
1265 Return the breakpoint's global thread id or #f if there isn't one." },
1266
1267   { "set-breakpoint-thread!", 2, 0, 0,
1268     as_a_scm_t_subr (gdbscm_set_breakpoint_thread_x),
1269     "\
1270 Set the global thread id for this breakpoint.\n\
1271 \n\
1272   Arguments: <gdb:breakpoint> global-thread-id" },
1273
1274   { "breakpoint-task", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_task),
1275     "\
1276 Return the breakpoint's Ada task-id or #f if there isn't one." },
1277
1278   { "set-breakpoint-task!", 2, 0, 0,
1279     as_a_scm_t_subr (gdbscm_set_breakpoint_task_x),
1280     "\
1281 Set the breakpoint's Ada task-id.\n\
1282 \n\
1283   Arguments: <gdb:breakpoint> task-id" },
1284
1285   { "breakpoint-condition", 1, 0, 0,
1286     as_a_scm_t_subr (gdbscm_breakpoint_condition),
1287     "\
1288 Return the breakpoint's condition as specified by the user.\n\
1289 Return #f if there isn't one." },
1290
1291   { "set-breakpoint-condition!", 2, 0, 0,
1292     as_a_scm_t_subr (gdbscm_set_breakpoint_condition_x),
1293     "\
1294 Set the breakpoint's condition.\n\
1295 \n\
1296   Arguments: <gdb:breakpoint> condition\n\
1297     condition: a string" },
1298
1299   { "breakpoint-stop", 1, 0, 0, as_a_scm_t_subr (gdbscm_breakpoint_stop),
1300     "\
1301 Return the breakpoint's stop predicate.\n\
1302 Return #f if there isn't one." },
1303
1304   { "set-breakpoint-stop!", 2, 0, 0,
1305     as_a_scm_t_subr (gdbscm_set_breakpoint_stop_x),
1306     "\
1307 Set the breakpoint's stop predicate.\n\
1308 \n\
1309   Arguments: <gdb:breakpoint> procedure\n\
1310     procedure: A procedure of one argument, the breakpoint.\n\
1311       Its result is true if program execution should stop." },
1312
1313   { "breakpoint-commands", 1, 0, 0,
1314     as_a_scm_t_subr (gdbscm_breakpoint_commands),
1315     "\
1316 Return the breakpoint's commands." },
1317
1318   END_FUNCTIONS
1319 };
1320
1321 void
1322 gdbscm_initialize_breakpoints (void)
1323 {
1324   breakpoint_smob_tag
1325     = gdbscm_make_smob_type (breakpoint_smob_name, sizeof (breakpoint_smob));
1326   scm_set_smob_free (breakpoint_smob_tag, bpscm_free_breakpoint_smob);
1327   scm_set_smob_print (breakpoint_smob_tag, bpscm_print_breakpoint_smob);
1328
1329   observer_attach_breakpoint_created (bpscm_breakpoint_created);
1330   observer_attach_breakpoint_deleted (bpscm_breakpoint_deleted);
1331
1332   gdbscm_define_integer_constants (breakpoint_integer_constants, 1);
1333   gdbscm_define_functions (breakpoint_functions, 1);
1334
1335   type_keyword = scm_from_latin1_keyword ("type");
1336   wp_class_keyword = scm_from_latin1_keyword ("wp-class");
1337   internal_keyword = scm_from_latin1_keyword ("internal");
1338 }