Thu May 21 13:14:25 1998 John Metzler <jmetzler@cygnus.com>
[deliverable/binutils-gdb.git] / gdb / gdbtk.c
index 561aff32e57d2bae1d639b02f33f00c339c4681a..6027cdbec362bd3a06f9ebc8399554d41a4edba3 100644 (file)
@@ -35,6 +35,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #include <winuser.h>
 #endif
 
+#include <sys/stat.h>
+
 #include <tcl.h>
 #include <tk.h>
 #include <itcl.h> 
@@ -65,16 +67,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #include <stdio.h>
 #include "gdbcmd.h"
 
-#ifndef WINNT
-#ifndef FIOASYNC
-#include <sys/stropts.h>
-#endif
-#endif
-
-#ifdef __CYGWIN32__
 #include "annotate.h"
 #include <sys/time.h>
-#endif
 
 #ifdef WINNT
 #define GDBTK_PATH_SEP ";"
@@ -88,27 +82,23 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
 #undef SIOCSPGRP
 #endif
 
+static int No_Update = 0;
 static int load_in_progress = 0;
+static int in_fputs = 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));
 
-/* This is a disgusting hack. Unfortunately, the UI will lock up if we
-   are doing something like blocking in a system call, waiting for serial I/O,
-   or what have you.
-
-   This hook should be used whenever we might block. This means adding appropriate
-   timeouts to code and what not to allow this hook to be called. */
-void (*ui_loop_hook) PARAMS ((int));
-
 char * get_prompt PARAMS ((void));
 
 static void null_routine PARAMS ((int));
 static void gdbtk_flush PARAMS ((FILE *));
 static void gdbtk_fputs PARAMS ((const char *, FILE *));
 static int gdbtk_query PARAMS ((const char *, va_list));
+static void gdbtk_warning PARAMS ((const char *, va_list));
+static void gdbtk_ignorable_warning PARAMS ((const char *));
 static char *gdbtk_readline PARAMS ((char *));
 static void gdbtk_init PARAMS ((char *));
 static void tk_command_loop PARAMS ((void));
@@ -128,6 +118,7 @@ static int gdb_force_quit 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 call_obj_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
 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 *[]));
@@ -147,9 +138,14 @@ static int map_arg_registers PARAMS ((int, char *[], void (*) (int, void *), voi
 static void get_register_name PARAMS ((int, void *));
 static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
 static void get_register PARAMS ((int, void *));
+static int gdb_trace_status PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
 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_locals_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
+                                 objv[]));
+static int gdb_get_args_command 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_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[]));
@@ -159,7 +155,6 @@ static int gdb_get_tracepoint_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_O
 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 *));
@@ -173,33 +168,14 @@ static int gdb_loadfile PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST o
 static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
 static struct symtab *full_lookup_symtab PARAMS ((char *file));
 static int gdb_get_mem PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
-#ifdef __CYGWIN32__
-static void gdbtk_annotate_starting PARAMS ((void));
-static void gdbtk_annotate_stopped PARAMS ((void));
-static void gdbtk_annotate_signalled PARAMS ((void));
-static void gdbtk_annotate_exited PARAMS ((void));
-#endif
 
 /* Handle for TCL interpreter */
 static Tcl_Interp *interp = NULL;
 
-#ifndef WINNT
-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
@@ -318,22 +294,53 @@ gdbtk_fputs (ptr, stream)
      const char *ptr;
      FILE *stream;
 {
+  char *merge[2], *command;
+  in_fputs = 1;
+
   if (result_ptr)
-    Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
+     Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
   else if (error_string_ptr != NULL && stream == gdb_stderr)
     Tcl_DStringAppend (error_string_ptr, (char *) ptr, -1);
   else
     {
-      Tcl_DString str;
+      merge[0] = "gdbtk_tcl_fputs";
+      merge[1] = (char *)ptr;
+      command = Tcl_Merge (2, merge);
+      Tcl_Eval (interp, command);
+      Tcl_Free (command);
+    }
+  in_fputs = 0;
+}
 
