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