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