-      Tcl_DStringInit (&str);
+static void
+gdbtk_warning (warning, args)
+     const char *warning;
+     va_list args;
+{
+  char buf[200], *merge[2];
+  char *command;
 
-      Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
-      Tcl_DStringAppendElement (&str, (char *)ptr);
+  vsprintf (buf, warning, args);
+  merge[0] = "gdbtk_tcl_warning";
+  merge[1] = buf;
+  command = Tcl_Merge (2, merge);
+  Tcl_Eval (interp, command);
+  Tcl_Free (command);
+}
 
-      Tcl_Eval (interp, Tcl_DStringValue (&str)); 
-      Tcl_DStringFree (&str);
-    }
+static void
+gdbtk_ignorable_warning (warning)
+     const char *warning;
+{
+  char buf[200], *merge[2];
+  char *command;
+
+  sprintf (buf, warning);
+  merge[0] = "gdbtk_tcl_ignorable_warning";
+  merge[1] = buf;
+  command = Tcl_Merge (2, merge);
+  Tcl_Eval (interp, command);
+  Tcl_Free (command);
 }
 
 static int
@@ -351,7 +358,7 @@ gdbtk_query (query, args)
   command = Tcl_Merge (2, merge);
   Tcl_Eval (interp, command);
   Tcl_Free (command);
-
   val = atol (interp->result);
   return val;
 }
@@ -677,11 +684,12 @@ 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
@@ -1063,6 +1071,8 @@ gdb_changed_register_list (clientData, interp, argc, argv)
 \f
 /* This implements the tcl command "gdb_immediate", which 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. */
 static int
 gdb_immediate_command (clientData, interp, argc, argv)
      ClientData clientData;
@@ -1075,9 +1085,11 @@ gdb_immediate_command (clientData, interp, argc, argv)
   if (argc != 2)
     error ("wrong # args");
 
-  if (running_now)
+  if (running_now || load_in_progress)
     return TCL_OK;
 
+  No_Update = 0;
+
   Tcl_DStringAppend (result_ptr, "", -1);
   save_ptr = result_ptr;
   result_ptr = NULL;
@@ -1093,7 +1105,8 @@ gdb_immediate_command (clientData, interp, argc, argv)
 
 /* This implements the TCL command `gdb_cmd', which sends its argument into
    the GDB command scanner.  */
-
+/* This command will never cause the update, idle and busy hooks to be called
+   within the GUI. */
 static int
 gdb_cmd (clientData, interp, argc, argv)
      ClientData clientData;
@@ -1103,12 +1116,14 @@ gdb_cmd (clientData, interp, argc, argv)
 {
   Tcl_DString *save_ptr = NULL;
 
-  if (argc != 2)
+  if (argc < 2)
     error ("wrong # args");
 
-  if (running_now)
+  if (running_now || load_in_progress)
     return TCL_OK;
 
+  No_Update = 1;
+
   /* for the load instruction (and possibly others later) we
      set result_ptr to NULL so gdbtk_fputs() will not buffer
      all the data until the command is finished. */
@@ -1120,23 +1135,17 @@ gdb_cmd (clientData, interp, argc, argv)
       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
+    {
+      gdbtk_stop_timer ();
+      load_in_progress = 0;
+    }
 
-  load_in_progress = 0;
   bpstat_do_actions (&stop_bpstat);
   
   if (save_ptr) 
@@ -1165,6 +1174,23 @@ wrapped_call (args)
   return 1;
 }
 
