* gdb.asm/{Makefile.in,configure.in,configure}: New files.
[deliverable/binutils-gdb.git] / gdb / gdbtk.c
index d562e296358e21977496fc36eb9b36105f9e1812..f335a685027aafb91d40aa1a535586d08bf60bce 100644 (file)
@@ -1,5 +1,5 @@
 /* Tcl/Tk interface routines.
-   Copyright 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+   Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
 
    Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
 
@@ -38,10 +38,10 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #include <tk.h>
 #include <itcl.h> 
 #include <tix.h> 
+#include "guitcl.h"
 
 #ifdef IDE
 /* start-sanitize-ide */
-#include "guitcl.h"
 #include "event.h"
 #include "idetcl.h"
 #include "ilutk.h"
@@ -86,8 +86,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #undef SIOCSPGRP
 #endif
 
+static int load_in_progress = 0;
+
 int gdbtk_load_hash PARAMS ((char *, unsigned long));
 int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
+void (*pre_add_symbol_hook) PARAMS ((char *));
+void (*post_add_symbol_hook) PARAMS ((void));
 
 static void null_routine PARAMS ((int));
 static void gdbtk_flush PARAMS ((FILE *));
@@ -109,10 +113,11 @@ static int gdb_path_conv PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static int gdb_confirm_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static int gdb_force_quit PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
-static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
+static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
+static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static void gdbtk_readline_end PARAMS ((void));
 static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
@@ -132,6 +137,7 @@ static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static void get_register PARAMS ((int, void *));
 static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+void TclDebug PARAMS ((const char *fmt, ...));
 static int gdb_get_vars_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[]));
