#include "target.h"
#include <tcl.h>
#include <tk.h>
+#ifdef ANSI_PROTOTYPES
+#include <stdarg.h>
+#else
#include <varargs.h>
+#endif
#include <signal.h>
#include <fcntl.h>
#include <unistd.h>
#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;
static int disassemble_from_exec = -1;
+/* Supply malloc calls for tcl/tk. */
+
+char *
+Tcl_Malloc (size)
+ unsigned int size;
+{
+ return xmalloc (size);
+}
+
+char *
+Tcl_Realloc (ptr, size)
+ char *ptr;
+ unsigned int size;
+{
+ return xrealloc (ptr, size);
+}
+
+void
+Tcl_Free(ptr)
+ char *ptr;
+{
+ free (ptr);
+}
+
static void
null_routine(arg)
int 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 Tcl_DString *result_ptr;
+\f
+static void
+gdbtk_flush (stream)
+ FILE *stream;
+{
+#if 0
+ /* Force immediate screen update */
-static int saving_output = 0;
+ Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
+#endif
+}
static void
-start_saving_output ()
+gdbtk_fputs (ptr, stream)
+ const char *ptr;
+ FILE *stream;
{
- saving_output = 1;
-}
+ if (result_ptr)
+ Tcl_DStringAppend (result_ptr, (char *)ptr, -1);
+ else
+ {
+ Tcl_DString str;
-#define get_saved_output() (Tcl_DStringValue (&stdout_buffer))
+ Tcl_DStringInit (&str);
-static void
-finish_saving_output ()
+ Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
+ Tcl_DStringAppendElement (&str, (char *)ptr);
+
+ Tcl_Eval (interp, Tcl_DStringValue (&str));
+ Tcl_DStringFree (&str);
+ }
+}
+
+static int
+gdbtk_query (query, args)
+ char *query;
+ va_list args;
{
- if (!saving_output)
- return;
+ char buf[200];
+ long val;
- saving_output = 0;
+ vsprintf (buf, query, args);
+ Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
- Tcl_DStringFree (&stdout_buffer);
+ val = atol (interp->result);
+ return val;
}
\f
-/* 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 ()
+#ifdef ANSI_PROTOTYPES
+dsprintf_append_element (Tcl_DString *dsp, char *format, ...)
+#else
+dsprintf_append_element (va_alist)
+ va_dcl
+#endif
{
- char *s, *argv[1];
-
- /* We use Tcl_Merge to quote braces and funny characters as necessary. */
+ va_list args;
+ char buf[1024];
- argv[0] = Tcl_DStringValue (&stdout_buffer);
- s = Tcl_Merge (1, argv);
+#ifdef ANSI_PROTOTYPES
+ va_start (args, format);
+#else
+ Tcl_DString *dsp;
+ char *format;
- Tcl_DStringFree (&stdout_buffer);
+ va_start (args);
+ dsp = va_arg (args, Tcl_DString *);
+ format = va_arg (args, char *);
+#endif
- Tcl_VarEval (interp, "gdbtk_tcl_fputs ", s, NULL);
+ vsprintf (buf, format, args);
- free (s);
+ Tcl_DStringAppendElement (dsp, buf);
}
-static void
-gdbtk_flush (stream)
- FILE *stream;
+static int
+gdb_get_breakpoint_list (clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char *argv[];
{
- if (stream != gdb_stdout || saving_output)
- return;
-
- /* Flush output from C to tcl land. */
+ struct breakpoint *b;
+ extern struct breakpoint *breakpoint_chain;
- flush_holdbuf ();
+ if (argc != 1)
+ error ("wrong # args");
- /* Force immediate screen update */
+ for (b = breakpoint_chain; b; b = b->next)
+ if (b->type == bp_breakpoint)
+ dsprintf_append_element (result_ptr, "%d", b->number);
- Tcl_VarEval (interp, "gdbtk_tcl_flush", NULL);
+ return TCL_OK;
}
-static void
-gdbtk_fputs (ptr, stream)
- const char *ptr;
- FILE *stream;
+static int
+gdb_get_breakpoint_info (clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char *argv[];
{
- int len;
+ struct symtab_and_line sal;
+ 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 (stream != gdb_stdout)
- {
- Tcl_VarEval (interp, "gdbtk_tcl_fputs_error ", "{", ptr, "}", NULL);
- return;
- }
+ if (argc != 2)
+ error ("wrong # args");
- Tcl_DStringAppend (&stdout_buffer, ptr, -1);
+ bpnum = atoi (argv[1]);
- if (saving_output)
- return;
+ for (b = breakpoint_chain; b; b = b->next)
+ if (b->number == bpnum)
+ break;
- if (Tcl_DStringLength (&stdout_buffer) > 1000)
- flush_holdbuf ();
-}
+ if (!b || b->type != bp_breakpoint)
+ error ("Breakpoint #%d does not exist", bpnum);
-static int
-gdbtk_query (args)
- va_list args;
-{
- char *query;
- char buf[200];
- long val;
+ sal = find_pc_line (b->address, 0);
- query = va_arg (args, char *);
+ 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);
- vsprintf(buf, query, args);
- Tcl_VarEval (interp, "gdbtk_tcl_query ", "{", buf, "}", NULL);
+ Tcl_DStringStartSublist (result_ptr);
+ for (cmd = b->commands; cmd; cmd = cmd->next)
+ Tcl_DStringAppendElement (result_ptr, cmd->line);
+ Tcl_DStringEndSublist (result_ptr);
- val = atol (interp->result);
- return val;
+ 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;
}
-\f
+
static void
breakpoint_notify(b, action)
struct breakpoint *b;
const char *action;
{
- struct symbol *sym;
- char bpnum[50], line[50], pc[50];
- struct symtab_and_line sal;
- char *filename;
+ char buf[100];
int v;
if (b->type != bp_breakpoint)
return;
- sal = find_pc_line (b->address, 0);
-
- filename = symtab_to_filename (sal.symtab);
+ sprintf (buf, "gdbtk_tcl_breakpoint %s %d", action, b->number);
- 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);
+ v = Tcl_Eval (interp, buf);
if (v != TCL_OK)
{
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");
}
\f
/* This implements the TCL command `gdb_loc', which returns a list consisting
char *argv[];
{
char *filename;
- char buf[100];
struct symtab_and_line sal;
char *funcname;
CORE_ADDR pc;
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 */
+ dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
- sprintf (buf, "0x%lx", pc);
- Tcl_AppendElement (interp, buf); /* PC */
+ dsprintf_append_element (result_ptr, "0x%lx", pc); /* PC */
return TCL_OK;
}
value_ptr val;
if (argc != 2)
- {
- Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
- return TCL_ERROR;
- }
+ error ("wrong # args");
expr = parse_expression (argv[1]);
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);
struct symtab *symtab;
struct linetable_entry *le;
int nlines;
- 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;
}
&& le->pc == (le + 1)->pc)
continue;
- sprintf (buf, "%d", le->line);
- Tcl_AppendElement (interp, buf);
+ dsprintf_append_element (result_ptr, "%d", le->line);
}
return TCL_OK;
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;
&& *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
#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];
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))
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
int format;
if (argc < 2)
- {
- Tcl_SetResult (interp, "wrong # args", TCL_STATIC);
- return TCL_ERROR;
- }
+ error ("wrong # args");
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];
memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
REGISTER_RAW_SIZE (regnum));
- sprintf (buf, "%d", regnum);
- Tcl_AppendElement (interp, buf);
+ dsprintf_append_element (result_ptr, "%d", regnum);
}
static int
int argc;
char *argv[];
{
- int format;
-
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;
}
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));
{
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 */
memcpy (error_return, saved_error_return, sizeof (jmp_buf));
+ Tcl_DStringResult (interp, &result);
+ result_ptr = old_result_ptr;
+
return val;
}
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;
}
};
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]);
if (disassemble_from_exec == -1)
if (strcmp (target_shortname, "child") == 0
- || strcmp (target_shortname, "procfs") == 0)
+ || strcmp (target_shortname, "procfs") == 0
+ || strcmp (target_shortname, "vxprocess") == 0)
disassemble_from_exec = 0; /* It's a child process, read inferior mem */
else
disassemble_from_exec = 1; /* It's remote, read the exec file */
fputs_unfiltered (" ", gdb_stdout);
print_address (pc, gdb_stdout);
fputs_unfiltered (":\t ", gdb_stdout);
- pc += tm_print_insn (pc, &di);
+ pc += (*tm_print_insn) (pc, &di);
fputs_unfiltered ("\n", gdb_stdout);
}
}
fputs_unfiltered (" ", gdb_stdout);
print_address (pc, gdb_stdout);
fputs_unfiltered (":\t ", gdb_stdout);
- pc += tm_print_insn (pc, &di);
+ pc += (*tm_print_insn) (pc, &di);
fputs_unfiltered ("\n", gdb_stdout);
}
}
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);
if (!interp)
error ("Tcl_CreateInterp failed");
- Tcl_DStringInit (&stdout_buffer); /* Setup stdout buffer */
-
mainWindow = Tk_CreateMainWindow (interp, NULL, "gdb", "Gdb");
if (!mainWindow)
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;
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;
if (ioctl (x_fd, FIOASYNC, &i))
perror_with_name ("gdbtk_init: ioctl FIOASYNC failed");
+#ifdef SIOCSPGRP
i = getpid();
if (ioctl (x_fd, SIOCSPGRP, &i))
perror_with_name ("gdbtk_init: ioctl SIOCSPGRP failed");
+
+#else
+#ifdef F_SETOWN
+ i = getpid();
+ if (fcntl (x_fd, F_SETOWN, i))
+ perror_with_name ("gdbtk_init: fcntl F_SETOWN failed");
+#endif /* F_SETOWN */
+#endif /* !SIOCSPGRP */
#else
if (ioctl (x_fd, I_SETSIG, S_INPUT|S_RDNORM) < 0)
perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
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);
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,
projects / deliverable / binutils-gdb.git / blobdiff