gdb/gdbtk.c

   1 /* Tcl/Tk interface routines.
   2    Copyright 1994, 1995 Free Software Foundation, Inc.
   3
   4    Written by Stu Grossman <[email protected]> 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., 675 Mass Ave, Cambridge, MA 02139, 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 #ifdef ANSI_PROTOTYPES
  33 #include <stdarg.h>
  34 #else
  35 #include <varargs.h>
  36 #endif
  37 #include <signal.h>
  38 #include <fcntl.h>
  39 #include <unistd.h>
  40 #include <setjmp.h>
  41 #include "top.h"
  42 #include <sys/ioctl.h>
  43 #include <string.h>
  44 #include "dis-asm.h"
  45 #include <stdio.h>
  46 #include "gdbcmd.h"
  47
  48 #ifndef FIOASYNC
  49 #include <sys/stropts.h>
  50 #endif
  51
  52 /* Handle for TCL interpreter */
  53 static Tcl_Interp *interp = NULL;
  54
  55 /* Handle for TK main window */
  56 static Tk_Window mainWindow = NULL;
  57
  58 static int x_fd;                /* X network socket */
  59
  60 /* This variable determines where memory used for disassembly is read from.
  61
  62    If > 0, then disassembly comes from the exec file rather than the target
  63    (which might be at the other end of a slow serial link).  If == 0 then
  64    disassembly comes from target.  If < 0 disassembly is automatically switched
  65    to the target if it's an inferior process, otherwise the exec file is
  66    used.
  67  */
  68
  69 static int disassemble_from_exec = -1;
  70
  71 static void
  72 null_routine(arg)
  73      int arg;
  74 {
  75 }
  76
  77 /* The following routines deal with stdout/stderr data, which is created by
  78    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
  79    lowest level of these routines and capture all output from the rest of GDB.
  80    Normally they present their data to tcl via callbacks to the following tcl
  81    routines:  gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush.  These
  82    in turn call tk routines to update the display.
  83
  84    Under some circumstances, you may want to collect the output so that it can
  85    be returned as the value of a tcl procedure.  This can be done by
  86    surrounding the output routines with calls to start_saving_output and
  87    finish_saving_output.  The saved data can then be retrieved with
  88    get_saved_output (but this must be done before the call to
  89    finish_saving_output).  */
  90
  91 /* Dynamic string header for stdout. */
  92
  93 static Tcl_DString *result_ptr;
  94 \f
  95 static void
  96 gdbtk_flush (stream)
  97      FILE *stream;
  98 {
  99 #if 0
 100   /* Force immediate screen update */
 101
 102   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
 103 #endif
 104 }
 105
 106 static void
 107 gdbtk_fputs (ptr, stream)
 108      const char *ptr;
 109      FILE *stream;
 110 {
 111   if (result_ptr)
 112     Tcl_DStringAppend (result_ptr, (char *)ptr, -1);
 113   else
 114     {
 115       Tcl_DString str;
 116
 117       Tcl_DStringInit (&str);
 118
 119       Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
 120       Tcl_DStringAppendElement (&str, (char *)ptr);
 121
 122       Tcl_Eval (interp, Tcl_DStringValue (&str));
 123       Tcl_DStringFree (&str);
 124     }
 125 }
 126
 127 static int
 128 gdbtk_query (query, args)
 129      char *query;
 130      va_list args;
 131 {
 132   char buf[200];
 133   long val;
 134
 135   vsprintf (buf, query, args);
 136   Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
 137
 138   val = atol (interp->result);
 139   return val;
 140 }
 141 \f
 142 static void
 143 #ifdef ANSI_PROTOTYPES
 144 dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
 145 #else
 146 dsprintf_append_element (va_alist)
 147      va_dcl
 148 #endif
 149 {
 150   va_list args;
 151   char buf[1024];
 152
 153 #ifdef ANSI_PROTOTYPES
 154   va_start (args, format);
 155 #else
 156   Tcl_DString *dsp;
 157   char *format;
 158
 159   va_start (args);
 160   dsp = va_arg (args, Tcl_DString *);
 161   format = va_arg (args, char *);
 162 #endif
 163
 164   vsprintf (buf, format, args);
 165
 166   Tcl_DStringAppendElement (dsp, buf);
 167 }
 168
 169 static int
 170 gdb_get_breakpoint_list (clientData, interp, argc, argv)
 171      ClientData clientData;
 172      Tcl_Interp *interp;
 173      int argc;
 174      char *argv[];
 175 {
 176   struct breakpoint *b;
 177   extern struct breakpoint *breakpoint_chain;
 178
 179   if (argc != 1)
 180     error ("wrong # args");
 181
 182   for (b = breakpoint_chain; b; b = b->next)
 183     if (b->type == bp_breakpoint)
 184       dsprintf_append_element (result_ptr, "%d", b->number);
 185
 186   return TCL_OK;
 187 }
 188
 189 static int
 190 gdb_get_breakpoint_info (clientData, interp, argc, argv)
 191      ClientData clientData;
 192      Tcl_Interp *interp;
 193      int argc;
 194      char *argv[];
 195 {
 196   struct symtab_and_line sal;
 197   static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
 198                               "finish", "watchpoint", "hardware watchpoint",
 199                               "read watchpoint", "access watchpoint",
 200                               "longjmp", "longjmp resume", "step resume",
 201                               "through sigtramp", "watchpoint scope",
 202                               "call dummy" };
 203   static char *bpdisp[] = {"delete", "disable", "donttouch"};
 204   struct command_line *cmd;
 205   int bpnum;
 206   struct breakpoint *b;
 207   extern struct breakpoint *breakpoint_chain;
 208
 209   if (argc != 2)
 210     error ("wrong # args");
 211
 212   bpnum = atoi (argv[1]);
 213
 214   for (b = breakpoint_chain; b; b = b->next)
 215     if (b->number == bpnum)
 216       break;
 217
 218   if (!b || b->type != bp_breakpoint)
 219     error ("Breakpoint #%d does not exist", bpnum);
 220
 221   sal = find_pc_line (b->address, 0);
 222
 223   Tcl_DStringAppendElement (result_ptr, symtab_to_filename (sal.symtab));
 224   dsprintf_append_element (result_ptr, "%d", sal.line);
 225   dsprintf_append_element (result_ptr, "0x%lx", b->address);
 226   Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
 227   Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
 228   Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
 229   dsprintf_append_element (result_ptr, "%d", b->silent);
 230   dsprintf_append_element (result_ptr, "%d", b->ignore_count);
 231
 232   Tcl_DStringStartSublist (result_ptr);
 233   for (cmd = b->commands; cmd; cmd = cmd->next)
 234     Tcl_DStringAppendElement (result_ptr, cmd->line);
 235   Tcl_DStringEndSublist (result_ptr);
 236
 237   Tcl_DStringAppendElement (result_ptr, b->cond_string);
 238
 239   dsprintf_append_element (result_ptr, "%d", b->thread);
 240   dsprintf_append_element (result_ptr, "%d", b->hit_count);
 241
 242   return TCL_OK;
 243 }
 244
 245 static void
 246 breakpoint_notify(b, action)
 247      struct breakpoint *b;
 248      const char *action;
 249 {
 250   char buf[100];
 251   int v;
 252
 253   if (b->type != bp_breakpoint)
 254     return;
 255
 256   sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number);
 257
 258   v = Tcl_Eval (interp, buf);
 259
 260   if (v != TCL_OK)
 261     {
 262       gdbtk_fputs (interp->result, gdb_stdout);
 263       gdbtk_fputs ("\n", gdb_stdout);
 264     }
 265 }
 266
 267 static void
 268 gdbtk_create_breakpoint(b)
 269      struct breakpoint *b;
 270 {
 271   breakpoint_notify (b, "create");
 272 }
 273
 274 static void
 275 gdbtk_delete_breakpoint(b)
 276      struct breakpoint *b;
 277 {
 278   breakpoint_notify (b, "delete");
 279 }
 280
 281 static void
 282 gdbtk_modify_breakpoint(b)
 283      struct breakpoint *b;
 284 {
 285   breakpoint_notify (b, "modify");
 286 }
 287 \f
 288 /* This implements the TCL command `gdb_loc', which returns a list consisting
 289    of the source and line number associated with the current pc. */
 290
 291 static int
 292 gdb_loc (clientData, interp, argc, argv)
 293      ClientData clientData;
 294      Tcl_Interp *interp;
 295      int argc;
 296      char *argv[];
 297 {
 298   char *filename;
 299   struct symtab_and_line sal;
 300   char *funcname;
 301   CORE_ADDR pc;
 302
 303   if (argc == 1)
 304     {
 305       pc = selected_frame ? selected_frame->pc : stop_pc;
 306       sal = find_pc_line (pc, 0);
 307     }
 308   else if (argc == 2)
 309     {
 310       struct symtabs_and_lines sals;
 311       int nelts;
 312
 313       sals = decode_line_spec (argv[1], 1);
 314
 315       nelts = sals.nelts;
 316       sal = sals.sals[0];
 317       free (sals.sals);
 318
 319       if (sals.nelts != 1)
 320         error ("Ambiguous line spec");
 321
 322       pc = sal.pc;
 323     }
 324   else
 325     error ("wrong # args");
 326
 327   if (sal.symtab)
 328     Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
 329   else
 330     Tcl_DStringAppendElement (result_ptr, "");
 331
 332   find_pc_partial_function (pc, &funcname, NULL, NULL);
 333   Tcl_DStringAppendElement (result_ptr, funcname);
 334
 335   filename = symtab_to_filename (sal.symtab);
 336   Tcl_DStringAppendElement (result_ptr, filename);
 337
 338   dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
 339
 340   dsprintf_append_element (result_ptr, "0x%lx", pc); /* PC */
 341
 342   return TCL_OK;
 343 }
 344 \f
 345 /* This implements the TCL command `gdb_eval'. */
 346
 347 static int
 348 gdb_eval (clientData, interp, argc, argv)
 349      ClientData clientData;
 350      Tcl_Interp *interp;
 351      int argc;
 352      char *argv[];
 353 {
 354   struct expression *expr;
 355   struct cleanup *old_chain;
 356   value_ptr val;
 357
 358   if (argc != 2)
 359     error ("wrong # args");
 360
 361   expr = parse_expression (argv[1]);
 362
 363   old_chain = make_cleanup (free_current_contents, &expr);
 364
 365   val = evaluate_expression (expr);
 366
 367   val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
 368              gdb_stdout, 0, 0, 0, 0);
 369
 370   do_cleanups (old_chain);
 371
 372   return TCL_OK;
 373 }
 374 \f
 375 /* This implements the TCL command `gdb_sourcelines', which returns a list of
 376    all of the lines containing executable code for the specified source file
 377    (ie: lines where you can put breakpoints). */
 378
 379 static int
 380 gdb_sourcelines (clientData, interp, argc, argv)
 381      ClientData clientData;
 382      Tcl_Interp *interp;
 383      int argc;
 384      char *argv[];
 385 {
 386   struct symtab *symtab;
 387   struct linetable_entry *le;
 388   int nlines;
 389
 390   if (argc != 2)
 391     error ("wrong # args");
 392
 393   symtab = lookup_symtab (argv[1]);
 394
 395   if (!symtab)
 396     error ("No such file");
 397
 398   /* If there's no linetable, or no entries, then we are done. */
 399
 400   if (!symtab->linetable
 401       || symtab->linetable->nitems == 0)
 402     {
 403       Tcl_DStringAppendElement (result_ptr, "");
 404       return TCL_OK;
 405     }
 406
 407   le = symtab->linetable->item;
 408   nlines = symtab->linetable->nitems;
 409
 410   for (;nlines > 0; nlines--, le++)
 411     {
 412       /* If the pc of this line is the same as the pc of the next line, then
 413          just skip it.  */
 414       if (nlines > 1
 415           && le->pc == (le + 1)->pc)
 416         continue;
 417
 418       dsprintf_append_element (result_ptr, "%d", le->line);
 419     }
 420
 421   return TCL_OK;
 422 }
 423 \f
 424 static int
 425 map_arg_registers (argc, argv, func, argp)
 426      int argc;
 427      char *argv[];
 428      void (*func) PARAMS ((int regnum, void *argp));
 429      void *argp;
 430 {
 431   int regnum;
 432
 433   /* Note that the test for a valid register must include checking the
 434      reg_names array because NUM_REGS may be allocated for the union of the
 435      register sets within a family of related processors.  In this case, the
 436      trailing entries of reg_names will change depending upon the particular
 437      processor being debugged.  */
 438
 439   if (argc == 0)                /* No args, just do all the regs */
 440     {
 441       for (regnum = 0;
 442            regnum < NUM_REGS
 443            && reg_names[regnum] != NULL
 444            && *reg_names[regnum] != '\000';
 445            regnum++)
 446         func (regnum, argp);
 447
 448       return TCL_OK;
 449     }
 450
 451   /* Else, list of register #s, just do listed regs */
 452   for (; argc > 0; argc--, argv++)
 453     {
 454       regnum = atoi (*argv);
 455
 456       if (regnum >= 0
 457           && regnum < NUM_REGS
 458           && reg_names[regnum] != NULL
 459           && *reg_names[regnum] != '\000')
 460         func (regnum, argp);
 461       else
 462         error ("bad register number");
 463     }
 464
 465   return TCL_OK;
 466 }
 467
 468 static void
 469 get_register_name (regnum, argp)
 470      int regnum;
 471      void *argp;                /* Ignored */
 472 {
 473   Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
 474 }
 475
 476 /* This implements the TCL command `gdb_regnames', which returns a list of
 477    all of the register names. */
 478
 479 static int
 480 gdb_regnames (clientData, interp, argc, argv)
 481      ClientData clientData;
 482      Tcl_Interp *interp;
 483      int argc;
 484      char *argv[];
 485 {
 486   argc--;
 487   argv++;
 488
 489   return map_arg_registers (argc, argv, get_register_name, 0);
 490 }
 491
 492 #ifndef REGISTER_CONVERTIBLE
 493 #define REGISTER_CONVERTIBLE(x) (0 != 0)
 494 #endif
 495
 496 #ifndef REGISTER_CONVERT_TO_VIRTUAL
 497 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
 498 #endif
 499
 500 #ifndef INVALID_FLOAT
 501 #define INVALID_FLOAT(x, y) (0 != 0)
 502 #endif
 503
 504 static void
 505 get_register (regnum, fp)
 506      int regnum;
 507      void *fp;
 508 {
 509   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 510   char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
 511   int format = (int)fp;
 512
 513   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 514     {
 515       Tcl_DStringAppendElement (result_ptr, "Optimized out");
 516       return;
 517     }
 518
 519   /* Convert raw data to virtual format if necessary.  */
 520
 521   if (REGISTER_CONVERTIBLE (regnum))
 522     {
 523       REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
 524                                    raw_buffer, virtual_buffer);
 525     }
 526   else
 527     memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
 528
 529   val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
 530              gdb_stdout, format, 1, 0, Val_pretty_default);
 531
 532   Tcl_DStringAppend (result_ptr, " ", -1);
 533 }
 534
 535 static int
 536 gdb_fetch_registers (clientData, interp, argc, argv)
 537      ClientData clientData;
 538      Tcl_Interp *interp;
 539      int argc;
 540      char *argv[];
 541 {
 542   int format;
 543
 544   if (argc < 2)
 545     error ("wrong # args");
 546
 547   argc--;
 548   argv++;
 549
 550   argc--;
 551   format = **argv++;
 552
 553   return map_arg_registers (argc, argv, get_register, format);
 554 }
 555
 556 /* This contains the previous values of the registers, since the last call to
 557    gdb_changed_register_list.  */
 558
 559 static char old_regs[REGISTER_BYTES];
 560
 561 static void
 562 register_changed_p (regnum, argp)
 563      int regnum;
 564      void *argp;                /* Ignored */
 565 {
 566   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 567   char buf[100];
 568
 569   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 570     return;
 571
 572   if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 573               REGISTER_RAW_SIZE (regnum)) == 0)
 574     return;
 575
 576   /* Found a changed register.  Save new value and return it's number. */
 577
 578   memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 579           REGISTER_RAW_SIZE (regnum));
 580
 581   dsprintf_append_element (result_ptr, "%d", regnum);
 582 }
 583
 584 static int
 585 gdb_changed_register_list (clientData, interp, argc, argv)
 586      ClientData clientData;
 587      Tcl_Interp *interp;
 588      int argc;
 589      char *argv[];
 590 {
 591   argc--;
 592   argv++;
 593
 594   return map_arg_registers (argc, argv, register_changed_p, NULL);
 595 }
 596 \f
 597 /* This implements the TCL command `gdb_cmd', which sends it's argument into
 598    the GDB command scanner.  */
 599
 600 static int
 601 gdb_cmd (clientData, interp, argc, argv)
 602      ClientData clientData;
 603      Tcl_Interp *interp;
 604      int argc;
 605      char *argv[];
 606 {
 607   if (argc != 2)
 608     error ("wrong # args");
 609
 610   execute_command (argv[1], 1);
 611
 612   bpstat_do_actions (&stop_bpstat);
 613
 614   return TCL_OK;
 615 }
 616
 617 /* This routine acts as a top-level for all GDB code called by tcl/Tk.  It
 618    handles cleanups, and calls to return_to_top_level (usually via error).
 619    This is necessary in order to prevent a longjmp out of the bowels of Tk,
 620    possibly leaving things in a bad state.  Since this routine can be called
 621    recursively, it needs to save and restore the contents of the jmp_buf as
 622    necessary.  */
 623
 624 static int
 625 call_wrapper (clientData, interp, argc, argv)
 626      ClientData clientData;
 627      Tcl_Interp *interp;
 628      int argc;
 629      char *argv[];
 630 {
 631   int val;
 632   struct cleanup *saved_cleanup_chain;
 633   Tcl_CmdProc *func;
 634   jmp_buf saved_error_return;
 635   Tcl_DString result, *old_result_ptr;
 636
 637   Tcl_DStringInit (&result);
 638   old_result_ptr = result_ptr;
 639   result_ptr = &result;
 640
 641   func = (Tcl_CmdProc *)clientData;
 642   memcpy (saved_error_return, error_return, sizeof (jmp_buf));
 643
 644   saved_cleanup_chain = save_cleanups ();
 645
 646   if (!setjmp (error_return))
 647     val = func (clientData, interp, argc, argv);
 648   else
 649     {
 650       val = TCL_ERROR;          /* Flag an error for TCL */
 651
 652       gdb_flush (gdb_stderr);   /* Flush error output */
 653
 654       gdb_flush (gdb_stdout);   /* Sometimes error output comes here as well */
 655
 656 /* In case of an error, we may need to force the GUI into idle mode because
 657    gdbtk_call_command may have bombed out while in the command routine.  */
 658
 659       Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL);
 660     }
 661
 662   do_cleanups (ALL_CLEANUPS);
 663
 664   restore_cleanups (saved_cleanup_chain);
 665
 666   memcpy (error_return, saved_error_return, sizeof (jmp_buf));
 667
 668   Tcl_DStringResult (interp, &result);
 669   result_ptr = old_result_ptr;
 670
 671   return val;
 672 }
 673
 674 static int
 675 gdb_listfiles (clientData, interp, argc, argv)
 676      ClientData clientData;
 677      Tcl_Interp *interp;
 678      int argc;
 679      char *argv[];
 680 {
 681   struct objfile *objfile;
 682   struct partial_symtab *psymtab;
 683   struct symtab *symtab;
 684
 685   ALL_PSYMTABS (objfile, psymtab)
 686     Tcl_DStringAppendElement (result_ptr, psymtab->filename);
 687
 688   ALL_SYMTABS (objfile, symtab)
 689     Tcl_DStringAppendElement (result_ptr, symtab->filename);
 690
 691   return TCL_OK;
 692 }
 693
 694 static int
 695 gdb_stop (clientData, interp, argc, argv)
 696      ClientData clientData;
 697      Tcl_Interp *interp;
 698      int argc;
 699      char *argv[];
 700 {
 701   target_stop ();
 702
 703   return TCL_OK;
 704 }
 705 \f
 706 /* This implements the TCL command `gdb_disassemble'.  */
 707
 708 static int
 709 gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
 710      bfd_vma memaddr;
 711      bfd_byte *myaddr;
 712      int len;
 713      disassemble_info *info;
 714 {
 715   extern struct target_ops exec_ops;
 716   int res;
 717
 718   errno = 0;
 719   res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
 720
 721   if (res == len)
 722     return 0;
 723   else
 724     if (errno == 0)
 725       return EIO;
 726     else
 727       return errno;
 728 }
 729
 730 /* We need a different sort of line table from the normal one cuz we can't
 731    depend upon implicit line-end pc's for lines.  This is because of the
 732    reordering we are about to do.  */
 733
 734 struct my_line_entry {
 735   int line;
 736   CORE_ADDR start_pc;
 737   CORE_ADDR end_pc;
 738 };
 739
 740 static int
 741 compare_lines (mle1p, mle2p)
 742      const PTR mle1p;
 743      const PTR mle2p;
 744 {
 745   struct my_line_entry *mle1, *mle2;
 746   int val;
 747
 748   mle1 = (struct my_line_entry *) mle1p;
 749   mle2 = (struct my_line_entry *) mle2p;
 750
 751   val =  mle1->line - mle2->line;
 752
 753   if (val != 0)
 754     return val;
 755
 756   return mle1->start_pc - mle2->start_pc;
 757 }
 758
 759 static int
 760 gdb_disassemble (clientData, interp, argc, argv)
 761      ClientData clientData;
 762      Tcl_Interp *interp;
 763      int argc;
 764      char *argv[];
 765 {
 766   CORE_ADDR pc, low, high;
 767   int mixed_source_and_assembly;
 768   static disassemble_info di = {
 769     (fprintf_ftype) fprintf_filtered, /* fprintf_func */
 770     gdb_stdout,                 /* stream */
 771     NULL,                       /* application_data */
 772     0,                          /* flags */
 773     NULL,                       /* private_data */
 774     NULL,                       /* read_memory_func */
 775     dis_asm_memory_error,       /* memory_error_func */
 776     dis_asm_print_address       /* print_address_func */
 777     };
 778
 779   if (argc != 3 && argc != 4)
 780     error ("wrong # args");
 781
 782   if (strcmp (argv[1], "source") == 0)
 783     mixed_source_and_assembly = 1;
 784   else if (strcmp (argv[1], "nosource") == 0)
 785     mixed_source_and_assembly = 0;
 786   else
 787     error ("First arg must be 'source' or 'nosource'");
 788
 789   low = parse_and_eval_address (argv[2]);
 790
 791   if (argc == 3)
 792     {
 793       if (find_pc_partial_function (low, NULL, &low, &high) == 0)
 794         error ("No function contains specified address");
 795     }
 796   else
 797     high = parse_and_eval_address (argv[3]);
 798
 799   /* If disassemble_from_exec == -1, then we use the following heuristic to
 800      determine whether or not to do disassembly from target memory or from the
 801      exec file:
 802
 803      If we're debugging a local process, read target memory, instead of the
 804      exec file.  This makes disassembly of functions in shared libs work
 805      correctly.
 806
 807      Else, we're debugging a remote process, and should disassemble from the
 808      exec file for speed.  However, this is no good if the target modifies it's
 809      code (for relocation, or whatever).
 810    */
 811
 812   if (disassemble_from_exec == -1)
 813     if (strcmp (target_shortname, "child") == 0
 814         || strcmp (target_shortname, "procfs") == 0
 815         || strcmp (target_shortname, "vxprocess") == 0)
 816       disassemble_from_exec = 0; /* It's a child process, read inferior mem */
 817     else
 818       disassemble_from_exec = 1; /* It's remote, read the exec file */
 819
 820   if (disassemble_from_exec)
 821     di.read_memory_func = gdbtk_dis_asm_read_memory;
 822   else
 823     di.read_memory_func = dis_asm_read_memory;
 824
 825   /* If just doing straight assembly, all we need to do is disassemble
 826      everything between low and high.  If doing mixed source/assembly, we've
 827      got a totally different path to follow.  */
 828
 829   if (mixed_source_and_assembly)
 830     {                           /* Come here for mixed source/assembly */
 831       /* The idea here is to present a source-O-centric view of a function to
 832          the user.  This means that things are presented in source order, with
 833          (possibly) out of order assembly immediately following.  */
 834       struct symtab *symtab;
 835       struct linetable_entry *le;
 836       int nlines;
 837       int newlines;
 838       struct my_line_entry *mle;
 839       struct symtab_and_line sal;
 840       int i;
 841       int out_of_order;
 842       int next_line;
 843
 844       symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
 845
 846       if (!symtab)
 847         goto assembly_only;
 848
 849 /* First, convert the linetable to a bunch of my_line_entry's.  */
 850
 851       le = symtab->linetable->item;
 852       nlines = symtab->linetable->nitems;
 853
 854       if (nlines <= 0)
 855         goto assembly_only;
 856
 857       mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
 858
 859       out_of_order = 0;
 860
 861 /* Copy linetable entries for this function into our data structure, creating
 862    end_pc's and setting out_of_order as appropriate.  */
 863
 864 /* First, skip all the preceding functions.  */
 865
 866       for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
 867
 868 /* Now, copy all entries before the end of this function.  */
 869
 870       newlines = 0;
 871       for (; i < nlines - 1 && le[i].pc < high; i++)
 872         {
 873           if (le[i].line == le[i + 1].line
 874               && le[i].pc == le[i + 1].pc)
 875             continue;           /* Ignore duplicates */
 876
 877           mle[newlines].line = le[i].line;
 878           if (le[i].line > le[i + 1].line)
 879             out_of_order = 1;
 880           mle[newlines].start_pc = le[i].pc;
 881           mle[newlines].end_pc = le[i + 1].pc;
 882           newlines++;
 883         }
 884
 885 /* If we're on the last line, and it's part of the function, then we need to
 886    get the end pc in a special way.  */
 887
 888       if (i == nlines - 1
 889           && le[i].pc < high)
 890         {
 891           mle[newlines].line = le[i].line;
 892           mle[newlines].start_pc = le[i].pc;
 893           sal = find_pc_line (le[i].pc, 0);
 894           mle[newlines].end_pc = sal.end;
 895           newlines++;
 896         }
 897
 898 /* Now, sort mle by line #s (and, then by addresses within lines). */
 899
 900       if (out_of_order)
 901         qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
 902
 903 /* Now, for each line entry, emit the specified lines (unless they have been
 904    emitted before), followed by the assembly code for that line.  */
 905
 906       next_line = 0;            /* Force out first line */
 907       for (i = 0; i < newlines; i++)
 908         {
 909 /* Print out everything from next_line to the current line.  */
 910
 911           if (mle[i].line >= next_line)
 912             {
 913               if (next_line != 0)
 914                 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
 915               else
 916                 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
 917
 918               next_line = mle[i].line + 1;
 919             }
 920
 921           for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
 922             {
 923               QUIT;
 924               fputs_unfiltered ("    ", gdb_stdout);
 925               print_address (pc, gdb_stdout);
 926               fputs_unfiltered (":\t    ", gdb_stdout);
 927               pc += (*tm_print_insn) (pc, &di);
 928               fputs_unfiltered ("\n", gdb_stdout);
 929             }
 930         }
 931     }
 932   else
 933     {
 934 assembly_only:
 935       for (pc = low; pc < high; )
 936         {
 937           QUIT;
 938           fputs_unfiltered ("    ", gdb_stdout);
 939           print_address (pc, gdb_stdout);
 940           fputs_unfiltered (":\t    ", gdb_stdout);
 941           pc += (*tm_print_insn) (pc, &di);
 942           fputs_unfiltered ("\n", gdb_stdout);
 943         }
 944     }
 945
 946   gdb_flush (gdb_stdout);
 947
 948   return TCL_OK;
 949 }
 950 \f
 951 static void
 952 tk_command (cmd, from_tty)
 953      char *cmd;
 954      int from_tty;
 955 {
 956   int retval;
 957   char *result;
 958   struct cleanup *old_chain;
 959
 960   retval = Tcl_Eval (interp, cmd);
 961
 962   result = strdup (interp->result);
 963
 964   old_chain = make_cleanup (free, result);
 965
 966   if (retval != TCL_OK)
 967     error (result);
 968
 969   printf_unfiltered ("%s\n", result);
 970
 971   do_cleanups (old_chain);
 972 }
 973
 974 static void
 975 cleanup_init (ignored)
 976      int ignored;
 977 {
 978   if (mainWindow != NULL)
 979     Tk_DestroyWindow (mainWindow);
 980   mainWindow = NULL;
 981
 982   if (interp != NULL)
 983     Tcl_DeleteInterp (interp);
 984   interp = NULL;
 985 }
 986
 987 /* Come here during long calculations to check for GUI events.  Usually invoked
 988    via the QUIT macro.  */
 989
 990 static void
 991 gdbtk_interactive ()
 992 {
 993   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
 994 }
 995
 996 /* Come here when there is activity on the X file descriptor. */
 997
 998 static void
 999 x_event (signo)
