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