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       running_now = 0;
 817       Tcl_Eval (interp, "gdbtk_tcl_idle");
 818     }
 819
 820   do_cleanups (ALL_CLEANUPS);
 821
 822   restore_cleanups (saved_cleanup_chain);
 823
 824   memcpy (error_return, saved_error_return, sizeof (jmp_buf));
 825
 826   Tcl_DStringResult (interp, &result);
 827   result_ptr = old_result_ptr;
 828
 829   return val;
 830 }
 831
 832 static int
 833 gdb_listfiles (clientData, interp, argc, argv)
 834      ClientData clientData;
 835      Tcl_Interp *interp;
 836      int argc;
 837      char *argv[];
 838 {
 839   struct objfile *objfile;
 840   struct partial_symtab *psymtab;
 841   struct symtab *symtab;
 842
 843   ALL_PSYMTABS (objfile, psymtab)
 844     Tcl_DStringAppendElement (result_ptr, psymtab->filename);
 845
 846   ALL_SYMTABS (objfile, symtab)
 847     Tcl_DStringAppendElement (result_ptr, symtab->filename);
 848
 849   return TCL_OK;
 850 }
 851
 852 static int
 853 gdb_stop (clientData, interp, argc, argv)
 854      ClientData clientData;
 855      Tcl_Interp *interp;
 856      int argc;
 857      char *argv[];
 858 {
 859   target_stop ();
 860
 861   return TCL_OK;
 862 }
 863 \f
 864 /* This implements the TCL command `gdb_disassemble'.  */
 865
 866 static int
 867 gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
 868      bfd_vma memaddr;
 869      bfd_byte *myaddr;
 870      int len;
 871      disassemble_info *info;
 872 {
 873   extern struct target_ops exec_ops;
 874   int res;
 875
 876   errno = 0;
 877   res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
 878
 879   if (res == len)
 880     return 0;
 881   else
 882     if (errno == 0)
 883       return EIO;
 884     else
 885       return errno;
 886 }
 887
 888 /* We need a different sort of line table from the normal one cuz we can't
 889    depend upon implicit line-end pc's for lines.  This is because of the
 890    reordering we are about to do.  */
 891
 892 struct my_line_entry {
 893   int line;
 894   CORE_ADDR start_pc;
 895   CORE_ADDR end_pc;
 896 };
 897
 898 static int
 899 compare_lines (mle1p, mle2p)
 900      const PTR mle1p;
 901      const PTR mle2p;
 902 {
 903   struct my_line_entry *mle1, *mle2;
 904   int val;
 905
 906   mle1 = (struct my_line_entry *) mle1p;
 907   mle2 = (struct my_line_entry *) mle2p;
 908
 909   val =  mle1->line - mle2->line;
 910
 911   if (val != 0)
 912     return val;
 913
 914   return mle1->start_pc - mle2->start_pc;
 915 }
 916
 917 static int
 918 gdb_disassemble (clientData, interp, argc, argv)
 919      ClientData clientData;
 920      Tcl_Interp *interp;
 921      int argc;
 922      char *argv[];
 923 {
 924   CORE_ADDR pc, low, high;
 925   int mixed_source_and_assembly;
 926   static disassemble_info di;
 927   static int di_initialized;
 928
 929   if (! di_initialized)
 930     {
 931       INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
 932                                      (fprintf_ftype) fprintf_unfiltered);
 933       di.flavour = bfd_target_unknown_flavour;
 934       di.memory_error_func = dis_asm_memory_error;
 935       di.print_address_func = dis_asm_print_address;
 936       di_initialized = 1;
 937     }
 938
 939   di.mach = tm_print_insn_info.mach;
 940   if (TARGET_BYTE_ORDER == BIG_ENDIAN)
 941     tm_print_insn_info.endian = BFD_ENDIAN_BIG;
 942   else
 943     tm_print_insn_info.endian = BFD_ENDIAN_LITTLE;
 944
 945   if (argc != 3 && argc != 4)
 946     error ("wrong # args");
 947
 948   if (strcmp (argv[1], "source") == 0)
 949     mixed_source_and_assembly = 1;
 950   else if (strcmp (argv[1], "nosource") == 0)
 951     mixed_source_and_assembly = 0;
 952   else
 953     error ("First arg must be 'source' or 'nosource'");
 954
 955   low = parse_and_eval_address (argv[2]);
 956
 957   if (argc == 3)
 958     {
 959       if (find_pc_partial_function (low, NULL, &low, &high) == 0)
 960         error ("No function contains specified address");
 961     }
 962   else
 963     high = parse_and_eval_address (argv[3]);
 964
 965   /* If disassemble_from_exec == -1, then we use the following heuristic to
 966      determine whether or not to do disassembly from target memory or from the
 967      exec file:
 968
 969      If we're debugging a local process, read target memory, instead of the
 970      exec file.  This makes disassembly of functions in shared libs work
 971      correctly.
 972
 973      Else, we're debugging a remote process, and should disassemble from the
 974      exec file for speed.  However, this is no good if the target modifies its
 975      code (for relocation, or whatever).
 976    */
 977
 978   if (disassemble_from_exec == -1)
 979     if (strcmp (target_shortname, "child") == 0
 980         || strcmp (target_shortname, "procfs") == 0
 981         || strcmp (target_shortname, "vxprocess") == 0)
 982       disassemble_from_exec = 0; /* It's a child process, read inferior mem */
 983     else
 984       disassemble_from_exec = 1; /* It's remote, read the exec file */
 985
 986   if (disassemble_from_exec)
 987     di.read_memory_func = gdbtk_dis_asm_read_memory;
 988   else
 989     di.read_memory_func = dis_asm_read_memory;
 990
 991   /* If just doing straight assembly, all we need to do is disassemble
 992      everything between low and high.  If doing mixed source/assembly, we've
 993      got a totally different path to follow.  */
 994
 995   if (mixed_source_and_assembly)
 996     {                           /* Come here for mixed source/assembly */
 997       /* The idea here is to present a source-O-centric view of a function to
 998          the user.  This means that things are presented in source order, with
 999          (possibly) out of order assembly immediately following.  */
1000       struct symtab *symtab;
1001       struct linetable_entry *le;
1002       int nlines;
1003       int newlines;
1004       struct my_line_entry *mle;
1005       struct symtab_and_line sal;
1006       int i;
1007       int out_of_order;
1008       int next_line;
1009
1010       symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
1011
1012       if (!symtab)
1013         goto assembly_only;
1014
1015 /* First, convert the linetable to a bunch of my_line_entry's.  */
1016
1017       le = symtab->linetable->item;
1018       nlines = symtab->linetable->nitems;
1019
1020       if (nlines <= 0)
1021         goto assembly_only;
1022
1023       mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
1024
1025       out_of_order = 0;
1026
1027 /* Copy linetable entries for this function into our data structure, creating
1028    end_pc's and setting out_of_order as appropriate.  */
1029
1030 /* First, skip all the preceding functions.  */
1031
1032       for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
1033
1034 /* Now, copy all entries before the end of this function.  */
1035
1036       newlines = 0;
1037       for (; i < nlines - 1 && le[i].pc < high; i++)
1038         {
1039           if (le[i].line == le[i + 1].line
1040               && le[i].pc == le[i + 1].pc)
1041             continue;           /* Ignore duplicates */
1042
1043           mle[newlines].line = le[i].line;
1044           if (le[i].line > le[i + 1].line)
1045             out_of_order = 1;
1046           mle[newlines].start_pc = le[i].pc;
1047           mle[newlines].end_pc = le[i + 1].pc;
1048           newlines++;
1049         }
1050
1051 /* If we're on the last line, and it's part of the function, then we need to
1052    get the end pc in a special way.  */
1053
1054       if (i == nlines - 1
1055           && le[i].pc < high)
1056         {
1057           mle[newlines].line = le[i].line;
1058           mle[newlines].start_pc = le[i].pc;
1059           sal = find_pc_line (le[i].pc, 0);
1060           mle[newlines].end_pc = sal.end;
1061           newlines++;
1062         }
1063
1064 /* Now, sort mle by line #s (and, then by addresses within lines). */
1065
1066       if (out_of_order)
1067         qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
1068
1069 /* Now, for each line entry, emit the specified lines (unless they have been
1070    emitted before), followed by the assembly code for that line.  */
1071
1072       next_line = 0;            /* Force out first line */
1073       for (i = 0; i < newlines; i++)
1074         {
1075 /* Print out everything from next_line to the current line.  */
1076
1077           if (mle[i].line >= next_line)
1078             {
1079               if (next_line != 0)
1080                 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
1081               else
1082                 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
1083
1084               next_line = mle[i].line + 1;
1085             }
1086
1087           for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
1088             {
1089               QUIT;
1090               fputs_unfiltered ("    ", gdb_stdout);
1091               print_address (pc, gdb_stdout);
1092               fputs_unfiltered (":\t    ", gdb_stdout);
1093               pc += (*tm_print_insn) (pc, &di);
1094               fputs_unfiltered ("\n", gdb_stdout);
1095             }
1096         }
1097     }
1098   else
1099     {
1100 assembly_only:
1101       for (pc = low; pc < high; )
1102         {
1103           QUIT;
1104           fputs_unfiltered ("    ", gdb_stdout);
1105           print_address (pc, gdb_stdout);
1106           fputs_unfiltered (":\t    ", gdb_stdout);
1107           pc += (*tm_print_insn) (pc, &di);
1108           fputs_unfiltered ("\n", gdb_stdout);
1109         }
1110     }
1111
1112   gdb_flush (gdb_stdout);
1113
1114   return TCL_OK;
1115 }
1116 \f
1117 static void
1118 tk_command (cmd, from_tty)
1119      char *cmd;
1120      int from_tty;
1121 {
1122   int retval;
1123   char *result;
1124   struct cleanup *old_chain;
1125
1126   /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1127   if (cmd == NULL)
1128     error_no_arg ("tcl command to interpret");
1129
1130   retval = Tcl_Eval (interp, cmd);
1131
1132   result = strdup (interp->result);
1133
1134   old_chain = make_cleanup (free, result);
1135
1136   if (retval != TCL_OK)
1137     error (result);
1138
1139   printf_unfiltered ("%s\n", result);
1140
1141   do_cleanups (old_chain);
1142 }
1143
1144 static void
1145 cleanup_init (ignored)
1146      int ignored;
1147 {
1148   if (interp != NULL)
1149     Tcl_DeleteInterp (interp);
1150   interp = NULL;
1151 }
1152
1153 /* Come here during long calculations to check for GUI events.  Usually invoked
1154    via the QUIT macro.  */
1155
1156 static void
1157 gdbtk_interactive ()
1158 {
1159   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1160 }
1161
1162 /* Come here when there is activity on the X file descriptor. */
1163
1164 static void
1165 x_event (signo)
1166      int signo;
1167 {
1168   /* Process pending events */
1169
1170   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0);
1171 }
1172
1173 static int
1174 gdbtk_wait (pid, ourstatus)
1175      int pid;
1176      struct target_waitstatus *ourstatus;
1177 {
1178   struct sigaction action;
1179   static sigset_t nullsigmask = {0};
1180
1181 #ifndef SA_RESTART
1182   /* Needed for SunOS 4.1.x */
1183 #define SA_RESTART 0
1184 #endif
1185
1186   action.sa_handler = x_event;
1187   action.sa_mask = nullsigmask;
1188   action.sa_flags = SA_RESTART;
1189   sigaction(SIGIO, &action, NULL);
1190
1191   pid = target_wait (pid, ourstatus);
1192
1193   action.sa_handler = SIG_IGN;
1194   sigaction(SIGIO, &action, NULL);
1195
1196   return pid;
1197 }
1198
1199 /* This is called from execute_command, and provides a wrapper around
1200    various command routines in a place where both protocol messages and
1201    user input both flow through.  Mostly this is used for indicating whether
1202    the target process is running or not.
1203 */
1204
1205 static void
1206 gdbtk_call_command (cmdblk, arg, from_tty)
1207      struct cmd_list_element *cmdblk;
1208      char *arg;
1209      int from_tty;
1210 {
1211   running_now = 0;
1212   if (cmdblk->class == class_run)
1213     {
1214       running_now = 1;
1215       Tcl_Eval (interp, "gdbtk_tcl_busy");
1216       (*cmdblk->function.cfunc)(arg, from_tty);
1217       Tcl_Eval (interp, "gdbtk_tcl_idle");
1218       running_now = 0;
1219     }
1220   else
1221     (*cmdblk->function.cfunc)(arg, from_tty);
1222 }
1223
1224 /* This function is called instead of gdb's internal command loop.  This is the
1225    last chance to do anything before entering the main Tk event loop. */
1226
1227 static void
1228 tk_command_loop ()
1229 {
1230   extern GDB_FILE *instream;
1231
1232   /* We no longer want to use stdin as the command input stream */
1233   instream = NULL;
1234   Tcl_Eval (interp, "gdbtk_tcl_preloop");
1235   Tk_MainLoop ();
1236 }
1237
1238 static void
1239 gdbtk_init ()
1240 {
1241   struct cleanup *old_chain;
1242   char *gdbtk_filename;
1243   int i;
1244   struct sigaction action;
1245   static sigset_t nullsigmask = {0};
1246
1247   /* If there is no DISPLAY environment variable, Tk_Init below will fail,
1248      causing gdb to abort.  If instead we simply return here, gdb will
1249      gracefully degrade to using the command line interface. */
1250
1251   if (getenv ("DISPLAY") == NULL)
1252     return;
1253
1254   old_chain = make_cleanup (cleanup_init, 0);
1255
1256   /* First init tcl and tk. */
1257
1258   interp = Tcl_CreateInterp ();
1259
1260   if (!interp)
1261     error ("Tcl_CreateInterp failed");
1262
1263   if (Tcl_Init(interp) != TCL_OK)
1264     error ("Tcl_Init failed: %s", interp->result);
1265
1266   if (Tk_Init(interp) != TCL_OK)
1267     error ("Tk_Init failed: %s", interp->result);
1268
1269   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
1270   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
1271   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
1272                      NULL);
1273   Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
1274                      NULL);
1275   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
1276   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
1277   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
1278                      gdb_fetch_registers, NULL);
1279   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
1280                      gdb_changed_register_list, NULL);
1281   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
1282                      gdb_disassemble, NULL);
1283   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
1284   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
1285                      gdb_get_breakpoint_list, NULL);
1286   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
1287                      gdb_get_breakpoint_info, NULL);
1288
1289   command_loop_hook = tk_command_loop;
1290   print_frame_info_listing_hook =
1291     (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
1292   query_hook = gdbtk_query;
1293   flush_hook = gdbtk_flush;
1294   create_breakpoint_hook = gdbtk_create_breakpoint;
1295   delete_breakpoint_hook = gdbtk_delete_breakpoint;
1296   modify_breakpoint_hook = gdbtk_modify_breakpoint;
1297   interactive_hook = gdbtk_interactive;
1298   target_wait_hook = gdbtk_wait;
1299   call_command_hook = gdbtk_call_command;
1300   readline_begin_hook = gdbtk_readline_begin;
1301   readline_hook = gdbtk_readline;
1302   readline_end_hook = gdbtk_readline_end;
1303
1304   /* Get the file descriptor for the X server */
1305
1306   x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
1307
1308   /* Setup for I/O interrupts */
1309
1310   action.sa_mask = nullsigmask;
1311   action.sa_flags = 0;
1312   action.sa_handler = SIG_IGN;
1313   sigaction(SIGIO, &action, NULL);
1314
1315 #ifdef FIOASYNC
1316   i = 1;
1317   if (ioctl (x_fd, FIOASYNC, &i))
1318     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1319
1320 #ifdef SIOCSPGRP
1321   i = getpid();
1322   if (ioctl (x_fd, SIOCSPGRP, &i))
1323     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1324
1325 #else
1326 #ifdef F_SETOWN
1327   i = getpid();
1328   if (fcntl (x_fd, F_SETOWN, i))
1329     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1330 #endif  /* F_SETOWN */
1331 #endif  /* !SIOCSPGRP */
1332 #else
1333   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
1334     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1335 #endif /* ifndef FIOASYNC */
1336
1337   add_com ("tk", class_obscure, tk_command,
1338            "Send a command directly into tk.");
1339
1340   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
1341                TCL_LINK_INT);
1342
1343   /* Load up gdbtk.tcl after all the environment stuff has been setup.  */
1344
1345   gdbtk_filename = getenv ("GDBTK_FILENAME");
1346   if (!gdbtk_filename)
1347     if (access ("gdbtk.tcl", R_OK) == 0)
1348       gdbtk_filename = "gdbtk.tcl";
1349     else
1350       gdbtk_filename = GDBTK_FILENAME;
1351
1352 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1353    prior to this point go to stdout/stderr.  */
1354
1355   fputs_unfiltered_hook = gdbtk_fputs;
1356
1357   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
1358     {
1359       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1360
1361       fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename,
1362                           interp->errorLine, interp->result);
1363
1364       fputs_unfiltered ("Stack trace:\n", gdb_stderr);
1365       fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1366       error ("");
1367     }
1368
1369   discard_cleanups (old_chain);
1370 }
1371
1372 /* Come here during initialize_all_files () */
1373
1374 void
1375 _initialize_gdbtk ()
1376 {
1377   if (use_windows)
1378     {
1379       /* Tell the rest of the world that Gdbtk is now set up. */
1380
1381       init_ui_hook = gdbtk_init;
1382     }
1383 }