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