gdb/gdbtk.c

   1 /* Tcl/Tk interface routines.
   2    Copyright 1994, 1995, 1996, 1997 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 "gdbcore.h"
  31 #include "tracepoint.h"
  32
  33 #ifdef _WIN32
  34 #include <winuser.h>
  35 #endif
  36
  37 #include <tcl.h>
  38 #include <tk.h>
  39 #include <itcl.h>
  40 #include <tix.h>
  41 #include "guitcl.h"
  42
  43 #ifdef IDE
  44 /* start-sanitize-ide */
  45 #include "event.h"
  46 #include "idetcl.h"
  47 #include "ilutk.h"
  48 /* end-sanitize-ide */
  49 #endif
  50
  51 #ifdef ANSI_PROTOTYPES
  52 #include <stdarg.h>
  53 #else
  54 #include <varargs.h>
  55 #endif
  56 #include <signal.h>
  57 #include <fcntl.h>
  58 #include <unistd.h>
  59 #include <setjmp.h>
  60 #include "top.h"
  61 #include <sys/ioctl.h>
  62 #include "gdb_string.h"
  63 #include "dis-asm.h"
  64 #include <stdio.h>
  65 #include "gdbcmd.h"
  66
  67 #ifndef WINNT
  68 #ifndef FIOASYNC
  69 #include <sys/stropts.h>
  70 #endif
  71 #endif
  72
  73 #ifdef __CYGWIN32__
  74 #include <sys/time.h>
  75 #endif
  76
  77 #ifdef WINNT
  78 #define GDBTK_PATH_SEP ";"
  79 #else
  80 #define GDBTK_PATH_SEP ":"
  81 #endif
  82
  83 /* Some versions (1.3.79, 1.3.81) of Linux don't support SIOCSPGRP the way
  84    gdbtk wants to use it... */
  85 #ifdef __linux__
  86 #undef SIOCSPGRP
  87 #endif
  88
  89 static int load_in_progress = 0;
  90
  91 int gdbtk_load_hash PARAMS ((char *, unsigned long));
  92 int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
  93 void (*pre_add_symbol_hook) PARAMS ((char *));
  94 void (*post_add_symbol_hook) PARAMS ((void));
  95
  96 static void null_routine PARAMS ((int));
  97 static void gdbtk_flush PARAMS ((FILE *));
  98 static void gdbtk_fputs PARAMS ((const char *, FILE *));
  99 static int gdbtk_query PARAMS ((const char *, va_list));
 100 static char *gdbtk_readline PARAMS ((char *));
 101 static void gdbtk_init PARAMS ((char *));
 102 static void tk_command_loop PARAMS ((void));
 103 static void gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
 104 static int gdbtk_wait PARAMS ((int, struct target_waitstatus *));
 105 static void x_event PARAMS ((int));
 106 static void gdbtk_interactive PARAMS ((void));
 107 static void cleanup_init PARAMS ((int));
 108 static void tk_command PARAMS ((char *, int));
 109 static int gdb_disassemble PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 110 static int compare_lines PARAMS ((const PTR, const PTR));
 111 static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
 112 static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 113 static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 114 static int gdb_confirm_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 115 static int gdb_force_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 116 static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 117 static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 118 static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 119 static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 120 static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 121 static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 122 static void gdbtk_readline_end PARAMS ((void));
 123 static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 124 static void register_changed_p PARAMS ((int, void *));
 125 static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 126 static int gdb_get_breakpoint_info PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 127 static void breakpoint_notify PARAMS ((struct breakpoint *, const char *));
 128 static void gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
 129 static void gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
 130 static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
 131 static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 132 static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 133 static int gdb_sourcelines PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 134 static int map_arg_registers PARAMS ((int, char *[], void (*) (int, void *), void *));
 135 static void get_register_name PARAMS ((int, void *));
 136 static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 137 static void get_register PARAMS ((int, void *));
 138 static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 139 static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 140 void TclDebug PARAMS ((const char *fmt, ...));
 141 static int gdb_get_vars_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 142 static int gdb_get_function_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 143 static int gdb_get_line_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 144 static int gdb_get_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 145 static int gdb_tracepoint_exists_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 146 static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 147 static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 148 static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 149 static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 150 static char *find_file_in_dir PARAMS ((char *));
 151 static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 152 static void gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
 153 static void gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
 154 static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
 155 void gdbtk_pre_add_symbol PARAMS ((char *));
 156 void gdbtk_post_add_symbol PARAMS ((void));
 157
 158 /* Handle for TCL interpreter */
 159
 160 static Tcl_Interp *interp = NULL;
 161
 162 #ifndef WINNT
 163 static int x_fd;                /* X network socket */
 164 #endif
 165
 166 #ifdef __CYGWIN32__
 167
 168 /* On Windows we use timer interrupts when gdb might otherwise hang
 169    for a long time.  See the comment above gdbtk_start_timer.  This
 170    variable is true when timer interrupts are being used.  */
 171
 172 static int gdbtk_timer_going = 0;
 173
 174 static void gdbtk_start_timer PARAMS ((void));
 175 static void gdbtk_stop_timer PARAMS ((void));
 176
 177 #endif
 178
 179 /* This variable is true when the inferior is running.  Although it's
 180    possible to disable most input from widgets and thus prevent
 181    attempts to do anything while the inferior is running, any commands
 182    that get through - even a simple memory read - are Very Bad, and
 183    may cause GDB to crash or behave strangely.  So, this variable
 184    provides an extra layer of defense.  */
 185
 186 static int running_now;
 187
 188 /* This variable determines where memory used for disassembly is read from.
 189    If > 0, then disassembly comes from the exec file rather than the
 190    target (which might be at the other end of a slow serial link).  If
 191    == 0 then disassembly comes from target.  If < 0 disassembly is
 192    automatically switched to the target if it's an inferior process,
 193    otherwise the exec file is used.  */
 194
 195 static int disassemble_from_exec = -1;
 196
 197 #ifndef _WIN32
 198
 199 /* Supply malloc calls for tcl/tk.  We do not want to do this on
 200    Windows, because Tcl_Alloc is probably in a DLL which will not call
 201    the mmalloc routines.  */
 202
 203 char *
 204 Tcl_Alloc (size)
 205      unsigned int size;
 206 {
 207   return xmalloc (size);
 208 }
 209
 210 char *
 211 Tcl_Realloc (ptr, size)
 212      char *ptr;
 213      unsigned int size;
 214 {
 215   return xrealloc (ptr, size);
 216 }
 217
 218 void
 219 Tcl_Free(ptr)
 220      char *ptr;
 221 {
 222   free (ptr);
 223 }
 224
 225 #endif /* ! _WIN32 */
 226
 227 static void
 228 null_routine(arg)
 229      int arg;
 230 {
 231 }
 232
 233 #ifdef _WIN32
 234
 235 /* On Windows, if we hold a file open, other programs can't write to
 236    it.  In particular, we don't want to hold the executable open,
 237    because it will mean that people have to get out of the debugging
 238    session in order to remake their program.  So we close it, although
 239    this will cost us if and when we need to reopen it.  */
 240
 241 static void
 242 close_bfds ()
 243 {
 244   struct objfile *o;
 245
 246   ALL_OBJFILES (o)
 247     {
 248       if (o->obfd != NULL)
 249         bfd_cache_close (o->obfd);
 250     }
 251
 252   if (exec_bfd != NULL)
 253     bfd_cache_close (exec_bfd);
 254 }
 255
 256 #endif /* _WIN32 */
 257
 258 /* The following routines deal with stdout/stderr data, which is created by
 259    {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
 260    lowest level of these routines and capture all output from the rest of GDB.
 261    Normally they present their data to tcl via callbacks to the following tcl
 262    routines:  gdbtk_tcl_fputs, gdbtk_tcl_fputs_error, and gdbtk_flush.  These
 263    in turn call tk routines to update the display.
 264
 265    Under some circumstances, you may want to collect the output so that it can
 266    be returned as the value of a tcl procedure.  This can be done by
 267    surrounding the output routines with calls to start_saving_output and
 268    finish_saving_output.  The saved data can then be retrieved with
 269    get_saved_output (but this must be done before the call to
 270    finish_saving_output).  */
 271
 272 /* Dynamic string for output. */
 273
 274 static Tcl_DString *result_ptr;
 275
 276 /* Dynamic string for stderr.  This is only used if result_ptr is
 277    NULL.  */
 278
 279 static Tcl_DString *error_string_ptr;
 280 \f
 281 static void
 282 gdbtk_flush (stream)
 283      FILE *stream;
 284 {
 285 #if 0
 286   /* Force immediate screen update */
 287
 288   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
 289 #endif
 290 }
 291
 292 static void
 293 gdbtk_fputs (ptr, stream)
 294      const char *ptr;
 295      FILE *stream;
 296 {
 297   if (result_ptr)
 298     Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
 299   else if (error_string_ptr != NULL && stream == gdb_stderr)
 300     Tcl_DStringAppend (error_string_ptr, (char *) ptr, -1);
 301   else
 302     {
 303       Tcl_DString str;
 304
 305       Tcl_DStringInit (&str);
 306
 307       Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
 308       Tcl_DStringAppendElement (&str, (char *)ptr);
 309
 310       Tcl_Eval (interp, Tcl_DStringValue (&str));
 311       Tcl_DStringFree (&str);
 312     }
 313 }
 314
 315 static int
 316 gdbtk_query (query, args)
 317      const char *query;
 318      va_list args;
 319 {
 320   char buf[200], *merge[2];
 321   char *command;
 322   long val;
 323
 324   vsprintf (buf, query, args);
 325   merge[0] = "gdbtk_tcl_query";
 326   merge[1] = buf;
 327   command = Tcl_Merge (2, merge);
 328   Tcl_Eval (interp, command);
 329   Tcl_Free (command);
 330
 331   val = atol (interp->result);
 332   return val;
 333 }
 334
 335 /* VARARGS */
 336 static void
 337 #ifdef ANSI_PROTOTYPES
 338 gdbtk_readline_begin (char *format, ...)
 339 #else
 340 gdbtk_readline_begin (va_alist)
 341      va_dcl
 342 #endif
 343 {
 344   va_list args;
 345   char buf[200], *merge[2];
 346   char *command;
 347
 348 #ifdef ANSI_PROTOTYPES
 349   va_start (args, format);
 350 #else
 351   char *format;
 352   va_start (args);
 353   format = va_arg (args, char *);
 354 #endif
 355
 356   vsprintf (buf, format, args);
 357   merge[0] = "gdbtk_tcl_readline_begin";
 358   merge[1] = buf;
 359   command = Tcl_Merge (2, merge);
 360   Tcl_Eval (interp, command);
 361   free (command);
 362 }
 363
 364 static char *
 365 gdbtk_readline (prompt)
 366      char *prompt;
 367 {
 368   char *merge[2];
 369   char *command;
 370   int result;
 371
 372 #ifdef _WIN32
 373   close_bfds ();
 374 #endif
 375
 376   merge[0] = "gdbtk_tcl_readline";
 377   merge[1] = prompt;
 378   command = Tcl_Merge (2, merge);
 379   result = Tcl_Eval (interp, command);
 380   free (command);
 381   if (result == TCL_OK)
 382     {
 383       return (strdup (interp -> result));
 384     }
 385   else
 386     {
 387       gdbtk_fputs (interp -> result, gdb_stdout);
 388       gdbtk_fputs ("\n", gdb_stdout);
 389       return (NULL);
 390     }
 391 }
 392
 393 static void
 394 gdbtk_readline_end ()
 395 {
 396   Tcl_Eval (interp, "gdbtk_tcl_readline_end");
 397 }
 398
 399 \f
 400 static void
 401 #ifdef ANSI_PROTOTYPES
 402 dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
 403 #else
 404 dsprintf_append_element (va_alist)
 405      va_dcl
 406 #endif
 407 {
 408   va_list args;
 409   char buf[1024];
 410
 411 #ifdef ANSI_PROTOTYPES
 412   va_start (args, format);
 413 #else
 414   Tcl_DString *dsp;
 415   char *format;
 416
 417   va_start (args);
 418   dsp = va_arg (args, Tcl_DString *);
 419   format = va_arg (args, char *);
 420 #endif
 421
 422   vsprintf (buf, format, args);
 423
 424   Tcl_DStringAppendElement (dsp, buf);
 425 }
 426
 427 static int
 428 gdb_path_conv (clientData, interp, argc, argv)
 429      ClientData clientData;
 430      Tcl_Interp *interp;
 431      int argc;
 432      char *argv[];
 433 {
 434 #ifdef WINNT
 435   char pathname[256], *ptr;
 436   if (argc != 2)
 437     error ("wrong # args");
 438   cygwin32_conv_to_full_win32_path (argv[1], pathname);
 439   for (ptr = pathname; *ptr; ptr++)
 440     {
 441       if (*ptr == '\\')
 442         *ptr = '/';
 443     }
 444 #else
 445   char *pathname = argv[1];
 446 #endif
 447   Tcl_DStringAppend (result_ptr, pathname, strlen(pathname));
 448   return TCL_OK;
 449 }
 450
 451 static int
 452 gdb_get_breakpoint_list (clientData, interp, argc, argv)
 453      ClientData clientData;
 454      Tcl_Interp *interp;
 455      int argc;
 456      char *argv[];
 457 {
 458   struct breakpoint *b;
 459   extern struct breakpoint *breakpoint_chain;
 460
 461   if (argc != 1)
 462     error ("wrong # args");
 463
 464   for (b = breakpoint_chain; b; b = b->next)
 465     if (b->type == bp_breakpoint)
 466       dsprintf_append_element (result_ptr, "%d", b->number);
 467
 468   return TCL_OK;
 469 }
 470
 471 static int
 472 gdb_get_breakpoint_info (clientData, interp, argc, argv)
 473      ClientData clientData;
 474      Tcl_Interp *interp;
 475      int argc;
 476      char *argv[];
 477 {
 478   struct symtab_and_line sal;
 479   static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
 480                               "finish", "watchpoint", "hardware watchpoint",
 481                               "read watchpoint", "access watchpoint",
 482                               "longjmp", "longjmp resume", "step resume",
 483                               "through sigtramp", "watchpoint scope",
 484                               "call dummy" };
 485   static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
 486   struct command_line *cmd;
 487   int bpnum;
 488   struct breakpoint *b;
 489   extern struct breakpoint *breakpoint_chain;
 490   char *funcname, *filename;
 491
 492   if (argc != 2)
 493     error ("wrong # args");
 494
 495   bpnum = atoi (argv[1]);
 496
 497   for (b = breakpoint_chain; b; b = b->next)
 498     if (b->number == bpnum)
 499       break;
 500
 501   if (!b || b->type != bp_breakpoint)
 502     error ("Breakpoint #%d does not exist", bpnum);
 503
 504   sal = find_pc_line (b->address, 0);
 505
 506   filename = symtab_to_filename (sal.symtab);
 507   if (filename == NULL)
 508     filename = "";
 509   Tcl_DStringAppendElement (result_ptr, filename);
 510   find_pc_partial_function (b->address, &funcname, NULL, NULL);
 511   Tcl_DStringAppendElement (result_ptr, funcname);
 512   dsprintf_append_element (result_ptr, "%d", sal.line);
 513   dsprintf_append_element (result_ptr, "0x%lx", b->address);
 514   Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
 515   Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
 516   Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
 517   dsprintf_append_element (result_ptr, "%d", b->ignore_count);
 518
 519   Tcl_DStringStartSublist (result_ptr);
 520   for (cmd = b->commands; cmd; cmd = cmd->next)
 521     Tcl_DStringAppendElement (result_ptr, cmd->line);
 522   Tcl_DStringEndSublist (result_ptr);
 523
 524   Tcl_DStringAppendElement (result_ptr, b->cond_string);
 525
 526   dsprintf_append_element (result_ptr, "%d", b->thread);
 527   dsprintf_append_element (result_ptr, "%d", b->hit_count);
 528
 529   return TCL_OK;
 530 }
 531
 532 static void
 533 breakpoint_notify(b, action)
 534      struct breakpoint *b;
 535      const char *action;
 536 {
 537   char buf[256];
 538   int v;
 539   struct symtab_and_line sal;
 540   char *filename;
 541
 542   if (b->type != bp_breakpoint)
 543     return;
 544
 545   /* We ensure that ACTION contains no special Tcl characters, so we
 546      can do this.  */
 547   sal = find_pc_line (b->address, 0);
 548   filename = symtab_to_filename (sal.symtab);
 549   if (filename == NULL)
 550     filename = "N/A";
 551   sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number,
 552            (long)b->address, sal.line, filename);
 553
 554   v = Tcl_Eval (interp, buf);
 555
 556   if (v != TCL_OK)
 557     {
 558       gdbtk_fputs (interp->result, gdb_stdout);
 559       gdbtk_fputs ("\n", gdb_stdout);
 560     }
 561 }
 562
 563 static void
 564 gdbtk_create_breakpoint(b)
 565      struct breakpoint *b;
 566 {
 567   breakpoint_notify (b, "create");
 568 }
 569
 570 static void
 571 gdbtk_delete_breakpoint(b)
 572      struct breakpoint *b;
 573 {
 574   breakpoint_notify (b, "delete");
 575 }
 576
 577 static void
 578 gdbtk_modify_breakpoint(b)
 579      struct breakpoint *b;
 580 {
 581   breakpoint_notify (b, "modify");
 582 }
 583 \f
 584 /* This implements the TCL command `gdb_loc', which returns a list consisting
 585    of the source and line number associated with the current pc. */
 586
 587 static int
 588 gdb_loc (clientData, interp, argc, argv)
 589      ClientData clientData;
 590      Tcl_Interp *interp;
 591      int argc;
 592      char *argv[];
 593 {
 594   char *filename;
 595   struct symtab_and_line sal;
 596   char *funcname;
 597   CORE_ADDR pc;
 598
 599   if (!have_full_symbols () && !have_partial_symbols ())
 600     {
 601       Tcl_SetResult (interp, "No symbol table is loaded", TCL_STATIC);
 602       return TCL_ERROR;
 603     }
 604
 605   if (argc == 1)
 606     {
 607       if (selected_frame)
 608         {
 609           sal = find_pc_line (selected_frame->pc,
 610                               selected_frame->next != NULL
 611                               && !selected_frame->next->signal_handler_caller
 612                               && !frame_in_dummy (selected_frame->next));
 613         }
 614       else
 615         sal = find_pc_line (stop_pc, 0);
 616     }
 617   else if (argc == 2)
 618     {
 619       struct symtabs_and_lines sals;
 620       int nelts;
 621
 622       sals = decode_line_spec (argv[1], 1);
 623
 624       nelts = sals.nelts;
 625       sal = sals.sals[0];
 626       free (sals.sals);
 627
 628       if (sals.nelts != 1)
 629         error ("Ambiguous line spec");
 630     }
 631   else
 632     error ("wrong # args");
 633
 634   pc = sal.pc;
 635   if (sal.symtab)
 636     Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
 637   else
 638     Tcl_DStringAppendElement (result_ptr, "");
 639
 640   find_pc_partial_function (pc, &funcname, NULL, NULL);
 641   Tcl_DStringAppendElement (result_ptr, funcname);
 642
 643   filename = symtab_to_filename (sal.symtab);
 644   if (filename == NULL)
 645     filename = "N/A";
 646
 647   Tcl_DStringAppendElement (result_ptr, filename);
 648   dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
 649   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
 650   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
 651   return TCL_OK;
 652 }
 653 \f
 654 /* This implements the TCL command `gdb_eval'. */
 655
 656 static int
 657 gdb_eval (clientData, interp, argc, argv)
 658      ClientData clientData;
 659      Tcl_Interp *interp;
 660      int argc;
 661      char *argv[];
 662 {
 663   struct expression *expr;
 664   struct cleanup *old_chain;
 665   value_ptr val;
 666
 667   if (argc != 2)
 668     error ("wrong # args");
 669
 670   expr = parse_expression (argv[1]);
 671
 672   old_chain = make_cleanup (free_current_contents, &expr);
 673
 674   val = evaluate_expression (expr);
 675
 676   val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
 677              gdb_stdout, 0, 0, 0, 0);
 678
 679   do_cleanups (old_chain);
 680
 681   return TCL_OK;
 682 }
 683
 684 /* gdb_get_mem addr form size num aschar*/
 685 /* dump a block of memory */
 686 /* addr: address of data to dump */
 687 /* form: a char indicating format */
 688 /* size: size of each element; 1,2,4, or 8 bytes*/
 689 /* num: the number of 'size' elements to return */
 690 /* acshar:  an optional ascii character to use in ASCII dump */
 691 /* returns a list of 'num' elements followed by an optional */
 692 /* ASCII dump */
 693 static int
 694 gdb_get_mem (clientData, interp, argc, argv)
 695      ClientData clientData;
 696      Tcl_Interp *interp;
 697      int argc;
 698      char *argv[];
 699 {
 700   int size, asize, num, i, j;
 701   CORE_ADDR addr, saved_addr, ptr;
 702   int format;
 703   struct type *val_type;
 704   value_ptr vptr;
 705   char c, buff[128], aschar;
 706
 707   if (argc != 6)
 708     error ("wrong # args");
 709
 710   addr = (CORE_ADDR)strtoul(argv[1],(char **)NULL,0);
 711   saved_addr = addr;
 712   format = *argv[2];
 713   size = (int)strtoul(argv[3],(char **)NULL,0);
 714   num = (int)strtoul(argv[4],(char **)NULL,0);
 715   aschar = *argv[5];
 716
 717   switch (size) {
 718   case 1:
 719     val_type = builtin_type_char;
 720     asize = 'b';
 721     break;
 722   case 2:
 723     val_type = builtin_type_short;
 724     asize = 'h';
 725     break;
 726   case 4:
 727     val_type = builtin_type_int;
 728     asize = 'w';
 729     break;
 730   case 8:
 731     val_type = builtin_type_long_long;
 732     asize = 'g';
 733     break;
 734   default:
 735     val_type = builtin_type_char;
 736     asize = 'b';
 737   }
 738
 739   for (i=0; i < num; i++)
 740     {
 741       vptr = value_at (val_type, addr, (asection *)NULL);
 742       print_scalar_formatted (VALUE_CONTENTS(vptr), val_type, format, asize, gdb_stdout);
 743       fputs_unfiltered (" ", gdb_stdout);
 744       addr += size;
 745     }
 746
 747   if (aschar)
 748     {
 749       val_type = builtin_type_char;
 750       ptr = saved_addr;
 751       buff[0] = '"';
 752       i = 1;
 753       for (j=0; j < num*size; j++)
 754         {
 755           c = *(char *)VALUE_CONTENTS(value_at (val_type, ptr, (asection *)NULL));
 756           if (c < 32 || c > 126)
 757             c = aschar;
 758           if (c == '"')
 759             buff[i++] = '\\';
 760           buff[i++] = c;
 761           ptr++;
 762         }
 763       buff[i++] = '"';
 764       buff[i] = 0;
 765       fputs_unfiltered (buff, gdb_stdout);
 766     }
 767
 768   return TCL_OK;
 769 }
 770
 771
 772 /* This implements the TCL command `gdb_sourcelines', which returns a list of
 773    all of the lines containing executable code for the specified source file
 774    (ie: lines where you can put breakpoints). */
 775
 776 static int
 777 gdb_sourcelines (clientData, interp, argc, argv)
 778      ClientData clientData;
 779      Tcl_Interp *interp;
 780      int argc;
 781      char *argv[];
 782 {
 783   struct symtab *symtab;
 784   struct linetable_entry *le;
 785   int nlines;
 786
 787   if (argc != 2)
 788     error ("wrong # args");
 789
 790   symtab = lookup_symtab (argv[1]);
 791
 792   if (!symtab)
 793     error ("No such file");
 794
 795   /* If there's no linetable, or no entries, then we are done. */
 796
 797   if (!symtab->linetable
 798       || symtab->linetable->nitems == 0)
 799     {
 800       Tcl_DStringAppendElement (result_ptr, "");
 801       return TCL_OK;
 802     }
 803
 804   le = symtab->linetable->item;
 805   nlines = symtab->linetable->nitems;
 806
 807   for (;nlines > 0; nlines--, le++)
 808     {
 809       /* If the pc of this line is the same as the pc of the next line, then
 810          just skip it.  */
 811       if (nlines > 1
 812           && le->pc == (le + 1)->pc)
 813         continue;
 814
 815       dsprintf_append_element (result_ptr, "%d", le->line);
 816     }
 817
 818   return TCL_OK;
 819 }
 820 \f
 821 static int
 822 map_arg_registers (argc, argv, func, argp)
 823      int argc;
 824      char *argv[];
 825      void (*func) PARAMS ((int regnum, void *argp));
 826      void *argp;
 827 {
 828   int regnum;
 829
 830   /* Note that the test for a valid register must include checking the
 831      reg_names array because NUM_REGS may be allocated for the union of the
 832      register sets within a family of related processors.  In this case, the
 833      trailing entries of reg_names will change depending upon the particular
 834      processor being debugged.  */
 835
 836   if (argc == 0)                /* No args, just do all the regs */
 837     {
 838       for (regnum = 0;
 839            regnum < NUM_REGS
 840            && reg_names[regnum] != NULL
 841            && *reg_names[regnum] != '\000';
 842            regnum++)
 843         func (regnum, argp);
 844
 845       return TCL_OK;
 846     }
 847
 848   /* Else, list of register #s, just do listed regs */
 849   for (; argc > 0; argc--, argv++)
 850     {
 851       regnum = atoi (*argv);
 852
 853       if (regnum >= 0
 854           && regnum < NUM_REGS
 855           && reg_names[regnum] != NULL
 856           && *reg_names[regnum] != '\000')
 857         func (regnum, argp);
 858       else
 859         error ("bad register number");
 860     }
 861
 862   return TCL_OK;
 863 }
 864
 865 static void
 866 get_register_name (regnum, argp)
 867      int regnum;
 868      void *argp;                /* Ignored */
 869 {
 870   Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
 871 }
 872
 873 /* This implements the TCL command `gdb_regnames', which returns a list of
 874    all of the register names. */
 875
 876 static int
 877 gdb_regnames (clientData, interp, argc, argv)
 878      ClientData clientData;
 879      Tcl_Interp *interp;
 880      int argc;
 881      char *argv[];
 882 {
 883   argc--;
 884   argv++;
 885
 886   return map_arg_registers (argc, argv, get_register_name, NULL);
 887 }
 888
 889 #ifndef REGISTER_CONVERTIBLE
 890 #define REGISTER_CONVERTIBLE(x) (0 != 0)
 891 #endif
 892
 893 #ifndef REGISTER_CONVERT_TO_VIRTUAL
 894 #define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
 895 #endif
 896
 897 #ifndef INVALID_FLOAT
 898 #define INVALID_FLOAT(x, y) (0 != 0)
 899 #endif
 900
 901 static void
 902 get_register (regnum, fp)
 903      int regnum;
 904      void *fp;
 905 {
 906   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 907   char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
 908   int format = (int)fp;
 909
 910   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 911     {
 912       Tcl_DStringAppendElement (result_ptr, "Optimized out");
 913       return;
 914     }
 915
 916   /* Convert raw data to virtual format if necessary.  */
 917
 918   if (REGISTER_CONVERTIBLE (regnum))
 919     {
 920       REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
 921                                    raw_buffer, virtual_buffer);
 922     }
 923   else
 924     memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
 925
 926   if (format == 'r')
 927     {
 928       int j;
 929       printf_filtered ("0x");
 930       for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
 931         {
 932           register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
 933             : REGISTER_RAW_SIZE (regnum) - 1 - j;
 934           printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
 935         }
 936     }
 937   else
 938     val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
 939                gdb_stdout, format, 1, 0, Val_pretty_default);
 940
 941   Tcl_DStringAppend (result_ptr, " ", -1);
 942 }
 943
 944 static int
 945 gdb_fetch_registers (clientData, interp, argc, argv)
 946      ClientData clientData;
 947      Tcl_Interp *interp;
 948      int argc;
 949      char *argv[];
 950 {
 951   int format;
 952
 953   if (argc < 2)
 954     error ("wrong # args");
 955
 956   argc--;
 957   argv++;
 958
 959   argc--;
 960   format = **argv++;
 961
 962   return map_arg_registers (argc, argv, get_register, (void *) format);
 963 }
 964
 965 /* This contains the previous values of the registers, since the last call to
 966    gdb_changed_register_list.  */
 967
 968 static char old_regs[REGISTER_BYTES];
 969
 970 static void
 971 register_changed_p (regnum, argp)
 972      int regnum;
 973      void *argp;                /* Ignored */
 974 {
 975   char raw_buffer[MAX_REGISTER_RAW_SIZE];
 976
 977   if (read_relative_register_raw_bytes (regnum, raw_buffer))
 978     return;
 979
 980   if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 981               REGISTER_RAW_SIZE (regnum)) == 0)
 982     return;
 983
 984   /* Found a changed register.  Save new value and return its number. */
 985
 986   memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
 987           REGISTER_RAW_SIZE (regnum));
 988
 989   dsprintf_append_element (result_ptr, "%d", regnum);
 990 }
 991
 992 static int
 993 gdb_changed_register_list (clientData, interp, argc, argv)
 994      ClientData clientData;
 995      Tcl_Interp *interp;
 996      int argc;
 997      char *argv[];
 998 {
 999   argc--;
1000   argv++;
1001
1002   return map_arg_registers (argc, argv, register_changed_p, NULL);
1003 }
1004 \f
1005 /* This implements the tcl command "gdb_immediate", which does exactly
1006    the same thing as gdb_cmd, except NONE of its outut is buffered. */
1007 static int
1008 gdb_immediate_command (clientData, interp, argc, argv)
1009      ClientData clientData;
1010      Tcl_Interp *interp;
1011      int argc;
1012      char *argv[];
1013 {
1014   Tcl_DString *save_ptr = NULL;
1015
1016   if (argc != 2)
1017     error ("wrong # args");
1018
1019   if (running_now)
1020     return TCL_OK;
1021
1022   Tcl_DStringAppend (result_ptr, "", -1);
1023   save_ptr = result_ptr;
1024   result_ptr = NULL;
1025
1026   execute_command (argv[1], 1);
1027
1028   bpstat_do_actions (&stop_bpstat);
1029
1030   result_ptr = save_ptr;
1031
1032   return TCL_OK;
1033 }
1034
1035 /* This implements the TCL command `gdb_cmd', which sends its argument into
1036    the GDB command scanner.  */
1037
1038 static int
1039 gdb_cmd (clientData, interp, argc, argv)
1040      ClientData clientData;
1041      Tcl_Interp *interp;
1042      int argc;
1043      char *argv[];
1044 {
1045   Tcl_DString *save_ptr = NULL;
1046
1047   if (argc != 2)
1048     error ("wrong # args");
1049
1050   if (running_now)
1051     return TCL_OK;
1052
1053   /* for the load instruction (and possibly others later) we
1054      set result_ptr to NULL so gdbtk_fputs() will not buffer
1055      all the data until the command is finished. */
1056
1057   if (strncmp ("load ", argv[1], 5) == 0
1058       || strncmp ("while ", argv[1], 6) == 0)
1059     {
1060       Tcl_DStringAppend (result_ptr, "", -1);
1061       save_ptr = result_ptr;
1062       result_ptr = NULL;
1063       load_in_progress = 1;
1064
1065       /* On Windows, use timer interrupts so that the user can cancel
1066          the download.  FIXME: We may have to do something on other
1067          systems.  */
1068 #ifdef __CYGWIN32__
1069       gdbtk_start_timer ();
1070 #endif
1071     }
1072
1073   execute_command (argv[1], 1);
1074
1075 #ifdef __CYGWIN32__
1076   if (load_in_progress)
1077     gdbtk_stop_timer ();
1078 #endif
1079
1080   load_in_progress = 0;
1081   bpstat_do_actions (&stop_bpstat);
1082
1083   if (save_ptr)
1084     result_ptr = save_ptr;
1085
1086   return TCL_OK;
1087 }
1088
1089 /* Client of call_wrapper - this routine performs the actual call to
1090    the client function. */
1091
1092 struct wrapped_call_args
1093 {
1094   Tcl_Interp *interp;
1095   Tcl_CmdProc *func;
1096   int argc;
1097   char **argv;
1098   int val;
1099 };
1100
1101 static int
1102 wrapped_call (args)
1103      struct wrapped_call_args *args;
1104 {
1105   args->val = (*args->func) (args->func, args->interp, args->argc, args->argv);
1106   return 1;
1107 }
1108
1109 /* This routine acts as a top-level for all GDB code called by tcl/Tk.  It
1110    handles cleanups, and calls to return_to_top_level (usually via error).
1111    This is necessary in order to prevent a longjmp out of the bowels of Tk,
1112    possibly leaving things in a bad state.  Since this routine can be called
1113    recursively, it needs to save and restore the contents of the jmp_buf as
1114    necessary.  */
1115
1116 static int
1117 call_wrapper (clientData, interp, argc, argv)
1118      ClientData clientData;
1119      Tcl_Interp *interp;
1120      int argc;
1121      char *argv[];
1122 {
1123   struct wrapped_call_args wrapped_args;
1124   Tcl_DString result, *old_result_ptr;
1125   Tcl_DString error_string, *old_error_string_ptr;
1126
1127   Tcl_DStringInit (&result);
1128   old_result_ptr = result_ptr;
1129   result_ptr = &result;
1130
1131   Tcl_DStringInit (&error_string);
1132   old_error_string_ptr = error_string_ptr;
1133   error_string_ptr = &error_string;
1134
1135   wrapped_args.func = (Tcl_CmdProc *)clientData;
1136   wrapped_args.interp = interp;
1137   wrapped_args.argc = argc;
1138   wrapped_args.argv = argv;
1139   wrapped_args.val = 0;
1140
1141   if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
1142     {
1143       wrapped_args.val = TCL_ERROR;     /* Flag an error for TCL */
1144
1145 #ifdef __CYGWIN32__
1146       /* Make sure the timer interrupts are turned off.  */
1147       if (gdbtk_timer_going)
1148         gdbtk_stop_timer ();
1149 #endif
1150
1151       gdb_flush (gdb_stderr);   /* Flush error output */
1152       gdb_flush (gdb_stdout);   /* Sometimes error output comes here as well */
1153
1154       /* In case of an error, we may need to force the GUI into idle
1155          mode because gdbtk_call_command may have bombed out while in
1156          the command routine.  */
1157
1158       running_now = 0;
1159       Tcl_Eval (interp, "gdbtk_tcl_idle");
1160     }
1161
1162   /* if the download was cancelled, don't print the error */
1163   if (load_in_progress)
1164     {
1165       Tcl_DStringInit (&error_string);
1166       wrapped_args.val = TCL_OK;
1167       load_in_progress = 0;
1168     }
1169
1170   if (Tcl_DStringLength (&error_string) == 0)
1171     {
1172       Tcl_DStringResult (interp, &result);
1173       Tcl_DStringFree (&error_string);
1174     }
1175   else if (Tcl_DStringLength (&result) == 0)
1176     {
1177       Tcl_DStringResult (interp, &error_string);
1178       Tcl_DStringFree (&result);
1179       Tcl_DStringFree (&error_string);
1180     }
1181   else
1182     {
1183       Tcl_ResetResult (interp);
1184       Tcl_AppendResult (interp, Tcl_DStringValue (&result),
1185                         Tcl_DStringValue (&error_string), (char *) NULL);
1186       Tcl_DStringFree (&result);
1187       Tcl_DStringFree (&error_string);
1188     }
1189
1190   result_ptr = old_result_ptr;
1191   error_string_ptr = old_error_string_ptr;
1192
1193 #ifdef _WIN32
1194   close_bfds ();
1195 #endif
1196
1197   return wrapped_args.val;
1198 }
1199
1200 static int
1201 comp_files (file1, file2)
1202      const char *file1[], *file2[];
1203 {
1204   return strcmp(*file1,*file2);
1205 }
1206
1207
1208 static int
1209 gdb_listfiles (clientData, interp, objc, objv)
1210   ClientData clientData;
1211   Tcl_Interp *interp;
1212   int objc;
1213   Tcl_Obj *CONST objv[];
1214 {
1215   struct objfile *objfile;
1216   struct partial_symtab *psymtab;
1217   struct symtab *symtab;
1218   char *lastfile, *pathname, *files[1000];
1219   int i, numfiles = 0, len = 0;
1220   Tcl_Obj *mylist;
1221
1222   if (objc > 2)
1223     {
1224       Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
1225       return TCL_ERROR;
1226     }
1227   else if (objc == 2)
1228     pathname = Tcl_GetStringFromObj (objv[1], &len);
1229
1230   mylist = Tcl_NewListObj (0, NULL);
1231
1232   ALL_PSYMTABS (objfile, psymtab)
1233     {
1234       if (len == 0)
1235         {
1236           if (psymtab->filename)
1237             files[numfiles++] = basename(psymtab->filename);
1238         }
1239       else if (!strcmp(psymtab->filename,basename(psymtab->filename))
1240                || !strncmp(pathname,psymtab->filename,len))
1241         if (psymtab->filename)
1242           files[numfiles++] = basename(psymtab->filename);
1243     }
1244
1245   ALL_SYMTABS (objfile, symtab)
1246     {
1247       if (len == 0)
1248         {
1249           if (symtab->filename)
1250             files[numfiles++] = basename(symtab->filename);
1251         }
1252       else if (!strcmp(symtab->filename,basename(symtab->filename))
1253                || !strncmp(pathname,symtab->filename,len))
1254         if (symtab->filename)
1255           files[numfiles++] = basename(symtab->filename);
1256     }
1257
1258   qsort (files, numfiles, sizeof(char *), comp_files);
1259
1260   lastfile = "";
1261   for (i = 0; i < numfiles; i++)
1262     {
1263       if (strcmp(files[i],lastfile))
1264         Tcl_ListObjAppendElement (interp, mylist, Tcl_NewStringObj(files[i], -1));
1265       lastfile = files[i];
1266     }
1267   Tcl_SetObjResult (interp, mylist);
1268   return TCL_OK;
1269 }
1270
1271 static int
1272 gdb_listfuncs (clientData, interp, argc, argv)
1273      ClientData clientData;
1274      Tcl_Interp *interp;
1275      int argc;
1276      char *argv[];
1277 {
1278   struct symtab *symtab;
1279   struct blockvector *bv;
1280   struct block *b;
1281   struct symbol *sym;
1282   int i,j;
1283
1284   if (argc != 2)
1285     error ("wrong # args");
1286
1287   symtab = lookup_symtab (argv[1]);
1288
1289   if (!symtab)
1290     error ("No such file");
1291
1292   bv = BLOCKVECTOR (symtab);
1293   for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
1294     {
1295       b = BLOCKVECTOR_BLOCK (bv, i);
1296       /* Skip the sort if this block is always sorted.  */
1297       if (!BLOCK_SHOULD_SORT (b))
1298         sort_block_syms (b);
1299       for (j = 0; j < BLOCK_NSYMS (b); j++)
1300         {
1301           sym = BLOCK_SYM (b, j);
1302           if (SYMBOL_CLASS (sym) == LOC_BLOCK)
1303             {
1304               Tcl_DStringAppendElement (result_ptr, SYMBOL_NAME(sym));
1305             }
1306         }
1307     }
1308   return TCL_OK;
1309 }
1310
1311 static int
1312 gdb_stop (clientData, interp, argc, argv)
1313      ClientData clientData;
1314      Tcl_Interp *interp;
1315      int argc;
1316      char *argv[];
1317 {
1318   if (target_stop)
1319     target_stop ();
1320   else
1321     quit_flag = 1; /* hope something sees this */
1322
1323   return TCL_OK;
1324 }
1325
1326 /* Prepare to accept a new executable file.  This is called when we
1327    want to clear away everything we know about the old file, without
1328    asking the user.  The Tcl code will have already asked the user if
1329    necessary.  After this is called, we should be able to run the
1330    `file' command without getting any questions.  */
1331
1332 static int
1333 gdb_clear_file (clientData, interp, argc, argv)
1334      ClientData clientData;
1335      Tcl_Interp *interp;
1336      int argc;
1337      char *argv[];
1338 {
1339   if (inferior_pid != 0 && target_has_execution)
1340     {
1341       if (attach_flag)
1342         target_detach (NULL, 0);
1343       else
1344         target_kill ();
1345     }
1346
1347   if (target_has_execution)
1348     pop_target ();
1349
1350   symbol_file_command (NULL, 0);
1351
1352   /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
1353      clear it here.  FIXME: This seems like an abstraction violation
1354      somewhere.  */
1355   stop_pc = 0;
1356
1357   return TCL_OK;
1358 }
1359
1360 /* Ask the user to confirm an exit request.  */
1361
1362 static int
1363 gdb_confirm_quit (clientData, interp, argc, argv)
1364      ClientData clientData;
1365      Tcl_Interp *interp;
1366      int argc;
1367      char *argv[];
1368 {
1369   int ret;
1370
1371   ret = quit_confirm ();
1372   Tcl_DStringAppendElement (result_ptr, ret ? "1" : "0");
1373   return TCL_OK;
1374 }
1375
1376 /* Quit without asking for confirmation.  */
1377
1378 static int
1379 gdb_force_quit (clientData, interp, argc, argv)
1380      ClientData clientData;
1381      Tcl_Interp *interp;
1382      int argc;
1383      char *argv[];
1384 {
1385   quit_force ((char *) NULL, 1);
1386   return TCL_OK;
1387 }
1388 \f
1389 /* This implements the TCL command `gdb_disassemble'.  */
1390
1391 static int
1392 gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
1393      bfd_vma memaddr;
1394      bfd_byte *myaddr;
1395      int len;
1396      disassemble_info *info;
1397 {
1398   extern struct target_ops exec_ops;
1399   int res;
1400
1401   errno = 0;
1402   res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
1403
1404   if (res == len)
1405     return 0;
1406   else
1407     if (errno == 0)
1408       return EIO;
1409     else
1410       return errno;
1411 }
1412
1413 /* We need a different sort of line table from the normal one cuz we can't
1414    depend upon implicit line-end pc's for lines.  This is because of the
1415    reordering we are about to do.  */
1416
1417 struct my_line_entry {
1418   int line;
1419   CORE_ADDR start_pc;
1420   CORE_ADDR end_pc;
1421 };
1422
1423 static int
1424 compare_lines (mle1p, mle2p)
1425      const PTR mle1p;
1426      const PTR mle2p;
1427 {
1428   struct my_line_entry *mle1, *mle2;
1429   int val;
1430
1431   mle1 = (struct my_line_entry *) mle1p;
1432   mle2 = (struct my_line_entry *) mle2p;
1433
1434   val =  mle1->line - mle2->line;
1435
1436   if (val != 0)
1437     return val;
1438
1439   return mle1->start_pc - mle2->start_pc;
1440 }
1441
1442 static int
1443 gdb_disassemble (clientData, interp, argc, argv)
1444      ClientData clientData;
1445      Tcl_Interp *interp;
1446      int argc;
1447      char *argv[];
1448 {
1449   CORE_ADDR pc, low, high;
1450   int mixed_source_and_assembly;
1451   static disassemble_info di;
1452   static int di_initialized;
1453
1454   if (! di_initialized)
1455     {
1456       INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
1457                                      (fprintf_ftype) fprintf_unfiltered);
1458       di.flavour = bfd_target_unknown_flavour;
1459       di.memory_error_func = dis_asm_memory_error;
1460       di.print_address_func = dis_asm_print_address;
1461       di_initialized = 1;
1462     }
1463
1464   di.mach = tm_print_insn_info.mach;
1465   if (TARGET_BYTE_ORDER == BIG_ENDIAN)
1466     di.endian = BFD_ENDIAN_BIG;
1467   else
1468     di.endian = BFD_ENDIAN_LITTLE;
1469
1470   if (argc != 3 && argc != 4)
1471     error ("wrong # args");
1472
1473   if (strcmp (argv[1], "source") == 0)
1474     mixed_source_and_assembly = 1;
1475   else if (strcmp (argv[1], "nosource") == 0)
1476     mixed_source_and_assembly = 0;
1477   else
1478     error ("First arg must be 'source' or 'nosource'");
1479
1480   low = parse_and_eval_address (argv[2]);
1481
1482   if (argc == 3)
1483     {
1484       if (find_pc_partial_function (low, NULL, &low, &high) == 0)
1485         error ("No function contains specified address");
1486     }
1487   else
1488     high = parse_and_eval_address (argv[3]);
1489
1490   /* If disassemble_from_exec == -1, then we use the following heuristic to
1491      determine whether or not to do disassembly from target memory or from the
1492      exec file:
1493
1494      If we're debugging a local process, read target memory, instead of the
1495      exec file.  This makes disassembly of functions in shared libs work
1496      correctly.
1497
1498      Else, we're debugging a remote process, and should disassemble from the
1499      exec file for speed.  However, this is no good if the target modifies its
1500      code (for relocation, or whatever).
1501    */
1502
1503   if (disassemble_from_exec == -1)
1504     if (strcmp (target_shortname, "child") == 0
1505         || strcmp (target_shortname, "procfs") == 0
1506         || strcmp (target_shortname, "vxprocess") == 0)
1507       disassemble_from_exec = 0; /* It's a child process, read inferior mem */
1508     else
1509       disassemble_from_exec = 1; /* It's remote, read the exec file */
1510
1511   if (disassemble_from_exec)
1512     di.read_memory_func = gdbtk_dis_asm_read_memory;
1513   else
1514     di.read_memory_func = dis_asm_read_memory;
1515
1516   /* If just doing straight assembly, all we need to do is disassemble
1517      everything between low and high.  If doing mixed source/assembly, we've
1518      got a totally different path to follow.  */
1519
1520   if (mixed_source_and_assembly)
1521     {                           /* Come here for mixed source/assembly */
1522       /* The idea here is to present a source-O-centric view of a function to
1523          the user.  This means that things are presented in source order, with
1524          (possibly) out of order assembly immediately following.  */
1525       struct symtab *symtab;
1526       struct linetable_entry *le;
1527       int nlines;
1528       int newlines;
1529       struct my_line_entry *mle;
1530       struct symtab_and_line sal;
1531       int i;
1532       int out_of_order;
1533       int next_line;
1534
1535       symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
1536
1537       if (!symtab)
1538         goto assembly_only;
1539
1540 /* First, convert the linetable to a bunch of my_line_entry's.  */
1541
1542       le = symtab->linetable->item;
1543       nlines = symtab->linetable->nitems;
1544
1545       if (nlines <= 0)
1546         goto assembly_only;
1547
1548       mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
1549
1550       out_of_order = 0;
1551
1552 /* Copy linetable entries for this function into our data structure, creating
1553    end_pc's and setting out_of_order as appropriate.  */
1554
1555 /* First, skip all the preceding functions.  */
1556
1557       for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
1558
1559 /* Now, copy all entries before the end of this function.  */
1560
1561       newlines = 0;
1562       for (; i < nlines - 1 && le[i].pc < high; i++)
1563         {
1564           if (le[i].line == le[i + 1].line
1565               && le[i].pc == le[i + 1].pc)
1566             continue;           /* Ignore duplicates */
1567
1568           mle[newlines].line = le[i].line;
1569           if (le[i].line > le[i + 1].line)
1570             out_of_order = 1;
1571           mle[newlines].start_pc = le[i].pc;
1572           mle[newlines].end_pc = le[i + 1].pc;
1573           newlines++;
1574         }
1575
1576 /* If we're on the last line, and it's part of the function, then we need to
1577    get the end pc in a special way.  */
1578
1579       if (i == nlines - 1
1580           && le[i].pc < high)
1581         {
1582           mle[newlines].line = le[i].line;
1583           mle[newlines].start_pc = le[i].pc;
1584           sal = find_pc_line (le[i].pc, 0);
1585           mle[newlines].end_pc = sal.end;
1586           newlines++;
1587         }
1588
1589 /* Now, sort mle by line #s (and, then by addresses within lines). */
1590
1591       if (out_of_order)
1592         qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
1593
1594 /* Now, for each line entry, emit the specified lines (unless they have been
1595    emitted before), followed by the assembly code for that line.  */
1596
1597       next_line = 0;            /* Force out first line */
1598       for (i = 0; i < newlines; i++)
1599         {
1600 /* Print out everything from next_line to the current line.  */
1601
1602           if (mle[i].line >= next_line)
1603             {
1604               if (next_line != 0)
1605                 print_source_lines (symtab, next_line, mle[i].line + 1, 0);
1606               else
1607                 print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
1608
1609               next_line = mle[i].line + 1;
1610             }
1611
1612           for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
1613             {
1614               QUIT;
1615               fputs_unfiltered ("    ", gdb_stdout);
1616               print_address (pc, gdb_stdout);
1617               fputs_unfiltered (":\t    ", gdb_stdout);
1618               pc += (*tm_print_insn) (pc, &di);
1619               fputs_unfiltered ("\n", gdb_stdout);
1620             }
1621         }
1622     }
1623   else
1624     {
1625 assembly_only:
1626       for (pc = low; pc < high; )
1627         {
1628           QUIT;
1629           fputs_unfiltered ("    ", gdb_stdout);
1630           print_address (pc, gdb_stdout);
1631           fputs_unfiltered (":\t    ", gdb_stdout);
1632           pc += (*tm_print_insn) (pc, &di);
1633           fputs_unfiltered ("\n", gdb_stdout);
1634         }
1635     }
1636
1637   gdb_flush (gdb_stdout);
1638
1639   return TCL_OK;
1640 }
1641 \f
1642 static void
1643 tk_command (cmd, from_tty)
1644      char *cmd;
1645      int from_tty;
1646 {
1647   int retval;
1648   char *result;
1649   struct cleanup *old_chain;
1650
1651   /* Catch case of no argument, since this will make the tcl interpreter dump core. */
1652   if (cmd == NULL)
1653     error_no_arg ("tcl command to interpret");
1654
1655   retval = Tcl_Eval (interp, cmd);
1656
1657   result = strdup (interp->result);
1658
1659   old_chain = make_cleanup (free, result);
1660
1661   if (retval != TCL_OK)
1662     error (result);
1663
1664   printf_unfiltered ("%s\n", result);
1665
1666   do_cleanups (old_chain);
1667 }
1668
1669 static void
1670 cleanup_init (ignored)
1671      int ignored;
1672 {
1673   if (interp != NULL)
1674     Tcl_DeleteInterp (interp);
1675   interp = NULL;
1676 }
1677
1678 /* Come here during long calculations to check for GUI events.  Usually invoked
1679    via the QUIT macro.  */
1680
1681 static void
1682 gdbtk_interactive ()
1683 {
1684   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
1685 }
1686
1687 /* Come here when there is activity on the X file descriptor. */
1688
1689 static void
1690 x_event (signo)
1691      int signo;
1692 {
1693   /* Process pending events */
1694
1695   while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
1696     ;
1697
1698   /* If we are doing a download, see if the download should be
1699      cancelled.  FIXME: We should use a better variable name.  */
1700   if (load_in_progress)
1701     {
1702       char *val;
1703
1704       val = Tcl_GetVar (interp, "download_cancel_ok", TCL_GLOBAL_ONLY);
1705       if (val != NULL && atoi (val))
1706         {
1707           quit_flag = 1;
1708 #ifdef REQUEST_QUIT
1709           REQUEST_QUIT;
1710 #else
1711           if (immediate_quit)
1712             quit ();
1713 #endif
1714         }
1715     }
1716 }
1717
1718 #ifdef __CYGWIN32__
1719
1720 /* For Cygwin32, we use a timer to periodically check for Windows
1721    messages.  FIXME: It would be better to not poll, but to instead
1722    rewrite the target_wait routines to serve as input sources.
1723    Unfortunately, that will be a lot of work.  */
1724
1725 static void
1726 gdbtk_start_timer ()
1727 {
1728   sigset_t nullsigmask;
1729   struct sigaction action;
1730   struct itimerval it;
1731
1732   sigemptyset (&nullsigmask);
1733
1734   action.sa_handler = x_event;
1735   action.sa_mask = nullsigmask;
1736   action.sa_flags = 0;
1737   sigaction (SIGALRM, &action, NULL);
1738
1739   it.it_interval.tv_sec = 0;
1740   /* Check for messages twice a second.  */
1741   it.it_interval.tv_usec = 500 * 1000;
1742   it.it_value.tv_sec = 0;
1743   it.it_value.tv_usec = 500 * 1000;
1744
1745   setitimer (ITIMER_REAL, &it, NULL);
1746
1747   gdbtk_timer_going = 1;
1748 }
1749
1750 static void
1751 gdbtk_stop_timer ()
1752 {
1753   sigset_t nullsigmask;
1754   struct sigaction action;
1755   struct itimerval it;
1756
1757   gdbtk_timer_going = 0;
1758
1759   sigemptyset (&nullsigmask);
1760
1761   action.sa_handler = SIG_IGN;
1762   action.sa_mask = nullsigmask;
1763   action.sa_flags = 0;
1764   sigaction (SIGALRM, &action, NULL);
1765
1766   it.it_interval.tv_sec = 0;
1767   it.it_interval.tv_usec = 0;
1768   it.it_value.tv_sec = 0;
1769   it.it_value.tv_usec = 0;
1770   setitimer (ITIMER_REAL, &it, NULL);
1771 }
1772
1773 #endif
1774
1775 /* This hook function is called whenever we want to wait for the
1776    target.  */
1777
1778 static int
1779 gdbtk_wait (pid, ourstatus)
1780      int pid;
1781      struct target_waitstatus *ourstatus;
1782 {
1783 #ifndef WINNT
1784   struct sigaction action;
1785   static sigset_t nullsigmask = {0};
1786
1787
1788 #ifndef SA_RESTART
1789   /* Needed for SunOS 4.1.x */
1790 #define SA_RESTART 0
1791 #endif
1792
1793   action.sa_handler = x_event;
1794   action.sa_mask = nullsigmask;
1795   action.sa_flags = SA_RESTART;
1796   sigaction(SIGIO, &action, NULL);
1797 #endif /* WINNT */
1798
1799 #ifdef __CYGWIN32__
1800   /* Call x_event ourselves now, as well as starting the timer;
1801      otherwise, if single stepping, we may never wait long enough for
1802      the timer to trigger.  */
1803   x_event (SIGALRM);
1804
1805   gdbtk_start_timer ();
1806 #endif
1807
1808   pid = target_wait (pid, ourstatus);
1809
1810 #ifdef __CYGWIN32__
1811   gdbtk_stop_timer ();
1812 #endif
1813
1814 #ifndef WINNT
1815   action.sa_handler = SIG_IGN;
1816   sigaction(SIGIO, &action, NULL);
1817 #endif
1818
1819   return pid;
1820 }
1821
1822 /* This is called from execute_command, and provides a wrapper around
1823    various command routines in a place where both protocol messages and
1824    user input both flow through.  Mostly this is used for indicating whether
1825    the target process is running or not.
1826 */
1827
1828 static void
1829 gdbtk_call_command (cmdblk, arg, from_tty)
1830      struct cmd_list_element *cmdblk;
1831      char *arg;
1832      int from_tty;
1833 {
1834   running_now = 0;
1835   if (cmdblk->class == class_run || cmdblk->class == class_trace)
1836     {
1837       running_now = 1;
1838       Tcl_Eval (interp, "gdbtk_tcl_busy");
1839       (*cmdblk->function.cfunc)(arg, from_tty);
1840       running_now = 0;
1841       Tcl_Eval (interp, "gdbtk_tcl_idle");
1842     }
1843   else
1844     (*cmdblk->function.cfunc)(arg, from_tty);
1845 }
1846
1847 /* This function is called instead of gdb's internal command loop.  This is the
1848    last chance to do anything before entering the main Tk event loop. */
1849
1850 static void
1851 tk_command_loop ()
1852 {
1853   extern GDB_FILE *instream;
1854
1855   /* We no longer want to use stdin as the command input stream */
1856   instream = NULL;
1857
1858   if (Tcl_Eval (interp, "gdbtk_tcl_preloop") != TCL_OK)
1859     {
1860       char *msg;
1861
1862       /* Force errorInfo to be set up propertly.  */
1863       Tcl_AddErrorInfo (interp, "");
1864
1865       msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
1866 #ifdef _WIN32
1867       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
1868 #else
1869       fputs_unfiltered (msg, gdb_stderr);
1870 #endif
1871     }
1872
1873 #ifdef _WIN32
1874   close_bfds ();
1875 #endif
1876
1877   Tk_MainLoop ();
1878 }
1879
1880 /* gdbtk_init installs this function as a final cleanup.  */
1881
1882 static void
1883 gdbtk_cleanup (dummy)
1884      PTR dummy;
1885 {
1886   Tcl_Finalize ();
1887 }
1888
1889 /* Initialize gdbtk.  */
1890
1891 static void
1892 gdbtk_init ( argv0 )
1893      char *argv0;
1894 {
1895   struct cleanup *old_chain;
1896   char *lib, *gdbtk_lib, *gdbtk_lib_tmp, *gdbtk_file;
1897   int i, found_main;
1898 #ifndef WINNT
1899   struct sigaction action;
1900   static sigset_t nullsigmask = {0};
1901 #endif
1902 #ifdef IDE
1903   /* start-sanitize-ide */
1904   struct ide_event_handle *h;
1905   const char *errmsg;
1906   char *libexecdir;
1907   /* end-sanitize-ide */
1908 #endif
1909
1910   /* If there is no DISPLAY environment variable, Tk_Init below will fail,
1911      causing gdb to abort.  If instead we simply return here, gdb will
1912      gracefully degrade to using the command line interface. */
1913
1914 #ifndef WINNT
1915   if (getenv ("DISPLAY") == NULL)
1916     return;
1917 #endif
1918
1919   old_chain = make_cleanup (cleanup_init, 0);
1920
1921   /* First init tcl and tk. */
1922   Tcl_FindExecutable (argv0);
1923   interp = Tcl_CreateInterp ();
1924
1925   if (!interp)
1926     error ("Tcl_CreateInterp failed");
1927
1928   if (Tcl_Init(interp) != TCL_OK)
1929     error ("Tcl_Init failed: %s", interp->result);
1930
1931   make_final_cleanup (gdbtk_cleanup, NULL);
1932
1933   /* Initialize the Paths variable.  */
1934   if (ide_initialize_paths (interp, "gdbtcl") != TCL_OK)
1935     error ("ide_initialize_paths failed: %s", interp->result);
1936
1937 #ifdef IDE
1938   /* start-sanitize-ide */
1939   /* Find the directory where we expect to find idemanager.  We ignore
1940      errors since it doesn't really matter if this fails.  */
1941   libexecdir = Tcl_GetVar2 (interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
1942
1943   IluTk_Init ();
1944
1945   h = ide_event_init_from_environment (&errmsg, libexecdir);
1946   if (h == NULL)
1947     {
1948       Tcl_AppendResult (interp, "can't initialize event system: ", errmsg,
1949                         (char *) NULL);
1950       fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", interp->result);
1951
1952       Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
1953     }
1954   else
1955     {
1956       if (ide_create_tclevent_command (interp, h) != TCL_OK)
1957         error ("ide_create_tclevent_command failed: %s", interp->result);
1958
1959       if (ide_create_edit_command (interp, h) != TCL_OK)
1960         error ("ide_create_edit_command failed: %s", interp->result);
1961
1962       if (ide_create_property_command (interp, h) != TCL_OK)
1963         error ("ide_create_property_command failed: %s", interp->result);
1964
1965       if (ide_create_build_command (interp, h) != TCL_OK)
1966         error ("ide_create_build_command failed: %s", interp->result);
1967
1968       if (ide_create_window_register_command (interp, h, "gdb-restore")
1969           != TCL_OK)
1970         error ("ide_create_window_register_command failed: %s",
1971                interp->result);
1972
1973       if (ide_create_window_command (interp, h) != TCL_OK)
1974         error ("ide_create_window_command failed: %s", interp->result);
1975
1976       if (ide_create_exit_command (interp, h) != TCL_OK)
1977         error ("ide_create_exit_command failed: %s", interp->result);
1978
1979       if (ide_create_help_command (interp) != TCL_OK)
1980         error ("ide_create_help_command failed: %s", interp->result);
1981
1982       /*
1983         if (ide_initialize (interp, "gdb") != TCL_OK)
1984         error ("ide_initialize failed: %s", interp->result);
1985       */
1986
1987       Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
1988       Tcl_SetVar (interp, "IDE", "1", TCL_GLOBAL_ONLY);
1989     }
1990   /* end-sanitize-ide */
1991 #else
1992   Tcl_SetVar (interp, "GDBTK_IDE", "0", 0);
1993 #endif /* IDE */
1994
1995   /* We don't want to open the X connection until we've done all the
1996      IDE initialization.  Otherwise, goofy looking unfinished windows
1997      pop up when ILU drops into the TCL event loop.  */
1998
1999   if (Tk_Init(interp) != TCL_OK)
2000     error ("Tk_Init failed: %s", interp->result);
2001
2002   if (Itcl_Init(interp) == TCL_ERROR)
2003     error ("Itcl_Init failed: %s", interp->result);
2004
2005   if (Tix_Init(interp) != TCL_OK)
2006     error ("Tix_Init failed: %s", interp->result);
2007
2008 #ifdef __CYGWIN32__
2009   /* On Windows, create a sizebox widget command */
2010   if (ide_create_sizebox_command (interp) != TCL_OK)
2011     error ("sizebox creation failed");
2012   if (ide_create_winprint_command (interp) != TCL_OK)
2013     error ("windows print code initialization failed");
2014   /* start-sanitize-ide */
2015   /* An interface to ShellExecute.  */
2016   if (ide_create_shell_execute_command (interp) != TCL_OK)
2017     error ("shell execute command initialization failed");
2018   /* end-sanitize-ide */
2019 #endif
2020
2021   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
2022   Tcl_CreateCommand (interp, "gdb_immediate", call_wrapper,
2023                      gdb_immediate_command, NULL);
2024   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
2025   Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
2026   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
2027                      NULL);
2028   Tcl_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
2029   Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
2030                      NULL);
2031   Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
2032                      NULL);
2033   Tcl_CreateCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
2034   Tcl_CreateCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
2035   Tcl_CreateCommand (interp, "gdb_fetch_registers", call_wrapper,
2036                      gdb_fetch_registers, NULL);
2037   Tcl_CreateCommand (interp, "gdb_changed_register_list", call_wrapper,
2038                      gdb_changed_register_list, NULL);
2039   Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
2040                      gdb_disassemble, NULL);
2041   Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
2042   Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
2043                      gdb_get_breakpoint_list, NULL);
2044   Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
2045                      gdb_get_breakpoint_info, NULL);
2046   Tcl_CreateCommand (interp, "gdb_clear_file", call_wrapper,
2047                      gdb_clear_file, NULL);
2048   Tcl_CreateCommand (interp, "gdb_confirm_quit", call_wrapper,
2049                      gdb_confirm_quit, NULL);
2050   Tcl_CreateCommand (interp, "gdb_force_quit", call_wrapper,
2051                      gdb_force_quit, NULL);
2052   Tcl_CreateCommand (interp, "gdb_target_has_execution",
2053                      gdb_target_has_execution_command,
2054                      NULL, NULL);
2055   Tcl_CreateObjCommand (interp, "gdb_load_info", gdb_load_info, NULL, NULL);
2056   Tcl_CreateObjCommand (interp, "gdb_get_locals", gdb_get_vars_command,
2057                         (ClientData) 0, NULL);
2058   Tcl_CreateObjCommand (interp, "gdb_get_args", gdb_get_vars_command,
2059                         (ClientData) 1, NULL);
2060   Tcl_CreateObjCommand (interp, "gdb_get_function", gdb_get_function_command,
2061                         NULL, NULL);
2062   Tcl_CreateObjCommand (interp, "gdb_get_line", gdb_get_line_command,
2063                         NULL, NULL);
2064   Tcl_CreateObjCommand (interp, "gdb_get_file", gdb_get_file_command,
2065                         NULL, NULL);
2066   Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
2067                         gdb_tracepoint_exists_command, NULL, NULL);
2068   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
2069                         gdb_get_tracepoint_info, NULL, NULL);
2070   Tcl_CreateObjCommand (interp, "gdb_actions",
2071                         gdb_actions_command, NULL, NULL);
2072   Tcl_CreateObjCommand (interp, "gdb_prompt",
2073                         gdb_prompt_command, NULL, NULL);
2074   Tcl_CreateObjCommand (interp, "gdb_find_file",
2075                         gdb_find_file_command, NULL, NULL);
2076   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
2077                         gdb_get_tracepoint_list, NULL, NULL);
2078
2079   command_loop_hook = tk_command_loop;
2080   print_frame_info_listing_hook =
2081     (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
2082   query_hook = gdbtk_query;
2083   flush_hook = gdbtk_flush;
2084   create_breakpoint_hook = gdbtk_create_breakpoint;
2085   delete_breakpoint_hook = gdbtk_delete_breakpoint;
2086   modify_breakpoint_hook = gdbtk_modify_breakpoint;
2087   interactive_hook = gdbtk_interactive;
2088   target_wait_hook = gdbtk_wait;
2089   call_command_hook = gdbtk_call_command;
2090   readline_begin_hook = gdbtk_readline_begin;
2091   readline_hook = gdbtk_readline;
2092   readline_end_hook = gdbtk_readline_end;
2093   ui_load_progress_hook = gdbtk_load_hash;
2094   pre_add_symbol_hook   = gdbtk_pre_add_symbol;
2095   post_add_symbol_hook  = gdbtk_post_add_symbol;
2096   create_tracepoint_hook = gdbtk_create_tracepoint;
2097   delete_tracepoint_hook = gdbtk_delete_tracepoint;
2098
2099 #ifndef WINNT
2100   /* Get the file descriptor for the X server */
2101
2102   x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
2103
2104   /* Setup for I/O interrupts */
2105
2106   action.sa_mask = nullsigmask;
2107   action.sa_flags = 0;
2108   action.sa_handler = SIG_IGN;
2109   sigaction(SIGIO, &action, NULL);
2110
2111 #ifdef FIOASYNC
2112   i = 1;
2113   if (ioctl (x_fd, FIOASYNC, &i))
2114     perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
2115
2116 #ifdef SIOCSPGRP
2117   i = getpid();
2118   if (ioctl (x_fd, SIOCSPGRP, &i))
2119     perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
2120
2121 #else
2122 #ifdef F_SETOWN
2123   i = getpid();
2124   if (fcntl (x_fd, F_SETOWN, i))
2125     perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
2126 #endif  /* F_SETOWN */
2127 #endif  /* !SIOCSPGRP */
2128 #else
2129 #ifndef WINNT
2130   if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
2131     perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
2132 #endif
2133
2134 #endif /* ifndef FIOASYNC */
2135 #endif /* WINNT */
2136
2137   add_com ("tk", class_obscure, tk_command,
2138            "Send a command directly into tk.");
2139
2140   Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
2141                TCL_LINK_INT);
2142
2143   /* find the gdb tcl library and source main.tcl */
2144
2145   gdbtk_lib = getenv ("GDBTK_LIBRARY");
2146   if (!gdbtk_lib)
2147     if (access ("gdbtcl/main.tcl", R_OK) == 0)
2148       gdbtk_lib = "gdbtcl";
2149     else
2150       gdbtk_lib = GDBTK_LIBRARY;
2151
2152   gdbtk_lib_tmp = xstrdup (gdbtk_lib);
2153
2154   found_main = 0;
2155   /* see if GDBTK_LIBRARY is a path list */
2156   lib = strtok (gdbtk_lib_tmp, GDBTK_PATH_SEP);
2157   do
2158     {
2159       if (Tcl_VarEval (interp, "lappend auto_path ", lib, NULL) != TCL_OK)
2160         {
2161           fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2162           error ("");
2163         }
2164       if (!found_main)
2165         {
2166           gdbtk_file = concat (lib, "/main.tcl", (char *) NULL);
2167           if (access (gdbtk_file, R_OK) == 0)
2168             {
2169               found_main++;
2170               Tcl_SetVar (interp, "GDBTK_LIBRARY", lib, 0);
2171             }
2172         }
2173      }
2174   while ((lib = strtok (NULL, ":")) != NULL);
2175
2176   free (gdbtk_lib_tmp);
2177
2178   if (!found_main)
2179     {
2180       /* Try finding it with the auto path.  */
2181
2182       static const char script[] ="\
2183 proc gdbtk_find_main {} {\n\
2184   global auto_path GDBTK_LIBRARY\n\
2185   foreach dir $auto_path {\n\
2186     set f [file join $dir main.tcl]\n\
2187     if {[file exists $f]} then {\n\
2188       set GDBTK_LIBRARY $dir\n\
2189       return $f\n\
2190     }\n\
2191   }\n\
2192   return ""\n\
2193 }\n\
2194 gdbtk_find_main";
2195
2196       if (Tcl_GlobalEval (interp, (char *) script) != TCL_OK)
2197         {
2198           fputs_unfiltered (Tcl_GetVar (interp, "errorInfo", 0), gdb_stderr);
2199           error ("");
2200         }
2201
2202       if (interp->result[0] != '\0')
2203         {
2204           gdbtk_file = xstrdup (interp->result);
2205           found_main++;
2206         }
2207     }
2208
2209   if (!found_main)
2210     {
2211       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2212       if (getenv("GDBTK_LIBRARY"))
2213         {
2214           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
2215           fprintf_unfiltered (stderr,
2216                               "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
2217         }
2218       else
2219         {
2220           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY);
2221           fprintf_unfiltered (stderr, "You might want to set GDBTK_LIBRARY\n");
2222         }
2223       error("");
2224     }
2225
2226 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
2227    prior to this point go to stdout/stderr.  */
2228
2229   fputs_unfiltered_hook = gdbtk_fputs;
2230
2231   if (Tcl_EvalFile (interp, gdbtk_file) != TCL_OK)
2232     {
2233       char *msg;
2234
2235       /* Force errorInfo to be set up propertly.  */
2236       Tcl_AddErrorInfo (interp, "");
2237
2238       msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
2239
2240       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
2241
2242 #ifdef _WIN32
2243       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
2244 #else
2245       fputs_unfiltered (msg, gdb_stderr);
2246 #endif
2247
2248       error ("");
2249     }
2250
2251 #ifdef IDE
2252   /* start-sanitize-ide */
2253   /* Don't do this until we have initialized.  Otherwise, we may get a
2254      run command before we are ready for one.  */
2255   if (ide_run_server_init (interp, h) != TCL_OK)
2256     error ("ide_run_server_init failed: %s", interp->result);
2257   /* end-sanitize-ide */
2258 #endif
2259
2260   free (gdbtk_file);
2261
2262   discard_cleanups (old_chain);
2263 }
2264
2265 static int
2266 gdb_target_has_execution_command (clientData, interp, argc, argv)
2267      ClientData clientData;
2268      Tcl_Interp *interp;
2269      int argc;
2270      char *argv[];
2271 {
2272   int result = 0;
2273
2274   if (target_has_execution && inferior_pid != 0)
2275     result = 1;
2276
2277   Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
2278   return TCL_OK;
2279 }
2280
2281 /* gdb_load_info - returns information about the file about to be downloaded */
2282
2283 static int
2284 gdb_load_info (clientData, interp, objc, objv)
2285      ClientData clientData;
2286      Tcl_Interp *interp;
2287      int objc;
2288      Tcl_Obj *CONST objv[];
2289 {
2290    bfd *loadfile_bfd;
2291    struct cleanup *old_cleanups;
2292    asection *s;
2293    Tcl_Obj *ob[2];
2294    Tcl_Obj *res[16];
2295    int i = 0;
2296
2297    char *filename = Tcl_GetStringFromObj (objv[1], NULL);
2298
2299    loadfile_bfd = bfd_openr (filename, gnutarget);
2300    if (loadfile_bfd == NULL)
2301      {
2302        Tcl_SetObjResult (interp, Tcl_NewStringObj ("Open failed", -1));
2303        return TCL_ERROR;
2304      }
2305    old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
2306
2307    if (!bfd_check_format (loadfile_bfd, bfd_object))
2308      {
2309        Tcl_SetObjResult (interp, Tcl_NewStringObj ("Bad Object File", -1));
2310        return TCL_ERROR;
2311     }
2312
2313    for (s = loadfile_bfd->sections; s; s = s->next)
2314      {
2315        if (s->flags & SEC_LOAD)
2316          {
2317            bfd_size_type size = bfd_get_section_size_before_reloc (s);
2318            if (size > 0)
2319              {
2320                ob[0] = Tcl_NewStringObj((char *)bfd_get_section_name(loadfile_bfd, s), -1);
2321                ob[1] = Tcl_NewLongObj ((long)size);
2322                res[i++] = Tcl_NewListObj (2, ob);
2323              }
2324          }
2325      }
2326
2327    Tcl_SetObjResult (interp, Tcl_NewListObj (i, res));
2328    do_cleanups (old_cleanups);
2329    return TCL_OK;
2330 }
2331
2332
2333 int
2334 gdbtk_load_hash (section, num)
2335      char *section;
2336      unsigned long num;
2337 {
2338   char buf[128];
2339   sprintf (buf, "download_hash %s %ld", section, num);
2340   Tcl_Eval (interp, buf);
2341   return  atoi (interp->result);
2342 }
2343
2344 /* gdb_get_vars_command -
2345  *
2346  * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
2347  * function sets the Tcl interpreter's result to a list of variable names
2348  * depending on clientData. If clientData is one, the result is a list of
2349  * arguments; zero returns a list of locals -- all relative to the block
2350  * specified as an argument to the command. Valid commands include
2351  * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
2352  * and "main").
2353  */
2354 static int
2355 gdb_get_vars_command (clientData, interp, objc, objv)
2356      ClientData clientData;
2357      Tcl_Interp *interp;
2358      int objc;
2359      Tcl_Obj *CONST objv[];
2360 {
2361   Tcl_Obj *result;
2362   struct symtabs_and_lines sals;
2363   struct symbol *sym;
2364   struct block *block;
2365   char **canonical, *args;
2366   int i, nsyms, arguments;
2367
2368   if (objc != 2)
2369     {
2370       Tcl_AppendResult (interp,
2371                         "wrong # of args: should be \"",
2372                         Tcl_GetStringFromObj (objv[0], NULL),
2373                         " function:line|function|line|*addr\"");
2374       return TCL_ERROR;
2375     }
2376
2377   arguments = (int) clientData;
2378   args = Tcl_GetStringFromObj (objv[1], NULL);
2379   sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2380   if (sals.nelts == 0)
2381     {
2382       Tcl_AppendResult (interp,
2383                         "error decoding line", NULL);
2384       return TCL_ERROR;
2385     }
2386
2387   /* Initialize a list that will hold the results */
2388   result = Tcl_NewListObj (0, NULL);
2389
2390   /* Resolve all line numbers to PC's */
2391   for (i = 0; i < sals.nelts; i++)
2392     resolve_sal_pc (&sals.sals[i]);
2393
2394   block = block_for_pc (sals.sals[0].pc);
2395   while (block != 0)
2396     {
2397       nsyms = BLOCK_NSYMS (block);
2398       for (i = 0; i < nsyms; i++)
2399         {
2400           sym = BLOCK_SYM (block, i);
2401           switch (SYMBOL_CLASS (sym)) {
2402           default:
2403           case LOC_UNDEF:                 /* catches errors        */
2404           case LOC_CONST:             /* constant              */
2405           case LOC_STATIC:            /* static                */
2406           case LOC_REGISTER:      /* register              */
2407           case LOC_TYPEDEF:           /* local typedef         */
2408           case LOC_LABEL:             /* local label           */
2409           case LOC_BLOCK:             /* local function        */
2410           case LOC_CONST_BYTES:   /* loc. byte seq.        */
2411           case LOC_UNRESOLVED:    /* unresolved static     */
2412           case LOC_OPTIMIZED_OUT: /* optimized out         */
2413             break;
2414           case LOC_ARG:               /* argument              */
2415           case LOC_REF_ARG:           /* reference arg         */
2416           case LOC_REGPARM:           /* register arg          */
2417           case LOC_REGPARM_ADDR:  /* indirect register arg */
2418           case LOC_LOCAL_ARG:     /* stack arg             */
2419           case LOC_BASEREG_ARG:   /* basereg arg           */
2420             if (arguments)
2421               Tcl_ListObjAppendElement (interp, result,
2422                                         Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2423             break;
2424           case LOC_LOCAL:             /* stack local           */
2425           case LOC_BASEREG:           /* basereg local         */
2426             if (!arguments)
2427               Tcl_ListObjAppendElement (interp, result,
2428                                         Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
2429             break;
2430           }
2431         }
2432       if (BLOCK_FUNCTION (block))
2433         break;
2434       else
2435         block = BLOCK_SUPERBLOCK (block);
2436     }
2437
2438   Tcl_SetObjResult (interp, result);
2439   return TCL_OK;
2440 }
2441
2442 static int
2443 gdb_get_line_command (clientData, interp, objc, objv)
2444      ClientData clientData;
2445      Tcl_Interp *interp;
2446      int objc;
2447      Tcl_Obj *CONST objv[];
2448 {
2449   Tcl_Obj *result;
2450   struct symtabs_and_lines sals;
2451   char *args, **canonical;
2452
2453   if (objc != 2)
2454     {
2455       Tcl_AppendResult (interp, "wrong # of args: should be \"",
2456                         Tcl_GetStringFromObj (objv[0], NULL),
2457                         " linespec\"");
2458       return TCL_ERROR;
2459     }
2460
2461   args = Tcl_GetStringFromObj (objv[1], NULL);
2462   sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2463   if (sals.nelts == 1)
2464     {
2465       Tcl_SetObjResult (interp, Tcl_NewIntObj (sals.sals[0].line));
2466       return TCL_OK;
2467     }
2468
2469     Tcl_SetResult (interp, "N/A", TCL_STATIC);
2470     return TCL_OK;
2471 }
2472
2473 static int
2474 gdb_get_file_command (clientData, interp, objc, objv)
2475      ClientData clientData;
2476      Tcl_Interp *interp;
2477      int objc;
2478      Tcl_Obj *CONST objv[];
2479 {
2480   Tcl_Obj *result;
2481   struct symtabs_and_lines sals;
2482   char *args, **canonical;
2483
2484   if (objc != 2)
2485     {
2486       Tcl_AppendResult (interp, "wrong # of args: should be \"",
2487                         Tcl_GetStringFromObj (objv[0], NULL),
2488                         " linespec\"");
2489       return TCL_ERROR;
2490     }
2491
2492   args = Tcl_GetStringFromObj (objv[1], NULL);
2493   sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2494   if (sals.nelts == 1)
2495     {
2496       Tcl_SetResult (interp, sals.sals[0].symtab->filename, TCL_VOLATILE);
2497       return TCL_OK;
2498     }
2499
2500     Tcl_SetResult (interp, "N/A", TCL_STATIC);
2501     return TCL_OK;
2502 }
2503
2504 static int
2505 gdb_get_function_command (clientData, interp, objc, objv)
2506      ClientData clientData;
2507      Tcl_Interp *interp;
2508      int objc;
2509      Tcl_Obj *CONST objv[];
2510 {
2511   Tcl_Obj *result;
2512   char *function;
2513   struct symtabs_and_lines sals;
2514   char *args, **canonical;
2515
2516   if (objc != 2)
2517     {
2518       Tcl_AppendResult (interp, "wrong # of args: should be \"",
2519                         Tcl_GetStringFromObj (objv[0], NULL),
2520                         " linespec\"");
2521       return TCL_ERROR;
2522     }
2523
2524   args = Tcl_GetStringFromObj (objv[1], NULL);
2525   sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2526   if (sals.nelts == 1)
2527     {
2528       resolve_sal_pc (&sals.sals[0]);
2529       find_pc_partial_function (sals.sals[0].pc, &function, NULL, NULL);
2530       if (function != NULL)
2531         {
2532           Tcl_SetResult (interp, function, TCL_VOLATILE);
2533           return TCL_OK;
2534         }
2535     }
2536
2537   Tcl_SetResult (interp, "N/A", TCL_STATIC);
2538   return TCL_OK;
2539 }
2540
2541 static int
2542 gdb_get_tracepoint_info (clientData, interp, objc, objv)
2543      ClientData clientData;
2544      Tcl_Interp *interp;
2545      int objc;
2546      Tcl_Obj  *CONST objv[];
2547 {
2548   struct symtab_and_line sal;
2549   int tpnum;
2550   struct tracepoint *tp;
2551   struct action_line *al;
2552   Tcl_Obj *list, *action_list;
2553   char *filename, *funcname;
2554   char tmp[19];
2555
2556   if (objc != 2)
2557     error ("wrong # args");
2558
2559   Tcl_GetIntFromObj (NULL, objv[1], &tpnum);
2560
2561   ALL_TRACEPOINTS (tp)
2562     if (tp->number == tpnum)
2563       break;
2564
2565   if (tp == NULL)
2566     error ("Tracepoint #%d does not exist", tpnum);
2567
2568   list = Tcl_NewListObj (0, NULL);
2569   sal = find_pc_line (tp->address, 0);
2570   filename = symtab_to_filename (sal.symtab);
2571   if (filename == NULL)
2572     filename = "N/A";
2573   Tcl_ListObjAppendElement (interp, list,
2574                             Tcl_NewStringObj (filename, -1));
2575   find_pc_partial_function (tp->address, &funcname, NULL, NULL);
2576   Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (funcname, -1));
2577   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (sal.line));
2578   sprintf (tmp, "0x%08x", tp->address);
2579   Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
2580   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
2581   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->pass_count));
2582   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->step_count));
2583   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->thread));
2584   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->hit_count));
2585
2586   /* Append a list of actions */
2587   action_list = Tcl_NewListObj (0, NULL);
2588   for (al = tp->actions; al != NULL; al = al->next)
2589     {
2590       Tcl_ListObjAppendElement (interp, action_list,
2591                                 Tcl_NewStringObj (al->action, -1));
2592     }
2593   Tcl_ListObjAppendElement (interp, list, action_list);
2594
2595   Tcl_SetObjResult (interp, list);
2596   return TCL_OK;
2597 }
2598
2599 static void
2600 gdbtk_create_tracepoint (tp)
2601   struct tracepoint *tp;
2602 {
2603   tracepoint_notify (tp, "create");
2604 }
2605
2606 static void
2607 gdbtk_delete_tracepoint (tp)
2608   struct tracepoint *tp;
2609 {
2610   tracepoint_notify (tp, "delete");
2611 }
2612
2613 static void
2614 tracepoint_notify(tp, action)
2615      struct tracepoint *tp;
2616      const char *action;
2617 {
2618   char buf[256];
2619   int v;
2620   struct symtab_and_line sal;
2621   char *filename;
2622
2623   /* We ensure that ACTION contains no special Tcl characters, so we
2624      can do this.  */
2625   sal = find_pc_line (tp->address, 0);
2626
2627   filename = symtab_to_filename (sal.symtab);
2628   if (filename == NULL)
2629     filename = "N/A";
2630   sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number,
2631            (long)tp->address, sal.line, filename);
2632
2633   v = Tcl_Eval (interp, buf);
2634
2635   if (v != TCL_OK)
2636     {
2637       gdbtk_fputs (interp->result, gdb_stdout);
2638       gdbtk_fputs ("\n", gdb_stdout);
2639     }
2640 }
2641
2642 /* returns -1 if not found, tracepoint # if found */
2643 int
2644 tracepoint_exists (char * args)
2645 {
2646   struct tracepoint *tp;
2647   char **canonical;
2648   struct symtabs_and_lines sals;
2649   char  *file = NULL;
2650   int    result = -1;
2651
2652   sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
2653   if (sals.nelts == 1)
2654     {
2655       resolve_sal_pc (&sals.sals[0]);
2656       file = xmalloc (strlen (sals.sals[0].symtab->dirname)
2657                       + strlen (sals.sals[0].symtab->filename) + 1);
2658       if (file != NULL)
2659         {
2660           strcpy (file, sals.sals[0].symtab->dirname);
2661           strcat (file, sals.sals[0].symtab->filename);
2662
2663           ALL_TRACEPOINTS (tp)
2664             {
2665               if (tp->address == sals.sals[0].pc)
2666                 result = tp->number;
2667               else if (tp->source_file != NULL
2668                        && strcmp (tp->source_file, file) == 0
2669                        && sals.sals[0].line == tp->line_number)
2670
2671                 result = tp->number;
2672             }
2673         }
2674     }
2675   if (file != NULL)
2676     free (file);
2677   return result;
2678 }
2679
2680 static int
2681 gdb_actions_command (clientData, interp, objc, objv)
2682   ClientData clientData;
2683   Tcl_Interp *interp;
2684   int objc;
2685   Tcl_Obj *CONST objv[];
2686 {
2687   struct tracepoint *tp;
2688   Tcl_Obj **actions;
2689   int      nactions, i, len;
2690   char *number, *args, *action;
2691   long step_count;
2692   struct action_line *next = NULL, *temp;
2693
2694   if (objc != 3)
2695     {
2696       Tcl_AppendResult (interp, "wrong # args: should be: \"",
2697                         Tcl_GetStringFromObj (objv[0], NULL),
2698                         " number actions\"");
2699       return TCL_ERROR;
2700     }
2701
2702   args = number = Tcl_GetStringFromObj (objv[1], NULL);
2703   tp = get_tracepoint_by_number (&args);
2704   if (tp == NULL)
2705     {
2706       Tcl_AppendResult (interp, "Tracepoint \"", number, "\" does not exist");
2707       return TCL_ERROR;
2708     }
2709
2710   /* Free any existing actions */
2711   for (temp = tp->actions; temp != NULL; temp = next)
2712     {
2713       next = temp->next;
2714       if (temp->action)
2715         free (temp->action);
2716       free (temp);
2717     }
2718   step_count = 0;
2719
2720   Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
2721   for (i = 0; i < nactions; i++)
2722     {
2723       temp = xmalloc (sizeof (struct action_line));
2724       temp->next = NULL;
2725       action = Tcl_GetStringFromObj (actions[i], &len);
2726       temp->action = savestring (action, len);
2727       if (sscanf (temp->action, "while-stepping %d", &step_count) !=0)
2728         tp->step_count = step_count;
2729       if (next == NULL)
2730         {
2731           tp->actions = temp;
2732           next = temp;
2733         }
2734       else
2735         {
2736           next->next = temp;
2737           next = temp;
2738         }
2739     }
2740
2741   return TCL_OK;
2742 }
2743
2744 static int
2745 gdb_tracepoint_exists_command (clientData, interp, objc, objv)
2746   ClientData clientData;
2747   Tcl_Interp *interp;
2748   int objc;
2749   Tcl_Obj *CONST objv[];
2750 {
2751   char * args;
2752
2753   if (objc != 2)
2754     {
2755       Tcl_AppendResult (interp, "wrong # of args: should be \"",
2756                         Tcl_GetStringFromObj (objv[0], NULL),
2757                         " function:line|function|line|*addr\"");
2758       return TCL_ERROR;
2759     }
2760
2761   args = Tcl_GetStringFromObj (objv[1], NULL);
2762
2763   Tcl_SetObjResult (interp, Tcl_NewIntObj (tracepoint_exists (args)));
2764   return TCL_OK;
2765 }
2766
2767 /* Return the prompt to the interpreter */
2768 static int
2769 gdb_prompt_command (clientData, interp, objc, objv)
2770   ClientData clientData;
2771   Tcl_Interp *interp;
2772   int objc;
2773   Tcl_Obj *CONST objv[];
2774 {
2775   Tcl_SetResult (interp, get_prompt (), TCL_VOLATILE);
2776   return TCL_OK;
2777 }
2778
2779 /* return a list of all tracepoint numbers in interpreter */
2780 static int
2781 gdb_get_tracepoint_list (clientData, interp, objc, objv)
2782   ClientData clientData;
2783   Tcl_Interp *interp;
2784   int objc;
2785   Tcl_Obj *CONST objv[];
2786 {
2787   Tcl_Obj *list;
2788   struct tracepoint *tp;
2789
2790   list = Tcl_NewListObj (0, NULL);
2791
2792   ALL_TRACEPOINTS (tp)
2793     Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->number));
2794
2795   Tcl_SetObjResult (interp, list);
2796   return TCL_OK;
2797 }
2798
2799 /* This is stolen from source.c */
2800 #ifdef CRLF_SOURCE_FILES
2801
2802 /* Define CRLF_SOURCE_FILES in an xm-*.h file if source files on the
2803    host use \r\n rather than just \n.  Defining CRLF_SOURCE_FILES is
2804    much faster than defining LSEEK_NOT_LINEAR.  */
2805
2806 #ifndef O_BINARY
2807 #define O_BINARY 0
2808 #endif
2809
2810 #define OPEN_MODE (O_RDONLY | O_BINARY)
2811
2812 #else /* ! defined (CRLF_SOURCE_FILES) */
2813
2814 #define OPEN_MODE O_RDONLY
2815
2816 #endif /* ! defined (CRLF_SOURCE_FILES) */
2817
2818 /* Find the pathname to a file, searching the source_dir */
2819 /* we may actually need to use openp to find the the full pathname
2820    so we don't have any "../" et al in it. */
2821 static int
2822 gdb_find_file_command (clientData, interp, objc, objv)
2823   ClientData clientData;
2824   Tcl_Interp *interp;
2825   int objc;
2826   Tcl_Obj *CONST objv[];
2827 {
2828   char *file, *filename;
2829
2830   if (objc != 2)
2831     {
2832       Tcl_AppendResult (interp, "wrong # of args: should be \"",
2833                         Tcl_GetStringFromObj (objv[0], NULL),
2834                         " filename\"");
2835       return TCL_ERROR;
2836     }
2837
2838   file  = Tcl_GetStringFromObj (objv[1], NULL);
2839   filename = find_file_in_dir (file);
2840
2841   if (filename == NULL)
2842     Tcl_SetResult (interp, "", TCL_STATIC);
2843   else
2844     Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
2845
2846   return TCL_OK;
2847 }
2848
2849 static char *
2850 find_file_in_dir (file)
2851      char *file;
2852 {
2853   struct symtab *st = NULL;
2854
2855   if (file != NULL)
2856     {
2857       /* try something simple first */
2858       if (access (file, R_OK) == 0)
2859         return file;
2860
2861       /* We really need a symtab for this to work... */
2862       st = lookup_symtab (file);
2863       if (st != NULL)
2864         {
2865           file = symtab_to_filename (st);
2866           if (file != NULL)
2867             return file;
2868         }
2869     }
2870
2871   return NULL;
2872 }
2873
2874 /* This hook is called whenever we are ready to load a symbol file so that
2875    the UI can notify the user... */
2876 void
2877 gdbtk_pre_add_symbol (name)
2878   char *name;
2879 {
2880   char command[256];
2881
2882   sprintf (command, "gdbtk_tcl_pre_add_symbol %s", name);
2883   Tcl_Eval (interp, command);
2884 }
2885
2886 /* This hook is called whenever we finish loading a symbol file. */
2887 void
2888 gdbtk_post_add_symbol ()
2889 {
2890   Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
2891 }
2892
2893
2894 /* TclDebug (const char *fmt, ...) works just like printf() but */
2895 /* sends the output to the GDB TK debug window. */
2896 /* Not for normal use; just a convenient tool for debugging */
2897 void
2898 #ifdef ANSI_PROTOTYPES
2899 TclDebug (const char *fmt, ...)
2900 #else
2901 TclDebug (va_alist)
2902      va_dcl
2903 #endif
2904 {
2905   va_list args;
2906   char buf[512];
2907
2908 #ifdef ANSI_PROTOTYPES
2909   va_start (args, fmt);
2910 #else
2911   char *fmt;
2912   va_start (args);
2913   fmt = va_arg (args, char *);
2914 #endif
2915
2916   strcpy (buf, "debug \"");
2917   vsprintf (&buf[7], fmt, args);
2918   va_end (args);
2919   strcat (buf, "\"");
2920   Tcl_Eval (interp, buf);
2921 }
2922
2923
2924 /* Come here during initialize_all_files () */
2925
2926 void
2927 _initialize_gdbtk ()
2928 {
2929   if (use_windows)
2930     {
2931       /* Tell the rest of the world that Gdbtk is now set up. */
2932
2933       init_ui_hook = gdbtk_init;
2934     }
2935 }