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