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   static int di_initialized;
 794
 795   if (! di_initialized)
 796     {
 797       INIT_DISASSEMBLE_INFO (di, gdb_stdout);
 798       di.fprintf_func = (fprintf_ftype) fprintf_unfiltered;
 799       di.memory_error_func = dis_asm_memory_error;
 800       di.print_address_func = dis_asm_print_address;
 801       di_initialized = 1;
 802     }
 803
 804   if (argc != 3 && argc != 4)
 805     error ("wrong # args");
 806
 807   if (strcmp (argv[1], "source") == 0)
 808     mixed_source_and_assembly = 1;
 809   else if (strcmp (argv[1], "nosource") == 0)
 810     mixed_source_and_assembly = 0;
 811   else
 812     error ("First arg must be 'source' or 'nosource'");
 813
 814   low = parse_and_eval_address (argv[2]);
 815
 816   if (argc == 3)
 817     {
 818       if (find_pc_partial_function (low, NULL, &low, &high) == 0)
 819         error ("No function contains specified address");
 820     }
 821   else
 822     high = parse_and_eval_address (argv[3]);
 823
 824   /* If disassemble_from_exec == -1, then we use the following heuristic to
 825      determine whether or not to do disassembly from target memory or from the
 826      exec file:
 827
 828      If we're debugging a local process, read target memory, instead of the
 829      exec file.  This makes disassembly of functions in shared libs work
 830      correctly.
 831
 832      Else, we're debugging a remote process, and should disassemble from the
 833      exec file for speed.  However, this is no good if the target modifies it's
 834      code (for relocation, or whatever).
 835    */
 836
 837   if (disassemble_from_exec == -1)
 838     if (strcmp (target_shortname, "child") == 0
 839         || strcmp (target_shortname, "procfs") == 0
 840         || strcmp (target_shortname, "vxprocess") == 0)
 841       disassemble_from_exec = 0; /* It's a child process, read inferior mem */
 842     else
 843       disassemble_from_exec = 1; /* It's remote, read the exec file */
 844
 845   if (disassemble_from_exec)
 846     di.read_memory_func = gdbtk_dis_asm_read_memory;
 847   else
 848     di.read_memory_func = dis_asm_read_memory;
 849
 850   /* If just doing straight assembly, all we need to do is disassemble
 851      everything between low and high.  If doing mixed source/assembly, we've
 852      got a totally different path to follow.  */
 853
 854   if (mixed_source_and_assembly)
 855     {                           /* Come here for mixed source/assembly */
 856       /* The idea here is to present a source-O-centric view of a function to
 857          the user.  This means that things are presented in source order, with
 858          (possibly) out of order assembly immediately following.  */
 859       struct symtab *symtab;
 860       struct linetable_entry *le;
 861       int nlines;
 862       int newlines;
 863       struct my_line_entry *mle;
 864       struct symtab_and_line sal;
 865       int i;
 866       int out_of_order;
 867       int next_line;
 868
 869       symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
 870
 871       if (!symtab)
 872         goto assembly_only;
 873
 874 /* First, convert the linetable to a bunch of my_line_entry's.  */
 875
 876       le = symtab->linetable->item;
 877       nlines = symtab->linetable->nitems;
 878
 879       if (nlines <= 0)
 880         goto assembly_only;
 881
 882       mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
 883
 884       out_of_order = 0;
 885
 886 /* Copy linetable entries for this function into our data structure, creating
 887    end_pc's and setting out_of_order as appropriate.  */
 888
 889 /* First, skip all the preceding functions.  */
 890
 891       for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
 892
 893 /* Now, copy all entries before the end of this function.  */
 894
 895       newlines = 0;
 896       for (; i < nlines - 1 && le[i].pc < high; i++)
 897         {
 898           if (le[i].line == le[i + 1].line
 899               && le[i].pc == le[i + 1].pc)
 900             continue;           /* Ignore duplicates */
 901
 902           mle[newlines].line = le[i].line;
 903           if (le[i].line > le[i + 1].line)
 904             out_of_order = 1;
 905           mle[newlines].start_pc = le[i].pc;
 906           mle[newlines].end_pc = le[i + 1].pc;
 907           newlines++;
 908         }
 909
 910 /* If we're on the last line, and it's part of the function, then we need to
 911    get the end pc in a special way.  */
 912
 913       if (i == nlines - 1
 914           && le[i].pc < high)
 915         {
 916           mle[newlines].line = le[i].line;
 917           mle[newlines].start_pc = le[i].pc;
 918           sal = find_pc_line (le[i].pc, 0);
 919           mle[newlines].end_pc = sal.end;
 920           newlines++;
 921         }
 922
 923 /* Now, sort mle by line #s (and, then by addresses within lines). */
 924
 925       if (out_of_order)
 926         qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
 927
 928 /* Now, for each line entry, emit the specified lines (unless they have been
 929    emitted before), followed by the assembly code for that line.  */
 930
 931       next_line = 0;            /* Force out first line */
 932       for (i = 0; i < newlines; i++)
 933         {
 934 /* Print out everything from next_line to the current line.  */
 935
 936           if (mle[i].line >= next_line)
 937             {
 938               if (next_line != 0)
 939                 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
 940               else
 941                 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
 942
 943               next_line = mle[i].line + 1;
 944             }
 945
 946           for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
 947             {
 948               QUIT;
 949               fputs_unfiltered ("    ", gdb_stdout);
 950               print_address (pc, gdb_stdout);
 951               fputs_unfiltered (":\t    ", gdb_stdout);
 952               pc += (*tm_print_insn) (pc, &di);
 953               fputs_unfiltered ("\n", gdb_stdout);
 954             }
 955         }
 956     }
 957   else
 958     {
 959 assembly_only:
 960       for (pc = low; pc < high; )
 961         {
 962           QUIT;
 963           fputs_unfiltered ("    ", gdb_stdout);
 964           print_address (pc, gdb_stdout);
 965           fputs_unfiltered (":\t    ", gdb_stdout);
 966           pc += (*tm_print_insn) (pc, &di);
 967           fputs_unfiltered ("\n", gdb_stdout);
 968         }
 969     }
 970
 971   gdb_flush (gdb_stdout);
 972
 973   return TCL_OK;
 974 }
 975 \f
 976 static void
 977 tk_command (cmd, from_tty)
 978      char *cmd;
 979      int from_tty;
 980 {
 981   int retval;
 982   char *result;
 983   struct cleanup *old_chain;
 984
 985   retval = Tcl_Eval (interp, cmd);
 986
 987   result = strdup (interp->result);
 988
 989   old_chain = make_cleanup (free, result);
 990
 991   if (retval != TCL_OK)
 992     error (result);
 993
 994   printf_unfiltered ("%s\n", result);
 995
 996   do_cleanups (old_chain);
 997 }
 998
 999 static void
