#include "objfiles.h"
#include "target.h"
#include "gdbcore.h"
-#include "tracepoint.h"
#include "demangle.h"
-#include "frame.h"
#include "regcache.h"
#include "linespec.h"
#include "tui/tui-file.h"
#include "guitcl.h"
#include "gdbtk.h"
#include "gdbtk-wrapper.h"
+#include "gdbtk-cmds.h"
#include <signal.h>
#include <fcntl.h>
/* Various globals we reference. */
extern char *source_path;
-extern void *gdbtk_deleted_bp;
-
-static void setup_architecture_data (void);
-static int tracepoint_exists (char *args);
-
-/* This structure filled in call_wrapper and passed to
- the wrapped call function.
- It stores the command pointer and arguments
- run in the wrapper function. */
-
-struct wrapped_call_args
- {
- Tcl_Interp *interp;
- Tcl_ObjCmdProc *func;
- int objc;
- Tcl_Obj *CONST * objv;
- int val;
- };
/* These two objects hold boolean true and false,
and are shared by all the list objects that gdb_listfuncs
int No_Update = 0;
int load_in_progress = 0;
-/*
- * This is used in the register fetching routines
- */
-
-#ifndef INVALID_FLOAT
-#define INVALID_FLOAT(x, y) (0 != 0)
-#endif
-
-
-
/* This Structure is used in gdb_disassemble.
We need a different sort of line table from the normal one cuz we can't
depend upon implicit line-end pc's for lines to do the
Tcl_CmdInfo cmd;
};
-/* This contains the previous values of the registers, since the last call to
- gdb_changed_register_list. */
-
-static char *old_regs;
-
-/* 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 struct breakpoint *set_raw_breakpoint (struct symtab_and_line sal);
-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 Gdbtk_Init (Tcl_Interp * interp);
-int call_wrapper (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
/*
* Declarations for routines used only in this file.
static int compare_lines (const PTR, const PTR);
static int comp_files (const void *, const void *);
-static int gdb_actions_command (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_changed_register_list (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST[]);
static int gdb_clear_file (ClientData, Tcl_Interp * interp, int,
Tcl_Obj * CONST[]);
static int gdb_cmd (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_disassemble (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_entry_point (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_eval (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
-static int gdb_fetch_registers (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST[]);
static int gdb_find_file_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
static int gdb_force_quit (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
-static struct symtab *full_lookup_symtab (char *file);
-static int gdb_get_args_command (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_get_breakpoint_info (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST[]);
-static int gdb_get_breakpoint_list (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST[]);
static int gdb_get_file_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
static int gdb_get_function_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
static int gdb_get_line_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
-static int gdb_get_locals_command (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
static int gdb_get_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
-static int gdb_get_trace_frame_num (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_get_tracepoint_list (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_get_vars_command (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
static int gdb_immediate_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST[]);
static int gdb_listfiles (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_path_conv (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_prompt_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
-static int gdb_regnames (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_restore_fputs (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST[]);
static int gdb_search (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST objv[]);
-static int gdb_set_bp (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST objv[]);
-static int gdb_set_bp_addr (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_find_bp_at_line (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
-static int gdb_find_bp_at_addr (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
static int gdb_stop (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_target_has_execution_command (ClientData,
Tcl_Interp *, int,
Tcl_Obj * CONST[]);
-static int gdb_trace_status (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST[]);
-static int gdb_tracepoint_exists_command (ClientData, Tcl_Interp *,
- int, Tcl_Obj * CONST objv[]);
-static int gdb_get_tracepoint_info (ClientData, Tcl_Interp *, int,
- Tcl_Obj * CONST objv[]);
static int gdbtk_dis_asm_read_memory (bfd_vma, bfd_byte *, unsigned int,
disassemble_info *);
static void gdbtk_load_source (ClientData clientData,
struct
disassemble_info
*));
-static int get_pc_register (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
-static int gdb_stack (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
-static int gdb_selected_frame (ClientData clientData,
- Tcl_Interp * interp, int argc,
- Tcl_Obj * CONST objv[]);
-static int gdb_selected_block (ClientData clientData,
- Tcl_Interp * interp, int argc,
- Tcl_Obj * CONST objv[]);
-static int gdb_get_blocks (ClientData clientData,
- Tcl_Interp * interp, int objc,
- Tcl_Obj * CONST objv[]);
-static int gdb_block_vars (ClientData clientData,
- Tcl_Interp * interp, int objc,
- Tcl_Obj * CONST objv[]);
char *get_prompt (void);
-static void get_register (int, void *);
-static void get_register_name (int, void *);
-static int map_arg_registers (int, Tcl_Obj * CONST[],
- void (*)(int, void *), void *);
static int perror_with_name_wrapper (PTR args);
-static void register_changed_p (int, void *);
static int wrapped_call (PTR opaque_args);
-static void get_frame_name (Tcl_Interp * interp, Tcl_Obj * list,
- struct frame_info *fi);
-char *pc_function_name (CORE_ADDR pc);
\f
/* Gdbtk_Init
Gdbtk_Init (interp)
Tcl_Interp *interp;
{
- Tcl_CreateObjCommand (interp, "gdb_cmd", call_wrapper, gdb_cmd, NULL);
- Tcl_CreateObjCommand (interp, "gdb_immediate", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_cmd", gdbtk_call_wrapper, gdb_cmd, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_immediate", gdbtk_call_wrapper,
gdb_immediate_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_loc", call_wrapper, gdb_loc, NULL);
- Tcl_CreateObjCommand (interp, "gdb_path_conv", call_wrapper, gdb_path_conv,
+ Tcl_CreateObjCommand (interp, "gdb_loc", gdbtk_call_wrapper, gdb_loc, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_path_conv", gdbtk_call_wrapper, gdb_path_conv,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_listfiles", call_wrapper, gdb_listfiles,
+ Tcl_CreateObjCommand (interp, "gdb_listfiles", gdbtk_call_wrapper, gdb_listfiles,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_listfuncs", call_wrapper, gdb_listfuncs,
+ Tcl_CreateObjCommand (interp, "gdb_listfuncs", gdbtk_call_wrapper, gdb_listfuncs,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_entry_point", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_entry_point", gdbtk_call_wrapper,
gdb_entry_point, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_mem", call_wrapper, gdb_get_mem,
+ Tcl_CreateObjCommand (interp, "gdb_get_mem", gdbtk_call_wrapper, gdb_get_mem,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_stop", call_wrapper, gdb_stop, NULL);
- Tcl_CreateObjCommand (interp, "gdb_regnames", call_wrapper, gdb_regnames,
+ Tcl_CreateObjCommand (interp, "gdb_stop", gdbtk_call_wrapper, gdb_stop, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_restore_fputs", gdbtk_call_wrapper, gdb_restore_fputs,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_restore_fputs", call_wrapper, gdb_restore_fputs,
- NULL);
- Tcl_CreateObjCommand (interp, "gdb_fetch_registers", call_wrapper,
- gdb_fetch_registers, NULL);
- Tcl_CreateObjCommand (interp, "gdb_changed_register_list", call_wrapper,
- gdb_changed_register_list, NULL);
- Tcl_CreateObjCommand (interp, "gdb_disassemble", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_disassemble", gdbtk_call_wrapper,
gdb_disassemble, NULL);
- Tcl_CreateObjCommand (interp, "gdb_eval", call_wrapper, gdb_eval, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_list", call_wrapper,
- gdb_get_breakpoint_list, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_breakpoint_info", call_wrapper,
- gdb_get_breakpoint_info, NULL);
- Tcl_CreateObjCommand (interp, "gdb_clear_file", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_eval", gdbtk_call_wrapper, gdb_eval, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_clear_file", gdbtk_call_wrapper,
gdb_clear_file, NULL);
- Tcl_CreateObjCommand (interp, "gdb_confirm_quit", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_confirm_quit", gdbtk_call_wrapper,
gdb_confirm_quit, NULL);
- Tcl_CreateObjCommand (interp, "gdb_force_quit", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_force_quit", gdbtk_call_wrapper,
gdb_force_quit, NULL);
Tcl_CreateObjCommand (interp, "gdb_target_has_execution",
- call_wrapper,
+ gdbtk_call_wrapper,
gdb_target_has_execution_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_is_tracing",
- call_wrapper, gdb_trace_status,
- NULL);
- Tcl_CreateObjCommand (interp, "gdb_load_info", call_wrapper, gdb_load_info,
+ Tcl_CreateObjCommand (interp, "gdb_load_info", gdbtk_call_wrapper, gdb_load_info,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_locals", call_wrapper,
- gdb_get_locals_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_args", call_wrapper,
- gdb_get_args_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_function", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_get_function", gdbtk_call_wrapper,
gdb_get_function_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_line", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_get_line", gdbtk_call_wrapper,
gdb_get_line_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_file", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_get_file", gdbtk_call_wrapper,
gdb_get_file_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_tracepoint_exists",
- call_wrapper, gdb_tracepoint_exists_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_info",
- call_wrapper, gdb_get_tracepoint_info, NULL);
- Tcl_CreateObjCommand (interp, "gdb_actions",
- call_wrapper, gdb_actions_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_prompt",
- call_wrapper, gdb_prompt_command, NULL);
+ gdbtk_call_wrapper, gdb_prompt_command, NULL);
Tcl_CreateObjCommand (interp, "gdb_find_file",
- call_wrapper, gdb_find_file_command, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_tracepoint_list",
- call_wrapper, gdb_get_tracepoint_list, NULL);
- Tcl_CreateObjCommand (interp, "gdb_pc_reg", call_wrapper, get_pc_register,
+ gdbtk_call_wrapper, gdb_find_file_command, NULL);
+ Tcl_CreateObjCommand (interp, "gdb_loadfile", gdbtk_call_wrapper, gdb_loadfile,
NULL);
- Tcl_CreateObjCommand (interp, "gdb_loadfile", call_wrapper, gdb_loadfile,
- NULL);
- Tcl_CreateObjCommand (interp, "gdb_load_disassembly", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_load_disassembly", gdbtk_call_wrapper,
gdb_load_disassembly, NULL);
- Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper,
+ Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", gdbtk_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_CreateObjCommand (interp, "gdb_selected_frame", call_wrapper,
- gdb_selected_frame, NULL);
- Tcl_CreateObjCommand (interp, "gdb_selected_block", call_wrapper,
- gdb_selected_block, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_blocks", call_wrapper,
- gdb_get_blocks, NULL);
- Tcl_CreateObjCommand (interp, "gdb_block_variables", call_wrapper,
- gdb_block_vars, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_inferior_args", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_get_inferior_args", gdbtk_call_wrapper,
gdb_get_inferior_args, NULL);
- Tcl_CreateObjCommand (interp, "gdb_set_inferior_args", call_wrapper,
+ Tcl_CreateObjCommand (interp, "gdb_set_inferior_args", gdbtk_call_wrapper,
gdb_set_inferior_args, 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,
/* Init variable interface... */
if (gdb_variable_init (interp) != TCL_OK)
return TCL_ERROR;
-
- /* Register/initialize any architecture specific data */
- setup_architecture_data ();
- register_gdbarch_swap (&old_regs, sizeof (old_regs), NULL);
- register_gdbarch_swap (NULL, 0, setup_architecture_data);
+
+ /* Init breakpoint module */
+ if (Gdbtk_Breakpoint_Init (interp) != TCL_OK)
+ return TCL_ERROR;
+
+ /* Init stack module */
+ if (Gdbtk_Stack_Init (interp) != TCL_OK)
+ return TCL_ERROR;
+
+ /* Init register module */
+ if (Gdbtk_Register_Init (interp) != TCL_OK)
+ return TCL_ERROR;
/* Determine where to disassemble from */
Tcl_LinkVar (gdbtk_interp, "disassemble-from-exec",
necessary. */
int
-call_wrapper (clientData, interp, objc, objv)
+gdbtk_call_wrapper (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
* new element in a Tcl list object.
*/
-static void
+void
sprintf_append_element_to_obj (Tcl_Obj * objp, char *format,...)
{
va_list args;
}
-/* 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);
-
-}
-
-/* This implements the tcl commands "gdb_get_locals" and "gdb_get_args"
-
- * This function sets the Tcl interpreter's result to a list of variable names
- * depending on clientData. If clientData is one, the result is a list of
- * arguments; zero returns a list of locals -- all relative to the block
- * specified as an argument to the command. Valid commands include
- * anything decode_line_1 can handle (like "main.c:2", "*0x02020202",
- * and "main").
- *
- * Tcl Arguments:
- * linespec - the linespec defining the scope of the lookup. Empty string
- * to use the current block in the innermost frame.
- * Tcl Result:
- * A list of the locals or args
- */
-
-static int
-gdb_get_vars_command (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- struct symtabs_and_lines sals;
- struct symbol *sym;
- struct block *block;
- char **canonical, *args;
- int i, nsyms, arguments;
-
- if (objc > 2)
- {
- Tcl_WrongNumArgs (interp, 1, objv,
- "[function:line|function|line|*addr]");
- return TCL_ERROR;
- }
-
- arguments = (int) clientData;
-
- /* Initialize the result pointer to an empty list. */
-
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
-
- if (objc == 2)
- {
- args = Tcl_GetStringFromObj (objv[1], NULL);
- sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
- if (sals.nelts == 0)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "error decoding line", -1);
- return TCL_ERROR;
- }
-
- /* Resolve all line numbers to PC's */
- for (i = 0; i < sals.nelts; i++)
- resolve_sal_pc (&sals.sals[i]);
-
- block = block_for_pc (sals.sals[0].pc);
- }
- else
- {
- /* Specified currently selected frame */
- if (selected_frame == NULL)
- return TCL_OK;
-
- block = get_frame_block (selected_frame);
- }
-
- while (block != 0)
- {
- nsyms = BLOCK_NSYMS (block);
- for (i = 0; i < nsyms; i++)
- {
- sym = BLOCK_SYM (block, i);
- switch (SYMBOL_CLASS (sym))
- {
- default:
- case LOC_UNDEF: /* catches errors */
- case LOC_CONST: /* constant */
- case LOC_TYPEDEF: /* local typedef */
- case LOC_LABEL: /* local label */
- case LOC_BLOCK: /* local function */
- case LOC_CONST_BYTES: /* loc. byte seq. */
- case LOC_UNRESOLVED: /* unresolved static */
- case LOC_OPTIMIZED_OUT: /* optimized out */
- break;
- case LOC_ARG: /* argument */
- case LOC_REF_ARG: /* reference arg */
- case LOC_REGPARM: /* register arg */
- case LOC_REGPARM_ADDR: /* indirect register arg */
- case LOC_LOCAL_ARG: /* stack arg */
- case LOC_BASEREG_ARG: /* basereg arg */
- if (arguments)
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (SYMBOL_NAME (sym), -1));
- 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));
- break;
- }
- }
- if (BLOCK_FUNCTION (block))
- break;
- else
- block = BLOCK_SUPERBLOCK (block);
- }
-
- return TCL_OK;
-}
-
/* This implements the tcl command "gdb_get_line"
* It returns the linenumber for a given linespec. It will take any spec
return TCL_OK;
}
\f
-
-/*
- * This section contains all the commands that act on the registers:
- */
-
-/* This is a sort of mapcar function for operations on registers */
-
-static int
-map_arg_registers (objc, objv, func, argp)
- int objc;
- Tcl_Obj *CONST objv[];
- void (*func) (int regnum, void *argp);
- void *argp;
-{
- int regnum, numregs;
-
- /* Note that the test for a valid register must include checking the
- 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. */
-
- numregs = NUM_REGS + NUM_PSEUDO_REGS;
-
- if (objc == 0) /* No args, just do all the regs */
- {
- for (regnum = 0;
- regnum < numregs;
- regnum++)
- {
- if (REGISTER_NAME (regnum) == NULL
- || *(REGISTER_NAME (regnum)) == '\0')
- continue;
-
- 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 (regnum >= 0
- && regnum < numregs
- && 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;
- }
- }
-
- return TCL_OK;
-}
-
/* This implements the TCL command `gdb_restore_fputs'
It sets the fputs_unfiltered hook back to gdbtk_fputs.
Its sole reason for being is that sometimes we move the
gdbtk_disable_fputs = 0;
return TCL_OK;
}
-
-/* This implements the TCL command `gdb_regnames'. Its syntax is:
-
- gdb_regnames [-numbers] [REGNUM ...]
-
- Return a list containing the names of the registers whose numbers
- are given by REGNUM ... . If no register numbers are given, return
- all the registers' names.
-
- Note that some processors have gaps in the register numberings:
- even if there is no register numbered N, there may still be a
- register numbered N+1. So if you call gdb_regnames with no
- arguments, you can't assume that the N'th element of the result is
- register number N.
-
- Given the -numbers option, gdb_regnames returns, not a list of names,
- but a list of pairs {NAME NUMBER}, where NAME is the register name,
- and NUMBER is its number. */
+\f
+/*
+ * This section has commands that handle source disassembly.
+ */
+/* This implements the tcl command gdb_disassemble. It is no longer
+ * used in GDBTk, we use gdb_load_disassembly, but I kept it around in
+ * case other folks want it.
+ *
+ * Arguments:
+ * source_with_assm - must be "source" or "nosource"
+ * low_address - the address from which to start disassembly
+ * ?hi_address? - the address to which to disassemble, defaults
+ * to the end of the function containing low_address.
+ * Tcl Result:
+ * The disassembled code is passed to fputs_unfiltered, so it
+ * either goes to the console if result_ptr->obj_ptr is NULL or to
+ * the Tcl result.
+ */
static int
-gdb_regnames (clientData, interp, objc, objv)
+gdb_disassemble (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
- int numbers = 0;
-
- objc--;
- objv++;
+ CORE_ADDR low, high;
+ char *arg_ptr;
+ int mixed_source_and_assembly;
- if (objc >= 1)
+ if (objc != 3 && objc != 4)
{
- char *s = Tcl_GetStringFromObj (objv[0], NULL);
- if (STREQ (s, "-numbers"))
- numbers = 1;
- objc--;
- objv++;
+ Tcl_WrongNumArgs (interp, 1, objv, "source lowaddr ?highaddr?");
+ return TCL_ERROR;
}
- return map_arg_registers (objc, objv, get_register_name, &numbers);
-}
+ arg_ptr = Tcl_GetStringFromObj (objv[1], NULL);
+ if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
+ mixed_source_and_assembly = 1;
+ else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
+ mixed_source_and_assembly = 0;
+ else
+ error ("First arg must be 'source' or 'nosource'");
-static void
-get_register_name (regnum, argp)
- int regnum;
- void *argp;
-{
- /* Non-zero if the caller wants the register numbers, too. */
- int numbers = * (int *) argp;
- Tcl_Obj *name = Tcl_NewStringObj (REGISTER_NAME (regnum), -1);
- Tcl_Obj *elt;
+ low = parse_and_eval_address (Tcl_GetStringFromObj (objv[2], NULL));
- if (numbers)
+ if (objc == 3)
{
- /* Build a tuple of the form "{REGNAME NUMBER}", and append it to
- our result. */
- Tcl_Obj *array[2];
-
- array[0] = name;
- array[1] = Tcl_NewIntObj (regnum);
- elt = Tcl_NewListObj (2, array);
+ if (find_pc_partial_function (low, NULL, &low, &high) == 0)
+ error ("No function contains specified address");
}
else
- elt = name;
+ high = parse_and_eval_address (Tcl_GetStringFromObj (objv[3], NULL));
+
+ return gdb_disassemble_driver (low, high, mixed_source_and_assembly, NULL,
+ gdbtk_print_source, gdbtk_print_asm);
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, elt);
}
-/* This implements the tcl command gdb_fetch_registers
- * Pass it a list of register names, and it will
- * return their values as a list.
+/* This implements the tcl command gdb_load_disassembly
*
- * Tcl Arguments:
- * format: The format string for printing the values
- * args: the registers to look for
+ * Arguments:
+ * widget - the name of a text widget into which to load the data
+ * source_with_assm - must be "source" or "nosource"
+ * low_address - the address from which to start disassembly
+ * ?hi_address? - the address to which to disassemble, defaults
+ * to the end of the function containing low_address.
* Tcl Result:
- * A list of their values.
+ * The text widget is loaded with the data, and a list is returned.
+ * The first element of the list is a two element list containing the
+ * real low & high elements, the rest is a mapping between line number
+ * in the text widget, and either the source line number of that line,
+ * if it is a source line, or the assembly address. You can distinguish
+ * between the two, because the address will start with 0x...
*/
static int
-gdb_fetch_registers (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+gdb_load_disassembly (ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
{
- int format, result;
+ CORE_ADDR low, high;
+ struct disassembly_client_data client_data;
+ int mixed_source_and_assembly, ret_val, i;
+ char *arg_ptr;
+ char *map_name;
- if (objc < 2)
+ if (objc != 6 && objc != 7)
{
- Tcl_WrongNumArgs (interp, 1, objv, "format ?register1 register2 ...?");
+ Tcl_WrongNumArgs (interp, 1, objv, "[source|nosource] map_arr index_prefix low_address ?hi_address");
return TCL_ERROR;
}
- objc -= 2;
- objv++;
- format = *(Tcl_GetStringFromObj (objv[0], NULL));
- objv++;
-
- if (objc != 1)
- result_ptr->flags |= GDBTK_MAKES_LIST; /* Output the results as a list */
- result = map_arg_registers (objc, objv, get_register, (void *) format);
- if (objc != 1)
- result_ptr->flags &= ~GDBTK_MAKES_LIST;
- return result;
-}
-
-static void
-get_register (regnum, fp)
- int regnum;
- void *fp;
-{
- struct type *reg_vtype;
- 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;
-
- /* 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)
+ client_data.widget = Tcl_GetStringFromObj (objv[1], NULL);
+ if ( Tk_NameToWindow (interp, client_data.widget,
+ Tk_MainWindow (interp)) == NULL)
{
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj ("Optimized out", -1));
- return;
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid widget name.", -1);
+ return TCL_ERROR;
}
- /* Convert raw data to virtual format if necessary. */
-
- reg_vtype = REGISTER_VIRTUAL_TYPE (regnum);
- if (REGISTER_CONVERTIBLE (regnum))
+ if (!Tcl_GetCommandInfo (interp, client_data.widget, &client_data.cmd))
{
- REGISTER_CONVERT_TO_VIRTUAL (regnum, reg_vtype,
- raw_buffer, virtual_buffer);
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
+ -1);
+ return TCL_ERROR;
}
- else
- memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum));
- if (format == 'r')
+ arg_ptr = Tcl_GetStringFromObj (objv[2], NULL);
+ if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
+ mixed_source_and_assembly = 1;
+ else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
+ mixed_source_and_assembly = 0;
+ else
{
- int j;
- 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;
- sprintf (ptr, "%02x", (unsigned char) raw_buffer[idx]);
- ptr += 2;
- }
- fputs_filtered (buf, gdb_stdout);
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "Second arg must be 'source' or 'nosource'", -1);
+ return TCL_ERROR;
}
- else
- if ((TYPE_CODE (reg_vtype) == TYPE_CODE_UNION)
- && (strcmp (FIELD_NAME (TYPE_FIELD (reg_vtype, 0)), REGISTER_NAME (regnum)) == 0))
- {
- val_print (FIELD_TYPE (TYPE_FIELD (reg_vtype, 0)), virtual_buffer, 0, 0,
- gdb_stdout, format, 1, 0, Val_pretty_default);
- }
- else
- val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, 0,
- gdb_stdout, format, 1, 0, Val_pretty_default);
-
-}
-/* This implements the tcl command get_pc_reg
- * It returns the value of the PC register
- *
- * Tcl Arguments:
- * None
- * Tcl Result:
- * The value of the pc register.
- */
-
-static int
-get_pc_register (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- char *buff;
-
- xasprintf (&buff, "0x%llx", (long long) read_register (PC_REGNUM));
- Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
- free(buff);
- return TCL_OK;
-}
-
-/* This implements the tcl command "gdb_changed_register_list"
- * It takes a list of registers, and returns a list of
- * the registers on that list that have changed since the last
- * time the proc was called.
- *
- * Tcl Arguments:
- * A list of registers.
- * Tcl Result:
- * A list of changed registers.
- */
-
-static int
-gdb_changed_register_list (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- objc--;
- objv++;
-
- return map_arg_registers (objc, objv, register_changed_p, NULL);
-}
-
-static void
-register_changed_p (regnum, argp)
- int regnum;
- void *argp; /* Ignored */
-{
- char raw_buffer[MAX_REGISTER_RAW_SIZE];
-
- if (read_relative_register_raw_bytes (regnum, raw_buffer))
- return;
-
- if (memcmp (&old_regs[REGISTER_BYTE (regnum)], raw_buffer,
- 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));
-
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, Tcl_NewIntObj (regnum));
-}
-\f
-/*
- * This section contains the commands that deal with tracepoints:
- */
-
-/* return a list of all tracepoint numbers in interpreter */
-static int
-gdb_get_tracepoint_list (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- struct tracepoint *tp;
+ /* As we populate the text widget, we will also create an array in the
+ caller's scope. The name is given by objv[3].
+ Each source line gets an entry or the form:
+ array($prefix,srcline=$src_line_no) = $widget_line_no
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+ Each assembly line gets two entries of the form:
+ array($prefix,pc=$pc) = $widget_line_no
+ array($prefix,line=$widget_line_no) = $src_line_no
- ALL_TRACEPOINTS (tp)
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->number));
+ Where prefix is objv[4].
+ */
+
+ map_name = Tcl_GetStringFromObj (objv[3], NULL);
- return TCL_OK;
-}
+ if (*map_name != '\0')
+ {
+ char *prefix;
+ int prefix_len;
+
+ client_data.map_arr = "map_array";
+ if (Tcl_UpVar (interp, "1", map_name, client_data.map_arr, 0) != TCL_OK) {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Can't link map array.", -1);
+ return TCL_ERROR;
+ }
-/* returns -1 if not found, tracepoint # if found */
-static int
-tracepoint_exists (char *args)
-{
- struct tracepoint *tp;
- char **canonical;
- struct symtabs_and_lines sals;
- char *file = NULL;
- int result = -1;
+ prefix = Tcl_GetStringFromObj (objv[4], &prefix_len);
+
+ Tcl_DStringInit(&client_data.src_to_line_prefix);
+ Tcl_DStringAppend (&client_data.src_to_line_prefix,
+ prefix, prefix_len);
+ Tcl_DStringAppend (&client_data.src_to_line_prefix, ",srcline=",
+ sizeof (",srcline=") - 1);
+
+ Tcl_DStringInit(&client_data.pc_to_line_prefix);
+ Tcl_DStringAppend (&client_data.pc_to_line_prefix,
+ prefix, prefix_len);
+ Tcl_DStringAppend (&client_data.pc_to_line_prefix, ",pc=",
+ sizeof (",pc=") - 1);
+
+ Tcl_DStringInit(&client_data.line_to_pc_prefix);
+ Tcl_DStringAppend (&client_data.line_to_pc_prefix,
+ prefix, prefix_len);
+ Tcl_DStringAppend (&client_data.line_to_pc_prefix, ",line=",
+ sizeof (",line=") - 1);
- sals = decode_line_1 (&args, 1, NULL, 0, &canonical);
- if (sals.nelts == 1)
+ }
+ else
{
- resolve_sal_pc (&sals.sals[0]);
- file = xmalloc (strlen (sals.sals[0].symtab->dirname)
- + strlen (sals.sals[0].symtab->filename) + 1);
- if (file != NULL)
- {
- strcpy (file, sals.sals[0].symtab->dirname);
- strcat (file, sals.sals[0].symtab->filename);
-
- ALL_TRACEPOINTS (tp)
- {
- 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
- }
- }
+ client_data.map_arr = "";
}
- if (file != NULL)
- free (file);
- return result;
-}
-static int
-gdb_tracepoint_exists_command (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- char *args;
+ /* Now parse the addresses */
+
+ low = parse_and_eval_address (Tcl_GetStringFromObj (objv[5], NULL));
- if (objc != 2)
+ if (objc == 6)
{
- Tcl_WrongNumArgs (interp, 1, objv,
- "function:line|function|line|*addr");
- return TCL_ERROR;
+ if (find_pc_partial_function (low, NULL, &low, &high) == 0)
+ error ("No function contains specified address");
}
+ else
+ high = parse_and_eval_address (Tcl_GetStringFromObj (objv[6], NULL));
- args = Tcl_GetStringFromObj (objv[1], NULL);
- Tcl_SetIntObj (result_ptr->obj_ptr, tracepoint_exists (args));
- return TCL_OK;
-}
+ /* Setup the client_data structure, and call the driver function. */
+
+ client_data.file_opened_p = 0;
+ client_data.widget_line_no = 0;
+ client_data.interp = interp;
+ for (i = 0; i < 3; i++)
+ {
+ client_data.result_obj[i] = Tcl_NewObj();
+ Tcl_IncrRefCount (client_data.result_obj[i]);
+ }
-static int
-gdb_get_tracepoint_info (ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
-{
- struct symtab_and_line sal;
- int tpnum;
- struct tracepoint *tp;
- struct action_line *al;
- Tcl_Obj *action_list;
- char *filename, *funcname;
+ /* Fill up the constant parts of the argv structures */
+ client_data.asm_argv[0] = client_data.widget;
+ client_data.asm_argv[1] = "insert";
+ client_data.asm_argv[2] = "end";
+ client_data.asm_argv[3] = "-\t";
+ client_data.asm_argv[4] = "break_rgn_tag";
+ /* client_data.asm_argv[5] = address; */
+ client_data.asm_argv[6] = "break_rgn_tag";
+ /* client_data.asm_argv[7] = offset; */
+ client_data.asm_argv[8] = "break_rgn_tag";
+ client_data.asm_argv[9] = ":\t\t";
+ client_data.asm_argv[10] = "source_tag";
+ /* client_data.asm_argv[11] = code; */
+ client_data.asm_argv[12] = "source_tag";
+ client_data.asm_argv[13] = "\n";
- if (objc != 2)
+ if (mixed_source_and_assembly)
{
- Tcl_WrongNumArgs (interp, 1, objv, "tpnum");
- return TCL_ERROR;
+ client_data.source_argv[0] = client_data.widget;
+ client_data.source_argv[1] = "insert";
+ client_data.source_argv[2] = "end";
+ /* client_data.source_argv[3] = line_number; */
+ client_data.source_argv[4] = "";
+ /* client_data.source_argv[5] = line; */
+ client_data.source_argv[6] = "source_tag2";
}
+
+ ret_val = gdb_disassemble_driver (low, high, mixed_source_and_assembly,
+ (ClientData) &client_data,
+ gdbtk_load_source, gdbtk_load_asm);
- if (Tcl_GetIntFromObj (NULL, objv[1], &tpnum) != TCL_OK)
+ /* Now clean up the opened file, and the Tcl data structures */
+
+ if (client_data.file_opened_p == 1) {
+ fclose(client_data.fp);
+ }
+ if (*client_data.map_arr != '\0')
{
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
+ Tcl_DStringFree(&client_data.src_to_line_prefix);
+ Tcl_DStringFree(&client_data.pc_to_line_prefix);
+ Tcl_DStringFree(&client_data.line_to_pc_prefix);
}
-
- ALL_TRACEPOINTS (tp)
- if (tp->number == tpnum)
- break;
-
- if (tp == NULL)
+
+ for (i = 0; i < 3; i++)
{
- /* Hack. Check if this TP is being deleted. See comments
- around the definition of gdbtk_deleted_bp in
- gdbtk-hooks.c. */
- struct tracepoint *dtp = (struct tracepoint *) gdbtk_deleted_bp;
- if (dtp != NULL && dtp->number == tpnum)
- tp = dtp;
- else {
- char *buff;
- xasprintf (&buff, "Tracepoint #%d does not exist", tpnum);
- Tcl_SetStringObj (result_ptr->obj_ptr, buff, -1);
- free(buff);
- return TCL_ERROR;
- }
+ Tcl_DecrRefCount (client_data.result_obj[i]);
}
+
+ /* Finally, if we were successful, stick the low & high addresses
+ into the Tcl result. */
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
- sal = find_pc_line (tp->address, 0);
- filename = symtab_to_filename (sal.symtab);
- if (filename == NULL)
- filename = "N/A";
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (filename, -1));
+ if (ret_val == TCL_OK) {
+ char *buffer;
+ Tcl_Obj *limits_obj[2];
- funcname = pc_function_name (tp->address);
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, Tcl_NewStringObj
- (funcname, -1));
+ xasprintf (&buffer, "0x%s", paddr_nz (low));
+ limits_obj[0] = Tcl_NewStringObj (buffer, -1);
+ free(buffer);
+
+ xasprintf (&buffer, "0x%s", paddr_nz (high));
+ limits_obj[1] = Tcl_NewStringObj (buffer, -1);
+ free(buffer);
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (sal.line));
- {
- char *tmp;
- xasprintf (&tmp, "0x%s", paddr_nz (tp->address));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (tmp, -1));
- free (tmp);
+ Tcl_DecrRefCount (result_ptr->obj_ptr);
+ result_ptr->obj_ptr = Tcl_NewListObj (2, limits_obj);
+
}
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->enabled));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->pass_count));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->step_count));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->thread));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewIntObj (tp->hit_count));
-
- /* Append a list of actions */
- action_list = Tcl_NewObj ();
- for (al = tp->actions; al != NULL; al = al->next)
- {
- Tcl_ListObjAppendElement (interp, action_list,
- Tcl_NewStringObj (al->action, -1));
- }
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, action_list);
+ return ret_val;
- return TCL_OK;
}
-
-static int
-gdb_trace_status (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+static void
+gdbtk_load_source (ClientData clientData, struct symtab *symtab, int
+ start_line, int end_line)
{
- int result = 0;
+ struct disassembly_client_data *client_data =
+ (struct disassembly_client_data *) clientData;
+ char *buffer;
+ int index_len;
- if (trace_running_p)
- result = 1;
+ index_len = Tcl_DStringLength (&client_data->src_to_line_prefix);
+
+ if (client_data->file_opened_p == 1)
+ {
+ char **text_argv;
+ char line[10000], line_number[18];
+ int found_carriage_return = 1;
- Tcl_SetIntObj (result_ptr->obj_ptr, result);
- return TCL_OK;
-}
+ /* First do some sanity checks on the requested lines */
+ if (start_line < 1
+ || end_line < start_line || end_line > symtab->nlines)
+ {
+ return;
+ }
+ line_number[0] = '\t';
+ line[0] = '\t';
-static int
-gdb_get_trace_frame_num (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- if (objc != 1)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "linespec");
- return TCL_ERROR;
- }
-
- Tcl_SetIntObj (result_ptr->obj_ptr, get_traceframe_number ());
- return TCL_OK;
-
-}
+ text_argv = client_data->source_argv;
+
+ text_argv[3] = line_number;
+ text_argv[5] = line;
-/* This implements the tcl command gdb_actions
- * It sets actions for a given tracepoint.
- *
- * Tcl Arguments:
- * number: the tracepoint in question
- * actions: the actions to add to this tracepoint
- * Tcl Result:
- * None.
- */
+ if (fseek (client_data->fp, symtab->line_charpos[start_line - 1],
+ SEEK_SET) < 0)
+ {
+ fclose(client_data->fp);
+ client_data->file_opened_p = -1;
+ return;
+ }
+
+ for (; start_line < end_line; start_line++)
+ {
+ if (!fgets (line + 1, 9980, client_data->fp))
+ {
+ fclose(client_data->fp);
+ client_data->file_opened_p = -1;
+ return;
+ }
-static int
-gdb_actions_command (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- struct tracepoint *tp;
- Tcl_Obj **actions;
- int nactions, i, len;
- char *number, *args, *action;
- long step_count;
- struct action_line *next = NULL, *temp;
- enum actionline_type linetype;
-
- if (objc != 3)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "number actions");
- return TCL_ERROR;
- }
+ client_data->widget_line_no++;
+
+ sprintf (line_number + 1, "%d", start_line);
+
+ if (found_carriage_return) {
+ char *p;
+
+ p = strrchr(line, '\0') - 2;
+ if (*p == '\r') {
+ *p = '\n';
+ *(p + 1) = '\0';
+ } else {
+ found_carriage_return = 0;
+ }
+ }
- args = number = Tcl_GetStringFromObj (objv[1], NULL);
- tp = get_tracepoint_by_number (&args, 0, 0);
- if (tp == NULL)
- {
- Tcl_AppendStringsToObj (result_ptr->obj_ptr, "Tracepoint \"",
- number, "\" does not exist", NULL);
- return TCL_ERROR;
+ /* Run the command, then add an entry to the map array in
+ the caller's scope, if requested. */
+
+ client_data->cmd.proc (client_data->cmd.clientData,
+ client_data->interp, 7, text_argv);
+
+ if (*client_data->map_arr != '\0')
+ {
+
+ Tcl_DStringAppend (&client_data->src_to_line_prefix,
+ line_number + 1, -1);
+
+ /* FIXME: Convert to Tcl_SetVar2Ex when we move to 8.2. This
+ will allow us avoid converting widget_line_no into a string. */
+
+ xasprintf (&buffer, "%d", client_data->widget_line_no);
+
+ Tcl_SetVar2 (client_data->interp, client_data->map_arr,
+ Tcl_DStringValue (&client_data->src_to_line_prefix),
+ buffer, 0);
+ free(buffer);
+
+ Tcl_DStringSetLength (&client_data->src_to_line_prefix, index_len);
+ }
+ }
+
}
-
- /* Free any existing actions */
- if (tp->actions != NULL)
- free_actions (tp);
-
- step_count = 0;
-
- Tcl_ListObjGetElements (interp, objv[2], &nactions, &actions);
-
- /* Add the actions to the tracepoint */
- for (i = 0; i < nactions; i++)
+ else if (!client_data->file_opened_p)
{
- temp = xmalloc (sizeof (struct action_line));
- temp->next = NULL;
- action = Tcl_GetStringFromObj (actions[i], &len);
- temp->action = savestring (action, len);
-
- linetype = validate_actionline (&(temp->action), tp);
-
- if (linetype == BADLINE)
- {
- free (temp);
- continue;
- }
-
- if (next == NULL)
+ int fdes;
+ /* The file is not yet open, try to open it, then print the
+ first line. If we fail, set FILE_OPEN_P to -1. */
+
+ fdes = open_source_file (symtab);
+ if (fdes < 0)
{
- tp->actions = temp;
- next = temp;
+ client_data->file_opened_p = -1;
}
else
{
- next->next = temp;
- next = temp;
+ /* FIXME: Convert to a Tcl File Channel and read from there.
+ This will allow us to get the line endings and conversion
+ to UTF8 right automatically when we move to 8.2.
+ Need a Cygwin call to convert a file descriptor to the native
+ Windows handler to do this. */
+
+ client_data->file_opened_p = 1;
+ client_data->fp = fdopen (fdes, FOPEN_RB);
+ clearerr (client_data->fp);
+
+ if (symtab->line_charpos == 0)
+ find_source_lines (symtab, fdes);
+
+ /* We are called with an actual load request, so call ourselves
+ to load the first line. */
+
+ gdbtk_load_source (clientData, symtab, start_line, end_line);
}
}
+ else {
+ /* If we couldn't open the file, or got some prior error, just exit. */
+
+ return;
+ }
- return TCL_OK;
}
-\f
-/*
- * This section has commands that handle source disassembly.
- */
-/* This implements the tcl command gdb_disassemble. It is no longer
- * used in GDBTk, we use gdb_load_disassembly, but I kept it around in
- * case other folks want it.
- *
- * Arguments:
- * source_with_assm - must be "source" or "nosource"
- * low_address - the address from which to start disassembly
- * ?hi_address? - the address to which to disassemble, defaults
- * to the end of the function containing low_address.
- * Tcl Result:
- * The disassembled code is passed to fputs_unfiltered, so it
- * either goes to the console if result_ptr->obj_ptr is NULL or to
- * the Tcl result.
- */
-static int
-gdb_disassemble (clientData, interp, objc, objv)
+
+static CORE_ADDR
+gdbtk_load_asm (clientData, pc, di)
ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+ CORE_ADDR pc;
+ struct disassemble_info *di;
{
- CORE_ADDR low, high;
- char *arg_ptr;
- int mixed_source_and_assembly;
-
- if (objc != 3 && objc != 4)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "source lowaddr ?highaddr?");
- return TCL_ERROR;
- }
+ struct disassembly_client_data * client_data
+ = (struct disassembly_client_data *) clientData;
+ char **text_argv;
+ int i, pc_to_line_len, line_to_pc_len;
+ gdbtk_result new_result;
+ struct cleanup *old_chain = NULL;
- arg_ptr = Tcl_GetStringFromObj (objv[1], NULL);
- if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
- mixed_source_and_assembly = 1;
- else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
- mixed_source_and_assembly = 0;
- else
- error ("First arg must be 'source' or 'nosource'");
+ pc_to_line_len = Tcl_DStringLength (&client_data->pc_to_line_prefix);
+ line_to_pc_len = Tcl_DStringLength (&client_data->line_to_pc_prefix);
+
+ text_argv = client_data->asm_argv;
+
+ /* Preserve the current Tcl result object, print out what we need, and then
+ suck it out of the result, and replace... */
- low = parse_and_eval_address (Tcl_GetStringFromObj (objv[2], NULL));
+ old_chain = make_cleanup (gdbtk_restore_result_ptr, (void *) result_ptr);
+ result_ptr = &new_result;
+ result_ptr->obj_ptr = client_data->result_obj[0];
+ result_ptr->flags = GDBTK_TO_RESULT;
- if (objc == 3)
- {
- if (find_pc_partial_function (low, NULL, &low, &high) == 0)
- error ("No function contains specified address");
- }
- else
- high = parse_and_eval_address (Tcl_GetStringFromObj (objv[3], NULL));
+ /* Null out the three return objects we will use. */
- return gdb_disassemble_driver (low, high, mixed_source_and_assembly, NULL,
- gdbtk_print_source, gdbtk_print_asm);
+ for (i = 0; i < 3; i++)
+ Tcl_SetObjLength (client_data->result_obj[i], 0);
+
+ print_address_numeric (pc, 1, gdb_stdout);
+ gdb_flush (gdb_stdout);
-}
+ result_ptr->obj_ptr = client_data->result_obj[1];
+
+ print_address_symbolic (pc, gdb_stdout, 1, "\t");
+ gdb_flush (gdb_stdout);
-/* This implements the tcl command gdb_load_disassembly
- *
- * Arguments:
- * widget - the name of a text widget into which to load the data
- * source_with_assm - must be "source" or "nosource"
- * low_address - the address from which to start disassembly
- * ?hi_address? - the address to which to disassemble, defaults
- * to the end of the function containing low_address.
- * Tcl Result:
- * The text widget is loaded with the data, and a list is returned.
- * The first element of the list is a two element list containing the
- * real low & high elements, the rest is a mapping between line number
- * in the text widget, and either the source line number of that line,
- * if it is a source line, or the assembly address. You can distinguish
- * between the two, because the address will start with 0x...
- */
+ result_ptr->obj_ptr = client_data->result_obj[2];
+ pc += (*tm_print_insn) (pc, di);
+ gdb_flush (gdb_stdout);
-static int
-gdb_load_disassembly (ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
-{
- CORE_ADDR low, high;
- struct disassembly_client_data client_data;
- int mixed_source_and_assembly, ret_val, i;
- char *arg_ptr;
- char *map_name;
+ client_data->widget_line_no++;
- if (objc != 6 && objc != 7)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "[source|nosource] map_arr index_prefix low_address ?hi_address");
- return TCL_ERROR;
- }
+ text_argv[5] = Tcl_GetStringFromObj (client_data->result_obj[0], NULL);
+ text_argv[7] = Tcl_GetStringFromObj (client_data->result_obj[1], NULL);
+ text_argv[11] = Tcl_GetStringFromObj (client_data->result_obj[2], NULL);
- client_data.widget = Tcl_GetStringFromObj (objv[1], NULL);
- if ( Tk_NameToWindow (interp, client_data.widget,
- Tk_MainWindow (interp)) == NULL)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid widget name.", -1);
- return TCL_ERROR;
- }
+ client_data->cmd.proc (client_data->cmd.clientData,
+ client_data->interp, 14, text_argv);
- if (!Tcl_GetCommandInfo (interp, client_data.widget, &client_data.cmd))
+ if (*client_data->map_arr != '\0')
{
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
- -1);
- return TCL_ERROR;
- }
-
- arg_ptr = Tcl_GetStringFromObj (objv[2], NULL);
- if (*arg_ptr == 's' && strcmp (arg_ptr, "source") == 0)
- mixed_source_and_assembly = 1;
- else if (*arg_ptr == 'n' && strcmp (arg_ptr, "nosource") == 0)
- mixed_source_and_assembly = 0;
- else
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "Second arg must be 'source' or 'nosource'", -1);
- return TCL_ERROR;
- }
-
- /* As we populate the text widget, we will also create an array in the
- caller's scope. The name is given by objv[3].
- Each source line gets an entry or the form:
- array($prefix,srcline=$src_line_no) = $widget_line_no
-
- Each assembly line gets two entries of the form:
- array($prefix,pc=$pc) = $widget_line_no
- array($prefix,line=$widget_line_no) = $src_line_no
-
- Where prefix is objv[4].
- */
-
- map_name = Tcl_GetStringFromObj (objv[3], NULL);
-
- if (*map_name != '\0')
- {
- char *prefix;
- int prefix_len;
-
- client_data.map_arr = "map_array";
- if (Tcl_UpVar (interp, "1", map_name, client_data.map_arr, 0) != TCL_OK) {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't link map array.", -1);
- return TCL_ERROR;
- }
-
- prefix = Tcl_GetStringFromObj (objv[4], &prefix_len);
-
- Tcl_DStringInit(&client_data.src_to_line_prefix);
- Tcl_DStringAppend (&client_data.src_to_line_prefix,
- prefix, prefix_len);
- Tcl_DStringAppend (&client_data.src_to_line_prefix, ",srcline=",
- sizeof (",srcline=") - 1);
-
- Tcl_DStringInit(&client_data.pc_to_line_prefix);
- Tcl_DStringAppend (&client_data.pc_to_line_prefix,
- prefix, prefix_len);
- Tcl_DStringAppend (&client_data.pc_to_line_prefix, ",pc=",
- sizeof (",pc=") - 1);
-
- Tcl_DStringInit(&client_data.line_to_pc_prefix);
- Tcl_DStringAppend (&client_data.line_to_pc_prefix,
- prefix, prefix_len);
- Tcl_DStringAppend (&client_data.line_to_pc_prefix, ",line=",
- sizeof (",line=") - 1);
-
- }
- else
- {
- client_data.map_arr = "";
- }
-
- /* Now parse the addresses */
-
- low = parse_and_eval_address (Tcl_GetStringFromObj (objv[5], NULL));
-
- if (objc == 6)
- {
- if (find_pc_partial_function (low, NULL, &low, &high) == 0)
- error ("No function contains specified address");
- }
- else
- high = parse_and_eval_address (Tcl_GetStringFromObj (objv[6], NULL));
-
-
- /* Setup the client_data structure, and call the driver function. */
-
- client_data.file_opened_p = 0;
- client_data.widget_line_no = 0;
- client_data.interp = interp;
- for (i = 0; i < 3; i++)
- {
- client_data.result_obj[i] = Tcl_NewObj();
- Tcl_IncrRefCount (client_data.result_obj[i]);
- }
-
- /* Fill up the constant parts of the argv structures */
- client_data.asm_argv[0] = client_data.widget;
- client_data.asm_argv[1] = "insert";
- client_data.asm_argv[2] = "end";
- client_data.asm_argv[3] = "-\t";
- client_data.asm_argv[4] = "break_rgn_tag";
- /* client_data.asm_argv[5] = address; */
- client_data.asm_argv[6] = "break_rgn_tag";
- /* client_data.asm_argv[7] = offset; */
- client_data.asm_argv[8] = "break_rgn_tag";
- client_data.asm_argv[9] = ":\t\t";
- client_data.asm_argv[10] = "source_tag";
- /* client_data.asm_argv[11] = code; */
- client_data.asm_argv[12] = "source_tag";
- client_data.asm_argv[13] = "\n";
-
- if (mixed_source_and_assembly)
- {
- client_data.source_argv[0] = client_data.widget;
- client_data.source_argv[1] = "insert";
- client_data.source_argv[2] = "end";
- /* client_data.source_argv[3] = line_number; */
- client_data.source_argv[4] = "";
- /* client_data.source_argv[5] = line; */
- client_data.source_argv[6] = "source_tag2";
- }
-
- ret_val = gdb_disassemble_driver (low, high, mixed_source_and_assembly,
- (ClientData) &client_data,
- gdbtk_load_source, gdbtk_load_asm);
-
- /* Now clean up the opened file, and the Tcl data structures */
-
- if (client_data.file_opened_p == 1) {
- fclose(client_data.fp);
- }
- if (*client_data.map_arr != '\0')
- {
- Tcl_DStringFree(&client_data.src_to_line_prefix);
- Tcl_DStringFree(&client_data.pc_to_line_prefix);
- Tcl_DStringFree(&client_data.line_to_pc_prefix);
- }
-
- for (i = 0; i < 3; i++)
- {
- Tcl_DecrRefCount (client_data.result_obj[i]);
- }
-
- /* Finally, if we were successful, stick the low & high addresses
- into the Tcl result. */
-
- if (ret_val == TCL_OK) {
- char *buffer;
- Tcl_Obj *limits_obj[2];
-
- xasprintf (&buffer, "0x%s", paddr_nz (low));
- limits_obj[0] = Tcl_NewStringObj (buffer, -1);
- free(buffer);
-
- xasprintf (&buffer, "0x%s", paddr_nz (high));
- limits_obj[1] = Tcl_NewStringObj (buffer, -1);
- free(buffer);
-
- Tcl_DecrRefCount (result_ptr->obj_ptr);
- result_ptr->obj_ptr = Tcl_NewListObj (2, limits_obj);
-
- }
- return ret_val;
-
-}
-
-static void
-gdbtk_load_source (ClientData clientData, struct symtab *symtab, int
- start_line, int end_line)
-{
- struct disassembly_client_data *client_data =
- (struct disassembly_client_data *) clientData;
- char *buffer;
- int index_len;
-
- index_len = Tcl_DStringLength (&client_data->src_to_line_prefix);
-
- if (client_data->file_opened_p == 1)
- {
- char **text_argv;
- char line[10000], line_number[18];
- int found_carriage_return = 1;
-
- /* First do some sanity checks on the requested lines */
-
- if (start_line < 1
- || end_line < start_line || end_line > symtab->nlines)
- {
- return;
- }
-
- line_number[0] = '\t';
- line[0] = '\t';
-
- text_argv = client_data->source_argv;
-
- text_argv[3] = line_number;
- text_argv[5] = line;
-
- if (fseek (client_data->fp, symtab->line_charpos[start_line - 1],
- SEEK_SET) < 0)
- {
- fclose(client_data->fp);
- client_data->file_opened_p = -1;
- return;
- }
-
- for (; start_line < end_line; start_line++)
- {
- if (!fgets (line + 1, 9980, client_data->fp))
- {
- fclose(client_data->fp);
- client_data->file_opened_p = -1;
- return;
- }
-
- client_data->widget_line_no++;
-
- sprintf (line_number + 1, "%d", start_line);
-
- if (found_carriage_return) {
- char *p;
-
- p = strrchr(line, '\0') - 2;
- if (*p == '\r') {
- *p = '\n';
- *(p + 1) = '\0';
- } else {
- found_carriage_return = 0;
- }
- }
-
- /* Run the command, then add an entry to the map array in
- the caller's scope, if requested. */
-
- client_data->cmd.proc (client_data->cmd.clientData,
- client_data->interp, 7, text_argv);
-
- if (*client_data->map_arr != '\0')
- {
-
- Tcl_DStringAppend (&client_data->src_to_line_prefix,
- line_number + 1, -1);
-
- /* FIXME: Convert to Tcl_SetVar2Ex when we move to 8.2. This
- will allow us avoid converting widget_line_no into a string. */
-
- xasprintf (&buffer, "%d", client_data->widget_line_no);
-
- Tcl_SetVar2 (client_data->interp, client_data->map_arr,
- Tcl_DStringValue (&client_data->src_to_line_prefix),
- buffer, 0);
- free(buffer);
-
- Tcl_DStringSetLength (&client_data->src_to_line_prefix, index_len);
- }
- }
-
- }
- else if (!client_data->file_opened_p)
- {
- int fdes;
- /* The file is not yet open, try to open it, then print the
- first line. If we fail, set FILE_OPEN_P to -1. */
-
- fdes = open_source_file (symtab);
- if (fdes < 0)
- {
- client_data->file_opened_p = -1;
- }
- else
- {
- /* FIXME: Convert to a Tcl File Channel and read from there.
- This will allow us to get the line endings and conversion
- to UTF8 right automatically when we move to 8.2.
- Need a Cygwin call to convert a file descriptor to the native
- Windows handler to do this. */
-
- client_data->file_opened_p = 1;
- client_data->fp = fdopen (fdes, FOPEN_RB);
- clearerr (client_data->fp);
-
- if (symtab->line_charpos == 0)
- find_source_lines (symtab, fdes);
-
- /* We are called with an actual load request, so call ourselves
- to load the first line. */
-
- gdbtk_load_source (clientData, symtab, start_line, end_line);
- }
- }
- else {
- /* If we couldn't open the file, or got some prior error, just exit. */
-
- return;
- }
-
-}
-
-
-static CORE_ADDR
-gdbtk_load_asm (clientData, pc, di)
- ClientData clientData;
- CORE_ADDR pc;
- struct disassemble_info *di;
-{
- struct disassembly_client_data * client_data
- = (struct disassembly_client_data *) clientData;
- char **text_argv;
- int i, pc_to_line_len, line_to_pc_len;
- gdbtk_result new_result;
- struct cleanup *old_chain = NULL;
-
- pc_to_line_len = Tcl_DStringLength (&client_data->pc_to_line_prefix);
- line_to_pc_len = Tcl_DStringLength (&client_data->line_to_pc_prefix);
-
- text_argv = client_data->asm_argv;
-
- /* Preserve the current Tcl result object, print out what we need, and then
- suck it out of the result, and replace... */
-
- old_chain = make_cleanup (gdbtk_restore_result_ptr, (void *) result_ptr);
- result_ptr = &new_result;
- result_ptr->obj_ptr = client_data->result_obj[0];
- result_ptr->flags = GDBTK_TO_RESULT;
-
- /* Null out the three return objects we will use. */
-
- for (i = 0; i < 3; i++)
- Tcl_SetObjLength (client_data->result_obj[i], 0);
-
- print_address_numeric (pc, 1, gdb_stdout);
- gdb_flush (gdb_stdout);
-
- result_ptr->obj_ptr = client_data->result_obj[1];
-
- print_address_symbolic (pc, gdb_stdout, 1, "\t");
- gdb_flush (gdb_stdout);
-
- result_ptr->obj_ptr = client_data->result_obj[2];
- pc += (*tm_print_insn) (pc, di);
- gdb_flush (gdb_stdout);
-
- client_data->widget_line_no++;
-
- text_argv[5] = Tcl_GetStringFromObj (client_data->result_obj[0], NULL);
- text_argv[7] = Tcl_GetStringFromObj (client_data->result_obj[1], NULL);
- text_argv[11] = Tcl_GetStringFromObj (client_data->result_obj[2], NULL);
-
- client_data->cmd.proc (client_data->cmd.clientData,
- client_data->interp, 14, text_argv);
-
- if (*client_data->map_arr != '\0')
- {
- char *buffer;
-
- /* Run the command, then add an entry to the map array in
- the caller's scope. */
-
- Tcl_DStringAppend (&client_data->pc_to_line_prefix, text_argv[5], -1);
-
- /* FIXME: Convert to Tcl_SetVar2Ex when we move to 8.2. This
- will allow us avoid converting widget_line_no into a string. */
-
- xasprintf (&buffer, "%d", client_data->widget_line_no);
-
- Tcl_SetVar2 (client_data->interp, client_data->map_arr,
- Tcl_DStringValue (&client_data->pc_to_line_prefix),
- buffer, 0);
-
- Tcl_DStringAppend (&client_data->line_to_pc_prefix, buffer, -1);
-
- Tcl_SetVar2 (client_data->interp, client_data->map_arr,
- Tcl_DStringValue (&client_data->line_to_pc_prefix),
- text_argv[5], 0);
-
- /* Restore the prefixes to their initial state. */
-
- Tcl_DStringSetLength (&client_data->pc_to_line_prefix, pc_to_line_len);
- Tcl_DStringSetLength (&client_data->line_to_pc_prefix, line_to_pc_len);
-
- free(buffer);
- }
-
- do_cleanups (old_chain);
-
- return pc;
-}
-
-static void
-gdbtk_print_source (clientData, symtab, start_line, end_line)
- ClientData clientData;
- struct symtab *symtab;
- int start_line;
- int end_line;
-{
- print_source_lines (symtab, start_line, end_line, 0);
- gdb_flush (gdb_stdout);
-}
-
-static CORE_ADDR
-gdbtk_print_asm (clientData, pc, di)
- ClientData clientData;
- CORE_ADDR pc;
- struct disassemble_info *di;
-{
- 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);
- return pc;
-}
-
-static int
-gdb_disassemble_driver (low, high, mixed_source_and_assembly,
- clientData, print_source_fn, print_asm_fn)
- CORE_ADDR low;
- CORE_ADDR high;
- int mixed_source_and_assembly;
- ClientData clientData;
- void (*print_source_fn) (ClientData, struct symtab *, int, int);
- CORE_ADDR (*print_asm_fn) (ClientData, CORE_ADDR,
- struct disassemble_info *);
-{
- CORE_ADDR pc;
- static disassemble_info di;
- static int di_initialized;
-
- if (! di_initialized)
- {
- INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
- (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 = TARGET_PRINT_INSN_INFO->mach;
- if (TARGET_BYTE_ORDER == BIG_ENDIAN)
- di.endian = BFD_ENDIAN_BIG;
- else
- di.endian = BFD_ENDIAN_LITTLE;
-
- /* Set the architecture for multi-arch configurations. */
- if (TARGET_ARCHITECTURE != NULL)
- di.mach = TARGET_ARCHITECTURE->mach;
-
- /* If disassemble_from_exec == -1, then we use the following heuristic to
- determine whether or not to do disassembly from target memory or from the
- exec file:
-
- If we're debugging a local process, read target memory, instead of the
- exec file. This makes disassembly of functions in shared libs work
- correctly. Also, read target memory if we are debugging native threads.
-
- Else, we're debugging a remote process, and should disassemble from the
- exec file for speed. However, this is no good if the target modifies its
- code (for relocation, or whatever).
-
- As an aside, it is fairly bogus that there is not a better way to
- determine where to disassemble from. There should be a target vector
- entry for this or something.
-
- */
-
- if (disassemble_from_exec == -1)
- {
- if (strcmp (target_shortname, "child") == 0
- || strcmp (target_shortname, "procfs") == 0
- || strcmp (target_shortname, "vxprocess") == 0
- || strstr (target_shortname, "threads") != NULL)
- /* It's a child process, read inferior mem */
- disassemble_from_exec = 0;
- else
- /* It's remote, read the exec file */
- disassemble_from_exec = 1;
- }
-
- if (disassemble_from_exec)
- di.read_memory_func = gdbtk_dis_asm_read_memory;
- else
- di.read_memory_func = dis_asm_read_memory;
-
- /* If just doing straight assembly, all we need to do is disassemble
- everything between low and high. If doing mixed source/assembly, we've
- got a totally different path to follow. */
-
- 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. */
- struct symtab *symtab;
- struct linetable_entry *le;
- int nlines;
- int newlines;
- struct my_line_entry *mle;
- struct symtab_and_line sal;
- int i;
- int out_of_order;
- int next_line;
-
- /* Assume symtab is valid for whole PC range */
- symtab = find_pc_symtab (low);
-
- if (!symtab || !symtab->linetable)
- goto assembly_only;
-
- /* 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;
-
- 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. */
-
- /* 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. */
-
- 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 */
-
- /* GCC sometimes emits line directives with a linenumber
- of 0. It does this to handle live range splitting.
- This may be a bug, but we need to be able to handle it.
- For now, use the previous instructions line number.
- Since this is a bit of a hack anyway, we will just lose
- if the bogus sline is the first line of the range. For
- functions, I have never seen this to be the case. */
-
- if (le[i].line != 0)
- {
- mle[newlines].line = le[i].line;
- }
- else
- {
- if (newlines > 0)
- mle[newlines].line = mle[newlines - 1].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 (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++;
- }
-
- /* 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);
-
- /* 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_fn (clientData, symtab, next_line,
- mle[i].line + 1);
- else
- print_source_fn (clientData, symtab, mle[i].line,
- mle[i].line + 1);
-
- next_line = mle[i].line + 1;
- }
-
- for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
- {
- QUIT;
- pc = print_asm_fn (clientData, pc, &di);
- }
- }
- }
- else
- {
- assembly_only:
- for (pc = low; pc < high; )
- {
- QUIT;
- pc = print_asm_fn (clientData, pc, &di);
- }
- }
-
- return TCL_OK;
-}
-
-/* This is the memory_read_func for gdb_disassemble when we are
- disassembling from the exec file. */
-
-static int
-gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
- bfd_vma memaddr;
- bfd_byte *myaddr;
- unsigned int len;
- disassemble_info *info;
-{
- extern struct target_ops exec_ops;
- int res;
-
- errno = 0;
- res = xfer_memory (memaddr, myaddr, len, 0, 0, &exec_ops);
-
- if (res == len)
- return 0;
- else if (errno == 0)
- return EIO;
- else
- return errno;
-}
-
-/* This will be passed to qsort to sort the results of the disassembly */
-
-static int
-compare_lines (mle1p, mle2p)
- const PTR mle1p;
- const PTR mle2p;
-{
- struct my_line_entry *mle1, *mle2;
- int val;
-
- mle1 = (struct my_line_entry *) mle1p;
- mle2 = (struct my_line_entry *) mle2p;
-
- val = mle1->line - mle2->line;
-
- if (val != 0)
- return val;
-
- return mle1->start_pc - mle2->start_pc;
-}
-
-/* This implements the TCL command `gdb_loc',
-
- * Arguments:
- * ?symbol? The symbol or address to locate - defaults to pc
- * Tcl Return:
- * a list consisting of the following:
- * basename, function name, filename, line number, address, current pc
- */
-
-static int
-gdb_loc (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
-{
- char *filename;
- struct symtab_and_line sal;
- char *fname;
- CORE_ADDR pc;
-
- if (objc == 1)
- {
- if (selected_frame && (selected_frame->pc != read_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 highlighted. 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 = read_pc ();
- sal = find_pc_line (pc, 0);
- }
- }
- else if (objc == 2)
- {
- struct symtabs_and_lines sals;
- int nelts;
-
- sals = decode_line_spec (Tcl_GetStringFromObj (objv[1], NULL), 1);
-
- nelts = sals.nelts;
- sal = sals.sals[0];
- free (sals.sals);
-
- if (sals.nelts != 1)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
- return TCL_ERROR;
- }
- resolve_sal_pc (&sal);
- pc = sal.pc;
- }
- else
- {
- Tcl_WrongNumArgs (interp, 1, objv, "?symbol?");
- return TCL_ERROR;
- }
-
- if (sal.symtab)
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (sal.symtab->filename, -1));
- else
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj ("", 0));
-
- fname = pc_function_name (pc);
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (fname, -1));
-
- filename = symtab_to_filename (sal.symtab);
- if (filename == NULL)
- filename = "";
-
- /* file name */
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (filename, -1));
- /* 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;
-}
-
-/* This implements the TCL command gdb_entry_point. It returns the current
- entry point address. */
-
-static int
-gdb_entry_point (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- char *addrstr;
-
- /* If we have not yet loaded an exec file, then we have no
- entry point, so return an empty string.*/
- if ((int) current_target.to_stratum > (int) dummy_stratum)
- {
- addrstr = paddr_nz (entry_point_address ());
- Tcl_SetStringObj (result_ptr->obj_ptr, addrstr, -1);
- }
- else
- Tcl_SetStringObj (result_ptr->obj_ptr, "", -1);
-
- return TCL_OK;
-}
-
-/* This implements the Tcl command 'gdb_get_mem', which
- * dumps a block of memory
- * Arguments:
- * gdb_get_mem addr form size nbytes bpr aschar
- *
- * addr: address of data to dump
- * form: a char indicating format
- * size: size of each element; 1,2,4, or 8 bytes
- * nbytes: the number of bytes to read
- * bpr: bytes per row
- * aschar: if present, an ASCII dump of the row is included. ASCHAR
- * used for unprintable characters.
- *
- * Return:
- * a list of elements followed by an optional ASCII dump */
-
-static int
-gdb_get_mem (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- int size, asize, i, j, bc;
- CORE_ADDR addr;
- int nbytes, rnum, bpr;
- long tmp;
- char format, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
- struct type *val_type;
-
- if (objc < 6 || objc > 7)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "addr format size bytes bytes_per_row ?ascii_char?",
- -1);
- return TCL_ERROR;
- }
-
- if (Tcl_GetIntFromObj (interp, objv[3], &size) != TCL_OK)
- {
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
- else if (size <= 0)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid size, must be > 0", -1);
- return TCL_ERROR;
- }
-
- if (Tcl_GetIntFromObj (interp, objv[4], &nbytes) != TCL_OK)
- {
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
- else if (nbytes <= 0)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "Invalid number of bytes, must be > 0",
- -1);
- return TCL_ERROR;
- }
-
- if (Tcl_GetIntFromObj (interp, objv[5], &bpr) != TCL_OK)
- {
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
- else if (bpr <= 0)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "Invalid bytes per row, must be > 0", -1);
- return TCL_ERROR;
- }
-
- if (Tcl_GetLongFromObj (interp, objv[1], &tmp) != TCL_OK)
- return TCL_OK;
-
- addr = (CORE_ADDR) tmp;
-
- format = *(Tcl_GetStringFromObj (objv[2], NULL));
- mbuf = (char *) malloc (nbytes + 32);
- if (!mbuf)
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Out of memory.", -1);
- return TCL_ERROR;
- }
-
- memset (mbuf, 0, nbytes + 32);
- mptr = cptr = mbuf;
-
- rnum = 0;
- while (rnum < nbytes)
- {
- int error;
- int num = target_read_memory_partial (addr + rnum, mbuf + rnum,
- nbytes - rnum, &error);
- if (num <= 0)
- break;
- rnum += num;
- }
-
- if (objc == 7)
- aschar = *(Tcl_GetStringFromObj (objv[6], NULL));
- else
- aschar = 0;
-
- switch (size)
- {
- case 1:
- val_type = builtin_type_int8;
- asize = 'b';
- break;
- case 2:
- val_type = builtin_type_int16;
- asize = 'h';
- break;
- case 4:
- val_type = builtin_type_int32;
- asize = 'w';
- break;
- case 8:
- val_type = builtin_type_int64;
- asize = 'g';
- break;
- default:
- val_type = builtin_type_int8;
- asize = 'b';
- }
-
- bc = 0; /* count of bytes in a row */
- bptr = &buff[0]; /* pointer for ascii dump */
-
- /* Build up the result as a list... */
-
- result_ptr->flags |= GDBTK_MAKES_LIST;
-
- for (i = 0; i < nbytes; i += size)
- {
- if (i >= rnum)
- {
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj ("N/A", 3));
- 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++)
- {
- *bptr = *cptr++;
- if (*bptr < 32 || *bptr > 126)
- *bptr = aschar;
- bptr++;
- }
- }
- }
-
- mptr += size;
- bc += size;
-
- if (aschar && (bc >= bpr))
- {
- /* end of row. Add it to the result and reset variables */
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (buff, bc));
- bc = 0;
- bptr = &buff[0];
- }
- }
-
- result_ptr->flags &= ~GDBTK_MAKES_LIST;
-
- free (mbuf);
- return TCL_OK;
-}
-\f
-
-/* This implements the tcl command "gdb_loadfile"
- * It loads a c source file into a text widget.
- *
- * Tcl Arguments:
- * widget: the name of the text widget to fill
- * filename: the name of the file to load
- * linenumbers: A boolean indicating whether or not to display line numbers.
- * Tcl Result:
- *
- */
-
-/* In this routine, we will build up a "line table", i.e. a
- * table of bits showing which lines in the source file are executible.
- * 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
-static int
-gdb_loadfile (ClientData clientData, Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[])
-{
- char *file, *widget;
- int linenumbers, ln, lnum, ltable_size;
- FILE *fp;
- char *ltable;
- struct symtab *symtab;
- struct linetable_entry *le;
- long mtime = 0;
- struct stat st;
- char line[10000], line_num_buf[18];
- char *text_argv[9];
- Tcl_CmdInfo text_cmd;
-
-
- if (objc != 4)
- {
- Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
- return TCL_ERROR;
- }
-
- widget = Tcl_GetStringFromObj (objv[1], NULL);
- if ( Tk_NameToWindow (interp, widget, Tk_MainWindow (interp)) == NULL)
- {
- return TCL_ERROR;
- }
-
- if (!Tcl_GetCommandInfo (interp, widget, &text_cmd))
- {
- Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
- -1);
- return TCL_ERROR;
- }
-
- file = Tcl_GetStringFromObj (objv[2], NULL);
- Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
-
- symtab = full_lookup_symtab (file);
- if (!symtab)
- {
- Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);
- 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", "",
- RETURN_MASK_ALL);
- return TCL_ERROR;
- }
-
- 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("file_times",\
- "Source file is more recent than executable.\n");
- }
-
-
- /* 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)
- {
- Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -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)
- {
- 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);
- }
- }
+ char *buffer;
- ln = 1;
-
- line[0] = '\t';
- text_argv[0] = widget;
- text_argv[1] = "insert";
- text_argv[2] = "end";
- text_argv[5] = line;
- text_argv[6] = "source_tag";
- text_argv[8] = NULL;
-
- if (linenumbers)
- {
- int found_carriage_return = 1;
+ /* Run the command, then add an entry to the map array in
+ the caller's scope. */
- line_num_buf[1] = '\t';
-
- text_argv[3] = line_num_buf;
+ Tcl_DStringAppend (&client_data->pc_to_line_prefix, text_argv[5], -1);
- while (fgets (line + 1, 9980, fp))
- {
- /* Look for DOS style \r\n endings, and if found,
- * strip off the \r. We assume (for the sake of
- * speed) that ALL lines in the file have DOS endings,
- * or none do.
- */
-
- if (found_carriage_return)
- {
- char *p;
-
- p = strrchr(line, '\0') - 2;
- if (*p == '\r') {
- *p = '\n';
- *(p + 1) = '\0';
- } else {
- found_carriage_return = 0;
- }
- }
-
- sprintf (line_num_buf+2, "%d", ln);
- if (ltable[ln >> 3] & (1 << (ln % 8)))
- {
- line_num_buf[0] = '-';
- text_argv[4] = "break_rgn_tag";
- }
- else
- {
- line_num_buf[0] = ' ';
- text_argv[4] = "";
- }
-
- text_cmd.proc(text_cmd.clientData, interp, 7, text_argv);
- ln++;
- }
- }
- else
- {
- int found_carriage_return = 1;
-
- while (fgets (line + 1, 9980, fp))
- {
- if (found_carriage_return) {
- char *p;
-
- p = strrchr(line, '\0') - 2;
- if (*p == '\r') {
- *p = '\n';
- *(p + 1) = '\0';
- } else {
- found_carriage_return = 0;
- }
- }
+ /* FIXME: Convert to Tcl_SetVar2Ex when we move to 8.2. This
+ will allow us avoid converting widget_line_no into a string. */
+
+ xasprintf (&buffer, "%d", client_data->widget_line_no);
+
+ Tcl_SetVar2 (client_data->interp, client_data->map_arr,
+ Tcl_DStringValue (&client_data->pc_to_line_prefix),
+ buffer, 0);
- if (ltable[ln >> 3] & (1 << (ln % 8)))
- {
- text_argv[3] = "- ";
- text_argv[4] = "break_rgn_tag";
- }
- else
- {
- text_argv[3] = " ";
- text_argv[4] = "";
- }
+ Tcl_DStringAppend (&client_data->line_to_pc_prefix, buffer, -1);
+
+ Tcl_SetVar2 (client_data->interp, client_data->map_arr,
+ Tcl_DStringValue (&client_data->line_to_pc_prefix),
+ text_argv[5], 0);
- text_cmd.proc(text_cmd.clientData, interp, 7, text_argv);
- ln++;
- }
+ /* Restore the prefixes to their initial state. */
+
+ Tcl_DStringSetLength (&client_data->pc_to_line_prefix, pc_to_line_len);
+ Tcl_DStringSetLength (&client_data->line_to_pc_prefix, line_to_pc_len);
+
+ free(buffer);
}
-
- free (ltable);
- fclose (fp);
- return TCL_OK;
+
+ do_cleanups (old_chain);
+
+ return pc;
}
-\f
-/*
- * This section contains commands for manipulation of breakpoints.
- */
+static void
+gdbtk_print_source (clientData, symtab, start_line, end_line)
+ ClientData clientData;
+ struct symtab *symtab;
+ int start_line;
+ int end_line;
+{
+ print_source_lines (symtab, start_line, end_line, 0);
+ gdb_flush (gdb_stdout);
+}
-/* set a breakpoint by source file and line number */
-/* flags are as follows: */
-/* least significant 2 bits are disposition, rest is */
-/* type (normally 0).
-
- 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
- };
- */
-
-/* This implements the tcl command "gdb_set_bp"
- * It sets breakpoints, and notifies the GUI.
- *
- * Tcl Arguments:
- * 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.
- */
+static CORE_ADDR
+gdbtk_print_asm (clientData, pc, di)
+ ClientData clientData;
+ CORE_ADDR pc;
+ struct disassemble_info *di;
+{
+ 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);
+ return pc;
+}
static int
-gdb_set_bp (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+gdb_disassemble_driver (low, high, mixed_source_and_assembly,
+ clientData, print_source_fn, print_asm_fn)
+ CORE_ADDR low;
+ CORE_ADDR high;
+ int mixed_source_and_assembly;
+ ClientData clientData;
+ void (*print_source_fn) (ClientData, struct symtab *, int, int);
+ CORE_ADDR (*print_asm_fn) (ClientData, CORE_ADDR,
+ struct disassemble_info *);
{
- struct symtab_and_line sal;
- int line, thread = -1;
- struct breakpoint *b;
- char *buf, *typestr;
- Tcl_DString cmd;
- enum bpdisp disp;
+ CORE_ADDR pc;
+ static disassemble_info di;
+ static int di_initialized;
- if (objc != 4 && objc != 5)
+ if (! di_initialized)
{
- Tcl_WrongNumArgs (interp, 1, objv, "filename line type ?thread?");
- return TCL_ERROR;
+ INIT_DISASSEMBLE_INFO_NO_ARCH (di, gdb_stdout,
+ (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;
}
- sal.symtab = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
- if (sal.symtab == NULL)
- return TCL_ERROR;
+ di.mach = TARGET_PRINT_INSN_INFO->mach;
+ if (TARGET_BYTE_ORDER == BIG_ENDIAN)
+ di.endian = BFD_ENDIAN_BIG;
+ else
+ di.endian = BFD_ENDIAN_LITTLE;
- if (Tcl_GetIntFromObj (interp, objv[2], &line) == TCL_ERROR)
- {
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ /* Set the architecture for multi-arch configurations. */
+ if (TARGET_ARCHITECTURE != NULL)
+ di.mach = TARGET_ARCHITECTURE->mach;
+
+ /* If disassemble_from_exec == -1, then we use the following heuristic to
+ determine whether or not to do disassembly from target memory or from the
+ exec file:
+
+ If we're debugging a local process, read target memory, instead of the
+ exec file. This makes disassembly of functions in shared libs work
+ correctly. Also, read target memory if we are debugging native threads.
+
+ Else, we're debugging a remote process, and should disassemble from the
+ exec file for speed. However, this is no good if the target modifies its
+ code (for relocation, or whatever).
+
+ As an aside, it is fairly bogus that there is not a better way to
+ determine where to disassemble from. There should be a target vector
+ entry for this or something.
+
+ */
- typestr = Tcl_GetStringFromObj (objv[3], NULL);
- if (typestr == NULL)
+ if (disassemble_from_exec == -1)
{
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
+ if (strcmp (target_shortname, "child") == 0
+ || strcmp (target_shortname, "procfs") == 0
+ || strcmp (target_shortname, "vxprocess") == 0
+ || strstr (target_shortname, "threads") != NULL)
+ /* It's a child process, read inferior mem */
+ disassemble_from_exec = 0;
+ else
+ /* It's remote, read the exec file */
+ disassemble_from_exec = 1;
}
- if (strncmp (typestr, "temp", 4) == 0)
- disp = del;
- else if (strncmp (typestr, "normal", 6) == 0)
- disp = donttouch;
+
+ if (disassemble_from_exec)
+ di.read_memory_func = gdbtk_dis_asm_read_memory;
else
- {
- Tcl_SetStringObj (result_ptr->obj_ptr,
- "type must be \"temp\" or \"normal\"", -1);
- return TCL_ERROR;
- }
+ di.read_memory_func = dis_asm_read_memory;
- if (objc == 5)
- {
- if (Tcl_GetIntFromObj (interp, objv[4], &thread) == TCL_ERROR)
- {
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
- }
+ /* If just doing straight assembly, all we need to do is disassemble
+ everything between low and high. If doing mixed source/assembly, we've
+ got a totally different path to follow. */
- sal.line = line;
- if (!find_line_pc (sal.symtab, sal.line, &sal.pc))
- return TCL_ERROR;
+ 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. */
+ struct symtab *symtab;
+ struct linetable_entry *le;
+ int nlines;
+ int newlines;
+ struct my_line_entry *mle;
+ struct symtab_and_line sal;
+ int i;
+ int out_of_order;
+ int next_line;
+
+ /* Assume symtab is valid for whole PC range */
+ symtab = find_pc_symtab (low);
+
+ if (!symtab || !symtab->linetable)
+ goto assembly_only;
+
+ /* First, convert the linetable to a bunch of my_line_entry's. */
- sal.section = find_pc_overlay (sal.pc);
- 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;
-
- /* FIXME: this won't work for duplicate basenames! */
- xasprintf (&buf, "%s:%d", basename (Tcl_GetStringFromObj (objv[1], NULL)),
- line);
- b->addr_string = xstrdup (buf);
- free(buf);
+ le = symtab->linetable->item;
+ nlines = symtab->linetable->nitems;
- /* now send notification command back to GUI */
- create_breakpoint_hook (b);
- return TCL_OK;
-}
+ if (nlines <= 0)
+ goto assembly_only;
-/* This implements the tcl command "gdb_set_bp_addr"
- * It sets breakpoints, and notifies 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.
- */
+ mle = (struct my_line_entry *) alloca (nlines *
+ sizeof (struct my_line_entry));
-static int
-gdb_set_bp_addr (ClientData clientData, Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[])
-
-{
- struct symtab_and_line sal;
- int thread = -1;
- long addr;
- struct breakpoint *b;
- char *filename, *typestr, *buf;
- Tcl_DString cmd;
- enum bpdisp disp;
+ 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. */
- if (objc != 3 && objc != 4)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "address type ?thread?");
- return TCL_ERROR;
- }
+ /* First, skip all the preceding functions. */
- if (Tcl_GetLongFromObj (interp, objv[1], &addr) == TCL_ERROR)
- {
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ for (i = 0; i < nlines - 1 && le[i].pc < low; i++) ;
- 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;
- }
+ /* Now, copy all entries before the end of this function. */
- if (objc == 4)
- {
- if (Tcl_GetIntFromObj (interp, objv[3], &thread) == TCL_ERROR)
- {
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
- }
+ 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 */
- 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;
+ /* GCC sometimes emits line directives with a linenumber
+ of 0. It does this to handle live range splitting.
+ This may be a bug, but we need to be able to handle it.
+ For now, use the previous instructions line number.
+ Since this is a bit of a hack anyway, we will just lose
+ if the bogus sline is the first line of the range. For
+ functions, I have never seen this to be the case. */
+
+ if (le[i].line != 0)
+ {
+ mle[newlines].line = le[i].line;
+ }
+ else
+ {
+ if (newlines > 0)
+ mle[newlines].line = mle[newlines - 1].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++;
+ }
- xasprintf (&buf, "*(0x%lx)", addr);
- b->addr_string = xstrdup (buf);
+ /* 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. */
- /* now send notification command back to GUI */
- create_breakpoint_hook (b);
- return TCL_OK;
-}
+ 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++;
+ }
-/* This implements the tcl command "gdb_find_bp_at_line"
+ /* Now, sort mle by line #s (and, then by addresses within lines). */
- * 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
- */
+ if (out_of_order)
+ qsort (mle, newlines, sizeof (struct my_line_entry), compare_lines);
-static int
-gdb_find_bp_at_line (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+ /* Now, for each line entry, emit the specified lines (unless they have
+ been emitted before), followed by the assembly code for that line. */
-{
- struct symtab *s;
- int line;
- struct breakpoint *b;
- extern struct breakpoint *breakpoint_chain;
+ next_line = 0; /* Force out first line */
+ for (i = 0; i < newlines; i++)
+ {
+ /* Print out everything from next_line to the current line. */
- if (objc != 3)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "filename line");
- return TCL_ERROR;
- }
+ if (mle[i].line >= next_line)
+ {
+ if (next_line != 0)
+ print_source_fn (clientData, symtab, next_line,
+ mle[i].line + 1);
+ else
+ print_source_fn (clientData, symtab, mle[i].line,
+ mle[i].line + 1);
- s = full_lookup_symtab (Tcl_GetStringFromObj (objv[1], NULL));
- if (s == NULL)
- return TCL_ERROR;
+ next_line = mle[i].line + 1;
+ }
- if (Tcl_GetIntFromObj (interp, objv[2], &line) == TCL_ERROR)
+ for (pc = mle[i].start_pc; pc < mle[i].end_pc; )
+ {
+ QUIT;
+ pc = print_asm_fn (clientData, pc, &di);
+ }
+ }
+ }
+ else
{
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
+ assembly_only:
+ for (pc = low; pc < high; )
+ {
+ QUIT;
+ pc = print_asm_fn (clientData, pc, &di);
+ }
}
- 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 is the memory_read_func for gdb_disassemble when we are
+ disassembling from the exec file. */
-/* This implements the tcl command "gdb_find_bp_at_addr"
+static int
+gdbtk_dis_asm_read_memory (memaddr, myaddr, len, info)
+ bfd_vma memaddr;
+ bfd_byte *myaddr;
+ unsigned int len;
+ disassemble_info *info;
+{
+ extern struct target_ops exec_ops;
+ int res;
- * Tcl Arguments:
- * addr: address
- * Tcl Result:
- * It returns a list of breakpoint numbers
- */
+ errno = 0;
+ res = xfer_memory (memaddr, myaddr, len, 0, 0, &exec_ops);
-static int
-gdb_find_bp_at_addr (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+ if (res == len)
+ return 0;
+ else if (errno == 0)
+ return EIO;
+ else
+ return errno;
+}
+
+/* This will be passed to qsort to sort the results of the disassembly */
+static int
+compare_lines (mle1p, mle2p)
+ const PTR mle1p;
+ const PTR mle2p;
{
- long addr;
- struct breakpoint *b;
- extern struct breakpoint *breakpoint_chain;
+ struct my_line_entry *mle1, *mle2;
+ int val;
- if (objc != 2)
- {
- Tcl_WrongNumArgs (interp, 1, objv, "address");
- return TCL_ERROR;
- }
+ mle1 = (struct my_line_entry *) mle1p;
+ mle2 = (struct my_line_entry *) mle2p;
- if (Tcl_GetLongFromObj (interp, objv[1], &addr) == TCL_ERROR)
- {
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ val = mle1->line - mle2->line;
- 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));
+ if (val != 0)
+ return val;
- return TCL_OK;
+ return mle1->start_pc - mle2->start_pc;
}
-/* This implements the tcl command gdb_get_breakpoint_info
-
+/* This implements the TCL command `gdb_loc',
- * Tcl Arguments:
- * breakpoint_number
- * Tcl Result:
- * A list with {file, function, line_number, address, type, enabled?,
- * disposition, ignore_count, {list_of_commands},
- * condition, thread, hit_count}
+ * Arguments:
+ * ?symbol? The symbol or address to locate - defaults to pc
+ * Tcl Return:
+ * a list consisting of the following:
+ * basename, function name, filename, line number, address, current pc
*/
static int
-gdb_get_breakpoint_info (ClientData clientData, Tcl_Interp *interp, int objc,
- Tcl_Obj *CONST objv[])
+gdb_loc (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
+ char *filename;
struct symtab_and_line sal;
- struct command_line *cmd;
- int bpnum;
- struct breakpoint *b;
- extern struct breakpoint *breakpoint_chain;
- char *funcname, *filename;
-
- Tcl_Obj *new_obj;
+ char *fname;
+ CORE_ADDR pc;
- if (objc != 2)
+ if (objc == 1)
{
- Tcl_WrongNumArgs (interp, 1, objv, "breakpoint");
- return TCL_ERROR;
+ if (selected_frame && (selected_frame->pc != read_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 highlighted. 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 = read_pc ();
+ sal = find_pc_line (pc, 0);
+ }
}
-
- if (Tcl_GetIntFromObj (NULL, objv[1], &bpnum) != TCL_OK)
+ else if (objc == 2)
{
- result_ptr->flags = GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ struct symtabs_and_lines sals;
+ int nelts;
- for (b = breakpoint_chain; b; b = b->next)
- if (b->number == bpnum)
- break;
+ sals = decode_line_spec (Tcl_GetStringFromObj (objv[1], NULL), 1);
- if (!b || b->type != bp_breakpoint)
- {
- /* Hack. Check if this BP is being deleted. See comments
- around the definition of gdbtk_deleted_bp in
- gdbtk-hooks.c. */
- struct breakpoint *dbp = (struct breakpoint *) gdbtk_deleted_bp;
- if (dbp && dbp->number == bpnum)
- b = dbp;
- else
+ nelts = sals.nelts;
+ sal = sals.sals[0];
+ free (sals.sals);
+
+ if (sals.nelts != 1)
{
- char *err_buf;
- xasprintf (&err_buf, "Breakpoint #%d does not exist.", bpnum);
- Tcl_SetStringObj (result_ptr->obj_ptr, err_buf, -1);
- free(err_buf);
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Ambiguous line spec", -1);
return TCL_ERROR;
}
+ resolve_sal_pc (&sal);
+ pc = sal.pc;
+ }
+ else
+ {
+ Tcl_WrongNumArgs (interp, 1, objv, "?symbol?");
+ return TCL_ERROR;
}
- sal = find_pc_line (b->address, 0);
+ if (sal.symtab)
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (sal.symtab->filename, -1));
+ else
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj ("", 0));
+
+ fname = pc_function_name (pc);
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (fname, -1));
filename = symtab_to_filename (sal.symtab);
if (filename == NULL)
filename = "";
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+ /* file name */
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
Tcl_NewStringObj (filename, -1));
-
- funcname = pc_function_name (b->address);
- new_obj = Tcl_NewStringObj (funcname, -1);
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
-
+ /* line number */
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewIntObj (b->line_number));
+ 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 (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));
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (bpdisp[b->disposition], -1));
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewIntObj (b->ignore_count));
-
- new_obj = Tcl_NewObj ();
- for (cmd = b->commands; cmd; cmd = cmd->next)
- Tcl_ListObjAppendElement (NULL, new_obj,
- Tcl_NewStringObj (cmd->line, -1));
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
-
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj (b->cond_string, -1));
+ paddr_nz (stop_pc));
+ /* shared library */
+#ifdef PC_SOLIB
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewIntObj (b->thread));
+ Tcl_NewStringObj (PC_SOLIB (pc), -1));
+#else
Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewIntObj (b->hit_count));
-
+ Tcl_NewStringObj ("", -1));
+#endif
return TCL_OK;
}
-
-/* This implements the tcl command gdb_get_breakpoint_list
- * It builds up a list of the current breakpoints.
- *
- * Tcl Arguments:
- * None.
- * Tcl Result:
- * A list of breakpoint numbers.
- */
+/* This implements the TCL command gdb_entry_point. It returns the current
+ entry point address. */
static int
-gdb_get_breakpoint_list (clientData, interp, objc, objv)
+gdb_entry_point (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
- struct breakpoint *b;
- extern struct breakpoint *breakpoint_chain;
- Tcl_Obj *new_obj;
+ char *addrstr;
- if (objc != 1)
+ /* If we have not yet loaded an exec file, then we have no
+ entry point, so return an empty string.*/
+ if ((int) current_target.to_stratum > (int) dummy_stratum)
{
- Tcl_WrongNumArgs (interp, 1, objv, NULL);
- return TCL_ERROR;
+ addrstr = paddr_nz (entry_point_address ());
+ Tcl_SetStringObj (result_ptr->obj_ptr, addrstr, -1);
}
-
- for (b = breakpoint_chain; b; b = b->next)
- if (b->type == bp_breakpoint)
- {
- new_obj = Tcl_NewIntObj (b->number);
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, new_obj);
- }
+ else
+ Tcl_SetStringObj (result_ptr->obj_ptr, "", -1);
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.
+/* This implements the Tcl command 'gdb_get_mem', which
+ * dumps a block of memory
+ * Arguments:
+ * gdb_get_mem addr form size nbytes bpr aschar
*
- * Tcl Arguments:
- * start - starting stack frame
- * count - number of frames to inspect
- * Tcl Result:
- * A list of function names
- */
+ * addr: address of data to dump
+ * form: a char indicating format
+ * size: size of each element; 1,2,4, or 8 bytes
+ * nbytes: the number of bytes to read
+ * bpr: bytes per row
+ * aschar: if present, an ASCII dump of the row is included. ASCHAR
+ * used for unprintable characters.
+ *
+ * Return:
+ * a list of elements followed by an optional ASCII dump */
static int
-gdb_stack (clientData, interp, objc, objv)
+gdb_get_mem (clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
- int start, count;
+ int size, asize, i, j, bc;
+ CORE_ADDR addr;
+ int nbytes, rnum, bpr;
+ long tmp;
+ char format, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
+ struct type *val_type;
- if (objc < 3)
+ if (objc < 6 || objc > 7)
{
- Tcl_WrongNumArgs (interp, 1, objv, "start count");
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "addr format size bytes bytes_per_row ?ascii_char?",
+ -1);
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj (NULL, objv[1], &start))
+ if (Tcl_GetIntFromObj (interp, objv[3], &size) != TCL_OK)
{
result_ptr->flags |= GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj (NULL, objv[2], &count))
+ else if (size <= 0)
{
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Invalid size, must be > 0", -1);
return TCL_ERROR;
}
- if (target_has_stack)
- {
- gdb_result r;
- struct frame_info *top;
- struct frame_info *fi;
-
- /* Find the outermost frame */
- r = GDB_get_current_frame (&fi);
- if (r != GDB_OK)
- return TCL_OK;
-
- while (fi != NULL)
- {
- top = fi;
- r = GDB_get_prev_frame (fi, &fi);
- if (r != GDB_OK)
- fi = NULL;
- }
-
- /* top now points to the top (outermost frame) of the
- stack, so point it to the requested start */
- start = -start;
- r = GDB_find_relative_frame (top, &start, &top);
-
- result_ptr->obj_ptr = Tcl_NewListObj (0, NULL);
- if (r != GDB_OK)
- return TCL_OK;
-
- /* 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);
- r = GDB_get_next_frame (fi, &fi);
- if (r != GDB_OK)
- break;
- }
- }
- }
-
- 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 (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)
+ if (Tcl_GetIntFromObj (interp, objv[4], &nbytes) != TCL_OK)
{
- 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 = GDBTK_SYMBOL_SOURCE_NAME (msymbol);
- funlang = SYMBOL_LANGUAGE (msymbol);
- }
- else
- {
- funname = GDBTK_SYMBOL_SOURCE_NAME (func);
- funlang = SYMBOL_LANGUAGE (func);
- }
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
}
- else
+ else if (nbytes <= 0)
{
- struct minimal_symbol *msymbol = lookup_minimal_symbol_by_pc (fi->pc);
- if (msymbol != NULL)
- {
- funname = GDBTK_SYMBOL_SOURCE_NAME (msymbol);
- funlang = SYMBOL_LANGUAGE (msymbol);
- }
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "Invalid number of bytes, must be > 0",
+ -1);
+ return TCL_ERROR;
}
- if (sal.symtab)
+ if (Tcl_GetIntFromObj (interp, objv[5], &bpr) != TCL_OK)
{
- objv[0] = Tcl_NewStringObj (funname, -1);
- Tcl_ListObjAppendElement (interp, list, objv[0]);
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ return TCL_ERROR;
}
- else
+ else if (bpr <= 0)
{
-#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 ");
- }
- printf_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]);
+ Tcl_SetStringObj (result_ptr->obj_ptr,
+ "Invalid bytes per row, must be > 0", -1);
+ return TCL_ERROR;
}
-}
-
-/* This implements the tcl command gdb_selected_frame
-
- * Returns the address of the selected frame
- * frame.
- *
- * Arguments:
- * None
- * Tcl Result:
- * The currently selected frame's address
- */
-
-static int
-gdb_selected_frame (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- char *frame;
- if (selected_frame == NULL)
- xasprintf (&frame, "%s","");
- else
- xasprintf (&frame, "0x%s", paddr_nz (FRAME_FP (selected_frame)));
-
- Tcl_SetStringObj (result_ptr->obj_ptr, frame, -1);
+ if (Tcl_GetLongFromObj (interp, objv[1], &tmp) != TCL_OK)
+ return TCL_OK;
- free(frame);
- return TCL_OK;
-}
+ addr = (CORE_ADDR) tmp;
-/* This implements the tcl command gdb_selected_block
- *
- * Returns the start and end addresses of the innermost
- * block in the selected frame.
- *
- * Arguments:
- * None
- * Tcl Result:
- * The currently selected block's start and end addresses
- */
+ format = *(Tcl_GetStringFromObj (objv[2], NULL));
+ mbuf = (char *) malloc (nbytes + 32);
+ if (!mbuf)
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Out of memory.", -1);
+ return TCL_ERROR;
+ }
-static int
-gdb_selected_block (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- char *start = NULL;
- char *end = NULL;
+ memset (mbuf, 0, nbytes + 32);
+ mptr = cptr = mbuf;
- if (selected_frame == NULL)
+ rnum = 0;
+ while (rnum < nbytes)
{
- xasprintf (&start, "%s", "");
- xasprintf (&end, "%s", "");
+ int error;
+ int num = target_read_memory_partial (addr + rnum, mbuf + rnum,
+ nbytes - rnum, &error);
+ if (num <= 0)
+ break;
+ rnum += num;
}
+
+ if (objc == 7)
+ aschar = *(Tcl_GetStringFromObj (objv[6], NULL));
else
+ aschar = 0;
+
+ switch (size)
{
- struct block *block;
- block = get_frame_block (selected_frame);
- xasprintf (&start, "0x%s", paddr_nz (BLOCK_START (block)));
- xasprintf (&end, "0x%s", paddr_nz (BLOCK_END (block)));
+ case 1:
+ val_type = builtin_type_int8;
+ asize = 'b';
+ break;
+ case 2:
+ val_type = builtin_type_int16;
+ asize = 'h';
+ break;
+ case 4:
+ val_type = builtin_type_int32;
+ asize = 'w';
+ break;
+ case 8:
+ val_type = builtin_type_int64;
+ asize = 'g';
+ break;
+ default:
+ val_type = builtin_type_int8;
+ asize = 'b';
}
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (start, -1));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (end, -1));
-
- free(start);
- free(end);
- return TCL_OK;
-}
-
-/* This implements the tcl command gdb_get_blocks
- *
- * Returns the start and end addresses for all blocks in
- * the selected frame.
- *
- * Arguments:
- * None
- * Tcl Result:
- * A list of all valid blocks in the selected_frame.
- */
-
-static int
-gdb_get_blocks (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
-{
- struct block *block;
- int nsyms, i, junk;
- struct symbol *sym;
- CORE_ADDR pc;
+ bc = 0; /* count of bytes in a row */
+ bptr = &buff[0]; /* pointer for ascii dump */
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
+ /* Build up the result as a list... */
- if (selected_frame != NULL)
+ result_ptr->flags |= GDBTK_MAKES_LIST;
+
+ for (i = 0; i < nbytes; i += size)
{
- block = get_frame_block (selected_frame);
- pc = get_frame_pc (selected_frame);
- while (block != 0)
+ if (i >= rnum)
+ {
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj ("N/A", 3));
+ if (aschar)
+ for (j = 0; j < size; j++)
+ *bptr++ = 'X';
+ }
+ else
{
- nsyms = BLOCK_NSYMS (block);
- junk = 0;
- for (i = 0; i < nsyms; i++)
+ print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
+
+ if (aschar)
{
- sym = BLOCK_SYM (block, i);
- switch (SYMBOL_CLASS (sym))
+ for (j = 0; j < size; j++)
{
- default:
- case LOC_UNDEF: /* catches errors */
- case LOC_CONST: /* constant */
- case LOC_TYPEDEF: /* local typedef */
- case LOC_LABEL: /* local label */
- case LOC_BLOCK: /* local function */
- case LOC_CONST_BYTES: /* loc. byte seq. */
- case LOC_UNRESOLVED: /* unresolved static */
- case LOC_OPTIMIZED_OUT: /* optimized out */
- junk = 1;
- break;
-
- case LOC_ARG: /* argument */
- case LOC_REF_ARG: /* reference arg */
- case LOC_REGPARM: /* register arg */
- case LOC_REGPARM_ADDR: /* indirect register arg */
- case LOC_LOCAL_ARG: /* stack arg */
- case LOC_BASEREG_ARG: /* basereg arg */
-
- case LOC_LOCAL: /* stack local */
- case LOC_BASEREG: /* basereg local */
- case LOC_STATIC: /* static */
- case LOC_REGISTER: /* register */
- junk = 0;
- break;
+ *bptr = *cptr++;
+ if (*bptr < 32 || *bptr > 126)
+ *bptr = aschar;
+ bptr++;
}
}
+ }
- /* If we found a block with locals in it, add it to the list.
- Note that the ranges of start and end address for blocks
- are exclusive, so double-check against the PC */
-
- if (!junk && pc < BLOCK_END (block))
- {
- char *addr;
-
- Tcl_Obj *elt = Tcl_NewListObj (0, NULL);
- xasprintf (&addr, "0x%s", paddr_nz (BLOCK_START (block)));
- Tcl_ListObjAppendElement (interp, elt,
- Tcl_NewStringObj (addr, -1));
- free(addr);
- xasprintf (&addr, "0x%s", paddr_nz (BLOCK_END (block)));
- Tcl_ListObjAppendElement (interp, elt,
- Tcl_NewStringObj (addr, -1));
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr, elt);
- free(addr);
- }
+ mptr += size;
+ bc += size;
- if (BLOCK_FUNCTION (block))
- break;
- else
- block = BLOCK_SUPERBLOCK (block);
+ if (aschar && (bc >= bpr))
+ {
+ /* end of row. Add it to the result and reset variables */
+ Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
+ Tcl_NewStringObj (buff, bc));
+ bc = 0;
+ bptr = &buff[0];
}
}
+ result_ptr->flags &= ~GDBTK_MAKES_LIST;
+
+ free (mbuf);
return TCL_OK;
}
+\f
-/* This implements the tcl command gdb_block_vars.
- *
- * Returns all variables valid in the specified block.
+/* This implements the tcl command "gdb_loadfile"
+ * It loads a c source file into a text widget.
*
- * Arguments:
- * The start and end addresses which identify the block.
+ * Tcl Arguments:
+ * widget: the name of the text widget to fill
+ * filename: the name of the file to load
+ * linenumbers: A boolean indicating whether or not to display line numbers.
* Tcl Result:
- * All variables defined in the given block.
+ *
*/
+/* In this routine, we will build up a "line table", i.e. a
+ * table of bits showing which lines in the source file are executible.
+ * 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
static int
-gdb_block_vars (clientData, interp, objc, objv)
- ClientData clientData;
- Tcl_Interp *interp;
- int objc;
- Tcl_Obj *CONST objv[];
+gdb_loadfile (ClientData clientData, Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[])
{
- struct block *block;
- int nsyms, i;
- struct symbol *sym;
- CORE_ADDR start, end;
+ char *file, *widget;
+ int linenumbers, ln, lnum, ltable_size;
+ FILE *fp;
+ char *ltable;
+ struct symtab *symtab;
+ struct linetable_entry *le;
+ long mtime = 0;
+ struct stat st;
+ char line[10000], line_num_buf[18];
+ char *text_argv[9];
+ Tcl_CmdInfo text_cmd;
- if (objc < 3)
+
+ if (objc != 4)
+ {
+ Tcl_WrongNumArgs(interp, 1, objv, "widget filename linenumbers");
+ return TCL_ERROR;
+ }
+
+ widget = Tcl_GetStringFromObj (objv[1], NULL);
+ if ( Tk_NameToWindow (interp, widget, Tk_MainWindow (interp)) == NULL)
{
- Tcl_WrongNumArgs (interp, 1, objv, "startAddr endAddr");
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
return TCL_ERROR;
}
- Tcl_SetListObj (result_ptr->obj_ptr, 0, NULL);
- if (selected_frame == NULL)
- return TCL_OK;
+ if (!Tcl_GetCommandInfo (interp, widget, &text_cmd))
+ {
+ Tcl_SetStringObj (result_ptr->obj_ptr, "Can't get widget command info",
+ -1);
+ return TCL_ERROR;
+ }
+
+ file = Tcl_GetStringFromObj (objv[2], NULL);
+ Tcl_GetBooleanFromObj (interp, objv[3], &linenumbers);
+
+ symtab = full_lookup_symtab (file);
+ if (!symtab)
+ {
+ Tcl_SetStringObj ( result_ptr->obj_ptr, "File not found in symtab", -1);
+ return TCL_ERROR;
+ }
- start = parse_and_eval_address (Tcl_GetStringFromObj (objv[1], NULL));
- end = parse_and_eval_address (Tcl_GetStringFromObj (objv[2], NULL));
+ 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", "",
+ RETURN_MASK_ALL);
+ return TCL_ERROR;
+ }
+
+ 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("file_times",\
+ "Source file is more recent than executable.\n");
+ }
+
- block = get_frame_block (selected_frame);
+ /* 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)
+ {
+ Tcl_SetStringObj ( result_ptr->obj_ptr, "Out of memory.", -1);
+ fclose (fp);
+ return TCL_ERROR;
+ }
+
+ memset (ltable, 0, LTABLE_SIZE);
- while (block != 0)
+ if (symtab->linetable && symtab->linetable->nitems)
{
- if (BLOCK_START (block) == start && BLOCK_END (block) == end)
- {
- nsyms = BLOCK_NSYMS (block);
- for (i = 0; i < nsyms; i++)
+ 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);
+ }
+ }
+
+ ln = 1;
+
+ line[0] = '\t';
+ text_argv[0] = widget;
+ text_argv[1] = "insert";
+ text_argv[2] = "end";
+ text_argv[5] = line;
+ text_argv[6] = "source_tag";
+ text_argv[8] = NULL;
+
+ if (linenumbers)
+ {
+ int found_carriage_return = 1;
+
+ line_num_buf[1] = '\t';
+
+ text_argv[3] = line_num_buf;
+
+ while (fgets (line + 1, 9980, fp))
+ {
+ /* Look for DOS style \r\n endings, and if found,
+ * strip off the \r. We assume (for the sake of
+ * speed) that ALL lines in the file have DOS endings,
+ * or none do.
+ */
+
+ if (found_carriage_return)
{
- sym = BLOCK_SYM (block, i);
- switch (SYMBOL_CLASS (sym))
- {
- case LOC_ARG: /* argument */
- case LOC_REF_ARG: /* reference arg */
- case LOC_REGPARM: /* register arg */
- case LOC_REGPARM_ADDR: /* indirect register arg */
- case LOC_LOCAL_ARG: /* stack arg */
- case LOC_BASEREG_ARG: /* basereg arg */
- case LOC_LOCAL: /* stack local */
- case LOC_BASEREG: /* basereg local */
- case LOC_STATIC: /* static */
- case LOC_REGISTER: /* register */
- Tcl_ListObjAppendElement (interp, result_ptr->obj_ptr,
- Tcl_NewStringObj (SYMBOL_NAME (sym),
- -1));
- break;
-
- default:
- break;
- }
+ char *p;
+
+ p = strrchr(line, '\0') - 2;
+ if (*p == '\r') {
+ *p = '\n';
+ *(p + 1) = '\0';
+ } else {
+ found_carriage_return = 0;
+ }
+ }
+
+ sprintf (line_num_buf+2, "%d", ln);
+ if (ltable[ln >> 3] & (1 << (ln % 8)))
+ {
+ line_num_buf[0] = '-';
+ text_argv[4] = "break_rgn_tag";
+ }
+ else
+ {
+ line_num_buf[0] = ' ';
+ text_argv[4] = "";
+ }
+
+ text_cmd.proc(text_cmd.clientData, interp, 7, text_argv);
+ ln++;
+ }
+ }
+ else
+ {
+ int found_carriage_return = 1;
+
+ while (fgets (line + 1, 9980, fp))
+ {
+ if (found_carriage_return) {
+ char *p;
+
+ p = strrchr(line, '\0') - 2;
+ if (*p == '\r') {
+ *p = '\n';
+ *(p + 1) = '\0';
+ } else {
+ found_carriage_return = 0;
}
+ }
+
+ if (ltable[ln >> 3] & (1 << (ln % 8)))
+ {
+ text_argv[3] = "- ";
+ text_argv[4] = "break_rgn_tag";
+ }
+ else
+ {
+ text_argv[3] = " ";
+ text_argv[4] = "";
+ }
- return TCL_OK;
+ text_cmd.proc(text_cmd.clientData, interp, 7, text_argv);
+ ln++;
}
- else if (BLOCK_FUNCTION (block))
- break;
- else
- block = BLOCK_SUPERBLOCK (block);
}
+ free (ltable);
+ fclose (fp);
return TCL_OK;
}
\f
/* the first one instead of the correct one. */
/* symtab->fullname will be NULL if the file is not available. */
-static struct symtab *
+struct symtab *
full_lookup_symtab (file)
char *file;
{
return funcname;
}
-
-static void
-setup_architecture_data ()
-{
- /* don't trust REGISTER_BYTES to be zero. */
- old_regs = xmalloc (REGISTER_BYTES + 1);
- memset (old_regs, 0, REGISTER_BYTES + 1);
-}
-
OSDN Git Service
