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