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