gdb/guile/scm-breakpoint.c

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