+struct wrapped_call_objs
+{
+  Tcl_Interp *interp;
+  Tcl_CmdProc *func;
+  int objc;
+  Tcl_Obj **objv;
+  int val;
+};
+
+static int
+wrapped_obj_call (args)
+     struct wrapped_call_objs *args;
+{
+  args->val = (*args->func) (args->func, args->interp, args->objc, args->objv);
+  return 1;
+}
+
 /* This routine acts as a top-level for all GDB code called by tcl/Tk.  It
    handles cleanups, and calls to return_to_top_level (usually via error).
    This is necessary in order to prevent a longjmp out of the bowels of Tk,
@@ -1201,11 +1227,9 @@ call_wrapper (clientData, interp, argc, argv)
     {
       wrapped_args.val = TCL_ERROR;    /* Flag an error for TCL */
 
-#ifdef __CYGWIN32__
       /* Make sure the timer interrupts are turned off.  */
       if (gdbtk_timer_going)
-       gdbtk_stop_timer ();
-#endif
+        gdbtk_stop_timer ();
 
       gdb_flush (gdb_stderr);  /* Flush error output */
       gdb_flush (gdb_stdout);  /* Sometimes error output comes here as well */
@@ -1244,6 +1268,93 @@ call_wrapper (clientData, interp, argc, argv)
   result_ptr = old_result_ptr;
   error_string_ptr = old_error_string_ptr;
 
+#ifdef _WIN32
+  close_bfds ();
+#endif
+
+  return wrapped_args.val;
+}
+static int
+call_obj_wrapper (clientData, interp, objc, objv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int objc;
+     Tcl_Obj *CONST objv[];
+{
+  struct wrapped_call_objs wrapped_args;
+  Tcl_DString result, *old_result_ptr;
+  Tcl_DString error_string, *old_error_string_ptr;
+
+  /* The obj call wrapper works differently from the string wrapper, because
+   * the obj calls currently insert their results directly into the
+   * interpreter's result.  So there is no need to have a result_ptr...
+   * FIXME - rewrite all the object commands so they use a result_obj_ptr
+   *       - rewrite all the string commands to be object commands.
+   */
+  
+  Tcl_DStringInit (&result);
+  old_result_ptr = result_ptr;
+  result_ptr = &result;
+
+  Tcl_DStringInit (&error_string);
+
+  Tcl_DStringInit (&error_string);
+  old_error_string_ptr = error_string_ptr;
+  error_string_ptr = &error_string;
+
+  wrapped_args.func = (Tcl_CmdProc *)clientData;
+  wrapped_args.interp = interp;
+  wrapped_args.objc = objc;
+  wrapped_args.objv = objv;
+  wrapped_args.val = 0;
+
+  if (!catch_errors (wrapped_obj_call, &wrapped_args, "", RETURN_MASK_ALL))
+    {
+      wrapped_args.val = TCL_ERROR;    /* Flag an error for TCL */
+
+      /* Make sure the timer interrupts are turned off.  */
+      if (gdbtk_timer_going)
+        gdbtk_stop_timer ();
+
+      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;
+
+  if (Tcl_DStringLength (&error_string) == 0)
+    {
+      /* We should insert the result here, but the obj commands now
+       * do this directly, so we don't need to.
+       * FIXME - ultimately, all this should be redone so that all the
+       * commands either manipulate the Tcl result directly, or use a result_ptr.
+       */
+      
+      Tcl_DStringFree (&error_string);
+    }
+  else if (*(Tcl_GetStringResult (interp)) == '\0')
+    {
+      Tcl_DStringResult (interp, &error_string);
+      Tcl_DStringFree (&error_string);
+    }
+  else
+    {
+      Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_DStringValue (&error_string),
+                           Tcl_DStringLength (&error_string));
+      Tcl_DStringFree (&error_string);
+    }
+  
+  result_ptr = old_result_ptr;
+  error_string_ptr = old_error_string_ptr;
+
 #ifdef _WIN32
   close_bfds ();
 #endif
@@ -1268,10 +1379,14 @@ gdb_listfiles (clientData, interp, objc, objv)
   struct objfile *objfile;
   struct partial_symtab *psymtab;
   struct symtab *symtab;
-  char *lastfile, *pathname, *files[1000];
+  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?");
@@ -1284,6 +1399,11 @@ gdb_listfiles (clientData, interp, objc, objv)
 
   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)
@@ -1297,6 +1417,11 @@ gdb_listfiles (clientData, interp, objc, objv)
 
   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)
