gdb/gdbtk.c

   1 /* Tcl/Tk interface routines.
   2    Copyright 1994, 1995, 1996, 1997 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 <tcl.h>
  31 #include <tk.h>
  32 #include <itcl.h>
  33 #include <tix.h>
  34
  35 #ifdef IDE
  36 #include "event.h"
  37 #include "idetcl.h"
  38 #endif
  39
  40 #ifdef ANSI_PROTOTYPES
  41 #include <stdarg.h>
  42 #else
  43 #include <varargs.h>
  44 #endif
  45 #include <signal.h>
  46 #include <fcntl.h>
  47 #include <unistd.h>
  48 #include <setjmp.h>
  49 #include "top.h"
  50 #include <sys/ioctl.h>
  51 #include "gdb_string.h"
  52 #include "dis-asm.h"
  53 #include <stdio.h>
  54 #include "gdbcmd.h"
  55
  56 #ifndef WINNT
  57 #ifndef FIOASYNC
  58 #include <sys/stropts.h>
  59 #endif
  60 #endif
  61
  62 #ifdef WINNT
  63 #define GDBTK_PATH_SEP ";"
  64 #else
  65 #define GDBTK_PATH_SEP ":"
  66 #endif
  67
  68 /* Some versions (1.3.79, 1.3.81) of Linux don't support SIOCSPGRP the way
  69    gdbtk wants to use it... */
  70 #ifdef __linux__
  71 #undef SIOCSPGRP
  72 #endif
  73
  74 static void null_routine PARAMS ((int));
  75 static void gdbtk_flush PARAMS ((FILE *));
  76 static void gdbtk_fputs PARAMS ((const char *, FILE *));
  77 static int gdbtk_query PARAMS ((const char *, va_list));
  78 static char *gdbtk_readline PARAMS ((char *));
  79 static void gdbtk_init PARAMS ((char *));
  80 static void tk_command_loop PARAMS ((void));
  81 static void gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
  82 static int gdbtk_wait PARAMS ((int, struct target_waitstatus *));
  83 static void x_event PARAMS ((int));
  84 static void gdbtk_interactive PARAMS ((void));
  85 static void cleanup_init PARAMS ((int));
  86 static void tk_command PARAMS ((char *, int));
  87 static int gdb_disassemble PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  88 static int compare_lines PARAMS ((const PTR, const PTR));
  89 static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
  90 static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  91 static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  92 static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  93 static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  94 static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
  95 static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  96 static void gdbtk_readline_end PARAMS ((void));
  97 static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
  98 static void register_changed_p PARAMS ((int, void *));
  99 static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 100 static int gdb_get_breakpoint_info PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 101 static void breakpoint_notify PARAMS ((struct breakpoint *, const char *));
 102 static void gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
 103 static void gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
 104 static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
 105 static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 106 static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 107 static int gdb_sourcelines PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 108 static int map_arg_registers PARAMS ((int, char *[], void (*) (int, void *), void *));
 109 static void get_register_name PARAMS ((int, void *));
 110 static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 111 static void get_register PARAMS ((int, void *));
 112
 113 /* Handle for TCL interpreter */
 114
 115 static Tcl_Interp *interp = NULL;
 116
 117 static int x_fd;                /* X network socket */
 118
 119 /* This variable is true when the inferior is running.  Although it's
 120    possible to disable most input from widgets and thus prevent
 121    attempts to do anything while the inferior is running, any commands
 122    that get through - even a simple memory read - are Very Bad, and
 123    may cause GDB to crash or behave strangely.  So, this variable
 124    provides an extra layer of defense.  */
 125
 126 static int running_now;
 127
 128 /* This variable determines where memory used for disassembly is read from.
 129    If > 0, then disassembly comes from the exec file rather than the
 130    target (which might be at the other end of a slow serial link).  If
 131    == 0 then disassembly comes from target.  If < 0 disassembly is
 132    automatically switched to the target if it's an inferior process,
 133    otherwise the exec file is used.  */
 134
 135 static int disassemble_from_exec = -1;
 136
 137 #ifndef _WIN32
 138
 139 /* Supply malloc calls for tcl/tk.  We do not want to do this on
 140    Windows, because Tcl_Alloc is probably in a DLL which will not call
 141    the mmalloc routines.  */
 142
 143 char *
 144 Tcl_Alloc (size)
 145      unsigned int size;
 146 {
 147   return xmalloc (size);
 148 }
 149
 150 char *
 151 Tcl_Realloc (ptr, size)
 152      char *ptr;
 153      unsigned int size;
 154 {
 155   return xrealloc (ptr, size);
 156 }
 157
 158 void
 159 Tcl_Free(ptr)
 160      char *ptr;
 161 {
 162   free (ptr);
 163 }
 164
 165 #endif /* _WIN32 */
 166
 167 static void
 168 null_routine(arg)
 169      int arg;
 170 {
 171 }
 172
 173 /* The following routines deal with stdout/stderr data, which is created by
 174    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
 175    lowest level of these routines and capture all output from the rest of GDB.
 176    Normally they present their data to tcl via callbacks to the following tcl
 177    routines:  gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush.  These
 178    in turn call tk routines to update the display.
 179
 180    Under some circumstances, you may want to collect the output so that it can
 181    be returned as the value of a tcl procedure.  This can be done by
 182    surrounding the output routines with calls to start_saving_output and
 183    finish_saving_output.  The saved data can then be retrieved with
 184    get_saved_output (but this must be done before the call to
 185    finish_saving_output).  */
 186
 187 /* Dynamic string header for stdout. */
 188
 189 static Tcl_DString *result_ptr;
 190 \f
 191 static void
 192 gdbtk_flush (stream)
 193      FILE *stream;
 194 {
 195 #if 0
 196   /* Force immediate screen update */
 197
 198   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
 199 #endif
 200 }
 201
 202 static void
 203 gdbtk_fputs (ptr, stream)
 204      const char *ptr;
 205      FILE *stream;
 206 {
 207   if (result_ptr)
 208     Tcl_DStringAppend (result_ptr, (char *)ptr, -1);
 209   else
 210     {
 211       Tcl_DString str;
 212
 213       Tcl_DStringInit (&str);
 214
 215       Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
 216       Tcl_DStringAppendElement (&str, (char *)ptr);
 217
 218       Tcl_Eval (interp, Tcl_DStringValue (&str));
 219       Tcl_DStringFree (&str);
 220     }
 221 }
 222
 223 static int
 224 gdbtk_query (query, args)
 225      const char *query;
 226      va_list args;
 227 {
 228   char buf[200], *merge[2];
 229   char *command;
 230   long val;
 231
 232   vsprintf (buf, query, args);
 233   merge[0] = "gdbtk_tcl_query";
 234   merge[1] = buf;
 235   command = Tcl_Merge (2, merge);
 236   Tcl_Eval (interp, command);
 237   free (command);
 238
 239   val = atol (interp->result);
 240   return val;
 241 }
 242
 243 /* VARARGS */
 244 static void
 245 #ifdef ANSI_PROTOTYPES
 246 gdbtk_readline_begin (char *format, ...)
 247 #else
 248 gdbtk_readline_begin (va_alist)
 249      va_dcl
 250 #endif
 251 {
 252   va_list args;
 253   char buf[200], *merge[2];
 254   char *command;
 255
 256 #ifdef ANSI_PROTOTYPES
 257   va_start (args, format);
 258 #else
 259   char *format;
 260   va_start (args);
 261   format = va_arg (args, char *);
 262 #endif
 263
 264   vsprintf (buf, format, args);
 265   merge[0] = "gdbtk_tcl_readline_begin";
 266   merge[1] = buf;
 267   command = Tcl_Merge (2, merge);
 268   Tcl_Eval (interp, command);
 269   free (command);
 270 }
 271
 272 static char *
 273 gdbtk_readline (prompt)
 274      char *prompt;
 275 {
 276   char *merge[2];
 277   char *command;
 278   int result;
 279
 280   merge[0] = "gdbtk_tcl_readline";
 281   merge[1] = prompt;
 282   command = Tcl_Merge (2, merge);
 283   result = Tcl_Eval (interp, command);
 284   free (command);
 285   if (result == TCL_OK)
 286     {
 287       return (strdup (interp -> result));
 288     }
 289   else
 290     {
 291       gdbtk_fputs (interp -> result, gdb_stdout);
 292       gdbtk_fputs ("\n", gdb_stdout);
 293       return (NULL);
 294     }
 295 }
 296
 297 static void
 298 gdbtk_readline_end ()
 299 {
 300   Tcl_Eval (interp, "gdbtk_tcl_readline_end");
 301 }
 302
 303 \f
 304 static void
 305 #ifdef ANSI_PROTOTYPES
 306 dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
 307 #else
 308 dsprintf_append_element (va_alist)
 309      va_dcl
 310 #endif
 311 {
 312   va_list args;
 313   char buf[1024];
 314
 315 #ifdef ANSI_PROTOTYPES
 316   va_start (args, format);
 317 #else
 318   Tcl_DString *dsp;
 319   char *format;
 320
 321   va_start (args);
 322   dsp = va_arg (args, Tcl_DString *);
 323   format = va_arg (args, char *);
 324 #endif
 325
 326   vsprintf (buf, format, args);
 327
 328   Tcl_DStringAppendElement (dsp, buf);
 329 }
 330
 331 static int
 332 gdb_path_conv (clientData, interp, argc, argv)
 333      ClientData clientData;
 334      Tcl_Interp *interp;
 335      int argc;
 336      char *argv[];
 337 {
 338 #ifdef WINNT
 339   char pathname[256], *ptr;
 340   if (argc != 2)
 341     error ("wrong # args");
 342   cygwin32_conv_to_full_win32_path (argv[1], pathname);
 343   for (ptr = pathname; *ptr; ptr++)
 344     {
 345       if (*ptr == '\\')
 346         *ptr = '/';
 347     }
 348 #else
 349   char *pathname = argv[1];
 350 #endif
 351   Tcl_DStringAppend (result_ptr, pathname, strlen(pathname));
 352   return TCL_OK;
 353 }
 354
 355 static int
 356 gdb_get_breakpoint_list (clientData, interp, argc, argv)
 357      ClientData clientData;
 358      Tcl_Interp *interp;
 359      int argc;
 360      char *argv[];
 361 {
 362   struct breakpoint *b;
 363   extern struct breakpoint *breakpoint_chain;
 364
 365   if (argc != 1)
 366     error ("wrong # args");
 367
 368   for (b = breakpoint_chain; b; b = b->next)
 369     if (b->type == bp_breakpoint)
 370       dsprintf_append_element (result_ptr, "%d", b->number);
 371
 372   return TCL_OK;
 373 }
 374
 375 static int
 376 gdb_get_breakpoint_info (clientData, interp, argc, argv)
 377      ClientData clientData;
 378      Tcl_Interp *interp;
 379      int argc;
 380      char *argv[];
 381 {
 382   struct symtab_and_line sal;
 383   static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
 384                               "finish", "watchpoint", "hardware watchpoint",
 385                               "read watchpoint", "access watchpoint",
 386                               "longjmp", "longjmp resume", "step resume",
 387                               "through sigtramp", "watchpoint scope",
 388                               "call dummy" };
 389   static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
 390   struct command_line *cmd;
 391   int bpnum;
 392   struct breakpoint *b;
 393   extern struct breakpoint *breakpoint_chain;
 394
 395   if (argc != 2)
 396     error ("wrong # args");
 397
 398   bpnum = atoi (argv[1]);
 399
 400   for (b = breakpoint_chain; b; b = b->next)
 401     if (b->number == bpnum)
 402       break;
 403
 404   if (!b || b->type != bp_breakpoint)
 405     error ("Breakpoint #%d does not exist", bpnum);
 406
 407   sal = find_pc_line (b->address, 0);
 408
 409   Tcl_DStringAppendElement (result_ptr, symtab_to_filename (sal.symtab));
 410   dsprintf_append_element (result_ptr, "%d", sal.line);
 411   dsprintf_append_element (result_ptr, "0x%lx", b->address);
 412   Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
 413   Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
 414   Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
 415   dsprintf_append_element (result_ptr, "%d", b->silent);
 416   dsprintf_append_element (result_ptr, "%d", b->ignore_count);
 417
 418   Tcl_DStringStartSublist (result_ptr);
 419   for (cmd = b->commands; cmd; cmd = cmd->next)
 420     Tcl_DStringAppendElement (result_ptr, cmd->line);
 421   Tcl_DStringEndSublist (result_ptr);
 422
 423   Tcl_DStringAppendElement (result_ptr, b->cond_string);
 424
 425   dsprintf_append_element (result_ptr, "%d", b->thread);
 426   dsprintf_append_element (result_ptr, "%d", b->hit_count);
 427
 428   return TCL_OK;
 429 }
 430
 431 static void
 432 breakpoint_notify(b, action)
 433      struct breakpoint *b;
 434      const char *action;
 435 {
 436   char buf[100];
 437   int v;
 438   struct symtab_and_line sal;
 439
 440   if (b->type != bp_breakpoint)
 441     return;
 442
 443   /* We ensure that ACTION contains no special Tcl characters, so we
 444      can do this.  */
 445   sal = find_pc_line (b->address, 0);
 446   sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number,
 447            (long)b->address, sal.line, symtab_to_filename (sal.symtab));
 448
 449   v = Tcl_Eval (interp, buf);
 450
 451   if (v != TCL_OK)
 452     {
 453       gdbtk_fputs (interp->result, gdb_stdout);
 454       gdbtk_fputs ("\n", gdb_stdout);
 455     }
 456 }
 457
 458 static void
 459 gdbtk_create_breakpoint(b)
 460      struct breakpoint *b;
 461 {
 462   breakpoint_notify (b, "create");
 463 }
 464
 465 static void
 466 gdbtk_delete_breakpoint(b)
 467      struct breakpoint *b;
 468 {
 469   breakpoint_notify (b, "delete");
 470 }
 471
 472 static void
 473 gdbtk_modify_breakpoint(b)
 474      struct breakpoint *b;
 475 {
 476   breakpoint_notify (b, "modify");
 477 }
 478 \f
 479 /* This implements the TCL command `gdb_loc', which returns a list consisting
 480    of the source and line number associated with the current pc. */
 481
 482 static int
 483 gdb_loc (clientData, interp, argc, argv)
 484      ClientData clientData;
 485      Tcl_Interp *interp;
 486      int argc;
 487      char *argv[];
 488 {
 489   char *filename;
 490   struct symtab_and_line sal;
 491   char *funcname;
 492   CORE_ADDR pc;
 493
 494   if (argc == 1)
 495     {
 496       pc = selected_frame ? selected_frame->pc : stop_pc;
 497       sal = find_pc_line (pc, 0);
 498     }
 499   else if (argc == 2)
 500     {
 501       struct symtabs_and_lines sals;
 502       int nelts;
 503
 504       sals = decode_line_spec (argv[1], 1);
 505
 506       nelts = sals.nelts;
 507       sal = sals.sals[0];
 508       free (sals.sals);
 509
 510       if (sals.nelts != 1)
 511         error ("Ambiguous line spec");
 512
 513       pc = sal.pc;
 514     }
 515   else
 516     error ("wrong # args");
 517
 518   if (sal.symtab)
 519     Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
 520   else
 521     Tcl_DStringAppendElement (result_ptr, "");
 522
 523   find_pc_partial_function (pc, &funcname, NULL, NULL);
 524   Tcl_DStringAppendElement (result_ptr, funcname);
 525
 526   filename = symtab_to_filename (sal.symtab);
 527   Tcl_DStringAppendElement (result_ptr, filename);
 528
 529   dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
 530
 531   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
 532
 533   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
 534
 535   return TCL_OK;
 536 }
 537 \f
 538 /* This implements the TCL command `gdb_eval'. */
 539
 540 static int
 541 gdb_eval (clientData, interp, argc, argv)
 542      ClientData clientData;
 543      Tcl_Interp *interp;
 544      int argc;
 545      char *argv[];
 546 {
 547   struct expression *expr;
 548   struct cleanup *old_chain;
 549   value_ptr val;
 550
 551   if (argc != 2)
 552     error ("wrong # args");
 553
 554   expr = parse_expression (argv[1]);
 555
 556   old_chain = make_cleanup (free_current_contents, &expr);
 557
 558   val = evaluate_expression (expr);
 559
 560   val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
 561              gdb_stdout, 0, 0, 0, 0);
 562
 563   do_cleanups (old_chain);
 564
 565   return TCL_OK;
 566 }
 567 \f
 568 /* This implements the TCL command `gdb_sourcelines', which returns a list of
 569    all of the lines containing executable code for the specified source file
 570    (ie: lines where you can put breakpoints). */
 571
 572 static int
 573 gdb_sourcelines (clientData, interp, argc, argv)
 574      ClientData clientData;
 575      Tcl_Interp *interp;
 576      int argc;
 577      char *argv[];
 578 {
 579   struct symtab *symtab;
 580   struct linetable_entry *le;
 581   int nlines;
 582
 583   if (argc != 2)
 584     error ("wrong # args");
 585
 586   symtab = lookup_symtab (argv[1]);
 587
 588   if (!symtab)
 589     error ("No such file");
 590
 591   /* If there's no linetable, or no entries, then we are done. */
 592
 593   if (!symtab->linetable
 594       || symtab->linetable->nitems == 0)
 595     {
 596       Tcl_DStringAppendElement (result_ptr, "");
 597       return TCL_OK;
 598     }
 599
 600   le = symtab->linetable->item;
 601   nlines = symtab->linetable->nitems;
 602
 603   for (;nlines > 0; nlines--, le++)
 604     {
 605       /* If the pc of this line is the same as the pc of the next line, then
 606          just skip it.  */
 607       if (nlines > 1
 608           && le->pc == (le + 1)->pc)
 609         continue;
 610
 611       dsprintf_append_element (result_ptr, "%d", le->line);
 612     }
 613
 614   return TCL_OK;
 615 }
 616 \f
 617 static int
 618 map_arg_registers (argc, argv, func, argp)
 619      int argc;
 620      char *argv[];
 621      void (*func) PARAMS ((int regnum, void *argp));
 622      void *argp;
 623 {
 624   int regnum;
 625
 626   /* Note that the test for a valid register must include checking the
 627      reg_names array because NUM_REGS may be allocated for the union of the
 628      register sets within a family of related processors.  In this case, the
 629      trailing entries of reg_names will change depending upon the particular
 630      processor being debugged.  */
 631
 632   if (argc == 0)                /* No args, just do all the regs */
 633     {
 634       for (regnum = 0;
 635            regnum < NUM_REGS
 636            && reg_names[regnum] != NULL
 637            && *reg_names[regnum] != '\000';
 638            regnum++)
 639         func (regnum, argp);
 640
 641       return TCL_OK;
 642     }
 643
 644   /* Else, list of register #s, just do listed regs */
 645   for (; argc > 0; argc--, argv++)
 646     {
 647       regnum = atoi (*argv);
 648
 649       if (regnum >= 0
 650           && regnum < NUM_REGS
 651           && reg_names[regnum] != NULL
 652           && *reg_names[regnum] != '\000')
 653         func (regnum, argp);
 654       else
 655         error ("bad register number");
 656     }
 657
 658   return TCL_OK;
 659 }
 660
 661 static void
 662 get_register_name (regnum, argp)
 663      int regnum;
 664      void *argp;                /* Ignored */
 665 {
 666   Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
 667 }
 668
 669 /* This implements the TCL command `gdb_regnames', which returns a list of
 670    all of the register names. */
 671
 672 static int
 673 gdb_regnames (clientData, interp, argc, argv)
 674      ClientData clientData;
 675      Tcl_Interp *interp;
 676      int argc;
 677      char *argv[];
 678 {
 679   argc--;
 680   argv++;
 681
 682   return map_arg_registers (argc, argv, get_register_name, NULL);
 683 }
 684
 685 #ifndef REGISTER_CONVERTIBLE
 686 #define REGISTER_CONVERTIBLE(x) (0 != 0)
 687 #endif
 688
 689 #ifndef REGISTER_CONVERT_TO_VIRTUAL
 690 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
 691 #endif
 692
 693 #ifndef INVALID_FLOAT
 694 #define INVALID_FLOAT(x, y) (0 != 0)
 695 #endif
 696
 697 static void
 698 get_register (regnum, fp)
 699      int regnum;
 700      void *fp;
 701 {
 702   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 703   char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
 704   int format = (int)fp;
 705
 706   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 707     {
 708       Tcl_DStringAppendElement (result_ptr, "Optimized out");
 709       return;
 710     }
 711
 712   /* Convert raw data to virtual format if necessary.  */
 713
 714   if (REGISTER_CONVERTIBLE (regnum))
 715     {
 716       REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
 717                                    raw_buffer, virtual_buffer);
 718     }
 719   else
 720     memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
 721
 722   if (format == 'r')
 723     {
 724       int j;
 725       printf_filtered ("0x");
 726       for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
 727         {
 728           register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
 729             : REGISTER_RAW_SIZE (regnum) - 1 - j;
 730           printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
 731         }
 732     }
 733   else
 734     val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
 735                gdb_stdout, format, 1, 0, Val_pretty_default);
 736
 737   Tcl_DStringAppend (result_ptr, " ", -1);
 738 }
 739
 740 static int
 741 gdb_fetch_registers (clientData, interp, argc, argv)
 742      ClientData clientData;
 743      Tcl_Interp *interp;
 744      int argc;
 745      char *argv[];
 746 {
 747   int format;
 748
 749   if (argc < 2)
 750     error ("wrong # args");
 751
 752   argc--;
 753   argv++;
 754
 755   argc--;
 756   format = **argv++;
 757
 758   return map_arg_registers (argc, argv, get_register, (void *) format);
 759 }
 760
 761 /* This contains the previous values of the registers, since the last call to
 762    gdb_changed_register_list.  */
 763
 764 static char old_regs[REGISTER_BYTES];
 765
 766 static void
 767 register_changed_p (regnum, argp)
 768      int regnum;
 769      void *argp;                /* Ignored */
 770 {
 771   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 772
 773   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 774     return;
 775
 776   if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 777               REGISTER_RAW_SIZE (regnum)) == 0)
 778     return;
 779
 780   /* Found a changed register.  Save new value and return its number. */
 781
 782   memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 783           REGISTER_RAW_SIZE (regnum));
 784
 785   dsprintf_append_element (result_ptr, "%d", regnum);
 786 }
 787
 788 static int
 789 gdb_changed_register_list (clientData, interp, argc, argv)
 790      ClientData clientData;
 791      Tcl_Interp *interp;
 792      int argc;
 793      char *argv[];
 794 {
 795   argc--;
 796   argv++;
 797
 798   return map_arg_registers (argc, argv, register_changed_p, NULL);
 799 }
 800 \f
 801 /* This implements the TCL command `gdb_cmd', which sends its argument into
 802    the GDB command scanner.  */
 803
 804 static int
 805 gdb_cmd (clientData, interp, argc, argv)
 806      ClientData clientData;
 807      Tcl_Interp *interp;
 808      int argc;
 809      char *argv[];
 810 {
 811   if (argc != 2)
 812     error ("wrong # args");
 813
 814   if (running_now)
 815     return TCL_OK;
 816
 817   execute_command (argv[1], 1);
 818
 819   bpstat_do_actions (&stop_bpstat);
 820
 821   return TCL_OK;
 822 }
 823
 824 /* Client of call_wrapper - this routine performs the actual call to
 825    the client function. */
 826
 827 struct wrapped_call_args
 828 {
 829   Tcl_Interp *interp;
 830   Tcl_CmdProc *func;
 831   int argc;
 832   char **argv;
 833   int val;
 834 };
 835
 836 static int
 837 wrapped_call (args)
 838      struct wrapped_call_args *args;
 839 {
 840   args->val = (*args->func) (args->func, args->interp, args->argc, args->argv);
 841   return 1;
 842 }
 843
 844 /* This routine acts as a top-level for all GDB code called by tcl/Tk.  It
 845    handles cleanups, and calls to return_to_top_level (usually via error).
 846    This is necessary in order to prevent a longjmp out of the bowels of Tk,
 847    possibly leaving things in a bad state.  Since this routine can be called
 848    recursively, it needs to save and restore the contents of the jmp_buf as
 849    necessary.  */
 850
 851 static int
 852 call_wrapper (clientData, interp, argc, argv)
 853      ClientData clientData;
 854      Tcl_Interp *interp;
 855      int argc;
 856      char *argv[];
 857 {
 858   struct wrapped_call_args wrapped_args;
 859   Tcl_DString result, *old_result_ptr;
 860
 861   Tcl_DStringInit (&result);
 862   old_result_ptr = result_ptr;
 863   result_ptr = &result;
 864
 865   wrapped_args.func = (Tcl_CmdProc *)clientData;
 866   wrapped_args.interp = interp;
 867   wrapped_args.argc = argc;
 868   wrapped_args.argv = argv;
 869   wrapped_args.val = 0;
 870
 871   if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
 872     {
 873       wrapped_args.val = TCL_ERROR;     /* Flag an error for TCL */
 874
 875       gdb_flush (gdb_stderr);   /* Flush error output */
 876
 877       gdb_flush (gdb_stdout);   /* Sometimes error output comes here as well */
 878
 879       /* In case of an error, we may need to force the GUI into idle
 880          mode because gdbtk_call_command may have bombed out while in
 881          the command routine.  */
 882
 883       running_now = 0;
 884       Tcl_Eval (interp, "gdbtk_tcl_idle");
 885     }
 886
 887   Tcl_DStringResult (interp, &result);
 888   result_ptr = old_result_ptr;
 889
 890   return wrapped_args.val;
 891 }
 892
 893 static int
 894 gdb_listfiles (clientData, interp, argc, argv)
 895      ClientData clientData;
 896      Tcl_Interp *interp;
 897      int argc;
 898      char *argv[];
 899 {
 900   struct objfile *objfile;
 901   struct partial_symtab *psymtab;
 902   struct symtab *symtab;
 903
 904   ALL_PSYMTABS (objfile, psymtab)
 905     Tcl_DStringAppendElement (result_ptr, psymtab->filename);
 906
 907   ALL_SYMTABS (objfile, symtab)
 908     Tcl_DStringAppendElement (result_ptr, symtab->filename);
 909
 910   return TCL_OK;
 911 }
 912
 913 static int
 914 gdb_stop (clientData, interp, argc, argv)
 915      ClientData clientData;
 916      Tcl_Interp *interp;
 917      int argc;
 918      char *argv[];
 919 {
 920   if (target_stop)
 921     target_stop ();
 922   else
 923     quit_flag = 1; /* hope something sees this */
 924
 925   return TCL_OK;
 926 }
 927 \f
 928 /* This implements the TCL command `gdb_disassemble'.  */
 929
 930 static int
 931 gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
 932      bfd_vma memaddr;
 933      bfd_byte *myaddr;
 934      int len;
 935      disassemble_info *info;
 936 {
 937   extern struct target_ops exec_ops;
 938   int res;
 939
 940   errno = 0;
 941   res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
 942
 943   if (res == len)
 944     return 0;
 945   else
 946     if (errno == 0)
 947       return EIO;
 948     else
 949       return errno;
 950 }
 951
 952 /* We need a different sort of line table from the normal one cuz we can't
 953    depend upon implicit line-end pc's for lines.  This is because of the
 954    reordering we are about to do.  */
 955
 956 struct my_line_entry {
 957   int line;
 958   CORE_ADDR start_pc;
 959   CORE_ADDR end_pc;
 960 };
 961
 962 static int
 963 compare_lines (mle1p, mle2p)
 964      const PTR mle1p;
 965      const PTR mle2p;
 966 {
 967   struct my_line_entry *mle1, *mle2;
 968   int val;
 969
 970   mle1 = (struct my_line_entry *) mle1p;
 971   mle2 = (struct my_line_entry *) mle2p;
 972
 973   val =  mle1->line - mle2->line;
 974
 975   if (val != 0)
 976     return val;
 977
 978   return mle1->start_pc - mle2->start_pc;
 979 }
 980
 981 static int
 982 gdb_disassemble (clientData, interp, argc, argv)
 983      ClientData clientData;
 984      Tcl_Interp *interp;
 985      int argc;
 986      char *argv[];
 987 {
 988   CORE_ADDR pc, low, high;
 989   int mixed_source_and_assembly;
 990   static disassemble_info di;
 991   static int di_initialized;
 992
 993   if (! di_initialized)
 994     {
 995       INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
 996                                      (fprintf_ftype) fprintf_unfiltered);
 997       di.flavour = bfd_target_unknown_flavour;
 998       di.memory_error_func = dis_asm_memory_error;
 999       di.print_address_func = dis_asm_print_address;
1000       di_initialized = 1;
1001     }
1002
1003   di.mach = tm_print_insn_info.mach;
1004   if (TARGET_BYTE_ORDER == BIG_ENDIAN)
1005     di.endian = BFD_ENDIAN_BIG;
1006   else
1007     di.endian = BFD_ENDIAN_LITTLE;
1008
1009   if (argc != 3 && argc != 4)
1010     error ("wrong # args");
1011
1012   if (strcmp (argv[1], "source") == 0)
1013     mixed_source_and_assembly = 1;
1014   else if (strcmp (argv[1], "nosource") == 0)
1015     mixed_source_and_assembly = 0;
1016   else
1017     error ("First arg must be 'source' or 'nosource'");
1018
1019   low = parse_and_eval_address (argv[2]);
1020
1021   if (argc == 3)
1022     {
1023       if (find_pc_partial_function (low, NULL, &low, &high) == 0)
1024         error ("No function contains specified address");
1025     }
1026   else
1027     high = parse_and_eval_address (argv[3]);
1028
1029   /* If disassemble_from_exec == -1, then we use the following heuristic to
1030      determine whether or not to do disassembly from target memory or from the
1031      exec file:
1032
1033      If we're debugging a local process, read target memory, instead of the
1034      exec file.  This makes disassembly of functions in shared libs work
1035      correctly.
1036
1037      Else, we're debugging a remote process, and should disassemble from the
1038      exec file for speed.  However, this is no good if the target modifies its
1039      code (for relocation, or whatever).
1040    */
1041
1042   if (disassemble_from_exec == -1)
1043     if (strcmp (target_shortname, "child") == 0
1044         || strcmp (target_shortname, "procfs") == 0
1045         || strcmp (target_shortname, "vxprocess") == 0)
1046       disassemble_from_exec = 0; /* It's a child process, read inferior mem */
1047     else
1048       disassemble_from_exec = 1; /* It's remote, read the exec file */
1049
1050   if (disassemble_from_exec)
1051     di.read_memory_func = gdbtk_dis_asm_read_memory;
1052   else
1053     di.read_memory_func = dis_asm_read_memory;
1054
1055   /* If just doing straight assembly, all we need to do is disassemble
1056      everything between low and high.  If doing mixed source/assembly, we've
1057      got a totally different path to follow.  */
1058
1059   if (mixed_source_and_assembly)
1060     {                           /* Come here for mixed source/assembly */
1061       /* The idea here is to present a source-O-centric view of a function to
1062          the user.  This means that things are presented in source order, with
1063          (possibly) out of order assembly immediately following.  */
1064       struct symtab *symtab;
1065       struct linetable_entry *le;
1066       int nlines;
1067       int newlines;
1068       struct my_line_entry *mle;
1069       struct symtab_and_line sal;
1070       int i;
1071       int out_of_order;
1072       int next_line;
1073
1074       symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
1075
1076       if (!symtab)
1077         goto assembly_only;
1078
1079 /* First, convert the linetable to a bunch of my_line_entry's.  */
1080
1081       le = symtab->linetable->item;
1082       nlines = symtab->linetable->nitems;
1083
1084       if (nlines <= 0)
1085         goto assembly_only;
1086
1087       mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
1088
1089       out_of_order = 0;
1090
1091 /* Copy linetable entries for this function into our data structure, creating
1092    end_pc's and setting out_of_order as appropriate.  */
1093
1094 /* First, skip all the preceding functions.  */
1095
1096       for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
1097
1098 /* Now, copy all entries before the end of this function.  */
1099
1100       newlines = 0;
1101       for (; i < nlines - 1 && le[i].pc < high; i++)
1102         {
1103           if (le[i].line == le[i + 1].line
1104               && le[i].pc == le[i + 1].pc)
1105             continue;           /* Ignore duplicates */
1106
1107           mle[newlines].line = le[i].line;
1108           if (le[i].line > le[i + 1].line)
1109             out_of_order = 1;
1110           mle[newlines].start_pc = le[i].pc;
1111           mle[newlines].end_pc = le[i + 1].pc;
1112           newlines++;
1113         }
1114
1115 /* If we're on the last line, and it's part of the function, then we need to
1116    get the end pc in a special way.  */
1117
1118       if (i == nlines - 1
1119           && le[i].pc < high)
1120         {
1121           mle[newlines].line = le[i].line;
1122           mle[newlines].start_pc = le[i].pc;
1123           sal = find_pc_line (le[i].pc, 0);
1124           mle[newlines].end_pc = sal.end;
1125           newlines++;
1126         }
1127
1128 /* Now, sort mle by line #s (and, then by addresses within lines). */
1129
1130       if (out_of_order)
1131         qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
1132
1133 /* Now, for each line entry, emit the specified lines (unless they have been
1134    emitted before), followed by the assembly code for that line.  */
1135
1136       next_line = 0;            /* Force out first line */
1137       for (i = 0; i < newlines; i++)
1138         {
1139 /* Print out everything from next_line to the current line.  */
1140
1141           if (mle[i].line >= next_line)
1142             {
1143               if (next_line != 0)
1144                 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
1145               else
1146                 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
1147
1148               next_line = mle[i].line + 1;
1149             }
1150
1151           for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
1152             {
1153               QUIT;
1154               fputs_unfiltered ("    ", gdb_stdout);
1155               print_address (pc, gdb_stdout);
1156               fputs_unfiltered (":\t    ", gdb_stdout);
1157               pc += (*tm_print_insn) (pc, &di);
1158               fputs_unfiltered ("\n", gdb_stdout);
1159             }
1160         }
1161     }
1162   else
1163     {
1164 assembly_only:
1165       for (pc = low; pc < high; )
1166         {
1167           QUIT;
1168           fputs_unfiltered ("    ", gdb_stdout);
1169           print_address (pc, gdb_stdout);
1170           fputs_unfiltered (":\t    ", gdb_stdout);
1171           pc += (*tm_print_insn) (pc, &di);
1172           fputs_unfiltered ("\n", gdb_stdout);
1173         }
1174     }
1175
1176   gdb_flush (gdb_stdout);
1177
1178   return TCL_OK;
1179 }
1180 \f
1181 static void
1182 tk_command (cmd, from_tty)
1183      char *cmd;
1184      int from_tty;
1185 {
1186   int retval;
1187   char *result;
1188   struct cleanup *old_chain;
1189
1190   /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1191   if (cmd == NULL)
1192     error_no_arg ("tcl command to interpret");
1193
1194   retval = Tcl_Eval (interp, cmd);
1195
1196   result = strdup (interp->result);
1197
1198   old_chain = make_cleanup (free, result);
1199
1200   if (retval != TCL_OK)
1201     error (result);
1202
1203   printf_unfiltered ("%s\n", result);
1204
1205   do_cleanups (old_chain);
1206 }
1207
1208 static void
1209 cleanup_init (ignored)
1210      int ignored;
1211 {
1212   if (interp != NULL)
1213     Tcl_DeleteInterp (interp);
1214   interp = NULL;
1215 }
1216
1217 /* Come here during long calculations to check for GUI events.  Usually invoked
1218    via the QUIT macro.  */
1219
1220 static void
1221 gdbtk_interactive ()
1222 {
1223   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1224 }
1225
1226 /* Come here when there is activity on the X file descriptor. */
1227
1228 static void
1229 x_event (signo)
1230      int signo;
1231 {
1232   /* Process pending events */
1233
1234   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0);
1235 }
1236
1237 static int
1238 gdbtk_wait (pid, ourstatus)
1239      int pid;
1240      struct target_waitstatus *ourstatus;
1241 {
1242   struct sigaction action;
1243   static sigset_t nullsigmask = {0};
1244
1245 #ifndef SA_RESTART
1246   /* Needed for SunOS 4.1.x */
1247 #define SA_RESTART 0
1248 #endif
1249
1250   action.sa_handler = x_event;
1251   action.sa_mask = nullsigmask;
1252   action.sa_flags = SA_RESTART;
1253 #ifndef WINNT
1254   sigaction(SIGIO, &action, NULL);
1255 #endif
1256
1257   pid = target_wait (pid, ourstatus);
1258
1259   action.sa_handler = SIG_IGN;
1260 #ifndef WINNT
1261   sigaction(SIGIO, &action, NULL);
1262 #endif
1263
1264   return pid;
1265 }
1266
1267 /* This is called from execute_command, and provides a wrapper around
1268    various command routines in a place where both protocol messages and
1269    user input both flow through.  Mostly this is used for indicating whether
1270    the target process is running or not.
1271 */
1272
1273 static void
1274 gdbtk_call_command (cmdblk, arg, from_tty)
1275      struct cmd_list_element *cmdblk;
1276      char *arg;
1277      int from_tty;
1278 {
1279   running_now = 0;
1280   if (cmdblk->class == class_run)
1281     {
1282       running_now = 1;
1283       Tcl_Eval (interp, "gdbtk_tcl_busy");
1284       (*cmdblk->function.cfunc)(arg, from_tty);
1285       running_now = 0;
1286       Tcl_Eval (interp, "gdbtk_tcl_idle");
1287     }
1288   else
1289     (*cmdblk->function.cfunc)(arg, from_tty);
1290 }
1291
1292 /* This function is called instead of gdb's internal command loop.  This is the
1293    last chance to do anything before entering the main Tk event loop. */
1294
1295 static void
1296 tk_command_loop ()
1297 {
1298   extern GDB_FILE *instream;
1299
1300   /* We no longer want to use stdin as the command input stream */
1301   instream = NULL;
1302   Tcl_Eval (interp, "gdbtk_tcl_preloop");
1303   Tk_MainLoop ();
1304 }
1305
1306 static void
1307 gdbtk_init ( argv0 )
1308      char *argv0;
1309 {
1310   struct cleanup *old_chain;
1311   char *lib, *gdbtk_lib, gdbtk_lib_tmp[1024],gdbtk_file[128];
1312   int i, found_main;
1313   struct sigaction action;
1314   static sigset_t nullsigmask = {0};
1315 #ifdef IDE
1316   struct ide_event_handle *h;
1317   const char *errmsg;
1318   char *libexecdir;
1319 #endif
1320
1321   /* If there is no DISPLAY environment variable, Tk_Init below will fail,
1322      causing gdb to abort.  If instead we simply return here, gdb will
1323      gracefully degrade to using the command line interface. */
1324
1325 #ifndef WINNT
1326   if (getenv ("DISPLAY") == NULL)
1327     return;
1328 #endif
1329
1330   old_chain = make_cleanup (cleanup_init, 0);
1331
1332   /* First init tcl and tk. */
1333   Tcl_FindExecutable (argv0);
1334   interp = Tcl_CreateInterp ();
1335
1336   if (!interp)
1337     error ("Tcl_CreateInterp failed");
1338
1339   if (Tcl_Init(interp) != TCL_OK)
1340     error ("Tcl_Init failed: %s", interp->result);
1341
1342   if (Tk_Init(interp) != TCL_OK)
1343     error ("Tk_Init failed: %s", interp->result);
1344
1345   if (Itcl_Init(interp) == TCL_ERROR)
1346     error ("Itcl_Init failed: %s", interp->result);
1347
1348   if (Tix_Init(interp) != TCL_OK)
1349     error ("Tix_Init failed: %s", interp->result);
1350
1351 #ifdef IDE
1352   /* Initialize the Paths variable.
1353   if (ide_initialize_paths (interp, "gdb") != TCL_OK)
1354     return (TCL_ERROR);
1355     */
1356   /* Find the directory where we expect to find idemanager.  We ignore
1357      errors since it doesn't really matter if this fails.  */
1358   libexecdir = Tcl_GetVar2 (interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
1359
1360   IluTk_Init ();
1361
1362   h = ide_event_init_client (&errmsg, libexecdir);
1363   if (h == NULL)
1364     {
1365       Tcl_AppendResult (interp, "can't initialize event system: ", errmsg,
1366                         (char *) NULL);
1367       fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", interp->result);
1368     }
1369   else
1370     {
1371       if (ide_create_tclevent_command (interp, h) != TCL_OK)
1372         error ("ide_create_tclevent_command failed: %s", interp->result);
1373       if (ide_create_edit_command (interp, h) != TCL_OK)
1374         error ("ide_create_edit_command failed: %s", interp->result);
1375
1376       if (ide_create_property_command (interp, h) != TCL_OK)
1377         error ("ide_create_property_command failed: %s", interp->result);
1378
1379       /*
1380         if (ide_initialize (interp, "gdb") != TCL_OK)
1381         error ("ide_initialize failed: %s", interp->result);
1382       */
1383     }
1384   Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
1385 #else
1386   Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
1387 #endif /* IDE */
1388
1389   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
1390   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
1391   Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
1392   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
1393                      NULL);
1394   Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
1395                      NULL);
1396   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
1397   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
1398   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
1399                      gdb_fetch_registers, NULL);
1400   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
1401                      gdb_changed_register_list, NULL);
1402   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
1403                      gdb_disassemble, NULL);
1404   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
1405   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
1406                      gdb_get_breakpoint_list, NULL);
1407   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
1408                      gdb_get_breakpoint_info, NULL);
1409
1410   command_loop_hook = tk_command_loop;
1411   print_frame_info_listing_hook =
1412     (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
1413   query_hook = gdbtk_query;
1414   flush_hook = gdbtk_flush;
1415   create_breakpoint_hook = gdbtk_create_breakpoint;
1416   delete_breakpoint_hook = gdbtk_delete_breakpoint;
1417   modify_breakpoint_hook = gdbtk_modify_breakpoint;
1418   interactive_hook = gdbtk_interactive;
1419   target_wait_hook = gdbtk_wait;
1420   call_command_hook = gdbtk_call_command;
1421   readline_begin_hook = gdbtk_readline_begin;
1422   readline_hook = gdbtk_readline;
1423   readline_end_hook = gdbtk_readline_end;
1424
1425   /* Get the file descriptor for the X server */
1426
1427   x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
1428
1429   /* Setup for I/O interrupts */
1430
1431   action.sa_mask = nullsigmask;
1432   action.sa_flags = 0;
1433   action.sa_handler = SIG_IGN;
1434 #ifndef WINNT
1435   sigaction(SIGIO, &action, NULL);
1436 #endif
1437
1438 #ifdef FIOASYNC
1439   i = 1;
1440   if (ioctl (x_fd, FIOASYNC, &i))
1441     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1442
1443 #ifdef SIOCSPGRP
1444   i = getpid();
1445   if (ioctl (x_fd, SIOCSPGRP, &i))
1446     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1447
1448 #else
1449 #ifdef F_SETOWN
1450   i = getpid();
1451   if (fcntl (x_fd, F_SETOWN, i))
1452     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1453 #endif  /* F_SETOWN */
1454 #endif  /* !SIOCSPGRP */
1455 #else
1456 #ifndef WINNT
1457   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
1458     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1459 #endif
1460
1461 #endif /* ifndef FIOASYNC */
1462
1463   add_com ("tk", class_obscure, tk_command,
1464            "Send a command directly into tk.");
1465
1466   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
1467                TCL_LINK_INT);
1468
1469   /* find the gdb tcl library and source main.tcl */
1470
1471   gdbtk_lib = getenv ("GDBTK_LIBRARY");
1472   if (!gdbtk_lib)
1473     if (access ("gdbtcl/main.tcl", R_OK) == 0)
1474       gdbtk_lib = "gdbtcl";
1475     else
1476       gdbtk_lib = GDBTK_LIBRARY;
1477
1478   strcpy (gdbtk_lib_tmp, gdbtk_lib);
1479   found_main = 0;
1480   /* see if GDBTK_LIBRARY is a path list */
1481   lib = strtok (gdbtk_lib_tmp, GDBTK_PATH_SEP);
1482   do
1483     {
1484       if (Tcl_VarEval (interp, "lappend auto_path ", lib, NULL) != TCL_OK)
1485         {
1486           fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1487           error ("");
1488         }
1489       if (!found_main)
1490         {
1491           strcpy (gdbtk_file, lib);
1492           strcat (gdbtk_file, "/main.tcl");
1493           if (access (gdbtk_file, R_OK) == 0)
1494             {
1495               found_main++;
1496               Tcl_SetVar (interp, "GDBTK_LIBRARY", lib, 0);
1497             }
1498         }
1499      }
1500   while ((lib = strtok (NULL, ":")) != NULL);
1501
1502   if (!found_main)
1503     {
1504       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1505       if (getenv("GDBTK_LIBRARY"))
1506         {
1507           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
1508           fprintf_unfiltered (stderr,
1509                               "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
1510         }
1511       else
1512         {
1513           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY);
1514           fprintf_unfiltered (stderr, "You might want to set GDBTK_LIBRARY\n");
1515         }
1516       error("");
1517     }
1518
1519 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1520    prior to this point go to stdout/stderr.  */
1521
1522   fputs_unfiltered_hook = gdbtk_fputs;
1523
1524   if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
1525     {
1526       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1527
1528       fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_file,
1529                           interp->errorLine, interp->result);
1530
1531       fputs_unfiltered ("Stack trace:\n", gdb_stderr);
1532       fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1533       error ("");
1534     }
1535
1536   discard_cleanups (old_chain);
1537 }
1538
1539 /* Come here during initialize_all_files () */
1540
1541 void
1542 _initialize_gdbtk ()
1543 {
1544   if (use_windows)
1545     {
1546       /* Tell the rest of the world that Gdbtk is now set up. */
1547
1548       init_ui_hook = gdbtk_init;
1549     }
1550 }