@@ -140,9 +146,16 @@ static int gdb_tracepoint_exists_command PARAMS ((ClientData, Tcl_Interp *, int,
 static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static char *find_file_in_dir PARAMS ((char *));
+static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 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 tracepoint_notify PARAMS ((struct tracepoint *, const char *));
+static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
+void gdbtk_pre_add_symbol PARAMS ((char *));
+void gdbtk_post_add_symbol PARAMS ((void));
 
 /* Handle for TCL interpreter */
 
@@ -152,6 +165,19 @@ static Tcl_Interp *interp = NULL;
 static int x_fd;               /* X network socket */
 #endif
 
+#ifdef __CYGWIN32__
+
+/* On Windows we use timer interrupts when gdb might otherwise hang
+   for a long time.  See the comment above gdbtk_start_timer.  This
+   variable is true when timer interrupts are being used.  */
+
+static int gdbtk_timer_going = 0;
+
+static void gdbtk_start_timer PARAMS ((void));
+static void gdbtk_stop_timer PARAMS ((void));
+
+#endif
+
 /* This variable is true when the inferior is running.  Although it's
    possible to disable most input from widgets and thus prevent
    attempts to do anything while the inferior is running, any commands
@@ -481,7 +507,7 @@ gdb_get_breakpoint_info (clientData, interp, argc, argv)
 
   filename = symtab_to_filename (sal.symtab);
   if (filename == NULL)
-    filename = "N/A";
+    filename = "";
   Tcl_DStringAppendElement (result_ptr, filename);
   find_pc_partial_function (b->address, &funcname, NULL, NULL);
   Tcl_DStringAppendElement (result_ptr, funcname);
@@ -580,8 +606,15 @@ gdb_loc (clientData, interp, argc, argv)
 
   if (argc == 1)
     {
-      pc = selected_frame ? selected_frame->pc : stop_pc;
-      sal = find_pc_line (pc, 0);
+      if (selected_frame)
+       {
+         sal = find_pc_line (selected_frame->pc,
+                             selected_frame->next != NULL
+                             && !selected_frame->next->signal_handler_caller
+                             && !frame_in_dummy (selected_frame->next));
+       }
+      else
+       sal = find_pc_line (stop_pc, 0);
     }
   else if (argc == 2)
     {
@@ -596,12 +629,11 @@ gdb_loc (clientData, interp, argc, argv)
 
       if (sals.nelts != 1)
        error ("Ambiguous line spec");
-
-      pc = sal.pc;
     }
   else
     error ("wrong # args");
 
+  pc = sal.pc;
   if (sal.symtab)
     Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
   else
@@ -613,14 +645,11 @@ gdb_loc (clientData, interp, argc, argv)
   filename = symtab_to_filename (sal.symtab);
   if (filename == NULL)
     filename = "N/A";
-  Tcl_DStringAppendElement (result_ptr, filename);
 
+  Tcl_DStringAppendElement (result_ptr, filename);
   dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
-
   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
-
   dsprintf_append_element (result_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
-
   return TCL_OK;
 }
 \f
@@ -975,6 +1004,36 @@ gdb_changed_register_list (clientData, interp, argc, argv)
   return map_arg_registers (argc, argv, register_changed_p, NULL);
 }
 \f
+/* This implements the tcl command "gdb_immediate", which does exactly
+   the same thing as gdb_cmd, except NONE of its outut is buffered. */
+static int
+gdb_immediate_command (clientData, interp, argc, argv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int argc;
+     char *argv[];
+{
+  Tcl_DString *save_ptr = NULL;
+
+  if (argc != 2)
+    error ("wrong # args");
+
+  if (running_now)
+    return TCL_OK;
+
+  Tcl_DStringAppend (result_ptr, "", -1);
+  save_ptr = result_ptr;
+  result_ptr = NULL;
+
+  execute_command (argv[1], 1);
+
+  bpstat_do_actions (&stop_bpstat);
+  
+  result_ptr = save_ptr;
+
+  return TCL_OK;
+}
+
 /* This implements the TCL command `gdb_cmd', which sends its argument into
    the GDB command scanner.  */
 
@@ -997,14 +1056,30 @@ gdb_cmd (clientData, interp, argc, argv)
      set result_ptr to NULL so gdbtk_fputs() will not buffer
      all the data until the command is finished. */
 
-  if (strncmp("load ",argv[1],5) == 0) {
-    Tcl_DStringAppend (result_ptr, "", -1);
-    save_ptr = result_ptr;
-    result_ptr = NULL;
-  }
+  if (strncmp ("load ", argv[1], 5) == 0
+      || strncmp ("while ", argv[1], 6) == 0)
+    {
+      Tcl_DStringAppend (result_ptr, "", -1);
+      save_ptr = result_ptr;
+      result_ptr = NULL;
+      load_in_progress = 1;
+      
+      /* On Windows, use timer interrupts so that the user can cancel
+        the download.  FIXME: We may have to do something on other
+        systems.  */
+#ifdef __CYGWIN32__
+      gdbtk_start_timer ();
+#endif
+    }
 
   execute_command (argv[1], 1);
 
+#ifdef __CYGWIN32__
+  if (load_in_progress)
+    gdbtk_stop_timer ();
+#endif
+
+  load_in_progress = 0;
   bpstat_do_actions (&stop_bpstat);
   
   if (save_ptr) 
@@ -1069,8 +1144,13 @@ call_wrapper (clientData, interp, argc, argv)
     {
       wrapped_args.val = TCL_ERROR;    /* Flag an error for TCL */
 
-      gdb_flush (gdb_stderr);  /* Flush error output */
+#ifdef __CYGWIN32__
+      /* Make sure the timer interrupts are turned off.  */
+      if (gdbtk_timer_going)
+       gdbtk_stop_timer ();
+#endif
 
+      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
@@ -1081,6 +1161,14 @@ call_wrapper (clientData, interp, argc, argv)
       Tcl_Eval (interp, "gdbtk_tcl_idle");
     }
 
+  /* if the download was cancelled, don't print the error */
+  if (load_in_progress) 
+    {
+      Tcl_DStringInit (&error_string);
+      wrapped_args.val = TCL_OK;
+      load_in_progress = 0;
+    }
+
   if (Tcl_DStringLength (&error_string) == 0)
     {
       Tcl_DStringResult (interp, &result);
@@ -1090,6 +1178,7 @@ call_wrapper (clientData, interp, argc, argv)
     {
       Tcl_DStringResult (interp, &error_string);
       Tcl_DStringFree (&result);
+      Tcl_DStringFree (&error_string);
     }
   else
     {
@@ -1111,22 +1200,88 @@ call_wrapper (clientData, interp, argc, argv)
 }
 
 static int
-gdb_listfiles (clientData, interp, argc, argv)
-     ClientData clientData;
-     Tcl_Interp *interp;
-     int argc;
-     char *argv[];
+comp_files (file1, file2)
+     const char *file1[], *file2[];
+{
+  return strcmp(*file1,*file2);
+}
+
+
+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);
+
+  mylist = Tcl_NewListObj (0, NULL);
 
   ALL_PSYMTABS (objfile, psymtab)
-    Tcl_DStringAppendElement (result_ptr, psymtab->filename);
+    {
+      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)
-    Tcl_DStringAppendElement (result_ptr, symtab->filename);
+    {
+      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 = "";
+  for (i = 0; i < numfiles; i++)
+    {
+      if (strcmp(files[i],lastfile))
+       Tcl_ListObjAppendElement (interp, mylist, Tcl_NewStringObj(files[i], -1));
+      lastfile = files[i];
+    }
+  Tcl_SetObjResult (interp, mylist);
+  free (files);
   return TCL_OK;
 }
 
@@ -1211,6 +1366,11 @@ gdb_clear_file (clientData, interp, argc, argv)
 
   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;
 }
 
@@ -1549,7 +1709,27 @@ x_event (signo)
 {
   /* Process pending events */
 
-  while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0);
+  while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
+    ;
+
+  /* If we are doing a download, see if the download should be
+     cancelled.  FIXME: We should use a better variable name.  */
+  if (load_in_progress)
+    {
+      char *val;
+
+      val = Tcl_GetVar (interp, "download_cancel_ok", TCL_GLOBAL_ONLY);
+      if (val != NULL && atoi (val))
+       {
+         quit_flag = 1;
+#ifdef REQUEST_QUIT
+         REQUEST_QUIT;
+#else
+         if (immediate_quit) 
+           quit ();
+#endif
+       }
+    }
 }
 
 #ifdef __CYGWIN32__
@@ -1580,6 +1760,8 @@ gdbtk_start_timer ()
   it.it_value.tv_usec = 500 * 1000;
 
   setitimer (ITIMER_REAL, &it, NULL);
+
+  gdbtk_timer_going = 1;
 }
 
 static void