@@ -1318,6 +1443,7 @@ gdb_listfiles (clientData, interp, objc, objv)
       lastfile = files[i];
     }
   Tcl_SetObjResult (interp, mylist);
+  free (files);
   return TCL_OK;
 }
 
@@ -1369,6 +1495,14 @@ gdb_listfuncs (clientData, interp, argc, argv)
   return TCL_OK;
 }
 
+static int
+target_stop_wrapper (args)
+  char * args;
+{
+  target_stop ();
+  return 1;
+}
+
 static int
 gdb_stop (clientData, interp, argc, argv)
      ClientData clientData;
@@ -1377,7 +1511,10 @@ gdb_stop (clientData, interp, argc, argv)
      char *argv[];
 {
   if (target_stop)
-    target_stop ();
+    {
+      catch_errors (target_stop_wrapper, NULL, "",
+                    RETURN_MASK_ALL);
+    }
   else
     quit_flag = 1; /* hope something sees this */
 
@@ -1751,19 +1888,26 @@ static 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;
+
   /* Process pending events */
   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))
+      int val;
+      if (varname == NULL)
+       {
+         Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
+         varname = Tcl_ObjGetVar2(interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
+       }
+      if ((Tcl_GetIntFromObj(interp,varname,&val) == TCL_OK) && val)
        {
          quit_flag = 1;
 #ifdef REQUEST_QUIT
@@ -1774,67 +1918,67 @@ x_event (signo)
 #endif
        }
     }
+  in_x_event = 0;
 }
 
-#ifdef __CYGWIN32__
-
 /* For Cygwin32, we use a timer to periodically check for Windows
    messages.  FIXME: It would be better to not poll, but to instead
    rewrite the target_wait routines to serve as input sources.
    Unfortunately, that will be a lot of work.  */
+static sigset_t nullsigmask;
+static struct sigaction act1, act2;
+static struct itimerval it_on, it_off;
 
 static void
 gdbtk_start_timer ()
 {
-  sigset_t nullsigmask;
-  struct sigaction action;
-  struct itimerval it;
-
-  /*TclDebug ("Starting timer....");*/
-  sigemptyset (&nullsigmask);
+  static int first = 1;
+  /*TclDebug ("Starting timer....");*/  
+  if (first)
+    {
+      /* first time called, set up all the structs */
+      first = 0;
+      sigemptyset (&nullsigmask);
 
-  action.sa_handler = x_event;
-  action.sa_mask = nullsigmask;
-  action.sa_flags = 0;
-  sigaction (SIGALRM, &action, NULL);
+      act1.sa_handler = x_event;
+      act1.sa_mask = nullsigmask;
+      act1.sa_flags = 0;
 
-  it.it_interval.tv_sec = 0;
-  /* Check for messages twice a second.  */
-  it.it_interval.tv_usec = 500 * 1000;
-  it.it_value.tv_sec = 0;
-  it.it_value.tv_usec = 500 * 1000;
+      act2.sa_handler = SIG_IGN;
+      act2.sa_mask = nullsigmask;
+      act2.sa_flags = 0;
 
-  setitimer (ITIMER_REAL, &it, NULL);
+      it_on.it_interval.tv_sec = 0;
+      it_on.it_interval.tv_usec = 250000; /* .25 sec */
+      it_on.it_value.tv_sec = 0;
+      it_on.it_value.tv_usec = 250000;
 
-  gdbtk_timer_going = 1;
+      it_off.it_interval.tv_sec = 0;
+      it_off.it_interval.tv_usec = 0;
+      it_off.it_value.tv_sec = 0;
+      it_off.it_value.tv_usec = 0;
+    }
+  
+  if (!gdbtk_timer_going)
+    {
+      sigaction (SIGALRM, &act1, NULL);
+      setitimer (ITIMER_REAL, &it_on, NULL);
+      gdbtk_timer_going = 1;
+    }
 }
 
 static void
 gdbtk_stop_timer ()
 {
-  sigset_t nullsigmask;
-  struct sigaction action;
-  struct itimerval it;
-
-  gdbtk_timer_going = 0;
-  
-  /*TclDebug ("Stopping timer.");*/
-  sigemptyset (&nullsigmask);
-
-  action.sa_handler = SIG_IGN;
-  action.sa_mask = nullsigmask;
-  action.sa_flags = 0;
-  sigaction (SIGALRM, &action, NULL);
-
-  it.it_interval.tv_sec = 0;
-  it.it_interval.tv_usec = 0;
-  it.it_value.tv_sec = 0;
-  it.it_value.tv_usec = 0;
-  setitimer (ITIMER_REAL, &it, NULL);
+  if (gdbtk_timer_going)
+    {
+      gdbtk_timer_going = 0;
+      /*TclDebug ("Stopping timer.");*/
+      setitimer (ITIMER_REAL, &it_off, NULL);
+      sigaction (SIGALRM, &act2, NULL);
+    }
 }
 
