From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 26555 invoked by alias); 6 Mar 2002 23:54:51 -0000 Mailing-List: contact insight-help@sources.redhat.com; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: insight-owner@sources.redhat.com Received: (qmail 26265 invoked from network); 6 Mar 2002 23:54:46 -0000 Received: from unknown (HELO cygnus.com) (205.180.230.5) by sources.redhat.com with SMTP; 6 Mar 2002 23:54:46 -0000 Received: from makita.cygnus.com (makita.cygnus.com [205.180.230.78]) by runyon.cygnus.com (8.8.7-cygnus/8.8.7) with ESMTP id PAA24453 for ; Wed, 6 Mar 2002 15:54:45 -0800 (PST) Received: from localhost (keiths@localhost) by makita.cygnus.com (8.8.8+Sun/8.6.4) with ESMTP id PAA16926 for ; Wed, 6 Mar 2002 15:54:45 -0800 (PST) X-Authentication-Warning: makita.cygnus.com: keiths owned process doing -bs Date: Wed, 06 Mar 2002 15:54:00 -0000 From: Keith Seitz X-X-Sender: To: Insight Maling List Subject: [PATCH] Memory window optimization Message-ID: MIME-Version: 1.0 Content-Type: TEXT/PLAIN; charset=US-ASCII X-SW-Source: 2002-q1/txt/msg00182.txt.bz2 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 * 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 /* 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 <> [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 "$this newsize %h" --- 141,147 ---- bind $itk_interior.t <> [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 "$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