@@ -1589,6 +1771,8 @@ gdbtk_stop_timer ()
   struct sigaction action;
   struct itimerval it;
 
+  gdbtk_timer_going = 0;
+
   sigemptyset (&nullsigmask);
 
   action.sa_handler = SIG_IGN;
@@ -1630,6 +1814,11 @@ gdbtk_wait (pid, ourstatus)
 #endif /* WINNT */
 
 #ifdef __CYGWIN32__
+  /* Call x_event ourselves now, as well as starting the timer;
+     otherwise, if single stepping, we may never wait long enough for
+     the timer to trigger.  */
+  x_event (SIGALRM);
+
   gdbtk_start_timer ();
 #endif
 
@@ -1843,15 +2032,17 @@ gdbtk_init ( argv0 )
   /* An interface to ShellExecute.  */
   if (ide_create_shell_execute_command (interp) != TCL_OK)
     error ("shell execute command initialization failed");
+  /* end-sanitize-ide */
 #endif
 
   Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
+  Tcl_CreateCommand (interp, "gdb_immediate", call_wrapper,
+                     gdb_immediate_command, NULL);
   Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
   Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
   Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
                     NULL);
-  Tcl_CreateCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
-                    NULL);
+  Tcl_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
   Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
                     NULL);
   Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
@@ -1897,10 +2088,13 @@ gdbtk_init ( argv0 )
                         gdb_actions_command, NULL, NULL);
   Tcl_CreateObjCommand (interp, "gdb_prompt",
                         gdb_prompt_command, NULL, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_find_file",
+                        gdb_find_file_command, NULL, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
+                        gdb_get_tracepoint_list, NULL, NULL);
   
   command_loop_hook = tk_command_loop;
