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