gdb/guile/scm-breakpoint.c

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