1000 cleanup_init (ignored)
1001      int ignored;
1002 {
1003   if (mainWindow != NULL)
1004     Tk_DestroyWindow (mainWindow);
1005   mainWindow = NULL;
1006
1007   if (interp != NULL)
1008     Tcl_DeleteInterp (interp);
1009   interp = NULL;
1010 }
1011
1012 /* Come here during long calculations to check for GUI events.  Usually invoked
1013    via the QUIT macro.  */
1014
1015 static void
1016 gdbtk_interactive ()
1017 {
1018   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1019 }
1020
1021 /* Come here when there is activity on the X file descriptor. */
1022
1023 static void
1024 x_event (signo)
1025      int signo;
1026 {
1027   /* Process pending events */
1028
1029   while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0);
1030 }
1031
1032 static int
1033 gdbtk_wait (pid, ourstatus)
1034      int pid;
1035      struct target_waitstatus *ourstatus;
1036 {
1037   struct sigaction action;
1038   static sigset_t nullsigmask = {0};
1039
1040 #ifndef SA_RESTART
1041   /* Needed for SunOS 4.1.x */
1042 #define SA_RESTART 0
1043 #endif
1044
1045   action.sa_handler = x_event;
1046   action.sa_mask = nullsigmask;
1047   action.sa_flags = SA_RESTART;
1048   sigaction(SIGIO, &action, NULL);
1049
1050   pid = target_wait (pid, ourstatus);
1051
1052   action.sa_handler = SIG_IGN;
1053   sigaction(SIGIO, &action, NULL);
1054
1055   return pid;
1056 }
1057
1058 /* This is called from execute_command, and provides a wrapper around
1059    various command routines in a place where both protocol messages and
1060    user input both flow through.  Mostly this is used for indicating whether
1061    the target process is running or not.
1062 */
1063
1064 static void
1065 gdbtk_call_command (cmdblk, arg, from_tty)
1066      struct cmd_list_element *cmdblk;
1067      char *arg;
1068      int from_tty;
1069 {
1070   if (cmdblk->class == class_run)
1071     {
1072       Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL);
1073       (*cmdblk->function.cfunc)(arg, from_tty);
1074       Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL);
1075     }
1076   else
1077     (*cmdblk->function.cfunc)(arg, from_tty);
1078 }
1079
1080 static void
1081 gdbtk_init ()
1082 {
1083   struct cleanup *old_chain;
1084   char *gdbtk_filename;
1085   int i;
1086   struct sigaction action;
1087   static sigset_t nullsigmask = {0};
1088
1089   old_chain = make_cleanup (cleanup_init, 0);
1090
1091   /* First init tcl and tk. */
1092
1093   interp = Tcl_CreateInterp ();
1094
1095   if (!interp)
1096     error ("Tcl_CreateInterp failed");
1097
1098   mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
1099
1100   if (!mainWindow)
1101     return;                     /* DISPLAY probably not set */
1102
1103   if (Tcl_Init(interp) != TCL_OK)
1104     error ("Tcl_Init failed: %s", interp->result);
1105
1106   if (Tk_Init(interp) != TCL_OK)
1107     error ("Tk_Init failed: %s", interp->result);
1108
1109   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
1110   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
1111   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
1112                      NULL);
1113   Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
1114                      NULL);
1115   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
1116   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
1117   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
1118                      gdb_fetch_registers, NULL);
1119   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
1120                      gdb_changed_register_list, NULL);
1121   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
1122                      gdb_disassemble, NULL);
1123   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
1124   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
1125                      gdb_get_breakpoint_list, NULL);
1126   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
1127                      gdb_get_breakpoint_info, NULL);
1128
1129   command_loop_hook = Tk_MainLoop;
1130   print_frame_info_listing_hook = null_routine;
1131   query_hook = gdbtk_query;
1132   flush_hook = gdbtk_flush;
1133   create_breakpoint_hook = gdbtk_create_breakpoint;
1134   delete_breakpoint_hook = gdbtk_delete_breakpoint;
1135   modify_breakpoint_hook = gdbtk_modify_breakpoint;
1136   interactive_hook = gdbtk_interactive;
1137   target_wait_hook = gdbtk_wait;
1138   call_command_hook = gdbtk_call_command;
1139
1140   /* Get the file descriptor for the X server */
1141
1142   x_fd = ConnectionNumber (Tk_Display (mainWindow));
1143
1144   /* Setup for I/O interrupts */
1145
1146   action.sa_mask = nullsigmask;
1147   action.sa_flags = 0;
1148   action.sa_handler = SIG_IGN;
1149   sigaction(SIGIO, &action, NULL);
1150
1151 #ifdef FIOASYNC
1152   i = 1;
1153   if (ioctl (x_fd, FIOASYNC, &i))
1154     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1155
1156 #ifdef SIOCSPGRP
1157   i = getpid();
1158   if (ioctl (x_fd, SIOCSPGRP, &i))
1159     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1160
1161 #else
1162 #ifdef F_SETOWN
1163   i = getpid();
1164   if (fcntl (x_fd, F_SETOWN, i))
1165     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1166 #endif  /* F_SETOWN */
1167 #endif  /* !SIOCSPGRP */
1168 #else
1169   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
1170     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1171 #endif /* ifndef FIOASYNC */
1172
1173   add_com ("tk", class_obscure, tk_command,
1174            "Send a command directly into tk.");
1175
1176   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
1177                TCL_LINK_INT);
1178
1179   /* Load up gdbtk.tcl after all the environment stuff has been setup.  */
1180
1181   gdbtk_filename = getenv ("GDBTK_FILENAME");
1182   if (!gdbtk_filename)
1183     if (access ("gdbtk.tcl", R_OK) == 0)
1184       gdbtk_filename = "gdbtk.tcl";
1185     else
1186       gdbtk_filename = GDBTK_FILENAME;
1187
1188 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1189    prior to this point go to stdout/stderr.  */
1190
1191   fputs_unfiltered_hook = gdbtk_fputs;
1192
1193   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
1194     {
1195       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1196
1197       fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename,
1198                           interp->errorLine, interp->result);
1199
1200       fputs_unfiltered ("Stack trace:\n", gdb_stderr);
1201       fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1202       error ("");
1203     }
1204
1205   discard_cleanups (old_chain);
1206 }
1207
1208 /* Come here during initialze_all_files () */
1209
1210 void
1211 _initialize_gdbtk ()
1212 {
1213   if (use_windows)
1214     {
1215       /* Tell the rest of the world that Gdbtk is now set up. */
1216
1217       init_ui_hook = gdbtk_init;
1218     }
1219 }