#include "guitcl.h"
#include "gdbtk.h"
-#ifdef IDE
/* start-sanitize-ide */
+#ifdef IDE
#include "event.h"
#include "idetcl.h"
#include "ilutk.h"
-/* end-sanitize-ide */
#endif
+/* end-sanitize-ide */
#ifdef ANSI_PROTOTYPES
#include <stdarg.h>
static char old_regs[REGISTER_BYTES];
+/* These two lookup tables are used to translate the type & disposition fields
+ of the breakpoint structure (respectively) into something gdbtk understands.
+ They are also used in gdbtk-hooks.c */
+
+char *bptypes[] = {"none", "breakpoint", "hw breakpoint", "until",
+ "finish", "watchpoint", "hw watchpoint",
+ "read watchpoint", "acc watchpoint",
+ "longjmp", "longjmp resume", "step resume",
+ "sigtramp", "watchpoint scope",
+ "call dummy", "shlib events", "catch load",
+ "catch unload", "catch fork", "catch vfork",
+ "catch exec", "catch catch", "catch throw"
+};
+char *bpdisp[] = {"delete", "delstop", "disable", "donttouch"};
+
/*
* These are routines we need from breakpoint.c.
* at some point make these static in breakpoint.c and move GUI code there
extern void set_breakpoint_count (int);
extern int breakpoint_count;
+/* This variable determines where memory used for disassembly is read from.
+ * See note in gdbtk.h for details.
+ */
+int disassemble_from_exec = -1;
+
+extern int gdb_variable_init PARAMS ((Tcl_Interp *interp));
/*
* Declarations for routines exported from this file
*/
int Gdbtk_Init (Tcl_Interp *interp);
+int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
/*
* Declarations for routines used only in this file.
static int compare_lines PARAMS ((const PTR, const PTR));
static int comp_files PARAMS ((const void *, const void *));
-static int call_wrapper PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
static int gdb_actions_command PARAMS ((ClientData, Tcl_Interp *, int,
Tcl_Obj *CONST objv[]));
static int gdb_changed_register_list PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
static int gdb_search PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST
objv[]));
static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_set_bp_addr PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_find_bp_at_line PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
+static int gdb_find_bp_at_addr PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[]));
static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *,
int,
Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper,
gdb_search, NULL);
Tcl_CreateObjCommand (interp, "gdb_set_bp", call_wrapper, gdb_set_bp, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_set_bp_addr", call_wrapper, gdb_set_bp_addr, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_find_bp_at_line", call_wrapper, gdb_find_bp_at_line, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_find_bp_at_addr", call_wrapper, gdb_find_bp_at_addr, NULL);
Tcl_CreateObjCommand (interp, "gdb_get_trace_frame_num",
call_wrapper, gdb_get_trace_frame_num, NULL);
Tcl_CreateObjCommand (interp, "gdb_stack", call_wrapper, gdb_stack, NULL);
(char *) &gdb_context,
TCL_LINK_INT | TCL_LINK_READ_ONLY);
+ /* Init variable interface...*/
+ if (gdb_variable_init (interp) != TCL_OK)
+ return TCL_ERROR;
+
+ /* Determine where to disassemble from */
+ Tcl_LinkVar (gdbtk_interp, "disassemble-from-exec", (char *) &disassemble_from_exec,
+ TCL_LINK_INT);
+
Tcl_PkgProvide(interp, "Gdbtk", GDBTK_VERSION);
return TCL_OK;
}
recursively, it needs to save and restore the contents of the result_ptr as
necessary. */
-static int
+int
call_wrapper (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
- if (target_stop)
- {
+ if (target_stop != target_ignore)
target_stop ();
- }
else
quit_flag = 1; /* hope something sees this */
expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
- old_chain = make_cleanup (free_current_contents, &expr);
+ old_chain = make_cleanup ((make_cleanup_func) free_current_contents, &expr);
val = evaluate_expression (expr);
* the Tcl result.
*/
- val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), VALUE_ADDRESS (val),
+ val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
+ VALUE_EMBEDDED_OFFSET(val), VALUE_ADDRESS (val),
gdb_stdout, 0, 0, 0, 0);
do_cleanups (old_chain);
*
* Tcl Arguments:
* command - The GDB command to execute
+ * from_tty - 1 indicates this comes to the console. Pass this to the gdb command.
* Tcl Result:
* The output from the gdb command (except for the "load" & "while"
* which dump their output to the console.
int objc;
Tcl_Obj *CONST objv[];
{
-
+ int from_tty = 0;
+
if (objc < 2)
{
Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
return TCL_ERROR;
}
+ if (objc == 3)
+ {
+ if (Tcl_GetBooleanFromObj (NULL, objv[2], &from_tty) != TCL_OK) {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "from_tty must be a boolean.",
+ -1);
+ return TCL_ERROR;
+ }
+ }
+
if (running_now || load_in_progress)
return TCL_OK;
load_in_progress = 1;
}
- execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+ execute_command (Tcl_GetStringFromObj (objv[1], NULL), from_tty);
if (load_in_progress)
{
*
* Tcl Arguments:
* command - The GDB command to execute
+ * from_tty - 1 to indicate this is from the console.
* Tcl Result:
* None.
*/
Tcl_Obj *CONST objv[];
{
- if (objc != 2)
+ int from_tty = 0;
+
+ if (objc < 2)
{
Tcl_SetStringObj (result_ptr->obj_ptr, "wrong # args", -1);
return TCL_ERROR;
}
+ if (objc == 3)
+ {
+ if (Tcl_GetBooleanFromObj (NULL, objv[2], &from_tty) != TCL_OK) {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "from_tty must be a boolean.",
+ -1);
+ return TCL_ERROR;
+ }
+ }
+
if (running_now || load_in_progress)
return TCL_OK;
result_ptr->flags &= ~GDBTK_TO_RESULT;
- execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+ execute_command (Tcl_GetStringFromObj (objv[1], NULL), from_tty);
bpstat_do_actions (&stop_bpstat);
Tcl_SetStringObj (result_ptr->obj_ptr, "Open failed", -1);
return TCL_ERROR;
}
- old_cleanups = make_cleanup (bfd_close, loadfile_bfd);
+ old_cleanups = make_cleanup ((make_cleanup_func) bfd_close, loadfile_bfd);
if (!bfd_check_format (loadfile_bfd, bfd_object))
{
search_symbols (regexp, space, nfiles, files, &ss);
if (ss != NULL)
- old_chain = make_cleanup (free_search_symbols, ss);
+ old_chain = make_cleanup ((make_cleanup_func) free_search_symbols, ss);
Tcl_SetListObj(result_ptr->obj_ptr, 0, NULL);
if (static_only && p->block != STATIC_BLOCK)
continue;
- elem = Tcl_NewListObj (0, NULL);
+ /* Strip off some C++ special symbols, like RTTI and global
+ constructors/destructors. */
+ if ((p->symbol != NULL && !STREQN (SYMBOL_NAME (p->symbol), "__tf", 4)
+ && !STREQN (SYMBOL_NAME (p->symbol), "_GLOBAL_", 8))
+ || p->msymbol != NULL)
+ {
+ elem = Tcl_NewListObj (0, NULL);
- if (p->msymbol == NULL)
- Tcl_ListObjAppendElement (interp, elem,
- Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
- else
- Tcl_ListObjAppendElement (interp, elem,
- Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
+ if (p->msymbol == NULL)
+ Tcl_ListObjAppendElement (interp, elem,
+ Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->symbol), -1));
+ else
+ Tcl_ListObjAppendElement (interp, elem,
+ Tcl_NewStringObj (SYMBOL_SOURCE_NAME (p->msymbol), -1));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
+ Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elem);
+ }
}
if (ss != NULL)
if (SYMBOL_CLASS (sym) == LOC_BLOCK)
{
- char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
+ char *name = SYMBOL_DEMANGLED_NAME (sym);
+
if (name)
{
/* strip out "global constructors" and "global destructors" */
/* because we aren't interested in them. */
if (strncmp (name, "global ", 7))
{
+ /* If the function is overloaded, print out the functions
+ declaration, not just its name. */
+
funcVals[0] = Tcl_NewStringObj(name, -1);
- funcVals[1] = mangled;
+ funcVals[1] = mangled;
}
else
continue;
int regnum;
/* Note that the test for a valid register must include checking the
- reg_names array because NUM_REGS may be allocated for the union of the
- register sets within a family of related processors. In this case, the
- trailing entries of reg_names will change depending upon the particular
- processor being debugged. */
+ REGISTER_NAME because NUM_REGS may be allocated for the union of
+ the register sets within a family of related processors. In this
+ case, some entries of REGISTER_NAME will change depending upon
+ the particular processor being debugged. */
if (objc == 0) /* No args, just do all the regs */
{
for (regnum = 0;
regnum < NUM_REGS
- && reg_names[regnum] != NULL
- && *reg_names[regnum] != '\000';
+ && REGISTER_NAME (regnum) != NULL
+ && *REGISTER_NAME (regnum) != '\000';
regnum++)
func (regnum, argp);
if (regnum >= 0
&& regnum < NUM_REGS
- && reg_names[regnum] != NULL
- && *reg_names[regnum] != '\000')
+ && REGISTER_NAME (regnum) != NULL
+ && *REGISTER_NAME (regnum) != '\000')
func (regnum, argp);
else
{
void *argp; /* Ignored */
{
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (reg_names[regnum], -1));
+ Tcl_NewStringObj (REGISTER_NAME (regnum), -1));
}
/* This implements the tcl command gdb_fetch_registers
char raw_buffer[MAX_REGISTER_RAW_SIZE];
char virtual_buffer[MAX_REGISTER_VIRTUAL_SIZE];
int format = (int)fp;
+ int optim;
if (format == 'N')
format = 0;
- if (read_relative_register_raw_bytes (regnum, raw_buffer))
+ /* read_relative_register_raw_bytes returns a virtual frame pointer
+ (FRAME_FP (selected_frame)) if regnum == FP_REGNUM instead
+ of the real contents of the register. To get around this,
+ use get_saved_register instead. */
+ get_saved_register (raw_buffer, &optim, (CORE_ADDR *) NULL, selected_frame,
+ regnum, (enum lval_type *) NULL);
+ if (optim)
{
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
Tcl_NewStringObj ("Optimized out", -1));
if (format == 'r')
{
int j;
- printf_filtered ("0x");
+ char *ptr, buf[1024];
+
+ strcpy (buf, "0x");
+ ptr = buf + 2;
for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++)
{
register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
: REGISTER_RAW_SIZE (regnum) - 1 - j;
- printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
+ sprintf(ptr, "%02x", (unsigned char)raw_buffer[idx]);
+ ptr += 2;
}
+ fputs_filtered (buf, gdb_stdout);
}
else
- val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
+ val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, 0,
gdb_stdout, format, 1, 0, Val_pretty_default);
}
struct tracepoint *tp;
struct action_line *al;
Tcl_Obj *action_list;
- char *filename, *funcname;
+ char *filename, *funcname, *fname;
char tmp[19];
if (objc != 2)
if (tp == NULL)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Tracepoint #%d does not exist", -1);
+ char buff[64];
+ sprintf (buff, "Tracepoint #%d does not exist", tpnum);
+ Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
return TCL_ERROR;
}
filename = "N/A";
Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
Tcl_NewStringObj (filename, -1));
+
find_pc_partial_function (tp->address, &funcname, NULL, NULL);
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (funcname, -1));
+ fname = cplus_demangle (funcname, 0);
+ if (fname)
+ {
+ Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
+ (fname, -1));
+ free (fname);
+ }
+ else
+ Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
+ (funcname, -1));
+
Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewIntObj (sal.line));
sprintf (tmp, "0x%lx", tp->address);
Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj (tmp, -1));
di_initialized = 1;
}
- di.mach = tm_print_insn_info.mach;
+ di.mach = TARGET_PRINT_INSN_INFO->mach;
if (TARGET_BYTE_ORDER == BIG_ENDIAN)
di.endian = BFD_ENDIAN_BIG;
else
{
char *filename;
struct symtab_and_line sal;
+ struct symbol *sym;
char *funcname, *fname;
CORE_ADDR pc;
- if (!have_full_symbols () && !have_partial_symbols ())
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "No symbol table is loaded", -1);
- return TCL_ERROR;
- }
-
if (objc == 1)
{
if (selected_frame && (selected_frame->pc != stop_pc))
/* For a graphical debugger 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 on the stack, so what happens is the next instruction */
+ /* is highlighted. FIXME */
pc = selected_frame->pc;
sal = find_pc_line (selected_frame->pc,
selected_frame->next != NULL
Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
return TCL_ERROR;
}
+ resolve_sal_pc (&sal);
pc = sal.pc;
}
else
else
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewStringObj ("", 0));
- find_pc_partial_function (pc, &funcname, NULL, NULL);
- fname = cplus_demangle (funcname, 0);
- if (fname)
+ sym = find_pc_function (pc);
+ if (sym != NULL)
{
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (fname, -1));
- free (fname);
+ fname = SYMBOL_DEMANGLED_NAME (sym);
+ if (fname)
+ {
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (fname, -1));
+ }
+ else
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
}
else
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (funcname, -1));
+ {
+ /* find_pc_function will fail if there are only minimal symbols */
+ /* so do this instead... */
+ find_pc_partial_function (pc, &funcname, NULL, NULL);
+ /* we try cplus demangling; a guess really */
+ fname = cplus_demangle (funcname, 0);
+ if (fname)
+ {
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (fname, -1));
+ free (fname);
+ }
+ else
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (funcname, -1));
+ }
filename = symtab_to_filename (sal.symtab);
if (filename == NULL)
filename = "";
+ /* file name */
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
Tcl_NewStringObj (filename, -1));
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line)); /* line number */
- sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc)); /* PC in current frame */
- sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc)); /* Real PC */
+ /* line number */
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(sal.line));
+ /* PC in current frame */
+ sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(pc));
+ /* Real PC */
+ sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(stop_pc));
+
+ /* shared library */
+#ifdef PC_SOLIB
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (PC_SOLIB(pc), -1));
+#else
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj ("", -1));
+#endif
return TCL_OK;
}
long mtime = 0;
struct stat st;
Tcl_DString text_cmd_1, text_cmd_2, *cur_cmd;
- char line[1024], line_num_buf[16];
+ char line[10000], line_num_buf[16];
int prefix_len_1, prefix_len_2, cur_prefix_len, widget_len;
Tcl_DStringAppend (&text_cmd_2, " insert end { \t", -1);
prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
- while (fgets (line + 1, 980, fp))
+ while (fgets (line + 1, 9980, fp))
{
sprintf (line_num_buf, "%d", ln);
if (ltable[ln >> 3] & (1 << (ln % 8)))
cur_cmd = &text_cmd_1;
cur_prefix_len = prefix_len_1;
Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
- Tcl_DStringAppend (cur_cmd, "} break_tag", 11);
+ Tcl_DStringAppend (cur_cmd, "} break_rgn_tag", 15);
}
else
{
}
else
{
- Tcl_DStringAppend (&text_cmd_1, " insert end {- } break_tag", -1);
+ Tcl_DStringAppend (&text_cmd_1, " insert end {- } break_rgn_tag", -1);
prefix_len_1 = Tcl_DStringLength(&text_cmd_1);
Tcl_DStringAppend (&text_cmd_2, " insert end { } \"\"", -1);
prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
* filename: the file in which to set the breakpoint
* line: the line number for the breakpoint
* type: the type of the breakpoint
+ * thread: optional thread number
* Tcl Result:
* The return value of the call to gdbtk_tcl_breakpoint.
*/
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
-
{
struct symtab_and_line sal;
- int line, flags, ret;
+ int line, ret, thread = -1;
struct breakpoint *b;
- char buf[64];
+ char buf[64], *typestr;
Tcl_DString cmd;
+ enum bpdisp disp;
- if (objc != 4)
+ if (objc != 4 && objc != 5)
{
- Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "wrong number of args, should be \"filename line type [thread]\"", -1);
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)
{
result_ptr->flags = GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
-
- if (Tcl_GetIntFromObj( interp, objv[3], &flags) == TCL_ERROR)
+
+ typestr = Tcl_GetStringFromObj( objv[3], NULL);
+ if (typestr == NULL)
{
result_ptr->flags = GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
+ if (strncmp( typestr, "temp", 4 ) == 0)
+ disp = del;
+ else if (strncmp( typestr, "normal", 6 ) == 0)
+ disp = donttouch;
+ else
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "type must be \"temp\" or \"normal\"", -1);
+ return TCL_ERROR;
+ }
+
+ if (objc == 5)
+ {
+ if (Tcl_GetIntFromObj( interp, objv[4], &thread) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+ }
sal.line = line;
if (!find_line_pc (sal.symtab, sal.line, &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;
+ b->type = bp_breakpoint;
+ b->disposition = disp;
+ b->thread = thread;
/* FIXME: this won't work for duplicate basenames! */
sprintf (buf, "%s:%d", basename (Tcl_GetStringFromObj ( objv[1], NULL)), line);
Tcl_DStringAppendElement (&cmd, buf);
Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[2], NULL));
Tcl_DStringAppendElement (&cmd, Tcl_GetStringFromObj (objv[1], NULL));
+ Tcl_DStringAppendElement (&cmd, bpdisp[b->disposition]);
+ sprintf (buf, "%d", b->enable);
+ Tcl_DStringAppendElement (&cmd, buf);
+ sprintf (buf, "%d", b->thread);
+ Tcl_DStringAppendElement (&cmd, buf);
+
+
+ ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
+ Tcl_DStringFree (&cmd);
+ return ret;
+}
+
+/* This implements the tcl command "gdb_set_bp_addr"
+ * It sets breakpoints, and runs the Tcl command
+ * gdbtk_tcl_breakpoint create
+ * to register the new breakpoint with the GUI.
+ *
+ * Tcl Arguments:
+ * addr: the address at which to set the breakpoint
+ * type: the type of the breakpoint
+ * thread: optional thread number
+ * Tcl Result:
+ * The return value of the call to gdbtk_tcl_breakpoint.
+ */
+
+static int
+gdb_set_bp_addr (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+
+{
+ struct symtab_and_line sal;
+ int line, ret, thread = -1;
+ long addr;
+ struct breakpoint *b;
+ char *filename, *typestr, buf[64];
+ Tcl_DString cmd;
+ enum bpdisp disp;
+
+ if (objc != 4 && objc != 3)
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "wrong number of args, should be \"address type [thread]\"", -1);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetLongFromObj( interp, objv[1], &addr) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ typestr = Tcl_GetStringFromObj( objv[2], NULL);
+ if (typestr == NULL)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+ if (strncmp( typestr, "temp", 4 ) == 0)
+ disp = del;
+ else if (strncmp( typestr, "normal", 6 ) == 0)
+ disp = donttouch;
+ else
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "type must be \"temp\" or \"normal\"", -1);
+ return TCL_ERROR;
+ }
+
+ if (objc == 4)
+ {
+ if (Tcl_GetIntFromObj( interp, objv[3], &thread) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+ }
+
+ sal = find_pc_line (addr, 0);
+ sal.pc = addr;
+ b = set_raw_breakpoint (sal);
+ set_breakpoint_count (breakpoint_count + 1);
+ b->number = breakpoint_count;
+ b->type = bp_breakpoint;
+ b->disposition = disp;
+ b->thread = thread;
+
+ sprintf (buf, "*(0x%lx)",addr);
+ b->addr_string = strsave (buf);
+
+ /* now send notification command back to GUI */
+
+ Tcl_DStringInit (&cmd);
+
+ Tcl_DStringAppend (&cmd, "gdbtk_tcl_breakpoint create ", -1);
+ sprintf (buf, "%d", b->number);
+ Tcl_DStringAppendElement(&cmd, buf);
+ sprintf (buf, "0x%lx", addr);
+ Tcl_DStringAppendElement (&cmd, buf);
+ sprintf (buf, "%d", b->line_number);
+ Tcl_DStringAppendElement (&cmd, buf);
+
+ filename = symtab_to_filename (sal.symtab);
+ if (filename == NULL)
+ filename = "";
+ Tcl_DStringAppendElement (&cmd, filename);
+ Tcl_DStringAppendElement (&cmd, bpdisp[b->disposition]);
+ sprintf (buf, "%d", b->enable);
+ Tcl_DStringAppendElement (&cmd, buf);
+ sprintf (buf, "%d", b->thread);
+ Tcl_DStringAppendElement (&cmd, buf);
ret = Tcl_Eval (interp, Tcl_DStringValue (&cmd));
Tcl_DStringFree (&cmd);
return ret;
}
+/* This implements the tcl command "gdb_find_bp_at_line"
+ *
+ * Tcl Arguments:
+ * filename: the file in which to find the breakpoint
+ * line: the line number for the breakpoint
+ * Tcl Result:
+ * It returns a list of breakpoint numbers
+ */
+
+static int
+gdb_find_bp_at_line(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+
+{
+ struct symtab *s;
+ int line;
+ struct breakpoint *b;
+ extern struct breakpoint *breakpoint_chain;
+
+ if (objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename line");
+ return TCL_ERROR;
+ }
+
+ s = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL));
+ if (s == NULL)
+ return TCL_ERROR;
+
+ if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL);
+ for (b = breakpoint_chain; b; b = b->next)
+ if (b->line_number == line && !strcmp(b->source_file, s->filename))
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewIntObj (b->number));
+
+ return TCL_OK;
+}
+
+
+/* This implements the tcl command "gdb_find_bp_at_addr"
+ *
+ * Tcl Arguments:
+ * addr: address
+ * Tcl Result:
+ * It returns a list of breakpoint numbers
+ */
+
+static int
+gdb_find_bp_at_addr(clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+
+{
+ long addr;
+ struct breakpoint *b;
+ extern struct breakpoint *breakpoint_chain;
+
+ if (objc != 2)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "address");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetLongFromObj( interp, objv[1], &addr) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL);
+ for (b = breakpoint_chain; b; b = b->next)
+ if (b->address == (CORE_ADDR)addr)
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewIntObj (b->number));
+
+ return TCL_OK;
+}
+
/* This implements the tcl command gdb_get_breakpoint_info
*
*
Tcl_Obj *CONST objv[];
{
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", "delstop", "disable", "donttouch"};
struct command_line *cmd;
int bpnum;
struct breakpoint *b;
if (!b || b->type != bp_breakpoint)
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Breakpoint #%d does not exist", -1);
+ char err_buf[64];
+ sprintf(err_buf, "Breakpoint #%d does not exist.", bpnum);
+ Tcl_SetStringObj (result_ptr->obj_ptr, err_buf, -1);
return TCL_ERROR;
}
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (b->line_number));
- sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%lx", b->address);
+ sprintf_append_element_to_obj (result_ptr->obj_ptr, "0x%s", paddr_nz(b->address));
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
Tcl_NewStringObj (bptypes[b->type], -1));
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewBooleanObj(b->enable == enabled));
> BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
{
func = 0;
- funname = SYMBOL_NAME (msymbol);
+ funname = GDBTK_SYMBOL_SOURCE_NAME (msymbol);
funlang = SYMBOL_LANGUAGE (msymbol);
}
else
{
- funname = SYMBOL_NAME (func);
+ funname = GDBTK_SYMBOL_SOURCE_NAME (func);
funlang = SYMBOL_LANGUAGE (func);
}
}
struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
if (msymbol != NULL)
{
- funname = SYMBOL_NAME (msymbol);
+ funname = GDBTK_SYMBOL_SOURCE_NAME (msymbol);
funlang = SYMBOL_LANGUAGE (msymbol);
}
}
{
char *name = NULL;
- if (funlang == language_cplus)
- name = cplus_demangle (funname, 0);
- if (name == NULL)
- name = funname;
-
- objv[0] = Tcl_NewStringObj (name, -1);
+ objv[0] = Tcl_NewStringObj (funname, -1);
Tcl_ListObjAppendElement (interp, list, objv[0]);
}
else
if (objc != 2)
error ("wrong # args");
-#ifdef WINNT
+#ifdef __CYGWIN__
{
char pathname[256], *ptr;
- cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj(objv[1], NULL), pathname);
+ cygwin32_conv_to_full_win32_path (Tcl_GetStringFromObj (objv[1], NULL), pathname);
for (ptr = pathname; *ptr; ptr++)
{
if (*ptr == '\\')
}
return NULL;
}
+\f
+/* Local variables: */
+/* change-log-default-name: "ChangeLog-gdbtk" */
+/* End: */
projects / deliverable / binutils-gdb.git / blobdiff