-#endif
-
 /* This hook function is called whenever we want to wait for the
    target.  */
 
@@ -1843,29 +1987,9 @@ gdbtk_wait (pid, ourstatus)
      int pid;
      struct target_waitstatus *ourstatus;
 {
-#ifndef WINNT
-  struct sigaction action;
-  static sigset_t nullsigmask = {0};
-
-
-#ifndef SA_RESTART
-  /* Needed for SunOS 4.1.x */
-#define SA_RESTART 0
-#endif
-
-  action.sa_handler = x_event;
-  action.sa_mask = nullsigmask;
-  action.sa_flags = SA_RESTART;
-  sigaction(SIGIO, &action, NULL);
-#endif /* WINNT */
-
+  gdbtk_start_timer ();
   pid = target_wait (pid, ourstatus);
-
-#ifndef WINNT
-  action.sa_handler = SIG_IGN;
-  sigaction(SIGIO, &action, NULL); 
-#endif
-
+  gdbtk_stop_timer ();
   return pid;
 }
 
@@ -1884,11 +2008,27 @@ gdbtk_call_command (cmdblk, arg, from_tty)
   running_now = 0;
   if (cmdblk->class == class_run || cmdblk->class == class_trace)
     {
-      running_now = 1;
-      Tcl_Eval (interp, "gdbtk_tcl_busy");
-      (*cmdblk->function.cfunc)(arg, from_tty);
-      running_now = 0;
-      Tcl_Eval (interp, "gdbtk_tcl_idle");
+
+/* 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, s we need to have specific
+   procedures to do tstart and tstop
+*/
+      if (!strcmp(cmdblk->name, "tstart") && !No_Update)
+              Tcl_Eval (interp, "gdbtk_tcl_tstart"); 
+      else if (!strcmp(cmdblk->name, "tstop") && !No_Update) 
+              Tcl_Eval (interp, "gdbtk_tcl_tstop"); 
+/* end of hack */
+           else 
+             {
+                 running_now = 1;
+                 if (!No_Update)
+                   Tcl_Eval (interp, "gdbtk_tcl_busy");
+                 (*cmdblk->function.cfunc)(arg, from_tty);
+                 running_now = 0;
+                 if (!No_Update)
+                   Tcl_Eval (interp, "gdbtk_tcl_idle");
+             }
     }
   else
     (*cmdblk->function.cfunc)(arg, from_tty);
@@ -1977,6 +2117,10 @@ gdbtk_init ( argv0 )
   Tcl_FindExecutable (argv0); 
   interp = Tcl_CreateInterp ();
 
