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[] = {"breakpoint", "hardware breakpoint", "until",
+ "finish", "watchpoint", "hardware watchpoint",
+ "read watchpoint", "access watchpoint",
+ "longjmp", "longjmp resume", "step resume",
+ "through sigtramp", "watchpoint scope",
+ "call dummy" };
+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;
+
/*
- * Declarations for routines used only in this file.
+ * Declarations for routines exported from this file
*/
int Gdbtk_Init (Tcl_Interp *interp);
+
+/*
+ * 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_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_Obj *CONST objv[]));
static int gdbtk_dis_asm_read_memory PARAMS ((bfd_vma, bfd_byte *, int, disassemble_info *));
static int get_pc_register PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+static int gdb_stack PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []));
+
char * get_prompt PARAMS ((void));
static void get_register PARAMS ((int, void *));
static void get_register_name PARAMS ((int, void *));
static void register_changed_p PARAMS ((int, void *));
void TclDebug PARAMS ((const char *fmt, ...));
static int wrapped_call (char *opaque_args);
+static void get_frame_name PARAMS ((Tcl_Interp *interp, Tcl_Obj *list, struct frame_info *fi));
\f
/* Gdbtk_Init
* This loads all the Tcl commands into the Tcl interpreter.
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);
+
+ Tcl_LinkVar (interp, "gdb_selected_frame_level",
+ (char *) &selected_frame_level,
+ TCL_LINK_INT | TCL_LINK_READ_ONLY);
+
+ /* gdb_context is used for debugging multiple threads or tasks */
+ Tcl_LinkVar (interp, "gdb_context_id",
+ (char *) &gdb_context,
+ TCL_LINK_INT | TCL_LINK_READ_ONLY);
+
+ /* 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;
if (inferior_pid != 0 && target_has_execution)
{
if (attach_flag)
- target_detach (NULL, 0);
+ target_detach (NULL, 0);
else
- target_kill ();
+ target_kill ();
}
if (target_has_execution)
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);
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;
set turn off the GDBTK_TO_RESULT flag bit so gdbtk_fputs()
will not buffer all the data until the command is finished. */
- if ((strncmp ("load ", Tcl_GetStringFromObj (objv[1], NULL), 5) == 0)
- || (strncmp ("while ", Tcl_GetStringFromObj (objv[1], NULL), 6) == 0))
+ if ((strncmp ("load ", Tcl_GetStringFromObj (objv[1], NULL), 5) == 0))
{
result_ptr->flags &= ~GDBTK_TO_RESULT;
load_in_progress = 1;
- gdbtk_start_timer ();
}
- execute_command (Tcl_GetStringFromObj (objv[1], NULL), 1);
+ execute_command (Tcl_GetStringFromObj (objv[1], NULL), from_tty);
if (load_in_progress)
{
- gdbtk_stop_timer ();
load_in_progress = 0;
result_ptr->flags |= GDBTK_TO_RESULT;
}
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))
{
for (s = loadfile_bfd->sections; s; s = s->next)
{
if (s->flags & SEC_LOAD)
- {
- bfd_size_type size = bfd_get_section_size_before_reloc (s);
- if (size > 0)
- {
- ob[0] = Tcl_NewStringObj ((char *) bfd_get_section_name (loadfile_bfd, s), -1);
- ob[1] = Tcl_NewLongObj ((long) size);
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewListObj (2, ob));
- }
- }
+ {
+ bfd_size_type size = bfd_get_section_size_before_reloc (s);
+ if (size > 0)
+ {
+ ob[0] = Tcl_NewStringObj ((char *) bfd_get_section_name (loadfile_bfd, s), -1);
+ ob[1] = Tcl_NewLongObj ((long) size);
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewListObj (2, ob));
+ }
+ }
}
do_cleanups (old_cleanups);
default:
case LOC_UNDEF: /* catches errors */
case LOC_CONST: /* constant */
- case LOC_STATIC: /* static */
- case LOC_REGISTER: /* register */
case LOC_TYPEDEF: /* local typedef */
case LOC_LABEL: /* local label */
case LOC_BLOCK: /* local function */
break;
case LOC_LOCAL: /* stack local */
case LOC_BASEREG: /* basereg local */
+ case LOC_STATIC: /* static */
+ case LOC_REGISTER: /* register */
if (!arguments)
Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
{
if (numfiles == files_size)
{
- files_size = files_size * 2;
- files = (char **) xrealloc (files, sizeof (char *) * files_size);
+ files_size = files_size * 2;
+ files = (char **) xrealloc (files, sizeof (char *) * files_size);
}
if (psymtab->filename)
- {
- if (!len || !strncmp(pathname, psymtab->filename,len)
- || !strcmp(psymtab->filename, basename(psymtab->filename)))
- {
- files[numfiles++] = basename(psymtab->filename);
- }
- }
+ {
+ if (!len || !strncmp(pathname, psymtab->filename,len)
+ || !strcmp(psymtab->filename, basename(psymtab->filename)))
+ {
+ files[numfiles++] = basename(psymtab->filename);
+ }
+ }
}
ALL_SYMTABS (objfile, symtab)
{
if (numfiles == files_size)
{
- files_size = files_size * 2;
- files = (char **) xrealloc (files, sizeof (char *) * files_size);
+ files_size = files_size * 2;
+ files = (char **) xrealloc (files, sizeof (char *) * files_size);
}
if (symtab->filename && symtab->linetable && symtab->linetable->nitems)
- {
- if (!len || !strncmp(pathname, symtab->filename,len)
- || !strcmp(symtab->filename, basename(symtab->filename)))
- {
- files[numfiles++] = basename(symtab->filename);
- }
- }
+ {
+ if (!len || !strncmp(pathname, symtab->filename,len)
+ || !strcmp(symtab->filename, basename(symtab->filename)))
+ {
+ files[numfiles++] = basename(symtab->filename);
+ }
+ }
}
qsort (files, numfiles, sizeof(char *), comp_files);
for (i = 0; i < numfiles; i++)
{
if (strcmp(files[i],lastfile))
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj(files[i], -1));
+ Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj(files[i], -1));
lastfile = files[i];
}
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)
b = BLOCKVECTOR_BLOCK (bv, i);
/* Skip the sort if this block is always sorted. */
if (!BLOCK_SHOULD_SORT (b))
- sort_block_syms (b);
+ sort_block_syms (b);
for (j = 0; j < BLOCK_NSYMS (b); j++)
- {
- sym = BLOCK_SYM (b, j);
- if (SYMBOL_CLASS (sym) == LOC_BLOCK)
- {
+ {
+ sym = BLOCK_SYM (b, j);
+ if (SYMBOL_CLASS (sym) == LOC_BLOCK)
+ {
- char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
- if (name)
- {
- funcVals[0] = Tcl_NewStringObj(name, -1);
- funcVals[1] = mangled;
- }
- else
- {
- funcVals[0] = Tcl_NewStringObj(SYMBOL_NAME(sym), -1);
- funcVals[1] = not_mangled;
- }
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewListObj (2, funcVals));
- }
- }
+ char *name = cplus_demangle (SYMBOL_NAME(sym), 0);
+ if (name)
+ {
+ /* strip out "global constructors" and "global destructors" */
+ /* because we aren't interested in them. */
+ if (strncmp (name, "global ", 7))
+ {
+ funcVals[0] = Tcl_NewStringObj(name, -1);
+ funcVals[1] = mangled;
+ }
+ else
+ continue;
+
+ }
+ else
+ {
+ funcVals[0] = Tcl_NewStringObj(SYMBOL_NAME(sym), -1);
+ funcVals[1] = not_mangled;
+ }
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewListObj (2, funcVals));
+ }
+ }
}
return TCL_OK;
}
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';
- regnum++)
- func (regnum, argp);
+ regnum < NUM_REGS
+ && REGISTER_NAME (regnum) != NULL
+ && *REGISTER_NAME (regnum) != '\000';
+ regnum++)
+ func (regnum, argp);
return TCL_OK;
}
/* Else, list of register #s, just do listed regs */
for (; objc > 0; objc--, objv++)
{
-
- if (Tcl_GetIntFromObj (NULL, *objv, ®num) != TCL_OK) {
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ if (Tcl_GetIntFromObj (NULL, *objv, ®num) != TCL_OK)
+ {
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
if (regnum >= 0
- && regnum < NUM_REGS
- && reg_names[regnum] != NULL
- && *reg_names[regnum] != '\000')
- func (regnum, argp);
+ && regnum < NUM_REGS
+ && REGISTER_NAME (regnum) != NULL
+ && *REGISTER_NAME (regnum) != '\000')
+ func (regnum, argp);
else
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "bad register number", -1);
- return TCL_ERROR;
- }
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "bad register number", -1);
+ return TCL_ERROR;
+ }
}
return TCL_OK;
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
if (objc < 2)
{
Tcl_SetStringObj (result_ptr->obj_ptr,
- "wrong # args, should be gdb_fetch_registers format ?register1 register2 ...?", -1);
+ "wrong # args, should be gdb_fetch_registers format ?register1 register2 ...?", -1);
}
objc -= 2;
objv++;
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 (REGISTER_CONVERTIBLE (regnum))
{
REGISTER_CONVERT_TO_VIRTUAL (regnum, REGISTER_VIRTUAL_TYPE (regnum),
- raw_buffer, virtual_buffer);
+ raw_buffer, virtual_buffer);
}
else
memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
int j;
printf_filtered ("0x");
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]);
- }
+ {
+ register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j
+ : REGISTER_RAW_SIZE (regnum) - 1 - j;
+ printf_filtered ("%02x", (unsigned char)raw_buffer[idx]);
+ }
}
else
- val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0,
- gdb_stdout, format, 1, 0, Val_pretty_default);
+ val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, 0,
+ gdb_stdout, format, 1, 0, Val_pretty_default);
}
return;
if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
- REGISTER_RAW_SIZE (regnum)) == 0)
+ REGISTER_RAW_SIZE (regnum)) == 0)
return;
/* Found a changed register. Save new value and return its number. */
memcpy (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
- REGISTER_RAW_SIZE (regnum));
+ REGISTER_RAW_SIZE (regnum));
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj(regnum));
}
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));
if (! di_initialized)
{
INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
- (fprintf_ftype) fprintf_unfiltered);
+ (fprintf_ftype) fprintf_unfiltered);
di.flavour = bfd_target_unknown_flavour;
di.memory_error_func = dis_asm_memory_error;
di.print_address_func = dis_asm_print_address;
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
if (objc == 3)
{
if (find_pc_partial_function (low, NULL, &low, &high) == 0)
- error ("No function contains specified address");
+ error ("No function contains specified address");
}
else
high = parse_and_eval_address (Tcl_GetStringFromObj (objv[3], NULL));
if (disassemble_from_exec == -1)
{
if (strcmp (target_shortname, "child") == 0
- || strcmp (target_shortname, "procfs") == 0
- || strcmp (target_shortname, "vxprocess") == 0)
- disassemble_from_exec = 0; /* It's a child process, read inferior mem */
+ || 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 */
+ disassemble_from_exec = 1; /* It's remote, read the exec file */
}
if (disassemble_from_exec)
if (mixed_source_and_assembly)
{ /* Come here for mixed source/assembly */
/* The idea here is to present a source-O-centric view of a function to
- the user. This means that things are presented in source order, with
- (possibly) out of order assembly immediately following. */
+ the user. This means that things are presented in source order, with
+ (possibly) out of order assembly immediately following. */
struct symtab *symtab;
struct linetable_entry *le;
int nlines;
symtab = find_pc_symtab (low); /* Assume symtab is valid for whole PC range */
- if (!symtab)
- goto assembly_only;
+ if (!symtab || !symtab->linetable)
+ goto assembly_only;
-/* First, convert the linetable to a bunch of my_line_entry's. */
+ /* First, convert the linetable to a bunch of my_line_entry's. */
le = symtab->linetable->item;
nlines = symtab->linetable->nitems;
if (nlines <= 0)
- goto assembly_only;
+ goto assembly_only;
mle = (struct my_line_entry *) alloca (nlines * sizeof (struct my_line_entry));
out_of_order = 0;
+
+ /* Copy linetable entries for this function into our data structure, creating
+ end_pc's and setting out_of_order as appropriate. */
-/* Copy linetable entries for this function into our data structure, creating
- end_pc's and setting out_of_order as appropriate. */
-
-/* First, skip all the preceding functions. */
+ /* First, skip all the preceding functions. */
for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
-/* Now, copy all entries before the end of this function. */
+ /* Now, copy all entries before the end of this function. */
newlines = 0;
for (; i < nlines - 1 && le[i].pc < high; i++)
- {
- if (le[i].line == le[i + 1].line
- && le[i].pc == le[i + 1].pc)
- continue; /* Ignore duplicates */
-
- mle[newlines].line = le[i].line;
- if (le[i].line > le[i + 1].line)
- out_of_order = 1;
- mle[newlines].start_pc = le[i].pc;
- mle[newlines].end_pc = le[i + 1].pc;
- newlines++;
- }
+ {
+ if (le[i].line == le[i + 1].line
+ && le[i].pc == le[i + 1].pc)
+ continue; /* Ignore duplicates */
+
+ mle[newlines].line = le[i].line;
+ if (le[i].line > le[i + 1].line)
+ out_of_order = 1;
+ mle[newlines].start_pc = le[i].pc;
+ mle[newlines].end_pc = le[i + 1].pc;
+ newlines++;
+ }
-/* If we're on the last line, and it's part of the function, then we need to
- get the end pc in a special way. */
+ /* If we're on the last line, and it's part of the function, then we need to
+ get the end pc in a special way. */
if (i == nlines - 1
- && le[i].pc < high)
- {
- mle[newlines].line = le[i].line;
- mle[newlines].start_pc = le[i].pc;
- sal = find_pc_line (le[i].pc, 0);
- mle[newlines].end_pc = sal.end;
- newlines++;
- }
+ && le[i].pc < high)
+ {
+ mle[newlines].line = le[i].line;
+ mle[newlines].start_pc = le[i].pc;
+ sal = find_pc_line (le[i].pc, 0);
+ mle[newlines].end_pc = sal.end;
+ newlines++;
+ }
-/* Now, sort mle by line #s (and, then by addresses within lines). */
+ /* Now, sort mle by line #s (and, then by addresses within lines). */
if (out_of_order)
- qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
+ qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
-/* Now, for each line entry, emit the specified lines (unless they have been
- emitted before), followed by the assembly code for that line. */
+ /* Now, for each line entry, emit the specified lines (unless they have been
+ emitted before), followed by the assembly code for that line. */
next_line = 0; /* Force out first line */
for (i = 0; i < newlines; i++)
- {
-/* Print out everything from next_line to the current line. */
-
- if (mle[i].line >= next_line)
- {
- if (next_line != 0)
- print_source_lines (symtab, next_line, mle[i].line + 1, 0);
- else
- print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
-
- next_line = mle[i].line + 1;
- }
-
- for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
- {
- QUIT;
- fputs_unfiltered (" ", gdb_stdout);
- print_address (pc, gdb_stdout);
- fputs_unfiltered (":\t ", gdb_stdout);
- pc += (*tm_print_insn) (pc, &di);
- fputs_unfiltered ("\n", gdb_stdout);
- }
- }
+ {
+ /* Print out everything from next_line to the current line. */
+
+ if (mle[i].line >= next_line)
+ {
+ if (next_line != 0)
+ print_source_lines (symtab, next_line, mle[i].line + 1, 0);
+ else
+ print_source_lines (symtab, mle[i].line, mle[i].line + 1, 0);
+
+ next_line = mle[i].line + 1;
+ }
+
+ for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
+ {
+ QUIT;
+ fputs_unfiltered (" ", gdb_stdout);
+ print_address (pc, gdb_stdout);
+ fputs_unfiltered (":\t ", gdb_stdout);
+ pc += (*tm_print_insn) (pc, &di);
+ fputs_unfiltered ("\n", gdb_stdout);
+ }
+ }
}
else
{
-assembly_only:
+ assembly_only:
for (pc = low; pc < high; )
- {
- QUIT;
- fputs_unfiltered (" ", gdb_stdout);
- print_address (pc, gdb_stdout);
- fputs_unfiltered (":\t ", gdb_stdout);
- pc += (*tm_print_insn) (pc, &di);
- fputs_unfiltered ("\n", gdb_stdout);
- }
+ {
+ QUIT;
+ fputs_unfiltered (" ", gdb_stdout);
+ print_address (pc, gdb_stdout);
+ fputs_unfiltered (":\t ", gdb_stdout);
+ pc += (*tm_print_insn) (pc, &di);
+ fputs_unfiltered ("\n", gdb_stdout);
+ }
}
gdb_flush (gdb_stdout);
if (objc == 1)
{
if (selected_frame && (selected_frame->pc != stop_pc))
- {
- /* Note - this next line is not correct on all architectures. */
- /* 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 = 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));
- }
+ {
+ /* Note - this next line is not correct on all architectures. */
+ /* 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 = 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
- {
- pc = stop_pc;
- sal = find_pc_line (stop_pc, 0);
- }
+ {
+ pc = stop_pc;
+ sal = find_pc_line (stop_pc, 0);
+ }
}
else if (objc == 2)
{
free (sals.sals);
if (sals.nelts != 1)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
- return TCL_ERROR;
- }
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
+ return TCL_ERROR;
+ }
pc = sal.pc;
}
else
for (i=0; i < nbytes; i+= size)
{
if ( i >= rnum)
- {
- fputs_unfiltered ("N/A ", gdb_stdout);
- if (aschar)
- for ( j = 0; j < size; j++)
- *bptr++ = 'X';
- }
+ {
+ 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);
-
- if (aschar)
- {
- for ( j = 0; j < size; j++)
- {
- c = *cptr++;
- if (c < 32 || c > 126)
- c = aschar;
- if (c == '"')
- *bptr++ = '\\';
- *bptr++ = c;
- }
- }
- }
+ {
+ print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
+
+ if (aschar)
+ {
+ for ( j = 0; j < size; j++)
+ {
+ c = *cptr++;
+ if (c < 32 || c > 126)
+ c = aschar;
+ if (c == '"')
+ *bptr++ = '\\';
+ *bptr++ = c;
+ }
+ }
+ }
mptr += size;
bc += size;
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];
- }
+ {
+ /* end of row. print it and reset variables */
+ bc = 0;
+ *bptr++ = '"';
+ *bptr++ = ' ';
+ *bptr = 0;
+ fputs_unfiltered (buff, gdb_stdout);
+ bptr = &buff[1];
+ }
}
result_ptr->flags &= ~GDBTK_MAKES_LIST;
file = Tcl_GetStringFromObj (objv[2], NULL);
Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
- if ((fp = fopen ( file, "r" )) == NULL)
- {
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Can't open file for reading", -1);
- return TCL_ERROR;
- }
-
symtab = full_lookup_symtab (file);
if (!symtab)
{
- Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);
+ Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);
fclose (fp);
return TCL_ERROR;
}
+ file = symtab_to_filename ( symtab );
+ if ((fp = fopen ( file, "r" )) == NULL)
+ {
+ Tcl_SetStringObj ( result_ptr->obj_ptr, "Can't open file for reading", -1);
+ return TCL_ERROR;
+ }
+
if (stat (file, &st) < 0)
{
catch_errors (perror_with_name_wrapper, "gdbtk: get time stamp", "",
{
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)
- {
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
- free (ltable);
- fclose (fp);
- return TCL_ERROR;
- }
- ltable = new_ltable;
- }
- ltable[lnum] |= 1 << (le->line % 8);
- }
+ {
+ 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)
+ {
+ Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
+ free (ltable);
+ fclose (fp);
+ return TCL_ERROR;
+ }
+ ltable = new_ltable;
+ }
+ ltable[lnum] |= 1 << (le->line % 8);
+ }
}
Tcl_DStringInit(&text_cmd_1);
prefix_len_2 = Tcl_DStringLength(&text_cmd_2);
while (fgets (line + 1, 980, 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);
- }
- else
- {
- cur_cmd = &text_cmd_2;
- cur_prefix_len = prefix_len_2;
- Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
- Tcl_DStringAppend (cur_cmd, "} \"\"", 4);
- }
-
- Tcl_DStringAppendElement (cur_cmd, line);
- Tcl_DStringAppend (cur_cmd, " source_tag", 11);
-
- Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
- Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
- ln++;
- }
+ {
+ 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_rgn_tag", 15);
+ }
+ else
+ {
+ cur_cmd = &text_cmd_2;
+ cur_prefix_len = prefix_len_2;
+ Tcl_DStringAppend (cur_cmd, line_num_buf, -1);
+ Tcl_DStringAppend (cur_cmd, "} \"\"", 4);
+ }
+
+ Tcl_DStringAppendElement (cur_cmd, line);
+ Tcl_DStringAppend (cur_cmd, " source_tag", 11);
+
+ Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
+ Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
+ ln++;
+ }
}
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);
-
while (fgets (line + 1, 980, fp))
- {
- if (ltable[ln >> 3] & (1 << (ln % 8)))
- {
- cur_cmd = &text_cmd_1;
- cur_prefix_len = prefix_len_1;
- }
- else
- {
- cur_cmd = &text_cmd_2;
- cur_prefix_len = prefix_len_2;
- }
-
- Tcl_DStringAppendElement (cur_cmd, line);
- Tcl_DStringAppend (cur_cmd, " source_tag", 11);
-
- Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
- Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
-
- ln++;
- }
+ {
+ if (ltable[ln >> 3] & (1 << (ln % 8)))
+ {
+ cur_cmd = &text_cmd_1;
+ cur_prefix_len = prefix_len_1;
+ }
+ else
+ {
+ cur_cmd = &text_cmd_2;
+ cur_prefix_len = prefix_len_2;
+ }
+
+ Tcl_DStringAppendElement (cur_cmd, line);
+ Tcl_DStringAppend (cur_cmd, " source_tag", 11);
+
+ Tcl_Eval(interp, Tcl_DStringValue(cur_cmd));
+ Tcl_DStringSetLength(cur_cmd, cur_prefix_len);
+
+ ln++;
+ }
}
Tcl_DStringFree (&text_cmd_1);
* 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.
*/
{
struct symtab_and_line sal;
- int line, flags, ret;
+ int line, flags, ret, thread = -1;
struct breakpoint *b;
char buf[64];
Tcl_DString cmd;
- if (objc != 4)
+ if (objc != 4 && objc != 5)
{
- Tcl_WrongNumArgs(interp, 1, objv, "filename line type");
+ Tcl_WrongNumArgs(interp, 1, objv, "filename line type [thread]");
return TCL_ERROR;
}
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))
return TCL_ERROR;
b->number = breakpoint_count;
b->type = flags >> 2;
b->disposition = flags & 3;
+ 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, flags, ret, thread = -1;
+ long addr;
+ struct breakpoint *b;
+ char *filename, buf[64];
+ Tcl_DString cmd;
+
+ if (objc != 4 && objc != 3)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "addr type ?thread?");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetLongFromObj( interp, objv[1], &addr) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj( interp, objv[2], &flags) == TCL_ERROR)
+ {
+ result_ptr->flags = GDBTK_IN_TCL_RESULT;
+ 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 = flags >> 2;
+ b->disposition = flags & 3;
+ 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;
}
return TCL_OK;
}
+\f
+/* The functions in this section deal with stacks and backtraces. */
+
+/* This implements the tcl command gdb_stack.
+ * It builds up a list of stack frames.
+ *
+ * Tcl Arguments:
+ * start - starting stack frame
+ * count - number of frames to inspect
+ * Tcl Result:
+ * A list of function names
+ */
+
+static int
+gdb_stack (clientData, interp, objc, objv) ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ int start, count;
+
+ if (objc < 3)
+ {
+ Tcl_WrongNumArgs (interp, 1, objv, "start count");
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIntFromObj (NULL, objv[1], &start))
+ {
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIntFromObj (NULL, objv[2], &count))
+ {
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
+ }
+
+ Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+
+ if (target_has_stack)
+ {
+ struct frame_info *top;
+ struct frame_info *fi;
+
+ /* Find the outermost frame */
+ fi = get_current_frame ();
+ while (fi != NULL)
+ {
+ top = fi;
+ fi = get_prev_frame (fi);
+ }
+
+ /* top now points to the top (outermost frame) of the
+ stack, so point it to the requested start */
+ start = -start;
+ top = find_relative_frame (top, &start);
+
+ /* If start != 0, then we have asked to start outputting
+ frames beyond the innermost stack frame */
+ if (start == 0)
+ {
+ fi = top;
+ while (fi && count--)
+ {
+ get_frame_name (interp, result_ptr->obj_ptr, fi);
+ fi = get_next_frame (fi);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/* A helper function for get_stack which adds information about
+ * the stack frame FI to the caller's LIST.
+ *
+ * This is stolen from print_frame_info in stack.c.
+ */
+static void
+get_frame_name (interp, list, fi)
+ Tcl_Interp *interp;
+ Tcl_Obj *list;
+ struct frame_info *fi;
+{
+ struct symtab_and_line sal;
+ struct symbol *func = NULL;
+ register char *funname = 0;
+ enum language funlang = language_unknown;
+ Tcl_Obj *objv[1];
+
+ if (frame_in_dummy (fi))
+ {
+ objv[0] = Tcl_NewStringObj ("<function called from gdb>\n", -1);
+ Tcl_ListObjAppendElement (interp, list, objv[0]);
+ return;
+ }
+ if (fi->signal_handler_caller)
+ {
+ objv[0] = Tcl_NewStringObj ("<signal handler called>\n", -1);
+ Tcl_ListObjAppendElement (interp, list, objv[0]);
+ return;
+ }
+
+ sal =
+ find_pc_line (fi->pc,
+ fi->next != NULL
+ && !fi->next->signal_handler_caller
+ && !frame_in_dummy (fi->next));
+
+ func = find_pc_function (fi->pc);
+ if (func)
+ {
+ struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
+ if (msymbol != NULL
+ && (SYMBOL_VALUE_ADDRESS (msymbol)
+ > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
+ {
+ func = 0;
+ funname = SYMBOL_NAME (msymbol);
+ funlang = SYMBOL_LANGUAGE (msymbol);
+ }
+ else
+ {
+ funname = SYMBOL_NAME (func);
+ funlang = SYMBOL_LANGUAGE (func);
+ }
+ }
+ else
+ {
+ struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
+ if (msymbol != NULL)
+ {
+ funname = SYMBOL_NAME (msymbol);
+ funlang = SYMBOL_LANGUAGE (msymbol);
+ }
+ }
+
+ if (sal.symtab)
+ {
+ char *name = NULL;
+
+ if (funlang == language_cplus)
+ name = cplus_demangle (funname, 0);
+ if (name == NULL)
+ name = funname;
+
+ objv[0] = Tcl_NewStringObj (name, -1);
+ Tcl_ListObjAppendElement (interp, list, objv[0]);
+ }
+ else
+ {
+#if 0
+ /* we have no convenient way to deal with this yet... */
+ if (fi->pc != sal.pc || !sal.symtab)
+ {
+ print_address_numeric (fi->pc, 1, gdb_stdout);
+ printf_filtered (" in ");
+ }
+ fprintf_symbol_filtered (gdb_stdout, funname ? funname : "??", funlang,
+ DMGL_ANSI);
+#endif
+ objv[0] = Tcl_NewStringObj (funname != NULL ? funname : "??", -1);
+#ifdef PC_LOAD_SEGMENT
+ /* If we couldn't print out function name but if can figure out what
+ load segment this pc value is from, at least print out some info
+ about its load segment. */
+ if (!funname)
+ {
+ Tcl_AppendStringsToObj (objv[0], " from ", PC_LOAD_SEGMENT (fi->pc),
+ (char *) NULL);
+ }
+#endif
+#ifdef PC_SOLIB
+ if (!funname)
+ {
+ char *lib = PC_SOLIB (fi->pc);
+ if (lib)
+ {
+ Tcl_AppendStringsToObj (objv[0], " from ", lib, (char *) NULL);
+ }
+ }
+#endif
+ Tcl_ListObjAppendElement (interp, list, objv[0]);
+ }
+}
\f
/*
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 == '\\')
ALL_SYMTABS (objfile, st)
{
if (!strcmp (bfile, basename(st->filename)))
- {
- if (!st->fullname)
- fullname = symtab_to_filename (st);
- else
- fullname = st->fullname;
+ {
+ if (!st->fullname)
+ fullname = symtab_to_filename (st);
+ else
+ fullname = st->fullname;
- if (!strcmp (file, fullname))
- return st;
- }
+ 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;
- }
- }
+ {
+ st = PSYMTAB_TO_SYMTAB (pt);
+ if (st)
+ {
+ fullname = symtab_to_filename (st);
+ if (!strcmp (file, fullname))
+ return st;
+ }
+ }
}
return NULL;
}