gdb/gdbtk/generic/gdbtk-bp.c

   1 /* Tcl/Tk command definitions for Insight - Breakpoints.
   2    Copyright (C) 2001, 2002, 2008 Free Software Foundation, Inc.
   3
   4    This file is part of GDB.
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 2 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program; if not, write to the Free Software
  18    Foundation, Inc., 51 Franklin Street, Fifth Floor,
  19    Boston, MA 02110-1301, USA.  */
  20
  21 #include "defs.h"
  22 #include "symtab.h"
  23 #include "symfile.h"
  24 #include "source.h"
  25 #include "linespec.h"
  26 #include "breakpoint.h"
  27 #include "tracepoint.h"
  28 #include "gdb_string.h"
  29 #include <tcl.h>
  30 #include "gdbtk.h"
  31 #include "gdbtk-cmds.h"
  32 #include "observer.h"
  33
  34 /* From breakpoint.c */
  35 extern struct breakpoint *breakpoint_chain;
  36
  37 /* From gdbtk-hooks.c */
  38 extern void report_error (void);
  39
  40 /* These two lookup tables are used to translate the type & disposition fields
  41    of the breakpoint structure (respectively) into something gdbtk understands.
  42    They are also used in gdbtk-hooks.c */
  43
  44 char *bptypes[] =
  45   {"none", "breakpoint", "hw breakpoint", "until",
  46    "finish", "watchpoint", "hw watchpoint",
  47    "read watchpoint", "acc watchpoint",
  48    "longjmp", "longjmp resume", "step resume",
  49    "sigtramp", "watchpoint scope",
  50    "call dummy", "shlib events", "catch load",
  51    "catch unload", "catch fork", "catch vfork",
  52    "catch exec", "catch catch", "catch throw"
  53   };
  54 char *bpdisp[] =
  55   {"delete", "delstop", "disable", "donttouch"};
  56
  57 /* Is this breakpoint interesting to a user interface? */
  58 #define BREAKPOINT_IS_INTERESTING(bp) \
  59 ((bp)->type == bp_breakpoint             \
  60  || (bp)->type == bp_hardware_breakpoint \
  61  || (bp)->type == bp_watchpoint          \
  62  || (bp)->type == bp_hardware_watchpoint \
  63  || (bp)->type == bp_read_watchpoint     \
  64  || (bp)->type == bp_access_watchpoint)
  65
  66 /* Is this breakpoint a watchpoint?  */
  67 #define BREAKPOINT_IS_WATCHPOINT(bp)                                          \
  68 ((bp)->type == bp_watchpoint                                                  \
  69  || (bp)->type == bp_hardware_watchpoint                                      \
  70  || (bp)->type == bp_read_watchpoint                                          \
  71  || (bp)->type == bp_access_watchpoint)
  72
  73 /*
  74  * These are routines we need from breakpoint.c.
  75  * at some point make these static in breakpoint.c and move GUI code there
  76  */
  77
  78 extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal,
  79                                               enum bptype bp_type);
  80 extern void set_breakpoint_count (int);
  81 extern int breakpoint_count;
  82
  83 /* Breakpoint/Tracepoint lists. Unfortunately, gdb forces us to
  84    keep a list of breakpoints, too. Why couldn't it be done like
  85    treacepoints? */
  86 #define DEFAULT_LIST_SIZE 32
  87 static struct breakpoint **breakpoint_list;
  88 static int breakpoint_list_size = DEFAULT_LIST_SIZE;
  89
  90 /*
  91  * Forward declarations
  92  */
  93
  94 /* Breakpoint-related functions */
  95 static int gdb_find_bp_at_addr (ClientData, Tcl_Interp *, int,
  96                                 Tcl_Obj * CONST objv[]);
  97 static int gdb_find_bp_at_line (ClientData, Tcl_Interp *, int,
  98                                 Tcl_Obj * CONST objv[]);
  99 static int gdb_get_breakpoint_info (ClientData, Tcl_Interp *, int,
 100                                     Tcl_Obj * CONST[]);
 101 static int gdb_get_breakpoint_list (ClientData, Tcl_Interp *, int,
 102                                     Tcl_Obj * CONST[]);
 103 static int gdb_set_bp (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST objv[]);
 104 static int gdb_set_bp_addr (ClientData, Tcl_Interp *, int,
 105                             Tcl_Obj * CONST objv[]);
 106
 107 /* Tracepoint-related functions */
 108 static int gdb_actions_command (ClientData, Tcl_Interp *, int,
 109                                 Tcl_Obj * CONST objv[]);
 110 static int gdb_get_trace_frame_num (ClientData, Tcl_Interp *, int,
 111                                     Tcl_Obj * CONST objv[]);
 112 static int gdb_get_tracepoint_info (ClientData, Tcl_Interp *, int,
 113                                     Tcl_Obj * CONST objv[]);
 114 static int gdb_get_tracepoint_list (ClientData, Tcl_Interp *, int,
 115                                     Tcl_Obj * CONST objv[]);
 116 static int gdb_trace_status (ClientData, Tcl_Interp *, int,
 117                              Tcl_Obj * CONST[]);
 118 static int gdb_tracepoint_exists_command (ClientData, Tcl_Interp *,
 119                                           int, Tcl_Obj * CONST objv[]);
 120 static Tcl_Obj *get_breakpoint_commands (struct command_line *cmd);
 121
 122 static int tracepoint_exists (char *args);
 123
 124 /* Breakpoint/tracepoint events and related functions */
 125
 126 void gdbtk_create_breakpoint (int);
 127 void gdbtk_delete_breakpoint (int);
 128 void gdbtk_modify_breakpoint (int);
 129 void gdbtk_create_tracepoint (int);
 130 void gdbtk_delete_tracepoint (int);
 131 void gdbtk_modify_tracepoint (int);
 132 static void breakpoint_notify (int, const char *);
 133 static void tracepoint_notify (int, const char *);
 134
 135 int
 136 Gdbtk_Breakpoint_Init (Tcl_Interp *interp)
 137 {
 138   /* Breakpoint commands */
 139   Tcl_CreateObjCommand (interp, "gdb_find_bp_at_addr", gdbtk_call_wrapper,
 140                         gdb_find_bp_at_addr, NULL);
 141   Tcl_CreateObjCommand (interp, "gdb_find_bp_at_line", gdbtk_call_wrapper,
 142                         gdb_find_bp_at_line, NULL);
 143   Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_info", gdbtk_call_wrapper,
 144                         gdb_get_breakpoint_info, NULL);
 145   Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_list", gdbtk_call_wrapper,
 146                         gdb_get_breakpoint_list, NULL);
 147   Tcl_CreateObjCommand (interp, "gdb_set_bp", gdbtk_call_wrapper, gdb_set_bp, NULL);
 148   Tcl_CreateObjCommand (interp, "gdb_set_bp_addr", gdbtk_call_wrapper,
 149                         gdb_set_bp_addr, NULL);
 150
 151   /* Tracepoint commands */
 152   Tcl_CreateObjCommand (interp, "gdb_actions",
 153                         gdbtk_call_wrapper, gdb_actions_command, NULL);
 154   Tcl_CreateObjCommand (interp, "gdb_get_trace_frame_num",
 155                         gdbtk_call_wrapper, gdb_get_trace_frame_num, NULL);
 156   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
 157                         gdbtk_call_wrapper, gdb_get_tracepoint_info, NULL);
 158   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
 159                         gdbtk_call_wrapper, gdb_get_tracepoint_list, NULL);
 160   Tcl_CreateObjCommand (interp, "gdb_is_tracing",
 161                         gdbtk_call_wrapper, gdb_trace_status,   NULL);
 162   Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
 163                         gdbtk_call_wrapper, gdb_tracepoint_exists_command, NULL);
 164
 165   /* Initialize our tables of BPs. */
 166   breakpoint_list = (struct breakpoint **) xmalloc (breakpoint_list_size * sizeof (struct breakpoint *));
 167   memset (breakpoint_list, 0, breakpoint_list_size * sizeof (struct breakpoint *));
 168
 169   return TCL_OK;
 170 }
 171 \f
 172 /*
 173  *  This section contains commands for manipulation of breakpoints.
 174  */
 175
 176 /* set a breakpoint by source file and line number
 177    flags are as follows:
 178    least significant 2 bits are disposition, rest is
 179    type (normally 0).
 180
 181    enum bptype {
 182    bp_breakpoint,                Normal breakpoint
 183    bp_hardware_breakpoint,      Hardware assisted breakpoint
 184    }
 185
 186    Disposition of breakpoint.  Ie: what to do after hitting it.
 187    enum bpdisp {
 188    del,                         Delete it
 189    del_at_next_stop,            Delete at next stop, whether hit or not
 190    disable,                     Disable it
 191    donttouch                    Leave it alone
 192    };
 193 */
 194
 195
 196 /* This implements the tcl command "gdb_find_bp_at_addr"
 197
 198 * Tcl Arguments:
 199 *    addr:     CORE_ADDR
 200 * Tcl Result:
 201 *    It returns a list of breakpoint numbers
 202 */
 203 static int
 204 gdb_find_bp_at_addr (ClientData clientData, Tcl_Interp *interp,
 205                      int objc, Tcl_Obj *CONST objv[])
 206 {
 207   int i;
 208   CORE_ADDR addr;
 209   Tcl_WideInt waddr;
 210
 211   if (objc != 2)
 212     {
 213       Tcl_WrongNumArgs (interp, 1, objv, "address");
 214       return TCL_ERROR;
 215     }
 216
 217   if (Tcl_GetWideIntFromObj (interp, objv[1], &waddr) != TCL_OK)
 218     return TCL_ERROR;
 219   addr = waddr;
 220
 221   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
 222   for (i = 0; i < breakpoint_list_size; i++)
 223     {
 224       if (breakpoint_list[i] != NULL && breakpoint_list[i]->loc != NULL
 225           && breakpoint_list[i]->loc->address == addr)
 226         Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 227                                   Tcl_NewIntObj (i));
 228     }
 229
 230   return TCL_OK;
 231 }
 232
 233 /* This implements the tcl command "gdb_find_bp_at_line"
 234
 235 * Tcl Arguments:
 236 *    filename: the file in which to find the breakpoint
 237 *    line:     the line number for the breakpoint
 238 * Tcl Result:
 239 *    It returns a list of breakpoint numbers
 240 */
 241 static int
 242 gdb_find_bp_at_line (ClientData clientData, Tcl_Interp *interp,
 243                      int objc, Tcl_Obj *CONST objv[])
 244
 245 {
 246   struct symtab *s;
 247   int i, line;
 248
 249   if (objc != 3)
 250     {
 251       Tcl_WrongNumArgs (interp, 1, objv, "filename line");
 252       return TCL_ERROR;
 253     }
 254
 255   s = lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
 256   if (s == NULL)
 257     return TCL_ERROR;
 258
 259   if (Tcl_GetIntFromObj (interp, objv[2], &line) == TCL_ERROR)
 260     {
 261       result_ptr->flags = GDBTK_IN_TCL_RESULT;
 262       return TCL_ERROR;
 263     }
 264
 265   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
 266   for (i = 0; i < breakpoint_list_size; i++)
 267     if (breakpoint_list[i] != NULL
 268         && breakpoint_list[i]->line_number == line
 269         && !strcmp (breakpoint_list[i]->source_file, s->filename))
 270       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 271                                 Tcl_NewIntObj (i));
 272
 273   return TCL_OK;
 274 }
 275
 276 /* This implements the tcl command gdb_get_breakpoint_info
 277  *
 278  * Tcl Arguments:
 279  *   breakpoint_number
 280  * Tcl Result:
 281  *   A list with {file, function, line_number, address, type, enabled?,
 282  *                disposition, ignore_count, {list_of_commands},
 283  *                condition, thread, hit_count user_specification}
 284  */
 285 static int
 286 gdb_get_breakpoint_info (ClientData clientData, Tcl_Interp *interp, int objc,
 287                          Tcl_Obj *CONST objv[])
 288 {
 289   struct symtab_and_line sal;
 290   int bpnum;
 291   struct breakpoint *b;
 292   char *funcname, *filename;
 293   int isPending = 0;
 294
 295   Tcl_Obj *new_obj;
 296
 297   if (objc != 2)
 298     {
 299       Tcl_WrongNumArgs (interp, 1, objv, "breakpoint");
 300       return TCL_ERROR;
 301     }
 302
 303   if (Tcl_GetIntFromObj (NULL, objv[1], &bpnum) != TCL_OK)
 304     {
 305       result_ptr->flags = GDBTK_IN_TCL_RESULT;
 306       return TCL_ERROR;
 307     }
 308
 309   b = (bpnum <= breakpoint_list_size ? breakpoint_list[bpnum] : NULL);
 310   if (!b || b->type != bp_breakpoint)
 311     {
 312       gdbtk_set_result (interp, "Breakpoint #%d does not exist.", bpnum);
 313       return TCL_ERROR;
 314     }
 315
 316   isPending = (b->loc == NULL);
 317   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
 318   /* Pending breakpoints will display "<PENDING>" as the file name and the
 319      user expression into the Function field of the breakpoint view.
 320     "0" and "0" in the line number and address field.  */
 321   if (isPending)
 322     {
 323       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 324                                 Tcl_NewStringObj ("<PENDING>", -1));
 325       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 326                                 Tcl_NewStringObj (b->addr_string, -1));
 327       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 328                                 Tcl_NewIntObj (0));
 329       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 330                                 Tcl_NewIntObj (0));
 331     }
 332   else
 333     {
 334       sal = find_pc_line (b->loc->address, 0);
 335
 336       filename = symtab_to_filename (sal.symtab);
 337       if (filename == NULL)
 338         filename = "";
 339       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 340                                 Tcl_NewStringObj (filename, -1));
 341       funcname = pc_function_name (b->loc->address);
 342       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 343                                 Tcl_NewStringObj (funcname, -1));
 344       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 345                                 Tcl_NewIntObj (b->line_number));
 346       Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 347                                 Tcl_NewStringObj (core_addr_to_string
 348                                (b->loc->address), -1));
 349   }
 350
 351   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 352                             Tcl_NewStringObj (bptypes[b->type], -1));
 353   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 354                             Tcl_NewBooleanObj (b->enable_state == bp_enabled));
 355   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 356                             Tcl_NewStringObj (bpdisp[b->disposition], -1));
 357   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 358                             Tcl_NewIntObj (b->ignore_count));
 359
 360   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 361                             get_breakpoint_commands (b->commands));
 362
 363   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 364                             Tcl_NewStringObj (b->cond_string, -1));
 365
 366   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 367                             Tcl_NewIntObj (b->thread));
 368   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 369                             Tcl_NewIntObj (b->hit_count));
 370
 371   Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 372                             Tcl_NewStringObj (BREAKPOINT_IS_WATCHPOINT (b)
 373                                               ? b->exp_string
 374                                               : b->addr_string, -1));
 375
 376   return TCL_OK;
 377 }
 378
 379 /* Helper function for gdb_get_breakpoint_info, this function is
 380    responsible for figuring out what to type at the "commands" command
 381    in gdb's cli in order to get at the same command list passed here. */
 382
 383 static Tcl_Obj *
 384 get_breakpoint_commands (struct command_line *cmd)
 385 {
 386   Tcl_Obj *obj, *tmp;
 387
 388   obj = Tcl_NewObj ();
 389   while (cmd != NULL)
 390     {
 391       switch (cmd->control_type)
 392         {
 393         case simple_control:
 394           /* A simple command. Just append it. */
 395           Tcl_ListObjAppendElement (NULL, obj,
 396                                     Tcl_NewStringObj (cmd->line, -1));
 397           break;
 398
 399         case break_control:
 400           /* A loop_break */
 401           Tcl_ListObjAppendElement (NULL, obj,
 402                                     Tcl_NewStringObj ("loop_break", -1));
 403           break;
 404
 405         case continue_control:
 406           /* A loop_continue */
 407           Tcl_ListObjAppendElement (NULL, obj,
 408                                     Tcl_NewStringObj ("loop_continue", -1));
 409           break;
 410
 411         case while_control:
 412           /* A while loop. Must append "end" to the end of it. */
 413           tmp = Tcl_NewStringObj ("while ", -1);
 414           Tcl_AppendToObj (tmp, cmd->line, -1);
 415           Tcl_ListObjAppendElement (NULL, obj, tmp);
 416           Tcl_ListObjAppendList (NULL, obj,
 417                                  get_breakpoint_commands (*cmd->body_list));
 418           Tcl_ListObjAppendElement (NULL, obj,
 419                                     Tcl_NewStringObj ("end", -1));
 420           break;
 421
 422         case if_control:
 423           /* An if statement. cmd->body_list[0] is the true part,
 424              cmd->body_list[1] contains the "else" (false) part. */
 425           tmp = Tcl_NewStringObj ("if ", -1);
 426           Tcl_AppendToObj (tmp, cmd->line, -1);
 427           Tcl_ListObjAppendElement (NULL, obj, tmp);
 428           Tcl_ListObjAppendList (NULL, obj,
 429                                  get_breakpoint_commands (cmd->body_list[0]));
 430           if (cmd->body_count == 2)
 431             {
 432               Tcl_ListObjAppendElement (NULL, obj,
 433                                         Tcl_NewStringObj ("else", -1));
 434               Tcl_ListObjAppendList (NULL, obj,
 435                                      get_breakpoint_commands(cmd->body_list[1]));
 436             }
 437           Tcl_ListObjAppendElement (NULL, obj,
 438                                     Tcl_NewStringObj ("end", -1));
 439           break;
 440
 441         case invalid_control:
 442           /* Something invalid. Just skip it. */
 443           break;
 444         }
 445
 446       cmd = cmd->next;
 447     }
 448
 449   return obj;
 450 }
 451
 452 /* This implements the tcl command gdb_get_breakpoint_list
 453  * It builds up a list of the current breakpoints.
 454  *
 455  * Tcl Arguments:
 456  *    None.
 457  * Tcl Result:
 458  *    A list of breakpoint numbers.
 459  */
 460 static int
 461 gdb_get_breakpoint_list (ClientData clientData, Tcl_Interp *interp,
 462                          int objc, Tcl_Obj *CONST objv[])
 463 {
 464   int i;
 465   Tcl_Obj *new_obj;
 466
 467   if (objc != 1)
 468     {
 469       Tcl_WrongNumArgs (interp, 1, objv, NULL);
 470       return TCL_ERROR;
 471     }
 472
 473   for (i = 0; i < breakpoint_list_size; i++)
 474     {
 475       if (breakpoint_list[i] != NULL
 476           && breakpoint_list[i]->type == bp_breakpoint)
 477         {
 478           new_obj = Tcl_NewIntObj (i);
 479           Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
 480         }
 481     }
 482
 483   return TCL_OK;
 484 }
 485
 486 /* This implements the tcl command "gdb_set_bp"
 487  * It sets breakpoints, and notifies the GUI.
 488  *
 489  * Tcl Arguments:
 490  *    filename: the file in which to set the breakpoint
 491  *    line:     the line number for the breakpoint
 492  *    type:     the type of the breakpoint
 493  *    thread:   optional thread number
 494  * Tcl Result:
 495  *    The return value of the call to gdbtk_tcl_breakpoint.
 496  */
 497 static int
 498 gdb_set_bp (ClientData clientData, Tcl_Interp *interp,
 499             int objc, Tcl_Obj *CONST objv[])
 500 {
 501   struct symtab_and_line sal;
 502   int line, thread = -1;
 503   struct breakpoint *b;
 504   char *buf, *typestr;
 505   enum bpdisp disp;
 506
 507   if (objc != 4 && objc != 5)
 508     {
 509       Tcl_WrongNumArgs (interp, 1, objv, "filename line type ?thread?");
 510       return TCL_ERROR;
 511     }
 512
 513   sal.symtab = lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
 514   if (sal.symtab == NULL)
 515     return TCL_ERROR;
 516
 517   if (Tcl_GetIntFromObj (interp, objv[2], &line) == TCL_ERROR)
 518     {
 519       result_ptr->flags = GDBTK_IN_TCL_RESULT;
 520       return TCL_ERROR;
 521     }
 522
 523   typestr = Tcl_GetStringFromObj (objv[3], NULL);
 524   if (strncmp (typestr, "temp", 4) == 0)
 525     disp = disp_del;
 526   else if (strncmp (typestr, "normal", 6) == 0)
 527     disp = disp_donttouch;
 528   else
 529     {
 530       gdbtk_set_result (interp, "type must be \"temp\" or \"normal\"");
 531       return TCL_ERROR;
 532     }
 533
 534   if (objc == 5)
 535     {
 536       if (Tcl_GetIntFromObj (interp, objv[4], &thread) == TCL_ERROR)
 537         {
 538           result_ptr->flags = GDBTK_IN_TCL_RESULT;
 539           return TCL_ERROR;
 540         }
 541     }
 542
 543   sal.line = line;
 544   if (!find_line_pc (sal.symtab, sal.line, &sal.pc))
 545     return TCL_ERROR;
 546
 547   sal.section = find_pc_overlay (sal.pc);
 548   b = set_raw_breakpoint (sal, bp_breakpoint);
 549   set_breakpoint_count (breakpoint_count + 1);
 550   b->number = breakpoint_count;
 551   b->disposition = disp;
 552   b->thread = thread;
 553
 554   /* FIXME: this won't work for duplicate basenames! */
 555   buf = xstrprintf ("%s:%d", lbasename (Tcl_GetStringFromObj (objv[1], NULL)),
 556              line);
 557   b->addr_string = xstrdup (buf);
 558   free(buf);
 559
 560   /* now send notification command back to GUI */
 561   observer_notify_breakpoint_created (b->number);
 562   return TCL_OK;
 563 }
 564
 565 /* This implements the tcl command "gdb_set_bp_addr"
 566  * It sets breakpoints, and notifies the GUI.
 567  *
 568  * Tcl Arguments:
 569  *    addr:     the CORE_ADDR at which to set the breakpoint
 570  *    type:     the type of the breakpoint
 571  *    thread:   optional thread number
 572  * Tcl Result:
 573  *    The return value of the call to gdbtk_tcl_breakpoint.
 574  */
 575 static int
 576 gdb_set_bp_addr (ClientData clientData, Tcl_Interp *interp, int objc,
 577                  Tcl_Obj *CONST objv[])
 578
 579 {
 580   struct symtab_and_line sal;
 581   int thread = -1;
 582   CORE_ADDR addr;
 583   Tcl_WideInt waddr;
 584   struct breakpoint *b;
 585   char *saddr, *typestr;
 586   enum bpdisp disp;
 587
 588   if (objc != 3 && objc != 4)
 589     {
 590       Tcl_WrongNumArgs (interp, 1, objv, "address type ?thread?");
 591       return TCL_ERROR;
 592     }
 593
 594   if (Tcl_GetWideIntFromObj (interp, objv[1], &waddr) != TCL_OK)
 595     return TCL_ERROR;
 596   addr = waddr;
 597   saddr = Tcl_GetStringFromObj (objv[1], NULL);
 598
 599   typestr = Tcl_GetStringFromObj (objv[2], NULL);
 600   if (strncmp (typestr, "temp", 4) == 0)
 601     disp = disp_del;
 602   else if (strncmp (typestr, "normal", 6) == 0)
 603     disp = disp_donttouch;
 604   else
 605     {
 606       gdbtk_set_result (interp, "type must be \"temp\" or \"normal\"");
 607       return TCL_ERROR;
 608     }
 609
 610   if (objc == 4)
 611     {
 612       if (Tcl_GetIntFromObj (interp, objv[3], &thread) == TCL_ERROR)
 613         {
 614           result_ptr->flags = GDBTK_IN_TCL_RESULT;
 615           return TCL_ERROR;
 616         }
 617     }
 618
 619   sal = find_pc_line (addr, 0);
 620   sal.pc = addr;
 621   b = set_raw_breakpoint (sal, bp_breakpoint);
 622   set_breakpoint_count (breakpoint_count + 1);
 623   b->number = breakpoint_count;
 624   b->disposition = disp;
 625   b->thread = thread;
 626   b->addr_string = xstrdup (saddr);
 627
 628   /* now send notification command back to GUI */
 629   observer_notify_breakpoint_created (b->number);
 630   return TCL_OK;
 631 }
 632 \f
 633 /*
 634  * This section contains functions that deal with breakpoint
 635  * events from gdb.
 636  */
 637
 638 /* The next three functions use breakpoint_notify to allow the GUI
 639  * to handle creating, deleting and modifying breakpoints.  These three
 640  * functions are put into the appropriate gdb hooks in gdbtk_init.
 641  */
 642
 643 void
 644 gdbtk_create_breakpoint (int num)
 645 {
 646   struct breakpoint *b;
 647   for (b = breakpoint_chain; b != NULL; b = b->next)
 648     {
 649       if (b->number == num)
 650         break;
 651     }
 652
 653   if (b == NULL || !BREAKPOINT_IS_INTERESTING (b))
 654     return;
 655
 656   /* Check if there is room to store it */
 657   if (num >= breakpoint_list_size)
 658     {
 659       int oldsize = breakpoint_list_size;
 660       while (num >= breakpoint_list_size)
 661         breakpoint_list_size += DEFAULT_LIST_SIZE;
 662       breakpoint_list = (struct breakpoint **) xrealloc (breakpoint_list, breakpoint_list_size * sizeof (struct breakpoint *));
 663       memset (&(breakpoint_list[oldsize]), 0, (breakpoint_list_size - oldsize) * sizeof (struct breakpoint *));
 664     }
 665
 666   breakpoint_list[num] = b;
 667   breakpoint_notify (num, "create");
 668 }
 669
 670 void
 671 gdbtk_delete_breakpoint (int num)
 672 {
 673   if (num >= 0
 674       && num <= breakpoint_list_size
 675       && breakpoint_list[num] != NULL)
 676     {
 677       breakpoint_notify (num, "delete");
 678       breakpoint_list[num] = NULL;
 679     }
 680 }
 681
 682 void
 683 gdbtk_modify_breakpoint (int num)
 684 {
 685   if (num >= 0)
 686     breakpoint_notify (num, "modify");
 687 }
 688
 689 /* This is the generic function for handling changes in
 690  * a breakpoint.  It routes the information to the Tcl
 691  * command "gdbtk_tcl_breakpoint" in the form:
 692  *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
 693  * On error, the error string is written to gdb_stdout.
 694  */
 695 static void
 696 breakpoint_notify (int num, const char *action)
 697 {
 698   char *buf;
 699
 700   if (num > breakpoint_list_size
 701       || num < 0
 702       || breakpoint_list[num] == NULL
 703       /* FIXME: should not be so restrictive... */
 704       || breakpoint_list[num]->type != bp_breakpoint)
 705     return;
 706
 707   /* We ensure that ACTION contains no special Tcl characters, so we
 708      can do this.  */
 709   buf = xstrprintf ("gdbtk_tcl_breakpoint %s %d", action, num);
 710
 711   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 712     report_error ();
 713   free(buf);
 714 }
 715 \f
 716 /*
 717  * This section contains the commands that deal with tracepoints:
 718  */
 719
 720 /* This implements the tcl command gdb_actions
 721  * It sets actions for a given tracepoint.
 722  *
 723  * Tcl Arguments:
 724  *    number: the tracepoint in question
 725  *    actions: the actions to add to this tracepoint
 726  * Tcl Result:
 727  *    None.
 728  */
 729
 730 static int
 731 gdb_actions_command (ClientData clientData, Tcl_Interp *interp,
 732                      int objc, Tcl_Obj *CONST objv[])
 733 {
 734   struct breakpoint *tp;
 735   Tcl_Obj **actions;
 736   int nactions, i, len;
 737   char *number, *args, *action;
 738   long step_count;
 739   struct action_line *next = NULL, *temp;
 740   enum actionline_type linetype;
 741
 742   if (objc != 3)
 743     {
 744       Tcl_WrongNumArgs (interp, 1, objv, "number actions");
 745       return TCL_ERROR;
 746     }
 747
 748   args = number = Tcl_GetStringFromObj (objv[1], NULL);
 749   tp = get_tracepoint_by_number (&args, 0, 0);
 750   if (tp == NULL)
 751     {
 752       Tcl_AppendStringsToObj (result_ptr->obj_ptr, "Tracepoint \"",
 753                               number, "\" does not exist", NULL);
 754       return TCL_ERROR;
 755     }
 756
 757   /* Free any existing actions */
 758   if (tp->actions != NULL)
 759     free_actions (tp);
 760
 761   step_count = 0;
 762
 763   Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
 764
 765   /* Add the actions to the tracepoint */
 766   for (i = 0; i < nactions; i++)
 767     {
 768       temp = xmalloc (sizeof (struct action_line));
 769       temp->next = NULL;
 770       action = Tcl_GetStringFromObj (actions[i], &len);
 771       temp->action = savestring (action, len);
 772
 773       linetype = validate_actionline (&(temp->action), tp);
 774
 775       if (linetype == BADLINE)
 776         {
 777           free (temp);
 778           continue;
 779         }
 780
 781       if (next == NULL)
 782         {
 783           tp->actions = temp;
 784           next = temp;
 785         }
 786       else
 787         {
 788           next->next = temp;
 789           next = temp;
 790         }
 791     }
 792
 793   return TCL_OK;
 794 }
 795
 796 static int
 797 gdb_get_trace_frame_num (ClientData clientData, Tcl_Interp *interp,
 798                          int objc, Tcl_Obj *CONST objv[])
 799 {
 800   if (objc != 1)
 801     {
 802       Tcl_WrongNumArgs (interp, 1, objv, "linespec");
 803       return TCL_ERROR;
 804     }
 805
 806   Tcl_SetIntObj (result_ptr->obj_ptr, get_traceframe_number ());
 807   return TCL_OK;
 808
 809 }
 810
 811 static int
 812 gdb_get_tracepoint_info (ClientData clientData, Tcl_Interp *interp,
 813                          int objc, Tcl_Obj *CONST objv[])
 814 {
 815   struct symtab_and_line sal;
 816   int tpnum;
 817   struct breakpoint *tp;
 818   struct action_line *al;
 819   Tcl_Obj *action_list;
 820   char *filename, *funcname;
 821
 822   if (objc != 2)
 823     {
 824       Tcl_WrongNumArgs (interp, 1, objv, "tpnum");
 825       return TCL_ERROR;
 826     }
 827
 828   if (Tcl_GetIntFromObj (NULL, objv[1], &tpnum) != TCL_OK)
 829     {
 830       result_ptr->flags |= GDBTK_IN_TCL_RESULT;
 831       return TCL_ERROR;
 832     }
 833
 834   tp = get_tracepoint (tpnum);
 835
 836   if (tp == NULL)
 837     {
 838       gdbtk_set_result (interp, "Tracepoint #%d does not exist", tpnum);
 839       return TCL_ERROR;
 840     }
 841
 842   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
 843   sal = find_pc_line (tp->loc->address, 0);
 844   filename = symtab_to_filename (sal.symtab);
 845   if (filename == NULL)
 846     filename = "N/A";
 847   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 848                             Tcl_NewStringObj (filename, -1));
 849
 850   funcname = pc_function_name (tp->loc->address);
 851   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
 852                             (funcname, -1));
 853
 854   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 855                             Tcl_NewIntObj (sal.line));
 856   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 857                             Tcl_NewStringObj (core_addr_to_string (tp->loc->address), -1));
 858   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 859                             Tcl_NewIntObj (tp->enable_state == bp_enabled));
 860   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 861                             Tcl_NewIntObj (tp->pass_count));
 862   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 863                             Tcl_NewIntObj (tp->step_count));
 864   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 865                             Tcl_NewIntObj (tp->thread));
 866   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 867                             Tcl_NewIntObj (tp->hit_count));
 868
 869   /* Append a list of actions */
 870   action_list = Tcl_NewObj ();
 871   for (al = tp->actions; al != NULL; al = al->next)
 872     {
 873       Tcl_ListObjAppendElement (interp, action_list,
 874                                 Tcl_NewStringObj (al->action, -1));
 875     }
 876   Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, action_list);
 877
 878   return TCL_OK;
 879 }
 880
 881 /* return a list of all tracepoint numbers in interpreter */
 882 static int
 883 gdb_get_tracepoint_list (ClientData clientData,
 884                          Tcl_Interp *interp,
 885                          int objc,
 886                          Tcl_Obj *CONST objv[])
 887 {
 888   VEC(breakpoint_p) *tp_vec = NULL;
 889   int ix;
 890   struct breakpoint *tp;
 891
 892   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
 893
 894   tp_vec = all_tracepoints ();
 895   for (ix = 0; VEC_iterate (breakpoint_p, tp_vec, ix, tp); ix++)
 896     Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
 897                               Tcl_NewIntObj (tp->number));
 898   VEC_free (breakpoint_p, tp_vec);
 899
 900   return TCL_OK;
 901 }
 902
 903 static int
 904 gdb_trace_status (ClientData clientData,
 905                   Tcl_Interp *interp,
 906                   int objc,
 907                   Tcl_Obj *CONST objv[])
 908 {
 909   int result = 0;
 910
 911   if (trace_running_p)
 912     result = 1;
 913
 914   Tcl_SetIntObj (result_ptr->obj_ptr, result);
 915   return TCL_OK;
 916 }
 917
 918 /* returns -1 if not found, tracepoint # if found */
 919 static int
 920 tracepoint_exists (char *args)
 921 {
 922   VEC(breakpoint_p) *tp_vec = NULL;
 923   int ix;
 924   struct breakpoint *tp;
 925   char **canonical;
 926   struct symtabs_and_lines sals;
 927   char *file = NULL;
 928   int result = -1;
 929
 930   sals = decode_line_1 (&args, 1, NULL, 0, &canonical, NULL);
 931   if (sals.nelts == 1)
 932     {
 933       resolve_sal_pc (&sals.sals[0]);
 934       file = xmalloc (strlen (sals.sals[0].symtab->dirname)
 935                       + strlen (sals.sals[0].symtab->filename) + 1);
 936       if (file != NULL)
 937         {
 938           strcpy (file, sals.sals[0].symtab->dirname);
 939           strcat (file, sals.sals[0].symtab->filename);
 940
 941           tp_vec = all_tracepoints ();
 942           for (ix = 0; VEC_iterate (breakpoint_p, tp_vec, ix, tp); ix++)
 943             {
 944               if (tp->loc && tp->loc->address == sals.sals[0].pc)
 945                 result = tp->number;
 946 #if 0
 947               /* Why is this here? This messes up assembly traces */
 948               else if (tp->source_file != NULL
 949                        && strcmp (tp->source_file, file) == 0
 950                        && sals.sals[0].line == tp->line_number)
 951                 result = tp->number;
 952 #endif
 953             }
 954           VEC_free (breakpoint_p, tp_vec);
 955         }
 956     }
 957   if (file != NULL)
 958     free (file);
 959   return result;
 960 }
 961
 962 static int
 963 gdb_tracepoint_exists_command (ClientData clientData,
 964                                Tcl_Interp *interp,
 965                                int objc,
 966                                Tcl_Obj *CONST objv[])
 967 {
 968   char *args;
 969
 970   if (objc != 2)
 971     {
 972       Tcl_WrongNumArgs (interp, 1, objv,
 973                         "function:line|function|line|*addr");
 974       return TCL_ERROR;
 975     }
 976
 977   args = Tcl_GetStringFromObj (objv[1], NULL);
 978
 979   Tcl_SetIntObj (result_ptr->obj_ptr, tracepoint_exists (args));
 980   return TCL_OK;
 981 }
 982 \f
 983 /*
 984  * This section contains functions which deal with tracepoint
 985  * events from gdb.
 986  */
 987
 988 void
 989 gdbtk_create_tracepoint (int num)
 990 {
 991   tracepoint_notify (num, "create");
 992 }
 993
 994 void
 995 gdbtk_delete_tracepoint (int num)
 996 {
 997   tracepoint_notify (num, "delete");
 998 }
 999
1000 void
1001 gdbtk_modify_tracepoint (int num)
1002 {
1003   tracepoint_notify (num, "modify");
1004 }
1005
1006 static void
1007 tracepoint_notify (int num, const char *action)
1008 {
1009   char *buf;
1010
1011   /* We ensure that ACTION contains no special Tcl characters, so we
1012      can do this.  */
1013   buf = xstrprintf ("gdbtk_tcl_tracepoint %s %d", action, num);
1014
1015   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
1016     report_error ();
1017   free(buf);
1018 }