From d84563bc18c4aa8aadc2e515131acb4ca40300a9 Mon Sep 17 00:00:00 2001 From: Martin Hunt Date: Mon, 5 Oct 1998 05:35:01 +0000 Subject: Sun Oct 4 22:35:47 1998 Martin M. Hunt * gdbtk-cmds.c (gdb_set_bp): Add an optional thread number. (gdb_find_bp_at_line): New function. Returns a list of bpnums at the specified line number. (gdb_find_bp_at_addr): New function. Returns a list of bpnums at an address.. --- gdb/ChangeLog-gdbtk | 8 ++++ gdb/gdbtk-cmds.c | 110 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 115 insertions(+), 3 deletions(-) (limited to 'gdb') diff --git a/gdb/ChangeLog-gdbtk b/gdb/ChangeLog-gdbtk index 022911d..8f5571e 100644 --- a/gdb/ChangeLog-gdbtk +++ b/gdb/ChangeLog-gdbtk @@ -1,3 +1,11 @@ +Sun Oct 4 22:35:47 1998 Martin M. Hunt + + * gdbtk-cmds.c (gdb_set_bp): Add an optional thread number. + (gdb_find_bp_at_line): New function. Returns a list of bpnums + at the specified line number. + (gdb_find_bp_at_addr): New function. Returns a list of bpnums + at an address.. + 1998-10-02 Keith Seitz * gdbtk-hooks.c (gdbtk_exec_file_changed): New function which handles diff --git a/gdb/gdbtk-cmds.c b/gdb/gdbtk-cmds.c index 35890be..9620da3 100644 --- a/gdb/gdbtk-cmds.c +++ b/gdb/gdbtk-cmds.c @@ -199,6 +199,8 @@ static int gdb_regnames PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST [ static int gdb_search PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[])); static int gdb_set_bp PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[])); +static int gdb_find_bp_at_line PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[])); +static int gdb_find_bp_at_addr PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST objv[])); static int gdb_stop PARAMS ((ClientData, Tcl_Interp *, int, Tcl_Obj *CONST [])); static int gdb_target_has_execution_command PARAMS ((ClientData, Tcl_Interp *, int, @@ -300,6 +302,8 @@ Gdbtk_Init (interp) Tcl_CreateObjCommand (gdbtk_interp, "gdb_search", call_wrapper, gdb_search, NULL); Tcl_CreateObjCommand (interp, "gdb_set_bp", call_wrapper, gdb_set_bp, NULL); + Tcl_CreateObjCommand (interp, "gdb_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); @@ -2770,6 +2774,7 @@ enum bpdisp { * 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. */ @@ -2783,14 +2788,14 @@ gdb_set_bp (clientData, interp, objc, objv) { struct symtab_and_line sal; - int line, flags, ret; + int line, flags, ret, thread = -1; struct breakpoint *b; char buf[64]; Tcl_DString cmd; - if (objc != 4) + if (objc != 4 && objc != 5) { - Tcl_WrongNumArgs(interp, 1, objv, "filename line type"); + Tcl_WrongNumArgs(interp, 1, objv, "filename line type [thread]"); return TCL_ERROR; } @@ -2810,6 +2815,15 @@ gdb_set_bp (clientData, interp, objc, objv) return TCL_ERROR; } + if (objc == 5) + { + if (Tcl_GetIntFromObj( interp, objv[4], &thread) == TCL_ERROR) + { + result_ptr->flags = GDBTK_IN_TCL_RESULT; + return TCL_ERROR; + } + } + sal.line = line; if (!find_line_pc (sal.symtab, sal.line, &sal.pc)) return TCL_ERROR; @@ -2820,6 +2834,7 @@ gdb_set_bp (clientData, interp, objc, objv) b->number = breakpoint_count; b->type = flags >> 2; b->disposition = flags & 3; + b->thread = thread; /* FIXME: this won't work for duplicate basenames! */ sprintf (buf, "%s:%d", basename (Tcl_GetStringFromObj ( objv[1], NULL)), line); @@ -2842,6 +2857,95 @@ gdb_set_bp (clientData, interp, objc, objv) return ret; } +/* This implements the tcl command "gdb_find_bp_at_line" + * + * Tcl Arguments: + * filename: the file in which to find the breakpoint + * line: the line number for the breakpoint + * Tcl Result: + * It returns a list of breakpoint numbers + */ + +static int +gdb_find_bp_at_line(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; + +{ + struct symtab *s; + int line; + struct breakpoint *b; + extern struct breakpoint *breakpoint_chain; + + if (objc != 3) + { + Tcl_WrongNumArgs(interp, 1, objv, "filename line"); + return TCL_ERROR; + } + + s = full_lookup_symtab (Tcl_GetStringFromObj( objv[1], NULL)); + if (s == NULL) + return TCL_ERROR; + + if (Tcl_GetIntFromObj( interp, objv[2], &line) == TCL_ERROR) + { + result_ptr->flags = GDBTK_IN_TCL_RESULT; + return TCL_ERROR; + } + + Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL); + for (b = breakpoint_chain; b; b = b->next) + if (b->line_number == line && !strcmp(b->source_file, s->filename)) + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewIntObj (b->number)); + + return TCL_OK; +} + + +/* This implements the tcl command "gdb_find_bp_at_addr" + * + * Tcl Arguments: + * addr: address + * Tcl Result: + * It returns a list of breakpoint numbers + */ + +static int +gdb_find_bp_at_addr(clientData, interp, objc, objv) + ClientData clientData; + Tcl_Interp *interp; + int objc; + Tcl_Obj *CONST objv[]; + +{ + long addr; + struct breakpoint *b; + extern struct breakpoint *breakpoint_chain; + + if (objc != 2) + { + Tcl_WrongNumArgs(interp, 1, objv, "address"); + return TCL_ERROR; + } + + if (Tcl_GetLongFromObj( interp, objv[1], &addr) == TCL_ERROR) + { + result_ptr->flags = GDBTK_IN_TCL_RESULT; + return TCL_ERROR; + } + + Tcl_SetListObj (result_ptr->obj_ptr ,0 ,NULL); + for (b = breakpoint_chain; b; b = b->next) + if (b->address == (CORE_ADDR)addr) + Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr, + Tcl_NewIntObj (b->number)); + + return TCL_OK; +} + /* This implements the tcl command gdb_get_breakpoint_info * * -- cgit v1.1