Wed Jul 1 13:10:58 1998 Jim Ingham <jingham@cygnus.com>
authorJim Ingham <jingham@apple.com>
Wed, 1 Jul 1998 20:17:31 +0000 (20:17 +0000)
committerJim Ingham <jingham@apple.com>
Wed, 1 Jul 1998 20:17:31 +0000 (20:17 +0000)
* Moved gdbtk_hooks.c & gdbtk_cmds.c to gdbtk-hooks.c &
gdbtk-cmds.c to comply with the gdb conventions.  Changed the
configure & makefile to reflect the change...

gdb/.Sanitize
gdb/ChangeLog-gdbtk
gdb/Makefile.in
gdb/configure
gdb/configure.in
gdb/gdbtk-cmds.c [new file with mode: 0644]
gdb/gdbtk-hooks.c [new file with mode: 0644]
gdb/gdbtk.h
gdb/gdbtk_cmds.c [deleted file]
gdb/gdbtk_hooks.c [deleted file]

index 8a1fe2f96c1b95a00cf07bd6677bb160f4492f5a..9b0c0af515ce1f877f1b18358c7ae5b3da66d706 100644 (file)
@@ -15,7 +15,7 @@
 
 Do-first:
 
-gdbtk_files="ChangeLog-gdbtk README.GDBTK gdbtk.c gdbtcl2 gdb.rc gdbtool.ico"
+gdbtk_files="ChangeLog-gdbtk README.GDBTK gdbtk.c gdbtk.h gdbtk-cmds.c gdbtk-hooks.c gdbtcl2 gdb.rc gdbtool.ico"
 
 if ( echo $* | grep lose\-gdbtk > /dev/null ) ; then
        lose_these_too="${gdbtk_files} ${lose_these_too}"
index e84b7391c91cfe32da9232f6149151787f72e454..7210894846bfda0d0f22a633a87b35de0d3efabd 100644 (file)
@@ -1,3 +1,9 @@
+Wed Jul  1 13:10:58 1998  Jim Ingham   <jingham@cygnus.com>
+
+       * Moved gdbtk_hooks.c & gdbtk_cmds.c to gdbtk-hooks.c &
+       gdbtk-cmds.c to comply with the gdb conventions.  Changed the
+       configure & makefile to reflect the change...
+       
 Wed Jul  1 11:07:21 1998  Jim Ingham   <jingham@cygnus.com>
 
        * gdbtk.c: removed all the commands and hooks from this file so
index 3609c2d4aff32470600e0045aa77f8e73d397aec..2da0019b9569e8c9b5e6dcb9a4ec6f65cc2eff6f 100644 (file)
@@ -1181,17 +1181,17 @@ gdbtk.o: gdbtk.c gdbtk.h $(defs_h) $(symtab_h) $(inferior_h) $(command_h) \
        $(TCL_CFLAGS) $(TK_CFLAGS) $(X11_CFLAGS) \
                $(srcdir)/gdbtk.c -DGDBTK_LIBRARY=\"$(datadir)/gdbtcl\"
 
-gdbtk_cmds.o: gdbtk_cmds.c gdbtk.h $(defs_h) $(symtab_h) $(inferior_h) $(command_h) \
+gdbtk-cmds.o: gdbtk-cmds.c gdbtk.h $(defs_h) $(symtab_h) $(inferior_h) $(command_h) \
        $(bfd_h) symfile.h objfiles.h target.h gdb_string.h $(tracepoint_h)
        $(CC) -c $(INTERNAL_CFLAGS) $(IDE_CFLAGS) $(ITCL_CFLAGS) $(TIX_CFLAGS) \
        $(TCL_CFLAGS) $(TK_CFLAGS) $(X11_CFLAGS) \
-               $(srcdir)/gdbtk_cmds.c -DGDBTK_LIBRARY=\"$(datadir)/gdbtcl\"
+               $(srcdir)/gdbtk-cmds.c -DGDBTK_LIBRARY=\"$(datadir)/gdbtcl\"
 
-gdbtk_hooks.o: gdbtk_hooks.c gdbtk.h $(defs_h) $(symtab_h) $(inferior_h) $(command_h) \
+gdbtk-hooks.o: gdbtk-hooks.c gdbtk.h $(defs_h) $(symtab_h) $(inferior_h) $(command_h) \
        $(bfd_h) symfile.h objfiles.h target.h gdb_string.h $(tracepoint_h)
        $(CC) -c $(INTERNAL_CFLAGS) $(IDE_CFLAGS) $(ITCL_CFLAGS) $(TIX_CFLAGS) \
        $(TCL_CFLAGS) $(TK_CFLAGS) $(X11_CFLAGS) \
-               $(srcdir)/gdbtk_hooks.c -DGDBTK_LIBRARY=\"$(datadir)/gdbtcl\"
+               $(srcdir)/gdbtk-hooks.c -DGDBTK_LIBRARY=\"$(datadir)/gdbtcl\"
 
 tracepoint.o: tracepoint.c $(defs_h) $(symtab_h) $(frame_h) $(tracepoint_h) \
        $(gdbtypes_h) $(expression_h) $(gdbcmd_h) $(value_h) target.h \
index cc332885c8701712ceb5e813448e8ef6ec83ab70..a978e2ccab18627ca3713f218d119e4dba67f8f8 100755 (executable)
@@ -5213,7 +5213,7 @@ fi
           # were in LIBS then any link tests after this point would
           # try to include things like `$(LIBGUI)', which wouldn't work.
           GDBTKLIBS="${TCL_LIBS} ${TK_LIBS}"
-          CONFIG_OBS="${CONFIG_OBS} gdbtk.o gdbtk_cmds.o gdbtk_hooks.o"
+          CONFIG_OBS="${CONFIG_OBS} gdbtk.o gdbtk-cmds.o gdbtk-hooks.o"
 
           if test x$gdb_cv_os_cygwin32 = xyes; then
              WIN32LIBS="${WIN32LIBS} -lshell32 -lgdi32 -lcomdlg32 -ladvapi32 -luser32"
index d2ababdaebe99f371c4c6ae43de855fbd0cf93e3..46af5243bd492909333bcb45314f781aa44a4591 100644 (file)
@@ -425,7 +425,7 @@ if test "${enable_gdbtk}" = "yes"; then
           # were in LIBS then any link tests after this point would
           # try to include things like `$(LIBGUI)', which wouldn't work.
           GDBTKLIBS="${TCL_LIBS} ${TK_LIBS}"
-          CONFIG_OBS="${CONFIG_OBS} gdbtk.o gdbtk_cmds.o gdbtk_hooks.o"
+          CONFIG_OBS="${CONFIG_OBS} gdbtk.o gdbtk-cmds.o gdbtk-hooks.o"
 
           if test x$gdb_cv_os_cygwin32 = xyes; then
              WIN32LIBS="${WIN32LIBS} -lshell32 -lgdi32 -lcomdlg32 -ladvapi32 -luser32"
