/* Tcl/Tk interface routines.
- Copyright 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
+ Copyright 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
Written by Stu Grossman <grossman@cygnus.com> of Cygnus Support.
#include "target.h"
#include "gdbcore.h"
#include "tracepoint.h"
+#include "demangle.h"
#ifdef _WIN32
#include <winuser.h>
#endif
+#include <sys/stat.h>
+
#include <tcl.h>
#include <tk.h>
#include <itcl.h>
#include <stdio.h>
#include "gdbcmd.h"
-#ifndef WINNT
-#ifndef FIOASYNC
-#include <sys/stropts.h>
-#endif
-#endif
-
-#ifdef __CYGWIN32__
+#include "annotate.h"
#include <sys/time.h>
-#endif
#ifdef WINNT
#define GDBTK_PATH_SEP ";"
#undef SIOCSPGRP
#endif
+static int No_Update = 0;
static int load_in_progress = 0;
+static int in_fputs = 0;
int gdbtk_load_hash PARAMS ((char *, unsigned long));
int (*ui_load_progress_hook) PARAMS ((char *, unsigned long));
void (*pre_add_symbol_hook) PARAMS ((char *));
void (*post_add_symbol_hook) PARAMS ((void));
+char * get_prompt PARAMS ((void));
+
static void null_routine PARAMS ((int));
static void gdbtk_flush PARAMS ((FILE *));
static void gdbtk_fputs PARAMS ((const char *, FILE *));
static int gdbtk_query PARAMS ((const char *, va_list));
+static void gdbtk_warning PARAMS ((const char *, va_list));
+static void gdbtk_ignorable_warning PARAMS ((const char *));
static char *gdbtk_readline PARAMS ((char *));
static void gdbtk_init PARAMS ((char *));
static void tk_command_loop PARAMS ((void));
static int gdb_listfiles PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_listfuncs PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
+static int call_obj_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
static int gdb_cmd PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
static int gdb_immediate_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
static int gdb_fetch_registers PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static void gdbtk_readline_end PARAMS ((void));
+static void pc_changed PARAMS ((void));
static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static void register_changed_p PARAMS ((int, void *));
static int gdb_get_breakpoint_list PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static void gdbtk_modify_breakpoint PARAMS ((struct breakpoint *));
static int gdb_loc PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static int gdb_eval PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
-static int gdb_sourcelines PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static int map_arg_registers PARAMS ((int, char *[], void (*) (int, void *), void *));
static void get_register_name PARAMS ((int, void *));
static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
static void get_register PARAMS ((int, void *));
+static int gdb_trace_status PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *, int, char *argv[]));
static int gdb_load_info PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
void TclDebug PARAMS ((const char *fmt, ...));
+static int gdb_get_locals_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
+ objv[]));
+static int gdb_get_args_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
+ objv[]));
static int gdb_get_vars_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_get_function_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_get_line_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_prompt_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_find_file_command PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
-static char *find_file_in_dir PARAMS ((char *));
static int gdb_get_tracepoint_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static void gdbtk_create_tracepoint PARAMS ((struct tracepoint *));
static void gdbtk_delete_tracepoint PARAMS ((struct tracepoint *));
+static void gdbtk_modify_tracepoint PARAMS ((struct tracepoint *));
static void tracepoint_notify PARAMS ((struct tracepoint *, const char *));
+static void gdbtk_print_frame_info PARAMS ((struct symtab *, int, int, int));
void gdbtk_pre_add_symbol PARAMS ((char *));
void gdbtk_post_add_symbol PARAMS ((void));
+static int get_pc_register PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
+static int gdb_loadfile PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static struct symtab *full_lookup_symtab PARAMS ((char *file));
+static int gdb_get_mem PARAMS ((ClientData, Tcl_Interp *, int, char *[]));
/* Handle for TCL interpreter */
-
static Tcl_Interp *interp = NULL;
-#ifndef WINNT
-static int x_fd; /* X network socket */
-#endif
-
-#ifdef __CYGWIN32__
-
-/* On Windows we use timer interrupts when gdb might otherwise hang
- for a long time. See the comment above gdbtk_start_timer. This
- variable is true when timer interrupts are being used. */
-
static int gdbtk_timer_going = 0;
-
static void gdbtk_start_timer PARAMS ((void));
static void gdbtk_stop_timer PARAMS ((void));
-#endif
-
/* This variable is true when the inferior is running. Although it's
possible to disable most input from widgets and thus prevent
attempts to do anything while the inferior is running, any commands
const char *ptr;
FILE *stream;
{
+ char *merge[2], *command;
+ in_fputs = 1;
+
if (result_ptr)
- Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
+ Tcl_DStringAppend (result_ptr, (char *) ptr, -1);
else if (error_string_ptr != NULL && stream == gdb_stderr)
Tcl_DStringAppend (error_string_ptr, (char *) ptr, -1);
else
{
- Tcl_DString str;
+ merge[0] = "gdbtk_tcl_fputs";
+ merge[1] = (char *)ptr;
+ command = Tcl_Merge (2, merge);
+ Tcl_Eval (interp, command);
+ Tcl_Free (command);
+ }
+ in_fputs = 0;
+}
- Tcl_DStringInit (&str);
+static void
+gdbtk_warning (warning, args)
+ const char *warning;
+ va_list args;
+{
+ char buf[200], *merge[2];
+ char *command;
- Tcl_DStringAppend (&str, "gdbtk_tcl_fputs", -1);
- Tcl_DStringAppendElement (&str, (char *)ptr);
+ vsprintf (buf, warning, args);
+ merge[0] = "gdbtk_tcl_warning";
+ merge[1] = buf;
+ command = Tcl_Merge (2, merge);
+ Tcl_Eval (interp, command);
+ Tcl_Free (command);
+}
- Tcl_Eval (interp, Tcl_DStringValue (&str));
- Tcl_DStringFree (&str);
- }
+static void
+gdbtk_ignorable_warning (warning)
+ const char *warning;
+{
+ char buf[200], *merge[2];
+ char *command;
+
+ sprintf (buf, warning);
+ merge[0] = "gdbtk_tcl_ignorable_warning";
+ merge[1] = buf;
+ command = Tcl_Merge (2, merge);
+ Tcl_Eval (interp, command);
+ Tcl_Free (command);
}
static int
command = Tcl_Merge (2, merge);
Tcl_Eval (interp, command);
Tcl_Free (command);
-
+
val = atol (interp->result);
return val;
}
merge[1] = buf;
command = Tcl_Merge (2, merge);
Tcl_Eval (interp, command);
- free (command);
+ Tcl_Free (command);
}
static char *
merge[1] = prompt;
command = Tcl_Merge (2, merge);
result = Tcl_Eval (interp, command);
- free (command);
+ Tcl_Free (command);
if (result == TCL_OK)
{
return (strdup (interp -> result));
Tcl_Eval (interp, "gdbtk_tcl_readline_end");
}
+static void
+pc_changed()
+{
+ Tcl_Eval (interp, "gdbtk_pc_changed");
+}
+
\f
static void
#ifdef ANSI_PROTOTYPES
int bpnum;
struct breakpoint *b;
extern struct breakpoint *breakpoint_chain;
- char *funcname, *filename;
-
+ char *funcname, *fname, *filename;
+
if (argc != 2)
error ("wrong # args");
if (filename == NULL)
filename = "";
Tcl_DStringAppendElement (result_ptr, filename);
+
find_pc_partial_function (b->address, &funcname, NULL, NULL);
- Tcl_DStringAppendElement (result_ptr, funcname);
- dsprintf_append_element (result_ptr, "%d", sal.line);
+ fname = cplus_demangle (funcname, 0);
+ if (fname)
+ {
+ Tcl_DStringAppendElement (result_ptr, fname);
+ free (fname);
+ }
+ else
+ Tcl_DStringAppendElement (result_ptr, funcname);
+ dsprintf_append_element (result_ptr, "%d", b->line_number);
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");
sal = find_pc_line (b->address, 0);
filename = symtab_to_filename (sal.symtab);
if (filename == NULL)
- filename = "N/A";
+ filename = "";
+
sprintf (buf, "gdbtk_tcl_breakpoint %s %d 0x%lx %d {%s}", action, b->number,
- (long)b->address, sal.line, filename);
+ (long)b->address, b->line_number, filename);
v = Tcl_Eval (interp, buf);
breakpoint_notify (b, "modify");
}
\f
-/* This implements the TCL command `gdb_loc', which returns a list consisting
- of the source and line number associated with the current pc. */
+/* This implements the TCL command `gdb_loc', which returns a list */
+/* consisting of the following: */
+/* basename, function name, filename, line number, address, current pc */
static int
gdb_loc (clientData, interp, argc, argv)
{
char *filename;
struct symtab_and_line sal;
- char *funcname;
+ char *funcname, *fname;
CORE_ADDR pc;
if (!have_full_symbols () && !have_partial_symbols ())
Tcl_SetResult (interp, "No symbol table is loaded", TCL_STATIC);
return TCL_ERROR;
}
-
+
if (argc == 1)
{
- if (selected_frame)
+ if (selected_frame && (selected_frame->pc != stop_pc))
{
+ /* Note - this next line is not correct on all architectures. */
+ /* For a graphical debugged we really want to highlight the */
+ /* assembly line that called the next function on the stack. */
+ /* Many architectures have the next instruction saved as the */
+ /* pc on the stack, so what happens is the next instruction is hughlighted. */
+ /* FIXME */
+ pc = selected_frame->pc;
sal = find_pc_line (selected_frame->pc,
selected_frame->next != NULL
&& !selected_frame->next->signal_handler_caller
&& !frame_in_dummy (selected_frame->next));
}
else
- sal = find_pc_line (stop_pc, 0);
+ {
+ pc = stop_pc;
+ sal = find_pc_line (stop_pc, 0);
+ }
}
else if (argc == 2)
{
if (sals.nelts != 1)
error ("Ambiguous line spec");
+
+ pc = sal.pc;
}
else
error ("wrong # args");
- pc = sal.pc;
if (sal.symtab)
Tcl_DStringAppendElement (result_ptr, sal.symtab->filename);
else
Tcl_DStringAppendElement (result_ptr, "");
find_pc_partial_function (pc, &funcname, NULL, NULL);
- Tcl_DStringAppendElement (result_ptr, funcname);
-
+ fname = cplus_demangle (funcname, 0);
+ if (fname)
+ {
+ Tcl_DStringAppendElement (result_ptr, fname);
+ free (fname);
+ }
+ else
+ Tcl_DStringAppendElement (result_ptr, funcname);
filename = symtab_to_filename (sal.symtab);
if (filename == NULL)
- filename = "N/A";
+ filename = "";
Tcl_DStringAppendElement (result_ptr, filename);
dsprintf_append_element (result_ptr, "%d", sal.line); /* line number */
/* addr: address of data to dump */
/* form: a char indicating format */
/* size: size of each element; 1,2,4, or 8 bytes*/
-/* num: the number of 'size' elements to return */
-/* acshar: an optional ascii character to use in ASCII dump */
-/* returns a list of 'num' elements followed by an optional */
+/* num: the number of bytes to read */
+/* acshar: an optional ascii character to use in ASCII dump */
+/* returns a list of elements followed by an optional */
/* ASCII dump */
+
static int
gdb_get_mem (clientData, interp, argc, argv)
ClientData clientData;
int argc;
char *argv[];
{
- int size, asize, num, i, j;
- CORE_ADDR addr, saved_addr, ptr;
- int format;
+ int size, asize, i, j, bc;
+ CORE_ADDR addr;
+ int nbytes, rnum, bpr;
+ char format, c, *ptr, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
struct type *val_type;
- value_ptr vptr;
- char c, buff[128], aschar;
- if (argc != 6)
- error ("wrong # args");
+ if (argc < 6 || argc > 7)
+ {
+ interp->result = "addr format size bytes bytes_per_row ?ascii_char?";
+ return TCL_ERROR;
+ }
+
+ size = (int)strtoul(argv[3],(char **)NULL,0);
+ nbytes = (int)strtoul(argv[4],(char **)NULL,0);
+ bpr = (int)strtoul(argv[5],(char **)NULL,0);
+ if (nbytes <= 0 || bpr <= 0 || size <= 0)
+ {
+ interp->result = "Invalid number of bytes.";
+ return TCL_ERROR;
+ }
addr = (CORE_ADDR)strtoul(argv[1],(char **)NULL,0);
- saved_addr = addr;
format = *argv[2];
- size = (int)strtoul(argv[3],(char **)NULL,0);
- num = (int)strtoul(argv[4],(char **)NULL,0);
- aschar = *argv[5];
+ mbuf = (char *)malloc (nbytes+32);
+ if (!mbuf)
+ {
+ interp->result = "Out of memory.";
+ return TCL_ERROR;
+ }
+ memset (mbuf, 0, nbytes+32);
+ mptr = cptr = mbuf;
+
+ rnum = target_read_memory_partial (addr, mbuf, nbytes, NULL);
+
+ if (argv[6])
+ aschar = *argv[6];
+ else
+ aschar = 0;
switch (size) {
case 1:
asize = 'b';
}
- for (i=0; i < num; i++)
- {
- vptr = value_at (val_type, addr, (asection *)NULL);
- print_scalar_formatted (VALUE_CONTENTS(vptr), val_type, format, asize, gdb_stdout);
- fputs_unfiltered (" ", gdb_stdout);
- addr += size;
- }
-
- if (aschar)
+ bc = 0; /* count of bytes in a row */
+ buff[0] = '"'; /* buffer for ascii dump */
+ bptr = &buff[1]; /* pointer for ascii dump */
+
+ for (i=0; i < nbytes; i+= size)
{
- val_type = builtin_type_char;
- ptr = saved_addr;
- buff[0] = '"';
- i = 1;
- for (j=0; j < num*size; j++)
+ if ( i >= rnum)
{
- c = *(char *)VALUE_CONTENTS(value_at (val_type, ptr, (asection *)NULL));
- if (c < 32 || c > 126)
- c = aschar;
- if (c == '"')
- buff[i++] = '\\';
- buff[i++] = c;
- ptr++;
+ fputs_unfiltered ("N/A ", gdb_stdout);
+ if (aschar)
+ for ( j = 0; j < size; j++)
+ *bptr++ = 'X';
+ }
+ else
+ {
+ print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
+ fputs_unfiltered (" ", gdb_stdout);
+ if (aschar)
+ {
+ for ( j = 0; j < size; j++)
+ {
+ c = *cptr++;
+ if (c < 32 || c > 126)
+ c = aschar;
+ if (c == '"')
+ *bptr++ = '\\';
+ *bptr++ = c;
+ }
+ }
}
- buff[i++] = '"';
- buff[i] = 0;
- fputs_unfiltered (buff, gdb_stdout);
- }
-
- return TCL_OK;
-}
-
-
-/* This implements the TCL command `gdb_sourcelines', which returns a list of
- all of the lines containing executable code for the specified source file
- (ie: lines where you can put breakpoints). */
-
-static int
-gdb_sourcelines (clientData, interp, argc, argv)
- ClientData clientData;
- Tcl_Interp *interp;
- int argc;
- char *argv[];
-{
- struct symtab *symtab;
- struct linetable_entry *le;
- int nlines;
-
- if (argc != 2)
- error ("wrong # args");
-
- symtab = lookup_symtab (argv[1]);
-
- if (!symtab)
- error ("No such file");
-
- /* If there's no linetable, or no entries, then we are done. */
-
- if (!symtab->linetable
- || symtab->linetable->nitems == 0)
- {
- Tcl_DStringAppendElement (result_ptr, "");
- return TCL_OK;
- }
-
- le = symtab->linetable->item;
- nlines = symtab->linetable->nitems;
- for (;nlines > 0; nlines--, le++)
- {
- /* If the pc of this line is the same as the pc of the next line, then
- just skip it. */
- if (nlines > 1
- && le->pc == (le + 1)->pc)
- continue;
+ mptr += size;
+ bc += size;
- dsprintf_append_element (result_ptr, "%d", le->line);
+ if (aschar && (bc >= bpr))
+ {
+ /* end of row. print it and reset variables */
+ bc = 0;
+ *bptr++ = '"';
+ *bptr++ = ' ';
+ *bptr = 0;
+ fputs_unfiltered (buff, gdb_stdout);
+ bptr = &buff[1];
+ }
}
-
+
+ free (mbuf);
return TCL_OK;
}
-\f
+
static int
map_arg_registers (argc, argv, func, argp)
int argc;
char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
int format = (int)fp;
+ if (format == 'N')
+ format = 0;
+
if (read_relative_register_raw_bytes (regnum, raw_buffer))
{
Tcl_DStringAppendElement (result_ptr, "Optimized out");
Tcl_DStringAppend (result_ptr, " ", -1);
}
+static int
+get_pc_register (clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char *argv[];
+{
+ sprintf(interp->result,"0x%llx",(long long)read_register(PC_REGNUM));
+ return TCL_OK;
+}
+
static int
gdb_fetch_registers (clientData, interp, argc, argv)
ClientData clientData;
if (argc < 2)
error ("wrong # args");
- argc--;
+ argc -= 2;
argv++;
-
- argc--;
format = **argv++;
-
+
return map_arg_registers (argc, argv, get_register, (void *) format);
}
\f
/* This implements the tcl command "gdb_immediate", which does exactly
the same thing as gdb_cmd, except NONE of its outut is buffered. */
+/* This will also ALWAYS cause the busy,update, and idle hooks to be
+ called, contrasted with gdb_cmd, which NEVER calls them. */
static int
gdb_immediate_command (clientData, interp, argc, argv)
ClientData clientData;
if (argc != 2)
error ("wrong # args");
- if (running_now)
+ if (running_now || load_in_progress)
return TCL_OK;
+ No_Update = 0;
+
Tcl_DStringAppend (result_ptr, "", -1);
save_ptr = result_ptr;
result_ptr = NULL;
/* This implements the TCL command `gdb_cmd', which sends its argument into
the GDB command scanner. */
-
+/* This command will never cause the update, idle and busy hooks to be called
+ within the GUI. */
static int
gdb_cmd (clientData, interp, argc, argv)
ClientData clientData;
{
Tcl_DString *save_ptr = NULL;
- if (argc != 2)
+ if (argc < 2)
error ("wrong # args");
- if (running_now)
+ if (running_now || load_in_progress)
return TCL_OK;
+ No_Update = 1;
+
/* for the load instruction (and possibly others later) we
set result_ptr to NULL so gdbtk_fputs() will not buffer
all the data until the command is finished. */
save_ptr = result_ptr;
result_ptr = NULL;
load_in_progress = 1;
-
- /* On Windows, use timer interrupts so that the user can cancel
- the download. FIXME: We may have to do something on other
- systems. */
-#ifdef __CYGWIN32__
gdbtk_start_timer ();
-#endif
}
execute_command (argv[1], 1);
-#ifdef __CYGWIN32__
if (load_in_progress)
- gdbtk_stop_timer ();
-#endif
+ {
+ gdbtk_stop_timer ();
+ load_in_progress = 0;
+ }
- load_in_progress = 0;
bpstat_do_actions (&stop_bpstat);
if (save_ptr)
return 1;
}
+struct wrapped_call_objs
+{
+ Tcl_Interp *interp;
+ Tcl_CmdProc *func;
+ int objc;
+ Tcl_Obj **objv;
+ int val;
+};
+
+static int
+wrapped_obj_call (args)
+ struct wrapped_call_objs *args;
+{
+ args->val = (*args->func) (args->func, args->interp, args->objc, args->objv);
+ return 1;
+}
+
/* This routine acts as a top-level for all GDB code called by tcl/Tk. It
handles cleanups, and calls to return_to_top_level (usually via error).
This is necessary in order to prevent a longjmp out of the bowels of Tk,
{
wrapped_args.val = TCL_ERROR; /* Flag an error for TCL */
-#ifdef __CYGWIN32__
/* Make sure the timer interrupts are turned off. */
if (gdbtk_timer_going)
- gdbtk_stop_timer ();
-#endif
+ gdbtk_stop_timer ();
gdb_flush (gdb_stderr); /* Flush error output */
gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */
running_now = 0;
Tcl_Eval (interp, "gdbtk_tcl_idle");
}
-
- /* if the download was cancelled, don't print the error */
- if (load_in_progress)
- {
- Tcl_DStringInit (&error_string);
- wrapped_args.val = TCL_OK;
- load_in_progress = 0;
- }
+
+ /* do not suppress any errors -- a remote target could have errored */
+ load_in_progress = 0;
if (Tcl_DStringLength (&error_string) == 0)
{
result_ptr = old_result_ptr;
error_string_ptr = old_error_string_ptr;
+#ifdef _WIN32
+ close_bfds ();
+#endif
+
+ return wrapped_args.val;
+}
+static int
+call_obj_wrapper (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ struct wrapped_call_objs wrapped_args;
+ Tcl_DString result, *old_result_ptr;
+ Tcl_DString error_string, *old_error_string_ptr;
+
+ /* The obj call wrapper works differently from the string wrapper, because
+ * the obj calls currently insert their results directly into the
+ * interpreter's result. So there is no need to have a result_ptr...
+ * FIXME - rewrite all the object commands so they use a result_obj_ptr
+ * - rewrite all the string commands to be object commands.
+ */
+
+ Tcl_DStringInit (&result);
+ old_result_ptr = result_ptr;
+ result_ptr = &result;
+
+ Tcl_DStringInit (&error_string);
+
+ Tcl_DStringInit (&error_string);
+ old_error_string_ptr = error_string_ptr;
+ error_string_ptr = &error_string;
+
+ wrapped_args.func = (Tcl_CmdProc *)clientData;
+ wrapped_args.interp = interp;
+ wrapped_args.objc = objc;
+ wrapped_args.objv = objv;
+ wrapped_args.val = 0;
+
+ if (!catch_errors (wrapped_obj_call, &wrapped_args, "", RETURN_MASK_ALL))
+ {
+ wrapped_args.val = TCL_ERROR; /* Flag an error for TCL */
+
+ /* Make sure the timer interrupts are turned off. */
+ if (gdbtk_timer_going)
+ gdbtk_stop_timer ();
+
+ gdb_flush (gdb_stderr); /* Flush error output */
+ gdb_flush (gdb_stdout); /* Sometimes error output comes here as well */
+
+ /* In case of an error, we may need to force the GUI into idle
+ mode because gdbtk_call_command may have bombed out while in
+ the command routine. */
+
+ running_now = 0;
+ Tcl_Eval (interp, "gdbtk_tcl_idle");
+ }
+
+ /* do not suppress any errors -- a remote target could have errored */
+ load_in_progress = 0;
+
+ if (Tcl_DStringLength (&error_string) == 0)
+ {
+ /* We should insert the result here, but the obj commands now
+ * do this directly, so we don't need to.
+ * FIXME - ultimately, all this should be redone so that all the
+ * commands either manipulate the Tcl result directly, or use a result_ptr.
+ */
+
+ Tcl_DStringFree (&error_string);
+ }
+ else if (*(Tcl_GetStringResult (interp)) == '\0')
+ {
+ Tcl_DStringResult (interp, &error_string);
+ Tcl_DStringFree (&error_string);
+ }
+ else
+ {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), Tcl_DStringValue (&error_string),
+ Tcl_DStringLength (&error_string));
+ Tcl_DStringFree (&error_string);
+ }
+
+ result_ptr = old_result_ptr;
+ error_string_ptr = old_error_string_ptr;
+
#ifdef _WIN32
close_bfds ();
#endif
return strcmp(*file1,*file2);
}
-
static int
gdb_listfiles (clientData, interp, objc, objv)
ClientData clientData;
struct objfile *objfile;
struct partial_symtab *psymtab;
struct symtab *symtab;
- char *lastfile, *pathname, *files[1000];
+ char *lastfile, *pathname, **files;
+ int files_size;
int i, numfiles = 0, len = 0;
Tcl_Obj *mylist;
+ files_size = 1000;
+ files = (char **) xmalloc (sizeof (char *) * files_size);
+
if (objc > 2)
{
Tcl_WrongNumArgs (interp, 1, objv, "Usage: gdb_listfiles ?pathname?");
ALL_PSYMTABS (objfile, psymtab)
{
+ if (numfiles == files_size)
+ {
+ files_size = files_size * 2;
+ files = (char **) xrealloc (files, sizeof (char *) * files_size);
+ }
if (len == 0)
{
if (psymtab->filename)
ALL_SYMTABS (objfile, symtab)
{
+ if (numfiles == files_size)
+ {
+ files_size = files_size * 2;
+ files = (char **) xrealloc (files, sizeof (char *) * files_size);
+ }
if (len == 0)
{
if (symtab->filename)
lastfile = files[i];
}
Tcl_SetObjResult (interp, mylist);
+ free (files);
return TCL_OK;
}
struct blockvector *bv;
struct block *b;
struct symbol *sym;
+ char buf[128];
int i,j;
-
+
if (argc != 2)
error ("wrong # args");
- symtab = lookup_symtab (argv[1]);
-
+ symtab = full_lookup_symtab (argv[1]);
if (!symtab)
error ("No such file");
sym = BLOCK_SYM (b, j);
if (SYMBOL_CLASS (sym) == LOC_BLOCK)
{
- Tcl_DStringAppendElement (result_ptr, SYMBOL_NAME(sym));
+
+ char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
+ if (name)
+ {
+ sprintf (buf,"{%s} 1", name);
+ }
+ else
+ sprintf (buf,"{%s} 0", SYMBOL_NAME(sym));
+ Tcl_DStringAppendElement (result_ptr, buf);
}
}
}
}
static int
-gdb_stop (clientData, interp, argc, argv)
- ClientData clientData;
+target_stop_wrapper (args)
+ char * args;
+{
+ target_stop ();
+ return 1;
+}
+
+static int
+gdb_stop (clientData, interp, argc, argv)
+ ClientData clientData;
Tcl_Interp *interp;
int argc;
char *argv[];
{
if (target_stop)
- target_stop ();
+ {
+ catch_errors (target_stop_wrapper, NULL, "",
+ RETURN_MASK_ALL);
+ }
else
quit_flag = 1; /* hope something sees this */
x_event (signo)
int signo;
{
- /* Process pending events */
+ static int in_x_event = 0;
+ static Tcl_Obj *varname = NULL;
+ if (in_x_event || in_fputs)
+ return;
+ in_x_event = 1;
+
+ /* Process pending events */
while (Tcl_DoOneEvent (TCL_DONT_WAIT|TCL_ALL_EVENTS) != 0)
;
- /* If we are doing a download, see if the download should be
- cancelled. FIXME: We should use a better variable name. */
if (load_in_progress)
{
- char *val;
-
- val = Tcl_GetVar (interp, "download_cancel_ok", TCL_GLOBAL_ONLY);
- if (val != NULL && atoi (val))
+ int val;
+ if (varname == NULL)
+ {
+ Tcl_Obj *varnamestrobj = Tcl_NewStringObj("download_cancel_ok",-1);
+ varname = Tcl_ObjGetVar2(interp,varnamestrobj,NULL,TCL_GLOBAL_ONLY);
+ }
+ if ((Tcl_GetIntFromObj(interp,varname,&val) == TCL_OK) && val)
{
quit_flag = 1;
#ifdef REQUEST_QUIT
#endif
}
}
+ in_x_event = 0;
}
-#ifdef __CYGWIN32__
-
/* For Cygwin32, we use a timer to periodically check for Windows
messages. FIXME: It would be better to not poll, but to instead
rewrite the target_wait routines to serve as input sources.
Unfortunately, that will be a lot of work. */
+static sigset_t nullsigmask;
+static struct sigaction act1, act2;
+static struct itimerval it_on, it_off;
static void
gdbtk_start_timer ()
{
- sigset_t nullsigmask;
- struct sigaction action;
- struct itimerval it;
-
- sigemptyset (&nullsigmask);
-
- action.sa_handler = x_event;
- action.sa_mask = nullsigmask;
- action.sa_flags = 0;
- sigaction (SIGALRM, &action, NULL);
-
- it.it_interval.tv_sec = 0;
- /* Check for messages twice a second. */
- it.it_interval.tv_usec = 500 * 1000;
- it.it_value.tv_sec = 0;
- it.it_value.tv_usec = 500 * 1000;
-
- setitimer (ITIMER_REAL, &it, NULL);
-
- gdbtk_timer_going = 1;
+ static int first = 1;
+ /*TclDebug ("Starting timer....");*/
+ if (first)
+ {
+ /* first time called, set up all the structs */
+ first = 0;
+ sigemptyset (&nullsigmask);
+
+ act1.sa_handler = x_event;
+ 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; /* .25 sec */
+ 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 (!gdbtk_timer_going)
+ {
+ sigaction (SIGALRM, &act1, NULL);
+ setitimer (ITIMER_REAL, &it_on, NULL);
+ gdbtk_timer_going = 1;
+ }
}
static void
gdbtk_stop_timer ()
{
- sigset_t nullsigmask;
- struct sigaction action;
- struct itimerval it;
-
- gdbtk_timer_going = 0;
-
- sigemptyset (&nullsigmask);
-
- action.sa_handler = SIG_IGN;
- action.sa_mask = nullsigmask;
- action.sa_flags = 0;
- sigaction (SIGALRM, &action, NULL);
-
- it.it_interval.tv_sec = 0;
- it.it_interval.tv_usec = 0;
- it.it_value.tv_sec = 0;
- it.it_value.tv_usec = 0;
- setitimer (ITIMER_REAL, &it, NULL);
+ if (gdbtk_timer_going)
+ {
+ gdbtk_timer_going = 0;
+ /*TclDebug ("Stopping timer.");*/
+ setitimer (ITIMER_REAL, &it_off, NULL);
+ sigaction (SIGALRM, &act2, NULL);
+ }
}
-#endif
-
/* This hook function is called whenever we want to wait for the
target. */
int pid;
struct target_waitstatus *ourstatus;
{
-#ifndef WINNT
- struct sigaction action;
- static sigset_t nullsigmask = {0};
-
-
-#ifndef SA_RESTART
- /* Needed for SunOS 4.1.x */
-#define SA_RESTART 0
-#endif
-
- action.sa_handler = x_event;
- action.sa_mask = nullsigmask;
- action.sa_flags = SA_RESTART;
- sigaction(SIGIO, &action, NULL);
-#endif /* WINNT */
-
-#ifdef __CYGWIN32__
- /* Call x_event ourselves now, as well as starting the timer;
- otherwise, if single stepping, we may never wait long enough for
- the timer to trigger. */
- x_event (SIGALRM);
-
gdbtk_start_timer ();
-#endif
-
pid = target_wait (pid, ourstatus);
-
-#ifdef __CYGWIN32__
gdbtk_stop_timer ();
-#endif
-
-#ifndef WINNT
- action.sa_handler = SIG_IGN;
- sigaction(SIGIO, &action, NULL);
-#endif
-
return pid;
}
running_now = 0;
if (cmdblk->class == class_run || cmdblk->class == class_trace)
{
- running_now = 1;
- Tcl_Eval (interp, "gdbtk_tcl_busy");
- (*cmdblk->function.cfunc)(arg, from_tty);
- running_now = 0;
- Tcl_Eval (interp, "gdbtk_tcl_idle");
+
+/* HACK! HACK! This is to get the gui to update the tstart/tstop
+ button only incase of tstart/tstop commands issued from the console
+ We don't want to update the src window, s we need to have specific
+ procedures to do tstart and tstop
+*/
+ if (!strcmp(cmdblk->name, "tstart") && !No_Update)
+ Tcl_Eval (interp, "gdbtk_tcl_tstart");
+ else if (!strcmp(cmdblk->name, "tstop") && !No_Update)
+ Tcl_Eval (interp, "gdbtk_tcl_tstop");
+/* end of hack */
+ else
+ {
+ running_now = 1;
+ if (!No_Update)
+ Tcl_Eval (interp, "gdbtk_tcl_busy");
+ (*cmdblk->function.cfunc)(arg, from_tty);
+ running_now = 0;
+ if (!No_Update)
+ Tcl_Eval (interp, "gdbtk_tcl_idle");
+ }
}
else
(*cmdblk->function.cfunc)(arg, from_tty);
gdbtk_cleanup (dummy)
PTR dummy;
{
+#ifdef IDE
+ struct ide_event_handle *h = (struct ide_event_handle *) dummy;
+
+ ide_interface_deregister_all (h);
+#endif
Tcl_Finalize ();
}
Tcl_FindExecutable (argv0);
interp = Tcl_CreateInterp ();
+#ifdef TCL_MEM_DEBUG
+ Tcl_InitMemory (interp);
+#endif
+
if (!interp)
error ("Tcl_CreateInterp failed");
if (Tcl_Init(interp) != TCL_OK)
error ("Tcl_Init failed: %s", interp->result);
- make_final_cleanup (gdbtk_cleanup, NULL);
+#ifndef IDE
+ /* For the IDE we register the cleanup later, after we've
+ initialized events. */
+ make_final_cleanup (gdbtk_cleanup, NULL);
+#endif
/* Initialize the Paths variable. */
if (ide_initialize_paths (interp, "gdbtcl") != TCL_OK)
IluTk_Init ();
h = ide_event_init_from_environment (&errmsg, libexecdir);
+ make_final_cleanup (gdbtk_cleanup, h);
if (h == NULL)
{
Tcl_AppendResult (interp, "can't initialize event system: ", errmsg,
*/
Tcl_SetVar (interp, "GDBTK_IDE", "1", 0);
- Tcl_SetVar (interp, "IDE", "1", TCL_GLOBAL_ONLY);
}
/* end-sanitize-ide */
#else
error ("Tix_Init failed: %s", interp->result);
#ifdef __CYGWIN32__
+ if (ide_create_messagebox_command (interp) != TCL_OK)
+ error ("messagebox command initialization failed");
/* On Windows, create a sizebox widget command */
if (ide_create_sizebox_command (interp) != TCL_OK)
error ("sizebox creation failed");
if (ide_create_shell_execute_command (interp) != TCL_OK)
error ("shell execute command initialization failed");
/* end-sanitize-ide */
+ if (ide_create_win_grab_command (interp) != TCL_OK)
+ error ("grab support command initialization failed");
+ /* Path conversion functions. */
+ if (ide_create_cygwin_path_command (interp) != TCL_OK)
+ error ("cygwin path command initialization failed");
#endif
Tcl_CreateCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
gdb_immediate_command, NULL);
Tcl_CreateCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
Tcl_CreateCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv, NULL);
- Tcl_CreateCommand (interp, "gdb_sourcelines", call_wrapper, gdb_sourcelines,
- NULL);
- Tcl_CreateObjCommand (interp, "gdb_listfiles", gdb_listfiles, NULL, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_listfiles", call_obj_wrapper, gdb_listfiles, NULL);
Tcl_CreateCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
NULL);
Tcl_CreateCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
Tcl_CreateCommand (interp, "gdb_target_has_execution",
gdb_target_has_execution_command,
NULL, NULL);
- Tcl_CreateObjCommand (interp, "gdb_load_info", gdb_load_info, NULL, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_locals", gdb_get_vars_command,
- (ClientData) 0, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_args", gdb_get_vars_command,
- (ClientData) 1, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_function", gdb_get_function_command,
- NULL, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_line", gdb_get_line_command,
- NULL, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_file", gdb_get_file_command,
- NULL, NULL);
+ Tcl_CreateCommand (interp, "gdb_is_tracing",
+ gdb_trace_status,
+ NULL, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_load_info", call_obj_wrapper, gdb_load_info, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_get_locals", call_obj_wrapper, gdb_get_locals_command,
+ NULL);
+ Tcl_CreateObjCommand (interp, "gdb_get_args", call_obj_wrapper, gdb_get_args_command,
+ NULL);
+ Tcl_CreateObjCommand (interp, "gdb_get_function", call_obj_wrapper, gdb_get_function_command,
+ NULL);
+ Tcl_CreateObjCommand (interp, "gdb_get_line", call_obj_wrapper, gdb_get_line_command,
+ NULL);
+ Tcl_CreateObjCommand (interp, "gdb_get_file", call_obj_wrapper, gdb_get_file_command,
+ NULL);
Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
- gdb_tracepoint_exists_command, NULL, NULL);
+ call_obj_wrapper, gdb_tracepoint_exists_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
- gdb_get_tracepoint_info, NULL, NULL);
+ call_obj_wrapper, gdb_get_tracepoint_info, NULL);
Tcl_CreateObjCommand (interp, "gdb_actions",
- gdb_actions_command, NULL, NULL);
+ call_obj_wrapper, gdb_actions_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_prompt",
- gdb_prompt_command, NULL, NULL);
+ call_obj_wrapper, gdb_prompt_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_find_file",
- gdb_find_file_command, NULL, NULL);
+ call_obj_wrapper, gdb_find_file_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
- gdb_get_tracepoint_list, NULL, NULL);
-
+ call_obj_wrapper, gdb_get_tracepoint_list, NULL);
+ Tcl_CreateCommand (interp, "gdb_pc_reg", get_pc_register, NULL, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_loadfile", call_obj_wrapper, gdb_loadfile, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_set_bp", call_obj_wrapper, gdb_set_bp, NULL);
+
command_loop_hook = tk_command_loop;
- print_frame_info_listing_hook =
- (void (*) PARAMS ((struct symtab *, int, int, int))) null_routine;
+ print_frame_info_listing_hook = gdbtk_print_frame_info;
query_hook = gdbtk_query;
+ warning_hook = gdbtk_warning;
flush_hook = gdbtk_flush;
create_breakpoint_hook = gdbtk_create_breakpoint;
delete_breakpoint_hook = gdbtk_delete_breakpoint;
post_add_symbol_hook = gdbtk_post_add_symbol;
create_tracepoint_hook = gdbtk_create_tracepoint;
delete_tracepoint_hook = gdbtk_delete_tracepoint;
-
-#ifndef WINNT
- /* Get the file descriptor for the X server */
-
- x_fd = ConnectionNumber (Tk_Display (Tk_MainWindow (interp)));
-
- /* Setup for I/O interrupts */
-
- action.sa_mask = nullsigmask;
- action.sa_flags = 0;
- action.sa_handler = SIG_IGN;
- sigaction(SIGIO, &action, NULL);
-
-#ifdef FIOASYNC
- i = 1;
- 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
-#ifndef WINNT
- if (ioctl (x_fd, I_SETSIG, S_INPUT|S_RDNORM) < 0)
- perror_with_name ("gdbtk_init: ioctl I_SETSIG failed");
-#endif
-
-#endif /* ifndef FIOASYNC */
-#endif /* WINNT */
+ modify_tracepoint_hook = gdbtk_modify_tracepoint;
+ pc_changed_hook = pc_changed;
add_com ("tk", class_obscure, tk_command,
"Send a command directly into tk.");
return TCL_OK;
}
+static int
+gdb_trace_status (clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char *argv[];
+{
+ int result = 0;
+
+ if (trace_running_p)
+ result = 1;
+
+ Tcl_SetIntObj (Tcl_GetObjResult (interp), result);
+ return TCL_OK;
+}
+
/* gdb_load_info - returns information about the file about to be downloaded */
static int
return atoi (interp->result);
}
+/* gdb_get_locals -
+ * This and gdb_get_locals just call gdb_get_vars_command with the right
+ * value of clientData. We can't use the client data in the definition
+ * of the command, because the call wrapper uses this instead...
+ */
+
+static int
+gdb_get_locals_command (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+
+ return gdb_get_vars_command((ClientData) 0, interp, objc, objv);
+
+}
+
+static int
+gdb_get_args_command (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+
+ return gdb_get_vars_command((ClientData) 1, interp, objc, objv);
+
+}
+
/* gdb_get_vars_command -
*
* Implements the "gdb_get_locals" and "gdb_get_args" tcl commands. This
find_pc_partial_function (tp->address, &funcname, NULL, NULL);
Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (funcname, -1));
Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (sal.line));
- sprintf (tmp, "0x%08x", tp->address);
+ sprintf (tmp, "0x%lx", tp->address);
Tcl_ListObjAppendElement (interp, list, Tcl_NewStringObj (tmp, -1));
Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->enabled));
Tcl_ListObjAppendElement (interp, list, Tcl_NewIntObj (tp->pass_count));
return TCL_OK;
}
+
+/* TclDebug (const char *fmt, ...) works just like printf() but */
+/* sends the output to the GDB TK debug window. */
+/* Not for normal use; just a convenient tool for debugging */
+void
+#ifdef ANSI_PROTOTYPES
+TclDebug (const char *fmt, ...)
+#else
+TclDebug (va_alist)
+ va_dcl
+#endif
+{
+ va_list args;
+ char buf[512], *v[2], *merge;
+
+#ifdef ANSI_PROTOTYPES
+ va_start (args, fmt);
+#else
+ char *fmt;
+ va_start (args);
+ fmt = va_arg (args, char *);
+#endif
+
+ v[0] = "debug";
+ v[1] = buf;
+
+ vsprintf (buf, fmt, args);
+ va_end (args);
+
+ merge = Tcl_Merge (2, v);
+ Tcl_Eval (interp, merge);
+ Tcl_Free (merge);
+}
+
+
+/* Find the full pathname to a file, searching the symbol tables */
+
+static int
+gdb_find_file_command (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ char *filename = NULL;
+ struct symtab *st;
+
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename");
+ return TCL_ERROR;
+ }
+
+ st = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
+ if (st)
+ filename = st->fullname;
+
+ if (filename == NULL)
+ Tcl_SetObjResult (interp, Tcl_NewStringObj ("", 0));
+ else
+ Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
+
+ return TCL_OK;
+}
+
static void
gdbtk_create_tracepoint (tp)
struct tracepoint *tp;
tracepoint_notify (tp, "delete");
}
+static void
+gdbtk_modify_tracepoint (tp)
+ struct tracepoint *tp;
+{
+ tracepoint_notify (tp, "modify");
+}
+
static void
tracepoint_notify(tp, action)
struct tracepoint *tp;
if (filename == NULL)
filename = "N/A";
sprintf (buf, "gdbtk_tcl_tracepoint %s %d 0x%lx %d {%s}", action, tp->number,
- (long)tp->address, sal.line, filename);
+ (long)tp->address, sal.line, filename, tp->pass_count);
v = Tcl_Eval (interp, buf);
{
if (tp->address == sals.sals[0].pc)
result = tp->number;
+#if 0
+ /* Why is this here? This messes up assembly traces */
else if (tp->source_file != NULL
&& strcmp (tp->source_file, file) == 0
&& sals.sals[0].line == tp->line_number)
-
result = tp->number;
+#endif
}
}
}
}
/* Free any existing actions */
- for (temp = tp->actions; temp != NULL; temp = temp->next)
- {
- if (temp->action)
- free (temp->action);
- free (temp);
- }
+ if (tp->actions != NULL)
+ free_actions (tp);
+
step_count = 0;
Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
return TCL_OK;
}
-/* This is stolen from source.c */
-#ifdef CRLF_SOURCE_FILES
-/* Define CRLF_SOURCE_FILES in an xm-*.h file if source files on the
- host use \r\n rather than just \n. Defining CRLF_SOURCE_FILES is
- much faster than defining LSEEK_NOT_LINEAR. */
+/* This hook is called whenever we are ready to load a symbol file so that
+ the UI can notify the user... */
+void
+gdbtk_pre_add_symbol (name)
+ char *name;
+{
+ char *merge, *v[2];
-#ifndef O_BINARY
-#define O_BINARY 0
-#endif
+ v[0] = "gdbtk_tcl_pre_add_symbol";
+ v[1] = name;
+ merge = Tcl_Merge (2, v);
+ Tcl_Eval (interp, merge);
+ Tcl_Free (merge);
+}
+
+/* This hook is called whenever we finish loading a symbol file. */
+void
+gdbtk_post_add_symbol ()
+{
+ Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
+}
+
+
+
+static void
+gdbtk_print_frame_info (s, line, stopline, noerror)
+ struct symtab *s;
+ int line;
+ int stopline;
+ int noerror;
+{
+ current_source_symtab = s;
+ current_source_line = line;
+}
+
+
+/* The lookup_symtab() in symtab.c doesn't work correctly */
+/* It will not work will full pathnames and if multiple */
+/* source files have the same basename, it will return */
+/* the first one instead of the correct one. This version */
+/* also always makes sure symtab->fullname is set. */
+
+static struct symtab *
+full_lookup_symtab(file)
+ char *file;
+{
+ struct symtab *st;
+ struct objfile *objfile;
+ char *bfile, *fullname;
+ struct partial_symtab *pt;
+
+ if (!file)
+ return NULL;
+
+ /* first try a direct lookup */
+ st = lookup_symtab (file);
+ if (st)
+ {
+ if (!st->fullname)
+ symtab_to_filename(st);
+ return st;
+ }
+
+ /* if the direct approach failed, try */
+ /* looking up the basename and checking */
+ /* all matches with the fullname */
+ bfile = basename (file);
+ ALL_SYMTABS (objfile, st)
+ {
+ if (!strcmp (bfile, basename(st->filename)))
+ {
+ if (!st->fullname)
+ fullname = symtab_to_filename (st);
+ else
+ fullname = st->fullname;
-#define OPEN_MODE (O_RDONLY | O_BINARY)
+ if (!strcmp (file, fullname))
+ return st;
+ }
+ }
+
+ /* still no luck? look at psymtabs */
+ ALL_PSYMTABS (objfile, pt)
+ {
+ if (!strcmp (bfile, basename(pt->filename)))
+ {
+ st = PSYMTAB_TO_SYMTAB (pt);
+ if (st)
+ {
+ fullname = symtab_to_filename (st);
+ if (!strcmp (file, fullname))
+ return st;
+ }
+ }
+ }
+ return NULL;
+}
-#else /* ! defined (CRLF_SOURCE_FILES) */
+static int
+perror_with_name_wrapper (args)
+ char * args;
+{
+ perror_with_name (args);
+ return 1;
+}
-#define OPEN_MODE O_RDONLY
+/* gdb_loadfile loads a c source file into a text widget. */
-#endif /* ! defined (CRLF_SOURCE_FILES) */
+/* LTABLE_SIZE is the number of bytes to allocate for the */
+/* line table. Its size limits the maximum number of lines */
+/* in a file to 8 * LTABLE_SIZE. This memory is freed after */
+/* the file is loaded, so it is OK to make this very large. */
+/* Additional memory will be allocated if needed. */
+#define LTABLE_SIZE 20000
-/* Find the pathname to a file, searching the source_dir */
-/* we may actually need to use openp to find the the full pathname
- so we don't have any "../" et al in it. */
static int
-gdb_find_file_command (clientData, interp, objc, objv)
+gdb_loadfile (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
- char *file, *filename;
+ char *file, *widget, *line, *buf, msg[128];
+ int linenumbers, ln, anum, lnum, ltable_size;
+ Tcl_Obj *a[2], *b[2], *cmd;
+ FILE *fp;
+ char *ltable;
+ struct symtab *symtab;
+ struct linetable_entry *le;
+ long mtime = 0;
+ struct stat st;
- if (objc != 2)
+
+ if (objc != 4)
{
- Tcl_AppendResult (interp, "wrong # of args: should be \"",
- Tcl_GetStringFromObj (objv[0], NULL),
- " filename\"");
+ Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
+ return TCL_ERROR;
+ }
+
+ widget = Tcl_GetStringFromObj (objv[1], NULL);
+ file = Tcl_GetStringFromObj (objv[2], NULL);
+ Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
+
+ if ((fp = fopen ( file, "r" )) == NULL)
+ return TCL_ERROR;
+
+ symtab = full_lookup_symtab (file);
+ if (!symtab)
+ {
+ sprintf(msg, "File not found");
+ Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
+ fclose (fp);
return TCL_ERROR;
}
- file = Tcl_GetStringFromObj (objv[1], NULL);
- filename = find_file_in_dir (file);
-
- if (filename == NULL)
- Tcl_SetResult (interp, "", TCL_STATIC);
- else
- Tcl_SetObjResult (interp, Tcl_NewStringObj (filename, -1));
+ if (stat (file, &st) < 0)
+ {
+ catch_errors (perror_with_name_wrapper, "gdbtk: get time stamp", "",
+ RETURN_MASK_ALL);
+ return TCL_ERROR;
+ }
- return TCL_OK;
-}
+ if (symtab && symtab->objfile && symtab->objfile->obfd)
+ mtime = bfd_get_mtime(symtab->objfile->obfd);
+ else if (exec_bfd)
+ mtime = bfd_get_mtime(exec_bfd);
+
+ if (mtime && mtime < st.st_mtime)
+ gdbtk_ignorable_warning("Source file is more recent than executable.\n");
-static char *
-find_file_in_dir (file)
- char *file;
-{
- struct symtab *st = NULL;
- if (file != NULL)
+ /* Source linenumbers don't appear to be in order, and a sort is */
+ /* too slow so the fastest solution is just to allocate a huge */
+ /* array and set the array entry for each linenumber */
+
+ ltable_size = LTABLE_SIZE;
+ ltable = (char *)malloc (LTABLE_SIZE);
+ if (ltable == NULL)
{
- /* try something simple first */
- if (access (file, R_OK) == 0)
- return file;
-
- /* We really need a symtab for this to work... */
- st = lookup_symtab (file);
- if (st != NULL)
+ sprintf(msg, "Out of memory.");
+ Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
+ fclose (fp);
+ return TCL_ERROR;
+ }
+
+ memset (ltable, 0, LTABLE_SIZE);
+
+ if (symtab->linetable && symtab->linetable->nitems)
+ {
+ le = symtab->linetable->item;
+ for (ln = symtab->linetable->nitems ;ln > 0; ln--, le++)
+ {
+ lnum = le->line >> 3;
+ if (lnum >= ltable_size)
+ {
+ char *new_ltable;
+ new_ltable = (char *)realloc (ltable, ltable_size*2);
+ memset (new_ltable + ltable_size, 0, ltable_size);
+ ltable_size *= 2;
+ if (new_ltable == NULL)
+ {
+ sprintf(msg, "Out of memory.");
+ Tcl_SetStringObj ( Tcl_GetObjResult (interp), msg, -1);
+ free (ltable);
+ fclose (fp);
+ return TCL_ERROR;
+ }
+ ltable = new_ltable;
+ }
+ ltable[lnum] |= 1 << (le->line % 8);
+ }
+ }
+
+ /* create an object with enough space, then grab its */
+ /* buffer and sprintf directly into it. */
+ a[0] = Tcl_NewStringObj (ltable, 1024);
+ a[1] = Tcl_NewListObj(0,NULL);
+ buf = a[0]->bytes;
+ b[0] = Tcl_NewStringObj (ltable,1024);
+ b[1] = Tcl_NewStringObj ("source_tag", -1);
+ Tcl_IncrRefCount (b[0]);
+ Tcl_IncrRefCount (b[1]);
+ line = b[0]->bytes + 1;
+ strcpy(b[0]->bytes,"\t");
+
+ ln = 1;
+ while (fgets (line, 980, fp))
+ {
+ if (linenumbers)
+ {
+ if (ltable[ln >> 3] & (1 << (ln % 8)))
+ {
+ sprintf (buf,"%s insert end {-\t%d} break_tag", widget, ln);
+ a[0]->length = strlen (buf);
+ }
+ else
+ {
+ sprintf (buf,"%s insert end { \t%d} \"\"", widget, ln);
+ a[0]->length = strlen (buf);
+ }
+ }
+ else
+ {
+ if (ltable[ln >> 3] & (1 << (ln % 8)))
{
- file = symtab_to_filename (st);
- if (file != NULL)
- return file;
+ sprintf (buf,"%s insert end {-\t} break_tag", widget);
+ a[0]->length = strlen (buf);
}
+ else
+ {
+ sprintf (buf,"%s insert end { \t} \"\"", widget);
+ a[0]->length = strlen (buf);
+ }
+ }
+ b[0]->length = strlen(b[0]->bytes);
+ Tcl_SetListObj(a[1],2,b);
+ cmd = Tcl_ConcatObj(2,a);
+ Tcl_EvalObj (interp, cmd);
+ Tcl_DecrRefCount (cmd);
+ ln++;
}
-
- return NULL;
+ Tcl_DecrRefCount (b[0]);
+ Tcl_DecrRefCount (b[0]);
+ Tcl_DecrRefCount (b[1]);
+ Tcl_DecrRefCount (b[1]);
+ free (ltable);
+ fclose (fp);
+ return TCL_OK;
}
-/* This hook is called whenever we are ready to load a symbol file so that
- the UI can notify the user... */
-void
-gdbtk_pre_add_symbol (name)
- char *name;
-{
- char command[256];
+/* at some point make these static in breakpoint.c and move GUI code there */
+extern struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
+extern void set_breakpoint_count (int);
+extern int breakpoint_count;
- sprintf (command, "gdbtk_tcl_pre_add_symbol %s", name);
- Tcl_Eval (interp, command);
-}
+/* set a breakpoint by source file and line number */
+/* flags are as follows: */
+/* least significant 2 bits are disposition, rest is */
+/* type (normally 0).
-/* This hook is called whenever we finish loading a symbol file. */
-void
-gdbtk_post_add_symbol ()
-{
- Tcl_Eval (interp, "gdbtk_tcl_post_add_symbol");
+enum bptype {
+ bp_breakpoint, Normal breakpoint
+ bp_hardware_breakpoint, Hardware assisted breakpoint
}
+Disposition of breakpoint. Ie: what to do after hitting it.
+enum bpdisp {
+ del, Delete it
+ del_at_next_stop, Delete at next stop, whether hit or not
+ disable, Disable it
+ donttouch Leave it alone
+ };
+*/
-/* TclDebug (const char *fmt, ...) works just like printf() but */
-/* sends the output to the GDB TK debug window. */
-/* Not for normal use; just a convenient tool for debugging */
-void
-#ifdef ANSI_PROTOTYPES
-TclDebug (const char *fmt, ...)
-#else
-TclDebug (va_alist)
- va_dcl
-#endif
-{
- va_list args;
- char buf[512];
+static int
+gdb_set_bp (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
-#ifdef ANSI_PROTOTYPES
- va_start (args, fmt);
-#else
- char *fmt;
- va_start (args);
- fmt = va_arg (args, char *);
-#endif
+{
+ struct symtab_and_line sal;
+ int line, flags, ret;
+ struct breakpoint *b;
+ char buf[64];
+ Tcl_Obj *a[5], *cmd;
- strcpy (buf, "debug \"");
- vsprintf (&buf[7], fmt, args);
- va_end (args);
- strcat (buf, "\"");
- Tcl_Eval (interp, buf);
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
+ return TCL_ERROR;
+ }
+
+ sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
+ if (sal.symtab == NULL)
+ return TCL_ERROR;
+
+ if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
+ return TCL_ERROR;
+
+ if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
+ return TCL_ERROR;
+
+ sal.line = line;
+ sal.pc = find_line_pc (sal.symtab, sal.line);
+ if (sal.pc == 0)
+ return TCL_ERROR;
+
+ sal.section = find_pc_overlay (sal.pc);
+ b = set_raw_breakpoint (sal);
+ set_breakpoint_count (breakpoint_count + 1);
+ b->number = breakpoint_count;
+ b->type = flags >> 2;
+ b->disposition = flags & 3;
+
+ /* FIXME: this won't work for duplicate basenames! */
+ sprintf (buf, "%s:%d", basename(Tcl_GetStringFromObj( objv[1], NULL)), line);
+ b->addr_string = strsave (buf);
+
+ /* now send notification command back to GUI */
+ sprintf (buf, "0x%x", sal.pc);
+ a[0] = Tcl_NewStringObj ("gdbtk_tcl_breakpoint create", -1);
+ a[1] = Tcl_NewIntObj (b->number);
+ a[2] = Tcl_NewStringObj (buf, -1);
+ a[3] = objv[2];
+ a[4] = Tcl_NewListObj (1,&objv[1]);
+ cmd = Tcl_ConcatObj(5,a);
+ ret = Tcl_EvalObj (interp, cmd);
+ Tcl_DecrRefCount (cmd);
+ return ret;
}
-
/* Come here during initialize_all_files () */
void
init_ui_hook = gdbtk_init;
}
+#ifdef __CYGWIN32__
+ else
+ {
+ DWORD ft = GetFileType (GetStdHandle (STD_INPUT_HANDLE));
+ void cygwin32_attach_handle_to_fd (char *, int, HANDLE, int, int);
+
+ 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
}
projects / deliverable / binutils-gdb.git / blobdiff