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