1000      int signo;
1001 {
1002   /* Process pending events */
1003
1004   while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0);
1005 }
1006
1007 static int
1008 gdbtk_wait (pid, ourstatus)
1009      int pid;
1010      struct target_waitstatus *ourstatus;
1011 {
1012   struct sigaction action;
1013   static sigset_t nullsigmask = {0};
1014
1015 #ifndef SA_RESTART
1016   /* Needed for SunOS 4.1.x */
1017 #define SA_RESTART 0
1018 #endif
1019
1020   action.sa_handler = x_event;
1021   action.sa_mask = nullsigmask;
1022   action.sa_flags = SA_RESTART;
1023   sigaction(SIGIO, &action, NULL);
1024
1025   pid = target_wait (pid, ourstatus);
1026
1027   action.sa_handler = SIG_IGN;
1028   sigaction(SIGIO, &action, NULL);
1029
1030   return pid;
1031 }
1032
1033 /* This is called from execute_command, and provides a wrapper around
1034    various command routines in a place where both protocol messages and
1035    user input both flow through.  Mostly this is used for indicating whether
1036    the target process is running or not.
1037 */
1038
1039 static void
1040 gdbtk_call_command (cmdblk, arg, from_tty)
1041      struct cmd_list_element *cmdblk;
1042      char *arg;
1043      int from_tty;
1044 {
1045   if (cmdblk->class == class_run)
1046     {
1047       Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL);
1048       (*cmdblk->function.cfunc)(arg, from_tty);
1049       Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL);
1050     }
1051   else
1052     (*cmdblk->function.cfunc)(arg, from_tty);
1053 }
1054
1055 static void
1056 gdbtk_init ()
1057 {
1058   struct cleanup *old_chain;
1059   char *gdbtk_filename;
1060   int i;
1061   struct sigaction action;
1062   static sigset_t nullsigmask = {0};
1063
1064   old_chain = make_cleanup (cleanup_init, 0);
1065
1066   /* First init tcl and tk. */
1067
1068   interp = Tcl_CreateInterp ();
1069
1070   if (!interp)
1071     error ("Tcl_CreateInterp failed");
1072
1073   mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
1074
1075   if (!mainWindow)
1076     return;                     /* DISPLAY probably not set */
1077
1078   if (Tcl_Init(interp) != TCL_OK)
1079     error ("Tcl_Init failed: %s", interp->result);
1080
1081   if (Tk_Init(interp) != TCL_OK)
1082     error ("Tk_Init failed: %s", interp->result);
1083
1084   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
1085   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
1086   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
1087                      NULL);
1088   Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
1089                      NULL);
1090   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
1091   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
1092   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
1093                      gdb_fetch_registers, NULL);
1094   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
1095                      gdb_changed_register_list, NULL);
1096   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
1097                      gdb_disassemble, NULL);
1098   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
1099   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
1100                      gdb_get_breakpoint_list, NULL);
1101   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
1102                      gdb_get_breakpoint_info, NULL);
1103
1104   command_loop_hook = Tk_MainLoop;
1105   print_frame_info_listing_hook = null_routine;
1106   query_hook = gdbtk_query;
1107   flush_hook = gdbtk_flush;
1108   create_breakpoint_hook = gdbtk_create_breakpoint;
1109   delete_breakpoint_hook = gdbtk_delete_breakpoint;
1110   modify_breakpoint_hook = gdbtk_modify_breakpoint;
1111   interactive_hook = gdbtk_interactive;
1112   target_wait_hook = gdbtk_wait;
1113   call_command_hook = gdbtk_call_command;
1114
1115   /* Get the file descriptor for the X server */
1116
1117   x_fd = ConnectionNumber (Tk_Display (mainWindow));
1118
1119   /* Setup for I/O interrupts */
1120
1121   action.sa_mask = nullsigmask;
1122   action.sa_flags = 0;
1123   action.sa_handler = SIG_IGN;
1124   sigaction(SIGIO, &action, NULL);
1125
1126 #ifdef FIOASYNC
1127   i = 1;
1128   if (ioctl (x_fd, FIOASYNC, &i))
1129     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1130
1131 #ifdef SIOCSPGRP
1132   i = getpid();
1133   if (ioctl (x_fd, SIOCSPGRP, &i))
1134     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1135
1136 #else
1137 #ifdef F_SETOWN
1138   i = getpid();
1139   if (fcntl (x_fd, F_SETOWN, i))
1140     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1141 #endif  /* F_SETOWN */
1142 #endif  /* !SIOCSPGRP */
1143 #else
1144   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
1145     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1146 #endif /* ifndef FIOASYNC */
1147
1148   add_com ("tk", class_obscure, tk_command,
1149            "Send a command directly into tk.");
1150
1151   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
1152                TCL_LINK_INT);
1153
1154   /* Load up gdbtk.tcl after all the environment stuff has been setup.  */
1155
1156   gdbtk_filename = getenv ("GDBTK_FILENAME");
1157   if (!gdbtk_filename)
1158     if (access ("gdbtk.tcl", R_OK) == 0)
1159       gdbtk_filename = "gdbtk.tcl";
1160     else
1161       gdbtk_filename = GDBTK_FILENAME;
1162
1163 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1164    prior to this point go to stdout/stderr.  */
1165
1166   fputs_unfiltered_hook = gdbtk_fputs;
1167
1168   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
1169     {
1170       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1171
1172       fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename,
1173                           interp->errorLine, interp->result);
1174
1175       fputs_unfiltered ("Stack trace:\n", gdb_stderr);
1176       fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1177       error ("");
1178     }
1179
1180   discard_cleanups (old_chain);
1181 }
1182
1183 /* Come here during initialze_all_files () */
1184
1185 void
1186 _initialize_gdbtk ()
1187 {
1188   if (use_windows)
1189     {
1190       /* Tell the rest of the world that Gdbtk is now set up. */
1191
1192       init_ui_hook = gdbtk_init;
1193     }
1194 }