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 void
  58 null_routine(arg)
  59      int arg;
  60 {
  61 }
  62
  63 \f
  64 /* This routine redirects the output of fputs_unfiltered so that
  65    the user can see what's going on in his debugger window. */
  66
  67 static char holdbuf[200];
  68 static char *holdbufp = holdbuf;
  69 static int holdfree = sizeof (holdbuf);
  70
  71 static void
  72 flush_holdbuf ()
  73 {
  74   if (holdbufp == holdbuf)
  75     return;
  76
  77   Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", holdbuf, "}", NULL);
  78   holdbufp = holdbuf;
  79   holdfree = sizeof (holdbuf);
  80 }
  81
  82 static void
  83 gdbtk_flush (stream)
  84      FILE *stream;
  85 {
  86   flush_holdbuf ();
  87
  88   Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
  89 }
  90
  91 static void
  92 gdbtk_fputs (ptr)
  93      const char *ptr;
  94 {
  95   int len;
  96
  97   len = strlen (ptr) + 1;
  98
  99   if (len > holdfree)
 100     {
 101       flush_holdbuf ();
 102
 103       if (len > sizeof (holdbuf))
 104         {
 105           Tcl_VarEval (interp, "gdbtk_tcl_fputs ", "{", ptr, "}", NULL);
 106           return;
 107         }
 108     }
 109
 110   strncpy (holdbufp, ptr, len);
 111   holdbufp += len - 1;
 112   holdfree -= len - 1;
 113 }
 114
 115 static int
 116 gdbtk_query (args)
 117      va_list args;
 118 {
 119   char *query;
 120   char buf[200];
 121   long val;
 122
 123   query = va_arg (args, char *);
 124
 125   vsprintf(buf, query, args);
 126   Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
 127
 128   val = atol (interp->result);
 129   return val;
 130 }
 131 \f
 132 #if 0
 133 static char *
 134 full_filename(symtab)
 135      struct symtab *symtab;
 136 {
 137   int pathlen;
 138   char *filename;
 139
 140   if (!symtab)
 141     return NULL;
 142
 143   if (symtab->fullname)
 144     return savestring(symtab->fullname, strlen(symtab->fullname));
 145
 146   if (symtab->filename[0] == '/')
 147     return savestring(symtab->filename, strlen(symtab->filename));
 148
 149   if (symtab->dirname)
 150     pathlen = strlen(symtab->dirname);
 151   else
 152     pathlen = 0;
 153   if (symtab->filename)
 154     pathlen += strlen(symtab->filename);
 155
 156   filename = xmalloc(pathlen+1);
 157
 158   if (symtab->dirname)
 159     strcpy(filename, symtab->dirname);
 160   else
 161     *filename = '\000';
 162   if (symtab->filename)
 163     strcat(filename, symtab->filename);
 164
 165   return filename;
 166 }
 167 #endif
 168 \f
 169 static void
 170 breakpoint_notify(b, action)
 171      struct breakpoint *b;
 172      const char *action;
 173 {
 174   struct symbol *sym;
 175   char bpnum[50], line[50], pc[50];
 176   struct symtab_and_line sal;
 177   char *filename;
 178   int v;
 179
 180   if (b->type != bp_breakpoint)
 181     return;
 182
 183   sal = find_pc_line (b->address, 0);
 184
 185   filename = symtab_to_filename (sal.symtab);
 186
 187   sprintf (bpnum, "%d", b->number);
 188   sprintf (line, "%d", sal.line);
 189   sprintf (pc, "0x%x", b->address);
 190
 191   v = Tcl_VarEval (interp,
 192                    "gdbtk_tcl_breakpoint ",
 193                    action,
 194                    " ", bpnum,
 195                    " ", filename,
 196                    " ", line,
 197                    " ", pc,
 198                    NULL);
 199
 200   if (v != TCL_OK)
 201     {
 202       gdbtk_fputs (interp->result);
 203       gdbtk_fputs ("\n");
 204     }
 205 }
 206
 207 static void
 208 gdbtk_create_breakpoint(b)
 209      struct breakpoint *b;
 210 {
 211   breakpoint_notify(b, "create");
 212 }
 213
 214 static void
 215 gdbtk_delete_breakpoint(b)
 216      struct breakpoint *b;
 217 {
 218   breakpoint_notify(b, "delete");
 219 }
 220
 221 static void
 222 gdbtk_enable_breakpoint(b)
 223      struct breakpoint *b;
 224 {
 225   breakpoint_notify(b, "enable");
 226 }
 227
 228 static void
 229 gdbtk_disable_breakpoint(b)
 230      struct breakpoint *b;
 231 {
 232   breakpoint_notify(b, "disable");
 233 }
 234 \f
 235 /* This implements the TCL command `gdb_loc', which returns a list consisting
 236    of the source and line number associated with the current pc. */
 237
 238 static int
 239 gdb_loc (clientData, interp, argc, argv)
 240      ClientData clientData;
 241      Tcl_Interp *interp;
 242      int argc;
 243      char *argv[];
 244 {
 245   char *filename;
 246   char buf[100];
 247   struct symtab_and_line sal;
 248   char *funcname;
 249   CORE_ADDR pc;
 250
 251   if (argc == 1)
 252     {
 253       struct frame_info *frame;
 254       struct symbol *func;
 255
 256       frame = get_frame_info (selected_frame);
 257
 258       pc = frame ? frame->pc : stop_pc;
 259
 260       sal = find_pc_line (pc, 0);
 261     }
 262   else if (argc == 2)
 263     {
 264       struct symtabs_and_lines sals;
 265       int nelts;
 266
 267       sals = decode_line_spec (argv[1], 1);
 268
 269       nelts = sals.nelts;
 270       sal = sals.sals[0];
 271       free (sals.sals);
 272
 273       if (sals.nelts != 1)
 274         {
 275           Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC);
 276           return TCL_ERROR;
 277         }
 278
 279       pc = sal.pc;
 280     }
 281   else
 282     {
 283       Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
 284       return TCL_ERROR;
 285     }
 286
 287   if (sal.symtab)
 288     Tcl_AppendElement (interp, sal.symtab->filename);
 289   else
 290     Tcl_AppendElement (interp, "");
 291
 292   find_pc_partial_function (pc, &funcname, NULL, NULL);
 293   Tcl_AppendElement (interp, funcname);
 294
 295   filename = symtab_to_filename (sal.symtab);
 296   Tcl_AppendElement (interp, filename);
 297
 298   sprintf (buf, "%d", sal.line);
 299   Tcl_AppendElement (interp, buf); /* line number */
 300
 301   sprintf (buf, "0x%x", pc);
 302   Tcl_AppendElement (interp, buf); /* PC */
 303
 304   return TCL_OK;
 305 }
 306 \f
 307 static int
 308 gdb_cmd_stub (cmd)
 309      char *cmd;
 310 {
 311   execute_command (cmd, 1);
 312
 313   return 1;                     /* Indicate success */
 314 }
 315
 316 /* This implements the TCL command `gdb_cmd', which sends it's argument into
 317    the GDB command scanner.  */
 318
 319 static int
 320 gdb_cmd (clientData, interp, argc, argv)
 321      ClientData clientData;
 322      Tcl_Interp *interp;
 323      int argc;
 324      char *argv[];
 325 {
 326   int val;
 327   struct cleanup *old_chain;
 328
 329   if (argc != 2)
 330     {
 331       Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
 332       return TCL_ERROR;
 333     }
 334
 335   old_chain = make_cleanup (null_routine, 0);
 336
 337   val = catch_errors (gdb_cmd_stub, argv[1], "", RETURN_MASK_ERROR);
 338
 339   bpstat_do_actions (&stop_bpstat);
 340   do_cleanups (old_chain);
 341
 342   /* Drain all buffered command output */
 343
 344   gdb_flush (gdb_stderr);
 345   gdb_flush (gdb_stdout);
 346
 347   /* We could base the return value on val, but that would require most users
 348      to use catch.  Since GDB errors are already being handled elsewhere, I
 349      see no reason to pass them up to the caller. */
 350
 351   return TCL_OK;
 352 }
 353
 354 static int
 355 gdb_listfiles (clientData, interp, argc, argv)
 356      ClientData clientData;
 357      Tcl_Interp *interp;
 358      int argc;
 359      char *argv[];
 360 {
 361   int val;
 362   struct objfile *objfile;
 363   struct partial_symtab *psymtab;
 364
 365   ALL_PSYMTABS (objfile, psymtab)
 366     Tcl_AppendElement (interp, psymtab->filename);
 367
 368   return TCL_OK;
 369 }
 370 \f
 371 static void
 372 tk_command (cmd, from_tty)
 373      char *cmd;
 374      int from_tty;
 375 {
 376   Tcl_VarEval (interp, cmd, NULL);
 377
 378   gdbtk_fputs (interp->result);
 379   gdbtk_fputs ("\n");
 380 }
 381
 382 static void
 383 cleanup_init (ignored)
 384      int ignored;
 385 {
 386   if (mainWindow != NULL)
 387     Tk_DestroyWindow (mainWindow);
 388   mainWindow = NULL;
 389
 390   if (interp != NULL)
 391     Tcl_DeleteInterp (interp);
 392   interp = NULL;
 393 }
 394
 395 /* Come here during long calculations to check for GUI events.  Usually invoked
 396    via the QUIT macro.  */
 397
 398 static void
 399 gdbtk_interactive ()
 400 {
 401   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
 402 }
 403
 404 static void
 405 gdbtk_init ()
 406 {
 407   struct cleanup *old_chain;
 408   char *gdbtk_filename;
 409
 410   old_chain = make_cleanup (cleanup_init, 0);
 411
 412   /* First init tcl and tk. */
 413
 414   interp = Tcl_CreateInterp ();
 415
 416   if (!interp)
 417     error ("Tcl_CreateInterp failed");
 418
 419   mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
 420
 421   if (!mainWindow)
 422     return;                     /* DISPLAY probably not set */
 423
 424   if (Tcl_Init(interp) != TCL_OK)
 425     error ("Tcl_Init failed: %s", interp->result);
 426
 427   if (Tk_Init(interp) != TCL_OK)
 428     error ("Tk_Init failed: %s", interp->result);
 429
 430   Tcl_CreateCommand (interp, "gdb_cmd", gdb_cmd, NULL, NULL);
 431   Tcl_CreateCommand (interp, "gdb_loc", gdb_loc, NULL, NULL);
 432   Tcl_CreateCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
 433
 434   gdbtk_filename = getenv ("GDBTK_FILENAME");
 435   if (!gdbtk_filename)
 436     if (access ("gdbtk.tcl", R_OK) == 0)
 437       gdbtk_filename = "gdbtk.tcl";
 438     else
 439       gdbtk_filename = GDBTK_FILENAME;
 440
 441   if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
 442     error ("Failure reading %s: %s", gdbtk_filename, interp->result);
 443
 444   command_loop_hook = Tk_MainLoop;
 445   fputs_unfiltered_hook = gdbtk_fputs;
 446   print_frame_info_listing_hook = null_routine;
 447   query_hook = gdbtk_query;
 448   flush_hook = gdbtk_flush;
 449   create_breakpoint_hook = gdbtk_create_breakpoint;
 450   delete_breakpoint_hook = gdbtk_delete_breakpoint;
 451   enable_breakpoint_hook = gdbtk_enable_breakpoint;
 452   disable_breakpoint_hook = gdbtk_disable_breakpoint;
 453   interactive_hook = gdbtk_interactive;
 454
 455   discard_cleanups (old_chain);
 456
 457   add_com ("tk", class_obscure, tk_command,
 458            "Send a command directly into tk.");
 459 }
 460
 461 /* Come here during initialze_all_files () */
 462
 463 void
 464 _initialize_gdbtk ()
 465 {
 466   if (no_windows)
 467     return;
 468
 469   /* Tell the rest of the world that Gdbtk is now set up. */
 470
 471   init_ui_hook = gdbtk_init;
 472 }