#include "defs.h"
#include "inferior.h"
#include "symfile.h"
#include "objfiles.h"
#include "gdbcore.h"
#include "tracepoint.h"
#include "demangle.h"
#include "version.h"
#include "top.h"
#include "annotate.h"
#if defined(_WIN32) || defined(__CYGWIN__)
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#endif
#define HAS_STDARG 1
#include <itcl.h>
#include <itk.h>
#include "guitcl.h"
#include "gdbtk.h"
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/ioctl.h>
#include <sys/time.h>
#include <signal.h>
#include "gdb_string.h"
#include "dis-asm.h"
#include "gdbcmd.h"
#ifdef __CYGWIN32__
#include <sys/cygwin.h>
#endif
extern void _initialize_gdbtk (void);
static sigset_t nullsigmask;
static struct sigaction act1, act2;
static struct itimerval it_on, it_off;
static void
x_event_wrapper (int signo)
{
x_event (signo);
}
char *external_editor_command = NULL;
extern int Tktable_Init (Tcl_Interp * interp);
void gdbtk_init (void);
static void gdbtk_init_1 (char *argv0);
void gdbtk_interactive (void);
static void cleanup_init (void *ignore);
static void tk_command (char *, int);
static int target_should_use_timer (struct target_ops *t);
int target_is_native (struct target_ops *t);
int gdbtk_test (char *);
static void view_command (char *, int);
Tcl_Interp *gdbtk_interp = NULL;
static int gdbtk_timer_going = 0;
int gdb_context = 0;
int running_now;
static char *gdbtk_source_filename = NULL;
int gdbtk_disable_fputs = 1;
static const char *argv0;
#ifndef _WIN32
#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
char *
TclpAlloc (unsigned int size)
{
return xmalloc (size);
}
char *
TclpRealloc (char *ptr, unsigned int size)
{
return xrealloc (ptr, size);
}
void
TclpFree (char *ptr)
{
free (ptr);
}
#endif
#endif
#ifdef _WIN32
void
close_bfds ()
{
struct objfile *o;
ALL_OBJFILES (o)
{
if (o->obfd != NULL)
bfd_cache_close (o->obfd);
}
if (exec_bfd != NULL)
bfd_cache_close (exec_bfd);
}
#endif
void
TclDebug (char level, const char *fmt,...)
{
va_list args;
char *buf;
const char *v[3];
char *merge;
char *priority;
switch (level)
{
case 'W':
priority = "W";
break;
case 'E':
priority = "E";
break;
case 'X':
priority = "X";
break;
default:
priority = "I";
}
va_start (args, fmt);
xvasprintf (&buf, fmt, args);
va_end (args);
v[0] = "dbug";
v[1] = priority;
v[2] = buf;
merge = Tcl_Merge (3, v);
if (Tcl_Eval (gdbtk_interp, merge) != TCL_OK)
Tcl_BackgroundError (gdbtk_interp);
Tcl_Free (merge);
free(buf);
}
static void
cleanup_init (void *ignore)
{
if (gdbtk_interp != NULL)
Tcl_DeleteInterp (gdbtk_interp);
gdbtk_interp = NULL;
}
void
gdbtk_interactive ()
{
}
void
gdbtk_start_timer ()
{
static int first = 1;
if (first)
{
first = 0;
sigemptyset (&nullsigmask);
act1.sa_handler = x_event_wrapper;
act1.sa_mask = nullsigmask;
act1.sa_flags = 0;
act2.sa_handler = SIG_IGN;
act2.sa_mask = nullsigmask;
act2.sa_flags = 0;
it_on.it_interval.tv_sec = 0;
it_on.it_interval.tv_usec = 250000;
it_on.it_value.tv_sec = 0;
it_on.it_value.tv_usec = 250000;
it_off.it_interval.tv_sec = 0;
it_off.it_interval.tv_usec = 0;
it_off.it_value.tv_sec = 0;
it_off.it_value.tv_usec = 0;
}
if (target_should_use_timer (¤t_target))
{
if (!gdbtk_timer_going)
{
sigaction (SIGALRM, &act1, NULL);
setitimer (ITIMER_REAL, &it_on, NULL);
gdbtk_timer_going = 1;
}
}
return;
}
void
gdbtk_stop_timer ()
{
if (gdbtk_timer_going)
{
gdbtk_timer_going = 0;
setitimer (ITIMER_REAL, &it_off, NULL);
sigaction (SIGALRM, &act2, NULL);
}
return;
}
static int
target_should_use_timer (struct target_ops *t)
{
return target_is_native (t);
}
int
target_is_native (struct target_ops *t)
{
char *name = t->to_shortname;
if (strcmp (name, "exec") == 0 || strcmp (name, "hpux-threads") == 0
|| strcmp (name, "child") == 0 || strcmp (name, "procfs") == 0
|| strcmp (name, "solaris-threads") == 0
|| strcmp (name, "linuxthreads") == 0
|| strcmp (name, "multi-thread") == 0)
return 1;
return 0;
}
static void
gdbtk_cleanup (PTR dummy)
{
Tcl_Eval (gdbtk_interp, "gdbtk_cleanup");
Tcl_Finalize ();
}
void
gdbtk_init (void)
{
struct cleanup *old_chain;
char *s;
int element_count;
const char **exec_path;
CONST char *internal_exec_name;
#ifndef _WIN32
if (getenv ("DISPLAY") == NULL)
{
return;
}
#endif
old_chain = make_cleanup (cleanup_init, 0);
Tcl_FindExecutable (argv0);
gdbtk_interp = Tcl_CreateInterp ();
#ifdef TCL_MEM_DEBUG
Tcl_InitMemory (gdbtk_interp);
#endif
if (!gdbtk_interp)
error ("Tcl_CreateInterp failed");
internal_exec_name = Tcl_GetNameOfExecutable ();
Tcl_SplitPath ((char *) internal_exec_name, &element_count, &exec_path);
if (strcmp (exec_path[element_count - 2], "bin") != 0)
{
static char set_libs_path_script[] = "\
set srcDir [file dirname [file dirname $env(TCL_LIBRARY)]];\n\
\
if {![info exists env(TK_LIBRARY)]} {\n\
set env(TK_LIBRARY) [file join $srcDir tk library]\n\
}\n\
\
if {![info exists env(ITCL_LIBRARY)]} {\n\
set env(ITCL_LIBRARY) [file join $srcDir itcl itcl library]\n\
}\n\
\
if {![info exists env(ITK_LIBRARY)]} {\n\
set env(ITK_LIBRARY) [file join $srcDir itcl itk library]\n\
}\n\
\
if {![info exists env(IWIDGETS_LIBRARY)]} {\n\
set env(IWIDGETS_LIBRARY)\
[file join $srcDir itcl iwidgets generic]\n\
}\n\
\
if {![info exists env(TIX_LIBRARY)]} {\n\
set env(TIX_LIBRARY) [file join $srcDir tix library]\n\
}\n\
\
if {![info exists env(GDBTK_LIBRARY)]} {\n\
set env(GDBTK_LIBRARY) [file join $srcDir gdb gdbtk library]\n\
}\n\
\
# Append the directory with the itcl pkg index\n\
if {[info exists env(TCLLIBPATH)]} {\n\
append env(TCLLIBPATH) :[file joing $srcDir itcl]\n\
} else {\n\
set env(TCLLIBPATH) [file join $srcDir itcl]\n\
}\n\
\
# We also need to append the iwidgets library path.\n\
# Unfortunately, there is no IWIDGETS_LIBRARY.\n\
set IWIDGETS_LIBRARY [file join $srcDir itcl iwidgets generic]\n";
Tcl_Obj *commandObj;
if (Tcl_GetVar2 (gdbtk_interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY) == NULL)
{
int i, count;
char *src_dir = SRC_DIR;
const char **src_path;
const char **lib_path;
Tcl_DString lib_dstring;
Tcl_DStringInit (&lib_dstring);
#ifdef __CYGWIN__
src_dir = (char *) alloca (cygwin_posix_to_win32_path_list_buf_size (SRC_DIR));
cygwin_posix_to_win32_path_list (SRC_DIR, src_dir);
#endif
Tcl_SplitPath (src_dir, &count, &src_path);
lib_path = (const char **) alloca ((count + 2) * sizeof (char *));
for (i = 0; i < count - 1; i++)
lib_path[i] = src_path[i];
lib_path[i++] = "tcl";
lib_path[i++] = "library";
Tcl_JoinPath (i, lib_path, &lib_dstring);
Tcl_SetVar2 (gdbtk_interp, "env", "TCL_LIBRARY",
Tcl_DStringValue (&lib_dstring) , TCL_GLOBAL_ONLY);
Tcl_DStringFree (&lib_dstring);
Tcl_Free ((char *) src_path);
}
commandObj = Tcl_NewStringObj (set_libs_path_script, -1);
Tcl_IncrRefCount (commandObj);
Tcl_EvalObj (gdbtk_interp, commandObj);
Tcl_DecrRefCount (commandObj);
}
Tcl_Free ((char *) exec_path);
if (Tcl_Init (gdbtk_interp) != TCL_OK)
error ("Tcl_Init failed: %s", gdbtk_interp->result);
xasprintf (&s, "%d", inhibit_gdbinit);
Tcl_SetVar2 (gdbtk_interp, "GDBStartup", "inhibit_prefs", s, TCL_GLOBAL_ONLY);
free(s);
Tcl_SetVar2 (gdbtk_interp, "GDBStartup", "host_name", (char*) host_name, TCL_GLOBAL_ONLY);
Tcl_SetVar2 (gdbtk_interp, "GDBStartup", "target_name", (char*) target_name, TCL_GLOBAL_ONLY);
make_final_cleanup (gdbtk_cleanup, NULL);
if (ide_initialize_paths (gdbtk_interp, "") != TCL_OK)
error ("ide_initialize_paths failed: %s", gdbtk_interp->result);
if (Tk_Init (gdbtk_interp) != TCL_OK)
error ("Tk_Init failed: %s", gdbtk_interp->result);
if (Itcl_Init (gdbtk_interp) == TCL_ERROR)
error ("Itcl_Init failed: %s", gdbtk_interp->result);
Tcl_StaticPackage (gdbtk_interp, "Itcl", Itcl_Init,
(Tcl_PackageInitProc *) NULL);
if (Itk_Init (gdbtk_interp) == TCL_ERROR)
error ("Itk_Init failed: %s", gdbtk_interp->result);
Tcl_StaticPackage (gdbtk_interp, "Itk", Itk_Init,
(Tcl_PackageInitProc *) NULL);
if (Tktable_Init (gdbtk_interp) != TCL_OK)
error ("Tktable_Init failed: %s", gdbtk_interp->result);
Tcl_StaticPackage (gdbtk_interp, "Tktable", Tktable_Init,
(Tcl_PackageInitProc *) NULL);
#ifdef __CYGWIN32__
if (ide_create_messagebox_command (gdbtk_interp) != TCL_OK)
error ("messagebox command initialization failed");
#if 0
if (ide_create_sizebox_command (gdbtk_interp) != TCL_OK)
error ("sizebox creation failed");
#endif
if (ide_create_winprint_command (gdbtk_interp) != TCL_OK)
error ("windows print code initialization failed");
if (ide_create_win_grab_command (gdbtk_interp) != TCL_OK)
error ("grab support command initialization failed");
if (ide_create_cygwin_path_command (gdbtk_interp) != TCL_OK)
error ("cygwin path command initialization failed");
if (ide_create_shell_execute_command (gdbtk_interp) != TCL_OK)
error ("cygwin shell execute command initialization failed");
#endif
if (cyg_create_warp_pointer_command (gdbtk_interp) != TCL_OK)
error ("warp_pointer command initialization failed");
if (Gdbtk_Init (gdbtk_interp) != TCL_OK)
{
error ("Gdbtk_Init failed: %s", gdbtk_interp->result);
}
Tcl_StaticPackage (gdbtk_interp, "Insight", Gdbtk_Init, NULL);
add_com ("tk", class_obscure, tk_command,
"Send a command directly into tk.");
add_com ("view", class_obscure, view_command,
"View a location in the source window.");
if (external_editor_command != NULL)
{
Tcl_SetVar (gdbtk_interp, "external_editor_command",
external_editor_command, 0);
xfree (external_editor_command);
external_editor_command = NULL;
}
#ifdef __CYGWIN32__
(void) FreeConsole ();
#endif
discard_cleanups (old_chain);
}
void
gdbtk_source_start_file (void)
{
#ifdef NO_TCLPRO_DEBUGGER
static char script[] = "\
proc gdbtk_find_main {} {\n\
global Paths GDBTK_LIBRARY\n\
rename gdbtk_find_main {}\n\
tcl_findLibrary insight 1.0 {} main.tcl GDBTK_LIBRARY GDBTKLIBRARY\n\
set Paths(appdir) $GDBTK_LIBRARY\n\
}\n\
gdbtk_find_main";
#else
static char script[] = "\
proc gdbtk_find_main {} {\n\
global Paths GDBTK_LIBRARY env\n\
rename gdbtk_find_main {}\n\
if {[info exists env(DEBUG_STUB)]} {\n\
source $env(DEBUG_STUB)\n\
debugger_init\n\
set debug_startup 1\n\
} else {\n\
set debug_startup 0\n\
}\n\
tcl_findLibrary insight 1.0 {} main.tcl GDBTK_LIBRARY GDBTK_LIBRARY\n\
set Paths(appdir) $GDBTK_LIBRARY\n\
}\n\
gdbtk_find_main";
#endif
gdbtk_disable_fputs = 0;
if (Tcl_GlobalEval (gdbtk_interp, (char *) script) != TCL_OK)
{
const char *msg;
Tcl_AddErrorInfo (gdbtk_interp, "");
msg = Tcl_GetVar (gdbtk_interp, "errorInfo", TCL_GLOBAL_ONLY);
#ifdef _WIN32
MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
throw_exception (RETURN_ERROR);
#else
error ("%s", msg);
#endif
}
if (gdbtk_source_filename != NULL)
{
char *s = "after idle source ";
char *script = concat (s, gdbtk_source_filename, (char *) NULL);
Tcl_Eval (gdbtk_interp, script);
free (gdbtk_source_filename);
free (script);
}
}
static void
gdbtk_init_1 (char *arg0)
{
argv0 = arg0;
init_ui_hook = NULL;
}
int
gdbtk_test (char *filename)
{
if (access (filename, R_OK) != 0)
return 0;
else
gdbtk_source_filename = xstrdup (filename);
return 1;
}
void
_initialize_gdbtk ()
{
if (strcmp (interpreter_p, "insight") == 0)
init_ui_hook = gdbtk_init_1;
#ifdef __CYGWIN__
else
{
DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE));
switch (ft)
{
case FILE_TYPE_DISK:
case FILE_TYPE_CHAR:
case FILE_TYPE_PIPE:
break;
default:
AllocConsole ();
cygwin32_attach_handle_to_fd ("/dev/conin", 0,
GetStdHandle (STD_INPUT_HANDLE),
1, GENERIC_READ);
cygwin32_attach_handle_to_fd ("/dev/conout", 1,
GetStdHandle (STD_OUTPUT_HANDLE),
0, GENERIC_WRITE);
cygwin32_attach_handle_to_fd ("/dev/conout", 2,
GetStdHandle (STD_ERROR_HANDLE),
0, GENERIC_WRITE);
break;
}
}
#endif
}
static void
tk_command (char *cmd, int from_tty)
{
int retval;
char *result;
struct cleanup *old_chain;
if (cmd == NULL)
error_no_arg ("tcl command to interpret");
retval = Tcl_Eval (gdbtk_interp, cmd);
result = xstrdup (gdbtk_interp->result);
old_chain = make_cleanup (free, result);
if (retval != TCL_OK)
error ("%s", result);
printf_unfiltered ("%s\n", result);
do_cleanups (old_chain);
}
static void
view_command (char *args, int from_tty)
{
char *script;
struct cleanup *old_chain;
if (args != NULL)
{
xasprintf (&script,
"[lindex [ManagedWin::find SrcWin] 0] location BROWSE_TAG [gdb_loc %s]",
args);
old_chain = make_cleanup (xfree, script);
if (Tcl_Eval (gdbtk_interp, script) != TCL_OK)
{
Tcl_Obj *obj = Tcl_GetObjResult (gdbtk_interp);
error ("%s", Tcl_GetStringFromObj (obj, NULL));
}
do_cleanups (old_chain);
}
else
error ("Argument required (location to view)");
}