gdb/gdbtk.c

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