gdb/gdbtk.c

   1 /* Startup code for gdbtk.
   2    Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
   3
   4    Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
   5
   6 This file is part of GDB.
   7
   8 This program is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 2 of the License, or
  11 (at your option) any later version.
  12
  13 This program is distributed in the hope that it will be useful,
  14 but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 GNU General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with this program; if not, write to the Free Software
  20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.  */
  21
  22 #include "defs.h"
  23 #include "symtab.h"
  24 #include "inferior.h"
  25 #include "command.h"
  26 #include "bfd.h"
  27 #include "symfile.h"
  28 #include "objfiles.h"
  29 #include "target.h"
  30 #include "gdbcore.h"
  31 #include "tracepoint.h"
  32 #include "demangle.h"
  33
  34 #ifdef _WIN32
  35 #include <winuser.h>
  36 #endif
  37
  38 #include <sys/stat.h>
  39
  40 #include <tcl.h>
  41 #include <tk.h>
  42 #include <itcl.h>
  43 #include <tix.h>
  44 #include "guitcl.h"
  45 #include "gdbtk.h"
  46
  47 #ifdef IDE
  48 /* start-sanitize-ide */
  49 #include "event.h"
  50 #include "idetcl.h"
  51 #include "ilutk.h"
  52 /* end-sanitize-ide */
  53 #endif
  54
  55 #ifdef ANSI_PROTOTYPES
  56 #include <stdarg.h>
  57 #else
  58 #include <varargs.h>
  59 #endif
  60 #include <signal.h>
  61 #include <fcntl.h>
  62 #include <unistd.h>
  63 #include <setjmp.h>
  64 #include "top.h"
  65 #include <sys/ioctl.h>
  66 #include "gdb_string.h"
  67 #include "dis-asm.h"
  68 #include <stdio.h>
  69 #include "gdbcmd.h"
  70
  71 #include "annotate.h"
  72 #include <sys/time.h>
  73
  74 /* For Cygwin32, we use a timer to periodically check for Windows
  75    messages.  FIXME: It would be better to not poll, but to instead
  76    rewrite the target_wait routines to serve as input sources.
  77    Unfortunately, that will be a lot of work.  */
  78 static sigset_t nullsigmask;
  79 static struct sigaction act1, act2;
  80 static struct itimerval it_on, it_off;
  81
  82 extern int Tktable_Init PARAMS ((Tcl_Interp *interp));
  83
  84 static void gdbtk_init PARAMS ((char *));
  85 void gdbtk_interactive PARAMS ((void));
  86 static void cleanup_init PARAMS ((int));
  87 static void tk_command PARAMS ((char *, int));
  88
  89 void gdbtk_add_hooks PARAMS ((void));
  90 int gdbtk_test PARAMS ((char *));
  91
  92 /*
  93  * gdbtk_fputs is defined in the gdbtk_hooks.c, but we need it here
  94  * because we delay adding this hook till all the setup is done.  That
  95  * way errors will go to stdout.
  96  */
  97
  98 extern void   gdbtk_fputs PARAMS ((const char *, FILE *));
  99
 100 /* Handle for TCL interpreter */
 101 Tcl_Interp *gdbtk_interp = NULL;
 102
 103 static int gdbtk_timer_going = 0;
 104
 105 /* This variable is true when the inferior is running.  See note in
 106  * gdbtk.h for details.
 107  */
 108
 109 int running_now;
 110
 111 /* This variable determines where memory used for disassembly is read from.
 112  * See note in gdbtk.h for details.
 113  */
 114
 115 int disassemble_from_exec = -1;
 116
 117 /* This variable holds the name of a Tcl file which should be sourced by the
 118    interpreter when it goes idle at startup. Used with the testsuite. */
 119
 120 static char *gdbtk_source_filename = NULL;
 121 \f
 122 #ifndef _WIN32
 123
 124 /* Supply malloc calls for tcl/tk.  We do not want to do this on
 125    Windows, because Tcl_Alloc is probably in a DLL which will not call
 126    the mmalloc routines.  */
 127
 128 char *
 129 Tcl_Alloc (size)
 130      unsigned int size;
 131 {
 132   return xmalloc (size);
 133 }
 134
 135 char *
 136 Tcl_Realloc (ptr, size)
 137      char *ptr;
 138      unsigned int size;
 139 {
 140   return xrealloc (ptr, size);
 141 }
 142
 143 void
 144 Tcl_Free(ptr)
 145      char *ptr;
 146 {
 147   free (ptr);
 148 }
 149
 150 #endif /* ! _WIN32 */
 151
 152 #ifdef _WIN32
 153
 154 /* On Windows, if we hold a file open, other programs can't write to
 155  * it.  In particular, we don't want to hold the executable open,
 156  * because it will mean that people have to get out of the debugging
 157  * session in order to remake their program.  So we close it, although
 158  * this will cost us if and when we need to reopen it.
 159  */
 160
 161 void
 162 close_bfds ()
 163 {
 164   struct objfile *o;
 165
 166   ALL_OBJFILES (o)
 167     {
 168       if (o->obfd != NULL)
 169         bfd_cache_close (o->obfd);
 170     }
 171
 172   if (exec_bfd != NULL)
 173     bfd_cache_close (exec_bfd);
 174 }
 175
 176 #endif /* _WIN32 */
 177
 178 \f
 179 /* TclDebug (const char *fmt, ...) works just like printf() but
 180  * sends the output to the GDB TK debug window.
 181  * Not for normal use; just a convenient tool for debugging
 182  */
 183
 184 void
 185 #ifdef ANSI_PROTOTYPES
 186 TclDebug (const char *fmt, ...)
 187 #else
 188 TclDebug (va_alist)
 189      va_dcl
 190 #endif
 191 {
 192   va_list args;
 193   char buf[512], *v[2], *merge;
 194
 195 #ifdef ANSI_PROTOTYPES
 196   va_start (args, fmt);
 197 #else
 198   char *fmt;
 199   va_start (args);
 200   fmt = va_arg (args, char *);
 201 #endif
 202
 203   v[0] = "debug";
 204   v[1] = buf;
 205
 206   vsprintf (buf, fmt, args);
 207   va_end (args);
 208
 209   merge = Tcl_Merge (2, v);
 210   Tcl_Eval (gdbtk_interp, merge);
 211   Tcl_Free (merge);
 212 }
 213
 214 \f
 215 /*
 216  * The rest of this file contains the start-up, and event handling code for gdbtk.
 217  */
 218
 219 /*
 220  * This cleanup function is added to the cleanup list that surrounds the Tk
 221  * main in gdbtk_init.  It deletes the Tcl interpreter.
 222  */
 223
 224 static void
 225 cleanup_init (ignored)
 226      int ignored;
 227 {
 228   if (gdbtk_interp != NULL)
 229     Tcl_DeleteInterp (gdbtk_interp);
 230   gdbtk_interp = NULL;
 231 }
 232
 233 /* Come here during long calculations to check for GUI events.  Usually invoked
 234    via the QUIT macro.  */
 235
 236 void
 237 gdbtk_interactive ()
 238 {
 239   /* Tk_DoOneEvent (TK_DONT_WAIT|TK_IDLE_EVENTS); */
 240 }
 241
 242
 243 void
 244 gdbtk_start_timer ()
 245 {
 246   static int first = 1;
 247   /*TclDebug ("Starting timer....");*/
 248   if (first)
 249     {
 250       /* first time called, set up all the structs */
 251       first = 0;
 252       sigemptyset (&nullsigmask);
 253
 254       act1.sa_handler = x_event;
 255       act1.sa_mask = nullsigmask;
 256       act1.sa_flags = 0;
 257
 258       act2.sa_handler = SIG_IGN;
 259       act2.sa_mask = nullsigmask;
 260       act2.sa_flags = 0;
 261
 262       it_on.it_interval.tv_sec = 0;
 263       it_on.it_interval.tv_usec = 250000; /* .25 sec */
 264       it_on.it_value.tv_sec = 0;
 265       it_on.it_value.tv_usec = 250000;
 266
 267       it_off.it_interval.tv_sec = 0;
 268       it_off.it_interval.tv_usec = 0;
 269       it_off.it_value.tv_sec = 0;
 270       it_off.it_value.tv_usec = 0;
 271     }
 272
 273   if (!gdbtk_timer_going)
 274     {
 275       sigaction (SIGALRM, &act1, NULL);
 276       setitimer (ITIMER_REAL, &it_on, NULL);
 277       gdbtk_timer_going = 1;
 278     }
 279 }
 280
 281 void
 282 gdbtk_stop_timer ()
 283 {
 284   if (gdbtk_timer_going)
 285     {
 286       gdbtk_timer_going = 0;
 287       /*TclDebug ("Stopping timer.");*/
 288       setitimer (ITIMER_REAL, &it_off, NULL);
 289       sigaction (SIGALRM, &act2, NULL);
 290     }
 291 }
 292
 293 /* gdbtk_init installs this function as a final cleanup.  */
 294
 295 static void
 296 gdbtk_cleanup (dummy)
 297      PTR dummy;
 298 {
 299   Tcl_Eval (gdbtk_interp, "gdbtk_cleanup");
 300 #ifdef IDE
 301   struct ide_event_handle *h = (struct ide_event_handle *) dummy;
 302   ide_interface_deregister_all (h);
 303 #endif
 304   Tcl_Finalize ();
 305 }
 306
 307 /* Initialize gdbtk.  This involves creating a Tcl interpreter,
 308  * defining all the Tcl commands that the GUI will use, pointing
 309  * all the gdb "hooks" to the correct functions,
 310  * and setting the Tcl auto loading environment so that we can find all
 311  * the Tcl based library files.
 312  */
 313
 314 static void
 315 gdbtk_init ( argv0 )
 316      char *argv0;
 317 {
 318   struct cleanup *old_chain;
 319   char *lib, *gdbtk_lib, *gdbtk_lib_tmp, *gdbtk_file;
 320   int found_main;
 321   Tcl_Obj *auto_path_elem, *auto_path_name;
 322
 323 #ifdef IDE
 324   /* start-sanitize-ide */
 325   struct ide_event_handle *h;
 326   const char *errmsg;
 327   char *libexecdir;
 328   /* end-sanitize-ide */
 329 #endif
 330
 331   /* If there is no DISPLAY environment variable, Tk_Init below will fail,
 332      causing gdb to abort.  If instead we simply return here, gdb will
 333      gracefully degrade to using the command line interface. */
 334
 335 #ifndef WINNT
 336   if (getenv ("DISPLAY") == NULL)
 337     return;
 338 #endif
 339
 340   old_chain = make_cleanup (cleanup_init, 0);
 341
 342   /* First init tcl and tk. */
 343   Tcl_FindExecutable (argv0);
 344   gdbtk_interp = Tcl_CreateInterp ();
 345
 346 #ifdef TCL_MEM_DEBUG
 347   Tcl_InitMemory (gdbtk_interp);
 348 #endif
 349
 350   if (!gdbtk_interp)
 351     error ("Tcl_CreateInterp failed");
 352
 353   if (Tcl_Init(gdbtk_interp) != TCL_OK)
 354     error ("Tcl_Init failed: %s", gdbtk_interp->result);
 355
 356 #ifndef IDE
 357   /* For the IDE we register the cleanup later, after we've
 358      initialized events.  */
 359   make_final_cleanup (gdbtk_cleanup,  NULL);
 360 #endif
 361
 362   /* Initialize the Paths variable.  */
 363   if (ide_initialize_paths (gdbtk_interp, "gdbtcl") != TCL_OK)
 364     error ("ide_initialize_paths failed: %s", gdbtk_interp->result);
 365
 366 #ifdef IDE
 367   /* start-sanitize-ide */
 368   /* Find the directory where we expect to find idemanager.  We ignore
 369      errors since it doesn't really matter if this fails.  */
 370   libexecdir = Tcl_GetVar2 (gdbtk_interp, "Paths", "libexecdir", TCL_GLOBAL_ONLY);
 371
 372   IluTk_Init ();
 373
 374   h = ide_event_init_from_environment (&errmsg, libexecdir);
 375   make_final_cleanup (gdbtk_cleanup, h);
 376   if (h == NULL)
 377     {
 378       Tcl_AppendResult (gdbtk_interp, "can't initialize event system: ", errmsg,
 379                         (char *) NULL);
 380       fprintf(stderr, "WARNING: ide_event_init_client failed: %s\n", gdbtk_interp->result);
 381
 382       Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0);
 383     }
 384   else
 385     {
 386       if (ide_create_tclevent_command (gdbtk_interp, h) != TCL_OK)
 387         error ("ide_create_tclevent_command failed: %s", gdbtk_interp->result);
 388
 389       if (ide_create_edit_command (gdbtk_interp, h) != TCL_OK)
 390         error ("ide_create_edit_command failed: %s", gdbtk_interp->result);
 391
 392       if (ide_create_property_command (gdbtk_interp, h) != TCL_OK)
 393         error ("ide_create_property_command failed: %s", gdbtk_interp->result);
 394
 395       if (ide_create_build_command (gdbtk_interp, h) != TCL_OK)
 396         error ("ide_create_build_command failed: %s", gdbtk_interp->result);
 397
 398       if (ide_create_window_register_command (gdbtk_interp, h, "gdb-restore")
 399           != TCL_OK)
 400         error ("ide_create_window_register_command failed: %s",
 401                gdbtk_interp->result);
 402
 403       if (ide_create_window_command (gdbtk_interp, h) != TCL_OK)
 404         error ("ide_create_window_command failed: %s", gdbtk_interp->result);
 405
 406       if (ide_create_exit_command (gdbtk_interp, h) != TCL_OK)
 407         error ("ide_create_exit_command failed: %s", gdbtk_interp->result);
 408
 409       if (ide_create_help_command (gdbtk_interp) != TCL_OK)
 410         error ("ide_create_help_command failed: %s", gdbtk_interp->result);
 411
 412       /*
 413         if (ide_initialize (gdbtk_interp, "gdb") != TCL_OK)
 414         error ("ide_initialize failed: %s", gdbtk_interp->result);
 415       */
 416
 417       Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "1", 0);
 418     }
 419   /* end-sanitize-ide */
 420 #else
 421   Tcl_SetVar (gdbtk_interp, "IDE_ENABLED", "0", 0);
 422 #endif /* IDE */
 423
 424   /* We don't want to open the X connection until we've done all the
 425      IDE initialization.  Otherwise, goofy looking unfinished windows
 426      pop up when ILU drops into the TCL event loop.  */
 427
 428   if (Tk_Init(gdbtk_interp) != TCL_OK)
 429     error ("Tk_Init failed: %s", gdbtk_interp->result);
 430
 431   if (Itcl_Init(gdbtk_interp) == TCL_ERROR)
 432     error ("Itcl_Init failed: %s", gdbtk_interp->result);
 433   Tcl_StaticPackage(gdbtk_interp, "Tktable", Tktable_Init,
 434                     (Tcl_PackageInitProc *) NULL);
 435
 436   if (Tix_Init(gdbtk_interp) != TCL_OK)
 437     error ("Tix_Init failed: %s", gdbtk_interp->result);
 438   Tcl_StaticPackage(gdbtk_interp, "Tktable", Tktable_Init,
 439                     (Tcl_PackageInitProc *) NULL);
 440
 441   if (Tktable_Init(gdbtk_interp) != TCL_OK)
 442     error ("Tktable_Init failed: %s", gdbtk_interp->result);
 443
 444   Tcl_StaticPackage(gdbtk_interp, "Tktable", Tktable_Init,
 445                     (Tcl_PackageInitProc *) NULL);
 446   /*
 447    * These are the commands to do some Windows Specific stuff...
 448    */
 449
 450 #ifdef __CYGWIN32__
 451   if (ide_create_messagebox_command (gdbtk_interp) != TCL_OK)
 452     error ("messagebox command initialization failed");
 453   /* On Windows, create a sizebox widget command */
 454   if (ide_create_sizebox_command (gdbtk_interp) != TCL_OK)
 455     error ("sizebox creation failed");
 456   if (ide_create_winprint_command (gdbtk_interp) != TCL_OK)
 457     error ("windows print code initialization failed");
 458   /* start-sanitize-ide */
 459   /* An interface to ShellExecute.  */
 460   if (ide_create_shell_execute_command (gdbtk_interp) != TCL_OK)
 461     error ("shell execute command initialization failed");
 462   /* end-sanitize-ide */
 463   if (ide_create_win_grab_command (gdbtk_interp) != TCL_OK)
 464     error ("grab support command initialization failed");
 465   /* Path conversion functions.  */
 466   if (ide_create_cygwin_path_command (gdbtk_interp) != TCL_OK)
 467     error ("cygwin path command initialization failed");
 468 #endif
 469
 470   /*
 471    * This adds all the Gdbtk commands.
 472    */
 473
 474   if (Gdbtk_Init(gdbtk_interp) != TCL_OK)
 475     {
 476        error("Gdbtk_Init failed: %s", gdbtk_interp->result);
 477     }
 478
 479   Tcl_StaticPackage(gdbtk_interp, "Gdbtk", Gdbtk_Init, NULL);
 480
 481   /* This adds all the hooks that call up from the bowels of gdb
 482    *  back into Tcl-land...
 483    */
 484
 485   gdbtk_add_hooks();
 486
 487   /* Add a back door to Tk from the gdb console... */
 488
 489   add_com ("tk", class_obscure, tk_command,
 490            "Send a command directly into tk.");
 491
 492   Tcl_LinkVar (gdbtk_interp, "disassemble-from-exec", (char *) &disassemble_from_exec,
 493                TCL_LINK_INT);
 494
 495   /* find the gdb tcl library and source main.tcl */
 496
 497   gdbtk_lib = getenv ("GDBTK_LIBRARY");
 498   if (!gdbtk_lib)
 499     {
 500       if (access ("gdbtcl/main.tcl", R_OK) == 0)
 501         gdbtk_lib = "gdbtcl";
 502       else
 503         gdbtk_lib = GDBTK_LIBRARY;
 504     }
 505
 506   gdbtk_lib_tmp = xstrdup (gdbtk_lib);
 507
 508   found_main = 0;
 509   /* see if GDBTK_LIBRARY is a path list */
 510   lib = strtok (gdbtk_lib_tmp, GDBTK_PATH_SEP);
 511
 512   auto_path_name = Tcl_NewStringObj ("auto_path", -1);
 513
 514   do
 515     {
 516       auto_path_elem = Tcl_NewStringObj (lib, -1);
 517       if (Tcl_ObjSetVar2 (gdbtk_interp, auto_path_name, NULL, auto_path_elem,
 518                           TCL_GLOBAL_ONLY | TCL_APPEND_VALUE | TCL_LIST_ELEMENT ) == NULL)
 519         {
 520           fputs_unfiltered (Tcl_GetVar (gdbtk_interp, "errorInfo", 0), gdb_stderr);
 521           error ("");
 522         }
 523       if (!found_main)
 524         {
 525           gdbtk_file = concat (lib, "/main.tcl", (char *) NULL);
 526           if (access (gdbtk_file, R_OK) == 0)
 527             {
 528               found_main++;
 529               Tcl_SetVar (gdbtk_interp, "GDBTK_LIBRARY", lib, 0);
 530             }
 531         }
 532      }
 533   while ((lib = strtok (NULL, ":")) != NULL);
 534
 535   free (gdbtk_lib_tmp);
 536   Tcl_DecrRefCount(auto_path_name);
 537
 538   if (!found_main)
 539     {
 540       /* Try finding it with the auto path.  */
 541
 542       static const char script[] ="\
 543 proc gdbtk_find_main {} {\n\
 544   global auto_path GDBTK_LIBRARY\n\
 545   foreach dir $auto_path {\n\
 546     set f [file join $dir main.tcl]\n\
 547     if {[file exists $f]} then {\n\
 548       set GDBTK_LIBRARY $dir\n\
 549       return $f\n\
 550     }\n\
 551   }\n\
 552   return ""\n\
 553 }\n\
 554 gdbtk_find_main";
 555
 556       if (Tcl_GlobalEval (gdbtk_interp, (char *) script) != TCL_OK)
 557         {
 558           fputs_unfiltered (Tcl_GetVar (gdbtk_interp, "errorInfo", 0), gdb_stderr);
 559           error ("");
 560         }
 561
 562       if (gdbtk_interp->result[0] != '\0')
 563         {
 564           gdbtk_file = xstrdup (gdbtk_interp->result);
 565           found_main++;
 566         }
 567     }
 568
 569   if (!found_main)
 570     {
 571       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
 572       if (getenv("GDBTK_LIBRARY"))
 573         {
 574           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n",getenv("GDBTK_LIBRARY"));
 575           fprintf_unfiltered (stderr,
 576                               "Please set GDBTK_LIBRARY to a path that includes the GDB tcl files.\n");
 577         }
 578       else
 579         {
 580           fprintf_unfiltered (stderr, "Unable to find main.tcl in %s\n", GDBTK_LIBRARY);
 581           fprintf_unfiltered (stderr, "You might want to set GDBTK_LIBRARY\n");
 582         }
 583       error("");
 584     }
 585
 586 /* Defer setup of fputs_unfiltered_hook to near the end so that error messages
 587    prior to this point go to stdout/stderr.  */
 588
 589   fputs_unfiltered_hook = gdbtk_fputs;
 590
 591 /* start-sanitize-tclpro */
 592 #ifdef TCLPRO_DEBUGGER
 593   {
 594     Tcl_DString source_cmd;
 595
 596     Tcl_DStringInit (&source_cmd);
 597     Tcl_DStringAppend (&source_cmd,
 598                       "if {[info exists env(DEBUG_STUB)]} {source $env(DEBUG_STUB); " -1);
 599     Tcl_DStringAppend (&source_cmd, "debugger_init; debugger_eval {source {", -1);
 600     Tcl_DStringAppend (&source_cmd, gdbtk_file, -1);
 601     Tcl_DStringAppend (&source_cmd, "}}} else {source {", -1);
 602     Tcl_DStringAppend (&source_cmd, gdbtk_file, -1);
 603     Tcl_DStringAppend (&source_cmd, "}}", -1);
 604     if (Tcl_GlobalEval (gdbtk_interp, Tcl_DStringValue (&source_cmd)) != TCL_OK)
 605 #else
 606 /* end-sanitize-tclpro */
 607       if (Tcl_EvalFile (gdbtk_interp, gdbtk_file) != TCL_OK)
 608 /* start-sanitize-tclpro */
 609 #endif
 610 /* end-sanitize-tclpro */
 611         {
 612       char *msg;
 613
 614       /* Force errorInfo to be set up propertly.  */
 615       Tcl_AddErrorInfo (gdbtk_interp, "");
 616
 617       msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
 618
 619       fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
 620
 621 #ifdef _WIN32
 622       MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
 623 #else
 624       fputs_unfiltered (msg, gdb_stderr);
 625 #endif
 626
 627       error ("");
 628     }
 629 /* start-sanitize-tclpro */
 630 #ifdef TCLPRO_DEBUGGER
 631       Tcl_DStringFree(&source_cmd);
 632     }
 633 #endif
 634 /* end-sanitize-tclpro */
 635
 636 #ifdef IDE
 637   /* start-sanitize-ide */
 638   /* Don't do this until we have initialized.  Otherwise, we may get a
 639      run command before we are ready for one.  */
 640   if (ide_run_server_init (gdbtk_interp, h) != TCL_OK)
 641     error ("ide_run_server_init failed: %s", gdbtk_interp->result);
 642   /* end-sanitize-ide */
 643 #endif
 644
 645   free (gdbtk_file);
 646
 647   /* Now source in the filename provided by the --tclcommand option.
 648      This is mostly used for the gdbtk testsuite... */
 649
 650   if (gdbtk_source_filename != NULL)
 651     {
 652       char *s = "after idle source ";
 653       char *script = concat (s, gdbtk_source_filename, (char *) NULL);
 654       Tcl_Eval (gdbtk_interp, script);
 655       free (gdbtk_source_filename);
 656       free (script);
 657     }
 658
 659
 660   discard_cleanups (old_chain);
 661 }
 662
 663 /* gdbtk_test is used in main.c to validate the -tclcommand option to
 664    gdb, which sources in a file of tcl code after idle during the
 665    startup procedure. */
 666
 667 int
 668 gdbtk_test (filename)
 669      char *filename;
 670 {
 671   if (access (filename, R_OK) != 0)
 672     return 0;
 673   else
 674     gdbtk_source_filename = xstrdup (filename);
 675   return 1;
 676 }
 677
 678 /* Come here during initialize_all_files () */
 679
 680 void
 681 _initialize_gdbtk ()
 682 {
 683   if (use_windows)
 684     {
 685       /* Tell the rest of the world that Gdbtk is now set up. */
 686
 687       init_ui_hook = gdbtk_init;
 688 #ifdef __CYGWIN32__
 689       (void) FreeConsole ();
 690 #endif
 691     }
 692 #ifdef __CYGWIN32__
 693   else
 694     {
 695       DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE));
 696       void cygwin32_attach_handle_to_fd (char *, int, HANDLE, int, int);
 697
 698       switch (ft)
 699         {
 700           case FILE_TYPE_DISK:
 701           case FILE_TYPE_CHAR:
 702           case FILE_TYPE_PIPE:
 703             break;
 704           default:
 705             AllocConsole();
 706             cygwin32_attach_handle_to_fd ("/dev/conin", 0,
 707                                           GetStdHandle (STD_INPUT_HANDLE),
 708                                           1, GENERIC_READ);
 709             cygwin32_attach_handle_to_fd ("/dev/conout", 1,
 710                                           GetStdHandle (STD_OUTPUT_HANDLE),
 711                                           0, GENERIC_WRITE);
 712             cygwin32_attach_handle_to_fd ("/dev/conout", 2,
 713                                           GetStdHandle (STD_ERROR_HANDLE),
 714                                           0, GENERIC_WRITE);
 715             break;
 716         }
 717     }
 718 #endif
 719 }
 720
 721 static void
 722 tk_command (cmd, from_tty)
 723      char *cmd;
 724      int from_tty;
 725 {
 726   int retval;
 727   char *result;
 728   struct cleanup *old_chain;
 729
 730   /* Catch case of no argument, since this will make the tcl interpreter dump core. */
 731   if (cmd == NULL)
 732     error_no_arg ("tcl command to interpret");
 733
 734   retval = Tcl_Eval (gdbtk_interp, cmd);
 735
 736   result = strdup (gdbtk_interp->result);
 737
 738   old_chain = make_cleanup (free, result);
 739
 740   if (retval != TCL_OK)
 741     error (result);
 742
 743   printf_unfiltered ("%s\n", result);
 744
 745   do_cleanups (old_chain);
 746 }
 747