gdb/gdbtk/generic/gdbtk-hooks.c

   1 /* Startup code for Insight.
   2
   3    Copyright (C) 1994, 1995, 1996, 1997, 1998, 2000, 200, 2002, 2003, 2004, 2008
   4    Free Software Foundation, Inc.
   5
   6    Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
   7
   8    This file is part of GDB.
   9
  10    This program is free software; you can redistribute it and/or modify
  11    it under the terms of the GNU General Public License as published by
  12    the Free Software Foundation; either version 2 of the License, or
  13    (at your option) any later version.
  14
  15    This program is distributed in the hope that it will be useful,
  16    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18    GNU General Public License for more details.
  19
  20    You should have received a copy of the GNU General Public License
  21    along with this program; if not, write to the Free Software
  22    Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23    Boston, MA 02110-1301, USA.  */
  24
  25 #include "defs.h"
  26 #include "inferior.h"
  27 #include "symfile.h"
  28 #include "objfiles.h"
  29 #include "gdbcore.h"
  30 #include "tracepoint.h"
  31 #include "demangle.h"
  32 #include "top.h"
  33 #include "annotate.h"
  34 #include "cli/cli-decode.h"
  35 #include "observer.h"
  36
  37 #ifdef _WIN32
  38 #define WIN32_LEAN_AND_MEAN
  39 #include <windows.h>
  40 #endif
  41
  42 /* tcl header files includes varargs.h unless HAS_STDARG is defined,
  43    but gdb uses stdarg.h, so make sure HAS_STDARG is defined.  */
  44 #define HAS_STDARG 1
  45
  46 #include <tcl.h>
  47 #include <tk.h>
  48 #include "guitcl.h"
  49 #include "gdbtk.h"
  50
  51 #include <signal.h>
  52 #include <fcntl.h>
  53 #ifdef HAVE_SYS_IOCTL_H
  54 #include <sys/ioctl.h>
  55 #endif
  56 #include <sys/time.h>
  57
  58 #include "gdb_string.h"
  59 #include "dis-asm.h"
  60 #include "gdbcmd.h"
  61
  62
  63 volatile int in_fputs = 0;
  64
  65 /* Set by gdb_stop, this flag informs x_event to tell its caller
  66    that it should forcibly detach from the target. */
  67 int gdbtk_force_detach = 0;
  68
  69 /* From gdbtk-bp.c */
  70 extern void gdbtk_create_breakpoint (int);
  71 extern void gdbtk_delete_breakpoint (int);
  72 extern void gdbtk_modify_breakpoint (int);
  73 extern void gdbtk_create_tracepoint (int);
  74 extern void gdbtk_delete_tracepoint (int);
  75 extern void gdbtk_modify_tracepoint (int);
  76
  77 static void gdbtk_architecture_changed (struct gdbarch *);
  78 static void gdbtk_trace_find (char *arg, int from_tty);
  79 static void gdbtk_trace_start_stop (int, int);
  80 static void gdbtk_attach (void);
  81 static void gdbtk_detach (void);
  82 static void gdbtk_file_changed (char *);
  83 static void gdbtk_exec_file_display (char *);
  84 static void gdbtk_call_command (struct cmd_list_element *, char *, int);
  85 static ptid_t gdbtk_wait (ptid_t, struct target_waitstatus *);
  86 int x_event (int);
  87 static int gdbtk_query (const char *, va_list);
  88 static void gdbtk_warning (const char *, va_list);
  89 static char *gdbtk_readline (char *);
  90 static void gdbtk_readline_begin (char *format,...);
  91 static void gdbtk_readline_end (void);
  92 static void gdbtk_pre_add_symbol (const char *);
  93 static void gdbtk_print_frame_info (struct symtab *, int, int, int);
  94 static void gdbtk_post_add_symbol (void);
  95 static void gdbtk_register_changed (int regno);
  96 static void gdbtk_memory_changed (CORE_ADDR addr, int len);
  97 static void gdbtk_selected_frame_changed (int);
  98 static void gdbtk_context_change (int);
  99 static void gdbtk_error_begin (void);
 100 void report_error (void);
 101 static void gdbtk_annotate_signal (void);
 102 static void gdbtk_set_hook (struct cmd_list_element *cmdblk);
 103
 104 /*
 105  * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
 106  * See note there for details.
 107  */
 108
 109 long gdbtk_read (struct ui_file *, char *, long);
 110 void gdbtk_fputs (const char *, struct ui_file *);
 111 static int gdbtk_load_hash (const char *, unsigned long);
 112
 113 static ptid_t gdbtk_ptid;
 114
 115 /*
 116  * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
 117  * startup code to fill in the hooks needed by core gdb.
 118  */
 119
 120 void
 121 gdbtk_add_hooks (void)
 122 {
 123   /* Gdb observers */
 124   observer_attach_breakpoint_created (gdbtk_create_breakpoint);
 125   observer_attach_breakpoint_modified (gdbtk_modify_breakpoint);
 126   observer_attach_breakpoint_deleted (gdbtk_delete_breakpoint);
 127   observer_attach_tracepoint_created (gdbtk_create_tracepoint);
 128   observer_attach_tracepoint_modified (gdbtk_modify_tracepoint);
 129   observer_attach_tracepoint_deleted (gdbtk_delete_tracepoint);
 130   observer_attach_architecture_changed (gdbtk_architecture_changed);
 131
 132   /* Hooks */
 133   deprecated_call_command_hook = gdbtk_call_command;
 134   deprecated_set_hook = gdbtk_set_hook;
 135   deprecated_readline_begin_hook = gdbtk_readline_begin;
 136   deprecated_readline_hook = gdbtk_readline;
 137   deprecated_readline_end_hook = gdbtk_readline_end;
 138
 139   deprecated_print_frame_info_listing_hook = gdbtk_print_frame_info;
 140   deprecated_query_hook = gdbtk_query;
 141   deprecated_warning_hook = gdbtk_warning;
 142
 143   deprecated_interactive_hook = gdbtk_interactive;
 144   deprecated_target_wait_hook = gdbtk_wait;
 145   deprecated_ui_load_progress_hook = gdbtk_load_hash;
 146
 147   deprecated_ui_loop_hook = x_event;
 148   deprecated_pre_add_symbol_hook = gdbtk_pre_add_symbol;
 149   deprecated_post_add_symbol_hook = gdbtk_post_add_symbol;
 150   deprecated_file_changed_hook = gdbtk_file_changed;
 151   specify_exec_file_hook (gdbtk_exec_file_display);
 152
 153   deprecated_trace_find_hook = gdbtk_trace_find;
 154   deprecated_trace_start_stop_hook = gdbtk_trace_start_stop;
 155
 156   deprecated_attach_hook            = gdbtk_attach;
 157   deprecated_detach_hook            = gdbtk_detach;
 158
 159   deprecated_register_changed_hook = gdbtk_register_changed;
 160   deprecated_memory_changed_hook = gdbtk_memory_changed;
 161   deprecated_selected_frame_level_changed_hook = gdbtk_selected_frame_changed;
 162   deprecated_context_hook = gdbtk_context_change;
 163
 164   deprecated_error_begin_hook = gdbtk_error_begin;
 165
 166   deprecated_annotate_signal_hook = gdbtk_annotate_signal;
 167   deprecated_annotate_signalled_hook = gdbtk_annotate_signal;
 168 }
 169
 170 /* These control where to put the gdb output which is created by
 171    {f}printf_{un}filtered and friends.  gdbtk_fputs is the lowest
 172    level of these routines and capture all output from the rest of
 173    GDB.
 174
 175    The reason to use the result_ptr rather than the gdbtk_interp's result
 176    directly is so that a call_wrapper invoked function can preserve its result
 177    across calls into Tcl which might be made in the course of the function's
 178    execution.
 179
 180    * result_ptr->obj_ptr is where to accumulate the result.
 181    * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
 182    instead of to the result_ptr.
 183    * GDBTK_MAKES_LIST flag means add to the result as a list element.
 184
 185 */
 186
 187 gdbtk_result *result_ptr = NULL;
 188
 189 /* If you want to restore an old value of result_ptr whenever cleanups
 190    are run, pass this function to make_cleanup, along with the value
 191    of result_ptr you'd like to reinstate.  */
 192 void
 193 gdbtk_restore_result_ptr (void *old_result_ptr)
 194 {
 195   result_ptr = (gdbtk_result *) old_result_ptr;
 196 }
 197
 198 /* This allows you to Tcl_Eval a tcl command which takes
 199    a command word, and then a single argument. */
 200 int
 201 gdbtk_two_elem_cmd (cmd_name, argv1)
 202      char *cmd_name;
 203      char *argv1;
 204 {
 205   char *command;
 206   int result, flags_ptr, arg_len, cmd_len;
 207
 208   arg_len = Tcl_ScanElement (argv1, &flags_ptr);
 209   cmd_len = strlen (cmd_name);
 210   command = malloc (arg_len + cmd_len + 2);
 211   strcpy (command, cmd_name);
 212   strcat (command, " ");
 213
 214   Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
 215
 216   result = Tcl_Eval (gdbtk_interp, command);
 217   if (result != TCL_OK)
 218     report_error ();
 219   free (command);
 220   return result;
 221 }
 222
 223 struct ui_file *
 224 gdbtk_fileopenin (void)
 225 {
 226   struct ui_file *file = ui_file_new ();
 227   set_ui_file_read (file, gdbtk_read);
 228   return file;
 229 }
 230
 231 struct ui_file *
 232 gdbtk_fileopen (void)
 233 {
 234   struct ui_file *file = ui_file_new ();
 235   set_ui_file_fputs (file, gdbtk_fputs);
 236   return file;
 237 }
 238
 239 /* This handles input from the gdb console.
 240  */
 241
 242 long
 243 gdbtk_read (struct ui_file *stream, char *buf, long sizeof_buf)
 244 {
 245   int result;
 246   size_t actual_len;
 247
 248   if (stream == gdb_stdtargin)
 249     {
 250       result = Tcl_Eval (gdbtk_interp, "gdbtk_console_read");
 251       if (result != TCL_OK)
 252         {
 253           report_error ();
 254           actual_len = 0;
 255         }
 256       else
 257         actual_len = strlen (gdbtk_interp->result);
 258
 259       /* Truncate the string if it is too big for the caller's buffer.  */
 260       if (actual_len >= sizeof_buf)
 261         actual_len = sizeof_buf - 1;
 262
 263       memcpy (buf, gdbtk_interp->result, actual_len);
 264       buf[actual_len] = '\0';
 265       return actual_len;
 266     }
 267   else
 268     {
 269       errno = EBADF;
 270       return 0;
 271     }
 272 }
 273
 274
 275 /* This handles all the output from gdb.  All the gdb printf_xxx functions
 276  * eventually end up here.  The output is either passed to the result_ptr
 277  * where it will go to the result of some gdbtk command, or passed to the
 278  * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
 279  * window.
 280  *
 281  * The cases are:
 282  *
 283  * 1) result_ptr == NULL - This happens when some output comes from gdb which
 284  *    is not generated by a command in gdbtk-cmds, usually startup stuff.
 285  *    In this case we just route the data to gdbtk_tcl_fputs.
 286  * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
 287  *    We place the data into the result_ptr, either as a string,
 288  *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
 289  * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
 290  *    UNLESS it was coming to gdb_stderr.  Then we place it in the result_ptr
 291  *    anyway, so it can be dealt with.
 292  *
 293  */
 294
 295 void
 296 gdbtk_fputs (const char *ptr, struct ui_file *stream)
 297 {
 298   if (gdbtk_disable_fputs)
 299     return;
 300
 301   in_fputs = 1;
 302
 303   if (stream == gdb_stdlog)
 304     gdbtk_two_elem_cmd ("gdbtk_tcl_fputs_log", (char *) ptr);
 305   else if (stream == gdb_stdtarg)
 306     gdbtk_two_elem_cmd ("gdbtk_tcl_fputs_target", (char *) ptr);
 307   else if (result_ptr != NULL)
 308     {
 309       if (result_ptr->flags & GDBTK_TO_RESULT)
 310         {
 311           if (result_ptr->flags & GDBTK_MAKES_LIST)
 312             Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
 313                                       Tcl_NewStringObj ((char *) ptr, -1));
 314           else
 315             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 316         }
 317       else if (stream == gdb_stderr || result_ptr->flags & GDBTK_ERROR_ONLY)
 318         {
 319           if (result_ptr->flags & GDBTK_ERROR_STARTED)
 320             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 321           else
 322             {
 323               Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
 324               result_ptr->flags |= GDBTK_ERROR_STARTED;
 325             }
 326         }
 327       else
 328         {
 329           gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 330           if (result_ptr->flags & GDBTK_MAKES_LIST)
 331             gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
 332         }
 333     }
 334   else
 335     {
 336       gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 337     }
 338
 339   in_fputs = 0;
 340 }
 341
 342 /*
 343  * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
 344  */
 345
 346 static void
 347 gdbtk_warning (const char *warning, va_list args)
 348 {
 349   char *buf;
 350   xvasprintf (&buf, warning, args);
 351   gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
 352   free(buf);
 353 }
 354
 355
 356 /* Error-handling function for all hooks */
 357 /* Hooks are not like tcl functions, they do not simply return */
 358 /* TCL_OK or TCL_ERROR.  Also, the calling function typically */
 359 /* doesn't care about errors in the hook functions.  Therefore */
 360 /* after every hook function, report_error should be called. */
 361 /* report_error can just call Tcl_BackgroundError() which will */
 362 /* pop up a messagebox, or it can silently log the errors through */
 363 /* the gdbtk dbug command.  */
 364
 365 void
 366 report_error ()
 367 {
 368   TclDebug ('E', Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY));
 369   /*  Tcl_BackgroundError(gdbtk_interp); */
 370 }
 371
 372 /*
 373  * This routes all ignorable warnings to the Tcl function
 374  * "gdbtk_tcl_ignorable_warning".
 375  */
 376
 377 void
 378 gdbtk_ignorable_warning (const char *class, const char *warning)
 379 {
 380   char *buf;
 381   xasprintf (&buf, "gdbtk_tcl_ignorable_warning {%s} {%s}", class, warning);
 382   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 383     report_error ();
 384   free(buf);
 385 }
 386
 387 static void
 388 gdbtk_register_changed (int regno)
 389 {
 390   if (Tcl_Eval (gdbtk_interp, "gdbtk_register_changed") != TCL_OK)
 391     report_error ();
 392 }
 393
 394 static void
 395 gdbtk_memory_changed (CORE_ADDR addr, int len)
 396 {
 397   if (Tcl_Eval (gdbtk_interp, "gdbtk_memory_changed") != TCL_OK)
 398     report_error ();
 399 }
 400 \f
 401
 402 /* This hook is installed as the deprecated_ui_loop_hook, which is
 403  * used in several places to keep the gui alive (x_event runs gdbtk's
 404  * event loop). Users include:
 405  * - ser-tcp.c in socket reading code
 406  * - ser-unix.c in serial port reading code
 407  * - built-in simulators while executing
 408  *
 409  * x_event used to be called on SIGIO on the socket to the X server
 410  * for unix. Unfortunately, Linux does not deliver SIGIO, so we resort
 411  * to an elaborate scheme to keep the gui alive.
 412  *
 413  * For simulators and socket or serial connections on all hosts, we
 414  * rely on deprecated_ui_loop_hook (x_event) to keep us going. If the
 415  * user requests a detach (as a result of pressing the stop button --
 416  * see comments before gdb_stop in gdbtk-cmds.c), it sets the global
 417  * GDBTK_FORCE_DETACH, which is the value that x_event returns to it's
 418  * caller. It is up to the caller of x_event to act on this
 419  * information.
 420  *
 421  * For native unix, we simply set an interval timer which calls
 422  * x_event to allow the debugger to run through the Tcl event
 423  * loop. See comments before gdbtk_start_timer and gdb_stop_timer
 424  * in gdbtk.c.
 425  *
 426  * For native windows (and a few other targets, like the v850 ICE), we
 427  * rely on the target_wait loops to call deprecated_ui_loop_hook to
 428  * keep us alive.  */
 429 int
 430 x_event (int signo)
 431 {
 432   static volatile int in_x_event = 0;
 433   static Tcl_Obj *varname = NULL;
 434
 435   /* Do nor re-enter this code or enter it while collecting gdb output. */
 436   if (in_x_event || in_fputs)
 437     return 0;
 438
 439   /* Also, only do things while the target is running (stops and redraws).
 440      FIXME: We wold like to at least redraw at other times but this is bundled
 441      together in the TCL_WINDOW_EVENTS group and we would also process user
 442      input.  We will have to prevent (unwanted)  user input to be generated
 443      in order to be able to redraw (removing this test here). */
 444   if (!running_now)
 445     return 0;
 446
 447   in_x_event = 1;
 448   gdbtk_force_detach = 0;
 449
 450   /* Process pending events */
 451   while (Tcl_DoOneEvent (TCL_DONT_WAIT | TCL_ALL_EVENTS) != 0)
 452     ;
 453
 454   if (load_in_progress)
 455     {
 456       int val;
 457       if (varname == NULL)
 458         {
 459 #if TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION < 1 || TCL_MINOR_VERSION > 2)
 460           Tcl_Obj *varnamestrobj = Tcl_NewStringObj ("download_cancel_ok", -1);
 461           varname = Tcl_ObjGetVar2 (gdbtk_interp, varnamestrobj, NULL, TCL_GLOBAL_ONLY);
 462 #else
 463           varname = Tcl_GetObjVar2 (gdbtk_interp, "download_cancel_ok", NULL, TCL_GLOBAL_ONLY);
 464 #endif
 465         }
 466       if ((Tcl_GetIntFromObj (gdbtk_interp, varname, &val) == TCL_OK) && val)
 467         {
 468           quit_flag = 1;
 469 #ifdef REQUEST_QUIT
 470           REQUEST_QUIT;
 471 #else
 472           if (immediate_quit)
 473             quit ();
 474 #endif
 475         }
 476     }
 477   in_x_event = 0;
 478
 479   return gdbtk_force_detach;
 480 }
 481
 482 /* VARARGS */
 483 static void
 484 gdbtk_readline_begin (char *format,...)
 485 {
 486   va_list args;
 487   char *buf;
 488
 489   va_start (args, format);
 490   xvasprintf (&buf, format, args);
 491   gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
 492   free(buf);
 493 }
 494
 495 static char *
 496 gdbtk_readline (char *prompt)
 497 {
 498   int result;
 499
 500 #ifdef _WIN32
 501   close_bfds ();
 502 #endif
 503
 504   result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
 505
 506   if (result == TCL_OK)
 507     {
 508       return (xstrdup (gdbtk_interp->result));
 509     }
 510   else
 511     {
 512       gdbtk_fputs (gdbtk_interp->result, gdb_stdout);
 513       gdbtk_fputs ("\n", gdb_stdout);
 514       return (NULL);
 515     }
 516 }
 517
 518 static void
 519 gdbtk_readline_end ()
 520 {
 521   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end") != TCL_OK)
 522     report_error ();
 523 }
 524
 525 static void
 526 gdbtk_call_command (struct cmd_list_element *cmdblk,
 527                     char *arg, int from_tty)
 528 {
 529   struct cleanup *old_chain;
 530
 531   old_chain = make_cleanup (null_cleanup, 0);
 532   running_now = 0;
 533   if (cmdblk->class == class_run || cmdblk->class == class_trace)
 534     {
 535
 536       running_now = 1;
 537       if (!No_Update)
 538         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
 539       cmd_func (cmdblk, arg, from_tty);
 540       running_now = 0;
 541       if (!No_Update)
 542         Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
 543     }
 544   else
 545     cmd_func (cmdblk, arg, from_tty);
 546
 547   do_cleanups (old_chain);
 548 }
 549
 550 /* Called after a `set' command succeeds.  Runs the Tcl hook
 551    `gdb_set_hook' with the full name of the variable (a Tcl list) as
 552    the first argument and the new value as the second argument.  */
 553
 554 static void
 555 gdbtk_set_hook (struct cmd_list_element *cmdblk)
 556 {
 557   Tcl_DString cmd;
 558   char *p;
 559   char *buffer = NULL;
 560
 561   Tcl_DStringInit (&cmd);
 562   Tcl_DStringAppendElement (&cmd, "gdbtk_tcl_set_variable");
 563
 564   /* Append variable name as sublist.  */
 565   Tcl_DStringStartSublist (&cmd);
 566   p = cmdblk->prefixname;
 567   while (p && *p)
 568     {
 569       char *q = strchr (p, ' ');
 570       char save = '\0';
 571       if (q)
 572         {
 573           save = *q;
 574           *q = '\0';
 575         }
 576       Tcl_DStringAppendElement (&cmd, p);
 577       if (q)
 578         *q = save;
 579       p = q + 1;
 580     }
 581   Tcl_DStringAppendElement (&cmd, cmdblk->name);
 582   Tcl_DStringEndSublist (&cmd);
 583
 584   switch (cmdblk->var_type)
 585     {
 586     case var_string_noescape:
 587     case var_filename:
 588     case var_enum:
 589     case var_string:
 590       Tcl_DStringAppendElement (&cmd, (*(char **) cmdblk->var
 591                                        ? *(char **) cmdblk->var
 592                                        : "(null)"));
 593       break;
 594
 595     case var_boolean:
 596       Tcl_DStringAppendElement (&cmd, (*(int *) cmdblk->var ? "1" : "0"));
 597       break;
 598
 599     case var_uinteger:
 600     case var_zinteger:
 601       xasprintf (&buffer, "%u", *(unsigned int *) cmdblk->var);
 602       Tcl_DStringAppendElement (&cmd, buffer);
 603       break;
 604
 605     case var_integer:
 606       xasprintf (&buffer, "%d", *(int *) cmdblk->var);
 607       Tcl_DStringAppendElement (&cmd, buffer);
 608       break;
 609
 610     default:
 611       /* This case should already be trapped by the hook caller.  */
 612       Tcl_DStringAppendElement (&cmd, "error");
 613       break;
 614     }
 615
 616   if (Tcl_Eval (gdbtk_interp, Tcl_DStringValue (&cmd)) != TCL_OK)
 617     report_error ();
 618
 619   Tcl_DStringFree (&cmd);
 620
 621   if (buffer != NULL)
 622     {
 623       free(buffer);
 624     }
 625 }
 626
 627 int
 628 gdbtk_load_hash (const char *section, unsigned long num)
 629 {
 630   char *buf;
 631   xasprintf (&buf, "Download::download_hash %s %ld", section, num);
 632   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 633     report_error ();
 634   free(buf);
 635
 636   return atoi (gdbtk_interp->result);
 637 }
 638
 639
 640 /* This hook is called whenever we are ready to load a symbol file so that
 641    the UI can notify the user... */
 642 static void
 643 gdbtk_pre_add_symbol (const char *name)
 644 {
 645   gdbtk_two_elem_cmd ("gdbtk_tcl_pre_add_symbol", (char *) name);
 646 }
 647
 648 /* This hook is called whenever we finish loading a symbol file. */
 649 static void
 650 gdbtk_post_add_symbol ()
 651 {
 652   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol") != TCL_OK)
 653     report_error ();
 654 }
 655
 656 /* This hook function is called whenever we want to wait for the
 657    target.  */
 658
 659 static ptid_t
 660 gdbtk_wait (ptid_t ptid, struct target_waitstatus *ourstatus)
 661 {
 662   gdbtk_force_detach = 0;
 663   gdbtk_start_timer ();
 664   ptid = target_wait (ptid, ourstatus);
 665   gdbtk_stop_timer ();
 666   gdbtk_ptid = ptid;
 667
 668   return ptid;
 669 }
 670
 671 /*
 672  * This handles all queries from gdb.
 673  * The first argument is a printf style format statement, the rest are its
 674  * arguments.  The resultant formatted string is passed to the Tcl function
 675  * "gdbtk_tcl_query".
 676  * It returns the users response to the query, as well as putting the value
 677  * in the result field of the Tcl interpreter.
 678  */
 679
 680 static int
 681 gdbtk_query (const char *query, va_list args)
 682 {
 683   char *buf;
 684   long val;
 685
 686   xvasprintf (&buf, query, args);
 687   gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
 688   free(buf);
 689
 690   val = atol (gdbtk_interp->result);
 691   return val;
 692 }
 693
 694
 695 static void
 696 gdbtk_print_frame_info (struct symtab *s, int line,
 697                         int stopline, int noerror)
 698 {
 699 }
 700
 701 /*
 702  * gdbtk_trace_find
 703  *
 704  * This is run by the trace_find_command.  arg is the argument that was passed
 705  * to that command, from_tty is 1 if the command was run from a tty, 0 if it
 706  * was run from a script.  It runs gdbtk_tcl_tfind_hook passing on these two
 707  * arguments.
 708  *
 709  */
 710
 711 static void
 712 gdbtk_trace_find (char *arg, int from_tty)
 713 {
 714   Tcl_Obj *cmdObj;
 715
 716   cmdObj = Tcl_NewListObj (0, NULL);
 717   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj,
 718                             Tcl_NewStringObj ("gdbtk_tcl_trace_find_hook", -1));
 719   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewStringObj (arg, -1));
 720   Tcl_ListObjAppendElement (gdbtk_interp, cmdObj, Tcl_NewIntObj (from_tty));
 721 #if TCL_MAJOR_VERSION == 8 && (TCL_MINOR_VERSION < 1 || TCL_MINOR_VERSION > 2)
 722   if (Tcl_GlobalEvalObj (gdbtk_interp, cmdObj) != TCL_OK)
 723     report_error ();
 724 #else
 725   if (Tcl_EvalObj (gdbtk_interp, cmdObj, TCL_EVAL_GLOBAL) != TCL_OK)
 726     report_error ();
 727 #endif
 728 }
 729
 730 /*
 731  * gdbtk_trace_start_stop
 732  *
 733  * This is run by the trace_start_command and trace_stop_command.
 734  * The START variable determines which, 1 meaning trace_start was run,
 735  * 0 meaning trace_stop was run.
 736  *
 737  */
 738
 739 static void
 740 gdbtk_trace_start_stop (int start, int from_tty)
 741 {
 742
 743   if (start)
 744     Tcl_GlobalEval (gdbtk_interp, "gdbtk_tcl_tstart");
 745   else
 746     Tcl_GlobalEval (gdbtk_interp, "gdbtk_tcl_tstop");
 747
 748 }
 749
 750 static void
 751 gdbtk_selected_frame_changed (int level)
 752 {
 753 #if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION < 1
 754   char *a;
 755   xasprintf (&a, "%d", level);
 756   Tcl_SetVar (gdbtk_interp, "gdb_selected_frame_level", a, TCL_GLOBAL_ONLY);
 757   xfree (a);
 758 #else
 759   Tcl_SetVar2Ex (gdbtk_interp, "gdb_selected_frame_level", NULL,
 760                  Tcl_NewIntObj (level), TCL_GLOBAL_ONLY);
 761 #endif
 762 }
 763
 764 /* Called when the current thread changes. */
 765 /* gdb_context is linked to the tcl variable "gdb_context_id" */
 766 static void
 767 gdbtk_context_change (int num)
 768 {
 769   gdb_context = num;
 770 }
 771
 772 /* Called from file_command */
 773 static void
 774 gdbtk_file_changed (char *filename)
 775 {
 776   gdbtk_two_elem_cmd ("gdbtk_tcl_file_changed", filename);
 777 }
 778
 779 /* Called from exec_file_command */
 780 static void
 781 gdbtk_exec_file_display (char *filename)
 782 {
 783   gdbtk_two_elem_cmd ("gdbtk_tcl_exec_file_display", filename);
 784 }
 785
 786 /* Called from error_begin, this hook is used to warn the gui
 787    about multi-line error messages */
 788 static void
 789 gdbtk_error_begin ()
 790 {
 791   if (result_ptr != NULL)
 792     result_ptr->flags |= GDBTK_ERROR_ONLY;
 793 }
 794 \f
 795 /* notify GDBtk when a signal occurs */
 796 static void
 797 gdbtk_annotate_signal ()
 798 {
 799   char *buf;
 800
 801   /* Inform gui that the target has stopped. This is
 802      a necessary stop button evil. We don't want signal notification
 803      to interfere with the elaborate and painful stop button detach
 804      timeout. */
 805   Tcl_Eval (gdbtk_interp, "gdbtk_stop_idle_callback");
 806
 807   xasprintf (&buf, "gdbtk_signal %s {%s}", target_signal_to_name (stop_signal),
 808              target_signal_to_string (stop_signal));
 809   if (Tcl_Eval (gdbtk_interp, buf) != TCL_OK)
 810     report_error ();
 811   free(buf);
 812 }
 813
 814 static void
 815 gdbtk_attach ()
 816 {
 817   if (Tcl_Eval (gdbtk_interp, "after idle \"update idletasks;gdbtk_attached\"") != TCL_OK)
 818     {
 819       report_error ();
 820     }
 821 }
 822
 823 static void
 824 gdbtk_detach ()
 825 {
 826   if (Tcl_Eval (gdbtk_interp, "gdbtk_detached") != TCL_OK)
 827     {
 828       report_error ();
 829     }
 830 }
 831
 832 /* Called from gdbarch_update_p whenever the architecture changes. */
 833 static void
 834 gdbtk_architecture_changed (struct gdbarch *ignore)
 835 {
 836   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_architecture_changed");
 837 }
 838
 839 ptid_t
 840 gdbtk_get_ptid (void)
 841 {
 842   return gdbtk_ptid;
 843 }