#include "dis-asm.h"
#include "gdbcmd.h"
+#ifdef HAVE_CTYPE_H
+#include <ctype.h> /* for isprint() */
+#endif
+
/* Various globals we reference. */
extern char *source_path;
Tcl_Obj * CONST objv[]);
static int gdb_get_line_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
-static int gdb_get_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
+static int gdb_update_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_set_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_immediate_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST[]);
NULL);
Tcl_CreateObjCommand (interp, "gdb_entry_point", gdbtk_call_wrapper,
gdb_entry_point, NULL);
- Tcl_CreateObjCommand (interp, "gdb_get_mem", gdbtk_call_wrapper, gdb_get_mem,
+ Tcl_CreateObjCommand (interp, "gdb_update_mem", gdbtk_call_wrapper, gdb_update_mem,
NULL);
Tcl_CreateObjCommand (interp, "gdb_set_mem", gdbtk_call_wrapper, gdb_set_mem,
NULL);
struct cleanup *old_chain = NULL;
int format = 0;
value_ptr val;
+ struct ui_file *stb;
+ long dummy;
if (objc != 2 && objc != 3)
{
old_chain = make_cleanup (free_current_contents, &expr);
val = evaluate_expression (expr);
- /*
- * Print the result of the expression evaluation. This will go to
- * eventually go to gdbtk_fputs, and from there be collected into
- * the Tcl result.
- */
-
+ /* "Print" the result of the expression evaluation. */
+ stb = mem_fileopen ();
val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
VALUE_EMBEDDED_OFFSET (val), VALUE_ADDRESS (val),
- gdb_stdout, format, 0, 0, 0);
+ stb, format, 0, 0, 0);
+ Tcl_SetObjResult (interp, Tcl_NewStringObj (ui_file_xstrdup (stb, &dummy), -1));
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
do_cleanups (old_chain);
return TCL_OK;
return TCL_OK;
}
-/* This implements the Tcl command 'gdb_get_mem', which
- * dumps a block of memory
+/* This implements the Tcl command 'gdb_update_mem', which
+ * updates a block of memory in the memory window
+ *
* Arguments:
- * gdb_get_mem addr form size nbytes bpr aschar
+ * gdb_update_mem data 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.
+ * 1 data: variable that holds table's data
+ * 2 addr: address of data to dump
+ * 3 mform: a char indicating format
+ * 4 size: size of each element; 1,2,4, or 8 bytes
+ * 5 nbytes: the number of bytes to read
+ * 6 bpr: bytes per row
+ * 7 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 */
+ * a list of three integers: {border_col_width data_col_width ascii_col_width}
+ * which can be used to set the table's column widths. */
static int
-gdb_get_mem (ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
+gdb_update_mem (ClientData clientData, Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[])
{
- int size, asize, i, j, bc;
+ long dummy;
+ char index[20];
CORE_ADDR addr;
int nbytes, rnum, bpr;
- char format, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
+ int size, asize, i, j, bc;
+ int max_ascii_len, max_val_len, max_label_len;
+ char format, aschar;
+ char *data, *tmp;
+ char buff[128], *mbuf, *mptr, *cptr, *bptr;
+ struct ui_file *stb;
struct type *val_type;
+ struct cleanup *old_chain;
+ Tcl_Obj *result;
- if (objc < 6 || objc > 7)
+ if (objc < 7 || objc > 8)
{
- Tcl_WrongNumArgs (interp, 1, objv, "addr format size bytes bytes_per_row ?ascii_char?");
+ Tcl_WrongNumArgs (interp, 1, objv, "data addr format size bytes bytes_per_row ?ascii_char?");
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj (interp, objv[3], &size) != TCL_OK)
+ /* Get table data and link to a local variable */
+ data = Tcl_GetStringFromObj (objv[1], NULL);
+ if (data == NULL)
{
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ gdbtk_set_result (interp, "could not get data variable");
return TCL_ERROR;
}
- else if (size <= 0)
+
+ if (Tcl_UpVar (interp, "1", data, "data", 0) != TCL_OK)
{
- gdbtk_set_result (interp, "Invalid size, must be > 0");
+ gdbtk_set_result (interp, "could not link table data");
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj (interp, objv[4], &nbytes) != TCL_OK)
+ if (Tcl_GetIntFromObj (interp, objv[4], &size) != TCL_OK)
+ return TCL_ERROR;
+ else if (size <= 0)
{
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
+ gdbtk_set_result (interp, "Invalid size, must be > 0");
return TCL_ERROR;
}
+
+ if (Tcl_GetIntFromObj (interp, objv[5], &nbytes) != TCL_OK)
+ return TCL_ERROR;
else if (nbytes <= 0)
{
gdbtk_set_result (interp, "Invalid number of bytes, must be > 0");
return TCL_ERROR;
}
- if (Tcl_GetIntFromObj (interp, objv[5], &bpr) != TCL_OK)
- {
- result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- return TCL_ERROR;
- }
+ if (Tcl_GetIntFromObj (interp, objv[6], &bpr) != TCL_OK)
+ return TCL_ERROR;
else if (bpr <= 0)
{
gdbtk_set_result (interp, "Invalid bytes per row, must be > 0");
return TCL_ERROR;
}
- addr = string_to_core_addr (Tcl_GetStringFromObj (objv[1], NULL));
+ tmp = Tcl_GetStringFromObj (objv[2], NULL);
+ if (tmp == NULL)
+ {
+ gdbtk_set_result (interp, "could not get address");
+ return TCL_ERROR;
+ }
+ addr = string_to_core_addr (tmp);
- format = *(Tcl_GetStringFromObj (objv[2], NULL));
- mbuf = (char *) malloc (nbytes + 32);
+ format = *(Tcl_GetStringFromObj (objv[3], NULL));
+ mbuf = (char *) xmalloc (nbytes + 32);
if (!mbuf)
{
gdbtk_set_result (interp, "Out of memory.");
rnum += num;
}
- if (objc == 7)
- aschar = *(Tcl_GetStringFromObj (objv[6], NULL));
+ if (objc == 8)
+ aschar = *(Tcl_GetStringFromObj (objv[7], NULL));
else
aschar = 0;
bc = 0; /* count of bytes in a row */
bptr = &buff[0]; /* pointer for ascii dump */
- /* Build up the result as a list... */
+ /* Open a memory ui_file that we can use to print memory values */
+ stb = mem_fileopen ();
+ old_chain = make_cleanup_ui_file_delete (stb);
- result_ptr->flags |= GDBTK_MAKES_LIST;
+ /* A little macro to do column indices. As a rule, given the current
+ byte, i, of a total nbytes and the bytes per row, bpr, and the size of
+ each cell, size, the row and column will be given by:
+
+ row = i/bpr
+ col = (i%bpr)/size
+ */
+#define INDEX(row,col) sprintf (index, "%d,%d",(row),(col))
+
+ /* Fill in address labels */
+ max_label_len = 0;
+ for (i = 0; i < nbytes; i += bpr)
+ {
+ char s[130];
+ sprintf (s, "0x%s", core_addr_to_string (addr + i));
+ INDEX ((int) i/bpr, -1);
+ Tcl_SetVar2 (interp, "data", index, s, 0);
+ /* The tcl code in MemWin::update_addr used to track the size
+ of each cell. I don't see how these could change for any given
+ update, so we don't loop over all cells. We just note the first
+ size. */
+ if (max_label_len == 0)
+ max_label_len = strlen (s);
+ }
+
+ /* Fill in memory */
+ max_val_len = 0; /* Ditto the above comments about max_label_len */
+ max_ascii_len = 0;
for (i = 0; i < nbytes; i += size)
{
+ INDEX ((int) i/bpr, (int) (i%bpr)/size);
+
if (i >= rnum)
{
- Tcl_ListObjAppendElement (NULL, result_ptr->obj_ptr,
- Tcl_NewStringObj ("N/A", 3));
+ /* Read fewer bytes than requested */
+ tmp = "N/A";
+
if (aschar)
- for (j = 0; j < size; j++)
- *bptr++ = 'X';
+ {
+ for (j = 0; j < size; j++)
+ *bptr++ = 'X';
+ }
}
else
{
- print_scalar_formatted (mptr, val_type, format, asize, gdb_stdout);
+ /* print memory to our uiout file and set the table's variable */
+ ui_file_rewind (stb);
+ print_scalar_formatted (mptr, val_type, format, asize, stb);
+ tmp = ui_file_xstrdup (stb, &dummy);
+
+ /* See comments above on max_*_len */
+ if (max_val_len == 0)
+ max_val_len = strlen (tmp);
if (aschar)
{
for (j = 0; j < size; j++)
{
- *bptr = *cptr++;
- if (*bptr < 32 || *bptr > 126)
- *bptr = aschar;
- bptr++;
+ if (isprint (*cptr))
+ *bptr++ = *cptr++;
+ else
+ {
+ *bptr++ = aschar;
+ cptr++;;
+ }
}
}
}
+ Tcl_SetVar2 (interp, "data", index, tmp, 0);
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));
+ *bptr = '\000';
+ INDEX (i/bpr, bpr/size);
+ Tcl_SetVar2 (interp, "data", index, buff, 0);
+
+ /* See comments above on max_*_len */
+ if (max_ascii_len == 0)
+ max_ascii_len = strlen (buff);
+
bc = 0;
bptr = &buff[0];
}
}
- result_ptr->flags &= ~GDBTK_MAKES_LIST;
+ /* return max_*_len so that column widths can be set */
+ result = Tcl_NewListObj (0, NULL);
+ Tcl_ListObjAppendElement (interp, result, Tcl_NewIntObj (max_label_len + 1));
+ Tcl_ListObjAppendElement (interp, result, Tcl_NewIntObj (max_val_len + 1));
+ Tcl_ListObjAppendElement (interp, result, Tcl_NewIntObj (max_ascii_len + 1));
+ result_ptr->flags |= GDBTK_IN_TCL_RESULT;
- free (mbuf);
+ do_cleanups (old_chain);
+ xfree (mbuf);
return TCL_OK;
+#undef INDEX
}
\f
$m add check -label " Auto Update" -variable _mem($this,enabled) \
-underline 1 -command "after idle $this toggle_enabled"
$m add command -label " Update Now" -underline 1 \
- -command "$this update_address" -accelerator {Ctrl+U}
+ -command [code $this _update_address 1] -accelerator {Ctrl+U}
$m add separator
$m add command -label " Preferences..." -underline 1 \
-command "$this create_prefs"
bind $itk_interior.t <<Paste>> [format {after idle %s paste %s %s} $this %x %y]
menu $itk_interior.t.menu -tearoff 0
- bind_plain_key $top Control-u "$this update_address"
+ bind_plain_key $top Control-u [code $this _update_address 1]
# bind resize events
bind $itk_interior <Configure> "$this newsize %h"
"Scroll Down (Increment Address)"
if {!$mbar} {
- button $itk_interior.f.upd -command "$this update_address" \
+ button $itk_interior.f.upd -command [code $this _update_address 1] \
-image [image create photo -file [::file join $gdb_ImageDir check.gif]]
balloon register $itk_interior.f.upd "Update Now"
checkbutton $itk_interior.cb -variable _mem($this,enabled) -command "$this toggle_enabled"
# fill initial display
if {$nb} {
- update_address
+ _update_address 0
}
if {!$mbar} {
set addr $start_addr
set nextval 0
# now read back the data and update the widget
- catch {gdb_get_mem $addr $format $size $nb $bytes_per_row $ascii_char} vals
- for {set n 0} {$n < $nb} {incr n $bytes_per_row} {
- set ${this}_memval($row,-1) [format "0x%x" $addr]
- for { set col 0 } { $col < [expr {$bytes_per_row / $size}] } { incr col } {
- set ${this}_memval($row,$col) [lindex $vals $nextval]
- incr nextval
- }
- set ${this}_memval($row,$col) [lindex $vals $nextval]
- incr nextval
- set addr [gdb_incr_addr $addr $bytes_per_row]
- incr row
- }
+ catch {gdb_update_mem ${this}_memval $addr $format $size $nb $bytes_per_row $ascii_char} vals
return
}
# line out. It will only matter if the write did not succeed, and this was
# not a very good way to tell the user about that anyway...
#
- # catch {gdb_get_mem $addr $format $size $size $size ""} val
+ # catch {gdb_update_mem $addr $format $size $size $size ""} val
# delete whitespace in response
set val [string trimright $val]
set val [string trimleft $val]
if {$Running} { return }
if {$_mem($this,enabled)} {
- update_address
+ _update_address 1
set bg white
set state normal
} else {
body MemWin::update {event} {
global _mem
if {$_mem($this,enabled)} {
- update_address
+ _update_address 0
}
}
set theight [winfo height $itk_interior.t]
set Numrows [expr {$theight / $rheight}]
$itk_interior.t configure -rows $Numrows
- update_addr
+ _update_address 1
+ }
+}
+
+body MemWin::_update_address {make_busy} {
+ if {$make_busy} {
+ gdbtk_busy
+ }
+ update_address [string trimleft [$itk_interior.f.cntl get]]
+ if {$make_busy} {
+ gdbtk_idle
}
}
# ------------------------------------------------------------------
body MemWin::update_address_cb {} {
set new_entry 1
- update_address [$itk_interior.f.cntl get]
+ _update_address 1
}
# ------------------------------------------------------------------
# METHOD: update_address - update address and data displayed
# ------------------------------------------------------------------
-body MemWin::update_address { {ae ""} } {
- debug $ae
- if {$ae == ""} {
- set addr_exp [string trimleft [$itk_interior.f.cntl get]]
- } else {
- set addr_exp $ae
- }
+body MemWin::update_address {addr_exp} {
set bad_expr 0
set saved_addr $current_addr
BadExpr "Can't Evaluate \"$addr_exp\""
return
}
-
- # Check for spaces
+
+ # Check for spaces - this can happen with gdb_eval and $pc, for example.
set index [string first \ $current_addr]
if {$index != -1} {
incr index -1
return
}
$itk_interior.t config -background white -state normal
- update_addr
$itk_interior.f.cntl clear
$itk_interior.f.cntl insert 0 [format "0x%x" $current_addr]
+ _update_address 1
}
body MemWin::update_addr {} {
global _mem ${this}_memval
- if {$bad_expr} {
- return
- }
-
- gdbtk_busy
- set addr $current_addr
- set row 0
+ set row 0
if {$numbytes == 0} {
set nb [expr {$Numrows * $bytes_per_row}]
} else {
set nb $numbytes
}
- set nextval 0
- set num [expr {$bytes_per_row / $size}]
if {$ascii} {
- set asc $ascii_char
+ set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row $ascii_char} vals]
+
} else {
- set asc ""
+ set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row} vals]
}
- #debug "get_mem $addr $format $size $nb $bytes_per_row $asc"
- set retVal [catch {gdb_get_mem $addr $format \
- $size $nb $bytes_per_row $asc} vals]
- #debug "retVal=$retVal vals=$vals"
- if {$retVal || [llength $vals] == 0} {
- # FIXME gdb_get_mem does not always return an error when addr is invalid.
+
+ if {$retVal || [llength $vals] != 3} {
BadExpr "Couldn't get memory at address: \"$addr\""
- gdbtk_idle
- dbug W "gdb_get_mem returned return code: $retVal and value: \"$vals\""
- return
- }
-
- set mlen 0
- for {set n 0} {$n < $nb} {incr n $bytes_per_row} {
- set x $addr
- if {[string length $x] > $mlen} {
- set mlen [string length $x]
- }
- set ${this}_memval($row,-1) $x
- for { set col 0 } { $col < $num } { incr col } {
- set x [lindex $vals $nextval]
- if {[string length $x] > $maxlen} {set maxlen [string length $x]}
- set ${this}_memval($row,$col) $x
- incr nextval
- }
- if {$ascii} {
- set x [lindex $vals $nextval]
- if {[string length $x] > $maxalen} {set maxalen [string length $x]}
- set ${this}_memval($row,$col) $x
- incr nextval
- }
- set addr [gdb_incr_addr $addr $bytes_per_row]
- incr row
+ debug "gdb_update_mem returned return code: $retVal and value: \"$vals\""
+ return
}
# set default column width to the max in the data columns
- $itk_interior.t configure -colwidth [expr {$maxlen + 1}]
+ $itk_interior.t configure -colwidth [lindex $vals 1]
+
# set border column width
- $itk_interior.t width -1 [expr {$mlen + 1}]
+ $itk_interior.t width -1 [lindex $vals 0]
+
+ # set ascii column width
if {$ascii} {
- # set ascii column width
- $itk_interior.t width $Numcols [expr {$maxalen + 1}]
+ $itk_interior.t width $Numcols [lindex $vals 2]
}
-
- gdbtk_idle
}
# ------------------------------------------------------------------
$itk_interior.t.menu add check -label "Auto Update" -variable _mem($this,enabled) \
-underline 0 -command "$this toggle_enabled"
$itk_interior.t.menu add command -label "Update Now" -underline 0 \
- -command "$this update_address"
+ -command [code $this _update_address 1]
$itk_interior.t.menu add command -label "Go To [$itk_interior.t curvalue]" -underline 0 \
-command "$this goto [$itk_interior.t curvalue]"
$itk_interior.t.menu add command -label "Open New Window at [$itk_interior.t curvalue]" -underline 0 \
set current_addr $addr
$itk_interior.f.cntl delete 0 end
$itk_interior.f.cntl insert end $addr
- update_address
+ _update_address
}
# ------------------------------------------------------------------
OSDN Git Service
