gdb/gdbtk.c

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