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 /* Handle for TK main window */
 101
 102 static Tk_Window mainWindow = NULL;
 103
 104 static int x_fd;                /* X network socket */
 105
 106 /* This variable is true when the inferior is running.  Although it's
 107    possible to disable most input from widgets and thus prevent
 108    attempts to do anything while the inferior is running, any commands
 109    that get through - even a simple memory read - are Very Bad, and
 110    may cause GDB to crash or behave strangely.  So, this variable
 111    provides an extra layer of defense.  */
 112
 113 static int running_now;
 114
 115 /* This variable determines where memory used for disassembly is read from.
 116    If > 0, then disassembly comes from the exec file rather than the
 117    target (which might be at the other end of a slow serial link).  If
 118    == 0 then disassembly comes from target.  If < 0 disassembly is
 119    automatically switched to the target if it's an inferior process,
 120    otherwise the exec file is used.  */
 121
 122 static int disassemble_from_exec = -1;
 123
 124 /* Supply malloc calls for tcl/tk.  */
 125
 126 char *
 127 Tcl_Malloc (size)
 128      unsigned int size;
 129 {
 130   return xmalloc (size);
 131 }
 132
 133 char *
 134 Tcl_Realloc (ptr, size)
 135      char *ptr;
 136      unsigned int size;
 137 {
 138   return xrealloc (ptr, size);
 139 }
 140
 141 void
 142 Tcl_Free(ptr)
 143      char *ptr;
 144 {
 145   free (ptr);
 146 }
 147
 148 static void
 149 null_routine(arg)
 150      int arg;
 151 {
 152 }
 153
 154 /* The following routines deal with stdout/stderr data, which is created by
 155    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
 156    lowest level of these routines and capture all output from the rest of GDB.
 157    Normally they present their data to tcl via callbacks to the following tcl
 158    routines:  gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush.  These
 159    in turn call tk routines to update the display.
 160
 161    Under some circumstances, you may want to collect the output so that it can
 162    be returned as the value of a tcl procedure.  This can be done by
 163    surrounding the output routines with calls to start_saving_output and
 164    finish_saving_output.  The saved data can then be retrieved with
 165    get_saved_output (but this must be done before the call to
 166    finish_saving_output).  */
 167
 168 /* Dynamic string header for stdout. */
 169
 170 static Tcl_DString *result_ptr;
 171 \f
 172 static void
 173 gdbtk_flush (stream)
 174      FILE *stream;
 175 {
 176 #if 0
 177   /* Force immediate screen update */
 178
 179   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
 180 #endif
 181 }
 182
 183 static void
 184 gdbtk_fputs (ptr, stream)
 185      const char *ptr;
 186      FILE *stream;
 187 {
 188
 189   if (result_ptr)
 190     Tcl_DStringAppend (result_ptr, (char *)ptr, -1);
 191   else
 192     {
 193       Tcl_DString str;
 194
 195       Tcl_DStringInit (&str);
 196
 197       Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
 198       Tcl_DStringAppendElement (&str, (char *)ptr);
 199
 200       Tcl_Eval (interp, Tcl_DStringValue (&str));
 201       Tcl_DStringFree (&str);
 202     }
 203 }
 204
 205 static int
 206 gdbtk_query (query, args)
 207      const char *query;
 208      va_list args;
 209 {
 210   char buf[200], *merge[2];
 211   char *command;
 212   long val;
 213
 214   vsprintf (buf, query, args);
 215   merge[0] = "gdbtk_tcl_query";
 216   merge[1] = buf;
 217   command = Tcl_Merge (2, merge);
 218   Tcl_Eval (interp, command);
 219   free (command);
 220
 221   val = atol (interp->result);
 222   return val;
 223 }
 224
 225 /* VARARGS */
 226 static void
 227 #ifdef ANSI_PROTOTYPES
 228 gdbtk_readline_begin (char *format, ...)
 229 #else
 230 gdbtk_readline_begin (va_alist)
 231      va_dcl
 232 #endif
 233 {
 234   va_list args;
 235   char buf[200], *merge[2];
 236   char *command;
 237
 238 #ifdef ANSI_PROTOTYPES
 239   va_start (args, format);
 240 #else
 241   char *format;
 242   va_start (args);
 243   format = va_arg (args, char *);
 244 #endif
 245
 246   vsprintf (buf, format, args);
 247   merge[0] = "gdbtk_tcl_readline_begin";
 248   merge[1] = buf;
 249   command = Tcl_Merge (2, merge);
 250   Tcl_Eval (interp, command);
 251   free (command);
 252 }
 253
 254 static char *
 255 gdbtk_readline (prompt)
 256      char *prompt;
 257 {
 258   char *merge[2];
 259   char *command;
 260
 261   merge[0] = "gdbtk_tcl_readline";
 262   merge[1] = prompt;
 263   command = Tcl_Merge (2, merge);
 264   if (Tcl_Eval (interp, command) == TCL_OK)
 265     {
 266       return (strdup (interp -> result));
 267     }
 268   else
 269     {
 270       gdbtk_fputs (interp -> result, gdb_stdout);
 271       gdbtk_fputs ("\n", gdb_stdout);
 272       return (NULL);
 273     }
 274 }
 275
 276 static void
 277 gdbtk_readline_end ()
 278 {
 279   Tcl_Eval (interp, "gdbtk_tcl_readline_end");
 280 }
 281
 282 \f
 283 static void
 284 #ifdef ANSI_PROTOTYPES
 285 dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
 286 #else
 287 dsprintf_append_element (va_alist)
 288      va_dcl
 289 #endif
 290 {
 291   va_list args;
 292   char buf[1024];
 293
 294 #ifdef ANSI_PROTOTYPES
 295   va_start (args, format);
 296 #else
 297   Tcl_DString *dsp;
 298   char *format;
 299
 300   va_start (args);
 301   dsp = va_arg (args, Tcl_DString *);
 302   format = va_arg (args, char *);
 303 #endif
 304
 305   vsprintf (buf, format, args);
 306
 307   Tcl_DStringAppendElement (dsp, buf);
 308 }
 309
 310 static int
 311 gdb_get_breakpoint_list (clientData, interp, argc, argv)
 312      ClientData clientData;
 313      Tcl_Interp *interp;
 314      int argc;
 315      char *argv[];
 316 {
 317   struct breakpoint *b;
 318   extern struct breakpoint *breakpoint_chain;
 319
 320   if (argc != 1)
 321     error ("wrong # args");
 322
 323   for (b = breakpoint_chain; b; b = b->next)
 324     if (b->type == bp_breakpoint)
 325       dsprintf_append_element (result_ptr, "%d", b->number);
 326
 327   return TCL_OK;
 328 }
 329
 330 static int
 331 gdb_get_breakpoint_info (clientData, interp, argc, argv)
 332      ClientData clientData;
 333      Tcl_Interp *interp;
 334      int argc;
 335      char *argv[];
 336 {
 337   struct symtab_and_line sal;
 338   static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
 339                               "finish", "watchpoint", "hardware watchpoint",
 340                               "read watchpoint", "access watchpoint",
 341                               "longjmp", "longjmp resume", "step resume",
 342                               "through sigtramp", "watchpoint scope",
 343                               "call dummy" };
 344   static char *bpdisp[] = {"delete", "disable", "donttouch"};
 345   struct command_line *cmd;
 346   int bpnum;
 347   struct breakpoint *b;
 348   extern struct breakpoint *breakpoint_chain;
 349
 350   if (argc != 2)
 351     error ("wrong # args");
 352
 353   bpnum = atoi (argv[1]);
 354
 355   for (b = breakpoint_chain; b; b = b->next)
 356     if (b->number == bpnum)
 357       break;
 358
 359   if (!b || b->type != bp_breakpoint)
 360     error ("Breakpoint #%d does not exist", bpnum);
 361
 362   sal = find_pc_line (b->address, 0);
 363
 364   Tcl_DStringAppendElement (result_ptr, symtab_to_filename (sal.symtab));
 365   dsprintf_append_element (result_ptr, "%d", sal.line);
 366   dsprintf_append_element (result_ptr, "0x%lx", b->address);
 367   Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
 368   Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
 369   Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
 370   dsprintf_append_element (result_ptr, "%d", b->silent);
 371   dsprintf_append_element (result_ptr, "%d", b->ignore_count);
 372
 373   Tcl_DStringStartSublist (result_ptr);
 374   for (cmd = b->commands; cmd; cmd = cmd->next)
 375     Tcl_DStringAppendElement (result_ptr, cmd->line);
 376   Tcl_DStringEndSublist (result_ptr);
 377
 378   Tcl_DStringAppendElement (result_ptr, b->cond_string);
 379
 380   dsprintf_append_element (result_ptr, "%d", b->thread);
 381   dsprintf_append_element (result_ptr, "%d", b->hit_count);
 382
 383   return TCL_OK;
 384 }
 385
 386 static void
 387 breakpoint_notify(b, action)
 388      struct breakpoint *b;
 389      const char *action;
 390 {
 391   char buf[100];
 392   int v;
 393
 394   if (b->type != bp_breakpoint)
 395     return;
 396
 397   /* We ensure that ACTION contains no special Tcl characters, so we
 398      can do this.  */
 399   sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number);
 400
 401   v = Tcl_Eval (interp, buf);
 402
 403   if (v != TCL_OK)
 404     {
 405       gdbtk_fputs (interp->result, gdb_stdout);
 406       gdbtk_fputs ("\n", gdb_stdout);
 407     }
 408 }
 409
 410 static void
 411 gdbtk_create_breakpoint(b)
 412      struct breakpoint *b;
 413 {
 414   breakpoint_notify (b, "create");
 415 }
 416
 417 static void
 418 gdbtk_delete_breakpoint(b)
 419      struct breakpoint *b;
 420 {
 421   breakpoint_notify (b, "delete");
 422 }
 423
 424 static void
 425 gdbtk_modify_breakpoint(b)
 426      struct breakpoint *b;
 427 {
 428   breakpoint_notify (b, "modify");
 429 }
 430 \f
 431 /* This implements the TCL command `gdb_loc', which returns a list consisting
 432    of the source and line number associated with the current pc. */
 433
 434 static int
 435 gdb_loc (clientData, interp, argc, argv)
 436      ClientData clientData;
 437      Tcl_Interp *interp;
 438      int argc;
 439      char *argv[];
 440 {
 441   char *filename;
 442   struct symtab_and_line sal;
 443   char *funcname;
 444   CORE_ADDR pc;
 445
 446   if (argc == 1)
 447     {
 448       pc = selected_frame ? selected_frame->pc : stop_pc;
 449       sal = find_pc_line (pc, 0);
 450     }
 451   else if (argc == 2)
 452     {
 453       struct symtabs_and_lines sals;
 454       int nelts;
 455
 456       sals = decode_line_spec (argv[1], 1);
 457
 458       nelts = sals.nelts;
 459       sal = sals.sals[0];
 460       free (sals.sals);
 461
 462       if (sals.nelts != 1)
 463         error ("Ambiguous line spec");
 464
 465       pc = sal.pc;
 466     }
 467   else
 468     error ("wrong # args");
 469
 470   if (sal.symtab)
 471     Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
 472   else
 473     Tcl_DStringAppendElement (result_ptr, "");
 474
 475   find_pc_partial_function (pc, &funcname, NULL, NULL);
 476   Tcl_DStringAppendElement (result_ptr, funcname);
 477
 478   filename = symtab_to_filename (sal.symtab);
 479   Tcl_DStringAppendElement (result_ptr, filename);
 480
 481   dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
 482
 483   dsprintf_append_element (result_ptr, "0x%lx", pc); /* PC */
 484
 485   return TCL_OK;
 486 }
 487 \f
 488 /* This implements the TCL command `gdb_eval'. */
 489
 490 static int
 491 gdb_eval (clientData, interp, argc, argv)
 492      ClientData clientData;
 493      Tcl_Interp *interp;
 494      int argc;
 495      char *argv[];
 496 {
 497   struct expression *expr;
 498   struct cleanup *old_chain;
 499   value_ptr val;
 500
 501   if (argc != 2)
 502     error ("wrong # args");
 503
 504   expr = parse_expression (argv[1]);
 505
 506   old_chain = make_cleanup (free_current_contents, &expr);
 507
 508   val = evaluate_expression (expr);
 509
 510   val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
 511              gdb_stdout, 0, 0, 0, 0);
 512
 513   do_cleanups (old_chain);
 514
 515   return TCL_OK;
 516 }
 517 \f
 518 /* This implements the TCL command `gdb_sourcelines', which returns a list of
 519    all of the lines containing executable code for the specified source file
 520    (ie: lines where you can put breakpoints). */
 521
 522 static int
 523 gdb_sourcelines (clientData, interp, argc, argv)
 524      ClientData clientData;
 525      Tcl_Interp *interp;
 526      int argc;
 527      char *argv[];
 528 {
 529   struct symtab *symtab;
 530   struct linetable_entry *le;
 531   int nlines;
 532
 533   if (argc != 2)
 534     error ("wrong # args");
 535
 536   symtab = lookup_symtab (argv[1]);
 537
 538   if (!symtab)
 539     error ("No such file");
 540
 541   /* If there's no linetable, or no entries, then we are done. */
 542
 543   if (!symtab->linetable
 544       || symtab->linetable->nitems == 0)
 545     {
 546       Tcl_DStringAppendElement (result_ptr, "");
 547       return TCL_OK;
 548     }
 549
 550   le = symtab->linetable->item;
 551   nlines = symtab->linetable->nitems;
 552
 553   for (;nlines > 0; nlines--, le++)
 554     {
 555       /* If the pc of this line is the same as the pc of the next line, then
 556          just skip it.  */
 557       if (nlines > 1
 558           && le->pc == (le + 1)->pc)
 559         continue;
 560
 561       dsprintf_append_element (result_ptr, "%d", le->line);
 562     }
 563
 564   return TCL_OK;
 565 }
 566 \f
 567 static int
 568 map_arg_registers (argc, argv, func, argp)
 569      int argc;
 570      char *argv[];
 571      void (*func) PARAMS ((int regnum, void *argp));
 572      void *argp;
 573 {
 574   int regnum;
 575
 576   /* Note that the test for a valid register must include checking the
 577      reg_names array because NUM_REGS may be allocated for the union of the
 578      register sets within a family of related processors.  In this case, the
 579      trailing entries of reg_names will change depending upon the particular
 580      processor being debugged.  */
 581
 582   if (argc == 0)                /* No args, just do all the regs */
 583     {
 584       for (regnum = 0;
 585            regnum < NUM_REGS
 586            && reg_names[regnum] != NULL
 587            && *reg_names[regnum] != '\000';
 588            regnum++)
 589         func (regnum, argp);
 590
 591       return TCL_OK;
 592     }
 593
 594   /* Else, list of register #s, just do listed regs */
 595   for (; argc > 0; argc--, argv++)
 596     {
 597       regnum = atoi (*argv);
 598
 599       if (regnum >= 0
 600           && regnum < NUM_REGS
 601           && reg_names[regnum] != NULL
 602           && *reg_names[regnum] != '\000')
 603         func (regnum, argp);
 604       else
 605         error ("bad register number");
 606     }
 607
 608   return TCL_OK;
 609 }
 610
 611 static void
 612 get_register_name (regnum, argp)
 613      int regnum;
 614      void *argp;                /* Ignored */
 615 {
 616   Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
 617 }
 618
 619 /* This implements the TCL command `gdb_regnames', which returns a list of
 620    all of the register names. */
 621
 622 static int
 623 gdb_regnames (clientData, interp, argc, argv)
 624      ClientData clientData;
 625      Tcl_Interp *interp;
 626      int argc;
 627      char *argv[];
 628 {
 629   argc--;
 630   argv++;
 631
 632   return map_arg_registers (argc, argv, get_register_name, NULL);
 633 }
 634
 635 #ifndef REGISTER_CONVERTIBLE
 636 #define REGISTER_CONVERTIBLE(x) (0 != 0)
 637 #endif
 638
 639 #ifndef REGISTER_CONVERT_TO_VIRTUAL
 640 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
 641 #endif
 642
 643 #ifndef INVALID_FLOAT
 644 #define INVALID_FLOAT(x, y) (0 != 0)
 645 #endif
 646
 647 static void
 648 get_register (regnum, fp)
 649      int regnum;
 650      void *fp;
 651 {
 652   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 653   char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
 654   int format = (int)fp;
 655
 656   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 657     {
 658       Tcl_DStringAppendElement (result_ptr, "Optimized out");
 659       return;
 660     }
 661
 662   /* Convert raw data to virtual format if necessary.  */
 663
 664   if (REGISTER_CONVERTIBLE (regnum))
 665     {
 666       REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
 667                                    raw_buffer, virtual_buffer);
 668     }
 669   else
 670     memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
 671
 672   if (format == 'r')
 673     {
 674       int j;
 675       printf_filtered ("0x");
 676       for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
 677         {
 678           register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
 679             : REGISTER_RAW_SIZE (regnum) - 1 - j;
 680           printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
 681         }
 682     }
 683   else
 684     val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
 685                gdb_stdout, format, 1, 0, Val_pretty_default);
 686
 687   Tcl_DStringAppend (result_ptr, " ", -1);
 688 }
 689
 690 static int
 691 gdb_fetch_registers (clientData, interp, argc, argv)
 692      ClientData clientData;
 693      Tcl_Interp *interp;
 694      int argc;
 695      char *argv[];
 696 {
 697   int format;
 698
 699   if (argc < 2)
 700     error ("wrong # args");
 701
 702   argc--;
 703   argv++;
 704
 705   argc--;
 706   format = **argv++;
 707
 708   return map_arg_registers (argc, argv, get_register, (void *) format);
 709 }
 710
 711 /* This contains the previous values of the registers, since the last call to
 712    gdb_changed_register_list.  */
 713
 714 static char old_regs[REGISTER_BYTES];
 715
 716 static void
 717 register_changed_p (regnum, argp)
 718      int regnum;
 719      void *argp;                /* Ignored */
 720 {
 721   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 722
 723   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 724     return;
 725
 726   if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 727               REGISTER_RAW_SIZE (regnum)) == 0)
 728     return;
 729
 730   /* Found a changed register.  Save new value and return its number. */
 731
 732   memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 733           REGISTER_RAW_SIZE (regnum));
 734
 735   dsprintf_append_element (result_ptr, "%d", regnum);
 736 }
 737
 738 static int
 739 gdb_changed_register_list (clientData, interp, argc, argv)
 740      ClientData clientData;
 741      Tcl_Interp *interp;
 742      int argc;
 743      char *argv[];
 744 {
 745   argc--;
 746   argv++;
 747
 748   return map_arg_registers (argc, argv, register_changed_p, NULL);
 749 }
 750 \f
 751 /* This implements the TCL command `gdb_cmd', which sends its argument into
 752    the GDB command scanner.  */
 753
 754 static int
 755 gdb_cmd (clientData, interp, argc, argv)
 756      ClientData clientData;
 757      Tcl_Interp *interp;
 758      int argc;
 759      char *argv[];
 760 {
 761   if (argc != 2)
 762     error ("wrong # args");
 763
 764   if (running_now)
 765     return TCL_OK;
 766
 767   execute_command (argv[1], 1);
 768
 769   bpstat_do_actions (&stop_bpstat);
 770
 771   return TCL_OK;
 772 }
 773
 774 /* This routine acts as a top-level for all GDB code called by tcl/Tk.  It
 775    handles cleanups, and calls to return_to_top_level (usually via error).
 776    This is necessary in order to prevent a longjmp out of the bowels of Tk,
 777    possibly leaving things in a bad state.  Since this routine can be called
 778    recursively, it needs to save and restore the contents of the jmp_buf as
 779    necessary.  */
 780
 781 static int
 782 call_wrapper (clientData, interp, argc, argv)
 783      ClientData clientData;
 784      Tcl_Interp *interp;
 785      int argc;
 786      char *argv[];
 787 {
 788   int val;
 789   struct cleanup *saved_cleanup_chain;
 790   Tcl_CmdProc *func;
 791   jmp_buf saved_error_return;
 792   Tcl_DString result, *old_result_ptr;
 793
 794   Tcl_DStringInit (&result);
 795   old_result_ptr = result_ptr;
 796   result_ptr = &result;
 797
 798   func = (Tcl_CmdProc *)clientData;
 799   memcpy (saved_error_return, error_return, sizeof (jmp_buf));
 800
 801   saved_cleanup_chain = save_cleanups ();
 802
 803   if (!setjmp (error_return))
 804     val = func (clientData, interp, argc, argv);
 805   else
 806     {
 807       val = TCL_ERROR;          /* Flag an error for TCL */
 808
 809       gdb_flush (gdb_stderr);   /* Flush error output */
 810
 811       gdb_flush (gdb_stdout);   /* Sometimes error output comes here as well */
 812
 813       /* In case of an error, we may need to force the GUI into idle
 814          mode because gdbtk_call_command may have bombed out while in
 815          the command routine.  */
 816
 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 (mainWindow != NULL)
1149     Tk_DestroyWindow (mainWindow);
1150   mainWindow = NULL;
1151
1152   if (interp != NULL)
1153     Tcl_DeleteInterp (interp);
1154   interp = NULL;
1155 }
1156
1157 /* Come here during long calculations to check for GUI events.  Usually invoked
1158    via the QUIT macro.  */
1159
1160 static void
1161 gdbtk_interactive ()
1162 {
1163   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1164 }
1165
1166 /* Come here when there is activity on the X file descriptor. */
1167
1168 static void
1169 x_event (signo)
1170      int signo;
1171 {
1172   /* Process pending events */
1173
1174   while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0);
1175 }
1176
1177 static int
1178 gdbtk_wait (pid, ourstatus)
1179      int pid;
1180      struct target_waitstatus *ourstatus;
1181 {
1182   struct sigaction action;
1183   static sigset_t nullsigmask = {0};
1184
1185 #ifndef SA_RESTART
1186   /* Needed for SunOS 4.1.x */
1187 #define SA_RESTART 0
1188 #endif
1189
1190   action.sa_handler = x_event;
1191   action.sa_mask = nullsigmask;
1192   action.sa_flags = SA_RESTART;
1193   sigaction(SIGIO, &action, NULL);
1194
1195   pid = target_wait (pid, ourstatus);
1196
1197   action.sa_handler = SIG_IGN;
1198   sigaction(SIGIO, &action, NULL);
1199
1200   return pid;
1201 }
1202
1203 /* This is called from execute_command, and provides a wrapper around
1204    various command routines in a place where both protocol messages and
1205    user input both flow through.  Mostly this is used for indicating whether
1206    the target process is running or not.
1207 */
1208
1209 static void
1210 gdbtk_call_command (cmdblk, arg, from_tty)
1211      struct cmd_list_element *cmdblk;
1212      char *arg;
1213      int from_tty;
1214 {
1215   running_now = 0;
1216   if (cmdblk->class == class_run)
1217     {
1218       running_now = 1;
1219       Tcl_Eval (interp, "gdbtk_tcl_busy");
1220       (*cmdblk->function.cfunc)(arg, from_tty);
1221       Tcl_Eval (interp, "gdbtk_tcl_idle");
1222       running_now = 0;
1223     }
1224   else
1225     (*cmdblk->function.cfunc)(arg, from_tty);
1226 }
1227
1228 /* This function is called instead of gdb's internal command loop.  This is the
1229    last chance to do anything before entering the main Tk event loop. */
1230
1231 static void
1232 tk_command_loop ()
1233 {
1234   extern GDB_FILE *instream;
1235
1236   /* We no longer want to use stdin as the command input stream */
1237   instream = NULL;
1238   Tcl_Eval (interp, "gdbtk_tcl_preloop");
1239   Tk_MainLoop ();
1240 }
1241
1242 static void
1243 gdbtk_init ()
1244 {
1245   struct cleanup *old_chain;
1246   char *gdbtk_filename;
1247   int i;
1248   struct sigaction action;
1249   static sigset_t nullsigmask = {0};
1250
1251   old_chain = make_cleanup (cleanup_init, 0);
1252
1253   /* First init tcl and tk. */
1254
1255   interp = Tcl_CreateInterp ();
1256
1257   if (!interp)
1258     error ("Tcl_CreateInterp failed");
1259
1260   mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
1261
1262   if (!mainWindow)
1263     return;                     /* DISPLAY probably not set */
1264
1265   if (Tcl_Init(interp) != TCL_OK)
1266     error ("Tcl_Init failed: %s", interp->result);
1267
1268   if (Tk_Init(interp) != TCL_OK)
1269     error ("Tk_Init failed: %s", interp->result);
1270
1271   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
1272   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
1273   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
1274                      NULL);
1275   Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
1276                      NULL);
1277   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
1278   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
1279   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
1280                      gdb_fetch_registers, NULL);
1281   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
1282                      gdb_changed_register_list, NULL);
1283   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
1284                      gdb_disassemble, NULL);
1285   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
1286   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
1287                      gdb_get_breakpoint_list, NULL);
1288   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
1289                      gdb_get_breakpoint_info, NULL);
1290
1291   command_loop_hook = tk_command_loop;
1292   print_frame_info_listing_hook =
1293     (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
1294   query_hook = gdbtk_query;
1295   flush_hook = gdbtk_flush;
1296   create_breakpoint_hook = gdbtk_create_breakpoint;
1297   delete_breakpoint_hook = gdbtk_delete_breakpoint;
1298   modify_breakpoint_hook = gdbtk_modify_breakpoint;
1299   interactive_hook = gdbtk_interactive;
1300   target_wait_hook = gdbtk_wait;
1301   call_command_hook = gdbtk_call_command;
1302   readline_begin_hook = gdbtk_readline_begin;
1303   readline_hook = gdbtk_readline;
1304   readline_end_hook = gdbtk_readline_end;
1305
1306   /* Get the file descriptor for the X server */
1307
1308   x_fd = ConnectionNumber (Tk_Display (mainWindow));
1309
1310   /* Setup for I/O interrupts */
1311
1312   action.sa_mask = nullsigmask;
1313   action.sa_flags = 0;
1314   action.sa_handler = SIG_IGN;
1315   sigaction(SIGIO, &action, NULL);
1316
1317 #ifdef FIOASYNC
1318   i = 1;
1319   if (ioctl (x_fd, FIOASYNC, &i))
1320     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
1321
1322 #ifdef SIOCSPGRP
1323   i = getpid();
1324   if (ioctl (x_fd, SIOCSPGRP, &i))
1325     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
1326
1327 #else
1328 #ifdef F_SETOWN
1329   i = getpid();
1330   if (fcntl (x_fd, F_SETOWN, i))
1331     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
1332 #endif  /* F_SETOWN */
1333 #endif  /* !SIOCSPGRP */
1334 #else
1335   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
1336     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
1337 #endif /* ifndef FIOASYNC */
1338
1339   add_com ("tk", class_obscure, tk_command,
1340            "Send a command directly into tk.");
1341
1342   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
1343                TCL_LINK_INT);
1344
1345   /* Load up gdbtk.tcl after all the environment stuff has been setup.  */
1346
1347   gdbtk_filename = getenv ("GDBTK_FILENAME");
1348   if (!gdbtk_filename)
1349     if (access ("gdbtk.tcl", R_OK) == 0)
1350       gdbtk_filename = "gdbtk.tcl";
1351     else
1352       gdbtk_filename = GDBTK_FILENAME;
1353
1354 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
1355    prior to this point go to stdout/stderr.  */
1356
1357   fputs_unfiltered_hook = gdbtk_fputs;
1358
1359   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
1360     {
1361       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
1362
1363       fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename,
1364                           interp->errorLine, interp->result);
1365
1366       fputs_unfiltered ("Stack trace:\n", gdb_stderr);
1367       fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
1368       error ("");
1369     }
1370
1371   discard_cleanups (old_chain);
1372 }
1373
1374 /* Come here during initialize_all_files () */
1375
1376 void
1377 _initialize_gdbtk ()
1378 {
1379   if (use_windows)
1380     {
1381       /* Tell the rest of the world that Gdbtk is now set up. */
1382
1383       init_ui_hook = gdbtk_init;
1384     }
1385 }