+#ifdef TCL_MEM_DEBUG
+  Tcl_InitMemory (interp);
+#endif
+
   if (!interp)
     error ("Tcl_CreateInterp failed");
 
@@ -2045,7 +2189,6 @@ gdbtk_init ( argv0 )
       */
 
       Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
-      Tcl_SetVar (interp, "IDE", "1", TCL_GLOBAL_ONLY);
     }
   /* end-sanitize-ide */
 #else
@@ -2090,7 +2233,7 @@ gdbtk_init ( argv0 )
                      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_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_listfiles", call_obj_wrapper, gdb_listfiles, NULL);
   Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
                     NULL);
   Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
@@ -2117,36 +2260,40 @@ gdbtk_init ( argv0 )
   Tcl_CreateCommand (interp, "gdb_target_has_execution",
                      gdb_target_has_execution_command,
                      NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_load_info", gdb_load_info, NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_locals", gdb_get_vars_command, 
-                        (ClientData) 0, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_args", gdb_get_vars_command,
-                        (ClientData) 1, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_function", gdb_get_function_command,
-                        NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_line", gdb_get_line_command,
-                        NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_get_file", gdb_get_file_command,
-                        NULL, NULL);
+  Tcl_CreateCommand (interp, "gdb_is_tracing",
+                     gdb_trace_status,
+                     NULL, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_load_info", call_obj_wrapper, gdb_load_info, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_locals", call_obj_wrapper, gdb_get_locals_command, 
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_args", call_obj_wrapper, gdb_get_args_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_function", call_obj_wrapper, gdb_get_function_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_line", call_obj_wrapper, gdb_get_line_command,
+                         NULL);
+  Tcl_CreateObjCommand (interp, "gdb_get_file", call_obj_wrapper, gdb_get_file_command,
+                         NULL);
   Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
-                        gdb_tracepoint_exists_command, NULL, NULL);
+                        call_obj_wrapper, gdb_tracepoint_exists_command,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
-                        gdb_get_tracepoint_info, NULL, NULL);
+                        call_obj_wrapper, gdb_get_tracepoint_info,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_actions",
-                        gdb_actions_command, NULL, NULL);
+                        call_obj_wrapper, gdb_actions_command,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_prompt",
-                        gdb_prompt_command, NULL, NULL);
+                        call_obj_wrapper, gdb_prompt_command,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_find_file",
-                        gdb_find_file_command, NULL, NULL);
+                        call_obj_wrapper, gdb_find_file_command,  NULL);
   Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
