This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
[PATCH] Memory window optimization
- From: Keith Seitz <keiths at redhat dot com>
- To: Insight Maling List <insight at sources dot redhat dot com>
- Date: Wed, 6 Mar 2002 15:54:44 -0800 (PST)
- Subject: [PATCH] Memory window optimization
Hi,
The following patch changes the memory window update handlers so that it
stuffs the window in C instead of tcl. This gives us about a 30-40% speed
increase in the operation of this window.
I've also changed gdb_eval so that it no longer use gdb_stdout to print
out the value. Instead it creates its own temporary memory file.
Keith
ChangeLog
2002-03-06 Keith Seitz <keiths@redhat.com>
* generic/gdbtk-cmds.c: Include "ctype.h" if available.
(gdb_get_mem): Renamed to gdb_update_mem.
(gdb_update_mem): Take array as first tcl argument. This
array will hold the data for the table, which is now stuffed
in C instead of tcl.
(gdb_eval): Use our own ui-file instead of gdb_stdout.
* library/memwin.ith (_update_address): New method.
(update_address): Address expression is no longer optional.
* library/memwin.itb (build_win): Use _update_address instead of
update_address.
(toggle_enabled): Ditto.
(newsize): Use _update_address instead of update_addr.
(update_address_cb): Use _update_address instead of update_address.
(do_popup): Likewise.
(goto): Likewise.
(incr_addr): Use _update_address instead of update_addr.
(edit): Use gdb_update_mem instead of gdb_get_mem.
(update_addr): use gdb_update_mem to do all the window updating.
Patch:
Index: generic/gdbtk-cmds.c
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-cmds.c,v
retrieving revision 1.52
diff -p -r1.52 gdbtk-cmds.c
*** generic/gdbtk-cmds.c 2002/02/11 03:21:55 1.52
--- generic/gdbtk-cmds.c 2002/03/05 20:19:08
***************
*** 53,58 ****
--- 53,62 ----
#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;
*************** static int gdb_get_function_command (Cli
*** 136,142 ****
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_set_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]);
static int gdb_immediate_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST[]);
--- 140,146 ----
Tcl_Obj * CONST objv[]);
static int gdb_get_line_command (ClientData, Tcl_Interp *, int,
Tcl_Obj * CONST objv[]);
! 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[]);
*************** Gdbtk_Init (Tcl_Interp *interp)
*** 221,227 ****
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,
NULL);
Tcl_CreateObjCommand (interp, "gdb_set_mem", gdbtk_call_wrapper, gdb_set_mem,
NULL);
--- 225,231 ----
NULL);
Tcl_CreateObjCommand (interp, "gdb_entry_point", gdbtk_call_wrapper,
gdb_entry_point, NULL);
! 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);
*************** gdb_eval (ClientData clientData, Tcl_Int
*** 612,617 ****
--- 616,623 ----
struct cleanup *old_chain = NULL;
int format = 0;
value_ptr val;
+ struct ui_file *stb;
+ long dummy;
if (objc != 2 && objc != 3)
{
*************** gdb_eval (ClientData clientData, Tcl_Int
*** 625,640 ****
expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
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.
- */
val_print (VALUE_TYPE (val), VALUE_CONTENTS (val),
VALUE_EMBEDDED_OFFSET (val), VALUE_ADDRESS (val),
! gdb_stdout, format, 0, 0, 0);
do_cleanups (old_chain);
return TCL_OK;
--- 631,644 ----
expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL));
old_chain = make_cleanup (free_current_contents, &expr);
val = evaluate_expression (expr);
+ /* "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),
! 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;
*************** gdb_set_mem (ClientData clientData, Tcl_
*** 2467,2541 ****
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 clientData, Tcl_Interp *interp,
! int objc, Tcl_Obj *CONST objv[])
{
! int size, asize, i, j, bc;
CORE_ADDR addr;
int nbytes, rnum, bpr;
! char format, buff[128], aschar, *mbuf, *mptr, *cptr, *bptr;
struct type *val_type;
! if (objc < 6 || objc > 7)
{
! Tcl_WrongNumArgs (interp, 1, objv, "addr format size bytes bytes_per_row ?ascii_char?");
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)
{
! gdbtk_set_result (interp, "Invalid size, must be > 0");
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)
{
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;
! }
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));
! format = *(Tcl_GetStringFromObj (objv[2], NULL));
! mbuf = (char *) malloc (nbytes + 32);
if (!mbuf)
{
gdbtk_set_result (interp, "Out of memory.");
--- 2471,2567 ----
return TCL_OK;
}
! /* This implements the Tcl command 'gdb_update_mem', which
! * updates a block of memory in the memory window
! *
* Arguments:
! * gdb_update_mem data addr form size nbytes bpr aschar
*
! * 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 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_update_mem (ClientData clientData, Tcl_Interp *interp,
! int objc, Tcl_Obj *CONST objv[])
{
! long dummy;
! char index[20];
CORE_ADDR addr;
int nbytes, rnum, bpr;
! 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 < 7 || objc > 8)
{
! Tcl_WrongNumArgs (interp, 1, objv, "data addr format size bytes bytes_per_row ?ascii_char?");
return TCL_ERROR;
}
! /* Get table data and link to a local variable */
! data = Tcl_GetStringFromObj (objv[1], NULL);
! if (data == NULL)
{
! gdbtk_set_result (interp, "could not get data variable");
return TCL_ERROR;
}
!
! if (Tcl_UpVar (interp, "1", data, "data", 0) != TCL_OK)
{
! gdbtk_set_result (interp, "could not link table data");
return TCL_ERROR;
}
! if (Tcl_GetIntFromObj (interp, objv[4], &size) != TCL_OK)
! return TCL_ERROR;
! else if (size <= 0)
{
! 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[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;
}
! 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[3], NULL));
! mbuf = (char *) xmalloc (nbytes + 32);
if (!mbuf)
{
gdbtk_set_result (interp, "Out of memory.");
*************** gdb_get_mem (ClientData clientData, Tcl_
*** 2556,2563 ****
rnum += num;
}
! if (objc == 7)
! aschar = *(Tcl_GetStringFromObj (objv[6], NULL));
else
aschar = 0;
--- 2582,2589 ----
rnum += num;
}
! if (objc == 8)
! aschar = *(Tcl_GetStringFromObj (objv[7], NULL));
else
aschar = 0;
*************** gdb_get_mem (ClientData clientData, Tcl_
*** 2587,2621 ****
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;
--- 2613,2692 ----
bc = 0; /* count of bytes in a row */
bptr = &buff[0]; /* pointer for ascii dump */
! /* Open a memory ui_file that we can use to print memory values */
! stb = mem_fileopen ();
! old_chain = make_cleanup_ui_file_delete (stb);
! /* 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)
{
! /* Read fewer bytes than requested */
! tmp = "N/A";
!
if (aschar)
! {
! for (j = 0; j < size; j++)
! *bptr++ = 'X';
! }
}
else
{
! /* 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++)
{
! if (isprint (*cptr))
! *bptr++ = *cptr++;
! else
! {
! *bptr++ = aschar;
! cptr++;;
! }
}
}
}
+ Tcl_SetVar2 (interp, "data", index, tmp, 0);
mptr += size;
bc += size;
*************** gdb_get_mem (ClientData clientData, Tcl_
*** 2623,2639 ****
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;
}
--- 2694,2723 ----
if (aschar && (bc >= bpr))
{
/* end of row. Add it to the result and reset variables */
! *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];
}
}
! /* 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;
! do_cleanups (old_chain);
! xfree (mbuf);
return TCL_OK;
+ #undef INDEX
}
Index: library/memwin.itb
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/memwin.itb,v
retrieving revision 1.15
diff -p -r1.15 memwin.itb
*** library/memwin.itb 2002/01/15 19:52:01 1.15
--- library/memwin.itb 2002/03/05 20:19:15
*************** body MemWin::build_win {} {
*** 79,85 ****
$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}
$m add separator
$m add command -label " Preferences..." -underline 1 \
-command "$this create_prefs"
--- 79,85 ----
$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 [code $this _update_address 1] -accelerator {Ctrl+U}
$m add separator
$m add command -label " Preferences..." -underline 1 \
-command "$this create_prefs"
*************** body MemWin::build_win {} {
*** 141,147 ****
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 resize events
bind $itk_interior <Configure> "$this newsize %h"
--- 141,147 ----
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 [code $this _update_address 1]
# bind resize events
bind $itk_interior <Configure> "$this newsize %h"
*************** body MemWin::build_win {} {
*** 164,170 ****
"Scroll Down (Increment Address)"
if {!$mbar} {
! button $itk_interior.f.upd -command "$this update_address" \
-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"
--- 164,170 ----
"Scroll Down (Increment Address)"
if {!$mbar} {
! 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"
*************** body MemWin::build_win {} {
*** 188,194 ****
# fill initial display
if {$nb} {
! update_address
}
if {!$mbar} {
--- 188,194 ----
# fill initial display
if {$nb} {
! _update_address 0
}
if {!$mbar} {
*************** body MemWin::edit { cell } {
*** 298,315 ****
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
! }
return
}
--- 298,304 ----
set addr $start_addr
set nextval 0
# now read back the data and update the widget
! catch {gdb_update_mem ${this}_memval $addr $format $size $nb $bytes_per_row $ascii_char} vals
return
}
*************** body MemWin::edit { cell } {
*** 340,346 ****
# 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
# delete whitespace in response
set val [string trimright $val]
set val [string trimleft $val]
--- 329,335 ----
# 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_update_mem $addr $format $size $size $size ""} val
# delete whitespace in response
set val [string trimright $val]
set val [string trimleft $val]
*************** body MemWin::toggle_enabled {} {
*** 356,362 ****
if {$Running} { return }
if {$_mem($this,enabled)} {
! update_address
set bg white
set state normal
} else {
--- 345,351 ----
if {$Running} { return }
if {$_mem($this,enabled)} {
! _update_address 1
set bg white
set state normal
} else {
*************** body MemWin::toggle_enabled {} {
*** 372,378 ****
body MemWin::update {event} {
global _mem
if {$_mem($this,enabled)} {
! update_address
}
}
--- 361,367 ----
body MemWin::update {event} {
global _mem
if {$_mem($this,enabled)} {
! _update_address 0
}
}
*************** body MemWin::newsize {height} {
*** 451,457 ****
set theight [winfo height $itk_interior.t]
set Numrows [expr {$theight / $rheight}]
$itk_interior.t configure -rows $Numrows
! update_addr
}
}
--- 440,456 ----
set theight [winfo height $itk_interior.t]
set Numrows [expr {$theight / $rheight}]
$itk_interior.t configure -rows $Numrows
! _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::newsize {height} {
*** 460,478 ****
# ------------------------------------------------------------------
body MemWin::update_address_cb {} {
set new_entry 1
! update_address [$itk_interior.f.cntl get]
}
# ------------------------------------------------------------------
# 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
! }
set bad_expr 0
set saved_addr $current_addr
--- 459,471 ----
# ------------------------------------------------------------------
body MemWin::update_address_cb {} {
set new_entry 1
! _update_address 1
}
# ------------------------------------------------------------------
# METHOD: update_address - update address and data displayed
# ------------------------------------------------------------------
! body MemWin::update_address {addr_exp} {
set bad_expr 0
set saved_addr $current_addr
*************** body MemWin::update_address { {ae ""} }
*** 508,515 ****
BadExpr "Can't Evaluate \"$addr_exp\""
return
}
!
! # Check for spaces
set index [string first \ $current_addr]
if {$index != -1} {
incr index -1
--- 501,508 ----
BadExpr "Can't Evaluate \"$addr_exp\""
return
}
!
! # 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
*************** body MemWin::incr_addr {num} {
*** 557,565 ****
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]
}
--- 550,558 ----
return
}
$itk_interior.t config -background white -state normal
$itk_interior.f.cntl clear
$itk_interior.f.cntl insert 0 [format "0x%x" $current_addr]
+ _update_address 1
}
*************** body MemWin::incr_addr {num} {
*** 569,640 ****
# ------------------------------------------------------------------
body MemWin::update_addr {} {
global _mem ${this}_memval
-
- if {$bad_expr} {
- return
- }
! gdbtk_busy
! set addr $current_addr
! 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
} else {
! set asc ""
}
! #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.
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
- }
# set default column width to the max in the data columns
! $itk_interior.t configure -colwidth [expr {$maxlen + 1}]
# set border column width
! $itk_interior.t width -1 [expr {$mlen + 1}]
if {$ascii} {
! # set ascii column width
! $itk_interior.t width $Numcols [expr {$maxalen + 1}]
}
-
- gdbtk_idle
}
# ------------------------------------------------------------------
--- 562,598 ----
# ------------------------------------------------------------------
body MemWin::update_addr {} {
global _mem ${this}_memval
! set row 0
if {$numbytes == 0} {
set nb [expr {$Numrows * $bytes_per_row}]
} else {
set nb $numbytes
}
if {$ascii} {
! set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row $ascii_char} vals]
!
} else {
! set retVal [catch {gdb_update_mem ${this}_memval $current_addr $format $size $nb $bytes_per_row} vals]
}
!
! if {$retVal || [llength $vals] != 3} {
BadExpr "Couldn't get memory at address: \"$addr\""
! 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 [lindex $vals 1]
!
# set border column width
! $itk_interior.t width -1 [lindex $vals 0]
!
! # set ascii column width
if {$ascii} {
! $itk_interior.t width $Numcols [lindex $vals 2]
}
}
# ------------------------------------------------------------------
*************** body MemWin::do_popup {X Y} {
*** 695,701 ****
$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"
$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 \
--- 653,659 ----
$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 [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 \
*************** body MemWin::goto { addr } {
*** 713,719 ****
set current_addr $addr
$itk_interior.f.cntl delete 0 end
$itk_interior.f.cntl insert end $addr
! update_address
}
# ------------------------------------------------------------------
--- 671,677 ----
set current_addr $addr
$itk_interior.f.cntl delete 0 end
$itk_interior.f.cntl insert end $addr
! _update_address
}
# ------------------------------------------------------------------
Index: library/memwin.ith
===================================================================
RCS file: /cvs/src/src/gdb/gdbtk/library/memwin.ith,v
retrieving revision 1.7
diff -p -r1.7 memwin.ith
*** library/memwin.ith 2001/11/19 18:43:19 1.7
--- library/memwin.ith 2002/03/05 20:19:15
***************
*** 1,5 ****
# Memory display window class definition for Insight.
! # Copyright 1998, 1999, 2001 Red Hat, Inc.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License (GPL) as published by
--- 1,5 ----
# Memory display window class definition for Insight.
! # Copyright 1998, 1999, 2001, 2002 Red Hat, Inc.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License (GPL) as published by
*************** class MemWin {
*** 37,42 ****
--- 37,43 ----
method build_win {}
method init_addr_exp {}
method cursor {glyph}
+ method _update_address {make_busy}
}
public {
*************** class MemWin {
*** 63,69 ****
method toggle_enabled {}
method newsize {height}
method update_address_cb {}
! method update_address { {ae ""} }
method BadExpr {errTxt}
method incr_addr {num}
method update_addr
--- 64,70 ----
method toggle_enabled {}
method newsize {height}
method update_address_cb {}
! method update_address {addr_exp}
method BadExpr {errTxt}
method incr_addr {num}
method update_addr