-  print_frame_info_listing_hook =
-    (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
+  print_frame_info_listing_hook = gdbtk_print_frame_info;
   query_hook = gdbtk_query;
   flush_hook = gdbtk_flush;
   create_breakpoint_hook = gdbtk_create_breakpoint;
@@ -1913,8 +2107,11 @@ gdbtk_init ( argv0 )
   readline_hook = gdbtk_readline;
   readline_end_hook = gdbtk_readline_end;
   ui_load_progress_hook = gdbtk_load_hash;
+  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;
 
 #ifndef WINNT
   /* Get the file descriptor for the X server */
@@ -2155,11 +2352,10 @@ gdbtk_load_hash (section, num)
      char *section;
      unsigned long num;
 {
-  int result;
   char buf[128];
   sprintf (buf, "download_hash %s %ld", section, num);
-  result = Tcl_Eval (interp, buf); 
-  return result;
+  Tcl_Eval (interp, buf); 
+  return  atoi (interp->result);
 }
 
 /* gdb_get_vars_command -
@@ -2367,11 +2563,11 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
      Tcl_Obj  *CONST objv[];
 {
   struct symtab_and_line sal;
-  struct command_line *cmd;
   int tpnum;
   struct tracepoint *tp;
   struct action_line *al;
   Tcl_Obj *list, *action_list;
+  char *filename, *funcname;
   char tmp[19];
   
   if (objc != 2)
@@ -2387,13 +2583,15 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
     error ("Tracepoint #%d does not exist", tpnum);
 
   list = Tcl_NewListObj (0, NULL);
-  if (tp->source_file != NULL)
-    Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tp->source_file, -1));
-  else
-    Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj ("N/A", -1));
-  Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->line_number));
-  /* the function part is not currently used by the frontend */
-  Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj ("function", -1));
+  sal = find_pc_line (tp->address, 0);
+  filename = symtab_to_filename (sal.symtab);
+  if (filename == NULL)
+    filename = "N/A";
+  Tcl_ListObjAppendElement (interp, list,
+                            Tcl_NewStringObj (filename, -1));
+  find_pc_partial_function (tp->address, &funcname, NULL, NULL);
+  Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (funcname, -1));
+  Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (sal.line));
   sprintf (tmp, "0x%08x", tp->address);
   Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
@@ -2429,23 +2627,32 @@ gdbtk_delete_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];
-  char *source;
   int v;
+  struct symtab_and_line sal;
+  char *filename;
 
   /* We ensure that ACTION contains no special Tcl characters, so we
      can do this.  */
-  if (tp->source_file != NULL)
-    source = tp->source_file;
-  else
-    source = "N/A";
+  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, tp->line_number, source);
+          (long)tp->address, sal.line, filename);
 
   v = Tcl_Eval (interp, buf);
 
@@ -2505,6 +2712,7 @@ gdb_actions_command (clientData, interp, objc, objv)
   Tcl_Obj **actions;
   int      nactions, i, len;
   char *number, *args, *action;
+  long step_count;
   struct action_line *next = NULL, *temp;
 
   if (objc != 3)
@@ -2524,12 +2732,10 @@ gdb_actions_command (clientData, interp, objc, objv)
     }
 
   /* Free any existing actions */
-  for (temp = tp->actions; temp != NULL; temp = temp->next)
-    {
-      if (temp->action)
-        free (temp->action);
-      free (temp);
-    }
+  if (tp->actions != NULL)
+    free_actions (tp);
+
+  step_count = 0;
 
   Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
   for (i = 0; i < nactions; i++)
@@ -2538,6 +2744,8 @@ gdb_actions_command (clientData, interp, objc, objv)
       temp->next = NULL;
       action = Tcl_GetStringFromObj (actions[i], &len);
       temp->action = savestring (action, len);
+      if (sscanf (temp->action, "while-stepping %d", &step_count) !=0)
+        tp->step_count = step_count;
       if (next == NULL)
         {
           tp->actions = temp;
@@ -2588,6 +2796,161 @@ gdb_prompt_command (clientData, interp, objc, objv)
   return TCL_OK;
 }
 