diff --git a/gdb/gdbtk-cmds.c b/gdb/gdbtk-cmds.c
new file mode 100644 (file)
index 0000000..221e3e6
--- /dev/null
@@ -0,0 +1,3075 @@
+/* Tcl/Tk command definitions for gdbtk.
+   Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+
+   Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
+
+This file is part of GDB.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "symtab.h"
+#include "inferior.h"
+#include "command.h"
+#include "bfd.h"
+#include "symfile.h"
+#include "objfiles.h"
+#include "target.h"
+#include "gdbcore.h"
+#include "tracepoint.h"
+#include "demangle.h"
+
+#ifdef _WIN32
+#include <winuser.h>
+#endif
+
+#include <sys/stat.h>
+
+#include <tcl.h>
+#include <tk.h>
+#include <itcl.h> 
+#include <tix.h> 
+#include "guitcl.h"
+#include "gdbtk.h"
+
+#ifdef IDE
+/* start-sanitize-ide */
+#include "event.h"
+#include "idetcl.h"
+#include "ilutk.h"
+/* end-sanitize-ide */
+#endif
+
+#ifdef ANSI_PROTOTYPES
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+#include <signal.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <setjmp.h>
+#include "top.h"
+#include <sys/ioctl.h>
+#include "gdb_string.h"
+#include "dis-asm.h"
+#include <stdio.h>
+#include "gdbcmd.h"
+
+#include "annotate.h"
+#include <sys/time.h>
+
+/* This structure filled in call_wrapper and passed to
+   the wrapped call function.
+   It stores the command pointer and arguments 
+   run in the wrapper function. */
+
+struct wrapped_call_args
+{
+  Tcl_Interp *interp;
+  Tcl_ObjCmdProc *func;
+  int objc;
+  Tcl_Obj *CONST *objv;
+  int val;
+};
+
+/* These two objects hold boolean true and false,
+   and are shared by all the list objects that gdb_listfuncs
+   returns. */
+   
+static Tcl_Obj *mangled, *not_mangled;
+
+/* These two control how the GUI behaves when gdb is either tracing or loading.
+   They are used in this file & gdbtk_hooks.c */
+
+int No_Update = 0;
+int load_in_progress = 0;
+
+/*
+ * This is used in the register fetching routines
+ */
+
+#ifndef REGISTER_CONVERTIBLE
+#define REGISTER_CONVERTIBLE(x) (0 != 0)
+#endif
+
+#ifndef REGISTER_CONVERT_TO_VIRTUAL
+#define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
+#endif
+
+#ifndef INVALID_FLOAT
+#define INVALID_FLOAT(x, y) (0 != 0)
+#endif
+
+
+
+/* This Structure is used in gdb_disassemble.
+   We need a different sort of line table from the normal one cuz we can't
+   depend upon implicit line-end pc's for lines to do the
+   reordering in this function.  */
+
+struct my_line_entry {
+  int line;
+  CORE_ADDR start_pc;
+  CORE_ADDR end_pc;
+};
+
+/* This contains the previous values of the registers, since the last call to
+   gdb_changed_register_list.  */
+
+static char old_regs[REGISTER_BYTES];
+
+/*
+ * These are routines we need from breakpoint.c.
+ * at some point make these static in breakpoint.c and move GUI code there
+ */
+
+extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
+extern void set_breakpoint_count (int);
+extern int breakpoint_count;
+
+
+/*
+ * Declarations for routines used only in this file.
+ */
+
+int Gdbtk_Init (Tcl_Interp *interp);
+static int compare_lines PARAMS ((const PTR, const PTR));
+static int comp_files PARAMS ((const void *, const void *));
+static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                       Tcl_Obj *CONST objv[]));
+static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_clear_file PARAMS ((ClientData, Tcl_Interp *interp, int, Tcl_Obj *CONST []));
+static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_confirm_quit PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_disassemble PARAMS ((ClientData, Tcl_Interp *, int, 
+                                   Tcl_Obj *CONST []));
+static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                         Tcl_Obj *CONST objv[]));
+static int gdb_force_quit PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static struct symtab *full_lookup_symtab PARAMS ((char *file));
+static int gdb_get_args_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                        Tcl_Obj *CONST objv[]));
+static int gdb_get_breakpoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_get_file_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                        Tcl_Obj *CONST objv[]));
+static int gdb_get_function_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                            Tcl_Obj *CONST objv[]));
+static int gdb_get_line_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                        Tcl_Obj *CONST objv[]));
+static int gdb_get_locals_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                        Tcl_Obj *CONST objv[]));
+static int gdb_get_mem PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_get_trace_frame_num PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int,
+                                           Tcl_Obj *CONST objv[]));
+static int gdb_get_vars_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                        Tcl_Obj *CONST objv[]));
+static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_loadfile PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int,
+                                      Tcl_Obj *CONST objv[]));
+static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_search PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
+                              objv[]));
+static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *,
+                                                    int,
+                                                    Tcl_Obj *CONST []));
+static int gdb_trace_status PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_tracepoint_exists_command PARAMS ((ClientData, Tcl_Interp *,
+                                                 int,
+                                                 Tcl_Obj *CONST objv[]));
+static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int,
+                                           Tcl_Obj *CONST objv[]));
+static void gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
+static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
+static void gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
+static void gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
+static void gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
+static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
+static void gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
+static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
+static void gdbtk_readline_end PARAMS ((void));
+static int get_pc_register PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+char * get_prompt PARAMS ((void));
+static void get_register PARAMS ((int, void *));
+static void get_register_name PARAMS ((int, void *));
+static int map_arg_registers PARAMS ((int, Tcl_Obj *CONST [], void (*) (int, void *), void *));
+static void pc_changed PARAMS ((void));
+static int perror_with_name_wrapper PARAMS ((char *args));
+static void register_changed_p PARAMS ((int, void *));
+void TclDebug PARAMS ((const char *fmt, ...));
+static int wrapped_call (char *opaque_args);
+\f
+/* Gdbtk_Init
+ *    This loads all the Tcl commands into the Tcl interpreter.
+ *
+ * Arguments:
+ *    interp - The interpreter into which to load the commands.
+ *
+ * Result:
+ *     A standard Tcl result.
+ */
+
+int
+Gdbtk_Init (interp)
+     Tcl_Interp *interp;
+{
+  Tcl_CreateObjCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_immediate", call_wrapper,
+                       gdb_immediate_command, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
+                       NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
+                       NULL);
+  Tcl_CreateObjCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_fetch_registers", call_wrapper,
+                       gdb_fetch_registers, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_changed_register_list", call_wrapper,
+                       gdb_changed_register_list, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_disassemble", call_wrapper,
+                       gdb_disassemble, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
+                       gdb_get_breakpoint_list, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
+                       gdb_get_breakpoint_info, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_clear_file", call_wrapper,
+                       gdb_clear_file, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_confirm_quit", call_wrapper,
+                       gdb_confirm_quit, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_force_quit", call_wrapper,
+                       gdb_force_quit, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_target_has_execution",
+                       call_wrapper,
+                       gdb_target_has_execution_command, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_is_tracing",
+                       call_wrapper, gdb_trace_status,
+                       NULL);
+  Tcl_CreateObjCommand (interp, "gdb_load_info", call_wrapper, gdb_load_info, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_locals", call_wrapper, gdb_get_locals_command, 
+                       NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_args", call_wrapper, gdb_get_args_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_function", call_wrapper, gdb_get_function_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_line", call_wrapper, gdb_get_line_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_file", call_wrapper, gdb_get_file_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
+                        call_wrapper, gdb_tracepoint_exists_command,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
+                        call_wrapper, gdb_get_tracepoint_info,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_actions",
+                        call_wrapper, gdb_actions_command,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_prompt",
+                        call_wrapper, gdb_prompt_command,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_find_file",
+                        call_wrapper, gdb_find_file_command,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
+                        call_wrapper, gdb_get_tracepoint_list,  NULL);  
+  Tcl_CreateObjCommand (interp, "gdb_pc_reg", call_wrapper, get_pc_register, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_loadfile", call_wrapper, gdb_loadfile,  NULL);
+  Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper,
+                       gdb_search,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_set_bp", call_wrapper, gdb_set_bp,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_trace_frame_num",
+                        call_wrapper, gdb_get_trace_frame_num,  NULL);  
+
+  Tcl_PkgProvide(interp, "Gdbtk", GDBTK_VERSION);
+  return TCL_OK;
+}
+
+/* This routine acts as a top-level for all GDB code called by Tcl/Tk.  It
+   handles cleanups, and uses catch_errors to trap calls to return_to_top_level
+   (usually via error).
+   This is necessary in order to prevent a longjmp out of the bowels of Tk,
+   possibly leaving things in a bad state.  Since this routine can be called
+   recursively, it needs to save and restore the contents of the result_ptr as
+   necessary. */
+
+static int
+call_wrapper (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct wrapped_call_args wrapped_args;
+  gdbtk_result new_result, *old_result_ptr;
+  int length;
+  
+  old_result_ptr = result_ptr;
+  result_ptr = &new_result;
+  result_ptr->obj_ptr = Tcl_NewObj();
+  result_ptr->flags = GDBTK_TO_RESULT;
+
+  wrapped_args.func = (Tcl_ObjCmdProc *) clientData;
+  wrapped_args.interp = interp;
+  wrapped_args.objc = objc;
+  wrapped_args.objv = objv;
+  wrapped_args.val = TCL_OK;
+
+  if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
+    {
+      
+      wrapped_args.val = TCL_ERROR;    /* Flag an error for TCL */
+
+      /* Make sure the timer interrupts are turned off.  */
+
+      gdbtk_stop_timer ();
+
+      gdb_flush (gdb_stderr);  /* Flush error output */
+      gdb_flush (gdb_stdout);  /* Sometimes error output comes here as well */
+
+      /* If we errored out here, and the results were going to the
+        console, then gdbtk_fputs will have gathered the result into the
+        result_ptr.  We also need to echo them out to the console here */
+
+      gdb_flush (gdb_stderr);  /* Flush error output */
+      gdb_flush (gdb_stdout);  /* Sometimes error output comes here as well */
+
+      /* In case of an error, we may need to force the GUI into idle
+        mode because gdbtk_call_command may have bombed out while in
+        the command routine.  */
+
+      running_now = 0;
+      Tcl_Eval (interp, "gdbtk_tcl_idle");
+      
+    }
+  
+  /* do not suppress any errors -- a remote target could have errored */
+  load_in_progress = 0;
+
+  /*
+   * Now copy the result over to the true Tcl result.  If GDBTK_TO_RESULT flag
+   * bit is set , this just copies a null object over to the Tcl result, which is
+   * fine because we should reset the result in this case anyway.
+   */
+  if (result_ptr->flags & GDBTK_IN_TCL_RESULT)
+    {
+      Tcl_DecrRefCount(result_ptr->obj_ptr);
+    }
+  else
+    {
+      Tcl_SetObjResult (interp, result_ptr->obj_ptr);
+    }
+
+  result_ptr = old_result_ptr;
+
+#ifdef _WIN32
+  close_bfds ();
+#endif
+
+  return wrapped_args.val;
+}
+
+/*
+ * This is the wrapper that is passed to catch_errors.
+ */
+
+static int
+wrapped_call (opaque_args)
+     char *opaque_args;
+{
+  struct wrapped_call_args *args = (struct wrapped_call_args *) opaque_args;
+  args->val = (*args->func) (args->func, args->interp, args->objc, args->objv);
+  return 1;
+}
+
+/* This is a convenience function to sprintf something(s) into a
+ * new element in a Tcl list object.
+ */
+
+static void
+#ifdef ANSI_PROTOTYPES
+sprintf_append_element_to_obj (Tcl_Obj *objp, char *format, ...)
+#else
+sprintf_append_element_to_obj (va_alist)
+     va_dcl
+#endif
+{
+  va_list args;
+  char buf[1024];
+  
+#ifdef ANSI_PROTOTYPES
+  va_start (args, format);
+#else
+  Tcl_Obj *objp;
+  char *format;
+
+  va_start (args);
+  dsp = va_arg (args, Tcl_Obj *);
+  format = va_arg (args, char *);
+#endif
+
+  vsprintf (buf, format, args);
+
+  Tcl_ListObjAppendElement (NULL, objp, Tcl_NewStringObj (buf, -1));
+}
+\f
+/*
+ * This section contains the commands that control execution.
+ */
+
+/* This implements the tcl command gdb_clear_file.
+ *
+ * Prepare to accept a new executable file.  This is called when we
+ * want to clear away everything we know about the old file, without
+ * asking the user.  The Tcl code will have already asked the user if
+ * necessary.  After this is called, we should be able to run the
+ * `file' command without getting any questions.  
+ *
+ * Arguments:
+ *    None
+ * Tcl Result:
+ *    None
+ */
+
+static int
+gdb_clear_file (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  if (objc != 1)
+    Tcl_SetStringObj (result_ptr->obj_ptr,
+                     "Wrong number of args, none are allowed.", -1);
+  
+  if (inferior_pid != 0 && target_has_execution)
+    {
+      if (attach_flag)
+       target_detach (NULL, 0);
+      else
+       target_kill ();
+    }
+
+  if (target_has_execution)
+    pop_target ();
+
+  symbol_file_command (NULL, 0);
+
+  /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
+     clear it here.  FIXME: This seems like an abstraction violation
+     somewhere.  */
+  stop_pc = 0;
+
+  return TCL_OK;
+}
+
+/* This implements the tcl command gdb_confirm_quit
+ * Ask the user to confirm an exit request.
+ *
+ * Arguments:
+ *    None
+ * Tcl Result:
+ *    A boolean, 1 if the user answered yes, 0 if no.
+ */
+
+static int
+gdb_confirm_quit (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int ret;
+
+  if (objc != 1)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Wrong number of args, should be none.", -1);
+      return TCL_ERROR;
+    }
+  
+  ret = quit_confirm ();
+  Tcl_SetBooleanObj (result_ptr->obj_ptr, ret);
+  return TCL_OK;
+}
+
+/* This implements the tcl command gdb_force_quit
+ * Quit without asking for confirmation.
+ *
+ * Arguments:
+ *    None
+ * Tcl Result:
+ *    None
+ */
+
+static int
+gdb_force_quit (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  if (objc != 1)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Wrong number of args, should be none.", -1);
+      return TCL_ERROR;
+    }
+  
+  quit_force ((char *) NULL, 1);
+  return TCL_OK;
+}
+
+/* This implements the tcl command gdb_stop
+ * It stops the target in a continuable fashion.
+ *
+ * Arguments:
+ *    None
+ * Tcl Result:
+ *    None
+ */
+
+static int
+gdb_stop (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  if (target_stop)
+    {
+      target_stop ();
+    }
+  else
+    quit_flag = 1; /* hope something sees this */
+
+  return TCL_OK;
+}
+
+\f
+/*
+ * This section contains Tcl commands that are wrappers for invoking
+ * the GDB command interpreter.
+ */
+
+
+/* This implements the tcl command `gdb_eval'.
+ * It uses the gdb evaluator to return the value of
+ * an expression in the current language
+ *
+ * Tcl Arguments:
+ *     expression - the expression to evaluate.
+ * Tcl Result:
+ *     The result of the evaluation.
+ */
+
+static int
+gdb_eval (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct expression *expr;
+  struct cleanup *old_chain;
+  value_ptr val;
+
+  if (objc != 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr,
+                       "wrong # args, should be \"gdb_eval expression\"", -1);
+      return TCL_ERROR;
+    }
+
+  expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
+
+  old_chain = make_cleanup (free_current_contents, &expr);
+
+  val = evaluate_expression (expr);
+
+  /*
+   * Print the result of the expression evaluation.  This will go to
+   * eventually go to gdbtk_fputs, and from there be collected into
+   * the Tcl result.
+   */
+  
+  val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
+            gdb_stdout, 0, 0, 0, 0);
+
+  do_cleanups (old_chain);
+
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_cmd".
+ *  
+ * It sends its argument to the GDB command scanner for execution. 
+ * This command will never cause the update, idle and busy hooks to be called
+ * within the GUI.
+ * 
+ * Tcl Arguments:
+ *    command - The GDB command to execute
+ * Tcl Result:
+ *    The output from the gdb command (except for the "load" & "while"
+ *    which dump their output to the console.
+ */
+
+static int
+gdb_cmd (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+
+  if (objc < 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
+      return TCL_ERROR;
+    }
+
+  if (running_now || load_in_progress)
+    return TCL_OK;
+
+  No_Update = 1;
+
+  /* for the load instruction (and possibly others later) we
+     set turn off the GDBTK_TO_RESULT flag bit so gdbtk_fputs() 
+     will not buffer all the data until the command is finished. */
+
+  if ((strncmp ("load ", Tcl_GetStringFromObj (objv[1], NULL), 5) == 0)
+      || (strncmp ("while ", Tcl_GetStringFromObj (objv[1], NULL), 6) == 0))
+    {
+      result_ptr->flags &= ~GDBTK_TO_RESULT;
+      load_in_progress = 1;
+      gdbtk_start_timer ();
+    }
+
+  execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+
+  if (load_in_progress)
+    {
+      gdbtk_stop_timer ();
+      load_in_progress = 0;
+      result_ptr->flags |= GDBTK_TO_RESULT;
+    }
+
+  bpstat_do_actions (&stop_bpstat);
+  
+  return TCL_OK;
+}
+
+/*
+ * This implements the tcl command "gdb_immediate"
+ *  
+ * It does exactly the same thing as gdb_cmd, except NONE of its outut 
+ * is buffered.  This will also ALWAYS cause the busy, update, and idle hooks to
+ * be called, contrasted with gdb_cmd, which NEVER calls them.
+ * It turns off the GDBTK_TO_RESULT flag, which diverts the result
+ * to the console window.
+ *
+ * Tcl Arguments:
+ *    command - The GDB command to execute
+ * Tcl Result:
+ *    None.
+ */
+
+static int
+gdb_immediate_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+
+  if (objc != 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
+      return TCL_ERROR;
+    }
+
+  if (running_now || load_in_progress)
+    return TCL_OK;
+
+  No_Update = 0;
+
+  result_ptr->flags &= ~GDBTK_TO_RESULT;  
+
+  execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+
+  bpstat_do_actions (&stop_bpstat);
+  
+  result_ptr->flags |= GDBTK_TO_RESULT;
+
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_prompt"
+ *
+ * It returns the gdb interpreter's prompt.
+ *
+ * Tcl Arguments:
+ *    None.
+ * Tcl Result:
+ *    The prompt.
+ */
+
+static int
+gdb_prompt_command (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  Tcl_SetStringObj (result_ptr->obj_ptr, get_prompt (), -1);
+  return TCL_OK;
+}
+
+\f
+/*
+ * This section contains general informational commands.
+ */
+
+/* This implements the tcl command "gdb_target_has_execution"
+ *
+ * Tells whether the target is executing.
+ *
+ * Tcl Arguments:
+ *    None
+ * Tcl Result:
+ *    A boolean indicating whether the target is executing.
+ */
+
+static int
+gdb_target_has_execution_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int result = 0;
+
+  if (target_has_execution && inferior_pid != 0)
+    result = 1;
+
+  Tcl_SetBooleanObj (result_ptr->obj_ptr, result);
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_load_info"
+ *
+ * It returns information about the file about to be downloaded.
+ *
+ * Tcl Arguments:
+ *    filename: The file to open & get the info on.
+ * Tcl Result:
+ *    A list consisting of the name and size of each section.
+ */
+
+static int
+gdb_load_info (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+   bfd *loadfile_bfd;
+   struct cleanup *old_cleanups;
+   asection *s;
+   Tcl_Obj *ob[2];
+   int i = 0;
+
+   char *filename = Tcl_GetStringFromObj (objv[1], NULL);
+
+   loadfile_bfd = bfd_openr (filename, gnutarget);
+   if (loadfile_bfd == NULL)
+     {
+       Tcl_SetStringObj (result_ptr->obj_ptr, "Open failed", -1);
+       return TCL_ERROR;
+     }
+   old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
+   
+   if (!bfd_check_format (loadfile_bfd, bfd_object)) 
+     {
+       Tcl_SetStringObj (result_ptr->obj_ptr, "Bad Object File", -1);
+       return TCL_ERROR;
+    }
+
+   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+   
+   for (s = loadfile_bfd->sections; s; s = s->next) 
+     {
+       if (s->flags & SEC_LOAD) 
+        {
+          bfd_size_type size = bfd_get_section_size_before_reloc (s);
+          if (size > 0)
+            {
+              ob[0] = Tcl_NewStringObj ((char *) bfd_get_section_name (loadfile_bfd, s), -1);
+              ob[1] = Tcl_NewLongObj ((long) size);
+              Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewListObj (2, ob));
+            }
+        }
+     }
+   
+   do_cleanups (old_cleanups);
+   return TCL_OK;
+}
+
+
+/* gdb_get_locals -
+ * This and gdb_get_locals just call gdb_get_vars_command with the right
+ * value of clientData.  We can't use the client data in the definition
+ * of the command, because the call wrapper uses this instead...
+ */
+
+static int
+gdb_get_locals_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+
+  return gdb_get_vars_command((ClientData) 0, interp, objc, objv);
+
+}
+
+static int
+gdb_get_args_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+
+  return gdb_get_vars_command((ClientData) 1, interp, objc, objv);
+
+}
+
+/* This implements the tcl commands "gdb_get_locals" and "gdb_get_args"
+ *  
+ * This function sets the Tcl interpreter's result to a list of variable names
+ * depending on clientData. If clientData is one, the result is a list of
+ * arguments; zero returns a list of locals -- all relative to the block
+ * specified as an argument to the command. Valid commands include
+ * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
+ * and "main").
+ *
+ * Tcl Arguments:
+ *   block - the address within which to specify the locals or args.
+ * Tcl Result:
+ *   A list of the locals or args
+ */
+
+static int
+gdb_get_vars_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct symtabs_and_lines sals;
+  struct symbol *sym;
+  struct block *block;
+  char **canonical, *args;
+  int i, nsyms, arguments;
+
+  if (objc != 2)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr,
+                        "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " function:line|function|line|*addr\"", NULL);
+      return TCL_ERROR;
+    }
+
+  arguments = (int) clientData;
+  args = Tcl_GetStringFromObj (objv[1], NULL);
+  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
+  if (sals.nelts == 0)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr,
+                        "error decoding line", -1);
+      return TCL_ERROR;
+    }
+
+  /* Initialize the result pointer to an empty list. */
+
+  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+
+  /* Resolve all line numbers to PC's */
+  for (i = 0; i < sals.nelts; i++)
+    resolve_sal_pc (&sals.sals[i]);
+  
+  block = block_for_pc (sals.sals[0].pc);
+  while (block != 0)
+    {
+      nsyms = BLOCK_NSYMS (block);
+      for (i = 0; i < nsyms; i++)
+        {
+          sym = BLOCK_SYM (block, i);
+          switch (SYMBOL_CLASS (sym)) {
+          default:
+          case LOC_UNDEF:                /* catches errors        */
+          case LOC_CONST:            /* constant              */
+          case LOC_STATIC:           /* static                */
+          case LOC_REGISTER:      /* register              */
+          case LOC_TYPEDEF:          /* local typedef         */
+          case LOC_LABEL:            /* local label           */
+          case LOC_BLOCK:            /* local function        */
+          case LOC_CONST_BYTES:          /* loc. byte seq.        */
+          case LOC_UNRESOLVED:    /* unresolved static     */
+          case LOC_OPTIMIZED_OUT: /* optimized out         */
+            break;
+          case LOC_ARG:                      /* argument              */
+          case LOC_REF_ARG:          /* reference arg         */
+          case LOC_REGPARM:          /* register arg          */
+          case LOC_REGPARM_ADDR:  /* indirect register arg */
+          case LOC_LOCAL_ARG:    /* stack arg             */
+          case LOC_BASEREG_ARG:          /* basereg arg           */
+            if (arguments)
+              Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
+                                        Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
+            break;
+          case LOC_LOCAL:            /* stack local           */
+          case LOC_BASEREG:          /* basereg local         */
+            if (!arguments)
+              Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
+                                        Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
+            break;
+          }
+        }
+      if (BLOCK_FUNCTION (block))
+        break;
+      else
+        block = BLOCK_SUPERBLOCK (block);
+    }
+  
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_get_line"
+ *
+ * It returns the linenumber for a given linespec.  It will take any spec
+ * that can be passed to decode_line_1
+ *
+ * Tcl Arguments:
+ *    linespec - the line specification
+ * Tcl Result:
+ *    The line number for that spec.
+ */
+static int
+gdb_get_line_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  Tcl_Obj *result;
+  struct symtabs_and_lines sals;
+  char *args, **canonical;
+  
+  if (objc != 2)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " linespec\"", NULL);
+      return TCL_ERROR;
+    }
+
+  args = Tcl_GetStringFromObj (objv[1], NULL);
+  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
+  if (sals.nelts == 1)
+    {
+      Tcl_SetIntObj (result_ptr->obj_ptr, sals.sals[0].line);
+      return TCL_OK;
+    }
+
+  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
+  return TCL_OK;
+  
+}
+
+/* This implements the tcl command "gdb_get_file"
+ *
+ * It returns the file containing a given line spec.
+ *
+ * Tcl Arguments:
+ *    linespec - The linespec to look up
+ * Tcl Result:
+ *    The file containing it.
+ */
+
+static int
+gdb_get_file_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  Tcl_Obj *result;
+  struct symtabs_and_lines sals;
+  char *args, **canonical;
+  
+  if (objc != 2)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " linespec\"", NULL);
+      return TCL_ERROR;
+    }
+
+  args = Tcl_GetStringFromObj (objv[1], NULL);
+  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
+  if (sals.nelts == 1)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, sals.sals[0].symtab->filename, -1);
+      return TCL_OK;
+    }
+
+  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_get_function"
+ *
+ * It finds the function containing the given line spec.
+ *
+ * Tcl Arguments:
+ *    linespec - The line specification
+ * Tcl Result:
+ *    The function that contains it, or "N/A" if it is not in a function.
+ */
+static int
+gdb_get_function_command (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  char *function;
+  struct symtabs_and_lines sals;
+  char *args, **canonical;
+
+  if (objc != 2)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " linespec\"", NULL);
+      return TCL_ERROR;
+    }
+
+  args = Tcl_GetStringFromObj (objv[1], NULL);
+  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
+  if (sals.nelts == 1)
+    {
+      resolve_sal_pc (&sals.sals[0]);
+      find_pc_partial_function (sals.sals[0].pc, &function, NULL, NULL);
+      if (function != NULL)
+        {
+          Tcl_SetStringObj (result_ptr->obj_ptr, function, -1);
+          return TCL_OK;
+        }
+    }
+  
+  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_find_file"
+ *
+ * It searches the symbol tables to get the full pathname to a file.
+ *
+ * Tcl Arguments:
+ *    filename: the file name to search for.
+ * Tcl Result:
+ *    The full path to the file, or an empty string if the file is not
+ *    found.
+ */
+
+static int
+gdb_find_file_command (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  char *filename = NULL;
+  struct symtab *st;
+
+  if (objc != 2)
+    {
+      Tcl_WrongNumArgs(interp, 1, objv, "filename");
+      return TCL_ERROR;
+    }
+
+  st = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
+  if (st)
+    filename = st->fullname;
+
+  if (filename == NULL)
+    Tcl_SetStringObj (result_ptr->obj_ptr, "", 0);
+  else
+    Tcl_SetStringObj (result_ptr->obj_ptr, filename, -1);
+
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_listfiles"
+ *
+ * This lists all the files in the current executible.
+ *
+ * Arguments:
+ *    ?pathname? - If provided, only files which match pathname
+ *        (up to strlen(pathname)) are included.
+ * Tcl Result:
+ *    A list of all matching files.
+ */
+
+static int
+gdb_listfiles (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  struct objfile *objfile;
+  struct partial_symtab *psymtab;
+  struct symtab *symtab;
+  char *lastfile, *pathname, **files;
+  int files_size;
+  int i, numfiles = 0, len = 0;
+  Tcl_Obj *mylist;
+  
+  files_size = 1000;
+  files = (char **) xmalloc (sizeof (char *) * files_size);
+
+  if (objc > 2)
+    {
+      Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
+      return TCL_ERROR;
+    }
+  else if (objc == 2)
+    pathname = Tcl_GetStringFromObj (objv[1], &len);
+
+  ALL_PSYMTABS (objfile, psymtab)
+    {
+      if (numfiles == files_size)
+        {
+           files_size = files_size * 2;
+           files = (char **) xrealloc (files, sizeof (char *) * files_size);
+        }
+      if (len == 0)
+       {
+         if (psymtab->filename)
+           files[numfiles++] = basename(psymtab->filename);
+       }
+      else if (!strcmp(psymtab->filename,basename(psymtab->filename))
+              || !strncmp(pathname,psymtab->filename,len))
+       if (psymtab->filename)
+         files[numfiles++] = basename(psymtab->filename);
+    }
+
+  ALL_SYMTABS (objfile, symtab)
+    {
+      if (numfiles == files_size)
+        {
+           files_size = files_size * 2;
+           files = (char **) xrealloc (files, sizeof (char *) * files_size);
+        }
+      if (len == 0)
+       {
+         if (symtab->filename)
+           files[numfiles++] = basename(symtab->filename);
+       }
+      else if (!strcmp(symtab->filename,basename(symtab->filename))
+              || !strncmp(pathname,symtab->filename,len))
+       if (symtab->filename)
+         files[numfiles++] = basename(symtab->filename);
+    }
+
+  qsort (files, numfiles, sizeof(char *), comp_files);
+
+  lastfile = "";
+
+  /* Discard the old result pointer, in case it has accumulated anything
+     and set it to a new list object */
+  
+  Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);
+  
+  for (i = 0; i < numfiles; i++)
+    {
+      if (strcmp(files[i],lastfile))
+       Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj(files[i], -1));
+      lastfile = files[i];
+    }
+
+  free (files);
+  return TCL_OK;
+}
+
+static int
+comp_files (file1, file2)
+     const void *file1, *file2;
+{
+  return strcmp(* (char **) file1, * (char **) file2);
+}
+
+
+/* This implements the tcl command "gdb_search"
+ *
+ *
+ * Tcl Arguments:
+ *    option - One of "functions", "variables" or "types"
+ *    regexp - The regular expression to look for.
+ * Then, optionally:
+ *    -files fileList
+ *    -static 1/0
+ * Tcl Result:
+ *
+ */
+
+static int
+gdb_search (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct symbol_search *ss;
+  struct symbol_search *p;
+  struct cleanup *old_chain;
+  Tcl_Obj *list, *result, *CONST *switch_objv;
+  int index, switch_objc, i;
+  namespace_enum space;
+  char *regexp, *val;
+  int static_only, nfiles;
+  Tcl_Obj **file_list;
+  char **files;
+  static char *search_options[] = { "functions", "variables", "types", (char *) NULL };
+  static char *switches[] = { "-files", "-static" };
+  enum search_opts { SEARCH_FUNCTIONS, SEARCH_VARIABLES, SEARCH_TYPES };
+  enum switches_opts { SWITCH_FILES, SWITCH_STATIC_ONLY };
+
+  if (objc < 3)
+    {
+      Tcl_WrongNumArgs (interp, 1, objv, "option regexp ?arg ...?");
+      return TCL_ERROR;
+    }
+
+  if (Tcl_GetIndexFromObj (interp, objv[1], search_options, "option", 0,
+                           &index) != TCL_OK)
+    return TCL_ERROR;
+
+  /* Unfortunately, we cannot teach search_symbols to search on
+     multiple regexps, so we have to do a two-tier search for
+     any searches which choose to narrow the playing field. */
+  switch ((enum search_opts) index)
+    {
+    case SEARCH_FUNCTIONS:
+      space = FUNCTIONS_NAMESPACE;      break;
+    case SEARCH_VARIABLES:
+      space = VARIABLES_NAMESPACE;      break;
+    case SEARCH_TYPES:
+      space = TYPES_NAMESPACE;          break;
+    }
+
+  regexp = Tcl_GetStringFromObj (objv[2], NULL);
+  /* Process any switches that refine the search */
+  switch_objc = objc - 3;
+  switch_objv = objv + 3;
+
+  static_only = 0;
+  nfiles = 0;
+  files = (char **) NULL;
+  while (switch_objc > 0)
+    {
+      if (Tcl_GetIndexFromObj (interp, switch_objv[0], switches,
+                               "option", 0, &index) != TCL_OK)
+       {
+         result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+         return TCL_ERROR;
+       }
+
+      switch ((enum switches_opts) index)
+        {
+        case SWITCH_FILES:
+          if (switch_objc < 2)
+            {
+              Tcl_WrongNumArgs (interp, 2, objv, "[-files fileList -static 1|0]");
+             result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+              return TCL_ERROR;
+            }              
+          Tcl_ListObjGetElements (interp, switch_objv[1], &nfiles, &file_list);
+          files = (char **) xmalloc (nfiles);
+          old_chain = make_cleanup (free, files);
+          
+          for (i = 0; i < nfiles; i++)
+              files[i] = Tcl_GetStringFromObj (file_list[i], NULL);
+          switch_objc--;
+          switch_objv++;
+          break;
+        case SWITCH_STATIC_ONLY:
+          if (switch_objc < 2)
+            {
+              Tcl_WrongNumArgs (interp, 2, objv, "[-files fileList] [-static 1|0]");
+             result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+              return TCL_ERROR;
+            }              
+          if ( Tcl_GetBooleanFromObj (interp, switch_objv[1], &static_only) !=
+              TCL_OK) {
+           result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+           return TCL_ERROR;
+         }
+          switch_objc--;
+          switch_objv++;
+        }
+
+      switch_objc--;
+      switch_objv++;
+    }
+
+  search_symbols (regexp, space, nfiles, files, &ss);
+  if (files != NULL && ss != NULL)
+    do_cleanups (old_chain);
+  old_chain = make_cleanup (free_search_symbols, ss);
+  
+  Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);
+  
+  for (p = ss; p != NULL; p = p->next)
+    {
+      Tcl_Obj *elem;
+
+      if (static_only && p->block != STATIC_BLOCK)
+        continue;
+
+      elem = Tcl_NewListObj (0, NULL);
+
+      if (p->msymbol == NULL)
+        Tcl_ListObjAppendElement (interp, elem, 
+                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
+      else
+        Tcl_ListObjAppendElement (interp, elem,
+                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
+
+      Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
+    }
+  
+  do_cleanups (old_chain);
+  return TCL_OK;
+}
+
+/* This implements the tcl command gdb_listfuncs
+ *  
+ * It lists all the functions defined in a given file
+ * 
+ * Arguments:
+ *    file - the file to look in
+ * Tcl Result:
+ *    A list of two element lists, the first element is
+ *    the symbol name, and the second is a boolean indicating
+ *    whether the symbol is demangled (1 for yes).
+ */
+
+static int
+gdb_listfuncs (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct symtab *symtab;
+  struct blockvector *bv;
+  struct block *b;
+  struct symbol *sym;
+  char buf[128];
+  int i,j;
+  Tcl_Obj *funcVals[2];
+
+  if (objc != 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
+    }
+  
+  symtab = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
+  if (!symtab)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "No such file", -1);
+      return TCL_ERROR;
+    }
+
+  if (mangled == NULL)
+    {
+      mangled = Tcl_NewBooleanObj(1);
+      not_mangled = Tcl_NewBooleanObj(0);
+      Tcl_IncrRefCount(mangled);
+      Tcl_IncrRefCount(not_mangled);
+    }
+
+  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+  
+  bv = BLOCKVECTOR (symtab);
+  for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
+    {
+      b = BLOCKVECTOR_BLOCK (bv, i);
+      /* Skip the sort if this block is always sorted.  */
+      if (!BLOCK_SHOULD_SORT (b))
+       sort_block_syms (b);
+      for (j = 0; j < BLOCK_NSYMS (b); j++)
+       {
+         sym = BLOCK_SYM (b, j);
+         if (SYMBOL_CLASS (sym) == LOC_BLOCK)
+           {
+             
+             char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
+             if (name)
+               {
+                 funcVals[0] = Tcl_NewStringObj(name, -1);
+                 funcVals[1] = mangled;          
+               }
+             else
+               {
+                 funcVals[0] = Tcl_NewStringObj(SYMBOL_NAME(sym), -1);
+                 funcVals[1] = not_mangled;
+               }
+             Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                                       Tcl_NewListObj (2, funcVals));
+           }
+       }
+    }
+  return TCL_OK;
+}
+
+\f
+/*
+ * This section contains all the commands that act on the registers:
+ */
+
+/* This is a sort of mapcar function for operations on registers */ 
+           
+static int
+map_arg_registers (objc, objv, func, argp)
+     int objc;
+     Tcl_Obj *CONST objv[];
+     void (*func) PARAMS ((int regnum, void *argp));
+     void *argp;
+{
+  int regnum;
+
+  /* Note that the test for a valid register must include checking the
+     reg_names array because NUM_REGS may be allocated for the union of the
+     register sets within a family of related processors.  In this case, the
+     trailing entries of reg_names will change depending upon the particular
+     processor being debugged.  */
+
+  if (objc == 0)               /* No args, just do all the regs */
+    {
+      for (regnum = 0;
+          regnum < NUM_REGS
+          && reg_names[regnum] != NULL
+          && *reg_names[regnum] != '\000';
+          regnum++)
+       func (regnum, argp);
+
+      return TCL_OK;
+    }
+
+  /* Else, list of register #s, just do listed regs */
+  for (; objc > 0; objc--, objv++)
+    {
+
+      if (Tcl_GetIntFromObj (NULL, *objv, &regnum) != TCL_OK) {
+       result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+       return TCL_ERROR;
+      }
+
+      if (regnum >= 0
+         && regnum < NUM_REGS
+         && reg_names[regnum] != NULL
+         && *reg_names[regnum] != '\000')
+       func (regnum, argp);
+      else
+       {
+         Tcl_SetStringObj (result_ptr->obj_ptr, "bad register number", -1);
+         return TCL_ERROR;
+       }
+    }
+
+  return TCL_OK;
+}
+           
+/* This implements the TCL command `gdb_regnames', which returns a list of
+   all of the register names. */
+
+static int
+gdb_regnames (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  objc--;
+  objv++;
+
+  return map_arg_registers (objc, objv, get_register_name, NULL);
+}
+
+static void
+get_register_name (regnum, argp)
+     int regnum;
+     void *argp;               /* Ignored */
+{
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                           Tcl_NewStringObj (reg_names[regnum], -1));
+}
+
+/* This implements the tcl command gdb_fetch_registers
+ * Pass it a list of register names, and it will
+ * return their values as a list.
+ *
+ * Tcl Arguments:
+ *    format: The format string for printing the values
+ *    args: the registers to look for
+ * Tcl Result:
+ *    A list of their values.
+ */
+
+static int
+gdb_fetch_registers (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int format, result;
+
+  if (objc < 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr,
+                       "wrong # args, should be gdb_fetch_registers format ?register1 register2 ...?", -1);
+    }
+  objc -= 2;
+  objv++;
+  format = *(Tcl_GetStringFromObj(objv[0], NULL));  
+  objv++;
+  
+  
+  result_ptr->flags |= GDBTK_MAKES_LIST; /* Output the results as a list */
+  result = map_arg_registers (objc, objv, get_register, (void *) format);
+  result_ptr->flags &= ~GDBTK_MAKES_LIST;
+  
+  return result; 
+}
+
+static void
+get_register (regnum, fp)
+     int regnum;
+     void *fp;
+{
+  char raw_buffer[MAX_REGISTER_RAW_SIZE];
+  char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
+  int format = (int)fp;
+
+  if (format == 'N')
+    format = 0;
+
+  if (read_relative_register_raw_bytes (regnum, raw_buffer))
+    {
+      Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                               Tcl_NewStringObj ("Optimized out", -1));
+      return;
+    }
+
+  /* Convert raw data to virtual format if necessary.  */
+
+  if (REGISTER_CONVERTIBLE (regnum))
+    {
+      REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
+                                  raw_buffer, virtual_buffer);
+    }
+  else
+    memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
+
+  if (format == 'r')
+    {
+      int j;
+      printf_filtered ("0x");
+      for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
+       {
+         register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
+           : REGISTER_RAW_SIZE (regnum) - 1 - j;
+         printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
+       }
+    }
+  else
+    val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
+              gdb_stdout, format, 1, 0, Val_pretty_default);
+
+}
+
+/* This implements the tcl command get_pc_reg
+ * It returns the value of the PC register
+ *
+ * Tcl Arguments:
+ *    None
+ * Tcl Result:
+ *    The value of the pc register.
+ */
+
+static int
+get_pc_register (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  char buff[64];
+  
+  sprintf (buff, "0x%llx",(long long) read_register (PC_REGNUM));
+  Tcl_SetStringObj(result_ptr->obj_ptr, buff, -1);
+  return TCL_OK;
+}
+
+/* This implements the tcl command "gdb_changed_register_list"
+ * It takes a list of registers, and returns a list of
+ * the registers on that list that have changed since the last
+ * time the proc was called.
+ *
+ * Tcl Arguments:
+ *    A list of registers.
+ * Tcl Result:
+ *    A list of changed registers.
+ */
+
+static int
+gdb_changed_register_list (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  objc--;
+  objv++;
+
+  return map_arg_registers (objc, objv, register_changed_p, NULL);
+}
+
+static void
+register_changed_p (regnum, argp)
+     int regnum;
+     void *argp;               /* Ignored */
+{
+  char raw_buffer[MAX_REGISTER_RAW_SIZE];
+
+  if (read_relative_register_raw_bytes (regnum, raw_buffer))
+    return;
+
+  if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
+             REGISTER_RAW_SIZE (regnum)) == 0)
+    return;
+
+  /* Found a changed register.  Save new value and return its number. */
+
+  memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
+         REGISTER_RAW_SIZE (regnum));
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(regnum));
+}
+\f
+/*
+ * This section contains the commands that deal with tracepoints:
+ */
+
+/* return a list of all tracepoint numbers in interpreter */
+static int
+gdb_get_tracepoint_list (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  struct tracepoint *tp;
+
+  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+
+  ALL_TRACEPOINTS (tp)
+    Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->number));
+
+  return TCL_OK;
+}
+
+/* returns -1 if not found, tracepoint # if found */
+int
+tracepoint_exists (char * args)
+{
+  struct tracepoint *tp;
+  char **canonical;
+  struct symtabs_and_lines sals;
+  char  *file = NULL;
+  int    result = -1;
+
+  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
+  if (sals.nelts == 1)
+    {
+      resolve_sal_pc (&sals.sals[0]);
+      file = xmalloc (strlen (sals.sals[0].symtab->dirname)
+                      + strlen (sals.sals[0].symtab->filename) + 1);
+      if (file != NULL)
+        {
+          strcpy (file, sals.sals[0].symtab->dirname);
+          strcat (file, sals.sals[0].symtab->filename);
+
+          ALL_TRACEPOINTS (tp)
+            {
+              if (tp->address == sals.sals[0].pc)
+                result = tp->number;
+#if 0
+              /* Why is this here? This messes up assembly traces */
+              else if (tp->source_file != NULL
+                       && strcmp (tp->source_file, file) == 0
+                       && sals.sals[0].line == tp->line_number)
+                result = tp->number;
+#endif                
+            }
+        }
+    }
+  if (file != NULL)
+    free (file);
+  return result;
+}
+
+static int
+gdb_tracepoint_exists_command (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  char * args;
+
+  if (objc != 2)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " function:line|function|line|*addr\"", NULL);
+      return TCL_ERROR;
+    }
+  
+  args = Tcl_GetStringFromObj (objv[1], NULL);
+  
+  Tcl_SetIntObj (result_ptr->obj_ptr, tracepoint_exists (args));
+  return TCL_OK;
+}
+
+static int
+gdb_get_tracepoint_info (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj  *CONST objv[];
+{
+  struct symtab_and_line sal;
+  int tpnum;
+  struct tracepoint *tp;
+  struct action_line *al;
+  Tcl_Obj *action_list;
+  char *filename, *funcname;
+  char tmp[19];
+  
+  if (objc != 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
+      return TCL_ERROR;
+    }
+  
+  if (Tcl_GetIntFromObj (NULL, objv[1], &tpnum) != TCL_OK)
+    {
+      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  ALL_TRACEPOINTS (tp)
+    if (tp->number == tpnum)
+      break;
+
+  if (tp == NULL)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Tracepoint #%d does not exist", -1);
+      return TCL_ERROR;
+    }
+
+  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+  sal = find_pc_line (tp->address, 0);
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "N/A";
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
+                            Tcl_NewStringObj (filename, -1));
+  find_pc_partial_function (tp->address, &funcname, NULL, NULL);
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (funcname, -1));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (sal.line));
+  sprintf (tmp, "0x%lx", tp->address);
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (tmp, -1));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->enabled));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->pass_count));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->step_count));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->thread));
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->hit_count));
+
+  /* Append a list of actions */
+  action_list = Tcl_NewObj ();
+  for (al = tp->actions; al != NULL; al = al->next)
+    {
+      Tcl_ListObjAppendElement (interp, action_list,
+                                Tcl_NewStringObj (al->action, -1));
+    }
+  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, action_list);
+
+  return TCL_OK;
+}
+
+
+static int
+gdb_trace_status (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int result = 0;
+  if (trace_running_p)
+    result = 1;
+  Tcl_SetIntObj (result_ptr->obj_ptr, result);
+  return TCL_OK;
+}
+
+
+
+static int
+gdb_get_trace_frame_num (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  if (objc != 1)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " linespec\"", NULL);
+      return TCL_ERROR;
+    }
+  Tcl_SetIntObj (result_ptr->obj_ptr, get_traceframe_number ());
+  return TCL_OK;
+  
+}
+/* This implements the tcl command gdb_actions
+ * It sets actions for a given tracepoint.
+ *
+ * Tcl Arguments:
+ *    number: the tracepoint in question
+ *    actions: the actions to add to this tracepoint
+ * Tcl Result:
+ *    None.
+ */
+
+static int
+gdb_actions_command (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  struct tracepoint *tp;
+  Tcl_Obj **actions;
+  int      nactions, i, len;
+  char *number, *args, *action;
+  long step_count;
+  struct action_line *next = NULL, *temp;
+  enum actionline_type linetype;
+
+  if (objc != 3)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # args: should be: \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " number actions\"", NULL);
+      return TCL_ERROR;
+    }
+
+  args = number = Tcl_GetStringFromObj (objv[1], NULL);
+  tp = get_tracepoint_by_number (&args);
+  if (tp == NULL)
+    {
+      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "Tracepoint \"", number, "\" does not exist", NULL);
+      return TCL_ERROR;
+    }
+
+  /* Free any existing actions */
+  if (tp->actions != NULL)
+    free_actions (tp);
+
+  step_count = 0;
+
+  Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
+
+  /* Add the actions to the tracepoint */
+  for (i = 0; i < nactions; i++)
+    {
+      temp = xmalloc (sizeof (struct action_line));
+      temp->next = NULL;
+      action = Tcl_GetStringFromObj (actions[i], &len);
+      temp->action = savestring (action, len);
+
+      linetype = validate_actionline (&(temp->action), tp);
+
+      if (linetype == BADLINE) 
+       {
+         free (temp);
+         continue;
+       }
+
+      if (next == NULL)
+        {
+          tp->actions = temp;
+          next = temp;
+        }
+      else
+        {
+          next->next = temp;
+          next = temp;
+        }
+    }
+  
+  return TCL_OK;
+}
+\f
+/*
+ * This section has commands that handle source disassembly.
+ */
+
+/* This implements the tcl command gdb_disassemble
+ *
+ * Arguments:
+ *    source_with_assm - must be "source" or "nosource"
+ *    low_address - the address from which to start disassembly
+ *    ?hi_address? - the address to which to disassemble, defaults
+ *                   to the end of the function containing low_address.
+ * Tcl Result:
+ *    The disassembled code is passed to fputs_unfiltered, so it
+ *    either goes to the console if result_ptr->obj_ptr is NULL or to
+ *    the Tcl result.
+ */
+
+static int
+gdb_disassemble (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  CORE_ADDR pc, low, high;
+  int mixed_source_and_assembly;
+  static disassemble_info di;
+  static int di_initialized;
+  char *arg_ptr;
+
+  if (objc != 3 && objc != 4)
+    error ("wrong # args");
+
+  if (! di_initialized)
+    {
+      INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
+                                    (fprintf_ftype) fprintf_unfiltered);
+      di.flavour = bfd_target_unknown_flavour;
+      di.memory_error_func = dis_asm_memory_error;
+      di.print_address_func = dis_asm_print_address;
+      di_initialized = 1;
+    }
+
+  di.mach = tm_print_insn_info.mach;
+  if (TARGET_BYTE_ORDER == BIG_ENDIAN)
+    di.endian = BFD_ENDIAN_BIG;
+  else
+    di.endian = BFD_ENDIAN_LITTLE;
+
+  arg_ptr = Tcl_GetStringFromObj (objv[1], NULL);
+  if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
+    mixed_source_and_assembly = 1;
+  else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
+    mixed_source_and_assembly = 0;
+  else
+    error ("First arg must be 'source' or 'nosource'");
+
+  low = parse_and_eval_address (Tcl_GetStringFromObj (objv[2], NULL));
+
+  if (objc == 3)
+    {
+      if (find_pc_partial_function (low, NULL, &low, &high) == 0)
+       error ("No function contains specified address");
+    }
+  else
+    high = parse_and_eval_address (Tcl_GetStringFromObj (objv[3], NULL));
+
+  /* If disassemble_from_exec == -1, then we use the following heuristic to
+     determine whether or not to do disassembly from target memory or from the
+     exec file:
+
+     If we're debugging a local process, read target memory, instead of the
+     exec file.  This makes disassembly of functions in shared libs work
+     correctly.
+
+     Else, we're debugging a remote process, and should disassemble from the
+     exec file for speed.  However, this is no good if the target modifies its
+     code (for relocation, or whatever).
+   */
+
+  if (disassemble_from_exec == -1)
+    if (strcmp (target_shortname, "child") == 0
+       || strcmp (target_shortname, "procfs") == 0
+       || strcmp (target_shortname, "vxprocess") == 0)
+      disassemble_from_exec = 0; /* It's a child process, read inferior mem */
+    else
+      disassemble_from_exec = 1; /* It's remote, read the exec file */
+
+  if (disassemble_from_exec)
+    di.read_memory_func = gdbtk_dis_asm_read_memory;
+  else
+    di.read_memory_func = dis_asm_read_memory;
+
+  /* If just doing straight assembly, all we need to do is disassemble
+     everything between low and high.  If doing mixed source/assembly, we've
+     got a totally different path to follow.  */
+
+  if (mixed_source_and_assembly)
+    {                          /* Come here for mixed source/assembly */
+      /* The idea here is to present a source-O-centric view of a function to
+        the user.  This means that things are presented in source order, with
+        (possibly) out of order assembly immediately following.  */
+      struct symtab *symtab;
+      struct linetable_entry *le;
+      int nlines;
+      int newlines;
+      struct my_line_entry *mle;
+      struct symtab_and_line sal;
+      int i;
+      int out_of_order;
+      int next_line;
+
+      symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
+
+      if (!symtab)
+       goto assembly_only;
+
+/* First, convert the linetable to a bunch of my_line_entry's.  */
+
+      le = symtab->linetable->item;
+      nlines = symtab->linetable->nitems;
+
+      if (nlines <= 0)
+       goto assembly_only;
+
+      mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
+
+      out_of_order = 0;
+
+/* Copy linetable entries for this function into our data structure, creating
+   end_pc's and setting out_of_order as appropriate.  */
+
+/* First, skip all the preceding functions.  */
+
+      for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
+
+/* Now, copy all entries before the end of this function.  */
+
+      newlines = 0;
+      for (; i < nlines - 1 && le[i].pc < high; i++)
+       {
+         if (le[i].line == le[i + 1].line
+             && le[i].pc == le[i + 1].pc)
+           continue;           /* Ignore duplicates */
+
+         mle[newlines].line = le[i].line;
+         if (le[i].line > le[i + 1].line)
+           out_of_order = 1;
+         mle[newlines].start_pc = le[i].pc;
+         mle[newlines].end_pc = le[i + 1].pc;
+         newlines++;
+       }
+
+/* If we're on the last line, and it's part of the function, then we need to
+   get the end pc in a special way.  */
+
+      if (i == nlines - 1
+         && le[i].pc < high)
+       {
+         mle[newlines].line = le[i].line;
+         mle[newlines].start_pc = le[i].pc;
+         sal = find_pc_line (le[i].pc, 0);
+         mle[newlines].end_pc = sal.end;
+         newlines++;
+       }
+
+/* Now, sort mle by line #s (and, then by addresses within lines). */
+
+      if (out_of_order)
+       qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
+
+/* Now, for each line entry, emit the specified lines (unless they have been
+   emitted before), followed by the assembly code for that line.  */
+
+      next_line = 0;           /* Force out first line */
+      for (i = 0; i < newlines; i++)
+       {
+/* Print out everything from next_line to the current line.  */
+
+         if (mle[i].line >= next_line)
+           {
+             if (next_line != 0)
+               print_source_lines (symtab, next_line, mle[i].line + 1, 0);
+             else
+               print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
+
+             next_line = mle[i].line + 1;
+           }
+
+         for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
+           {
+             QUIT;
+             fputs_unfiltered ("    ", gdb_stdout);
+             print_address (pc, gdb_stdout);
+             fputs_unfiltered (":\t    ", gdb_stdout);
+             pc += (*tm_print_insn) (pc, &di);
+             fputs_unfiltered ("\n", gdb_stdout);
+           }
+       }
+    }
+  else
+    {
+assembly_only:
+      for (pc = low; pc < high; )
+       {
+         QUIT;
+         fputs_unfiltered ("    ", gdb_stdout);
+         print_address (pc, gdb_stdout);
+         fputs_unfiltered (":\t    ", gdb_stdout);
+         pc += (*tm_print_insn) (pc, &di);
+         fputs_unfiltered ("\n", gdb_stdout);
+       }
+    }
+
+  gdb_flush (gdb_stdout);
+
+  return TCL_OK;
+}
+
+/* This is the memory_read_func for gdb_disassemble when we are
+   disassembling from the exec file. */
+
+static int
+gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
+     bfd_vma memaddr;
+     bfd_byte *myaddr;
+     int len;
+     disassemble_info *info;
+{
+  extern struct target_ops exec_ops;
+  int res;
+
+  errno = 0;
+  res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
+
+  if (res == len)
+    return 0;
+  else
+    if (errno == 0)
+      return EIO;
+    else
+      return errno;
+}
+
+/* This will be passed to qsort to sort the results of the disassembly */
+
+static int
+compare_lines (mle1p, mle2p)
+     const PTR mle1p;
+     const PTR mle2p;
+{
+  struct my_line_entry *mle1, *mle2;
+  int val;
+
+  mle1 = (struct my_line_entry *) mle1p;
+  mle2 = (struct my_line_entry *) mle2p;
+
+  val =  mle1->line - mle2->line;
+
+  if (val != 0)
+    return val;
+
+  return mle1->start_pc - mle2->start_pc;
+}
+
+/* This implements the TCL command `gdb_loc',
+ *
+ * Arguments:
+ *    ?symbol? The symbol or address to locate - defaults to pc
+ * Tcl Return:
+ *    a list consisting of the following:                                  
+ *       basename, function name, filename, line number, address, current pc
+ */
+
+static int
+gdb_loc (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  char *filename;
+  struct symtab_and_line sal;
+  char *funcname, *fname;
+  CORE_ADDR pc;
+
+  if (!have_full_symbols () && !have_partial_symbols ())
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "No symbol table is loaded", -1);
+      return TCL_ERROR;
+    }
+  
+  if (objc == 1)
+    {
+      if (selected_frame && (selected_frame->pc != stop_pc))
+       {
+         /* Note - this next line is not correct on all architectures. */
+         /* For a graphical debugger we really want to highlight the */
+         /* assembly line that called the next function on the stack. */
+         /* Many architectures have the next instruction saved as the */
+         /* pc on the stack, so what happens is the next instruction is hughlighted. */
+         /* FIXME */
+         pc = selected_frame->pc;
+         sal = find_pc_line (selected_frame->pc,
+                             selected_frame->next != NULL
+                             && !selected_frame->next->signal_handler_caller
+                             && !frame_in_dummy (selected_frame->next));
+       }
+      else
+       {
+         pc = stop_pc;
+         sal = find_pc_line (stop_pc, 0);
+       }
+    }
+  else if (objc == 2)
+    {
+      struct symtabs_and_lines sals;
+      int nelts;
+
+      sals = decode_line_spec (Tcl_GetStringFromObj (objv[1], NULL), 1);
+
+      nelts = sals.nelts;
+      sal = sals.sals[0];
+      free (sals.sals);
+
+      if (sals.nelts != 1)
+       {
+         Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
+         return TCL_ERROR;
+       }
+
+      pc = sal.pc;
+    }
+  else
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
+      return TCL_ERROR;
+    }
+
+  if (sal.symtab)
+    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                             Tcl_NewStringObj (sal.symtab->filename, -1));
+  else
+    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewStringObj ("", 0));
+
+  find_pc_partial_function (pc, &funcname, NULL, NULL);
+  fname = cplus_demangle (funcname, 0);
+  if (fname)
+    {
+      Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                               Tcl_NewStringObj (fname, -1));
+      free (fname);
+    }
+  else
+    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                             Tcl_NewStringObj (funcname, -1));
+  
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "";
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                           Tcl_NewStringObj (filename, -1));
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line)); /* line number */
+  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
+  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
+  return TCL_OK;
+}
+
+/* This implements the Tcl command 'gdb_get_mem', which 
+ * dumps a block of memory 
+ * Arguments:
+ *   gdb_get_mem addr form size num aschar
+ *
+ *   addr: address of data to dump
+ *   form: a char indicating format
+ *   size: size of each element; 1,2,4, or 8 bytes
+ *   num: the number of bytes to read 
+ *   acshar: an optional ascii character to use in ASCII dump
+ * 
+ * Return:
+ * a list of elements followed by an optional ASCII dump 
+ */
+
+static int
+gdb_get_mem (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  int size, asize, i, j, bc;
+  CORE_ADDR addr;
+  int nbytes, rnum, bpr;
+  long tmp;
+  char format, c, *ptr, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
+  struct type *val_type;
+
+  if (objc < 6 || objc > 7)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr,
+                       "addr format size bytes bytes_per_row ?ascii_char?", -1);
+      return TCL_ERROR; 
+    }
+
+  if (Tcl_GetIntFromObj (interp, objv[3], &size) != TCL_OK)
+    {
+      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+  else if (size <= 0)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid size, must be > 0", -1);
+      return TCL_ERROR;
+    }
+  
+  if (Tcl_GetIntFromObj (interp, objv[4], &nbytes) != TCL_OK)
+    {
+      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+  else if (size <= 0)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid number of bytes, must be > 0", 
+                       -1);
+      return TCL_ERROR;
+    }
+  
+  if (Tcl_GetIntFromObj (interp, objv[5], &bpr) != TCL_OK)
+    {
+      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+  else if (size <= 0)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid bytes per row, must be > 0", -1);
+      return TCL_ERROR;
+    }
+  
+  if (Tcl_GetLongFromObj (interp, objv[1], &tmp) != TCL_OK)
+    return TCL_OK;
+
+  addr = (CORE_ADDR) tmp;
+
+  format = *(Tcl_GetStringFromObj (objv[2], NULL));
+  mbuf = (char *)malloc (nbytes+32);
+  if (!mbuf)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Out of memory.", -1);
+      return TCL_ERROR;
+    }
+  
+  memset (mbuf, 0, nbytes+32);
+  mptr = cptr = mbuf;
+
+  rnum = target_read_memory_partial (addr, mbuf, nbytes, NULL);
+
+  if (objc == 7)
+    aschar = *(Tcl_GetStringFromObj(objv[6], NULL)); 
+  else
+    aschar = 0;
+
+  switch (size) {
+  case 1:
+    val_type = builtin_type_char;
+    asize = 'b';
+    break;
+  case 2:
+    val_type = builtin_type_short;
+    asize = 'h';
+    break;
+  case 4:
+    val_type = builtin_type_int;
+    asize = 'w';
+    break;
+  case 8:
+    val_type = builtin_type_long_long;
+    asize = 'g';
+    break;
+  default:
+    val_type = builtin_type_char;
+    asize = 'b';
+  }
+
+  bc = 0;        /* count of bytes in a row */
+  buff[0] = '"'; /* buffer for ascii dump */
+  bptr = &buff[1];   /* pointer for ascii dump */
+  
+  result_ptr->flags |= GDBTK_MAKES_LIST; /* Build up the result as a list... */
+   
+  for (i=0; i < nbytes; i+= size)
+    {
+      if ( i >= rnum)
+       {
+         fputs_unfiltered ("N/A ", gdb_stdout);
+         if (aschar)
+           for ( j = 0; j < size; j++)
+             *bptr++ = 'X';
+       }
+      else
+       {
+         print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
+
+         if (aschar)
+           {
+             for ( j = 0; j < size; j++)
+               {
+                 c = *cptr++;
+                 if (c < 32 || c > 126)
+                   c = aschar;
+                 if (c == '"')
+                   *bptr++ = '\\';
+                 *bptr++ = c;
+               }
+           }
+       }
+
+      mptr += size;
+      bc += size;
+
+      if (aschar && (bc >= bpr))
+       {
+         /* end of row. print it and reset variables */
+         bc = 0;
+         *bptr++ = '"';
+         *bptr++ = ' ';
+         *bptr = 0;
+         fputs_unfiltered (buff, gdb_stdout);
+         bptr = &buff[1];
+       }
+    }
+  
+  result_ptr->flags &= ~GDBTK_MAKES_LIST;
+           
+  free (mbuf);
+  return TCL_OK;
+}
+
+\f
+
+/* This implements the tcl command "gdb_loadfile"
+ * It loads a c source file into a text widget.
+ *
+ * Tcl Arguments:
+ *    widget: the name of the text widget to fill
+ *    filename: the name of the file to load
+ *    linenumbers: A boolean indicating whether or not to display line numbers.
+ * Tcl Result:
+ *
+ */
+
+/* In this routine, we will build up a "line table", i.e. a
+ * table of bits showing which lines in the source file are executible.
+ * LTABLE_SIZE is the number of bytes to allocate for the line table.
+ *
+ * Its size limits the maximum number of lines 
+ * in a file to 8 * LTABLE_SIZE.  This memory is freed after 
+ * the file is loaded, so it is OK to make this very large. 
+ * Additional memory will be allocated if needed. */
+#define LTABLE_SIZE 20000
+static int
+gdb_loadfile (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  char *file, *widget, *buf, msg[128];
+  int linenumbers, ln, anum, lnum, ltable_size;
+  FILE *fp;
+  char *ltable;
+  struct symtab *symtab;
+  struct linetable_entry *le;
+  long mtime = 0;
+  struct stat st;
+  Tcl_DString text_cmd_1, text_cmd_2, *cur_cmd;
+  char line[1024], line_num_buf[16];
+  int prefix_len_1, prefix_len_2, cur_prefix_len, widget_len;
+
+  if (objc != 4)
+    {
+      Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
+      return TCL_ERROR; 
+    }
+
+  widget = Tcl_GetStringFromObj (objv[1], NULL);
+  if ( Tk_NameToWindow (interp, widget, Tk_MainWindow (interp)) == NULL)
+    {
+      return TCL_ERROR;
+    }
+  
+  file  = Tcl_GetStringFromObj (objv[2], NULL);
+  Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
+
+  if ((fp = fopen ( file, "r" )) == NULL)
+    {
+      Tcl_SetStringObj ( result_ptr->obj_ptr, "Can't open file for reading", -1);      
+      return TCL_ERROR;
+    }
+  
+  symtab = full_lookup_symtab (file);
+  if (!symtab)
+    {
+      Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);      
+      fclose (fp);
+      return TCL_ERROR;
+    }
+
+  if (stat (file, &st) < 0)
+    {
+      catch_errors (perror_with_name_wrapper, "gdbtk: get time stamp", "",
+                    RETURN_MASK_ALL);
+      return TCL_ERROR;
+    }
+
+  if (symtab && symtab->objfile && symtab->objfile->obfd)
+      mtime = bfd_get_mtime(symtab->objfile->obfd);
+  else if (exec_bfd)
+      mtime = bfd_get_mtime(exec_bfd);
+  if (mtime && mtime < st.st_mtime)
+     gdbtk_ignorable_warning("Source file is more recent than executable.\n");
+
+
+  /* Source linenumbers don't appear to be in order, and a sort is */
+  /* too slow so the fastest solution is just to allocate a huge */
+  /* array and set the array entry for each linenumber */
+
+  ltable_size = LTABLE_SIZE;
+  ltable = (char *)malloc (LTABLE_SIZE);
+  if (ltable == NULL)
+    {
+      Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
+      fclose (fp);
+      return TCL_ERROR;
+    }
+
+  memset (ltable, 0, LTABLE_SIZE);
+
+  if (symtab->linetable && symtab->linetable->nitems)
+    {
+      le = symtab->linetable->item;
+      for (ln = symtab->linetable->nitems ;ln > 0; ln--, le++)
+       {
+         lnum = le->line >> 3;
+         if (lnum >= ltable_size)
+           {
+             char *new_ltable;
+             new_ltable = (char *)realloc (ltable, ltable_size*2);
+             memset (new_ltable + ltable_size, 0, ltable_size);
+             ltable_size *= 2;
+             if (new_ltable == NULL)
+               {
+                 Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
+                 free (ltable);
+                 fclose (fp);
+                 return TCL_ERROR;
+               }
+             ltable = new_ltable;
+           }
+         ltable[lnum] |= 1 << (le->line % 8);
+       }
+    }
+    
+  Tcl_DStringInit(&text_cmd_1);
+  Tcl_DStringInit(&text_cmd_2);
+  
+  ln = 1;
+
+  widget_len = strlen (widget);
+  line[0] = '\t';
+  
+  Tcl_DStringAppend (&text_cmd_1, widget, widget_len);
+  Tcl_DStringAppend (&text_cmd_2, widget, widget_len);
+  
+  if (linenumbers)
+    {
+      Tcl_DStringAppend (&text_cmd_1, " insert end {-\t", -1);
+      prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
+
+      Tcl_DStringAppend (&text_cmd_2, " insert end { \t", -1);
+      prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
+      
+      while (fgets (line + 1, 980, fp))
+       {
+         sprintf (line_num_buf, "%d", ln);
+         if (ltable[ln >> 3] & (1 << (ln % 8)))
+           {
+             cur_cmd = &text_cmd_1;
+             cur_prefix_len = prefix_len_1;
+             Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
+             Tcl_DStringAppend (cur_cmd, "} break_tag", 11);
+           }
+         else
+           {
+             cur_cmd = &text_cmd_2;
+             cur_prefix_len = prefix_len_2;
+             Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
+             Tcl_DStringAppend (cur_cmd, "} \"\"", 4);
+           }
+
+         Tcl_DStringAppendElement (cur_cmd, line);
+         Tcl_DStringAppend (cur_cmd, " source_tag", 11);
+         
+         Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
+         Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
+         ln++;
+       }
+    }
+  else
+    {
+      Tcl_DStringAppend (&text_cmd_1, " insert end {-\t} break_tag", -1);
+      prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
+      Tcl_DStringAppend (&text_cmd_2, " insert end { \t} \"\"", -1);
+      prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
+
+  
+      while (fgets (line + 1, 980, fp))
+       {
+         if (ltable[ln >> 3] & (1 << (ln % 8)))
+           {
+             cur_cmd = &text_cmd_1;
+             cur_prefix_len = prefix_len_1;
+           }
+         else
+           {
+             cur_cmd = &text_cmd_2;
+             cur_prefix_len = prefix_len_2;
+           }
+
+         Tcl_DStringAppendElement (cur_cmd, line);
+         Tcl_DStringAppend (cur_cmd, " source_tag", 11);
+         
+         Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
+         Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
+         
+         ln++;
+       }
+    }
+
+  Tcl_DStringFree (&text_cmd_1);
+  Tcl_DStringFree (&text_cmd_2);
+  free (ltable);
+  fclose (fp);
+  return TCL_OK;
+}
+\f
+/*
+ *  This section contains commands for manipulation of breakpoints.
+ */
+
+
+/* set a breakpoint by source file and line number */
+/* flags are as follows: */
+/* least significant 2 bits are disposition, rest is */
+/* type (normally 0).
+
+enum bptype {
+  bp_breakpoint,                Normal breakpoint 
+  bp_hardware_breakpoint,      Hardware assisted breakpoint
+}
+
+Disposition of breakpoint.  Ie: what to do after hitting it.
+enum bpdisp {
+  del,                         Delete it
+  del_at_next_stop,            Delete at next stop, whether hit or not
+  disable,                     Disable it 
+  donttouch                    Leave it alone 
+  };
+*/
+
+/* This implements the tcl command "gdb_set_bp"
+ * It sets breakpoints, and runs the Tcl command
+ *     gdbtk_tcl_breakpoint create
+ * to register the new breakpoint with the GUI.
+ *
+ * Tcl Arguments:
+ *    filename: the file in which to set the breakpoint
+ *    line:     the line number for the breakpoint
+ *    type:     the type of the breakpoint
+ * Tcl Result:
+ *    The return value of the call to gdbtk_tcl_breakpoint.
+ */
+
+static int
+gdb_set_bp (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+
+{
+  struct symtab_and_line sal;
+  int line, flags, ret;
+  struct breakpoint *b;
+  char buf[64];
+  Tcl_DString cmd;
+
+  if (objc != 4)
+    {
+      Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
+      return TCL_ERROR; 
+    }
+  
+  sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
+  if (sal.symtab == NULL)
+    return TCL_ERROR;
+
+  if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
+    {
+      result_ptr->flags = GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
+    {
+      result_ptr->flags = GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  sal.line = line;
+  if (!find_line_pc (sal.symtab, sal.line, &sal.pc))
+    return TCL_ERROR;
+
+  sal.section = find_pc_overlay (sal.pc);
+  b = set_raw_breakpoint (sal);
+  set_breakpoint_count (breakpoint_count + 1);
+  b->number = breakpoint_count;
+  b->type = flags >> 2;
+  b->disposition = flags & 3;
+
+  /* FIXME: this won't work for duplicate basenames! */
+  sprintf (buf, "%s:%d", basename (Tcl_GetStringFromObj ( objv[1], NULL)), line);
+  b->addr_string = strsave (buf);
+
+  /* now send notification command back to GUI */
+
+  Tcl_DStringInit (&cmd);
+
+  Tcl_DStringAppend (&cmd, "gdbtk_tcl_breakpoint create ", -1);
+  sprintf (buf, "%d", b->number);
+  Tcl_DStringAppendElement(&cmd, buf);
+  sprintf (buf, "0x%x", sal.pc);
+  Tcl_DStringAppendElement (&cmd, buf);
+  Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[2], NULL));
+  Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[1], NULL));
+
+  ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
+  Tcl_DStringFree (&cmd);
+  return ret;
+}
+
+/* This implements the tcl command gdb_get_breakpoint_info
+ *
+ *
+ * Tcl Arguments:
+ *   breakpoint_number
+ * Tcl Result:
+ *   A list with {file, function, line_number, address, type, enabled?,
+ *                disposition, ignore_count, {list_of_commands}, thread, hit_count}
+ */
+
+static int
+gdb_get_breakpoint_info (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct symtab_and_line sal;
+  static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
+                             "finish", "watchpoint", "hardware watchpoint",
+                             "read watchpoint", "access watchpoint",
+                             "longjmp", "longjmp resume", "step resume",
+                             "through sigtramp", "watchpoint scope",
+                             "call dummy" };
+  static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
+  struct command_line *cmd;
+  int bpnum;
+  struct breakpoint *b;
+  extern struct breakpoint *breakpoint_chain;
+  char *funcname, *fname, *filename;
+  Tcl_Obj *new_obj;
+
+  if (objc != 2)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong number of args, should be \"breakpoint\"", -1);
+      return TCL_ERROR;
+    }
+
+  if ( Tcl_GetIntFromObj(NULL, objv[1], &bpnum) != TCL_OK)
+    {
+      result_ptr->flags = GDBTK_IN_TCL_RESULT;
+      return TCL_ERROR;
+    }
+
+  for (b = breakpoint_chain; b; b = b->next)
+    if (b->number == bpnum)
+      break;
+
+  if (!b || b->type != bp_breakpoint)
+    {
+      Tcl_SetStringObj (result_ptr->obj_ptr, "Breakpoint #%d does not exist", -1);
+      return TCL_ERROR;
+    }
+
+  sal = find_pc_line (b->address, 0);
+
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "";
+
+  Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL);
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+         Tcl_NewStringObj (filename, -1));
+
+  find_pc_partial_function (b->address, &funcname, NULL, NULL);
+  fname = cplus_demangle (funcname, 0);
+  if (fname)
+    {
+      new_obj = Tcl_NewStringObj (fname, -1);
+      free (fname);
+    }
+  else
+    new_obj = Tcl_NewStringObj (funcname, -1);
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
+  
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->line_number));
+  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%lx", b->address);
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                           Tcl_NewStringObj (bptypes[b->type], -1));
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewBooleanObj(b->enable == enabled));
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                           Tcl_NewStringObj (bpdisp[b->disposition], -1));
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->ignore_count));
+
+  new_obj = Tcl_NewObj();
+  for (cmd = b->commands; cmd; cmd = cmd->next)
+    Tcl_ListObjAppendElement (NULL, new_obj,
+                             Tcl_NewStringObj (cmd->line, -1));
+  Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr, new_obj);
+                             
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+                           Tcl_NewStringObj (b->cond_string, -1));
+
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->thread));
+  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->hit_count));
+
+  return TCL_OK;
+}
+
+
+/* This implements the tcl command gdb_get_breakpoint_list
+ * It builds up a list of the current breakpoints.
+ *
+ * Tcl Arguments:
+ *    None.
+ * Tcl Result:
+ *    A list of breakpoint numbers.
+ */
+
+static int
+gdb_get_breakpoint_list (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct breakpoint *b;
+  extern struct breakpoint *breakpoint_chain;
+  Tcl_Obj *new_obj;
+
+  if (objc != 1)
+    error ("wrong number of args, none are allowed");
+
+  for (b = breakpoint_chain; b; b = b->next)
+    if (b->type == bp_breakpoint)
+      {
+        new_obj = Tcl_NewIntObj (b->number);
+        Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
+      }
+
+  return TCL_OK;
+}
+
+\f
+/*
+ * This section contains a bunch of miscellaneous utility commands
+ */
+
+/* This implements the tcl command gdb_path_conv
+ *
+ * On Windows, it canonicalizes the pathname,
+ * On Unix, it is a no op.
+ *
+ * Arguments:
+ *    path
+ * Tcl Result:
+ *    The canonicalized path.
+ */
+
+static int
+gdb_path_conv (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  if (objc != 2)
+    error ("wrong # args");
+  
+#ifdef WINNT
+  {
+    char pathname[256], *ptr;
+
+    cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj(objv[1], NULL), pathname);
+    for (ptr = pathname; *ptr; ptr++)
+      {
+       if (*ptr == '\\')
+         *ptr = '/';
+      }
+    Tcl_SetStringObj (result_ptr->obj_ptr, pathname, -1);
+  }
+#else
+  Tcl_SetStringObj (result_ptr->obj_ptr, Tcl_GetStringFromObj (objv[1], NULL), -1);
+#endif
+
+  return TCL_OK;
+}
+\f
+/*
+ * This section has utility routines that are not Tcl commands.
+ */
+
+static int
+perror_with_name_wrapper (args)
+  char * args;
+{
+  perror_with_name (args);
+  return 1;
+}
+
+/* The lookup_symtab() in symtab.c doesn't work correctly */
+/* It will not work will full pathnames and if multiple */
+/* source files have the same basename, it will return */
+/* the first one instead of the correct one.  This version */
+/* also always makes sure symtab->fullname is set. */
+
+static struct symtab *
+full_lookup_symtab(file)
+     char *file;
+{
+  struct symtab *st;
+  struct objfile *objfile;
+  char *bfile, *fullname;
+  struct partial_symtab *pt;
+
+  if (!file)
+    return NULL;
+
+  /* first try a direct lookup */
+  st = lookup_symtab (file);
+  if (st)
+    {
+      if (!st->fullname)
+         symtab_to_filename(st);
+      return st;
+    }
+  
+  /* if the direct approach failed, try */
+  /* looking up the basename and checking */
+  /* all matches with the fullname */
+  bfile = basename (file);
+  ALL_SYMTABS (objfile, st)
+    {
+      if (!strcmp (bfile, basename(st->filename)))
+       {
+         if (!st->fullname)
+           fullname = symtab_to_filename (st);
+         else
+           fullname = st->fullname;
+
+         if (!strcmp (file, fullname))
+           return st;
+       }
+    }
+  
+  /* still no luck?  look at psymtabs */
+  ALL_PSYMTABS (objfile, pt)
+    {
+      if (!strcmp (bfile, basename(pt->filename)))
+       {
+         st = PSYMTAB_TO_SYMTAB (pt);
+         if (st)
+           {
+             fullname = symtab_to_filename (st);
+             if (!strcmp (file, fullname))
+               return st;
+           }
+       }
+    }
+  return NULL;
+}
diff --git a/gdb/gdbtk-hooks.c b/gdb/gdbtk-hooks.c
new file mode 100644 (file)
index 0000000..b76f2ff
--- /dev/null
@@ -0,0 +1,689 @@
+/* Startup code for gdbtk.
+   Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
+
+   Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
+
+This file is part of GDB.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
+
+#include "defs.h"
+#include "symtab.h"
+#include "inferior.h"
+#include "command.h"
+#include "bfd.h"
+#include "symfile.h"
+#include "objfiles.h"
+#include "target.h"
+#include "gdbcore.h"
+#include "tracepoint.h"
+#include "demangle.h"
+
+#ifdef _WIN32
+#include <winuser.h>
+#endif
+
+#include <sys/stat.h>
+
+#include <tcl.h>
+#include <tk.h>
+#include <itcl.h> 
+#include <tix.h> 
+#include "guitcl.h"
+#include "gdbtk.h"
+
+#ifdef IDE
+/* start-sanitize-ide */
+#include "event.h"
+#include "idetcl.h"
+#include "ilutk.h"
+/* end-sanitize-ide */
+#endif
+
+#ifdef ANSI_PROTOTYPES
+#include <stdarg.h>
+#else
+#include <varargs.h>
+#endif
+#include <signal.h>
+#include <fcntl.h>
+#include <unistd.h>
+#include <setjmp.h>
+#include "top.h"
+#include <sys/ioctl.h>
+#include "gdb_string.h"
+#include "dis-asm.h"
+#include <stdio.h>
+#include "gdbcmd.h"
+
+#include "annotate.h"
+#include <sys/time.h>
+
+int in_fputs = 0;
+
+int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
+void (*pre_add_symbol_hook) PARAMS ((char *));
+void (*post_add_symbol_hook) PARAMS ((void));
+
+#ifdef __CYGWIN32__
+extern void (*ui_loop_hook) PARAMS ((int));
+#endif
+static void   gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
+static void   gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
+static void   gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
+static void   gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
+static void   gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
+static void   gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
+static void   tk_command_loop PARAMS ((void));
+static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
+static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
+       void   x_event PARAMS ((int));
+static int    gdbtk_query PARAMS ((const char *, va_list));
+static void   gdbtk_warning PARAMS ((const char *, va_list));
+void   gdbtk_ignorable_warning PARAMS ((const char *));
+static char*  gdbtk_readline PARAMS ((char *));
+static void
+#ifdef ANSI_PROTOTYPES
+gdbtk_readline_begin (char *format, ...);
+#else
+gdbtk_readline_begin ();
+#endif
+static void gdbtk_readline_end PARAMS ((void));
+static void   gdbtk_flush PARAMS ((FILE *));
+static void gdbtk_pre_add_symbol PARAMS ((char *));
+static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
+static void gdbtk_post_add_symbol PARAMS ((void));
+static void pc_changed PARAMS ((void));
+static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
+
+/*
+ * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
+ * See note there for details.
+ */
+
+void   gdbtk_fputs PARAMS ((const char *, FILE *));
+int           gdbtk_load_hash PARAMS ((char *, unsigned long));
+static void   breakpoint_notify PARAMS ((struct breakpoint *, const char *));
+
+/*
+ * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
+ * startup code to fill in the hooks needed by core gdb.
+ */
+
+void
+gdbtk_add_hooks(void)
+{
+  command_loop_hook = tk_command_loop;
+  call_command_hook = gdbtk_call_command;
+  readline_begin_hook = gdbtk_readline_begin;
+  readline_hook = gdbtk_readline;
+  readline_end_hook = gdbtk_readline_end;
+
+  print_frame_info_listing_hook = gdbtk_print_frame_info;
+  query_hook = gdbtk_query;
+  warning_hook = gdbtk_warning;
+  flush_hook = gdbtk_flush;
+
+  create_breakpoint_hook = gdbtk_create_breakpoint;
+  delete_breakpoint_hook = gdbtk_delete_breakpoint;
+  modify_breakpoint_hook = gdbtk_modify_breakpoint;
+
+  interactive_hook = gdbtk_interactive;
+  target_wait_hook = gdbtk_wait;
+  ui_load_progress_hook = gdbtk_load_hash;
+#ifdef __CYGWIN32__
+  ui_loop_hook = x_event;
+#endif
+  pre_add_symbol_hook   = gdbtk_pre_add_symbol;
+  post_add_symbol_hook  = gdbtk_post_add_symbol;
+
+  create_tracepoint_hook = gdbtk_create_tracepoint;
+  delete_tracepoint_hook = gdbtk_delete_tracepoint;
+  modify_tracepoint_hook = gdbtk_modify_tracepoint;
+  pc_changed_hook = pc_changed;
+
+}
+
+/* These control where to put the gdb output which is created by
+   {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
+   lowest level of these routines and capture all output from the rest of GDB.
+
+   The reason to use the result_ptr rather than the gdbtk_interp's result
+   directly is so that a call_wrapper invoked function can preserve its result
+   across calls into Tcl which might be made in the course of the function's
+   execution.
+   
+   * result_ptr->obj_ptr is where to accumulate the result.
+   * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
+     instead of to the result_ptr.
+   * GDBTK_MAKES_LIST flag means add to the result as a list element.
+
+   */
+
+gdbtk_result *result_ptr = NULL;
+\f
+
+/* This allows you to Tcl_Eval a tcl command which takes
+   a command word, and then a single argument. */
+  
+int gdbtk_two_elem_cmd (cmd_name, argv1)
+    char *cmd_name;
+    char * argv1;
+{
+  char *command;
+  int result, flags_ptr, arg_len, cmd_len;
+
+  arg_len = Tcl_ScanElement (argv1, &flags_ptr);
+  cmd_len = strlen (cmd_name);
+  command = malloc(arg_len + cmd_len + 2);
+  strcpy (command, cmd_name);
+  strcat (command, " ");
+  
+  Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
+
+  result = Tcl_Eval (gdbtk_interp, command);
+  free (command);
+  return result;
+  
+}
+
+static void
+gdbtk_flush (stream)
+     FILE *stream;
+{
+#if 0
+  /* Force immediate screen update */
+
+  Tcl_VarEval (gdbtk_interp, "gdbtk_tcl_flush", NULL);
+#endif
+}
+
+/* This handles all the output from gdb.  All the gdb printf_xxx functions
+ * eventually end up here.  The output is either passed to the result_ptr
+ * where it will go to the result of some gdbtk command, or passed to the
+ * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
+ * window.
+ *
+ * The cases are:
+ *
+ * 1) result_ptr == NULL - This happens when some output comes from gdb which
+ *    is not generated by a command in gdbtk-cmds, usually startup stuff.
+ *    In this case we just route the data to gdbtk_tcl_fputs.
+ * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
+ *    We place the data into the result_ptr, either as a string,
+ *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
+ * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
+ *    UNLESS it was coming to stderr.  Then we place it in the result_ptr
+ *    anyway, so it can be dealt with.
+ *
+ */
+
+void
+gdbtk_fputs (ptr, stream)
+     const char *ptr;
+     FILE *stream;
+{
+  in_fputs = 1;
+
+  if (result_ptr != NULL)
+    {
+      if (result_ptr->flags & GDBTK_TO_RESULT)
+       {
+         if (result_ptr->flags & GDBTK_MAKES_LIST)
+           Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr, 
+                                    Tcl_NewStringObj((char *) ptr, -1));
+         else                           
+           Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
+       }
+      else if (stream == gdb_stderr)
+       {
+         if (result_ptr->flags & GDBTK_ERROR_STARTED)
+           Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
+         else
+           {
+             Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
+             result_ptr->flags |= GDBTK_ERROR_STARTED;
+           }
+       }
+      else
+       {
+         gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
+         if (result_ptr->flags & GDBTK_MAKES_LIST)
+             gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
+       }
+    }
+  else
+    {
+      gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
+    }
+  
+  in_fputs = 0;
+}
+
+/*
+ * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
+ */
+
+static void
+gdbtk_warning (warning, args)
+     const char *warning;
+     va_list args;
+{
+  char buf[200];
+
+  vsprintf (buf, warning, args);
+  gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
+
+}
+
+/*
+ * This routes all ignorable warnings to the Tcl function
+ * "gdbtk_tcl_ignorable_warning".
+ */
+
+void
+gdbtk_ignorable_warning (warning)
+     const char *warning;
+{
+  char buf[200], *merge[2];
+  char *command;
+
+  sprintf (buf, warning);
+  gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf);
+
+}
+
+
+
+static void
+pc_changed()
+{
+  Tcl_Eval (gdbtk_interp, "gdbtk_pc_changed");
+}
+
+\f
+/* This function is called instead of gdb's internal command loop.  This is the
+   last chance to do anything before entering the main Tk event loop. 
+   At the end of the command, we enter the main loop. */
+
+static void
+tk_command_loop ()
+{
+  extern GDB_FILE *instream;
+
+  /* We no longer want to use stdin as the command input stream */
+  instream = NULL;
+
+  if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
+    {
+      char *msg;
+
+      /* Force errorInfo to be set up propertly.  */
+      Tcl_AddErrorInfo (gdbtk_interp, "");
+
+      msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
+#ifdef _WIN32
+      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
+#else
+      fputs_unfiltered (msg, gdb_stderr);
+#endif
+    }
+
+#ifdef _WIN32
+  close_bfds ();
+#endif
+
+  Tk_MainLoop ();
+}
+
+/* Come here when there is activity on the X file descriptor. */
+
+void
+x_event (signo)
+     int signo;
+{
+  static int in_x_event = 0;
+  static Tcl_Obj *varname = NULL;
+  if (in_x_event || in_fputs)
+    return; 
+
+  in_x_event = 1;
+
+#ifdef __CYGWIN32__
+  if (signo == -2)
+    gdbtk_stop_timer ();
+#endif
+
+  /* Process pending events */
+  while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
+    ;
+
+  if (load_in_progress)
+    {
+      int val;
+      if (varname == NULL)
+       {
+         Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
+         varname = Tcl_ObjGetVar2(gdbtk_interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
+       }
+      if ((Tcl_GetIntFromObj(gdbtk_interp,varname,&val) == TCL_OK) && val)
+       {
+         quit_flag = 1;
+#ifdef REQUEST_QUIT
+         REQUEST_QUIT;
+#else
+         if (immediate_quit) 
+           quit ();
+#endif
+       }
+    }
+  in_x_event = 0;
+}
+
+/* VARARGS */
+static void
+#ifdef ANSI_PROTOTYPES
+gdbtk_readline_begin (char *format, ...)
+#else
+gdbtk_readline_begin (va_alist)
+     va_dcl
+#endif
+{
+  va_list args;
+  char buf[200], *merge[2];
+  char *command;
+
+#ifdef ANSI_PROTOTYPES
+  va_start (args, format);
+#else
+  char *format;
+  va_start (args);
+  format = va_arg (args, char *);
+#endif
+
+  vsprintf (buf, format, args);
+  gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
+
+}
+
+static char *
+gdbtk_readline (prompt)
+     char *prompt;
+{
+  int result;
+
+#ifdef _WIN32
+  close_bfds ();
+#endif
+
+  result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
+
+  if (result == TCL_OK)
+    {
+      return (strdup (gdbtk_interp -> result));
+    }
+  else
+    {
+      gdbtk_fputs (gdbtk_interp -> result, gdb_stdout);
+      gdbtk_fputs ("\n", gdb_stdout);
+      return (NULL);
+    }
+}
+
+static void
+gdbtk_readline_end ()
+{
+  Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end");
+}
+
+static void
+gdbtk_call_command (cmdblk, arg, from_tty)
+     struct cmd_list_element *cmdblk;
+     char *arg;
+     int from_tty;
+{
+  running_now = 0;
+  if (cmdblk->class == class_run || cmdblk->class == class_trace)
+    {
+
+/* HACK! HACK! This is to get the gui to update the tstart/tstop
+   button only incase of tstart/tstop commands issued from the console
+   We don't want to update the src window, so we need to have specific
+   procedures to do tstart and tstop
+   Unfortunately this will not display errors from tstart or tstop in the 
+   console window itself, but as dialogs.*/
+
+      if (!strcmp(cmdblk->name, "tstart") && !No_Update)
+        {
+              Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstart"); 
+              (*cmdblk->function.cfunc)(arg, from_tty);
+        }
+      else if (!strcmp(cmdblk->name, "tstop") && !No_Update) 
+             {
+              Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstop"); 
+              (*cmdblk->function.cfunc)(arg, from_tty);
+             }
+/* end of hack */
+           else 
+             {
+                 running_now = 1;
+                 if (!No_Update)
+                   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
+                 (*cmdblk->function.cfunc)(arg, from_tty);
+                 running_now = 0;
+                 if (!No_Update)
+                   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
+             }
+    }
+  else
+    (*cmdblk->function.cfunc)(arg, from_tty);
+}
+
+/* The next three functions use breakpoint_notify to allow the GUI 
+ * to handle creating, deleting and modifying breakpoints.  These three
+ * functions are put into the appropriate gdb hooks in gdbtk_init.
+ */
+
+static void
+gdbtk_create_breakpoint(b)
+     struct breakpoint *b;
+{
+  breakpoint_notify (b, "create");
+}
+
+static void
+gdbtk_delete_breakpoint(b)
+     struct breakpoint *b;
+{
+  breakpoint_notify (b, "delete");
+}
+
+static void
+gdbtk_modify_breakpoint(b)
+     struct breakpoint *b;
+{
+  breakpoint_notify (b, "modify");
+}
+
+/* This is the generic function for handling changes in
+ * a breakpoint.  It routes the information to the Tcl
+ * command "gdbtk_tcl_breakpoint" in the form:
+ *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
+ * On error, the error string is written to gdb_stdout.
+ */
+
+static void
+breakpoint_notify(b, action)
+     struct breakpoint *b;
+     const char *action;
+{
+  char buf[256];
+  int v;
+  struct symtab_and_line sal;
+  char *filename;
+
+  if (b->type != bp_breakpoint)
+    return;
+
+  /* We ensure that ACTION contains no special Tcl characters, so we
+     can do this.  */
+  sal = find_pc_line (b->address, 0);
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "";
+
+  sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number, 
+          (long)b->address, b->line_number, filename);
+
+  v = Tcl_Eval (gdbtk_interp, buf);
+
+  if (v != TCL_OK)
+    {
+      gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp), gdb_stdout);
+      gdbtk_fputs ("\n", gdb_stdout);
+    }
+}
+
+int
+gdbtk_load_hash (section, num)
+     char *section;
+     unsigned long num;
+{
+  char buf[128];
+  sprintf (buf, "download_hash %s %ld", section, num);
+  Tcl_Eval (gdbtk_interp, buf); 
+  return  atoi (gdbtk_interp->result);
+}
+
+
+/* This hook is called whenever we are ready to load a symbol file so that
+   the UI can notify the user... */
+static void
+gdbtk_pre_add_symbol (name)
+  char *name;
+{
+
+  gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name);
+
+}
+
+/* This hook is called whenever we finish loading a symbol file. */
+static void
+gdbtk_post_add_symbol ()
+{
+  Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol");
+}
+
+/* This hook function is called whenever we want to wait for the
+   target.  */
+
+static int
+gdbtk_wait (pid, ourstatus)
+     int pid;
+     struct target_waitstatus *ourstatus;
+{
+  gdbtk_start_timer ();
+  pid = target_wait (pid, ourstatus);
+  gdbtk_stop_timer ();
+  return pid;
+}
+
+/*
+ * This handles all queries from gdb.
+ * The first argument is a printf style format statement, the rest are its
+ * arguments.  The resultant formatted string is passed to the Tcl function
+ * "gdbtk_tcl_query".  
+ * It returns the users response to the query, as well as putting the value
+ * in the result field of the Tcl interpreter.
+ */
+
+static int
+gdbtk_query (query, args)
+     const char *query;
+     va_list args;
+{
+  char buf[200];
+  long val;
+
+  vsprintf (buf, query, args);
+  gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
+  val = atol (gdbtk_interp->result);
+  return val;
+}
+
+
+static void
+gdbtk_print_frame_info (s, line, stopline, noerror)
+  struct symtab *s;
+  int line;
+  int stopline;
+  int noerror;
+{
+  current_source_symtab = s;
+  current_source_line = line;
+}
+
+static void
+gdbtk_create_tracepoint (tp)
+  struct tracepoint *tp;
+{
+  tracepoint_notify (tp, "create");
+}
+
+static void
+gdbtk_delete_tracepoint (tp)
+  struct tracepoint *tp;
+{
+  tracepoint_notify (tp, "delete");
+}
+
+static void
+gdbtk_modify_tracepoint (tp)
+  struct tracepoint *tp;
+{
+  tracepoint_notify (tp, "modify");
+}
+
+static void
+tracepoint_notify(tp, action)
+     struct tracepoint *tp;
+     const char *action;
+{
+  char buf[256];
+  int v;
+  struct symtab_and_line sal;
+  char *filename;
+
+  /* We ensure that ACTION contains no special Tcl characters, so we
+     can do this.  */
+  sal = find_pc_line (tp->address, 0);
+
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "N/A";
+  sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number, 
+          (long)tp->address, sal.line, filename, tp->pass_count);
+
+  v = Tcl_Eval (gdbtk_interp, buf);
+
+  if (v != TCL_OK)
+    {
+      gdbtk_fputs (gdbtk_interp->result, gdb_stdout);
+      gdbtk_fputs ("\n", gdb_stdout);
+    }
+}
+
+
index 0b5e59ff4045f4b5ce43e211ac710ad312992796..a98be7a28fab4ab283c4cda4fbb84302898d0362 100644 (file)
@@ -68,7 +68,7 @@ extern int disassemble_from_exec;
 extern int running_now;
 
 /* These two control how the GUI behaves when tracing or loading
-   They are defined in gdbtk_cmds.c */
+   They are defined in gdbtk-cmds.c */
   
 extern int No_Update;
 extern int load_in_progress;