-                        gdb_get_tracepoint_list, NULL, NULL);  
+                        call_obj_wrapper, gdb_get_tracepoint_list,  NULL);  
   Tcl_CreateCommand (interp, "gdb_pc_reg", get_pc_register, NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_loadfile", gdb_loadfile, NULL, NULL);
-  Tcl_CreateObjCommand (interp, "gdb_set_bp", gdb_set_bp, NULL, NULL);
+  Tcl_CreateObjCommand (interp, "gdb_loadfile", call_obj_wrapper, gdb_loadfile,  NULL);
+  Tcl_CreateObjCommand (interp, "gdb_set_bp", call_obj_wrapper, gdb_set_bp,  NULL);
 
   command_loop_hook = tk_command_loop;
   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;
@@ -2164,50 +2311,6 @@ gdbtk_init ( argv0 )
   delete_tracepoint_hook = gdbtk_delete_tracepoint;
   modify_tracepoint_hook = gdbtk_modify_tracepoint;
   pc_changed_hook = pc_changed;
-#ifdef __CYGWIN32__
-  annotate_starting_hook  = gdbtk_annotate_starting;
-  annotate_stopped_hook   = gdbtk_annotate_stopped;
-  annotate_signalled_hook = gdbtk_annotate_signalled;
-  annotate_exited_hook    = gdbtk_annotate_exited;
-  ui_loop_hook            = x_event;
-#endif
-#ifndef WINNT
-  /* Get the file descriptor for the X server */
-
-  x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
-
-  /* Setup for I/O interrupts */
-
-  action.sa_mask = nullsigmask;
-  action.sa_flags = 0;
-  action.sa_handler = SIG_IGN;
-  sigaction(SIGIO, &action, NULL);
-
-#ifdef FIOASYNC
-  i = 1;
-  if (ioctl (x_fd, FIOASYNC, &i))
-    perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
-
-#ifdef SIOCSPGRP
-  i = getpid();
-  if (ioctl (x_fd, SIOCSPGRP, &i))
-    perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
-
-#else
-#ifdef F_SETOWN
-  i = getpid();
-  if (fcntl (x_fd, F_SETOWN, i))
-    perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
-#endif /* F_SETOWN */
-#endif /* !SIOCSPGRP */
-#else
-#ifndef WINNT
-  if (ioctl (x_fd,  I_SETSIG, S_INPUT|S_RDNORM) < 0)
-    perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
-#endif
-
-#endif /* ifndef FIOASYNC */
-#endif /* WINNT */
 
   add_com ("tk", class_obscure, tk_command,
           "Send a command directly into tk.");
@@ -2353,6 +2456,22 @@ gdb_target_has_execution_command (clientData, interp, argc, argv)
   return TCL_OK;
 }
 
+static int
+gdb_trace_status (clientData, interp, argc, argv)
+     ClientData clientData;
+     Tcl_Interp *interp;
+     int argc;
+     char *argv[];
+{
+  int result = 0;
+  if (trace_running_p)
+    result = 1;
+  Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
+  return TCL_OK;
+}
+
 /* gdb_load_info - returns information about the file about to be downloaded */
 
 static int
@@ -2416,6 +2535,36 @@ gdbtk_load_hash (section, num)
   return  atoi (interp->result);
 }
 
+/* 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);
+
+}
+
 /* gdb_get_vars_command -
  *
  * Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
@@ -2650,7 +2799,7 @@ gdb_get_tracepoint_info (clientData, interp, objc, objv)
   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);
+  sprintf (tmp, "0x%lx", tp->address);
   Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
   Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->pass_count));
@@ -2775,7 +2924,7 @@ tracepoint_notify(tp, action)
   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);
+          (long)tp->address, sal.line, filename, tp->pass_count);
 
   v = Tcl_Eval (interp, buf);
 
@@ -2811,11 +2960,13 @@ tracepoint_exists (char * args)
             {
               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                
             }
         }
     }
@@ -2946,10 +3097,13 @@ void
 gdbtk_pre_add_symbol (name)
   char *name;
 {
-  char command[256];
+  char *merge, *v[2];
 
-  sprintf (command, "gdbtk_tcl_pre_add_symbol %s", name);
-  Tcl_Eval (interp, command);
+  v[0] = "gdbtk_tcl_pre_add_symbol";
+  v[1] = name;
+  merge = Tcl_Merge (2, v);
+  Tcl_Eval (interp, merge);
+  Tcl_Free (merge);
 }
 
 /* This hook is called whenever we finish loading a symbol file. */
@@ -3035,6 +3189,13 @@ full_lookup_symtab(file)
   return NULL;
 }
 
+static int
+perror_with_name_wrapper (args)
+  char * args;
+{
+  perror_with_name (args);
+  return 1;
+}
 
 /* gdb_loadfile loads a c source file into a text widget. */
 
@@ -3059,6 +3220,9 @@ gdb_loadfile (clientData, interp, objc, objv)
   char *ltable;
   struct symtab *symtab;
   struct linetable_entry *le;
