* annotate.c, breakpoint.c, defs.h, gdbtk.c, top.c: Replace
enable/disable_breakpoint_hook with modify_breakpoint_hook. * gdbtk.c: General cleanups, get rid of unused variables. Redo handling of stdout/stderr to just return output as the result of the tcl command that caused the output. Cleanup -Wall stuff. * (breakpoint_notify): Now returns just action and breakpoint number. * (gdb_get_breakpoint_list): New routine. Does the obvious. * (gdb_get_breakpoint_info): Mostly derived from the old breakpoint_notify, but returns lots more info. * (dsprintf_append_element): Helper routine, works like printf, but appends a tcl element onto the specified DString. Good for building up lists as return values. * (gdbtk_enable/disable_breakpoint): Go away. Replaced with gdbtk_modify_breakpoint. * (*many routines*): Use new result protocol. * (call_wrapper): Make sure that recursive calls don't trash results. * gdbtk.tcl: New windows, autocmd, and breakpoints. * (gdbtk_tcl_fputs): Don't use $current_output_win redirection anymore. It's not needed (in fact, this routine may not be needed anymore). * (gdbtk_tcl_breakpoint): Change to reflect new breakpoint notification protocol. * (gdbtk_tcl_busy gdbtk_tcl_idle): Straighten out buttons, remove catches. * (interactive_cmd): Use this wrapper around button invocations of many commands. This will catch errors and put the results into the command window. It also updates all the other windows. * Also, change reliefs of most things to sunken. This actually looks better. * (create_file_win): Fix margin binding to allow breakpoints to work again. * (create_asm_win): Use return value of gdb_disassemble instead of implicit I/O to the command window. * (create_command_window): Use new result protocol to get output from commands.
This commit is contained in:
parent
a8e27cc684
commit
6131622e34
|
@ -535,7 +535,6 @@ _initialize_annotate ()
|
|||
if (annotation_level > 1)
|
||||
{
|
||||
delete_breakpoint_hook = breakpoint_changed;
|
||||
enable_breakpoint_hook = breakpoint_changed;
|
||||
disable_breakpoint_hook = breakpoint_changed;
|
||||
modify_breakpoint_hook = breakpoint_changed;
|
||||
}
|
||||
}
|
||||
|
|
374
gdb/gdbtk.c
374
gdb/gdbtk.c
|
@ -38,18 +38,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
|
|||
#include <sys/ioctl.h>
|
||||
#include <string.h>
|
||||
#include "dis-asm.h"
|
||||
#include <stdio.h>
|
||||
#include "gdbcmd.h"
|
||||
|
||||
#ifndef FIOASYNC
|
||||
#include <sys/stropts.h>
|
||||
#endif
|
||||
|
||||
/* Non-zero means that we're doing the gdbtk interface. */
|
||||
int gdbtk = 0;
|
||||
|
||||
/* Non-zero means we are reloading breakpoints, etc from the
|
||||
Gdbtk kernel, and we should suppress various messages */
|
||||
static int gdbtk_reloading = 0;
|
||||
|
||||
/* Handle for TCL interpreter */
|
||||
static Tcl_Interp *interp = NULL;
|
||||
|
||||
|
@ -91,66 +86,17 @@ null_routine(arg)
|
|||
|
||||
/* Dynamic string header for stdout. */
|
||||
|
||||
static Tcl_DString stdout_buffer;
|
||||
|
||||
/* Use this to collect stdout output that will be returned as the result of a
|
||||
tcl command. */
|
||||
|
||||
static int saving_output = 0;
|
||||
|
||||
static void
|
||||
start_saving_output ()
|
||||
{
|
||||
saving_output = 1;
|
||||
}
|
||||
|
||||
#define get_saved_output() (Tcl_DStringValue (&stdout_buffer))
|
||||
|
||||
static void
|
||||
finish_saving_output ()
|
||||
{
|
||||
if (!saving_output)
|
||||
return;
|
||||
|
||||
saving_output = 0;
|
||||
|
||||
Tcl_DStringFree (&stdout_buffer);
|
||||
}
|
||||
static Tcl_DString *result_ptr;
|
||||
|
||||
/* This routine redirects the output of fputs_unfiltered so that
|
||||
the user can see what's going on in his debugger window. */
|
||||
|
||||
static void
|
||||
flush_holdbuf ()
|
||||
{
|
||||
char *s, *argv[1];
|
||||
|
||||
/* We use Tcl_Merge to quote braces and funny characters as necessary. */
|
||||
|
||||
argv[0] = Tcl_DStringValue (&stdout_buffer);
|
||||
s = Tcl_Merge (1, argv);
|
||||
|
||||
Tcl_DStringFree (&stdout_buffer);
|
||||
|
||||
Tcl_VarEval (interp, "gdbtk_tcl_fputs ", s, NULL);
|
||||
|
||||
free (s);
|
||||
}
|
||||
|
||||
static void
|
||||
gdbtk_flush (stream)
|
||||
FILE *stream;
|
||||
{
|
||||
if (stream != gdb_stdout || saving_output)
|
||||
return;
|
||||
|
||||
/* Flush output from C to tcl land. */
|
||||
|
||||
flush_holdbuf ();
|
||||
|
||||
#if 0
|
||||
/* Force immediate screen update */
|
||||
|
||||
Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
|
||||
#endif
|
||||
}
|
||||
|
||||
static void
|
||||
|
@ -158,21 +104,20 @@ gdbtk_fputs (ptr, stream)
|
|||
const char *ptr;
|
||||
FILE *stream;
|
||||
{
|
||||
int len;
|
||||
|
||||
if (stream != gdb_stdout)
|
||||
if (result_ptr)
|
||||
Tcl_DStringAppend (result_ptr, ptr, -1);
|
||||
else
|
||||
{
|
||||
Tcl_VarEval (interp, "gdbtk_tcl_fputs_error ", "{", ptr, "}", NULL);
|
||||
return;
|
||||
Tcl_DString str;
|
||||
|
||||
Tcl_DStringInit (&str);
|
||||
|
||||
Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
|
||||
Tcl_DStringAppendElement (&str, ptr);
|
||||
|
||||
Tcl_Eval (interp, Tcl_DStringValue (&str));
|
||||
Tcl_DStringFree (&str);
|
||||
}
|
||||
|
||||
Tcl_DStringAppend (&stdout_buffer, ptr, -1);
|
||||
|
||||
if (saving_output)
|
||||
return;
|
||||
|
||||
if (Tcl_DStringLength (&stdout_buffer) > 1000)
|
||||
flush_holdbuf ();
|
||||
}
|
||||
|
||||
static int
|
||||
|
@ -185,7 +130,7 @@ gdbtk_query (args)
|
|||
|
||||
query = va_arg (args, char *);
|
||||
|
||||
vsprintf(buf, query, args);
|
||||
vsprintf (buf, query, args);
|
||||
Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
|
||||
|
||||
val = atol (interp->result);
|
||||
|
@ -193,35 +138,117 @@ gdbtk_query (args)
|
|||
}
|
||||
|
||||
static void
|
||||
breakpoint_notify(b, action)
|
||||
struct breakpoint *b;
|
||||
const char *action;
|
||||
dsprintf_append_element (va_alist)
|
||||
va_dcl
|
||||
{
|
||||
va_list args;
|
||||
Tcl_DString *dsp;
|
||||
char *format;
|
||||
char buf[1024];
|
||||
|
||||
va_start (args);
|
||||
|
||||
dsp = va_arg (args, Tcl_DString *);
|
||||
format = va_arg (args, char *);
|
||||
|
||||
vsprintf (buf, format, args);
|
||||
|
||||
Tcl_DStringAppendElement (dsp, buf);
|
||||
}
|
||||
|
||||
static int
|
||||
gdb_get_breakpoint_list (clientData, interp, argc, argv)
|
||||
ClientData clientData;
|
||||
Tcl_Interp *interp;
|
||||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
struct breakpoint *b;
|
||||
extern struct breakpoint *breakpoint_chain;
|
||||
|
||||
if (argc != 1)
|
||||
error ("wrong # args");
|
||||
|
||||
for (b = breakpoint_chain; b; b = b->next)
|
||||
if (b->type == bp_breakpoint)
|
||||
dsprintf_append_element (result_ptr, "%d", b->number);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
gdb_get_breakpoint_info (clientData, interp, argc, argv)
|
||||
ClientData clientData;
|
||||
Tcl_Interp *interp;
|
||||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
struct symbol *sym;
|
||||
char bpnum[50], line[50], pc[50];
|
||||
struct symtab_and_line sal;
|
||||
char *filename;
|
||||
int v;
|
||||
static char *bptypes[] = {"breakpoint", "hardware breakpoint", "until",
|
||||
"finish", "watchpoint", "hardware watchpoint",
|
||||
"read watchpoint", "access watchpoint",
|
||||
"longjmp", "longjmp resume", "step resume",
|
||||
"through sigtramp", "watchpoint scope",
|
||||
"call dummy" };
|
||||
static char *bpdisp[] = {"delete", "disable", "donttouch"};
|
||||
struct command_line *cmd;
|
||||
int bpnum;
|
||||
struct breakpoint *b;
|
||||
extern struct breakpoint *breakpoint_chain;
|
||||
|
||||
if (argc != 2)
|
||||
error ("wrong # args");
|
||||
|
||||
bpnum = atoi (argv[1]);
|
||||
|
||||
for (b = breakpoint_chain; b; b = b->next)
|
||||
if (b->number == bpnum)
|
||||
break;
|
||||
|
||||
if (!b)
|
||||
error ("Breakpoint #%d does not exist", bpnum);
|
||||
|
||||
if (b->type != bp_breakpoint)
|
||||
return;
|
||||
|
||||
sal = find_pc_line (b->address, 0);
|
||||
|
||||
filename = symtab_to_filename (sal.symtab);
|
||||
Tcl_DStringAppendElement (result_ptr, symtab_to_filename (sal.symtab));
|
||||
dsprintf_append_element (result_ptr, "%d", sal.line);
|
||||
dsprintf_append_element (result_ptr, "0x%lx", b->address);
|
||||
Tcl_DStringAppendElement (result_ptr, bptypes[b->type]);
|
||||
Tcl_DStringAppendElement (result_ptr, b->enable == enabled ? "1" : "0");
|
||||
Tcl_DStringAppendElement (result_ptr, bpdisp[b->disposition]);
|
||||
dsprintf_append_element (result_ptr, "%d", b->silent);
|
||||
dsprintf_append_element (result_ptr, "%d", b->ignore_count);
|
||||
|
||||
sprintf (bpnum, "%d", b->number);
|
||||
sprintf (line, "%d", sal.line);
|
||||
sprintf (pc, "0x%lx", b->address);
|
||||
|
||||
v = Tcl_VarEval (interp,
|
||||
"gdbtk_tcl_breakpoint ",
|
||||
action,
|
||||
" ", bpnum,
|
||||
" ", filename ? filename : "{}",
|
||||
" ", line,
|
||||
" ", pc,
|
||||
NULL);
|
||||
Tcl_DStringStartSublist (result_ptr);
|
||||
for (cmd = b->commands; cmd; cmd = cmd->next)
|
||||
Tcl_DStringAppendElement (result_ptr, cmd->line);
|
||||
Tcl_DStringEndSublist (result_ptr);
|
||||
|
||||
Tcl_DStringAppendElement (result_ptr, b->cond_string);
|
||||
|
||||
dsprintf_append_element (result_ptr, "%d", b->thread);
|
||||
dsprintf_append_element (result_ptr, "%d", b->hit_count);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static void
|
||||
breakpoint_notify(b, action)
|
||||
struct breakpoint *b;
|
||||
const char *action;
|
||||
{
|
||||
char buf[100];
|
||||
int v;
|
||||
|
||||
if (b->type != bp_breakpoint)
|
||||
return;
|
||||
|
||||
sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number);
|
||||
|
||||
v = Tcl_Eval (interp, buf);
|
||||
|
||||
if (v != TCL_OK)
|
||||
{
|
||||
|
@ -234,28 +261,21 @@ static void
|
|||
gdbtk_create_breakpoint(b)
|
||||
struct breakpoint *b;
|
||||
{
|
||||
breakpoint_notify(b, "create");
|
||||
breakpoint_notify (b, "create");
|
||||
}
|
||||
|
||||
static void
|
||||
gdbtk_delete_breakpoint(b)
|
||||
struct breakpoint *b;
|
||||
{
|
||||
breakpoint_notify(b, "delete");
|
||||
breakpoint_notify (b, "delete");
|
||||
}
|
||||
|
||||
static void
|
||||
gdbtk_enable_breakpoint(b)
|
||||
gdbtk_modify_breakpoint(b)
|
||||
struct breakpoint *b;
|
||||
{
|
||||
breakpoint_notify(b, "enable");
|
||||
}
|
||||
|
||||
static void
|
||||
gdbtk_disable_breakpoint(b)
|
||||
struct breakpoint *b;
|
||||
{
|
||||
breakpoint_notify(b, "disable");
|
||||
breakpoint_notify (b, "modify");
|
||||
}
|
||||
|
||||
/* This implements the TCL command `gdb_loc', which returns a list consisting
|
||||
|
@ -291,35 +311,29 @@ gdb_loc (clientData, interp, argc, argv)
|
|||
free (sals.sals);
|
||||
|
||||
if (sals.nelts != 1)
|
||||
{
|
||||
Tcl_SetResult (interp, "Ambiguous line spec", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("Ambiguous line spec");
|
||||
|
||||
pc = sal.pc;
|
||||
}
|
||||
else
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
if (sal.symtab)
|
||||
Tcl_AppendElement (interp, sal.symtab->filename);
|
||||
Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
|
||||
else
|
||||
Tcl_AppendElement (interp, "");
|
||||
Tcl_DStringAppendElement (result_ptr, "");
|
||||
|
||||
find_pc_partial_function (pc, &funcname, NULL, NULL);
|
||||
Tcl_AppendElement (interp, funcname);
|
||||
Tcl_DStringAppendElement (result_ptr, funcname);
|
||||
|
||||
filename = symtab_to_filename (sal.symtab);
|
||||
Tcl_AppendElement (interp, filename);
|
||||
Tcl_DStringAppendElement (result_ptr, filename);
|
||||
|
||||
sprintf (buf, "%d", sal.line);
|
||||
Tcl_AppendElement (interp, buf); /* line number */
|
||||
Tcl_DStringAppendElement (result_ptr, buf); /* line number */
|
||||
|
||||
sprintf (buf, "0x%lx", pc);
|
||||
Tcl_AppendElement (interp, buf); /* PC */
|
||||
Tcl_DStringAppendElement (result_ptr, buf); /* PC */
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
@ -338,10 +352,7 @@ gdb_eval (clientData, interp, argc, argv)
|
|||
value_ptr val;
|
||||
|
||||
if (argc != 2)
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
expr = parse_expression (argv[1]);
|
||||
|
||||
|
@ -349,17 +360,8 @@ gdb_eval (clientData, interp, argc, argv)
|
|||
|
||||
val = evaluate_expression (expr);
|
||||
|
||||
start_saving_output (); /* Start collecting stdout */
|
||||
|
||||
val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
|
||||
gdb_stdout, 0, 0, 0, 0);
|
||||
#if 0
|
||||
value_print (val, gdb_stdout, 0, 0);
|
||||
#endif
|
||||
|
||||
Tcl_AppendElement (interp, get_saved_output ());
|
||||
|
||||
finish_saving_output (); /* Set stdout back to normal */
|
||||
|
||||
do_cleanups (old_chain);
|
||||
|
||||
|
@ -383,25 +385,19 @@ gdb_sourcelines (clientData, interp, argc, argv)
|
|||
char buf[100];
|
||||
|
||||
if (argc != 2)
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
symtab = lookup_symtab (argv[1]);
|
||||
|
||||
if (!symtab)
|
||||
{
|
||||
Tcl_SetResult (interp, "No such file", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("No such file");
|
||||
|
||||
/* If there's no linetable, or no entries, then we are done. */
|
||||
|
||||
if (!symtab->linetable
|
||||
|| symtab->linetable->nitems == 0)
|
||||
{
|
||||
Tcl_AppendElement (interp, "");
|
||||
Tcl_DStringAppendElement (result_ptr, "");
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
@ -417,7 +413,7 @@ gdb_sourcelines (clientData, interp, argc, argv)
|
|||
continue;
|
||||
|
||||
sprintf (buf, "%d", le->line);
|
||||
Tcl_AppendElement (interp, buf);
|
||||
Tcl_DStringAppendElement (result_ptr, buf);
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
|
@ -427,7 +423,7 @@ static int
|
|||
map_arg_registers (argc, argv, func, argp)
|
||||
int argc;
|
||||
char *argv[];
|
||||
int (*func) PARAMS ((int regnum, void *argp));
|
||||
void (*func) PARAMS ((int regnum, void *argp));
|
||||
void *argp;
|
||||
{
|
||||
int regnum;
|
||||
|
@ -461,22 +457,18 @@ map_arg_registers (argc, argv, func, argp)
|
|||
&& *reg_names[regnum] != '\000')
|
||||
func (regnum, argp);
|
||||
else
|
||||
{
|
||||
Tcl_SetResult (interp, "bad register number", TCL_STATIC);
|
||||
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("bad register number");
|
||||
}
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
static int
|
||||
static void
|
||||
get_register_name (regnum, argp)
|
||||
int regnum;
|
||||
void *argp; /* Ignored */
|
||||
{
|
||||
Tcl_AppendElement (interp, reg_names[regnum]);
|
||||
Tcl_DStringAppendElement (result_ptr, reg_names[regnum]);
|
||||
}
|
||||
|
||||
/* This implements the TCL command `gdb_regnames', which returns a list of
|
||||
|
@ -507,8 +499,9 @@ gdb_regnames (clientData, interp, argc, argv)
|
|||
#define INVALID_FLOAT(x, y) (0 != 0)
|
||||
#endif
|
||||
|
||||
static int
|
||||
static void
|
||||
get_register (regnum, fp)
|
||||
int regnum;
|
||||
void *fp;
|
||||
{
|
||||
char raw_buffer[MAX_REGISTER_RAW_SIZE];
|
||||
|
@ -517,12 +510,10 @@ get_register (regnum, fp)
|
|||
|
||||
if (read_relative_register_raw_bytes (regnum, raw_buffer))
|
||||
{
|
||||
Tcl_AppendElement (interp, "Optimized out");
|
||||
Tcl_DStringAppendElement (result_ptr, "Optimized out");
|
||||
return;
|
||||
}
|
||||
|
||||
start_saving_output (); /* Start collecting stdout */
|
||||
|
||||
/* Convert raw data to virtual format if necessary. */
|
||||
|
||||
if (REGISTER_CONVERTIBLE (regnum))
|
||||
|
@ -536,9 +527,7 @@ get_register (regnum, fp)
|
|||
val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
|
||||
gdb_stdout, format, 1, 0, Val_pretty_default);
|
||||
|
||||
Tcl_AppendElement (interp, get_saved_output ());
|
||||
|
||||
finish_saving_output (); /* Set stdout back to normal */
|
||||
Tcl_DStringAppend (result_ptr, " ", -1);
|
||||
}
|
||||
|
||||
static int
|
||||
|
@ -551,10 +540,7 @@ gdb_fetch_registers (clientData, interp, argc, argv)
|
|||
int format;
|
||||
|
||||
if (argc < 2)
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
argc--;
|
||||
argv++;
|
||||
|
@ -570,8 +556,9 @@ gdb_fetch_registers (clientData, interp, argc, argv)
|
|||
|
||||
static char old_regs[REGISTER_BYTES];
|
||||
|
||||
static int
|
||||
static void
|
||||
register_changed_p (regnum, argp)
|
||||
int regnum;
|
||||
void *argp; /* Ignored */
|
||||
{
|
||||
char raw_buffer[MAX_REGISTER_RAW_SIZE];
|
||||
|
@ -590,7 +577,7 @@ register_changed_p (regnum, argp)
|
|||
REGISTER_RAW_SIZE (regnum));
|
||||
|
||||
sprintf (buf, "%d", regnum);
|
||||
Tcl_AppendElement (interp, buf);
|
||||
Tcl_DStringAppendElement (result_ptr, buf);
|
||||
}
|
||||
|
||||
static int
|
||||
|
@ -600,8 +587,6 @@ gdb_changed_register_list (clientData, interp, argc, argv)
|
|||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
int format;
|
||||
|
||||
argc--;
|
||||
argv++;
|
||||
|
||||
|
@ -619,19 +604,12 @@ gdb_cmd (clientData, interp, argc, argv)
|
|||
char *argv[];
|
||||
{
|
||||
if (argc != 2)
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
execute_command (argv[1], 1);
|
||||
|
||||
bpstat_do_actions (&stop_bpstat);
|
||||
|
||||
/* Drain all buffered command output */
|
||||
|
||||
gdb_flush (gdb_stdout);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
||||
|
@ -653,6 +631,11 @@ call_wrapper (clientData, interp, argc, argv)
|
|||
struct cleanup *saved_cleanup_chain;
|
||||
Tcl_CmdProc *func;
|
||||
jmp_buf saved_error_return;
|
||||
Tcl_DString result, *old_result_ptr;
|
||||
|
||||
Tcl_DStringInit (&result);
|
||||
old_result_ptr = result_ptr;
|
||||
result_ptr = &result;
|
||||
|
||||
func = (Tcl_CmdProc *)clientData;
|
||||
memcpy (saved_error_return, error_return, sizeof (jmp_buf));
|
||||
|
@ -665,8 +648,6 @@ call_wrapper (clientData, interp, argc, argv)
|
|||
{
|
||||
val = TCL_ERROR; /* Flag an error for TCL */
|
||||
|
||||
finish_saving_output (); /* Restore stdout to normal */
|
||||
|
||||
gdb_flush (gdb_stderr); /* Flush error output */
|
||||
|
||||
gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */
|
||||
|
@ -683,6 +664,9 @@ call_wrapper (clientData, interp, argc, argv)
|
|||
|
||||
memcpy (error_return, saved_error_return, sizeof (jmp_buf));
|
||||
|
||||
Tcl_DStringResult (interp, &result);
|
||||
result_ptr = old_result_ptr;
|
||||
|
||||
return val;
|
||||
}
|
||||
|
||||
|
@ -693,16 +677,15 @@ gdb_listfiles (clientData, interp, argc, argv)
|
|||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
int val;
|
||||
struct objfile *objfile;
|
||||
struct partial_symtab *psymtab;
|
||||
struct symtab *symtab;
|
||||
|
||||
ALL_PSYMTABS (objfile, psymtab)
|
||||
Tcl_AppendElement (interp, psymtab->filename);
|
||||
Tcl_DStringAppendElement (result_ptr, psymtab->filename);
|
||||
|
||||
ALL_SYMTABS (objfile, symtab)
|
||||
Tcl_AppendElement (interp, symtab->filename);
|
||||
Tcl_DStringAppendElement (result_ptr, symtab->filename);
|
||||
|
||||
return TCL_OK;
|
||||
}
|
||||
|
@ -793,32 +776,21 @@ gdb_disassemble (clientData, interp, argc, argv)
|
|||
};
|
||||
|
||||
if (argc != 3 && argc != 4)
|
||||
{
|
||||
Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("wrong # args");
|
||||
|
||||
if (strcmp (argv[1], "source") == 0)
|
||||
mixed_source_and_assembly = 1;
|
||||
else if (strcmp (argv[1], "nosource") == 0)
|
||||
mixed_source_and_assembly = 0;
|
||||
else
|
||||
{
|
||||
Tcl_SetResult (interp, "First arg must be 'source' or 'nosource'",
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("First arg must be 'source' or 'nosource'");
|
||||
|
||||
low = parse_and_eval_address (argv[2]);
|
||||
|
||||
if (argc == 3)
|
||||
{
|
||||
if (find_pc_partial_function (low, NULL, &low, &high) == 0)
|
||||
{
|
||||
Tcl_SetResult (interp, "No function contains specified address",
|
||||
TCL_STATIC);
|
||||
return TCL_ERROR;
|
||||
}
|
||||
error ("No function contains specified address");
|
||||
}
|
||||
else
|
||||
high = parse_and_eval_address (argv[3]);
|
||||
|
@ -1086,8 +1058,6 @@ gdbtk_init ()
|
|||
int i;
|
||||
struct sigaction action;
|
||||
static sigset_t nullsigmask = {0};
|
||||
extern struct cmd_list_element *setlist;
|
||||
extern struct cmd_list_element *showlist;
|
||||
|
||||
old_chain = make_cleanup (cleanup_init, 0);
|
||||
|
||||
|
@ -1098,8 +1068,6 @@ gdbtk_init ()
|
|||
if (!interp)
|
||||
error ("Tcl_CreateInterp failed");
|
||||
|
||||
Tcl_DStringInit (&stdout_buffer); /* Setup stdout buffer */
|
||||
|
||||
mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
|
||||
|
||||
if (!mainWindow)
|
||||
|
@ -1126,6 +1094,10 @@ gdbtk_init ()
|
|||
Tcl_CreateCommand (interp, "gdb_disassemble", call_wrapper,
|
||||
gdb_disassemble, NULL);
|
||||
Tcl_CreateCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
|
||||
Tcl_CreateCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
|
||||
gdb_get_breakpoint_list, NULL);
|
||||
Tcl_CreateCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
|
||||
gdb_get_breakpoint_info, NULL);
|
||||
|
||||
command_loop_hook = Tk_MainLoop;
|
||||
print_frame_info_listing_hook = null_routine;
|
||||
|
@ -1133,8 +1105,7 @@ gdbtk_init ()
|
|||
flush_hook = gdbtk_flush;
|
||||
create_breakpoint_hook = gdbtk_create_breakpoint;
|
||||
delete_breakpoint_hook = gdbtk_delete_breakpoint;
|
||||
enable_breakpoint_hook = gdbtk_enable_breakpoint;
|
||||
disable_breakpoint_hook = gdbtk_disable_breakpoint;
|
||||
modify_breakpoint_hook = gdbtk_modify_breakpoint;
|
||||
interactive_hook = gdbtk_interactive;
|
||||
target_wait_hook = gdbtk_wait;
|
||||
call_command_hook = gdbtk_call_command;
|
||||
|
@ -1166,13 +1137,6 @@ gdbtk_init ()
|
|||
add_com ("tk", class_obscure, tk_command,
|
||||
"Send a command directly into tk.");
|
||||
|
||||
#if 0
|
||||
add_show_from_set (add_set_cmd ("disassemble-from-exec", class_support,
|
||||
var_boolean, (char *)&disassemble_from_exec,
|
||||
"Set ", &setlist),
|
||||
&showlist);
|
||||
#endif
|
||||
|
||||
Tcl_LinkVar (interp, "disassemble-from-exec", (char *)&disassemble_from_exec,
|
||||
TCL_LINK_INT);
|
||||
|
||||
|
@ -1192,8 +1156,6 @@ gdbtk_init ()
|
|||
|
||||
if (Tcl_EvalFile (interp, gdbtk_filename) != TCL_OK)
|
||||
{
|
||||
char *err;
|
||||
|
||||
fputs_unfiltered_hook = NULL; /* Force errors to stdout/stderr */
|
||||
|
||||
fprintf_unfiltered (stderr, "%s:%d: %s\n", gdbtk_filename,
|
||||
|
|
457
gdb/gdbtk.tcl
457
gdb/gdbtk.tcl
|
@ -26,7 +26,6 @@ set current_label {}
|
|||
set screen_height 0
|
||||
set screen_top 0
|
||||
set screen_bot 0
|
||||
set current_output_win .cmd.text
|
||||
set cfunc NIL
|
||||
set line_numbers 1
|
||||
set breakpoint_file(-1) {[garbage]}
|
||||
|
@ -65,10 +64,8 @@ if [info exists env(EDITOR)] then {
|
|||
#
|
||||
|
||||
proc gdbtk_tcl_fputs {arg} {
|
||||
global current_output_win
|
||||
|
||||
$current_output_win insert end "$arg"
|
||||
$current_output_win yview -pickplace end
|
||||
.cmd.text insert end "$arg"
|
||||
.cmd.text yview -pickplace end
|
||||
}
|
||||
|
||||
proc gdbtk_tcl_fputs_error {arg} {
|
||||
|
@ -87,9 +84,7 @@ proc gdbtk_tcl_fputs_error {arg} {
|
|||
#
|
||||
|
||||
proc gdbtk_tcl_flush {} {
|
||||
global current_output_win
|
||||
|
||||
$current_output_win yview -pickplace end
|
||||
.cmd.text yview -pickplace end
|
||||
update idletasks
|
||||
}
|
||||
|
||||
|
@ -149,18 +144,179 @@ proc gdbtk_tcl_end_variable_annotation {} {
|
|||
# of:
|
||||
# create - Notify of breakpoint creation
|
||||
# delete - Notify of breakpoint deletion
|
||||
# enable - Notify of breakpoint enabling
|
||||
# disable - Notify of breakpoint disabling
|
||||
#
|
||||
# All actions take the same set of arguments: BPNUM is the breakpoint
|
||||
# number, FILE is the source file and LINE is the line number, and PC is
|
||||
# the pc of the affected breakpoint.
|
||||
# modify - Notify of breakpoint modification
|
||||
#
|
||||
|
||||
proc gdbtk_tcl_breakpoint {action bpnum file line pc} {
|
||||
# file line pc type enabled disposition silent ignore_count commands cond_string thread hit_count
|
||||
|
||||
proc gdbtk_tcl_breakpoint {action bpnum} {
|
||||
set bpinfo [gdb_get_breakpoint_info $bpnum]
|
||||
set file [lindex $bpinfo 0]
|
||||
set line [lindex $bpinfo 1]
|
||||
set pc [lindex $bpinfo 2]
|
||||
set enable [lindex $bpinfo 4]
|
||||
|
||||
if {$action == "modify"} {
|
||||
if {$enable == "enabled"} {
|
||||
set action enable
|
||||
} else {
|
||||
set action disable
|
||||
}
|
||||
}
|
||||
|
||||
${action}_breakpoint $bpnum $file $line $pc
|
||||
}
|
||||
|
||||
proc create_breakpoints_window {} {
|
||||
global bpframe_lasty
|
||||
|
||||
if [winfo exists .breakpoints] {raise .breakpoints ; return}
|
||||
|
||||
build_framework .breakpoints "Breakpoints" ""
|
||||
|
||||
# First, delete all the old view menu entries
|
||||
|
||||
.breakpoints.menubar.view.menu delete 0 last
|
||||
|
||||
# Get rid of label
|
||||
|
||||
destroy .breakpoints.label
|
||||
|
||||
# Replace text with a canvas and fix the scrollbars
|
||||
|
||||
destroy .breakpoints.text
|
||||
canvas .breakpoints.c -relief sunken -bd 2 \
|
||||
-cursor hand2 -yscrollcommand {.breakpoints.scroll set}
|
||||
.breakpoints.scroll configure -command {.breakpoints.c yview}
|
||||
scrollbar .breakpoints.scrollx -orient horizontal \
|
||||
-command {.breakpoints.c xview} -relief sunken
|
||||
|
||||
pack .breakpoints.scrollx -side bottom -fill x -in .breakpoints.info
|
||||
pack .breakpoints.c -side left -expand yes -fill both \
|
||||
-in .breakpoints.info
|
||||
|
||||
set bpframe_lasty 0
|
||||
|
||||
# Create a frame for each breakpoint
|
||||
|
||||
foreach bpnum [gdb_get_breakpoint_list] {
|
||||
add_breakpoint_frame $bpnum
|
||||
}
|
||||
}
|
||||
|
||||
# Create a frame for bpnum in the .breakpoints canvas
|
||||
|
||||
proc add_breakpoint_frame bpnum {
|
||||
global bpframe_lasty
|
||||
|
||||
if ![winfo exists .breakpoints] return
|
||||
|
||||
set bpinfo [gdb_get_breakpoint_info $bpnum]
|
||||
|
||||
set file [lindex $bpinfo 0]
|
||||
set line [lindex $bpinfo 1]
|
||||
set pc [lindex $bpinfo 2]
|
||||
set type [lindex $bpinfo 3]
|
||||
set enabled [lindex $bpinfo 4]
|
||||
set disposition [lindex $bpinfo 5]
|
||||
set silent [lindex $bpinfo 6]
|
||||
set ignore_count [lindex $bpinfo 7]
|
||||
set commands [lindex $bpinfo 8]
|
||||
set cond [lindex $bpinfo 9]
|
||||
set thread [lindex $bpinfo 10]
|
||||
set hit_count [lindex $bpinfo 11]
|
||||
|
||||
set f .breakpoints.c.$bpnum
|
||||
|
||||
if ![winfo exists $f] {
|
||||
frame $f -relief sunken -bd 2
|
||||
|
||||
label $f.id -text "#$bpnum $file:$line ($pc)" \
|
||||
-relief flat -bd 2 -anchor w
|
||||
label $f.hit_count -text "Hit count: $hit_count" -relief flat \
|
||||
-bd 2 -anchor w
|
||||
|
||||
frame $f.thread
|
||||
label $f.thread.label -text "Thread: " -relief flat -bd 2 \
|
||||
-width 11 -anchor w
|
||||
entry $f.thread.entry -bd 2 -relief sunken -width 10
|
||||
$f.thread.entry insert end $thread
|
||||
pack $f.thread.label -side left
|
||||
pack $f.thread.entry -side left -fill x
|
||||
|
||||
frame $f.cond
|
||||
label $f.cond.label -text "Condition: " -relief flat -bd 2 \
|
||||
-width 11 -anchor w
|
||||
entry $f.cond.entry -bd 2 -relief sunken
|
||||
$f.cond.entry insert end $cond
|
||||
pack $f.cond.label -side left
|
||||
pack $f.cond.entry -side left -fill x -expand yes
|
||||
|
||||
frame $f.ignore_count
|
||||
label $f.ignore_count.label -text "Ignore count: " \
|
||||
-relief flat -bd 2 -width 11 -anchor w
|
||||
entry $f.ignore_count.entry -bd 2 -relief sunken -width 10
|
||||
$f.ignore_count.entry insert end $ignore_count
|
||||
pack $f.ignore_count.label -side left
|
||||
pack $f.ignore_count.entry -side left -fill x
|
||||
|
||||
frame $f.disps
|
||||
|
||||
checkbutton $f.disps.enabled -text "Enabled " \
|
||||
-variable enabled -anchor w -relief flat
|
||||
|
||||
radiobutton $f.disps.delete -text Delete \
|
||||
-variable disposition -anchor w -relief flat
|
||||
|
||||
radiobutton $f.disps.disable -text Disable \
|
||||
-variable disposition -anchor w -relief flat
|
||||
|
||||
radiobutton $f.disps.donttouch -text "Leave alone" \
|
||||
-variable disposition -anchor w -relief flat
|
||||
|
||||
pack $f.disps.delete $f.disps.disable $f.disps.donttouch \
|
||||
-side left -anchor w
|
||||
pack $f.disps.enabled -side right -anchor e
|
||||
text $f.commands -relief sunken -bd 2 -setgrid true \
|
||||
-cursor hand2 -height 3 -width 30
|
||||
|
||||
foreach line $commands {
|
||||
$f.commands insert end "${line}\n"
|
||||
}
|
||||
|
||||
pack $f.id -side top -anchor nw -fill x
|
||||
pack $f.hit_count $f.cond $f.thread $f.ignore_count $f.disps \
|
||||
$f.commands -side top -fill x -anchor nw
|
||||
}
|
||||
|
||||
set tag [.breakpoints.c create window 0 $bpframe_lasty -window $f -anchor nw]
|
||||
update
|
||||
set bbox [.breakpoints.c bbox $tag]
|
||||
|
||||
set bpframe_lasty [lindex $bbox 3]
|
||||
}
|
||||
|
||||
# Delete a breakpoint frame
|
||||
|
||||
proc delete_breakpoint_frame bpnum {
|
||||
global bpframe_lasty
|
||||
|
||||
if ![winfo exists .breakpoints] return
|
||||
|
||||
# First, clear the canvas
|
||||
|
||||
.breakpoints.c delete all
|
||||
|
||||
# Now, repopulate it with all but the doomed breakpoint
|
||||
|
||||
set bpframe_lasty 0
|
||||
foreach bp [gdb_get_breakpoint_list] {
|
||||
if {$bp != $bpnum} {
|
||||
add_breakpoint_frame $bp
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc asm_win_name {funcname} {
|
||||
if {$funcname == "*None*"} {return .asm.text}
|
||||
|
||||
|
@ -219,6 +375,10 @@ proc create_breakpoint {bpnum file line pc} {
|
|||
if [winfo exists $win] {
|
||||
insert_breakpoint_tag $win [pc_to_line $pclist($cfunc) $pc]
|
||||
}
|
||||
|
||||
# Update the breakpoints window
|
||||
|
||||
add_breakpoint_frame $bpnum
|
||||
}
|
||||
|
||||
#
|
||||
|
@ -282,6 +442,8 @@ proc delete_breakpoint {bpnum file line pc} {
|
|||
}
|
||||
}
|
||||
}
|
||||
|
||||
delete_breakpoint_frame $bpnum
|
||||
}
|
||||
|
||||
#
|
||||
|
@ -389,51 +551,51 @@ proc delete_breakpoint_tag {win line} {
|
|||
|
||||
proc gdbtk_tcl_busy {} {
|
||||
if [winfo exists .src] {
|
||||
catch {.src.start configure -state disabled}
|
||||
catch {.src.stop configure -state normal}
|
||||
catch {.src.step configure -state disabled}
|
||||
catch {.src.next configure -state disabled}
|
||||
catch {.src.continue configure -state disabled}
|
||||
catch {.src.finish configure -state disabled}
|
||||
catch {.src.up configure -state disabled}
|
||||
catch {.src.down configure -state disabled}
|
||||
catch {.src.bottom configure -state disabled}
|
||||
.src.start configure -state disabled
|
||||
.src.stop configure -state normal
|
||||
.src.step configure -state disabled
|
||||
.src.next configure -state disabled
|
||||
.src.continue configure -state disabled
|
||||
.src.finish configure -state disabled
|
||||
.src.up configure -state disabled
|
||||
.src.down configure -state disabled
|
||||
.src.bottom configure -state disabled
|
||||
}
|
||||
if [winfo exists .asm] {
|
||||
catch {.asm.stepi configure -state disabled}
|
||||
catch {.asm.nexti configure -state disabled}
|
||||
catch {.asm.continue configure -state disabled}
|
||||
catch {.asm.finish configure -state disabled}
|
||||
catch {.asm.up configure -state disabled}
|
||||
catch {.asm.down configure -state disabled}
|
||||
catch {.asm.bottom configure -state disabled}
|
||||
catch {.asm.close configure -state disabled}
|
||||
.asm.stepi configure -state disabled
|
||||
.asm.nexti configure -state disabled
|
||||
.asm.continue configure -state disabled
|
||||
.asm.finish configure -state disabled
|
||||
.asm.up configure -state disabled
|
||||
.asm.down configure -state disabled
|
||||
.asm.bottom configure -state disabled
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
proc gdbtk_tcl_idle {} {
|
||||
if [winfo exists .src] {
|
||||
catch {.src.start configure -state normal}
|
||||
catch {.src.stop configure -state disabled}
|
||||
catch {.src.step configure -state normal}
|
||||
catch {.src.next configure -state normal}
|
||||
catch {.src.continue configure -state normal}
|
||||
catch {.src.finish configure -state normal}
|
||||
catch {.src.up configure -state normal}
|
||||
catch {.src.down configure -state normal}
|
||||
catch {.src.bottom configure -state normal}
|
||||
.src.start configure -state normal
|
||||
.src.stop configure -state disabled
|
||||
.src.step configure -state normal
|
||||
.src.next configure -state normal
|
||||
.src.continue configure -state normal
|
||||
.src.finish configure -state normal
|
||||
.src.up configure -state normal
|
||||
.src.down configure -state normal
|
||||
.src.bottom configure -state normal
|
||||
}
|
||||
|
||||
if [winfo exists .asm] {
|
||||
catch {.asm.stepi configure -state normal}
|
||||
catch {.asm.nexti configure -state normal}
|
||||
catch {.asm.continue configure -state normal}
|
||||
catch {.asm.finish configure -state normal}
|
||||
catch {.asm.up configure -state normal}
|
||||
catch {.asm.down configure -state normal}
|
||||
catch {.asm.bottom configure -state normal}
|
||||
catch {.asm.close configure -state normal}
|
||||
.asm.stepi configure -state normal
|
||||
.asm.nexti configure -state normal
|
||||
.asm.continue configure -state normal
|
||||
.asm.finish configure -state normal
|
||||
.asm.up configure -state normal
|
||||
.asm.down configure -state normal
|
||||
.asm.bottom configure -state normal
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
#
|
||||
|
@ -499,6 +661,17 @@ menu .file_popup -cursor hand2
|
|||
.file_popup add command -label "Edit" -command {exec $editor +$selected_line $selected_file &}
|
||||
.file_popup add command -label "Set breakpoint" -command {gdb_cmd "break $selected_file:$selected_line"}
|
||||
|
||||
# Use this procedure to get the GDB core to execute the string `cmd'. This is
|
||||
# a wrapper around gdb_cmd, which will catch errors, and send output to the
|
||||
# command window. It will also cause all of the other windows to be updated.
|
||||
|
||||
proc interactive_cmd {cmd} {
|
||||
catch {gdb_cmd "$cmd"} result
|
||||
.cmd.text insert end $result
|
||||
.cmd.text yview -pickplace end
|
||||
update_ptr
|
||||
}
|
||||
|
||||
#
|
||||
# Bindings:
|
||||
#
|
||||
|
@ -730,7 +903,7 @@ proc not_implemented_yet {message} {
|
|||
##
|
||||
# Local procedure:
|
||||
#
|
||||
# create_expr_win - Create expression display window
|
||||
# create_expr_window - Create expression display window
|
||||
#
|
||||
# Description:
|
||||
#
|
||||
|
@ -818,7 +991,7 @@ proc update_exprs {} {
|
|||
}
|
||||
}
|
||||
|
||||
proc create_expr_win {} {
|
||||
proc create_expr_window {} {
|
||||
|
||||
if [winfo exists .expr] {raise .expr ; return}
|
||||
|
||||
|
@ -875,7 +1048,7 @@ proc create_expr_win {} {
|
|||
#
|
||||
|
||||
proc display_expression {expression} {
|
||||
create_expr_win
|
||||
create_expr_window
|
||||
|
||||
add_expr $expression
|
||||
}
|
||||
|
@ -915,7 +1088,7 @@ proc create_file_win {filename debug_file} {
|
|||
# File can't be read. Put error message into .src.nofile window and return.
|
||||
|
||||
catch {destroy .src.nofile}
|
||||
text .src.nofile -height 25 -width 88 -relief raised \
|
||||
text .src.nofile -height 25 -width 88 -relief sunken \
|
||||
-borderwidth 2 -yscrollcommand textscrollproc \
|
||||
-setgrid true -cursor hand2
|
||||
.src.nofile insert 0.0 $fh
|
||||
|
@ -927,22 +1100,21 @@ proc create_file_win {filename debug_file} {
|
|||
|
||||
# Actually create and do basic configuration on the text widget.
|
||||
|
||||
text $win -height 25 -width 88 -relief raised -borderwidth 2 \
|
||||
text $win -height 25 -width 88 -relief sunken -borderwidth 2 \
|
||||
-yscrollcommand textscrollproc -setgrid true -cursor hand2
|
||||
|
||||
# Setup all the bindings
|
||||
|
||||
bind $win <Enter> {focus %W}
|
||||
# bind $win <1> {listing_window_button_1 %W %X %Y %x %y}
|
||||
bind $win <1> do_nothing
|
||||
bind $win <B1-Motion> do_nothing
|
||||
|
||||
bind $win n {catch {gdb_cmd next} ; update_ptr}
|
||||
bind $win s {catch {gdb_cmd step} ; update_ptr}
|
||||
bind $win c {catch {gdb_cmd continue} ; update_ptr}
|
||||
bind $win f {catch {gdb_cmd finish} ; update_ptr}
|
||||
bind $win u {catch {gdb_cmd up} ; update_ptr}
|
||||
bind $win d {catch {gdb_cmd down} ; update_ptr}
|
||||
bind $win n {interactive_cmd next}
|
||||
bind $win s {interactive_cmd step}
|
||||
bind $win c {interactive_cmd continue}
|
||||
bind $win f {interactive_cmd finish}
|
||||
bind $win u {interactive_cmd up}
|
||||
bind $win d {interactive_cmd down}
|
||||
|
||||
$win delete 0.0 end
|
||||
$win insert 0.0 [read $fh]
|
||||
|
@ -972,7 +1144,7 @@ proc create_file_win {filename debug_file} {
|
|||
$win tag add margin $i.0 $i.8
|
||||
}
|
||||
|
||||
# $win tag bind margin <1> {listing_window_button_1 %W %X %Y %x %y}
|
||||
$win tag bind margin <1> {listing_window_button_1 %W %X %Y %x %y}
|
||||
$win tag bind source <1> {
|
||||
%W mark set anchor "@%x,%y wordstart"
|
||||
set last [%W index "@%x,%y wordend"]
|
||||
|
@ -1032,7 +1204,6 @@ proc create_file_win {filename debug_file} {
|
|||
proc create_asm_win {funcname pc} {
|
||||
global breakpoint_file
|
||||
global breakpoint_line
|
||||
global current_output_win
|
||||
global pclist
|
||||
global disassemble_with_source
|
||||
|
||||
|
@ -1043,7 +1214,7 @@ proc create_asm_win {funcname pc} {
|
|||
|
||||
# Actually create and do basic configuration on the text widget.
|
||||
|
||||
text $win -height 25 -width 80 -relief raised -borderwidth 2 \
|
||||
text $win -height 25 -width 80 -relief sunken -borderwidth 2 \
|
||||
-setgrid true -cursor hand2 -yscrollcommand asmscrollproc
|
||||
|
||||
# Setup all the bindings
|
||||
|
@ -1051,19 +1222,16 @@ proc create_asm_win {funcname pc} {
|
|||
bind $win <Enter> {focus %W}
|
||||
bind $win <1> {asm_window_button_1 %W %X %Y %x %y}
|
||||
bind $win <B1-Motion> do_nothing
|
||||
bind $win n {catch {gdb_cmd nexti} ; update_ptr}
|
||||
bind $win s {catch {gdb_cmd stepi} ; update_ptr}
|
||||
bind $win c {catch {gdb_cmd continue} ; update_ptr}
|
||||
bind $win f {catch {gdb_cmd finish} ; update_ptr}
|
||||
bind $win u {catch {gdb_cmd up} ; update_ptr}
|
||||
bind $win d {catch {gdb_cmd down} ; update_ptr}
|
||||
bind $win n {interactive_cmd nexti}
|
||||
bind $win s {interactive_cmd stepi}
|
||||
bind $win c {interactive_cmd continue}
|
||||
bind $win f {interactive_cmd finish}
|
||||
bind $win u {interactive_cmd up}
|
||||
bind $win d {interactive_cmd down}
|
||||
|
||||
# Disassemble the code, and read it into the new text widget
|
||||
|
||||
set temp $current_output_win
|
||||
set current_output_win $win
|
||||
catch "gdb_disassemble $disassemble_with_source $pc"
|
||||
set current_output_win $temp
|
||||
$win insert end [gdb_disassemble $disassemble_with_source $pc]
|
||||
|
||||
set numlines [$win index end]
|
||||
set numlines [lindex [split $numlines .] 0]
|
||||
|
@ -1272,18 +1440,18 @@ proc create_asm_window {} {
|
|||
frame .asm.row2
|
||||
|
||||
button .asm.stepi -width 6 -text Stepi \
|
||||
-command {catch {gdb_cmd stepi} ; update_ptr}
|
||||
-command {interactive_cmd stepi}
|
||||
button .asm.nexti -width 6 -text Nexti \
|
||||
-command {catch {gdb_cmd nexti} ; update_ptr}
|
||||
-command {interactive_cmd nexti}
|
||||
button .asm.continue -width 6 -text Cont \
|
||||
-command {catch {gdb_cmd continue} ; update_ptr}
|
||||
-command {interactive_cmd continue}
|
||||
button .asm.finish -width 6 -text Finish \
|
||||
-command {catch {gdb_cmd finish} ; update_ptr}
|
||||
button .asm.up -width 6 -text Up -command {catch {gdb_cmd up} ; update_ptr}
|
||||
-command {interactive_cmd finish}
|
||||
button .asm.up -width 6 -text Up -command {interactive_cmd up}
|
||||
button .asm.down -width 6 -text Down \
|
||||
-command {catch {gdb_cmd down} ; update_ptr}
|
||||
-command {interactive_cmd down}
|
||||
button .asm.bottom -width 6 -text Bottom \
|
||||
-command {catch {gdb_cmd {frame 0}} ; update_ptr}
|
||||
-command {interactive_cmd {frame 0}}
|
||||
|
||||
pack .asm.stepi .asm.continue .asm.up .asm.bottom -side left -padx 3 -pady 5 -in .asm.row1
|
||||
pack .asm.nexti .asm.finish .asm.down -side left -padx 3 -pady 5 -in .asm.row2
|
||||
|
@ -1691,6 +1859,9 @@ proc update_ptr {} {
|
|||
if [winfo exists .expr] {
|
||||
update_exprs
|
||||
}
|
||||
if [winfo exists .autocmd] {
|
||||
update_autocmd
|
||||
}
|
||||
}
|
||||
|
||||
# Make toplevel window disappear
|
||||
|
@ -1703,10 +1874,10 @@ proc files_command {} {
|
|||
wm minsize .files_window 1 1
|
||||
# wm overrideredirect .files_window true
|
||||
listbox .files_window.list -geometry 30x20 -setgrid true \
|
||||
-yscrollcommand {.files_window.scroll set} -relief raised \
|
||||
-yscrollcommand {.files_window.scroll set} -relief sunken \
|
||||
-borderwidth 2
|
||||
scrollbar .files_window.scroll -orient vertical \
|
||||
-command {.files_window.list yview}
|
||||
-command {.files_window.list yview} -relief sunken
|
||||
button .files_window.close -text Close -command {destroy .files_window}
|
||||
tk_listboxSingleSelect .files_window.list
|
||||
|
||||
|
@ -1789,25 +1960,25 @@ proc build_framework {win {title GDBtk} {label {}}} {
|
|||
-command "destroy ${win}"
|
||||
${win}.menubar.file.menu add separator
|
||||
${win}.menubar.file.menu add command -label Quit \
|
||||
-command { catch { gdb_cmd quit } }
|
||||
-command {interactive_cmd quit}
|
||||
|
||||
menubutton ${win}.menubar.commands -padx 12 -text Commands \
|
||||
-menu ${win}.menubar.commands.menu -underline 0
|
||||
|
||||
menu ${win}.menubar.commands.menu
|
||||
${win}.menubar.commands.menu add command -label Run \
|
||||
-command { catch {gdb_cmd run } ; update_ptr }
|
||||
-command {interactive_cmd run}
|
||||
${win}.menubar.commands.menu add command -label Step \
|
||||
-command { catch { gdb_cmd step } ; update_ptr }
|
||||
-command {interactive_cmd step}
|
||||
${win}.menubar.commands.menu add command -label Next \
|
||||
-command { catch { gdb_cmd next } ; update_ptr }
|
||||
-command {interactive_cmd next}
|
||||
${win}.menubar.commands.menu add command -label Continue \
|
||||
-command { catch { gdb_cmd continue } ; update_ptr }
|
||||
-command {interactive_cmd continue}
|
||||
${win}.menubar.commands.menu add separator
|
||||
${win}.menubar.commands.menu add command -label Stepi \
|
||||
-command { catch { gdb_cmd stepi } ; update_ptr }
|
||||
-command {interactive_cmd stepi}
|
||||
${win}.menubar.commands.menu add command -label Nexti \
|
||||
-command { catch { gdb_cmd nexti } ; update_ptr }
|
||||
-command {interactive_cmd nexti}
|
||||
|
||||
menubutton ${win}.menubar.view -padx 12 -text Options \
|
||||
-menu ${win}.menubar.view.menu -underline 0
|
||||
|
@ -1828,14 +1999,18 @@ proc build_framework {win {title GDBtk} {label {}}} {
|
|||
-command create_command_window
|
||||
${win}.menubar.window.menu add separator
|
||||
${win}.menubar.window.menu add command -label Source \
|
||||
-command {create_source_window ; update_ptr}
|
||||
-command create_source_window
|
||||
${win}.menubar.window.menu add command -label Assembly \
|
||||
-command {create_asm_window ; update_ptr}
|
||||
-command create_asm_window
|
||||
${win}.menubar.window.menu add separator
|
||||
${win}.menubar.window.menu add command -label Registers \
|
||||
-command {create_registers_window ; update_ptr}
|
||||
-command create_registers_window
|
||||
${win}.menubar.window.menu add command -label Expressions \
|
||||
-command {create_expr_win ; update_ptr}
|
||||
-command create_expr_window
|
||||
${win}.menubar.window.menu add command -label "Auto Command" \
|
||||
-command create_autocmd_window
|
||||
# ${win}.menubar.window.menu add command -label Breakpoints \
|
||||
# -command create_breakpoints_window
|
||||
|
||||
# ${win}.menubar.window.menu add separator
|
||||
# ${win}.menubar.window.menu add command -label Files \
|
||||
|
@ -1863,13 +2038,14 @@ proc build_framework {win {title GDBtk} {label {}}} {
|
|||
pack ${win}.menubar.help -side right
|
||||
|
||||
frame ${win}.info
|
||||
text ${win}.text -height 25 -width 80 -relief raised -borderwidth 2 \
|
||||
text ${win}.text -height 25 -width 80 -relief sunken -borderwidth 2 \
|
||||
-setgrid true -cursor hand2 -yscrollcommand "${win}.scroll set"
|
||||
|
||||
set ${win}.label $label
|
||||
label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief raised
|
||||
label ${win}.label -textvariable ${win}.label -borderwidth 2 -relief sunken
|
||||
|
||||
scrollbar ${win}.scroll -orient vertical -command "${win}.text yview"
|
||||
scrollbar ${win}.scroll -orient vertical -command "${win}.text yview" \
|
||||
-relief sunken
|
||||
|
||||
pack ${win}.label -side bottom -fill x -in ${win}.info
|
||||
pack ${win}.scroll -side right -fill y -in ${win}.info
|
||||
|
@ -1911,26 +2087,25 @@ proc create_source_window {} {
|
|||
frame .src.row2
|
||||
|
||||
button .src.start -width 6 -text Start -command \
|
||||
{catch {gdb_cmd {break main}}
|
||||
catch {gdb_cmd {enable delete $bpnum}}
|
||||
catch {gdb_cmd run}
|
||||
update_ptr }
|
||||
{interactive_cmd {break main}
|
||||
interactive_cmd {enable delete $bpnum}
|
||||
interactive_cmd run }
|
||||
button .src.stop -width 6 -text Stop -fg red -activeforeground red \
|
||||
-state disabled -command gdb_stop
|
||||
button .src.step -width 6 -text Step \
|
||||
-command {catch {gdb_cmd step} ; update_ptr}
|
||||
-command {interactive_cmd step}
|
||||
button .src.next -width 6 -text Next \
|
||||
-command {catch {gdb_cmd next} ; update_ptr}
|
||||
-command {interactive_cmd next}
|
||||
button .src.continue -width 6 -text Cont \
|
||||
-command {catch {gdb_cmd continue} ; update_ptr}
|
||||
-command {interactive_cmd continue}
|
||||
button .src.finish -width 6 -text Finish \
|
||||
-command {catch {gdb_cmd finish} ; update_ptr}
|
||||
-command {interactive_cmd finish}
|
||||
button .src.up -width 6 -text Up \
|
||||
-command {catch {gdb_cmd up} ; update_ptr}
|
||||
-command {interactive_cmd up}
|
||||
button .src.down -width 6 -text Down \
|
||||
-command {catch {gdb_cmd down} ; update_ptr}
|
||||
-command {interactive_cmd down}
|
||||
button .src.bottom -width 6 -text Bottom \
|
||||
-command {catch {gdb_cmd {frame 0}} ; update_ptr}
|
||||
-command {interactive_cmd {frame 0}}
|
||||
|
||||
pack .src.start .src.step .src.continue .src.up .src.bottom \
|
||||
-side left -padx 3 -pady 5 -in .src.row1
|
||||
|
@ -1950,6 +2125,50 @@ proc create_source_window {} {
|
|||
set screen_bot [lindex $args 3]}
|
||||
}
|
||||
|
||||
proc update_autocmd {} {
|
||||
global .autocmd.label
|
||||
global accumulate_output
|
||||
|
||||
catch {gdb_cmd "${.autocmd.label}"} result
|
||||
if !$accumulate_output { .autocmd.text delete 0.0 end }
|
||||
.autocmd.text insert end $result
|
||||
.autocmd.text yview -pickplace end
|
||||
}
|
||||
|
||||
proc create_autocmd_window {} {
|
||||
global .autocmd.label
|
||||
|
||||
if [winfo exists .autocmd] {raise .autocmd ; return}
|
||||
|
||||
build_framework .autocmd "Auto Command" ""
|
||||
|
||||
# First, delete all the old view menu entries
|
||||
|
||||
.autocmd.menubar.view.menu delete 0 last
|
||||
|
||||
# Accumulate output option
|
||||
|
||||
.autocmd.menubar.view.menu add checkbutton \
|
||||
-variable accumulate_output \
|
||||
-label "Accumulate output" -onvalue 1 -offvalue 0
|
||||
|
||||
# Now, create entry widget with label
|
||||
|
||||
frame .autocmd.entryframe
|
||||
|
||||
entry .autocmd.entry -borderwidth 2 -relief sunken
|
||||
bind .autocmd <Enter> {focus .autocmd.entry}
|
||||
bind .autocmd.entry <Key-Return> {set .autocmd.label [.autocmd.entry get]
|
||||
.autocmd.entry delete 0 end }
|
||||
|
||||
label .autocmd.entrylab -text "Command: "
|
||||
|
||||
pack .autocmd.entrylab -in .autocmd.entryframe -side left
|
||||
pack .autocmd.entry -in .autocmd.entryframe -side left -fill x -expand yes
|
||||
|
||||
pack .autocmd.entryframe -side bottom -fill x -before .autocmd.info
|
||||
}
|
||||
|
||||
proc create_command_window {} {
|
||||
global command_line
|
||||
|
||||
|
@ -1978,10 +2197,13 @@ proc create_command_window {} {
|
|||
global command_line
|
||||
|
||||
%W insert end \n
|
||||
%W yview -pickplace end
|
||||
catch "gdb_cmd [list $command_line]"
|
||||
interactive_cmd $command_line
|
||||
|
||||
# %W yview -pickplace end
|
||||
# catch "gdb_cmd [list $command_line]" result
|
||||
# %W insert end $result
|
||||
set command_line {}
|
||||
update_ptr
|
||||
# update_ptr
|
||||
%W insert end "(gdb) "
|
||||
%W yview -pickplace end
|
||||
}
|
||||
|
@ -2682,23 +2904,16 @@ create_command_window
|
|||
|
||||
# Create a copyright window
|
||||
|
||||
update
|
||||
toplevel .c
|
||||
wm geometry .c +300+300
|
||||
wm overrideredirect .c true
|
||||
|
||||
text .t
|
||||
set temp $current_output_win
|
||||
set current_output_win .t
|
||||
gdb_cmd "show version"
|
||||
set current_output_win $temp
|
||||
|
||||
message .c.m -text [.t get 0.0 end] -aspect 500 -relief raised
|
||||
destroy .t
|
||||
message .c.m -text [gdb_cmd "show version"] -aspect 500 -relief raised
|
||||
pack .c.m
|
||||
bind .c.m <Leave> {destroy .c}
|
||||
update
|
||||
|
||||
if [file exists ~/.gdbtkinit] {
|
||||
source ~/.gdbtkinit
|
||||
}
|
||||
|
||||
update
|
||||
|
|
|
@ -395,8 +395,7 @@ void (*flush_hook) PARAMS ((FILE *stream));
|
|||
|
||||
void (*create_breakpoint_hook) PARAMS ((struct breakpoint *bpt));
|
||||
void (*delete_breakpoint_hook) PARAMS ((struct breakpoint *bpt));
|
||||
void (*enable_breakpoint_hook) PARAMS ((struct breakpoint *bpt));
|
||||
void (*disable_breakpoint_hook) PARAMS ((struct breakpoint *bpt));
|
||||
void (*modify_breakpoint_hook) PARAMS ((struct breakpoint *bpt));
|
||||
|
||||
/* Called during long calculations to allow GUI to repair window damage, and to
|
||||
check for stop buttons, etc... */
|
||||
|
|
Loading…
Reference in New Issue