gdb/gdbtk-hooks.c

   1 /* Startup code for gdbtk.
   2    Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
   3
   4    Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
   5
   6 This file is part of GDB.
   7
   8 This program is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2 of the License, or
  11 (at your option) any later version.
  12
  13 This program is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with this program; if not, write to the Free Software
  20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
  21
  22 #include "defs.h"
  23 #include "symtab.h"
  24 #include "inferior.h"
  25 #include "command.h"
  26 #include "bfd.h"
  27 #include "symfile.h"
  28 #include "objfiles.h"
  29 #include "target.h"
  30 #include "gdbcore.h"
  31 #include "tracepoint.h"
  32 #include "demangle.h"
  33
  34 #ifdef _WIN32
  35 #include <winuser.h>
  36 #endif
  37
  38 #include <sys/stat.h>
  39
  40 #include <tcl.h>
  41 #include <tk.h>
  42 #include <itcl.h>
  43 #include <tix.h>
  44 #include "guitcl.h"
  45 #include "gdbtk.h"
  46
  47 #include <stdarg.h>
  48 #include <signal.h>
  49 #include <fcntl.h>
  50 #include <unistd.h>
  51 #include <setjmp.h>
  52 #include "top.h"
  53 #include <sys/ioctl.h>
  54 #include "gdb_string.h"
  55 #include "dis-asm.h"
  56 #include <stdio.h>
  57 #include "gdbcmd.h"
  58
  59 #include "annotate.h"
  60 #include <sys/time.h>
  61
  62 int in_fputs = 0;
  63
  64 extern int  (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
  65 extern void (*pre_add_symbol_hook) PARAMS ((char *));
  66 extern void (*post_add_symbol_hook) PARAMS ((void));
  67 extern void (*selected_frame_level_changed_hook) PARAMS ((int));
  68 #ifdef __CYGWIN32__
  69 extern void (*ui_loop_hook) PARAMS ((int));
  70 #endif
  71
  72 static void   gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
  73 static void   gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
  74 static void   gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
  75 static void   gdbtk_trace_find  PARAMS ((char *arg, int from_tty));
  76 static void   gdbtk_trace_start_stop PARAMS ((int, int));
  77 static void   gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
  78 static void   gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
  79 static void   gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
  80 static void   gdbtk_file_changed PARAMS ((char *));
  81 static void   gdbtk_exec_file_display PARAMS ((char *));
  82 static void   tk_command_loop PARAMS ((void));
  83 static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
  84 static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
  85 void   x_event PARAMS ((int));
  86 static int    gdbtk_query PARAMS ((const char *, va_list));
  87 static void   gdbtk_warning PARAMS ((const char *, va_list));
  88 static char*  gdbtk_readline PARAMS ((char *));
  89 static void gdbtk_readline_begin (char *format, ...);
  90 static void gdbtk_readline_end PARAMS ((void));
  91 static void   gdbtk_flush PARAMS ((GDB_FILE *));
  92 static void gdbtk_pre_add_symbol PARAMS ((char *));
  93 static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
  94 static void gdbtk_post_add_symbol PARAMS ((void));
  95 static void gdbtk_register_changed PARAMS ((int regno));
  96 static void gdbtk_memory_changed PARAMS ((CORE_ADDR addr, int len));
  97 static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
  98 static void gdbtk_selected_frame_changed PARAMS ((int));
  99 static void gdbtk_context_change PARAMS ((int));
 100 static void gdbtk_error_begin PARAMS ((void));
 101 static void report_error (void);
 102
 103 /*
 104  * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
 105  * See note there for details.
 106  */
 107
 108 void   gdbtk_fputs PARAMS ((const char *, GDB_FILE *));
 109 int           gdbtk_load_hash PARAMS ((char *, unsigned long));
 110 static void   breakpoint_notify PARAMS ((struct breakpoint *, const char *));
 111
 112 /*
 113  * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
 114  * startup code to fill in the hooks needed by core gdb.
 115  */
 116
 117 void
 118 gdbtk_add_hooks(void)
 119 {
 120   command_loop_hook = tk_command_loop;
 121   call_command_hook = gdbtk_call_command;
 122   readline_begin_hook = gdbtk_readline_begin;
 123   readline_hook = gdbtk_readline;
 124   readline_end_hook = gdbtk_readline_end;
 125
 126   print_frame_info_listing_hook = gdbtk_print_frame_info;
 127   query_hook = gdbtk_query;
 128   warning_hook = gdbtk_warning;
 129   flush_hook = gdbtk_flush;
 130
 131   create_breakpoint_hook = gdbtk_create_breakpoint;
 132   delete_breakpoint_hook = gdbtk_delete_breakpoint;
 133   modify_breakpoint_hook = gdbtk_modify_breakpoint;
 134
 135   interactive_hook       = gdbtk_interactive;
 136   target_wait_hook       = gdbtk_wait;
 137   ui_load_progress_hook  = gdbtk_load_hash;
 138
 139 #ifdef __CYGWIN32__
 140   ui_loop_hook = x_event;
 141 #endif
 142   pre_add_symbol_hook    = gdbtk_pre_add_symbol;
 143   post_add_symbol_hook   = gdbtk_post_add_symbol;
 144   file_changed_hook      = gdbtk_file_changed;
 145   exec_file_display_hook = gdbtk_exec_file_display;
 146
 147   create_tracepoint_hook = gdbtk_create_tracepoint;
 148   delete_tracepoint_hook = gdbtk_delete_tracepoint;
 149   modify_tracepoint_hook = gdbtk_modify_tracepoint;
 150   trace_find_hook        = gdbtk_trace_find;
 151   trace_start_stop_hook  = gdbtk_trace_start_stop;
 152
 153   register_changed_hook = gdbtk_register_changed;
 154   memory_changed_hook = gdbtk_memory_changed;
 155   selected_frame_level_changed_hook = gdbtk_selected_frame_changed;
 156   context_hook = gdbtk_context_change;
 157
 158   error_begin_hook = gdbtk_error_begin;
 159 }
 160
 161 /* These control where to put the gdb output which is created by
 162    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
 163    lowest level of these routines and capture all output from the rest of GDB.
 164
 165    The reason to use the result_ptr rather than the gdbtk_interp's result
 166    directly is so that a call_wrapper invoked function can preserve its result
 167    across calls into Tcl which might be made in the course of the function's
 168    execution.
 169
 170    * result_ptr->obj_ptr is where to accumulate the result.
 171    * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
 172      instead of to the result_ptr.
 173    * GDBTK_MAKES_LIST flag means add to the result as a list element.
 174
 175    */
 176
 177 gdbtk_result *result_ptr = NULL;
 178 \f
 179
 180 /* This allows you to Tcl_Eval a tcl command which takes
 181    a command word, and then a single argument. */
 182
 183 int gdbtk_two_elem_cmd (cmd_name, argv1)
 184     char *cmd_name;
 185     char * argv1;
 186 {
 187   char *command;
 188   int result, flags_ptr, arg_len, cmd_len;
 189
 190   arg_len = Tcl_ScanElement (argv1, &flags_ptr);
 191   cmd_len = strlen (cmd_name);
 192   command = malloc(arg_len + cmd_len + 2);
 193   strcpy (command, cmd_name);
 194   strcat (command, " ");
 195
 196   Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
 197
 198   result = Tcl_Eval (gdbtk_interp, command);
 199   if (result != TCL_OK)
 200     report_error ();
 201   free (command);
 202   return result;
 203 }
 204
 205 static void
 206 gdbtk_flush (stream)
 207      GDB_FILE *stream;
 208 {
 209 #if 0
 210   /* Force immediate screen update */
 211
 212   Tcl_VarEval (gdbtk_interp, "gdbtk_tcl_flush", NULL);
 213 #endif
 214 }
 215
 216 /* This handles all the output from gdb.  All the gdb printf_xxx functions
 217  * eventually end up here.  The output is either passed to the result_ptr
 218  * where it will go to the result of some gdbtk command, or passed to the
 219  * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
 220  * window.
 221  *
 222  * The cases are:
 223  *
 224  * 1) result_ptr == NULL - This happens when some output comes from gdb which
 225  *    is not generated by a command in gdbtk-cmds, usually startup stuff.
 226  *    In this case we just route the data to gdbtk_tcl_fputs.
 227  * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
 228  *    We place the data into the result_ptr, either as a string,
 229  *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
 230  * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
 231  *    UNLESS it was coming to gdb_stderr.  Then we place it in the result_ptr
 232  *    anyway, so it can be dealt with.
 233  *
 234  */
 235
 236 void
 237 gdbtk_fputs (ptr, stream)
 238      const char *ptr;
 239      GDB_FILE *stream;
 240 {
 241   in_fputs = 1;
 242
 243   if (result_ptr != NULL)
 244     {
 245       if (result_ptr->flags & GDBTK_TO_RESULT)
 246         {
 247           if (result_ptr->flags & GDBTK_MAKES_LIST)
 248             Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr,
 249                                      Tcl_NewStringObj((char *) ptr, -1));
 250           else
 251             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 252         }
 253       else if (stream == gdb_stderr || result_ptr->flags & GDBTK_ERROR_ONLY)
 254         {
 255           if (result_ptr->flags & GDBTK_ERROR_STARTED)
 256             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 257           else
 258             {
 259               Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
 260               result_ptr->flags |= GDBTK_ERROR_STARTED;
 261             }
 262         }
 263       else
 264         {
 265           gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 266           if (result_ptr->flags & GDBTK_MAKES_LIST)
 267             gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
 268         }
 269     }
 270   else
 271     {
 272       gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 273     }
 274
 275   in_fputs = 0;
 276 }
 277
 278 /*
 279  * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
 280  */
 281
 282 static void
 283 gdbtk_warning (warning, args)
 284      const char *warning;
 285      va_list args;
 286 {
 287   char buf[200];
 288
 289   vsprintf (buf, warning, args);
 290   gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
 291 }
 292
 293
 294 /* Error-handling function for all hooks */
 295 /* Hooks are not like tcl functions, they do not simply return */
 296 /* TCL_OK or TCL_ERROR.  Also, the calling function typically */
 297 /* doesn't care about errors in the hook functions.  Therefore */
 298 /* after every hook function, report_error should be called. */
 299 /* report_error can just call Tcl_BackgroundError() which will */
 300 /* pop up a messagebox, or it can silently log the errors through */
 301 /* the gdbtk dbug command.  */
 302
 303 static void
 304 report_error ()
 305 {
 306   TclDebug ('E',Tcl_GetVar(gdbtk_interp,"errorInfo",TCL_GLOBAL_ONLY));
 307   /*  Tcl_BackgroundError(gdbtk_interp); */
 308 }
 309
 310 /*
 311  * This routes all ignorable warnings to the Tcl function
 312  * "gdbtk_tcl_ignorable_warning".
 313  */
 314
 315 void
 316 gdbtk_ignorable_warning (class, warning)
 317      const char *class;
 318      const char *warning;
 319 {
 320   char buf[512];
 321   sprintf (buf, "gdbtk_tcl_ignorable_warning {%s} {%s}", class, warning);
 322   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 323     report_error();
 324 }
 325
 326 static void
 327 gdbtk_register_changed(regno)
 328      int regno;
 329 {
 330   if (Tcl_Eval (gdbtk_interp, "gdbtk_register_changed") != TCL_OK)
 331     report_error();
 332 }
 333
 334 static void
 335 gdbtk_memory_changed(addr, len)
 336      CORE_ADDR addr;
 337      int len;
 338 {
 339   if (Tcl_Eval (gdbtk_interp, "gdbtk_memory_changed") != TCL_OK)
 340     report_error();
 341 }
 342
 343 \f
 344 /* This function is called instead of gdb's internal command loop.  This is the
 345    last chance to do anything before entering the main Tk event loop.
 346    At the end of the command, we enter the main loop. */
 347
 348 static void
 349 tk_command_loop ()
 350 {
 351   extern FILE *instream;
 352
 353   /* We no longer want to use stdin as the command input stream */
 354   instream = NULL;
 355
 356   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
 357     {
 358       char *msg;
 359
 360       /* Force errorInfo to be set up propertly.  */
 361       Tcl_AddErrorInfo (gdbtk_interp, "");
 362
 363       msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
 364 #ifdef _WIN32
 365       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
 366 #else
 367       fputs_unfiltered (msg, gdb_stderr);
 368 #endif
 369     }
 370
 371 #ifdef _WIN32
 372   close_bfds ();
 373 #endif
 374
 375   Tk_MainLoop ();
 376 }
 377
 378 /* Come here when there is activity on the X file descriptor. */
 379
 380 void
 381 x_event (signo)
 382      int signo;
 383 {
 384   static int in_x_event = 0;
 385   static Tcl_Obj *varname = NULL;
 386   if (in_x_event || in_fputs)
 387     return;
 388
 389   in_x_event = 1;
 390
 391 #ifdef __CYGWIN32__
 392   if (signo == -2)
 393     gdbtk_stop_timer ();
 394 #endif
 395
 396   /* Process pending events */
 397   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
 398     ;
 399
 400   if (load_in_progress)
 401     {
 402       int val;
 403       if (varname == NULL)
 404         {
 405 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 1
 406           Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
 407           varname = Tcl_ObjGetVar2(gdbtk_interp, varnamestrobj, NULL, TCL_GLOBAL_ONLY);
 408 #else
 409           varname = Tcl_GetObjVar2(gdbtk_interp, "download_cancel_ok", NULL, TCL_GLOBAL_ONLY);
 410 #endif
 411         }
 412       if ((Tcl_GetIntFromObj(gdbtk_interp,varname,&val) == TCL_OK) && val)
 413         {
 414           quit_flag = 1;
 415 #ifdef REQUEST_QUIT
 416           REQUEST_QUIT;
 417 #else
 418           if (immediate_quit)
 419             quit ();
 420 #endif
 421         }
 422     }
 423   in_x_event = 0;
 424 }
 425
 426 /* VARARGS */
 427 static void
 428 gdbtk_readline_begin (char *format, ...)
 429 {
 430   va_list args;
 431   char buf[200];
 432
 433   va_start (args, format);
 434   vsprintf (buf, format, args);
 435   gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
 436 }
 437
 438 static char *
 439 gdbtk_readline (prompt)
 440      char *prompt;
 441 {
 442   int result;
 443
 444 #ifdef _WIN32
 445   close_bfds ();
 446 #endif
 447
 448   result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
 449
 450   if (result == TCL_OK)
 451     {
 452       return (strdup (gdbtk_interp -> result));
 453     }
 454   else
 455     {
 456       gdbtk_fputs (gdbtk_interp -> result, gdb_stdout);
 457       gdbtk_fputs ("\n", gdb_stdout);
 458       return (NULL);
 459     }
 460 }
 461
 462 static void
 463 gdbtk_readline_end ()
 464 {
 465   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end") != TCL_OK)
 466     report_error ();
 467 }
 468
 469 static void
 470 gdbtk_call_command (cmdblk, arg, from_tty)
 471      struct cmd_list_element *cmdblk;
 472      char *arg;
 473      int from_tty;
 474 {
 475   running_now = 0;
 476   if (cmdblk->class == class_run || cmdblk->class == class_trace)
 477     {
 478
 479       running_now = 1;
 480       if (!No_Update)
 481         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
 482       (*cmdblk->function.cfunc)(arg, from_tty);
 483       running_now = 0;
 484       if (!No_Update)
 485         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
 486     }
 487   else
 488     (*cmdblk->function.cfunc)(arg, from_tty);
 489 }
 490
 491 /* The next three functions use breakpoint_notify to allow the GUI
 492  * to handle creating, deleting and modifying breakpoints.  These three
 493  * functions are put into the appropriate gdb hooks in gdbtk_init.
 494  */
 495
 496 static void
 497 gdbtk_create_breakpoint(b)
 498      struct breakpoint *b;
 499 {
 500   breakpoint_notify (b, "create");
 501 }
 502
 503 static void
 504 gdbtk_delete_breakpoint(b)
 505      struct breakpoint *b;
 506 {
 507   breakpoint_notify (b, "delete");
 508 }
 509
 510 static void
 511 gdbtk_modify_breakpoint(b)
 512      struct breakpoint *b;
 513 {
 514   breakpoint_notify (b, "modify");
 515 }
 516
 517 /* This is the generic function for handling changes in
 518  * a breakpoint.  It routes the information to the Tcl
 519  * command "gdbtk_tcl_breakpoint" in the form:
 520  *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
 521  * On error, the error string is written to gdb_stdout.
 522  */
 523
 524 static void
 525 breakpoint_notify(b, action)
 526      struct breakpoint *b;
 527      const char *action;
 528 {
 529   char buf[256];
 530   int v;
 531   struct symtab_and_line sal;
 532   char *filename;
 533
 534   if (b->type != bp_breakpoint)
 535     return;
 536
 537   /* We ensure that ACTION contains no special Tcl characters, so we
 538      can do this.  */
 539   sal = find_pc_line (b->address, 0);
 540   filename = symtab_to_filename (sal.symtab);
 541   if (filename == NULL)
 542     filename = "";
 543
 544   sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s} {%s} %d %d",
 545            action, b->number, (long)b->address, b->line_number, filename,
 546            bpdisp[b->disposition], b->enable,  b->thread);
 547
 548   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 549     report_error ();
 550 }
 551
 552 int
 553 gdbtk_load_hash (section, num)
 554      char *section;
 555      unsigned long num;
 556 {
 557   char buf[128];
 558   sprintf (buf, "download_hash %s %ld", section, num);
 559   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 560     report_error ();
 561   return  atoi (gdbtk_interp->result);
 562 }
 563
 564
 565 /* This hook is called whenever we are ready to load a symbol file so that
 566    the UI can notify the user... */
 567 static void
 568 gdbtk_pre_add_symbol (name)
 569   char *name;
 570 {
 571   gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name);
 572 }
 573
 574 /* This hook is called whenever we finish loading a symbol file. */
 575 static void
 576 gdbtk_post_add_symbol ()
 577 {
 578   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol") != TCL_OK)
 579     report_error ();
 580 }
 581
 582 /* This hook function is called whenever we want to wait for the
 583    target.  */
 584
 585 static int
 586 gdbtk_wait (pid, ourstatus)
 587      int pid;
 588      struct target_waitstatus *ourstatus;
 589 {
 590   /* Don't run the timer on various targets... */
 591   if (!STREQ (target_shortname, "ice"))
 592     gdbtk_start_timer ();
 593   pid = target_wait (pid, ourstatus);
 594   gdbtk_stop_timer ();
 595   return pid;
 596 }
 597
 598 /*
 599  * This handles all queries from gdb.
 600  * The first argument is a printf style format statement, the rest are its
 601  * arguments.  The resultant formatted string is passed to the Tcl function
 602  * "gdbtk_tcl_query".
 603  * It returns the users response to the query, as well as putting the value
 604  * in the result field of the Tcl interpreter.
 605  */
 606
 607 static int
 608 gdbtk_query (query, args)
 609      const char *query;
 610      va_list args;
 611 {
 612   char buf[200];
 613   long val;
 614
 615   vsprintf (buf, query, args);
 616   gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
 617
 618   val = atol (gdbtk_interp->result);
 619   return val;
 620 }
 621
 622
 623 static void
 624 gdbtk_print_frame_info (s, line, stopline, noerror)
 625   struct symtab *s;
 626   int line;
 627   int stopline;
 628   int noerror;
 629 {
 630   current_source_symtab = s;
 631   current_source_line = line;
 632 }
 633
 634 static void
 635 gdbtk_create_tracepoint (tp)
 636   struct tracepoint *tp;
 637 {
 638   tracepoint_notify (tp, "create");
 639 }
 640
 641 static void
 642 gdbtk_delete_tracepoint (tp)
 643   struct tracepoint *tp;
 644 {
 645   tracepoint_notify (tp, "delete");
 646 }
 647
 648 static void
 649 gdbtk_modify_tracepoint (tp)
 650   struct tracepoint *tp;
 651 {
 652   tracepoint_notify (tp, "modify");
 653 }
 654
 655 static void
 656 tracepoint_notify(tp, action)
 657      struct tracepoint *tp;
 658      const char *action;
 659 {
 660   char buf[256];
 661   int v;
 662   struct symtab_and_line sal;
 663   char *filename;
 664
 665   /* We ensure that ACTION contains no special Tcl characters, so we
 666      can do this.  */
 667   sal = find_pc_line (tp->address, 0);
 668
 669   filename = symtab_to_filename (sal.symtab);
 670   if (filename == NULL)
 671     filename = "N/A";
 672   sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s} %d", action, tp->number,
 673            (long)tp->address, sal.line, filename, tp->pass_count);
 674
 675   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 676     report_error ();
 677 }
 678
 679 /*
 680  * gdbtk_trace_find
 681  *
 682  * This is run by the trace_find_command.  arg is the argument that was passed
 683  * to that command, from_tty is 1 if the command was run from a tty, 0 if it
 684  * was run from a script.  It runs gdbtk_tcl_tfind_hook passing on these two
 685  * arguments.
 686  *
 687  */
 688
 689 static void
 690 gdbtk_trace_find (arg, from_tty)
 691      char *arg;
 692      int from_tty;
 693 {
 694   Tcl_Obj *cmdObj;
 695
 696   cmdObj = Tcl_NewListObj (0, NULL);
 697   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj,
 698                             Tcl_NewStringObj ("gdbtk_tcl_trace_find_hook", -1));
 699   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewStringObj (arg, -1));
 700   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewIntObj(from_tty));
 701 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 1
 702   if (Tcl_GlobalEvalObj (gdbtk_interp, cmdObj) != TCL_OK)
 703     report_error ();
 704 #else
 705   if (Tcl_EvalObj (gdbtk_interp, cmdObj, TCL_EVAL_GLOBAL) != TCL_OK)
 706     report_error ();
 707 #endif
 708 }
 709
 710 /*
 711  * gdbtk_trace_start_stop
 712  *
 713  * This is run by the trace_start_command and trace_stop_command.
 714  * The START variable determines which, 1 meaning trace_start was run,
 715  * 0 meaning trace_stop was run.
 716  *
 717  */
 718
 719 static void
 720 gdbtk_trace_start_stop (start, from_tty)
 721      int start;
 722      int from_tty;
 723 {
 724
 725   if (start)
 726     Tcl_GlobalEval (gdbtk_interp, "gdbtk_tcl_tstart");
 727   else
 728     Tcl_GlobalEval (gdbtk_interp, "gdbtk_tcl_tstop");
 729
 730 }
 731
 732 static void
 733 gdbtk_selected_frame_changed (level)
 734      int level;
 735 {
 736   Tcl_UpdateLinkedVar (gdbtk_interp, "gdb_selected_frame_level");
 737 }
 738
 739 /* Called when the current thread changes. */
 740 /* gdb_context is linked to the tcl variable "gdb_context_id" */
 741 static void
 742 gdbtk_context_change (num)
 743      int num;
 744 {
 745   gdb_context = num;
 746 }
 747
 748 /* Called from file_command */
 749 static void
 750 gdbtk_file_changed (filename)
 751      char *filename;
 752 {
 753   gdbtk_two_elem_cmd ("gdbtk_tcl_file_changed", filename);
 754 }
 755
 756 /* Called from exec_file_command */
 757 static void
 758 gdbtk_exec_file_display (filename)
 759      char *filename;
 760 {
 761   gdbtk_two_elem_cmd ("gdbtk_tcl_exec_file_display", filename);
 762 }
 763
 764 /* Called from error_begin, this hook is used to warn the gui
 765    about multi-line error messages */
 766 static void
 767 gdbtk_error_begin ()
 768 {
 769   if (result_ptr != NULL)
 770     result_ptr->flags |= GDBTK_ERROR_ONLY;
 771 }
 772 \f
 773 /* Local variables: */
 774 /* change-log-default-name: "ChangeLog-gdbtk" */
 775 /* End: */