+/* 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[];
+{
+  Tcl_Obj *list;
+  struct tracepoint *tp;
+
+  list = Tcl_NewListObj (0, NULL);
+
+  ALL_TRACEPOINTS (tp)
+    Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->number));
+
+  Tcl_SetObjResult (interp, list);
+  return TCL_OK;
+}
+
+/* This is stolen from source.c */
+#ifdef CRLF_SOURCE_FILES
+
+/* Define CRLF_SOURCE_FILES in an xm-*.h file if source files on the
+   host use \r\n rather than just \n.  Defining CRLF_SOURCE_FILES is
+   much faster than defining LSEEK_NOT_LINEAR.  */
+
+#ifndef O_BINARY
+#define O_BINARY 0
+#endif
+
+#define OPEN_MODE (O_RDONLY | O_BINARY)
+
+#else /* ! defined (CRLF_SOURCE_FILES) */
+
+#define OPEN_MODE O_RDONLY
+
+#endif /* ! defined (CRLF_SOURCE_FILES) */
+
+/* Find the pathname to a file, searching the source_dir */
+/* we may actually need to use openp to find the the full pathname
+   so we don't have any "../" et al in it. */
+static int
+gdb_find_file_command (clientData, interp, objc, objv)
+  ClientData clientData;
+  Tcl_Interp *interp;
+  int objc;
+  Tcl_Obj *CONST objv[];
+{
+  char *file, *filename;
+
+  if (objc != 2)
+    {
+      Tcl_AppendResult (interp, "wrong # of args: should be \"",
+                        Tcl_GetStringFromObj (objv[0], NULL),
+                        " filename\"");
+      return TCL_ERROR;
+    }
+
+  file  = Tcl_GetStringFromObj (objv[1], NULL);
+  filename = find_file_in_dir (file);
+  
+  if (filename == NULL)
+    Tcl_SetResult (interp, "", TCL_STATIC);
+  else
+    Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
+
+  return TCL_OK;
+}
+
+static char *
+find_file_in_dir (file)
+     char *file;
+{
+  struct symtab *st = NULL;
+
+  if (file != NULL)
+    {
+      /* try something simple first */
+      if (access (file, R_OK) == 0)
+        return file;
+      
+      /* We really need a symtab for this to work... */
+      st = lookup_symtab (file);
+      if (st != NULL)
+        {
+          file = symtab_to_filename (st);
+          if (file != NULL)
+            return file;
+        }
+    }
+  
+  return NULL;
+}
+
+/* This hook is called whenever we are ready to load a symbol file so that
+   the UI can notify the user... */
+void
+gdbtk_pre_add_symbol (name)
+  char *name;
+{
+  char command[256];
+
+  sprintf (command, "gdbtk_tcl_pre_add_symbol %s", name);
+  Tcl_Eval (interp, command);
+}
+
+/* This hook is called whenever we finish loading a symbol file. */
+void
+gdbtk_post_add_symbol ()
+{
+  Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
+}
+
+
+/* TclDebug (const char *fmt, ...) works just like printf() but */
+/* sends the output to the GDB TK debug window. */
+/* Not for normal use; just a convenient tool for debugging */
+void
+#ifdef ANSI_PROTOTYPES
+TclDebug (const char *fmt, ...)
+#else
+TclDebug (va_alist)
+     va_dcl
+#endif
+{
+  va_list args;
+  char buf[512];
+
+#ifdef ANSI_PROTOTYPES
+  va_start (args, fmt);
+#else
+  char *fmt;
+  va_start (args);
+  fmt = va_arg (args, char *);
+#endif
+
+  strcpy (buf, "debug \"");
+  vsprintf (&buf[7], fmt, args);
+  va_end (args);
+  strcat (buf, "\"");
+  Tcl_Eval (interp, buf);
+}
+
+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;
+}
+
 /* Come here during initialize_all_files () */
 
 void
This page took 0.033436 seconds and 4 git commands to generate.