diff --git a/gdb/gdbtk_cmds.c b/gdb/gdbtk_cmds.c
deleted file mode 100644 (file)
index 221e3e6..0000000
+++ /dev/null
@@ -1,3075 +0,0 @@
-/* Tcl/Tk command definitions for gdbtk.
-   Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
-
-   Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
-
-This file is part of GDB.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
-
-#include "defs.h"
-#include "symtab.h"
-#include "inferior.h"
-#include "command.h"
-#include "bfd.h"
-#include "symfile.h"
-#include "objfiles.h"
-#include "target.h"
-#include "gdbcore.h"
-#include "tracepoint.h"
-#include "demangle.h"
-
-#ifdef _WIN32
-#include <winuser.h>
-#endif
-
-#include <sys/stat.h>
-
-#include <tcl.h>
-#include <tk.h>
-#include <itcl.h> 
-#include <tix.h> 
-#include "guitcl.h"
-#include "gdbtk.h"
-
-#ifdef IDE
-/* start-sanitize-ide */
-#include "event.h"
-#include "idetcl.h"
-#include "ilutk.h"
-/* end-sanitize-ide */
-#endif
-
-#ifdef ANSI_PROTOTYPES
-#include <stdarg.h>
-#else
-#include <varargs.h>
-#endif
-#include <signal.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <setjmp.h>
-#include "top.h"
-#include <sys/ioctl.h>
-#include "gdb_string.h"
-#include "dis-asm.h"
-#include <stdio.h>
-#include "gdbcmd.h"
-
-#include "annotate.h"
-#include <sys/time.h>
-
-/* This structure filled in call_wrapper and passed to
-   the wrapped call function.
-   It stores the command pointer and arguments 
-   run in the wrapper function. */
-
-struct wrapped_call_args
-{
-  Tcl_Interp *interp;
-  Tcl_ObjCmdProc *func;
-  int objc;
-  Tcl_Obj *CONST *objv;
-  int val;
-};
-
-/* These two objects hold boolean true and false,
-   and are shared by all the list objects that gdb_listfuncs
-   returns. */
-   
-static Tcl_Obj *mangled, *not_mangled;
-
-/* These two control how the GUI behaves when gdb is either tracing or loading.
-   They are used in this file & gdbtk_hooks.c */
-
-int No_Update = 0;
-int load_in_progress = 0;
-
-/*
- * This is used in the register fetching routines
- */
-
-#ifndef REGISTER_CONVERTIBLE
-#define REGISTER_CONVERTIBLE(x) (0 != 0)
-#endif
-
-#ifndef REGISTER_CONVERT_TO_VIRTUAL
-#define REGISTER_CONVERT_TO_VIRTUAL(x, y, z, a)
-#endif
-
-#ifndef INVALID_FLOAT
-#define INVALID_FLOAT(x, y) (0 != 0)
-#endif
-
-
-
-/* This Structure is used in gdb_disassemble.
-   We need a different sort of line table from the normal one cuz we can't
-   depend upon implicit line-end pc's for lines to do the
-   reordering in this function.  */
-
-struct my_line_entry {
-  int line;
-  CORE_ADDR start_pc;
-  CORE_ADDR end_pc;
-};
-
-/* This contains the previous values of the registers, since the last call to
-   gdb_changed_register_list.  */
-
-static char old_regs[REGISTER_BYTES];
-
-/*
- * These are routines we need from breakpoint.c.
- * at some point make these static in breakpoint.c and move GUI code there
- */
-
-extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
-extern void set_breakpoint_count (int);
-extern int breakpoint_count;
-
-
-/*
- * Declarations for routines used only in this file.
- */
-
-int Gdbtk_Init (Tcl_Interp *interp);
-static int compare_lines PARAMS ((const PTR, const PTR));
-static int comp_files PARAMS ((const void *, const void *));
-static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                       Tcl_Obj *CONST objv[]));
-static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_clear_file PARAMS ((ClientData, Tcl_Interp *interp, int, Tcl_Obj *CONST []));
-static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_confirm_quit PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_disassemble PARAMS ((ClientData, Tcl_Interp *, int, 
-                                   Tcl_Obj *CONST []));
-static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                         Tcl_Obj *CONST objv[]));
-static int gdb_force_quit PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static struct symtab *full_lookup_symtab PARAMS ((char *file));
-static int gdb_get_args_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                        Tcl_Obj *CONST objv[]));
-static int gdb_get_breakpoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_get_file_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                        Tcl_Obj *CONST objv[]));
-static int gdb_get_function_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                            Tcl_Obj *CONST objv[]));
-static int gdb_get_line_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                        Tcl_Obj *CONST objv[]));
-static int gdb_get_locals_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                        Tcl_Obj *CONST objv[]));
-static int gdb_get_mem PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_get_trace_frame_num PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
-static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int,
-                                           Tcl_Obj *CONST objv[]));
-static int gdb_get_vars_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                        Tcl_Obj *CONST objv[]));
-static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_loadfile PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
-static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
-static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int,
-                                      Tcl_Obj *CONST objv[]));
-static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_search PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
-                              objv[]));
-static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
-static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *,
-                                                    int,
-                                                    Tcl_Obj *CONST []));
-static int gdb_trace_status PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-static int gdb_tracepoint_exists_command PARAMS ((ClientData, Tcl_Interp *,
-                                                 int,
-                                                 Tcl_Obj *CONST objv[]));
-static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int,
-                                           Tcl_Obj *CONST objv[]));
-static void gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
-static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
-static void gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
-static void gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
-static void gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
-static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
-static void gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
-static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
-static void gdbtk_readline_end PARAMS ((void));
-static int get_pc_register PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
-char * get_prompt PARAMS ((void));
-static void get_register PARAMS ((int, void *));
-static void get_register_name PARAMS ((int, void *));
-static int map_arg_registers PARAMS ((int, Tcl_Obj *CONST [], void (*) (int, void *), void *));
-static void pc_changed PARAMS ((void));
-static int perror_with_name_wrapper PARAMS ((char *args));
-static void register_changed_p PARAMS ((int, void *));
-void TclDebug PARAMS ((const char *fmt, ...));
-static int wrapped_call (char *opaque_args);
-\f
-/* Gdbtk_Init
- *    This loads all the Tcl commands into the Tcl interpreter.
- *
- * Arguments:
- *    interp - The interpreter into which to load the commands.
- *
- * Result:
- *     A standard Tcl result.
- */
-
-int
-Gdbtk_Init (interp)
-     Tcl_Interp *interp;
-{
-  Tcl_CreateObjCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_immediate", call_wrapper,
-                       gdb_immediate_command, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
-                       NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
-                       NULL);
-  Tcl_CreateObjCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_fetch_registers", call_wrapper,
-                       gdb_fetch_registers, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_changed_register_list", call_wrapper,
-                       gdb_changed_register_list, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_disassemble", call_wrapper,
-                       gdb_disassemble, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
-                       gdb_get_breakpoint_list, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
-                       gdb_get_breakpoint_info, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_clear_file", call_wrapper,
-                       gdb_clear_file, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_confirm_quit", call_wrapper,
-                       gdb_confirm_quit, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_force_quit", call_wrapper,
-                       gdb_force_quit, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_target_has_execution",
-                       call_wrapper,
-                       gdb_target_has_execution_command, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_is_tracing",
-                       call_wrapper, gdb_trace_status,
-                       NULL);
-  Tcl_CreateObjCommand (interp, "gdb_load_info", call_wrapper, gdb_load_info, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_locals", call_wrapper, gdb_get_locals_command, 
-                       NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_args", call_wrapper, gdb_get_args_command,
-                         NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_function", call_wrapper, gdb_get_function_command,
-                         NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_line", call_wrapper, gdb_get_line_command,
-                         NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_file", call_wrapper, gdb_get_file_command,
-                         NULL);
-  Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
-                        call_wrapper, gdb_tracepoint_exists_command,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
-                        call_wrapper, gdb_get_tracepoint_info,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_actions",
-                        call_wrapper, gdb_actions_command,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_prompt",
-                        call_wrapper, gdb_prompt_command,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_find_file",
-                        call_wrapper, gdb_find_file_command,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
-                        call_wrapper, gdb_get_tracepoint_list,  NULL);  
-  Tcl_CreateObjCommand (interp, "gdb_pc_reg", call_wrapper, get_pc_register, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_loadfile", call_wrapper, gdb_loadfile,  NULL);
-  Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper,
-                       gdb_search,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_set_bp", call_wrapper, gdb_set_bp,  NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_trace_frame_num",
-                        call_wrapper, gdb_get_trace_frame_num,  NULL);  
-
-  Tcl_PkgProvide(interp, "Gdbtk", GDBTK_VERSION);
-  return TCL_OK;
-}
-
-/* This routine acts as a top-level for all GDB code called by Tcl/Tk.  It
-   handles cleanups, and uses catch_errors to trap calls to return_to_top_level
-   (usually via error).
-   This is necessary in order to prevent a longjmp out of the bowels of Tk,
-   possibly leaving things in a bad state.  Since this routine can be called
-   recursively, it needs to save and restore the contents of the result_ptr as
-   necessary. */
-
-static int
-call_wrapper (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct wrapped_call_args wrapped_args;
-  gdbtk_result new_result, *old_result_ptr;
-  int length;
-  
-  old_result_ptr = result_ptr;
-  result_ptr = &new_result;
-  result_ptr->obj_ptr = Tcl_NewObj();
-  result_ptr->flags = GDBTK_TO_RESULT;
-
-  wrapped_args.func = (Tcl_ObjCmdProc *) clientData;
-  wrapped_args.interp = interp;
-  wrapped_args.objc = objc;
-  wrapped_args.objv = objv;
-  wrapped_args.val = TCL_OK;
-
-  if (!catch_errors (wrapped_call, &wrapped_args, "", RETURN_MASK_ALL))
-    {
-      
-      wrapped_args.val = TCL_ERROR;    /* Flag an error for TCL */
-
-      /* Make sure the timer interrupts are turned off.  */
-
-      gdbtk_stop_timer ();
-
-      gdb_flush (gdb_stderr);  /* Flush error output */
-      gdb_flush (gdb_stdout);  /* Sometimes error output comes here as well */
-
-      /* If we errored out here, and the results were going to the
-        console, then gdbtk_fputs will have gathered the result into the
-        result_ptr.  We also need to echo them out to the console here */
-
-      gdb_flush (gdb_stderr);  /* Flush error output */
-      gdb_flush (gdb_stdout);  /* Sometimes error output comes here as well */
-
-      /* In case of an error, we may need to force the GUI into idle
-        mode because gdbtk_call_command may have bombed out while in
-        the command routine.  */
-
-      running_now = 0;
-      Tcl_Eval (interp, "gdbtk_tcl_idle");
-      
-    }
-  
-  /* do not suppress any errors -- a remote target could have errored */
-  load_in_progress = 0;
-
-  /*
-   * Now copy the result over to the true Tcl result.  If GDBTK_TO_RESULT flag
-   * bit is set , this just copies a null object over to the Tcl result, which is
-   * fine because we should reset the result in this case anyway.
-   */
-  if (result_ptr->flags & GDBTK_IN_TCL_RESULT)
-    {
-      Tcl_DecrRefCount(result_ptr->obj_ptr);
-    }
-  else
-    {
-      Tcl_SetObjResult (interp, result_ptr->obj_ptr);
-    }
-
-  result_ptr = old_result_ptr;
-
-#ifdef _WIN32
-  close_bfds ();
-#endif
-
-  return wrapped_args.val;
-}
-
-/*
- * This is the wrapper that is passed to catch_errors.
- */
-
-static int
-wrapped_call (opaque_args)
-     char *opaque_args;
-{
-  struct wrapped_call_args *args = (struct wrapped_call_args *) opaque_args;
-  args->val = (*args->func) (args->func, args->interp, args->objc, args->objv);
-  return 1;
-}
-
-/* This is a convenience function to sprintf something(s) into a
- * new element in a Tcl list object.
- */
-
-static void
-#ifdef ANSI_PROTOTYPES
-sprintf_append_element_to_obj (Tcl_Obj *objp, char *format, ...)
-#else
-sprintf_append_element_to_obj (va_alist)
-     va_dcl
-#endif
-{
-  va_list args;
-  char buf[1024];
-  
-#ifdef ANSI_PROTOTYPES
-  va_start (args, format);
-#else
-  Tcl_Obj *objp;
-  char *format;
-
-  va_start (args);
-  dsp = va_arg (args, Tcl_Obj *);
-  format = va_arg (args, char *);
-#endif
-
-  vsprintf (buf, format, args);
-
-  Tcl_ListObjAppendElement (NULL, objp, Tcl_NewStringObj (buf, -1));
-}
-\f
-/*
- * This section contains the commands that control execution.
- */
-
-/* This implements the tcl command gdb_clear_file.
- *
- * Prepare to accept a new executable file.  This is called when we
- * want to clear away everything we know about the old file, without
- * asking the user.  The Tcl code will have already asked the user if
- * necessary.  After this is called, we should be able to run the
- * `file' command without getting any questions.  
- *
- * Arguments:
- *    None
- * Tcl Result:
- *    None
- */
-
-static int
-gdb_clear_file (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  if (objc != 1)
-    Tcl_SetStringObj (result_ptr->obj_ptr,
-                     "Wrong number of args, none are allowed.", -1);
-  
-  if (inferior_pid != 0 && target_has_execution)
-    {
-      if (attach_flag)
-       target_detach (NULL, 0);
-      else
-       target_kill ();
-    }
-
-  if (target_has_execution)
-    pop_target ();
-
-  symbol_file_command (NULL, 0);
-
-  /* gdb_loc refers to stop_pc, but nothing seems to clear it, so we
-     clear it here.  FIXME: This seems like an abstraction violation
-     somewhere.  */
-  stop_pc = 0;
-
-  return TCL_OK;
-}
-
-/* This implements the tcl command gdb_confirm_quit
- * Ask the user to confirm an exit request.
- *
- * Arguments:
- *    None
- * Tcl Result:
- *    A boolean, 1 if the user answered yes, 0 if no.
- */
-
-static int
-gdb_confirm_quit (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  int ret;
-
-  if (objc != 1)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Wrong number of args, should be none.", -1);
-      return TCL_ERROR;
-    }
-  
-  ret = quit_confirm ();
-  Tcl_SetBooleanObj (result_ptr->obj_ptr, ret);
-  return TCL_OK;
-}
-
-/* This implements the tcl command gdb_force_quit
- * Quit without asking for confirmation.
- *
- * Arguments:
- *    None
- * Tcl Result:
- *    None
- */
-
-static int
-gdb_force_quit (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  if (objc != 1)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Wrong number of args, should be none.", -1);
-      return TCL_ERROR;
-    }
-  
-  quit_force ((char *) NULL, 1);
-  return TCL_OK;
-}
-
-/* This implements the tcl command gdb_stop
- * It stops the target in a continuable fashion.
- *
- * Arguments:
- *    None
- * Tcl Result:
- *    None
- */
-
-static int
-gdb_stop (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  if (target_stop)
-    {
-      target_stop ();
-    }
-  else
-    quit_flag = 1; /* hope something sees this */
-
-  return TCL_OK;
-}
-
-\f
-/*
- * This section contains Tcl commands that are wrappers for invoking
- * the GDB command interpreter.
- */
-
-
-/* This implements the tcl command `gdb_eval'.
- * It uses the gdb evaluator to return the value of
- * an expression in the current language
- *
- * Tcl Arguments:
- *     expression - the expression to evaluate.
- * Tcl Result:
- *     The result of the evaluation.
- */
-
-static int
-gdb_eval (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct expression *expr;
-  struct cleanup *old_chain;
-  value_ptr val;
-
-  if (objc != 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr,
-                       "wrong # args, should be \"gdb_eval expression\"", -1);
-      return TCL_ERROR;
-    }
-
-  expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
-
-  old_chain = make_cleanup (free_current_contents, &expr);
-
-  val = evaluate_expression (expr);
-
-  /*
-   * Print the result of the expression evaluation.  This will go to
-   * eventually go to gdbtk_fputs, and from there be collected into
-   * the Tcl result.
-   */
-  
-  val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
-            gdb_stdout, 0, 0, 0, 0);
-
-  do_cleanups (old_chain);
-
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_cmd".
- *  
- * It sends its argument to the GDB command scanner for execution. 
- * This command will never cause the update, idle and busy hooks to be called
- * within the GUI.
- * 
- * Tcl Arguments:
- *    command - The GDB command to execute
- * Tcl Result:
- *    The output from the gdb command (except for the "load" & "while"
- *    which dump their output to the console.
- */
-
-static int
-gdb_cmd (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-
-  if (objc < 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
-      return TCL_ERROR;
-    }
-
-  if (running_now || load_in_progress)
-    return TCL_OK;
-
-  No_Update = 1;
-
-  /* for the load instruction (and possibly others later) we
-     set turn off the GDBTK_TO_RESULT flag bit so gdbtk_fputs() 
-     will not buffer all the data until the command is finished. */
-
-  if ((strncmp ("load ", Tcl_GetStringFromObj (objv[1], NULL), 5) == 0)
-      || (strncmp ("while ", Tcl_GetStringFromObj (objv[1], NULL), 6) == 0))
-    {
-      result_ptr->flags &= ~GDBTK_TO_RESULT;
-      load_in_progress = 1;
-      gdbtk_start_timer ();
-    }
-
-  execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
-
-  if (load_in_progress)
-    {
-      gdbtk_stop_timer ();
-      load_in_progress = 0;
-      result_ptr->flags |= GDBTK_TO_RESULT;
-    }
-
-  bpstat_do_actions (&stop_bpstat);
-  
-  return TCL_OK;
-}
-
-/*
- * This implements the tcl command "gdb_immediate"
- *  
- * It does exactly the same thing as gdb_cmd, except NONE of its outut 
- * is buffered.  This will also ALWAYS cause the busy, update, and idle hooks to
- * be called, contrasted with gdb_cmd, which NEVER calls them.
- * It turns off the GDBTK_TO_RESULT flag, which diverts the result
- * to the console window.
- *
- * Tcl Arguments:
- *    command - The GDB command to execute
- * Tcl Result:
- *    None.
- */
-
-static int
-gdb_immediate_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-
-  if (objc != 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
-      return TCL_ERROR;
-    }
-
-  if (running_now || load_in_progress)
-    return TCL_OK;
-
-  No_Update = 0;
-
-  result_ptr->flags &= ~GDBTK_TO_RESULT;  
-
-  execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
-
-  bpstat_do_actions (&stop_bpstat);
-  
-  result_ptr->flags |= GDBTK_TO_RESULT;
-
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_prompt"
- *
- * It returns the gdb interpreter's prompt.
- *
- * Tcl Arguments:
- *    None.
- * Tcl Result:
- *    The prompt.
- */
-
-static int
-gdb_prompt_command (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  Tcl_SetStringObj (result_ptr->obj_ptr, get_prompt (), -1);
-  return TCL_OK;
-}
-
-\f
-/*
- * This section contains general informational commands.
- */
-
-/* This implements the tcl command "gdb_target_has_execution"
- *
- * Tells whether the target is executing.
- *
- * Tcl Arguments:
- *    None
- * Tcl Result:
- *    A boolean indicating whether the target is executing.
- */
-
-static int
-gdb_target_has_execution_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  int result = 0;
-
-  if (target_has_execution && inferior_pid != 0)
-    result = 1;
-
-  Tcl_SetBooleanObj (result_ptr->obj_ptr, result);
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_load_info"
- *
- * It returns information about the file about to be downloaded.
- *
- * Tcl Arguments:
- *    filename: The file to open & get the info on.
- * Tcl Result:
- *    A list consisting of the name and size of each section.
- */
-
-static int
-gdb_load_info (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-   bfd *loadfile_bfd;
-   struct cleanup *old_cleanups;
-   asection *s;
-   Tcl_Obj *ob[2];
-   int i = 0;
-
-   char *filename = Tcl_GetStringFromObj (objv[1], NULL);
-
-   loadfile_bfd = bfd_openr (filename, gnutarget);
-   if (loadfile_bfd == NULL)
-     {
-       Tcl_SetStringObj (result_ptr->obj_ptr, "Open failed", -1);
-       return TCL_ERROR;
-     }
-   old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
-   
-   if (!bfd_check_format (loadfile_bfd, bfd_object)) 
-     {
-       Tcl_SetStringObj (result_ptr->obj_ptr, "Bad Object File", -1);
-       return TCL_ERROR;
-    }
-
-   Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-   
-   for (s = loadfile_bfd->sections; s; s = s->next) 
-     {
-       if (s->flags & SEC_LOAD) 
-        {
-          bfd_size_type size = bfd_get_section_size_before_reloc (s);
-          if (size > 0)
-            {
-              ob[0] = Tcl_NewStringObj ((char *) bfd_get_section_name (loadfile_bfd, s), -1);
-              ob[1] = Tcl_NewLongObj ((long) size);
-              Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewListObj (2, ob));
-            }
-        }
-     }
-   
-   do_cleanups (old_cleanups);
-   return TCL_OK;
-}
-
-
-/* gdb_get_locals -
- * This and gdb_get_locals just call gdb_get_vars_command with the right
- * value of clientData.  We can't use the client data in the definition
- * of the command, because the call wrapper uses this instead...
- */
-
-static int
-gdb_get_locals_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-
-  return gdb_get_vars_command((ClientData) 0, interp, objc, objv);
-
-}
-
-static int
-gdb_get_args_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-
-  return gdb_get_vars_command((ClientData) 1, interp, objc, objv);
-
-}
-
-/* This implements the tcl commands "gdb_get_locals" and "gdb_get_args"
- *  
- * This function sets the Tcl interpreter's result to a list of variable names
- * depending on clientData. If clientData is one, the result is a list of
- * arguments; zero returns a list of locals -- all relative to the block
- * specified as an argument to the command. Valid commands include
- * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
- * and "main").
- *
- * Tcl Arguments:
- *   block - the address within which to specify the locals or args.
- * Tcl Result:
- *   A list of the locals or args
- */
-
-static int
-gdb_get_vars_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct symtabs_and_lines sals;
-  struct symbol *sym;
-  struct block *block;
-  char **canonical, *args;
-  int i, nsyms, arguments;
-
-  if (objc != 2)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr,
-                        "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " function:line|function|line|*addr\"", NULL);
-      return TCL_ERROR;
-    }
-
-  arguments = (int) clientData;
-  args = Tcl_GetStringFromObj (objv[1], NULL);
-  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
-  if (sals.nelts == 0)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr,
-                        "error decoding line", -1);
-      return TCL_ERROR;
-    }
-
-  /* Initialize the result pointer to an empty list. */
-
-  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-
-  /* Resolve all line numbers to PC's */
-  for (i = 0; i < sals.nelts; i++)
-    resolve_sal_pc (&sals.sals[i]);
-  
-  block = block_for_pc (sals.sals[0].pc);
-  while (block != 0)
-    {
-      nsyms = BLOCK_NSYMS (block);
-      for (i = 0; i < nsyms; i++)
-        {
-          sym = BLOCK_SYM (block, i);
-          switch (SYMBOL_CLASS (sym)) {
-          default:
-          case LOC_UNDEF:                /* catches errors        */
-          case LOC_CONST:            /* constant              */
-          case LOC_STATIC:           /* static                */
-          case LOC_REGISTER:      /* register              */
-          case LOC_TYPEDEF:          /* local typedef         */
-          case LOC_LABEL:            /* local label           */
-          case LOC_BLOCK:            /* local function        */
-          case LOC_CONST_BYTES:          /* loc. byte seq.        */
-          case LOC_UNRESOLVED:    /* unresolved static     */
-          case LOC_OPTIMIZED_OUT: /* optimized out         */
-            break;
-          case LOC_ARG:                      /* argument              */
-          case LOC_REF_ARG:          /* reference arg         */
-          case LOC_REGPARM:          /* register arg          */
-          case LOC_REGPARM_ADDR:  /* indirect register arg */
-          case LOC_LOCAL_ARG:    /* stack arg             */
-          case LOC_BASEREG_ARG:          /* basereg arg           */
-            if (arguments)
-              Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
-                                        Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
-            break;
-          case LOC_LOCAL:            /* stack local           */
-          case LOC_BASEREG:          /* basereg local         */
-            if (!arguments)
-              Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
-                                        Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
-            break;
-          }
-        }
-      if (BLOCK_FUNCTION (block))
-        break;
-      else
-        block = BLOCK_SUPERBLOCK (block);
-    }
-  
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_get_line"
- *
- * It returns the linenumber for a given linespec.  It will take any spec
- * that can be passed to decode_line_1
- *
- * Tcl Arguments:
- *    linespec - the line specification
- * Tcl Result:
- *    The line number for that spec.
- */
-static int
-gdb_get_line_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  Tcl_Obj *result;
-  struct symtabs_and_lines sals;
-  char *args, **canonical;
-  
-  if (objc != 2)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " linespec\"", NULL);
-      return TCL_ERROR;
-    }
-
-  args = Tcl_GetStringFromObj (objv[1], NULL);
-  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
-  if (sals.nelts == 1)
-    {
-      Tcl_SetIntObj (result_ptr->obj_ptr, sals.sals[0].line);
-      return TCL_OK;
-    }
-
-  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
-  return TCL_OK;
-  
-}
-
-/* This implements the tcl command "gdb_get_file"
- *
- * It returns the file containing a given line spec.
- *
- * Tcl Arguments:
- *    linespec - The linespec to look up
- * Tcl Result:
- *    The file containing it.
- */
-
-static int
-gdb_get_file_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  Tcl_Obj *result;
-  struct symtabs_and_lines sals;
-  char *args, **canonical;
-  
-  if (objc != 2)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " linespec\"", NULL);
-      return TCL_ERROR;
-    }
-
-  args = Tcl_GetStringFromObj (objv[1], NULL);
-  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
-  if (sals.nelts == 1)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, sals.sals[0].symtab->filename, -1);
-      return TCL_OK;
-    }
-
-  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_get_function"
- *
- * It finds the function containing the given line spec.
- *
- * Tcl Arguments:
- *    linespec - The line specification
- * Tcl Result:
- *    The function that contains it, or "N/A" if it is not in a function.
- */
-static int
-gdb_get_function_command (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  char *function;
-  struct symtabs_and_lines sals;
-  char *args, **canonical;
-
-  if (objc != 2)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " linespec\"", NULL);
-      return TCL_ERROR;
-    }
-
-  args = Tcl_GetStringFromObj (objv[1], NULL);
-  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
-  if (sals.nelts == 1)
-    {
-      resolve_sal_pc (&sals.sals[0]);
-      find_pc_partial_function (sals.sals[0].pc, &function, NULL, NULL);
-      if (function != NULL)
-        {
-          Tcl_SetStringObj (result_ptr->obj_ptr, function, -1);
-          return TCL_OK;
-        }
-    }
-  
-  Tcl_SetStringObj (result_ptr->obj_ptr, "N/A", -1);
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_find_file"
- *
- * It searches the symbol tables to get the full pathname to a file.
- *
- * Tcl Arguments:
- *    filename: the file name to search for.
- * Tcl Result:
- *    The full path to the file, or an empty string if the file is not
- *    found.
- */
-
-static int
-gdb_find_file_command (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  char *filename = NULL;
-  struct symtab *st;
-
-  if (objc != 2)
-    {
-      Tcl_WrongNumArgs(interp, 1, objv, "filename");
-      return TCL_ERROR;
-    }
-
-  st = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
-  if (st)
-    filename = st->fullname;
-
-  if (filename == NULL)
-    Tcl_SetStringObj (result_ptr->obj_ptr, "", 0);
-  else
-    Tcl_SetStringObj (result_ptr->obj_ptr, filename, -1);
-
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_listfiles"
- *
- * This lists all the files in the current executible.
- *
- * Arguments:
- *    ?pathname? - If provided, only files which match pathname
- *        (up to strlen(pathname)) are included.
- * Tcl Result:
- *    A list of all matching files.
- */
-
-static int
-gdb_listfiles (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  struct objfile *objfile;
-  struct partial_symtab *psymtab;
-  struct symtab *symtab;
-  char *lastfile, *pathname, **files;
-  int files_size;
-  int i, numfiles = 0, len = 0;
-  Tcl_Obj *mylist;
-  
-  files_size = 1000;
-  files = (char **) xmalloc (sizeof (char *) * files_size);
-
-  if (objc > 2)
-    {
-      Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
-      return TCL_ERROR;
-    }
-  else if (objc == 2)
-    pathname = Tcl_GetStringFromObj (objv[1], &len);
-
-  ALL_PSYMTABS (objfile, psymtab)
-    {
-      if (numfiles == files_size)
-        {
-           files_size = files_size * 2;
-           files = (char **) xrealloc (files, sizeof (char *) * files_size);
-        }
-      if (len == 0)
-       {
-         if (psymtab->filename)
-           files[numfiles++] = basename(psymtab->filename);
-       }
-      else if (!strcmp(psymtab->filename,basename(psymtab->filename))
-              || !strncmp(pathname,psymtab->filename,len))
-       if (psymtab->filename)
-         files[numfiles++] = basename(psymtab->filename);
-    }
-
-  ALL_SYMTABS (objfile, symtab)
-    {
-      if (numfiles == files_size)
-        {
-           files_size = files_size * 2;
-           files = (char **) xrealloc (files, sizeof (char *) * files_size);
-        }
-      if (len == 0)
-       {
-         if (symtab->filename)
-           files[numfiles++] = basename(symtab->filename);
-       }
-      else if (!strcmp(symtab->filename,basename(symtab->filename))
-              || !strncmp(pathname,symtab->filename,len))
-       if (symtab->filename)
-         files[numfiles++] = basename(symtab->filename);
-    }
-
-  qsort (files, numfiles, sizeof(char *), comp_files);
-
-  lastfile = "";
-
-  /* Discard the old result pointer, in case it has accumulated anything
-     and set it to a new list object */
-  
-  Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);
-  
-  for (i = 0; i < numfiles; i++)
-    {
-      if (strcmp(files[i],lastfile))
-       Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj(files[i], -1));
-      lastfile = files[i];
-    }
-
-  free (files);
-  return TCL_OK;
-}
-
-static int
-comp_files (file1, file2)
-     const void *file1, *file2;
-{
-  return strcmp(* (char **) file1, * (char **) file2);
-}
-
-
-/* This implements the tcl command "gdb_search"
- *
- *
- * Tcl Arguments:
- *    option - One of "functions", "variables" or "types"
- *    regexp - The regular expression to look for.
- * Then, optionally:
- *    -files fileList
- *    -static 1/0
- * Tcl Result:
- *
- */
-
-static int
-gdb_search (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct symbol_search *ss;
-  struct symbol_search *p;
-  struct cleanup *old_chain;
-  Tcl_Obj *list, *result, *CONST *switch_objv;
-  int index, switch_objc, i;
-  namespace_enum space;
-  char *regexp, *val;
-  int static_only, nfiles;
-  Tcl_Obj **file_list;
-  char **files;
-  static char *search_options[] = { "functions", "variables", "types", (char *) NULL };
-  static char *switches[] = { "-files", "-static" };
-  enum search_opts { SEARCH_FUNCTIONS, SEARCH_VARIABLES, SEARCH_TYPES };
-  enum switches_opts { SWITCH_FILES, SWITCH_STATIC_ONLY };
-
-  if (objc < 3)
-    {
-      Tcl_WrongNumArgs (interp, 1, objv, "option regexp ?arg ...?");
-      return TCL_ERROR;
-    }
-
-  if (Tcl_GetIndexFromObj (interp, objv[1], search_options, "option", 0,
-                           &index) != TCL_OK)
-    return TCL_ERROR;
-
-  /* Unfortunately, we cannot teach search_symbols to search on
-     multiple regexps, so we have to do a two-tier search for
-     any searches which choose to narrow the playing field. */
-  switch ((enum search_opts) index)
-    {
-    case SEARCH_FUNCTIONS:
-      space = FUNCTIONS_NAMESPACE;      break;
-    case SEARCH_VARIABLES:
-      space = VARIABLES_NAMESPACE;      break;
-    case SEARCH_TYPES:
-      space = TYPES_NAMESPACE;          break;
-    }
-
-  regexp = Tcl_GetStringFromObj (objv[2], NULL);
-  /* Process any switches that refine the search */
-  switch_objc = objc - 3;
-  switch_objv = objv + 3;
-
-  static_only = 0;
-  nfiles = 0;
-  files = (char **) NULL;
-  while (switch_objc > 0)
-    {
-      if (Tcl_GetIndexFromObj (interp, switch_objv[0], switches,
-                               "option", 0, &index) != TCL_OK)
-       {
-         result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-         return TCL_ERROR;
-       }
-
-      switch ((enum switches_opts) index)
-        {
-        case SWITCH_FILES:
-          if (switch_objc < 2)
-            {
-              Tcl_WrongNumArgs (interp, 2, objv, "[-files fileList -static 1|0]");
-             result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-              return TCL_ERROR;
-            }              
-          Tcl_ListObjGetElements (interp, switch_objv[1], &nfiles, &file_list);
-          files = (char **) xmalloc (nfiles);
-          old_chain = make_cleanup (free, files);
-          
-          for (i = 0; i < nfiles; i++)
-              files[i] = Tcl_GetStringFromObj (file_list[i], NULL);
-          switch_objc--;
-          switch_objv++;
-          break;
-        case SWITCH_STATIC_ONLY:
-          if (switch_objc < 2)
-            {
-              Tcl_WrongNumArgs (interp, 2, objv, "[-files fileList] [-static 1|0]");
-             result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-              return TCL_ERROR;
-            }              
-          if ( Tcl_GetBooleanFromObj (interp, switch_objv[1], &static_only) !=
-              TCL_OK) {
-           result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-           return TCL_ERROR;
-         }
-          switch_objc--;
-          switch_objv++;
-        }
-
-      switch_objc--;
-      switch_objv++;
-    }
-
-  search_symbols (regexp, space, nfiles, files, &ss);
-  if (files != NULL && ss != NULL)
-    do_cleanups (old_chain);
-  old_chain = make_cleanup (free_search_symbols, ss);
-  
-  Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);
-  
-  for (p = ss; p != NULL; p = p->next)
-    {
-      Tcl_Obj *elem;
-
-      if (static_only && p->block != STATIC_BLOCK)
-        continue;
-
-      elem = Tcl_NewListObj (0, NULL);
-
-      if (p->msymbol == NULL)
-        Tcl_ListObjAppendElement (interp, elem, 
-                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
-      else
-        Tcl_ListObjAppendElement (interp, elem,
-                                  Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
-
-      Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
-    }
-  
-  do_cleanups (old_chain);
-  return TCL_OK;
-}
-
-/* This implements the tcl command gdb_listfuncs
- *  
- * It lists all the functions defined in a given file
- * 
- * Arguments:
- *    file - the file to look in
- * Tcl Result:
- *    A list of two element lists, the first element is
- *    the symbol name, and the second is a boolean indicating
- *    whether the symbol is demangled (1 for yes).
- */
-
-static int
-gdb_listfuncs (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct symtab *symtab;
-  struct blockvector *bv;
-  struct block *b;
-  struct symbol *sym;
-  char buf[128];
-  int i,j;
-  Tcl_Obj *funcVals[2];
-
-  if (objc != 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
-    }
-  
-  symtab = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
-  if (!symtab)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "No such file", -1);
-      return TCL_ERROR;
-    }
-
-  if (mangled == NULL)
-    {
-      mangled = Tcl_NewBooleanObj(1);
-      not_mangled = Tcl_NewBooleanObj(0);
-      Tcl_IncrRefCount(mangled);
-      Tcl_IncrRefCount(not_mangled);
-    }
-
-  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-  
-  bv = BLOCKVECTOR (symtab);
-  for (i = GLOBAL_BLOCK; i <= STATIC_BLOCK; i++)
-    {
-      b = BLOCKVECTOR_BLOCK (bv, i);
-      /* Skip the sort if this block is always sorted.  */
-      if (!BLOCK_SHOULD_SORT (b))
-       sort_block_syms (b);
-      for (j = 0; j < BLOCK_NSYMS (b); j++)
-       {
-         sym = BLOCK_SYM (b, j);
-         if (SYMBOL_CLASS (sym) == LOC_BLOCK)
-           {
-             
-             char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
-             if (name)
-               {
-                 funcVals[0] = Tcl_NewStringObj(name, -1);
-                 funcVals[1] = mangled;          
-               }
-             else
-               {
-                 funcVals[0] = Tcl_NewStringObj(SYMBOL_NAME(sym), -1);
-                 funcVals[1] = not_mangled;
-               }
-             Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                                       Tcl_NewListObj (2, funcVals));
-           }
-       }
-    }
-  return TCL_OK;
-}
-
-\f
-/*
- * This section contains all the commands that act on the registers:
- */
-
-/* This is a sort of mapcar function for operations on registers */ 
-           
-static int
-map_arg_registers (objc, objv, func, argp)
-     int objc;
-     Tcl_Obj *CONST objv[];
-     void (*func) PARAMS ((int regnum, void *argp));
-     void *argp;
-{
-  int regnum;
-
-  /* Note that the test for a valid register must include checking the
-     reg_names array because NUM_REGS may be allocated for the union of the
-     register sets within a family of related processors.  In this case, the
-     trailing entries of reg_names will change depending upon the particular
-     processor being debugged.  */
-
-  if (objc == 0)               /* No args, just do all the regs */
-    {
-      for (regnum = 0;
-          regnum < NUM_REGS
-          && reg_names[regnum] != NULL
-          && *reg_names[regnum] != '\000';
-          regnum++)
-       func (regnum, argp);
-
-      return TCL_OK;
-    }
-
-  /* Else, list of register #s, just do listed regs */
-  for (; objc > 0; objc--, objv++)
-    {
-
-      if (Tcl_GetIntFromObj (NULL, *objv, &regnum) != TCL_OK) {
-       result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-       return TCL_ERROR;
-      }
-
-      if (regnum >= 0
-         && regnum < NUM_REGS
-         && reg_names[regnum] != NULL
-         && *reg_names[regnum] != '\000')
-       func (regnum, argp);
-      else
-       {
-         Tcl_SetStringObj (result_ptr->obj_ptr, "bad register number", -1);
-         return TCL_ERROR;
-       }
-    }
-
-  return TCL_OK;
-}
-           
-/* This implements the TCL command `gdb_regnames', which returns a list of
-   all of the register names. */
-
-static int
-gdb_regnames (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  objc--;
-  objv++;
-
-  return map_arg_registers (objc, objv, get_register_name, NULL);
-}
-
-static void
-get_register_name (regnum, argp)
-     int regnum;
-     void *argp;               /* Ignored */
-{
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                           Tcl_NewStringObj (reg_names[regnum], -1));
-}
-
-/* This implements the tcl command gdb_fetch_registers
- * Pass it a list of register names, and it will
- * return their values as a list.
- *
- * Tcl Arguments:
- *    format: The format string for printing the values
- *    args: the registers to look for
- * Tcl Result:
- *    A list of their values.
- */
-
-static int
-gdb_fetch_registers (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  int format, result;
-
-  if (objc < 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr,
-                       "wrong # args, should be gdb_fetch_registers format ?register1 register2 ...?", -1);
-    }
-  objc -= 2;
-  objv++;
-  format = *(Tcl_GetStringFromObj(objv[0], NULL));  
-  objv++;
-  
-  
-  result_ptr->flags |= GDBTK_MAKES_LIST; /* Output the results as a list */
-  result = map_arg_registers (objc, objv, get_register, (void *) format);
-  result_ptr->flags &= ~GDBTK_MAKES_LIST;
-  
-  return result; 
-}
-
-static void
-get_register (regnum, fp)
-     int regnum;
-     void *fp;
-{
-  char raw_buffer[MAX_REGISTER_RAW_SIZE];
-  char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
-  int format = (int)fp;
-
-  if (format == 'N')
-    format = 0;
-
-  if (read_relative_register_raw_bytes (regnum, raw_buffer))
-    {
-      Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                               Tcl_NewStringObj ("Optimized out", -1));
-      return;
-    }
-
-  /* Convert raw data to virtual format if necessary.  */
-
-  if (REGISTER_CONVERTIBLE (regnum))
-    {
-      REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
-                                  raw_buffer, virtual_buffer);
-    }
-  else
-    memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
-
-  if (format == 'r')
-    {
-      int j;
-      printf_filtered ("0x");
-      for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
-       {
-         register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
-           : REGISTER_RAW_SIZE (regnum) - 1 - j;
-         printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
-       }
-    }
-  else
-    val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
-              gdb_stdout, format, 1, 0, Val_pretty_default);
-
-}
-
-/* This implements the tcl command get_pc_reg
- * It returns the value of the PC register
- *
- * Tcl Arguments:
- *    None
- * Tcl Result:
- *    The value of the pc register.
- */
-
-static int
-get_pc_register (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  char buff[64];
-  
-  sprintf (buff, "0x%llx",(long long) read_register (PC_REGNUM));
-  Tcl_SetStringObj(result_ptr->obj_ptr, buff, -1);
-  return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_changed_register_list"
- * It takes a list of registers, and returns a list of
- * the registers on that list that have changed since the last
- * time the proc was called.
- *
- * Tcl Arguments:
- *    A list of registers.
- * Tcl Result:
- *    A list of changed registers.
- */
-
-static int
-gdb_changed_register_list (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  objc--;
-  objv++;
-
-  return map_arg_registers (objc, objv, register_changed_p, NULL);
-}
-
-static void
-register_changed_p (regnum, argp)
-     int regnum;
-     void *argp;               /* Ignored */
-{
-  char raw_buffer[MAX_REGISTER_RAW_SIZE];
-
-  if (read_relative_register_raw_bytes (regnum, raw_buffer))
-    return;
-
-  if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
-             REGISTER_RAW_SIZE (regnum)) == 0)
-    return;
-
-  /* Found a changed register.  Save new value and return its number. */
-
-  memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
-         REGISTER_RAW_SIZE (regnum));
-
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(regnum));
-}
-\f
-/*
- * This section contains the commands that deal with tracepoints:
- */
-
-/* return a list of all tracepoint numbers in interpreter */
-static int
-gdb_get_tracepoint_list (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  struct tracepoint *tp;
-
-  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-
-  ALL_TRACEPOINTS (tp)
-    Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->number));
-
-  return TCL_OK;
-}
-
-/* returns -1 if not found, tracepoint # if found */
-int
-tracepoint_exists (char * args)
-{
-  struct tracepoint *tp;
-  char **canonical;
-  struct symtabs_and_lines sals;
-  char  *file = NULL;
-  int    result = -1;
-
-  sals = decode_line_1 (&args, 1, NULL, 0, &canonical);  
-  if (sals.nelts == 1)
-    {
-      resolve_sal_pc (&sals.sals[0]);
-      file = xmalloc (strlen (sals.sals[0].symtab->dirname)
-                      + strlen (sals.sals[0].symtab->filename) + 1);
-      if (file != NULL)
-        {
-          strcpy (file, sals.sals[0].symtab->dirname);
-          strcat (file, sals.sals[0].symtab->filename);
-
-          ALL_TRACEPOINTS (tp)
-            {
-              if (tp->address == sals.sals[0].pc)
-                result = tp->number;
-#if 0
-              /* Why is this here? This messes up assembly traces */
-              else if (tp->source_file != NULL
-                       && strcmp (tp->source_file, file) == 0
-                       && sals.sals[0].line == tp->line_number)
-                result = tp->number;
-#endif                
-            }
-        }
-    }
-  if (file != NULL)
-    free (file);
-  return result;
-}
-
-static int
-gdb_tracepoint_exists_command (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  char * args;
-
-  if (objc != 2)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " function:line|function|line|*addr\"", NULL);
-      return TCL_ERROR;
-    }
-  
-  args = Tcl_GetStringFromObj (objv[1], NULL);
-  
-  Tcl_SetIntObj (result_ptr->obj_ptr, tracepoint_exists (args));
-  return TCL_OK;
-}
-
-static int
-gdb_get_tracepoint_info (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj  *CONST objv[];
-{
-  struct symtab_and_line sal;
-  int tpnum;
-  struct tracepoint *tp;
-  struct action_line *al;
-  Tcl_Obj *action_list;
-  char *filename, *funcname;
-  char tmp[19];
-  
-  if (objc != 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
-      return TCL_ERROR;
-    }
-  
-  if (Tcl_GetIntFromObj (NULL, objv[1], &tpnum) != TCL_OK)
-    {
-      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-
-  ALL_TRACEPOINTS (tp)
-    if (tp->number == tpnum)
-      break;
-
-  if (tp == NULL)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Tracepoint #%d does not exist", -1);
-      return TCL_ERROR;
-    }
-
-  Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-  sal = find_pc_line (tp->address, 0);
-  filename = symtab_to_filename (sal.symtab);
-  if (filename == NULL)
-    filename = "N/A";
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
-                            Tcl_NewStringObj (filename, -1));
-  find_pc_partial_function (tp->address, &funcname, NULL, NULL);
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (funcname, -1));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (sal.line));
-  sprintf (tmp, "0x%lx", tp->address);
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (tmp, -1));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->enabled));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->pass_count));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->step_count));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->thread));
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (tp->hit_count));
-
-  /* Append a list of actions */
-  action_list = Tcl_NewObj ();
-  for (al = tp->actions; al != NULL; al = al->next)
-    {
-      Tcl_ListObjAppendElement (interp, action_list,
-                                Tcl_NewStringObj (al->action, -1));
-    }
-  Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, action_list);
-
-  return TCL_OK;
-}
-
-
-static int
-gdb_trace_status (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  int result = 0;
-  if (trace_running_p)
-    result = 1;
-  Tcl_SetIntObj (result_ptr->obj_ptr, result);
-  return TCL_OK;
-}
-
-
-
-static int
-gdb_get_trace_frame_num (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  if (objc != 1)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # of args: should be \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " linespec\"", NULL);
-      return TCL_ERROR;
-    }
-  Tcl_SetIntObj (result_ptr->obj_ptr, get_traceframe_number ());
-  return TCL_OK;
-  
-}
-/* This implements the tcl command gdb_actions
- * It sets actions for a given tracepoint.
- *
- * Tcl Arguments:
- *    number: the tracepoint in question
- *    actions: the actions to add to this tracepoint
- * Tcl Result:
- *    None.
- */
-
-static int
-gdb_actions_command (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  struct tracepoint *tp;
-  Tcl_Obj **actions;
-  int      nactions, i, len;
-  char *number, *args, *action;
-  long step_count;
-  struct action_line *next = NULL, *temp;
-  enum actionline_type linetype;
-
-  if (objc != 3)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "wrong # args: should be: \"",
-                        Tcl_GetStringFromObj (objv[0], NULL),
-                        " number actions\"", NULL);
-      return TCL_ERROR;
-    }
-
-  args = number = Tcl_GetStringFromObj (objv[1], NULL);
-  tp = get_tracepoint_by_number (&args);
-  if (tp == NULL)
-    {
-      Tcl_AppendStringsToObj (result_ptr->obj_ptr, "Tracepoint \"", number, "\" does not exist", NULL);
-      return TCL_ERROR;
-    }
-
-  /* Free any existing actions */
-  if (tp->actions != NULL)
-    free_actions (tp);
-
-  step_count = 0;
-
-  Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
-
-  /* Add the actions to the tracepoint */
-  for (i = 0; i < nactions; i++)
-    {
-      temp = xmalloc (sizeof (struct action_line));
-      temp->next = NULL;
-      action = Tcl_GetStringFromObj (actions[i], &len);
-      temp->action = savestring (action, len);
-
-      linetype = validate_actionline (&(temp->action), tp);
-
-      if (linetype == BADLINE) 
-       {
-         free (temp);
-         continue;
-       }
-
-      if (next == NULL)
-        {
-          tp->actions = temp;
-          next = temp;
-        }
-      else
-        {
-          next->next = temp;
-          next = temp;
-        }
-    }
-  
-  return TCL_OK;
-}
-\f
-/*
- * This section has commands that handle source disassembly.
- */
-
-/* This implements the tcl command gdb_disassemble
- *
- * Arguments:
- *    source_with_assm - must be "source" or "nosource"
- *    low_address - the address from which to start disassembly
- *    ?hi_address? - the address to which to disassemble, defaults
- *                   to the end of the function containing low_address.
- * Tcl Result:
- *    The disassembled code is passed to fputs_unfiltered, so it
- *    either goes to the console if result_ptr->obj_ptr is NULL or to
- *    the Tcl result.
- */
-
-static int
-gdb_disassemble (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  CORE_ADDR pc, low, high;
-  int mixed_source_and_assembly;
-  static disassemble_info di;
-  static int di_initialized;
-  char *arg_ptr;
-
-  if (objc != 3 && objc != 4)
-    error ("wrong # args");
-
-  if (! di_initialized)
-    {
-      INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
-                                    (fprintf_ftype) fprintf_unfiltered);
-      di.flavour = bfd_target_unknown_flavour;
-      di.memory_error_func = dis_asm_memory_error;
-      di.print_address_func = dis_asm_print_address;
-      di_initialized = 1;
-    }
-
-  di.mach = tm_print_insn_info.mach;
-  if (TARGET_BYTE_ORDER == BIG_ENDIAN)
-    di.endian = BFD_ENDIAN_BIG;
-  else
-    di.endian = BFD_ENDIAN_LITTLE;
-
-  arg_ptr = Tcl_GetStringFromObj (objv[1], NULL);
-  if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
-    mixed_source_and_assembly = 1;
-  else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
-    mixed_source_and_assembly = 0;
-  else
-    error ("First arg must be 'source' or 'nosource'");
-
-  low = parse_and_eval_address (Tcl_GetStringFromObj (objv[2], NULL));
-
-  if (objc == 3)
-    {
-      if (find_pc_partial_function (low, NULL, &low, &high) == 0)
-       error ("No function contains specified address");
-    }
-  else
-    high = parse_and_eval_address (Tcl_GetStringFromObj (objv[3], NULL));
-
-  /* If disassemble_from_exec == -1, then we use the following heuristic to
-     determine whether or not to do disassembly from target memory or from the
-     exec file:
-
-     If we're debugging a local process, read target memory, instead of the
-     exec file.  This makes disassembly of functions in shared libs work
-     correctly.
-
-     Else, we're debugging a remote process, and should disassemble from the
-     exec file for speed.  However, this is no good if the target modifies its
-     code (for relocation, or whatever).
-   */
-
-  if (disassemble_from_exec == -1)
-    if (strcmp (target_shortname, "child") == 0
-       || strcmp (target_shortname, "procfs") == 0
-       || strcmp (target_shortname, "vxprocess") == 0)
-      disassemble_from_exec = 0; /* It's a child process, read inferior mem */
-    else
-      disassemble_from_exec = 1; /* It's remote, read the exec file */
-
-  if (disassemble_from_exec)
-    di.read_memory_func = gdbtk_dis_asm_read_memory;
-  else
-    di.read_memory_func = dis_asm_read_memory;
-
-  /* If just doing straight assembly, all we need to do is disassemble
-     everything between low and high.  If doing mixed source/assembly, we've
-     got a totally different path to follow.  */
-
-  if (mixed_source_and_assembly)
-    {                          /* Come here for mixed source/assembly */
-      /* The idea here is to present a source-O-centric view of a function to
-        the user.  This means that things are presented in source order, with
-        (possibly) out of order assembly immediately following.  */
-      struct symtab *symtab;
-      struct linetable_entry *le;
-      int nlines;
-      int newlines;
-      struct my_line_entry *mle;
-      struct symtab_and_line sal;
-      int i;
-      int out_of_order;
-      int next_line;
-
-      symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
-
-      if (!symtab)
-       goto assembly_only;
-
-/* First, convert the linetable to a bunch of my_line_entry's.  */
-
-      le = symtab->linetable->item;
-      nlines = symtab->linetable->nitems;
-
-      if (nlines <= 0)
-       goto assembly_only;
-
-      mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
-
-      out_of_order = 0;
-
-/* Copy linetable entries for this function into our data structure, creating
-   end_pc's and setting out_of_order as appropriate.  */
-
-/* First, skip all the preceding functions.  */
-
-      for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
-
-/* Now, copy all entries before the end of this function.  */
-
-      newlines = 0;
-      for (; i < nlines - 1 && le[i].pc < high; i++)
-       {
-         if (le[i].line == le[i + 1].line
-             && le[i].pc == le[i + 1].pc)
-           continue;           /* Ignore duplicates */
-
-         mle[newlines].line = le[i].line;
-         if (le[i].line > le[i + 1].line)
-           out_of_order = 1;
-         mle[newlines].start_pc = le[i].pc;
-         mle[newlines].end_pc = le[i + 1].pc;
-         newlines++;
-       }
-
-/* If we're on the last line, and it's part of the function, then we need to
-   get the end pc in a special way.  */
-
-      if (i == nlines - 1
-         && le[i].pc < high)
-       {
-         mle[newlines].line = le[i].line;
-         mle[newlines].start_pc = le[i].pc;
-         sal = find_pc_line (le[i].pc, 0);
-         mle[newlines].end_pc = sal.end;
-         newlines++;
-       }
-
-/* Now, sort mle by line #s (and, then by addresses within lines). */
-
-      if (out_of_order)
-       qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
-
-/* Now, for each line entry, emit the specified lines (unless they have been
-   emitted before), followed by the assembly code for that line.  */
-
-      next_line = 0;           /* Force out first line */
-      for (i = 0; i < newlines; i++)
-       {
-/* Print out everything from next_line to the current line.  */
-
-         if (mle[i].line >= next_line)
-           {
-             if (next_line != 0)
-               print_source_lines (symtab, next_line, mle[i].line + 1, 0);
-             else
-               print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
-
-             next_line = mle[i].line + 1;
-           }
-
-         for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
-           {
-             QUIT;
-             fputs_unfiltered ("    ", gdb_stdout);
-             print_address (pc, gdb_stdout);
-             fputs_unfiltered (":\t    ", gdb_stdout);
-             pc += (*tm_print_insn) (pc, &di);
-             fputs_unfiltered ("\n", gdb_stdout);
-           }
-       }
-    }
-  else
-    {
-assembly_only:
-      for (pc = low; pc < high; )
-       {
-         QUIT;
-         fputs_unfiltered ("    ", gdb_stdout);
-         print_address (pc, gdb_stdout);
-         fputs_unfiltered (":\t    ", gdb_stdout);
-         pc += (*tm_print_insn) (pc, &di);
-         fputs_unfiltered ("\n", gdb_stdout);
-       }
-    }
-
-  gdb_flush (gdb_stdout);
-
-  return TCL_OK;
-}
-
-/* This is the memory_read_func for gdb_disassemble when we are
-   disassembling from the exec file. */
-
-static int
-gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
-     bfd_vma memaddr;
-     bfd_byte *myaddr;
-     int len;
-     disassemble_info *info;
-{
-  extern struct target_ops exec_ops;
-  int res;
-
-  errno = 0;
-  res = xfer_memory (memaddr, myaddr, len, 0, &exec_ops);
-
-  if (res == len)
-    return 0;
-  else
-    if (errno == 0)
-      return EIO;
-    else
-      return errno;
-}
-
-/* This will be passed to qsort to sort the results of the disassembly */
-
-static int
-compare_lines (mle1p, mle2p)
-     const PTR mle1p;
-     const PTR mle2p;
-{
-  struct my_line_entry *mle1, *mle2;
-  int val;
-
-  mle1 = (struct my_line_entry *) mle1p;
-  mle2 = (struct my_line_entry *) mle2p;
-
-  val =  mle1->line - mle2->line;
-
-  if (val != 0)
-    return val;
-
-  return mle1->start_pc - mle2->start_pc;
-}
-
-/* This implements the TCL command `gdb_loc',
- *
- * Arguments:
- *    ?symbol? The symbol or address to locate - defaults to pc
- * Tcl Return:
- *    a list consisting of the following:                                  
- *       basename, function name, filename, line number, address, current pc
- */
-
-static int
-gdb_loc (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  char *filename;
-  struct symtab_and_line sal;
-  char *funcname, *fname;
-  CORE_ADDR pc;
-
-  if (!have_full_symbols () && !have_partial_symbols ())
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "No symbol table is loaded", -1);
-      return TCL_ERROR;
-    }
-  
-  if (objc == 1)
-    {
-      if (selected_frame && (selected_frame->pc != stop_pc))
-       {
-         /* Note - this next line is not correct on all architectures. */
-         /* For a graphical debugger we really want to highlight the */
-         /* assembly line that called the next function on the stack. */
-         /* Many architectures have the next instruction saved as the */
-         /* pc on the stack, so what happens is the next instruction is hughlighted. */
-         /* FIXME */
-         pc = selected_frame->pc;
-         sal = find_pc_line (selected_frame->pc,
-                             selected_frame->next != NULL
-                             && !selected_frame->next->signal_handler_caller
-                             && !frame_in_dummy (selected_frame->next));
-       }
-      else
-       {
-         pc = stop_pc;
-         sal = find_pc_line (stop_pc, 0);
-       }
-    }
-  else if (objc == 2)
-    {
-      struct symtabs_and_lines sals;
-      int nelts;
-
-      sals = decode_line_spec (Tcl_GetStringFromObj (objv[1], NULL), 1);
-
-      nelts = sals.nelts;
-      sal = sals.sals[0];
-      free (sals.sals);
-
-      if (sals.nelts != 1)
-       {
-         Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
-         return TCL_ERROR;
-       }
-
-      pc = sal.pc;
-    }
-  else
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
-      return TCL_ERROR;
-    }
-
-  if (sal.symtab)
-    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                             Tcl_NewStringObj (sal.symtab->filename, -1));
-  else
-    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewStringObj ("", 0));
-
-  find_pc_partial_function (pc, &funcname, NULL, NULL);
-  fname = cplus_demangle (funcname, 0);
-  if (fname)
-    {
-      Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                               Tcl_NewStringObj (fname, -1));
-      free (fname);
-    }
-  else
-    Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                             Tcl_NewStringObj (funcname, -1));
-  
-  filename = symtab_to_filename (sal.symtab);
-  if (filename == NULL)
-    filename = "";
-
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                           Tcl_NewStringObj (filename, -1));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line)); /* line number */
-  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
-  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
-  return TCL_OK;
-}
-
-/* This implements the Tcl command 'gdb_get_mem', which 
- * dumps a block of memory 
- * Arguments:
- *   gdb_get_mem addr form size num aschar
- *
- *   addr: address of data to dump
- *   form: a char indicating format
- *   size: size of each element; 1,2,4, or 8 bytes
- *   num: the number of bytes to read 
- *   acshar: an optional ascii character to use in ASCII dump
- * 
- * Return:
- * a list of elements followed by an optional ASCII dump 
- */
-
-static int
-gdb_get_mem (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  int size, asize, i, j, bc;
-  CORE_ADDR addr;
-  int nbytes, rnum, bpr;
-  long tmp;
-  char format, c, *ptr, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
-  struct type *val_type;
-
-  if (objc < 6 || objc > 7)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr,
-                       "addr format size bytes bytes_per_row ?ascii_char?", -1);
-      return TCL_ERROR; 
-    }
-
-  if (Tcl_GetIntFromObj (interp, objv[3], &size) != TCL_OK)
-    {
-      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-  else if (size <= 0)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid size, must be > 0", -1);
-      return TCL_ERROR;
-    }
-  
-  if (Tcl_GetIntFromObj (interp, objv[4], &nbytes) != TCL_OK)
-    {
-      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-  else if (size <= 0)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid number of bytes, must be > 0", 
-                       -1);
-      return TCL_ERROR;
-    }
-  
-  if (Tcl_GetIntFromObj (interp, objv[5], &bpr) != TCL_OK)
-    {
-      result_ptr->flags |= GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-  else if (size <= 0)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid bytes per row, must be > 0", -1);
-      return TCL_ERROR;
-    }
-  
-  if (Tcl_GetLongFromObj (interp, objv[1], &tmp) != TCL_OK)
-    return TCL_OK;
-
-  addr = (CORE_ADDR) tmp;
-
-  format = *(Tcl_GetStringFromObj (objv[2], NULL));
-  mbuf = (char *)malloc (nbytes+32);
-  if (!mbuf)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Out of memory.", -1);
-      return TCL_ERROR;
-    }
-  
-  memset (mbuf, 0, nbytes+32);
-  mptr = cptr = mbuf;
-
-  rnum = target_read_memory_partial (addr, mbuf, nbytes, NULL);
-
-  if (objc == 7)
-    aschar = *(Tcl_GetStringFromObj(objv[6], NULL)); 
-  else
-    aschar = 0;
-
-  switch (size) {
-  case 1:
-    val_type = builtin_type_char;
-    asize = 'b';
-    break;
-  case 2:
-    val_type = builtin_type_short;
-    asize = 'h';
-    break;
-  case 4:
-    val_type = builtin_type_int;
-    asize = 'w';
-    break;
-  case 8:
-    val_type = builtin_type_long_long;
-    asize = 'g';
-    break;
-  default:
-    val_type = builtin_type_char;
-    asize = 'b';
-  }
-
-  bc = 0;        /* count of bytes in a row */
-  buff[0] = '"'; /* buffer for ascii dump */
-  bptr = &buff[1];   /* pointer for ascii dump */
-  
-  result_ptr->flags |= GDBTK_MAKES_LIST; /* Build up the result as a list... */
-   
-  for (i=0; i < nbytes; i+= size)
-    {
-      if ( i >= rnum)
-       {
-         fputs_unfiltered ("N/A ", gdb_stdout);
-         if (aschar)
-           for ( j = 0; j < size; j++)
-             *bptr++ = 'X';
-       }
-      else
-       {
-         print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
-
-         if (aschar)
-           {
-             for ( j = 0; j < size; j++)
-               {
-                 c = *cptr++;
-                 if (c < 32 || c > 126)
-                   c = aschar;
-                 if (c == '"')
-                   *bptr++ = '\\';
-                 *bptr++ = c;
-               }
-           }
-       }
-
-      mptr += size;
-      bc += size;
-
-      if (aschar && (bc >= bpr))
-       {
-         /* end of row. print it and reset variables */
-         bc = 0;
-         *bptr++ = '"';
-         *bptr++ = ' ';
-         *bptr = 0;
-         fputs_unfiltered (buff, gdb_stdout);
-         bptr = &buff[1];
-       }
-    }
-  
-  result_ptr->flags &= ~GDBTK_MAKES_LIST;
-           
-  free (mbuf);
-  return TCL_OK;
-}
-
-\f
-
-/* This implements the tcl command "gdb_loadfile"
- * It loads a c source file into a text widget.
- *
- * Tcl Arguments:
- *    widget: the name of the text widget to fill
- *    filename: the name of the file to load
- *    linenumbers: A boolean indicating whether or not to display line numbers.
- * Tcl Result:
- *
- */
-
-/* In this routine, we will build up a "line table", i.e. a
- * table of bits showing which lines in the source file are executible.
- * LTABLE_SIZE is the number of bytes to allocate for the line table.
- *
- * Its size limits the maximum number of lines 
- * in a file to 8 * LTABLE_SIZE.  This memory is freed after 
- * the file is loaded, so it is OK to make this very large. 
- * Additional memory will be allocated if needed. */
-#define LTABLE_SIZE 20000
-static int
-gdb_loadfile (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-{
-  char *file, *widget, *buf, msg[128];
-  int linenumbers, ln, anum, lnum, ltable_size;
-  FILE *fp;
-  char *ltable;
-  struct symtab *symtab;
-  struct linetable_entry *le;
-  long mtime = 0;
-  struct stat st;
-  Tcl_DString text_cmd_1, text_cmd_2, *cur_cmd;
-  char line[1024], line_num_buf[16];
-  int prefix_len_1, prefix_len_2, cur_prefix_len, widget_len;
-
-  if (objc != 4)
-    {
-      Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
-      return TCL_ERROR; 
-    }
-
-  widget = Tcl_GetStringFromObj (objv[1], NULL);
-  if ( Tk_NameToWindow (interp, widget, Tk_MainWindow (interp)) == NULL)
-    {
-      return TCL_ERROR;
-    }
-  
-  file  = Tcl_GetStringFromObj (objv[2], NULL);
-  Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
-
-  if ((fp = fopen ( file, "r" )) == NULL)
-    {
-      Tcl_SetStringObj ( result_ptr->obj_ptr, "Can't open file for reading", -1);      
-      return TCL_ERROR;
-    }
-  
-  symtab = full_lookup_symtab (file);
-  if (!symtab)
-    {
-      Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);      
-      fclose (fp);
-      return TCL_ERROR;
-    }
-
-  if (stat (file, &st) < 0)
-    {
-      catch_errors (perror_with_name_wrapper, "gdbtk: get time stamp", "",
-                    RETURN_MASK_ALL);
-      return TCL_ERROR;
-    }
-
-  if (symtab && symtab->objfile && symtab->objfile->obfd)
-      mtime = bfd_get_mtime(symtab->objfile->obfd);
-  else if (exec_bfd)
-      mtime = bfd_get_mtime(exec_bfd);
-  if (mtime && mtime < st.st_mtime)
-     gdbtk_ignorable_warning("Source file is more recent than executable.\n");
-
-
-  /* Source linenumbers don't appear to be in order, and a sort is */
-  /* too slow so the fastest solution is just to allocate a huge */
-  /* array and set the array entry for each linenumber */
-
-  ltable_size = LTABLE_SIZE;
-  ltable = (char *)malloc (LTABLE_SIZE);
-  if (ltable == NULL)
-    {
-      Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
-      fclose (fp);
-      return TCL_ERROR;
-    }
-
-  memset (ltable, 0, LTABLE_SIZE);
-
-  if (symtab->linetable && symtab->linetable->nitems)
-    {
-      le = symtab->linetable->item;
-      for (ln = symtab->linetable->nitems ;ln > 0; ln--, le++)
-       {
-         lnum = le->line >> 3;
-         if (lnum >= ltable_size)
-           {
-             char *new_ltable;
-             new_ltable = (char *)realloc (ltable, ltable_size*2);
-             memset (new_ltable + ltable_size, 0, ltable_size);
-             ltable_size *= 2;
-             if (new_ltable == NULL)
-               {
-                 Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
-                 free (ltable);
-                 fclose (fp);
-                 return TCL_ERROR;
-               }
-             ltable = new_ltable;
-           }
-         ltable[lnum] |= 1 << (le->line % 8);
-       }
-    }
-    
-  Tcl_DStringInit(&text_cmd_1);
-  Tcl_DStringInit(&text_cmd_2);
-  
-  ln = 1;
-
-  widget_len = strlen (widget);
-  line[0] = '\t';
-  
-  Tcl_DStringAppend (&text_cmd_1, widget, widget_len);
-  Tcl_DStringAppend (&text_cmd_2, widget, widget_len);
-  
-  if (linenumbers)
-    {
-      Tcl_DStringAppend (&text_cmd_1, " insert end {-\t", -1);
-      prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
-
-      Tcl_DStringAppend (&text_cmd_2, " insert end { \t", -1);
-      prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
-      
-      while (fgets (line + 1, 980, fp))
-       {
-         sprintf (line_num_buf, "%d", ln);
-         if (ltable[ln >> 3] & (1 << (ln % 8)))
-           {
-             cur_cmd = &text_cmd_1;
-             cur_prefix_len = prefix_len_1;
-             Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
-             Tcl_DStringAppend (cur_cmd, "} break_tag", 11);
-           }
-         else
-           {
-             cur_cmd = &text_cmd_2;
-             cur_prefix_len = prefix_len_2;
-             Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
-             Tcl_DStringAppend (cur_cmd, "} \"\"", 4);
-           }
-
-         Tcl_DStringAppendElement (cur_cmd, line);
-         Tcl_DStringAppend (cur_cmd, " source_tag", 11);
-         
-         Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
-         Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
-         ln++;
-       }
-    }
-  else
-    {
-      Tcl_DStringAppend (&text_cmd_1, " insert end {-\t} break_tag", -1);
-      prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
-      Tcl_DStringAppend (&text_cmd_2, " insert end { \t} \"\"", -1);
-      prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
-
-  
-      while (fgets (line + 1, 980, fp))
-       {
-         if (ltable[ln >> 3] & (1 << (ln % 8)))
-           {
-             cur_cmd = &text_cmd_1;
-             cur_prefix_len = prefix_len_1;
-           }
-         else
-           {
-             cur_cmd = &text_cmd_2;
-             cur_prefix_len = prefix_len_2;
-           }
-
-         Tcl_DStringAppendElement (cur_cmd, line);
-         Tcl_DStringAppend (cur_cmd, " source_tag", 11);
-         
-         Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
-         Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
-         
-         ln++;
-       }
-    }
-
-  Tcl_DStringFree (&text_cmd_1);
-  Tcl_DStringFree (&text_cmd_2);
-  free (ltable);
-  fclose (fp);
-  return TCL_OK;
-}
-\f
-/*
- *  This section contains commands for manipulation of breakpoints.
- */
-
-
-/* set a breakpoint by source file and line number */
-/* flags are as follows: */
-/* least significant 2 bits are disposition, rest is */
-/* type (normally 0).
-
-enum bptype {
-  bp_breakpoint,                Normal breakpoint 
-  bp_hardware_breakpoint,      Hardware assisted breakpoint
-}
-
-Disposition of breakpoint.  Ie: what to do after hitting it.
-enum bpdisp {
-  del,                         Delete it
-  del_at_next_stop,            Delete at next stop, whether hit or not
-  disable,                     Disable it 
-  donttouch                    Leave it alone 
-  };
-*/
-
-/* This implements the tcl command "gdb_set_bp"
- * It sets breakpoints, and runs the Tcl command
- *     gdbtk_tcl_breakpoint create
- * to register the new breakpoint with the GUI.
- *
- * Tcl Arguments:
- *    filename: the file in which to set the breakpoint
- *    line:     the line number for the breakpoint
- *    type:     the type of the breakpoint
- * Tcl Result:
- *    The return value of the call to gdbtk_tcl_breakpoint.
- */
-
-static int
-gdb_set_bp (clientData, interp, objc, objv)
-  ClientData clientData;
-  Tcl_Interp *interp;
-  int objc;
-  Tcl_Obj *CONST objv[];
-
-{
-  struct symtab_and_line sal;
-  int line, flags, ret;
-  struct breakpoint *b;
-  char buf[64];
-  Tcl_DString cmd;
-
-  if (objc != 4)
-    {
-      Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
-      return TCL_ERROR; 
-    }
-  
-  sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
-  if (sal.symtab == NULL)
-    return TCL_ERROR;
-
-  if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
-    {
-      result_ptr->flags = GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-
-  if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
-    {
-      result_ptr->flags = GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-
-  sal.line = line;
-  if (!find_line_pc (sal.symtab, sal.line, &sal.pc))
-    return TCL_ERROR;
-
-  sal.section = find_pc_overlay (sal.pc);
-  b = set_raw_breakpoint (sal);
-  set_breakpoint_count (breakpoint_count + 1);
-  b->number = breakpoint_count;
-  b->type = flags >> 2;
-  b->disposition = flags & 3;
-
-  /* FIXME: this won't work for duplicate basenames! */
-  sprintf (buf, "%s:%d", basename (Tcl_GetStringFromObj ( objv[1], NULL)), line);
-  b->addr_string = strsave (buf);
-
-  /* now send notification command back to GUI */
-
-  Tcl_DStringInit (&cmd);
-
-  Tcl_DStringAppend (&cmd, "gdbtk_tcl_breakpoint create ", -1);
-  sprintf (buf, "%d", b->number);
-  Tcl_DStringAppendElement(&cmd, buf);
-  sprintf (buf, "0x%x", sal.pc);
-  Tcl_DStringAppendElement (&cmd, buf);
-  Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[2], NULL));
-  Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[1], NULL));
-
-  ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
-  Tcl_DStringFree (&cmd);
-  return ret;
-}
-
-/* This implements the tcl command gdb_get_breakpoint_info
- *
- *
- * Tcl Arguments:
- *   breakpoint_number
- * Tcl Result:
- *   A list with {file, function, line_number, address, type, enabled?,
- *                disposition, ignore_count, {list_of_commands}, thread, hit_count}
- */
-
-static int
-gdb_get_breakpoint_info (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct symtab_and_line sal;
-  static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
-                             "finish", "watchpoint", "hardware watchpoint",
-                             "read watchpoint", "access watchpoint",
-                             "longjmp", "longjmp resume", "step resume",
-                             "through sigtramp", "watchpoint scope",
-                             "call dummy" };
-  static char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
-  struct command_line *cmd;
-  int bpnum;
-  struct breakpoint *b;
-  extern struct breakpoint *breakpoint_chain;
-  char *funcname, *fname, *filename;
-  Tcl_Obj *new_obj;
-
-  if (objc != 2)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "wrong number of args, should be \"breakpoint\"", -1);
-      return TCL_ERROR;
-    }
-
-  if ( Tcl_GetIntFromObj(NULL, objv[1], &bpnum) != TCL_OK)
-    {
-      result_ptr->flags = GDBTK_IN_TCL_RESULT;
-      return TCL_ERROR;
-    }
-
-  for (b = breakpoint_chain; b; b = b->next)
-    if (b->number == bpnum)
-      break;
-
-  if (!b || b->type != bp_breakpoint)
-    {
-      Tcl_SetStringObj (result_ptr->obj_ptr, "Breakpoint #%d does not exist", -1);
-      return TCL_ERROR;
-    }
-
-  sal = find_pc_line (b->address, 0);
-
-  filename = symtab_to_filename (sal.symtab);
-  if (filename == NULL)
-    filename = "";
-
-  Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL);
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-         Tcl_NewStringObj (filename, -1));
-
-  find_pc_partial_function (b->address, &funcname, NULL, NULL);
-  fname = cplus_demangle (funcname, 0);
-  if (fname)
-    {
-      new_obj = Tcl_NewStringObj (fname, -1);
-      free (fname);
-    }
-  else
-    new_obj = Tcl_NewStringObj (funcname, -1);
-
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
-  
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->line_number));
-  sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%lx", b->address);
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                           Tcl_NewStringObj (bptypes[b->type], -1));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewBooleanObj(b->enable == enabled));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                           Tcl_NewStringObj (bpdisp[b->disposition], -1));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->ignore_count));
-
-  new_obj = Tcl_NewObj();
-  for (cmd = b->commands; cmd; cmd = cmd->next)
-    Tcl_ListObjAppendElement (NULL, new_obj,
-                             Tcl_NewStringObj (cmd->line, -1));
-  Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr, new_obj);
-                             
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
-                           Tcl_NewStringObj (b->cond_string, -1));
-
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->thread));
-  Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->hit_count));
-
-  return TCL_OK;
-}
-
-
-/* This implements the tcl command gdb_get_breakpoint_list
- * It builds up a list of the current breakpoints.
- *
- * Tcl Arguments:
- *    None.
- * Tcl Result:
- *    A list of breakpoint numbers.
- */
-
-static int
-gdb_get_breakpoint_list (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  struct breakpoint *b;
-  extern struct breakpoint *breakpoint_chain;
-  Tcl_Obj *new_obj;
-
-  if (objc != 1)
-    error ("wrong number of args, none are allowed");
-
-  for (b = breakpoint_chain; b; b = b->next)
-    if (b->type == bp_breakpoint)
-      {
-        new_obj = Tcl_NewIntObj (b->number);
-        Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
-      }
-
-  return TCL_OK;
-}
-
-\f
-/*
- * This section contains a bunch of miscellaneous utility commands
- */
-
-/* This implements the tcl command gdb_path_conv
- *
- * On Windows, it canonicalizes the pathname,
- * On Unix, it is a no op.
- *
- * Arguments:
- *    path
- * Tcl Result:
- *    The canonicalized path.
- */
-
-static int
-gdb_path_conv (clientData, interp, objc, objv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int objc;
-     Tcl_Obj *CONST objv[];
-{
-  if (objc != 2)
-    error ("wrong # args");
-  
-#ifdef WINNT
-  {
-    char pathname[256], *ptr;
-
-    cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj(objv[1], NULL), pathname);
-    for (ptr = pathname; *ptr; ptr++)
-      {
-       if (*ptr == '\\')
-         *ptr = '/';
-      }
-    Tcl_SetStringObj (result_ptr->obj_ptr, pathname, -1);
-  }
-#else
-  Tcl_SetStringObj (result_ptr->obj_ptr, Tcl_GetStringFromObj (objv[1], NULL), -1);
-#endif
-
-  return TCL_OK;
-}
-\f
-/*
- * This section has utility routines that are not Tcl commands.
- */
-
-static int
-perror_with_name_wrapper (args)
-  char * args;
-{
-  perror_with_name (args);
-  return 1;
-}
-
-/* The lookup_symtab() in symtab.c doesn't work correctly */
-/* It will not work will full pathnames and if multiple */
-/* source files have the same basename, it will return */
-/* the first one instead of the correct one.  This version */
-/* also always makes sure symtab->fullname is set. */
-
-static struct symtab *
-full_lookup_symtab(file)
-     char *file;
-{
-  struct symtab *st;
-  struct objfile *objfile;
-  char *bfile, *fullname;
-  struct partial_symtab *pt;
-
-  if (!file)
-    return NULL;
-
-  /* first try a direct lookup */
-  st = lookup_symtab (file);
-  if (st)
-    {
-      if (!st->fullname)
-         symtab_to_filename(st);
-      return st;
-    }
-  
-  /* if the direct approach failed, try */
-  /* looking up the basename and checking */
-  /* all matches with the fullname */
-  bfile = basename (file);
-  ALL_SYMTABS (objfile, st)
-    {
-      if (!strcmp (bfile, basename(st->filename)))
-       {
-         if (!st->fullname)
-           fullname = symtab_to_filename (st);
-         else
-           fullname = st->fullname;
-
-         if (!strcmp (file, fullname))
-           return st;
-       }
-    }
-  
-  /* still no luck?  look at psymtabs */
-  ALL_PSYMTABS (objfile, pt)
-    {
-      if (!strcmp (bfile, basename(pt->filename)))
-       {
-         st = PSYMTAB_TO_SYMTAB (pt);
-         if (st)
-           {
-             fullname = symtab_to_filename (st);
-             if (!strcmp (file, fullname))
-               return st;
-           }
-       }
-    }
-  return NULL;
-}
diff --git a/gdb/gdbtk_hooks.c b/gdb/gdbtk_hooks.c
deleted file mode 100644 (file)
index f87efe1..0000000
+++ /dev/null
@@ -1,689 +0,0 @@
-/* Startup code for gdbtk.
-   Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
-
-   Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
-
-This file is part of GDB.
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
-
-#include "defs.h"
-#include "symtab.h"
-#include "inferior.h"
-#include "command.h"
-#include "bfd.h"
-#include "symfile.h"
-#include "objfiles.h"
-#include "target.h"
-#include "gdbcore.h"
-#include "tracepoint.h"
-#include "demangle.h"
-
-#ifdef _WIN32
-#include <winuser.h>
-#endif
-
-#include <sys/stat.h>
-
-#include <tcl.h>
-#include <tk.h>
-#include <itcl.h> 
-#include <tix.h> 
-#include "guitcl.h"
-#include "gdbtk.h"
-
-#ifdef IDE
-/* start-sanitize-ide */
-#include "event.h"
-#include "idetcl.h"
-#include "ilutk.h"
-/* end-sanitize-ide */
-#endif
-
-#ifdef ANSI_PROTOTYPES
-#include <stdarg.h>
-#else
-#include <varargs.h>
-#endif
-#include <signal.h>
-#include <fcntl.h>
-#include <unistd.h>
-#include <setjmp.h>
-#include "top.h"
-#include <sys/ioctl.h>
-#include "gdb_string.h"
-#include "dis-asm.h"
-#include <stdio.h>
-#include "gdbcmd.h"
-
-#include "annotate.h"
-#include <sys/time.h>
-
-int in_fputs = 0;
-
-int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
-void (*pre_add_symbol_hook) PARAMS ((char *));
-void (*post_add_symbol_hook) PARAMS ((void));
-
-#ifdef __CYGWIN32__
-extern void (*ui_loop_hook) PARAMS ((int));
-#endif
-static void   gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
-static void   gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
-static void   gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
-static void   gdbtk_create_breakpoint PARAMS ((struct breakpoint *));
-static void   gdbtk_delete_breakpoint PARAMS ((struct breakpoint *));
-static void   gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
-static void   tk_command_loop PARAMS ((void));
-static void   gdbtk_call_command PARAMS ((struct cmd_list_element *, char *, int));
-static int    gdbtk_wait PARAMS ((int, struct target_waitstatus *));
-       void   x_event PARAMS ((int));
-static int    gdbtk_query PARAMS ((const char *, va_list));
-static void   gdbtk_warning PARAMS ((const char *, va_list));
-void   gdbtk_ignorable_warning PARAMS ((const char *));
-static char*  gdbtk_readline PARAMS ((char *));
-static void
-#ifdef ANSI_PROTOTYPES
-gdbtk_readline_begin (char *format, ...);
-#else
-gdbtk_readline_begin ();
-#endif
-static void gdbtk_readline_end PARAMS ((void));
-static void   gdbtk_flush PARAMS ((FILE *));
-static void gdbtk_pre_add_symbol PARAMS ((char *));
-static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
-static void gdbtk_post_add_symbol PARAMS ((void));
-static void pc_changed PARAMS ((void));
-static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
-
-/*
- * gdbtk_fputs can't be static, because we need to call it in gdbtk.c.
- * See note there for details.
- */
-
-void   gdbtk_fputs PARAMS ((const char *, FILE *));
-int           gdbtk_load_hash PARAMS ((char *, unsigned long));
-static void   breakpoint_notify PARAMS ((struct breakpoint *, const char *));
-
-/*
- * gdbtk_add_hooks - add all the hooks to gdb.  This will get called by the
- * startup code to fill in the hooks needed by core gdb.
- */
-
-void
-gdbtk_add_hooks(void)
-{
-  command_loop_hook = tk_command_loop;
-  call_command_hook = gdbtk_call_command;
-  readline_begin_hook = gdbtk_readline_begin;
-  readline_hook = gdbtk_readline;
-  readline_end_hook = gdbtk_readline_end;
-
-  print_frame_info_listing_hook = gdbtk_print_frame_info;
-  query_hook = gdbtk_query;
-  warning_hook = gdbtk_warning;
-  flush_hook = gdbtk_flush;
-
-  create_breakpoint_hook = gdbtk_create_breakpoint;
-  delete_breakpoint_hook = gdbtk_delete_breakpoint;
-  modify_breakpoint_hook = gdbtk_modify_breakpoint;
-
-  interactive_hook = gdbtk_interactive;
-  target_wait_hook = gdbtk_wait;
-  ui_load_progress_hook = gdbtk_load_hash;
-#ifdef __CYGWIN32__
-  ui_loop_hook = x_event;
-#endif
-  pre_add_symbol_hook   = gdbtk_pre_add_symbol;
-  post_add_symbol_hook  = gdbtk_post_add_symbol;
-
-  create_tracepoint_hook = gdbtk_create_tracepoint;
-  delete_tracepoint_hook = gdbtk_delete_tracepoint;
-  modify_tracepoint_hook = gdbtk_modify_tracepoint;
-  pc_changed_hook = pc_changed;
-
-}
-
-/* These control where to put the gdb output which is created by
-   {f}printf_{un}filtered and friends.  gdbtk_fputs and gdbtk_flush are the
-   lowest level of these routines and capture all output from the rest of GDB.
-
-   The reason to use the result_ptr rather than the gdbtk_interp's result
-   directly is so that a call_wrapper invoked function can preserve its result
-   across calls into Tcl which might be made in the course of the function's
-   execution.
-   
-   * result_ptr->obj_ptr is where to accumulate the result.
-   * GDBTK_TO_RESULT flag means the output goes to the gdbtk_tcl_fputs proc
-     instead of to the result_ptr.
-   * GDBTK_MAKES_LIST flag means add to the result as a list element.
-
-   */
-
-gdbtk_result *result_ptr = NULL;
-\f
-
-/* This allows you to Tcl_Eval a tcl command which takes
-   a command word, and then a single argument. */
-  
-int gdbtk_two_elem_cmd (cmd_name, argv1)
-    char *cmd_name;
-    char * argv1;
-{
-  char *command;
-  int result, flags_ptr, arg_len, cmd_len;
-
-  arg_len = Tcl_ScanElement (argv1, &flags_ptr);
-  cmd_len = strlen (cmd_name);
-  command = malloc(arg_len + cmd_len + 2);
-  strcpy (command, cmd_name);
-  strcat (command, " ");
-  
-  Tcl_ConvertElement (argv1, command + cmd_len + 1, flags_ptr);
-
-  result = Tcl_Eval (gdbtk_interp, command);
-  free (command);
-  return result;
-  
-}
-
-static void
-gdbtk_flush (stream)
-     FILE *stream;
-{
-#if 0
-  /* Force immediate screen update */
-
-  Tcl_VarEval (gdbtk_interp, "gdbtk_tcl_flush", NULL);
-#endif
-}
-
-/* This handles all the output from gdb.  All the gdb printf_xxx functions
- * eventually end up here.  The output is either passed to the result_ptr
- * where it will go to the result of some gdbtk command, or passed to the
- * Tcl proc gdbtk_tcl_fputs (where it is usually just dumped to the console
- * window.
- *
- * The cases are:
- *
- * 1) result_ptr == NULL - This happens when some output comes from gdb which
- *    is not generated by a command in gdbtk_cmds, usually startup stuff.
- *    In this case we just route the data to gdbtk_tcl_fputs.
- * 2) The GDBTK_TO_RESULT flag is set - The result is supposed to go to Tcl.
- *    We place the data into the result_ptr, either as a string,
- *    or a list, depending whether the GDBTK_MAKES_LIST bit is set.
- * 3) The GDBTK_TO_RESULT flag is unset - We route the data to gdbtk_tcl_fputs
- *    UNLESS it was coming to stderr.  Then we place it in the result_ptr
- *    anyway, so it can be dealt with.
- *
- */
-
-void
-gdbtk_fputs (ptr, stream)
-     const char *ptr;
-     FILE *stream;
-{
-  in_fputs = 1;
-
-  if (result_ptr != NULL)
-    {
-      if (result_ptr->flags & GDBTK_TO_RESULT)
-       {
-         if (result_ptr->flags & GDBTK_MAKES_LIST)
-           Tcl_ListObjAppendElement(NULL, result_ptr->obj_ptr, 
-                                    Tcl_NewStringObj((char *) ptr, -1));
-         else                           
-           Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
-       }
-      else if (stream == gdb_stderr)
-       {
-         if (result_ptr->flags & GDBTK_ERROR_STARTED)
-           Tcl_AppendToObj (result_ptr->obj_ptr, (char *) ptr, -1);
-         else
-           {
-             Tcl_SetStringObj (result_ptr->obj_ptr, (char *) ptr, -1);
-             result_ptr->flags |= GDBTK_ERROR_STARTED;
-           }
-       }
-      else
-       {
-         gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
-         if (result_ptr->flags & GDBTK_MAKES_LIST)
-             gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", " ");
-       }
-    }
-  else
-    {
-      gdbtk_two_elem_cmd ("gdbtk_tcl_fputs", (char *) ptr);
-    }
-  
-  in_fputs = 0;
-}
-
-/*
- * This routes all warnings to the Tcl function "gdbtk_tcl_warning".
- */
-
-static void
-gdbtk_warning (warning, args)
-     const char *warning;
-     va_list args;
-{
-  char buf[200];
-
-  vsprintf (buf, warning, args);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_warning", buf);
-
-}
-
-/*
- * This routes all ignorable warnings to the Tcl function
- * "gdbtk_tcl_ignorable_warning".
- */
-
-void
-gdbtk_ignorable_warning (warning)
-     const char *warning;
-{
-  char buf[200], *merge[2];
-  char *command;
-
-  sprintf (buf, warning);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_ignorable_warning", buf);
-
-}
-
-
-
-static void
-pc_changed()
-{
-  Tcl_Eval (gdbtk_interp, "gdbtk_pc_changed");
-}
-
-\f
-/* This function is called instead of gdb's internal command loop.  This is the
-   last chance to do anything before entering the main Tk event loop. 
-   At the end of the command, we enter the main loop. */
-
-static void
-tk_command_loop ()
-{
-  extern GDB_FILE *instream;
-
-  /* We no longer want to use stdin as the command input stream */
-  instream = NULL;
-
-  if (Tcl_Eval (gdbtk_interp, "gdbtk_tcl_preloop") != TCL_OK)
-    {
-      char *msg;
-
-      /* Force errorInfo to be set up propertly.  */
-      Tcl_AddErrorInfo (gdbtk_interp, "");
-
-      msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
-#ifdef _WIN32
-      MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
-#else
-      fputs_unfiltered (msg, gdb_stderr);
-#endif
-    }
-
-#ifdef _WIN32
-  close_bfds ();
-#endif
-
-  Tk_MainLoop ();
-}
-
-/* Come here when there is activity on the X file descriptor. */
-
-void
-x_event (signo)
-     int signo;
-{
-  static int in_x_event = 0;
-  static Tcl_Obj *varname = NULL;
-  if (in_x_event || in_fputs)
-    return; 
-
-  in_x_event = 1;
-
-#ifdef __CYGWIN32__
-  if (signo == -2)
-    gdbtk_stop_timer ();
-#endif
-
-  /* Process pending events */
-  while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
-    ;
-
-  if (load_in_progress)
-    {
-      int val;
-      if (varname == NULL)
-       {
-         Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
-         varname = Tcl_ObjGetVar2(gdbtk_interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
-       }
-      if ((Tcl_GetIntFromObj(gdbtk_interp,varname,&val) == TCL_OK) && val)
-       {
-         quit_flag = 1;
-#ifdef REQUEST_QUIT
-         REQUEST_QUIT;
-#else
-         if (immediate_quit) 
-           quit ();
-#endif
-       }
-    }
-  in_x_event = 0;
-}
-
-/* VARARGS */
-static void
-#ifdef ANSI_PROTOTYPES
-gdbtk_readline_begin (char *format, ...)
-#else
-gdbtk_readline_begin (va_alist)
-     va_dcl
-#endif
-{
-  va_list args;
-  char buf[200], *merge[2];
-  char *command;
-
-#ifdef ANSI_PROTOTYPES
-  va_start (args, format);
-#else
-  char *format;
-  va_start (args);
-  format = va_arg (args, char *);
-#endif
-
-  vsprintf (buf, format, args);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_readline_begin", buf);
-
-}
-
-static char *
-gdbtk_readline (prompt)
-     char *prompt;
-{
-  int result;
-
-#ifdef _WIN32
-  close_bfds ();
-#endif
-
-  result = gdbtk_two_elem_cmd ("gdbtk_tcl_readline", prompt);
-
-  if (result == TCL_OK)
-    {
-      return (strdup (gdbtk_interp -> result));
-    }
-  else
-    {
-      gdbtk_fputs (gdbtk_interp -> result, gdb_stdout);
-      gdbtk_fputs ("\n", gdb_stdout);
-      return (NULL);
-    }
-}
-
-static void
-gdbtk_readline_end ()
-{
-  Tcl_Eval (gdbtk_interp, "gdbtk_tcl_readline_end");
-}
-
-static void
-gdbtk_call_command (cmdblk, arg, from_tty)
-     struct cmd_list_element *cmdblk;
-     char *arg;
-     int from_tty;
-{
-  running_now = 0;
-  if (cmdblk->class == class_run || cmdblk->class == class_trace)
-    {
-
-/* HACK! HACK! This is to get the gui to update the tstart/tstop
-   button only incase of tstart/tstop commands issued from the console
-   We don't want to update the src window, so we need to have specific
-   procedures to do tstart and tstop
-   Unfortunately this will not display errors from tstart or tstop in the 
-   console window itself, but as dialogs.*/
-
-      if (!strcmp(cmdblk->name, "tstart") && !No_Update)
-        {
-              Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstart"); 
-              (*cmdblk->function.cfunc)(arg, from_tty);
-        }
-      else if (!strcmp(cmdblk->name, "tstop") && !No_Update) 
-             {
-              Tcl_Eval (gdbtk_interp, "gdbtk_tcl_tstop"); 
-              (*cmdblk->function.cfunc)(arg, from_tty);
-             }
-/* end of hack */
-           else 
-             {
-                 running_now = 1;
-                 if (!No_Update)
-                   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_busy");
-                 (*cmdblk->function.cfunc)(arg, from_tty);
-                 running_now = 0;
-                 if (!No_Update)
-                   Tcl_Eval (gdbtk_interp, "gdbtk_tcl_idle");
-             }
-    }
-  else
-    (*cmdblk->function.cfunc)(arg, from_tty);
-}
-
-/* The next three functions use breakpoint_notify to allow the GUI 
- * to handle creating, deleting and modifying breakpoints.  These three
- * functions are put into the appropriate gdb hooks in gdbtk_init.
- */
-
-static void
-gdbtk_create_breakpoint(b)
-     struct breakpoint *b;
-{
-  breakpoint_notify (b, "create");
-}
-
-static void
-gdbtk_delete_breakpoint(b)
-     struct breakpoint *b;
-{
-  breakpoint_notify (b, "delete");
-}
-
-static void
-gdbtk_modify_breakpoint(b)
-     struct breakpoint *b;
-{
-  breakpoint_notify (b, "modify");
-}
-
-/* This is the generic function for handling changes in
- * a breakpoint.  It routes the information to the Tcl
- * command "gdbtk_tcl_breakpoint" in the form:
- *   gdbtk_tcl_breakpoint action b_number b_address b_line b_file
- * On error, the error string is written to gdb_stdout.
- */
-
-static void
-breakpoint_notify(b, action)
-     struct breakpoint *b;
-     const char *action;
-{
-  char buf[256];
-  int v;
-  struct symtab_and_line sal;
-  char *filename;
-
-  if (b->type != bp_breakpoint)
-    return;
-
-  /* We ensure that ACTION contains no special Tcl characters, so we
-     can do this.  */
-  sal = find_pc_line (b->address, 0);
-  filename = symtab_to_filename (sal.symtab);
-  if (filename == NULL)
-    filename = "";
-
-  sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number, 
-          (long)b->address, b->line_number, filename);
-
-  v = Tcl_Eval (gdbtk_interp, buf);
-
-  if (v != TCL_OK)
-    {
-      gdbtk_fputs (Tcl_GetStringResult (gdbtk_interp), gdb_stdout);
-      gdbtk_fputs ("\n", gdb_stdout);
-    }
-}
-
-int
-gdbtk_load_hash (section, num)
-     char *section;
-     unsigned long num;
-{
-  char buf[128];
-  sprintf (buf, "download_hash %s %ld", section, num);
-  Tcl_Eval (gdbtk_interp, buf); 
-  return  atoi (gdbtk_interp->result);
-}
-
-
-/* This hook is called whenever we are ready to load a symbol file so that
-   the UI can notify the user... */
-static void
-gdbtk_pre_add_symbol (name)
-  char *name;
-{
-
-  gdbtk_two_elem_cmd("gdbtk_tcl_pre_add_symbol", name);
-
-}
-
-/* This hook is called whenever we finish loading a symbol file. */
-static void
-gdbtk_post_add_symbol ()
-{
-  Tcl_Eval (gdbtk_interp, "gdbtk_tcl_post_add_symbol");
-}
-
-/* This hook function is called whenever we want to wait for the
-   target.  */
-
-static int
-gdbtk_wait (pid, ourstatus)
-     int pid;
-     struct target_waitstatus *ourstatus;
-{
-  gdbtk_start_timer ();
-  pid = target_wait (pid, ourstatus);
-  gdbtk_stop_timer ();
-  return pid;
-}
-
-/*
- * This handles all queries from gdb.
- * The first argument is a printf style format statement, the rest are its
- * arguments.  The resultant formatted string is passed to the Tcl function
- * "gdbtk_tcl_query".  
- * It returns the users response to the query, as well as putting the value
- * in the result field of the Tcl interpreter.
- */
-
-static int
-gdbtk_query (query, args)
-     const char *query;
-     va_list args;
-{
-  char buf[200];
-  long val;
-
-  vsprintf (buf, query, args);
-  gdbtk_two_elem_cmd ("gdbtk_tcl_query", buf);
-  val = atol (gdbtk_interp->result);
-  return val;
-}
-
-
-static void
-gdbtk_print_frame_info (s, line, stopline, noerror)
-  struct symtab *s;
-  int line;
-  int stopline;
-  int noerror;
-{
-  current_source_symtab = s;
-  current_source_line = line;
-}
-
-static void
-gdbtk_create_tracepoint (tp)
-  struct tracepoint *tp;
-{
-  tracepoint_notify (tp, "create");
-}
-
-static void
-gdbtk_delete_tracepoint (tp)
-  struct tracepoint *tp;
-{
-  tracepoint_notify (tp, "delete");
-}
-
-static void
-gdbtk_modify_tracepoint (tp)
-  struct tracepoint *tp;
-{
-  tracepoint_notify (tp, "modify");
-}
-
-static void
-tracepoint_notify(tp, action)
-     struct tracepoint *tp;
-     const char *action;
-{
-  char buf[256];
-  int v;
-  struct symtab_and_line sal;
-  char *filename;
-
-  /* We ensure that ACTION contains no special Tcl characters, so we
-     can do this.  */
-  sal = find_pc_line (tp->address, 0);
-
-  filename = symtab_to_filename (sal.symtab);
-  if (filename == NULL)
-    filename = "N/A";
-  sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number, 
-          (long)tp->address, sal.line, filename, tp->pass_count);
-
-  v = Tcl_Eval (gdbtk_interp, buf);
-
-  if (v != TCL_OK)
-    {
-      gdbtk_fputs (gdbtk_interp->result, gdb_stdout);
-      gdbtk_fputs ("\n", gdb_stdout);
-    }
-}
-
-