gdb/gdbtk.c

   1 /* TK interface routines.
   2    Copyright 1994 Free Software Foundation, Inc.
   3
   4 This file is part of GDB.
   5
   6 This program is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2 of the License, or
   9 (at your option) any later version.
  10
  11 This program is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with this program; if not, write to the Free Software
  18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20 #include "defs.h"
  21 #include "symtab.h"
  22 #include "inferior.h"
  23 #include "command.h"
  24 #include "bfd.h"
  25 #include "symfile.h"
  26 #include "objfiles.h"
  27 #include "target.h"
  28 #include <sys/types.h>
  29 #include <sys/time.h>
  30 #include <sys/param.h>
  31 #include <varargs.h>
  32 #include <sys/stat.h>
  33 #include <fcntl.h>
  34 #include <sys/filio.h>
  35 #include <setjmp.h>
  36 #include <signal.h>
  37 #include <sys/errno.h>
  38 #include <termios.h>
  39 #include <string.h>
  40 #include <tcl.h>
  41 #include <tk.h>
  42 #include <unistd.h>
  43
  44 /* Non-zero means that we're doing the gdbtk interface. */
  45 int gdbtk = 0;
  46
  47 /* Non-zero means we are reloading breakpoints, etc from the
  48    Gdbtk kernel, and we should suppress various messages */
  49 static int gdbtk_reloading = 0;
  50
  51 /* Handle for TCL interpreter */
  52 static Tcl_Interp *interp = NULL;
  53
  54 /* Handle for TK main window */
  55 static Tk_Window mainWindow = NULL;
  56
  57 static int x_fd;                /* X network socket */
  58
  59 static void
  60 null_routine(arg)
  61      int arg;
  62 {
  63 }
  64
  65 \f
  66 /* This routine redirects the output of fputs_unfiltered so that
  67    the user can see what's going on in his debugger window. */
  68
  69 static char holdbuf[200];
  70 static char *holdbufp = holdbuf;
  71 static int holdfree = sizeof (holdbuf);
  72
  73 static void
  74 flush_holdbuf ()
  75 {
  76   if (holdbufp == holdbuf)
  77     return;
  78
  79   Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", holdbuf, "}", NULL);
  80   holdbufp = holdbuf;
  81   holdfree = sizeof (holdbuf);
  82 }
  83
  84 static void
  85 gdbtk_flush (stream)
  86      FILE *stream;
  87 {
  88   flush_holdbuf ();
  89
  90   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
  91 }
  92
  93 static void
  94 gdbtk_fputs (ptr)
  95      const char *ptr;
  96 {
  97   int len;
  98
  99   len = strlen (ptr) + 1;
 100
 101   if (len > holdfree)
 102     {
 103       flush_holdbuf ();
 104
 105       if (len > sizeof (holdbuf))
 106         {
 107           Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", ptr, "}", NULL);
 108           return;
 109         }
 110     }
 111
 112   strncpy (holdbufp, ptr, len);
 113   holdbufp += len - 1;
 114   holdfree -= len - 1;
 115 }
 116
 117 static int
 118 gdbtk_query (args)
 119      va_list args;
 120 {
 121   char *query;
 122   char buf[200];
 123   long val;
 124
 125   query = va_arg (args, char *);
 126
 127   vsprintf(buf, query, args);
 128   Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
 129
 130   val = atol (interp->result);
 131   return val;
 132 }
 133 \f
 134 #if 0
 135 static char *
 136 full_filename(symtab)
 137      struct symtab *symtab;
 138 {
 139   int pathlen;
 140   char *filename;
 141
 142   if (!symtab)
 143     return NULL;
 144
 145   if (symtab->fullname)
 146     return savestring(symtab->fullname, strlen(symtab->fullname));
 147
 148   if (symtab->filename[0] == '/')
 149     return savestring(symtab->filename, strlen(symtab->filename));
 150
 151   if (symtab->dirname)
 152     pathlen = strlen(symtab->dirname);
 153   else
 154     pathlen = 0;
 155   if (symtab->filename)
 156     pathlen += strlen(symtab->filename);
 157
 158   filename = xmalloc(pathlen+1);
 159
 160   if (symtab->dirname)
 161     strcpy(filename, symtab->dirname);
 162   else
 163     *filename = '\000';
 164   if (symtab->filename)
 165     strcat(filename, symtab->filename);
 166
 167   return filename;
 168 }
 169 #endif
 170 \f
 171 static void
 172 breakpoint_notify(b, action)
 173      struct breakpoint *b;
 174      const char *action;
 175 {
 176   struct symbol *sym;
 177   char bpnum[50], line[50], pc[50];
 178   struct symtab_and_line sal;
 179   char *filename;
 180   int v;
 181
 182   if (b->type != bp_breakpoint)
 183     return;
 184
 185   sal = find_pc_line (b->address, 0);
 186
 187   filename = symtab_to_filename (sal.symtab);
 188
 189   sprintf (bpnum, "%d", b->number);
 190   sprintf (line, "%d", sal.line);
 191   sprintf (pc, "0x%x", b->address);
 192
 193   v = Tcl_VarEval (interp,
 194                    "gdbtk_tcl_breakpoint ",
 195                    action,
 196                    " ", bpnum,
 197                    " ", filename,
 198                    " ", line,
 199                    " ", pc,
 200                    NULL);
 201
 202   if (v != TCL_OK)
 203     {
 204       gdbtk_fputs (interp->result);
 205       gdbtk_fputs ("\n");
 206     }
 207 }
 208
 209 static void
 210 gdbtk_create_breakpoint(b)
 211      struct breakpoint *b;
 212 {
 213   breakpoint_notify(b, "create");
 214 }
 215
 216 static void
 217 gdbtk_delete_breakpoint(b)
 218      struct breakpoint *b;
 219 {
 220   breakpoint_notify(b, "delete");
 221 }
 222
 223 static void
 224 gdbtk_enable_breakpoint(b)
 225      struct breakpoint *b;
 226 {
 227   breakpoint_notify(b, "enable");
 228 }
 229
 230 static void
 231 gdbtk_disable_breakpoint(b)
 232      struct breakpoint *b;
 233 {
 234   breakpoint_notify(b, "disable");
 235 }
 236 \f
 237 /* This implements the TCL command `gdb_loc', which returns a list consisting
 238    of the source and line number associated with the current pc. */
 239
 240 static int
 241 gdb_loc (clientData, interp, argc, argv)
 242      ClientData clientData;
 243      Tcl_Interp *interp;
 244      int argc;
 245      char *argv[];
 246 {
 247   char *filename;
 248   char buf[100];
 249   struct symtab_and_line sal;
 250   char *funcname;
 251   CORE_ADDR pc;
 252
 253   if (argc == 1)
 254     {
 255       struct frame_info *frame;
 256       struct symbol *func;
 257
 258       frame = get_frame_info (selected_frame);
 259
 260       pc = frame ? frame->pc : stop_pc;
 261
 262       sal = find_pc_line (pc, 0);
 263     }
 264   else if (argc == 2)
 265     {
 266       struct symtabs_and_lines sals;
 267       int nelts;
 268
 269       sals = decode_line_spec (argv[1], 1);
 270
 271       nelts = sals.nelts;
 272       sal = sals.sals[0];
 273       free (sals.sals);
 274
 275       if (sals.nelts != 1)
 276         {
 277           Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC);
 278           return TCL_ERROR;
 279         }
 280
 281       pc = sal.pc;
 282     }
 283   else
 284     {
 285       Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
 286       return TCL_ERROR;
 287     }
 288
 289   if (sal.symtab)
 290     Tcl_AppendElement (interp, sal.symtab->filename);
 291   else
 292     Tcl_AppendElement (interp, "");
 293
 294   find_pc_partial_function (pc, &funcname, NULL, NULL);
 295   Tcl_AppendElement (interp, funcname);
 296
 297   filename = symtab_to_filename (sal.symtab);
 298   Tcl_AppendElement (interp, filename);
 299
 300   sprintf (buf, "%d", sal.line);
 301   Tcl_AppendElement (interp, buf); /* line number */
 302
 303   sprintf (buf, "0x%x", pc);
 304   Tcl_AppendElement (interp, buf); /* PC */
 305
 306   return TCL_OK;
 307 }
 308 \f
 309 static int
 310 gdb_cmd_stub (cmd)
 311      char *cmd;
 312 {
 313   execute_command (cmd, 1);
 314
 315   return 1;                     /* Indicate success */
 316 }
 317
 318 /* This implements the TCL command `gdb_cmd', which sends it's argument into
 319    the GDB command scanner.  */
 320
 321 static int
 322 gdb_cmd (clientData, interp, argc, argv)
 323      ClientData clientData;
 324      Tcl_Interp *interp;
 325      int argc;
 326      char *argv[];
 327 {
 328   int val;
 329   struct cleanup *old_chain;
 330
 331   if (argc != 2)
 332     {
 333       Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
 334       return TCL_ERROR;
 335     }
 336
 337   old_chain = make_cleanup (null_routine, 0);
 338
 339   val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR);
 340
 341   /* In case of an error, we may need to force the GUI into idle mode because
 342      gdbtk_call_command may have bombed out while in the command routine.  */
 343
 344   if (val == 0)
 345     Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL);
 346
 347   bpstat_do_actions (&stop_bpstat);
 348   do_cleanups (old_chain);
 349
 350   /* Drain all buffered command output */
 351
 352   gdb_flush (gdb_stderr);
 353   gdb_flush (gdb_stdout);
 354
 355   /* We could base the return value on val, but that would require most users
 356      to use catch.  Since GDB errors are already being handled elsewhere, I
 357      see no reason to pass them up to the caller. */
 358
 359   return TCL_OK;
 360 }
 361
 362 static int
 363 gdb_listfiles (clientData, interp, argc, argv)
 364      ClientData clientData;
 365      Tcl_Interp *interp;
 366      int argc;
 367      char *argv[];
 368 {
 369   int val;
 370   struct objfile *objfile;
 371   struct partial_symtab *psymtab;
 372
 373   ALL_PSYMTABS (objfile, psymtab)
 374     Tcl_AppendElement (interp, psymtab->filename);
 375
 376   return TCL_OK;
 377 }
 378
 379 static int
 380 gdb_stop (clientData, interp, argc, argv)
 381      ClientData clientData;
 382      Tcl_Interp *interp;
 383      int argc;
 384      char *argv[];
 385 {
 386   extern pid_t inferior_process_group;
 387
 388   /* XXX - This is WRONG for remote targets.  Probably need a target vector
 389      entry to do this right.  */
 390
 391   kill (-inferior_process_group, SIGINT);
 392 }
 393
 394 \f
 395 static void
 396 tk_command (cmd, from_tty)
 397      char *cmd;
 398      int from_tty;
 399 {
 400   Tcl_VarEval (interp, cmd, NULL);
 401
 402   gdbtk_fputs (interp->result);
 403   gdbtk_fputs ("\n");
 404 }
 405
 406 static void
 407 cleanup_init (ignored)
 408      int ignored;
 409 {
 410   if (mainWindow != NULL)
 411     Tk_DestroyWindow (mainWindow);
 412   mainWindow = NULL;
 413
 414   if (interp != NULL)
 415     Tcl_DeleteInterp (interp);
 416   interp = NULL;
 417 }
 418
 419 /* Come here during long calculations to check for GUI events.  Usually invoked
 420    via the QUIT macro.  */
 421
 422 static void
 423 gdbtk_interactive ()
 424 {
 425   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
 426 }
 427
 428 /* Come here when there is activity on the X file descriptor. */
 429
 430 static void
 431 x_event (signo)
 432      int signo;
 433 {
 434   /* Process pending events */
 435
 436   while (Tk_DoOneEvent (TK_DONT_WAIT|TK_ALL_EVENTS) != 0);
 437 }
 438
 439 static int
 440 gdbtk_wait (pid, ourstatus)
 441      int pid;
 442      struct target_waitstatus *ourstatus;
 443 {
 444   signal (SIGIO, x_event);
 445
 446   pid = target_wait (pid, ourstatus);
 447
 448   signal (SIGIO, SIG_IGN);
 449
 450   return pid;
 451 }
 452
 453 /* This is called from execute_command, and provides a wrapper around
 454    various command routines in a place where both protocol messages and
 455    user input both flow through.  Mostly this is used for indicating whether
 456    the target process is running or not.
 457 */
 458
 459 static void
 460 gdbtk_call_command (cmdblk, arg, from_tty)
 461      struct cmd_list_element *cmdblk;
 462      char *arg;
 463      int from_tty;
 464 {
 465   if (cmdblk->class == class_run)
 466     {
 467       Tcl_VarEval (interp, "gdbtk_tcl_busy", NULL);
 468       (*cmdblk->function.cfunc)(arg, from_tty);
 469       Tcl_VarEval (interp, "gdbtk_tcl_idle", NULL);
 470     }
 471   else
 472     (*cmdblk->function.cfunc)(arg, from_tty);
 473 }
 474
 475 static void
 476 gdbtk_init ()
 477 {
 478   struct cleanup *old_chain;
 479   char *gdbtk_filename;
 480   int i;
 481
 482   old_chain = make_cleanup (cleanup_init, 0);
 483
 484   /* First init tcl and tk. */
 485
 486   interp = Tcl_CreateInterp ();
 487
 488   if (!interp)
 489     error ("Tcl_CreateInterp failed");
 490
 491   mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
 492
 493   if (!mainWindow)
 494     return;                     /* DISPLAY probably not set */
 495
 496   if (Tcl_Init(interp) != TCL_OK)
 497     error ("Tcl_Init failed: %s", interp->result);
 498
 499   if (Tk_Init(interp) != TCL_OK)
 500     error ("Tk_Init failed: %s", interp->result);
 501
 502   Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL);
 503   Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL);
 504   Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
 505   Tcl_CreateCommand (interp, "gdb_stop", gdb_stop, NULL, NULL);
 506
 507   gdbtk_filename = getenv ("GDBTK_FILENAME");
 508   if (!gdbtk_filename)
 509     if (access ("gdbtk.tcl", R_OK) == 0)
 510       gdbtk_filename = "gdbtk.tcl";
 511     else
 512       gdbtk_filename = GDBTK_FILENAME;
 513
 514   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
 515     error ("Failure reading %s: %s", gdbtk_filename, interp->result);
 516
 517   /* XXX - Get the file descriptor for the network socket.  This is not Kosher
 518      as it involves looking at data private to Xlib.  */
 519
 520   x_fd = Tk_Display (mainWindow) -> fd;
 521
 522   /* Setup for I/O interrupts */
 523
 524   signal (SIGIO, SIG_IGN);
 525
 526   i = fcntl (x_fd, F_GETFL, 0);
 527   fcntl (x_fd, F_SETFL, i|FASYNC);
 528   fcntl (x_fd, F_SETOWN, getpid());
 529
 530   command_loop_hook = Tk_MainLoop;
 531   fputs_unfiltered_hook = gdbtk_fputs;
 532   print_frame_info_listing_hook = null_routine;
 533   query_hook = gdbtk_query;
 534   flush_hook = gdbtk_flush;
 535   create_breakpoint_hook = gdbtk_create_breakpoint;
 536   delete_breakpoint_hook = gdbtk_delete_breakpoint;
 537   enable_breakpoint_hook = gdbtk_enable_breakpoint;
 538   disable_breakpoint_hook = gdbtk_disable_breakpoint;
 539   interactive_hook = gdbtk_interactive;
 540   target_wait_hook = gdbtk_wait;
 541   call_command_hook = gdbtk_call_command;
 542
 543   discard_cleanups (old_chain);
 544
 545   add_com ("tk", class_obscure, tk_command,
 546            "Send a command directly into tk.");
 547 }
 548
 549 /* Come here during initialze_all_files () */
 550
 551 void
 552 _initialize_gdbtk ()
 553 {
 554   if (use_windows)
 555     {
 556       /* Tell the rest of the world that Gdbtk is now set up. */
 557
 558       init_ui_hook = gdbtk_init;
 559     }
 560 }