gdb/gdbtk.c

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