+  long mtime = 0;
+  struct stat st;
+
  
   if (objc != 4)
     {
@@ -3076,10 +3240,28 @@ gdb_loadfile (clientData, interp, objc, objv)
   symtab = full_lookup_symtab (file);
   if (!symtab)
     {
+      sprintf(msg, "File not found");
+      Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -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 */
@@ -3140,16 +3322,28 @@ gdb_loadfile (clientData, interp, objc, objv)
       if (linenumbers)
        {
          if (ltable[ln >> 3] & (1 << (ln % 8)))
-           a[0]->length = sprintf (buf,"%s insert end {-\t%d} break_tag", widget, ln);
+        {
+          sprintf (buf,"%s insert end {-\t%d} break_tag", widget, ln);
+          a[0]->length = strlen (buf);
+        }
          else
-           a[0]->length = sprintf (buf,"%s insert end {\t%d} \"\"", widget, ln);
+        {
+          sprintf (buf,"%s insert end { \t%d} \"\"", widget, ln);
+          a[0]->length = strlen (buf);
+        }
        }
       else
        {
          if (ltable[ln >> 3] & (1 << (ln % 8)))
-          a[0]->length = sprintf (buf,"%s insert end {-\t} break_tag", widget);
+        {
+          sprintf (buf,"%s insert end {-\t} break_tag", widget);
+          a[0]->length = strlen (buf);
+        }
          else
-          a[0]->length = sprintf (buf,"%s insert end {\t} \"\"", widget);
+        {
+          sprintf (buf,"%s insert end { \t} \"\"", widget);
+          a[0]->length = strlen (buf);
+        }
        }
       b[0]->length = strlen(b[0]->bytes);
       Tcl_SetListObj(a[1],2,b);
@@ -3250,40 +3444,6 @@ gdb_set_bp (clientData, interp, objc, objv)
   return ret;
 }
 
-#ifdef __CYGWIN32__
-/* The whole timer idea is an easy one, but POSIX does not appear to have
-   some sort of interval timer requirement. Consequently, we cannot rely
-   on cygwin32 to always deliver the timer's signal. This is especially
-   painful given that all serial I/O will block the timer right now. */
-static void
-gdbtk_annotate_starting ()
-{
-  /* TclDebug ("### STARTING ###"); */
-  gdbtk_start_timer ();
-}
-
-static void
-gdbtk_annotate_stopped ()
-{
-  /* TclDebug ("### STOPPED ###"); */
-  gdbtk_stop_timer ();
-}
-
-static void
-gdbtk_annotate_exited ()
-{
-  /* TclDebug ("### EXITED ###"); */
-  gdbtk_stop_timer ();
-}
-
-static void
-gdbtk_annotate_signalled ()
-{
-  /* TclDebug ("### SIGNALLED ###"); */
-  gdbtk_stop_timer ();
-}
-#endif
-
 /* Come here during initialize_all_files () */
 
 void
@@ -3295,4 +3455,31 @@ _initialize_gdbtk ()
 
       init_ui_hook = gdbtk_init;
     }
+#ifdef __CYGWIN32__
+  else
+    {
+      DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE));
+      void cygwin32_attach_handle_to_fd (char *, int, HANDLE, int, int);
+
+      switch (ft)
+       {
+         case FILE_TYPE_DISK:
+         case FILE_TYPE_CHAR:
+         case FILE_TYPE_PIPE:
+           break;
+         default:
+           AllocConsole();
+           cygwin32_attach_handle_to_fd ("/dev/conin", 0,
+                                         GetStdHandle (STD_INPUT_HANDLE),
+                                         1, GENERIC_READ);
+           cygwin32_attach_handle_to_fd ("/dev/conout", 1,
+                                         GetStdHandle (STD_OUTPUT_HANDLE),
+                                         0, GENERIC_WRITE);
+           cygwin32_attach_handle_to_fd ("/dev/conout", 2,
+                                         GetStdHandle (STD_ERROR_HANDLE),
+                                         0, GENERIC_WRITE);
+           break;
+       }
+    }
+#endif
 }
This page took 0.033745 seconds and 4 git commands to generate.