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 #ifdef IDE
  48 /* start-sanitize-ide */
  49 #include "event.h"
  50 #include "idetcl.h"
  51 #include "ilutk.h"
  52 /* end-sanitize-ide */
  53 #endif
  54
  55 #ifdef ANSI_PROTOTYPES
  56 #include <stdarg.h>
  57 #else
  58 #include <varargs.h>
  59 #endif
  60 #include <signal.h>
  61 #include <fcntl.h>
  62 #include <unistd.h>
  63 #include <setjmp.h>
  64 #include "top.h"
  65 #include <sys/ioctl.h>
  66 #include "gdb_string.h"
  67 #include "dis-asm.h"
  68 #include <stdio.h>
  69 #include "gdbcmd.h"
  70
  71 #include "annotate.h"
  72 #include <sys/time.h>
  73
  74 int in_fputs = 0;
  75
  76 extern int  (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
  77 extern void (*pre_add_symbol_hook) PARAMS ((char *));
  78 extern void (*post_add_symbol_hook) PARAMS ((void));
  79 extern void (*selected_frame_level_changed_hook) PARAMS ((int));
  80
  81 #ifdef __CYGWIN32__
  82 extern void (*ui_loop_hook) PARAMS ((int));
  83 #endif
  84
  85 static void   gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
  86 static void   gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
  87 static void   gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
  88 static void   gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
  89 static void   gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
  90 static void   gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
  91 static void   tk_command_loop PARAMS ((void));
  92 static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
  93 static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
  94        void   x_event PARAMS ((int));
  95 static int    gdbtk_query PARAMS ((const char *, va_list));
  96 static void   gdbtk_warning PARAMS ((const char *, va_list));
  97 void   gdbtk_ignorable_warning PARAMS ((const char *));
  98 static char*  gdbtk_readline PARAMS ((char *));
  99 static void
 100 #ifdef ANSI_PROTOTYPES
 101 gdbtk_readline_begin (char *format, ...);
 102 #else
 103 gdbtk_readline_begin ();
 104 #endif
 105 static void gdbtk_readline_end PARAMS ((void));
 106 static void   gdbtk_flush PARAMS ((FILE *));
 107 static void gdbtk_pre_add_symbol PARAMS ((char *));
 108 static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
 109 static void gdbtk_post_add_symbol PARAMS ((void));
 110 static void pc_changed PARAMS ((void));
 111 static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
 112 static void gdbtk_selected_frame_changed PARAMS ((int));
 113 static void gdbtk_context_change PARAMS ((int));
 114 void (*context_hook) PARAMS ((int));
 115
 116 /*
 117  * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
 118  * See note there for details.
 119  */
 120
 121 void   gdbtk_fputs PARAMS ((const char *, FILE *));
 122 int           gdbtk_load_hash PARAMS ((char *, unsigned long));
 123 static void   breakpoint_notify PARAMS ((struct breakpoint *, const char *));
 124
 125 /*
 126  * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
 127  * startup code to fill in the hooks needed by core gdb.
 128  */
 129
 130 void
 131 gdbtk_add_hooks(void)
 132 {
 133   command_loop_hook = tk_command_loop;
 134   call_command_hook = gdbtk_call_command;
 135   readline_begin_hook = gdbtk_readline_begin;
 136   readline_hook = gdbtk_readline;
 137   readline_end_hook = gdbtk_readline_end;
 138
 139   print_frame_info_listing_hook = gdbtk_print_frame_info;
 140   query_hook = gdbtk_query;
 141   warning_hook = gdbtk_warning;
 142   flush_hook = gdbtk_flush;
 143
 144   create_breakpoint_hook = gdbtk_create_breakpoint;
 145   delete_breakpoint_hook = gdbtk_delete_breakpoint;
 146   modify_breakpoint_hook = gdbtk_modify_breakpoint;
 147
 148   interactive_hook = gdbtk_interactive;
 149   target_wait_hook = gdbtk_wait;
 150   ui_load_progress_hook = gdbtk_load_hash;
 151 #ifdef __CYGWIN32__
 152   ui_loop_hook = x_event;
 153 #endif
 154   pre_add_symbol_hook   = gdbtk_pre_add_symbol;
 155   post_add_symbol_hook  = gdbtk_post_add_symbol;
 156
 157   create_tracepoint_hook = gdbtk_create_tracepoint;
 158   delete_tracepoint_hook = gdbtk_delete_tracepoint;
 159   modify_tracepoint_hook = gdbtk_modify_tracepoint;
 160   pc_changed_hook = pc_changed;
 161   selected_frame_level_changed_hook = gdbtk_selected_frame_changed;
 162   context_hook = gdbtk_context_change;
 163 }
 164
 165 /* These control where to put the gdb output which is created by
 166    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
 167    lowest level of these routines and capture all output from the rest of GDB.
 168
 169    The reason to use the result_ptr rather than the gdbtk_interp's result
 170    directly is so that a call_wrapper invoked function can preserve its result
 171    across calls into Tcl which might be made in the course of the function's
 172    execution.
 173
 174    * result_ptr->obj_ptr is where to accumulate the result.
 175    * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
 176      instead of to the result_ptr.
 177    * GDBTK_MAKES_LIST flag means add to the result as a list element.
 178
 179    */
 180
 181 gdbtk_result *result_ptr = NULL;
 182 \f
 183
 184 /* This allows you to Tcl_Eval a tcl command which takes
 185    a command word, and then a single argument. */
 186
 187 int gdbtk_two_elem_cmd (cmd_name, argv1)
 188     char *cmd_name;
 189     char * argv1;
 190 {
 191   char *command;
 192   int result, flags_ptr, arg_len, cmd_len;
 193
 194   arg_len = Tcl_ScanElement (argv1, &flags_ptr);
 195   cmd_len = strlen (cmd_name);
 196   command = malloc(arg_len + cmd_len + 2);
 197   strcpy (command, cmd_name);
 198   strcat (command, " ");
 199
 200   Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
 201
 202   result = Tcl_Eval (gdbtk_interp, command);
 203   free (command);
 204   return result;
 205
 206 }
 207
 208 static void
 209 gdbtk_flush (stream)
 210      FILE *stream;
 211 {
 212 #if 0
 213   /* Force immediate screen update */
 214
 215   Tcl_VarEval (gdbtk_interp, "gdbtk_tcl_flush", NULL);
 216 #endif
 217 }
 218
 219 /* This handles all the output from gdb.  All the gdb printf_xxx functions
 220  * eventually end up here.  The output is either passed to the result_ptr
 221  * where it will go to the result of some gdbtk command, or passed to the
 222  * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
 223  * window.
 224  *
 225  * The cases are:
 226  *
 227  * 1) result_ptr == NULL - This happens when some output comes from gdb which
 228  *    is not generated by a command in gdbtk-cmds, usually startup stuff.
 229  *    In this case we just route the data to gdbtk_tcl_fputs.
 230  * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
 231  *    We place the data into the result_ptr, either as a string,
 232  *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
 233  * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
 234  *    UNLESS it was coming to stderr.  Then we place it in the result_ptr
 235  *    anyway, so it can be dealt with.
 236  *
 237  */
 238
 239 void
 240 gdbtk_fputs (ptr, stream)
 241      const char *ptr;
 242      FILE *stream;
 243 {
 244   in_fputs = 1;
 245
 246   if (result_ptr != NULL)
 247     {
 248       if (result_ptr->flags & GDBTK_TO_RESULT)
 249         {
 250           if (result_ptr->flags & GDBTK_MAKES_LIST)
 251             Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr,
 252                                      Tcl_NewStringObj((char *) ptr, -1));
 253           else
 254             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 255         }
 256       else if (stream == gdb_stderr)
 257         {
 258           if (result_ptr->flags & GDBTK_ERROR_STARTED)
 259             Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
 260           else
 261             {
 262               Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
 263               result_ptr->flags |= GDBTK_ERROR_STARTED;
 264             }
 265         }
 266       else
 267         {
 268           gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 269           if (result_ptr->flags & GDBTK_MAKES_LIST)
 270               gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
 271         }
 272     }
 273   else
 274     {
 275       gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
 276     }
 277
 278   in_fputs = 0;
 279 }
 280
 281 /*
 282  * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
 283  */
 284
 285 static void
 286 gdbtk_warning (warning, args)
 287      const char *warning;
 288      va_list args;
 289 {
 290   char buf[200];
 291
 292   vsprintf (buf, warning, args);
 293   gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
 294
 295 }
 296
 297 /*
 298  * This routes all ignorable warnings to the Tcl function
 299  * "gdbtk_tcl_ignorable_warning".
 300  */
 301
 302 void
 303 gdbtk_ignorable_warning (warning)
 304      const char *warning;
 305 {
 306   char buf[512];
 307   sprintf (buf, warning);
 308   gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf);
 309 }
 310
 311 static void
 312 pc_changed()
 313 {
 314   Tcl_Eval (gdbtk_interp, "gdbtk_pc_changed");
 315 }
 316
 317 \f
 318 /* This function is called instead of gdb's internal command loop.  This is the
 319    last chance to do anything before entering the main Tk event loop.
 320    At the end of the command, we enter the main loop. */
 321
 322 static void
 323 tk_command_loop ()
 324 {
 325   extern GDB_FILE *instream;
 326
 327   /* We no longer want to use stdin as the command input stream */
 328   instream = NULL;
 329
 330   if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
 331     {
 332       char *msg;
 333
 334       /* Force errorInfo to be set up propertly.  */
 335       Tcl_AddErrorInfo (gdbtk_interp, "");
 336
 337       msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
 338 #ifdef _WIN32
 339       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
 340 #else
 341       fputs_unfiltered (msg, gdb_stderr);
 342 #endif
 343     }
 344
 345 #ifdef _WIN32
 346   close_bfds ();
 347 #endif
 348
 349   Tk_MainLoop ();
 350 }
 351
 352 /* Come here when there is activity on the X file descriptor. */
 353
 354 void
 355 x_event (signo)
 356      int signo;
 357 {
 358   static int in_x_event = 0;
 359   static Tcl_Obj *varname = NULL;
 360   if (in_x_event || in_fputs)
 361     return;
 362
 363   in_x_event = 1;
 364
 365 #ifdef __CYGWIN32__
 366   if (signo == -2)
 367     gdbtk_stop_timer ();
 368 #endif
 369
 370   /* Process pending events */
 371   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
 372     ;
 373
 374   if (load_in_progress)
 375     {
 376       int val;
 377       if (varname == NULL)
 378         {
 379           Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
 380           varname = Tcl_ObjGetVar2(gdbtk_interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
 381         }
 382       if ((Tcl_GetIntFromObj(gdbtk_interp,varname,&val) == TCL_OK) && val)
 383         {
 384           quit_flag = 1;
 385 #ifdef REQUEST_QUIT
 386           REQUEST_QUIT;
 387 #else
 388           if (immediate_quit)
 389             quit ();
 390 #endif
 391         }
 392     }
 393   in_x_event = 0;
 394 }
 395
 396 /* VARARGS */
 397 static void
 398 #ifdef ANSI_PROTOTYPES
 399 gdbtk_readline_begin (char *format, ...)
 400 #else
 401 gdbtk_readline_begin (va_alist)
 402      va_dcl
 403 #endif
 404 {
 405   va_list args;
 406   char buf[200];
 407
 408 #ifdef ANSI_PROTOTYPES
 409   va_start (args, format);
 410 #else
 411   char *format;
 412   va_start (args);
 413   format = va_arg (args, char *);
 414 #endif
 415
 416   vsprintf (buf, format, args);
 417   gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
 418
 419 }
 420
 421 static char *
 422 gdbtk_readline (prompt)
 423      char *prompt;
 424 {
 425   int result;
 426
 427 #ifdef _WIN32
 428   close_bfds ();
 429 #endif
 430
 431   result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
 432
 433   if (result == TCL_OK)
 434     {
 435       return (strdup (gdbtk_interp -> result));
 436     }
 437   else
 438     {
 439       gdbtk_fputs (gdbtk_interp -> result, gdb_stdout);
 440       gdbtk_fputs ("\n", gdb_stdout);
 441       return (NULL);
 442     }
 443 }
 444
 445 static void
 446 gdbtk_readline_end ()
 447 {
 448   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end");
 449 }
 450
 451 static void
 452 gdbtk_call_command (cmdblk, arg, from_tty)
 453      struct cmd_list_element *cmdblk;
 454      char *arg;
 455      int from_tty;
 456 {
 457   running_now = 0;
 458   if (cmdblk->class == class_run || cmdblk->class == class_trace)
 459     {
 460
 461       /* HACK! HACK! This is to get the gui to update the tstart/tstop
 462          button only incase of tstart/tstop commands issued from the console
 463          We don't want to update the src window, so we need to have specific
 464          procedures to do tstart and tstop
 465          Unfortunately this will not display errors from tstart or tstop in the
 466          console window itself, but as dialogs.*/
 467
 468       if (!strcmp(cmdblk->name, "tstart") && !No_Update)
 469         {
 470           Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstart");
 471           (*cmdblk->function.cfunc)(arg, from_tty);
 472         }
 473       else if (!strcmp(cmdblk->name, "tstop") && !No_Update)
 474         {
 475           Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstop");
 476           (*cmdblk->function.cfunc)(arg, from_tty);
 477         }
 478       /* end of hack */
 479       else
 480         {
 481           running_now = 1;
 482           if (!No_Update)
 483             Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
 484           (*cmdblk->function.cfunc)(arg, from_tty);
 485           running_now = 0;
 486           if (!No_Update)
 487             Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
 488         }
 489     }
 490   else
 491     (*cmdblk->function.cfunc)(arg, from_tty);
 492 }
 493
 494 /* The next three functions use breakpoint_notify to allow the GUI
 495  * to handle creating, deleting and modifying breakpoints.  These three
 496  * functions are put into the appropriate gdb hooks in gdbtk_init.
 497  */
 498
 499 static void
 500 gdbtk_create_breakpoint(b)
 501      struct breakpoint *b;
 502 {
 503   breakpoint_notify (b, "create");
 504 }
 505
 506 static void
 507 gdbtk_delete_breakpoint(b)
 508      struct breakpoint *b;
 509 {
 510   breakpoint_notify (b, "delete");
 511 }
 512
 513 static void
 514 gdbtk_modify_breakpoint(b)
 515      struct breakpoint *b;
 516 {
 517   breakpoint_notify (b, "modify");
 518 }
 519
 520 /* This is the generic function for handling changes in
 521  * a breakpoint.  It routes the information to the Tcl
 522  * command "gdbtk_tcl_breakpoint" in the form:
 523  *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
 524  * On error, the error string is written to gdb_stdout.
 525  */
 526
 527 static void
 528 breakpoint_notify(b, action)
 529      struct breakpoint *b;
 530      const char *action;
 531 {
 532   char buf[256];
 533   int v;
 534   struct symtab_and_line sal;
 535   char *filename;
 536
 537   if (b->type != bp_breakpoint)
 538     return;
 539
 540   /* We ensure that ACTION contains no special Tcl characters, so we
 541      can do this.  */
 542   sal = find_pc_line (b->address, 0);
 543   filename = symtab_to_filename (sal.symtab);
 544   if (filename == NULL)
 545     filename = "";
 546
 547   sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number,
 548            (long)b->address, b->line_number, filename);
 549
 550   v = Tcl_Eval (gdbtk_interp, buf);
 551
 552   if (v != TCL_OK)
 553     {
 554       gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp), gdb_stdout);
 555       gdbtk_fputs ("\n", gdb_stdout);
 556     }
 557 }
 558
 559 int
 560 gdbtk_load_hash (section, num)
 561      char *section;
 562      unsigned long num;
 563 {
 564   char buf[128];
 565   sprintf (buf, "download_hash %s %ld", section, num);
 566   Tcl_Eval (gdbtk_interp, buf);
 567   return  atoi (gdbtk_interp->result);
 568 }
 569
 570
 571 /* This hook is called whenever we are ready to load a symbol file so that
 572    the UI can notify the user... */
 573 static void
 574 gdbtk_pre_add_symbol (name)
 575   char *name;
 576 {
 577
 578   gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name);
 579
 580 }
 581
 582 /* This hook is called whenever we finish loading a symbol file. */
 583 static void
 584 gdbtk_post_add_symbol ()
 585 {
 586   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol");
 587 }
 588
 589 /* This hook function is called whenever we want to wait for the
 590    target.  */
 591
 592 static int
 593 gdbtk_wait (pid, ourstatus)
 594      int pid;
 595      struct target_waitstatus *ourstatus;
 596 {
 597   gdbtk_start_timer ();
 598   pid = target_wait (pid, ourstatus);
 599   gdbtk_stop_timer ();
 600   return pid;
 601 }
 602
 603 /*
 604  * This handles all queries from gdb.
 605  * The first argument is a printf style format statement, the rest are its
 606  * arguments.  The resultant formatted string is passed to the Tcl function
 607  * "gdbtk_tcl_query".
 608  * It returns the users response to the query, as well as putting the value
 609  * in the result field of the Tcl interpreter.
 610  */
 611
 612 static int
 613 gdbtk_query (query, args)
 614      const char *query;
 615      va_list args;
 616 {
 617   char buf[200];
 618   long val;
 619
 620   vsprintf (buf, query, args);
 621   gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
 622
 623   val = atol (gdbtk_interp->result);
 624   return val;
 625 }
 626
 627
 628 static void
 629 gdbtk_print_frame_info (s, line, stopline, noerror)
 630   struct symtab *s;
 631   int line;
 632   int stopline;
 633   int noerror;
 634 {
 635   current_source_symtab = s;
 636   current_source_line = line;
 637 }
 638
 639 static void
 640 gdbtk_create_tracepoint (tp)
 641   struct tracepoint *tp;
 642 {
 643   tracepoint_notify (tp, "create");
 644 }
 645
 646 static void
 647 gdbtk_delete_tracepoint (tp)
 648   struct tracepoint *tp;
 649 {
 650   tracepoint_notify (tp, "delete");
 651 }
 652
 653 static void
 654 gdbtk_modify_tracepoint (tp)
 655   struct tracepoint *tp;
 656 {
 657   tracepoint_notify (tp, "modify");
 658 }
 659
 660 static void
 661 tracepoint_notify(tp, action)
 662      struct tracepoint *tp;
 663      const char *action;
 664 {
 665   char buf[256];
 666   int v;
 667   struct symtab_and_line sal;
 668   char *filename;
 669
 670   /* We ensure that ACTION contains no special Tcl characters, so we
 671      can do this.  */
 672   sal = find_pc_line (tp->address, 0);
 673
 674   filename = symtab_to_filename (sal.symtab);
 675   if (filename == NULL)
 676     filename = "N/A";
 677   sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s} %d", action, tp->number,
 678            (long)tp->address, sal.line, filename, tp->pass_count);
 679
 680   v = Tcl_Eval (gdbtk_interp, buf);
 681
 682   if (v != TCL_OK)
 683     {
 684       gdbtk_fputs (gdbtk_interp->result, gdb_stdout);
 685       gdbtk_fputs ("\n", gdb_stdout);
 686     }
 687 }
 688
 689 static void
 690 gdbtk_selected_frame_changed (level)
 691      int level;
 692 {
 693   Tcl_UpdateLinkedVar (gdbtk_interp, "gdb_selected_frame_level");
 694 }
 695
 696 /* Called when the current thread changes. */
 697 /* gdb_context is linked to the tcl variable "gdb_context_id" */
 698 static void
 699 gdbtk_context_change (num)
 700      int num;
 701 {
 702   gdb_context = num;
 703 }