gdb/gdbtk.c

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