diff options
author | Keith Seitz <keiths@redhat.com> | 2002-03-06 23:56:03 +0000 |
---|---|---|
committer | Keith Seitz <keiths@redhat.com> | 2002-03-06 23:56:03 +0000 |
commit | 146904ad3d2d417262aebeaa188d660830429ebc (patch) | |
tree | e9bd929784c6e4c675c9fd697529082e3ed6adb8 /gdb/gdbtk | |
parent | 5e8aaa3a2e25a569da649c2a9f6d67b1e81fca9c (diff) | |
download | gdb-146904ad3d2d417262aebeaa188d660830429ebc.tar.gz |
* 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.
Diffstat (limited to 'gdb/gdbtk')
-rw-r--r-- | gdb/gdbtk/ChangeLog | 21 | ||||
-rw-r--r-- | gdb/gdbtk/generic/gdbtk-cmds.c | 198 | ||||
-rw-r--r-- | gdb/gdbtk/library/memwin.itb | 122 | ||||
-rw-r--r-- | gdb/gdbtk/library/memwin.ith | 5 |
4 files changed, 205 insertions, 141 deletions
diff --git a/gdb/gdbtk/ChangeLog b/gdb/gdbtk/ChangeLog index 7adcdc52351..2cdeacd567e 100644 --- a/gdb/gdbtk/ChangeLog +++ b/gdb/gdbtk/ChangeLog @@ -1,3 +1,24 @@ +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. + 2002-03-06 Martin M. Hunt <hunt@redhat.com> * library/srcwin.itb: Don't try to set balloon help diff --git a/gdb/gdbtk/generic/gdbtk-cmds.c b/gdb/gdbtk/generic/gdbtk-cmds.c index 22f91d08e27..c24178b720b 100644 --- a/gdb/gdbtk/generic/gdbtk-cmds.c +++ b/gdb/gdbtk/generic/gdbtk-cmds.c @@ -53,6 +53,10 @@ #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; @@ -136,7 +140,7 @@ 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_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[]); @@ -221,7 +225,7 @@ Gdbtk_Init (Tcl_Interp *interp) 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); @@ -612,6 +616,8 @@ gdb_eval (ClientData clientData, Tcl_Interp *interp, struct cleanup *old_chain = NULL; int format = 0; value_ptr val; + struct ui_file *stb; + long dummy; if (objc != 2 && objc != 3) { @@ -626,15 +632,13 @@ gdb_eval (ClientData clientData, Tcl_Interp *interp, 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; @@ -2467,75 +2471,97 @@ gdb_set_mem (ClientData clientData, Tcl_Interp *interp, 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."); @@ -2556,8 +2582,8 @@ gdb_get_mem (ClientData clientData, Tcl_Interp *interp, rnum += num; } - if (objc == 7) - aschar = *(Tcl_GetStringFromObj (objv[6], NULL)); + if (objc == 8) + aschar = *(Tcl_GetStringFromObj (objv[7], NULL)); else aschar = 0; @@ -2587,35 +2613,80 @@ gdb_get_mem (ClientData clientData, Tcl_Interp *interp, 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; @@ -2623,17 +2694,30 @@ gdb_get_mem (ClientData clientData, Tcl_Interp *interp, 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 } diff --git a/gdb/gdbtk/library/memwin.itb b/gdb/gdbtk/library/memwin.itb index 2e698370ba5..53bc7b62d62 100644 --- a/gdb/gdbtk/library/memwin.itb +++ b/gdb/gdbtk/library/memwin.itb @@ -79,7 +79,7 @@ body MemWin::build_win {} { $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" @@ -141,7 +141,7 @@ body MemWin::build_win {} { 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" @@ -164,7 +164,7 @@ body MemWin::build_win {} { "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" @@ -188,7 +188,7 @@ body MemWin::build_win {} { # fill initial display if {$nb} { - update_address + _update_address 0 } if {!$mbar} { @@ -298,18 +298,7 @@ body MemWin::edit { cell } { 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 } @@ -340,7 +329,7 @@ body MemWin::edit { cell } { # 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] @@ -356,7 +345,7 @@ body MemWin::toggle_enabled {} { if {$Running} { return } if {$_mem($this,enabled)} { - update_address + _update_address 1 set bg white set state normal } else { @@ -372,7 +361,7 @@ body MemWin::toggle_enabled {} { body MemWin::update {event} { global _mem if {$_mem($this,enabled)} { - update_address + _update_address 0 } } @@ -451,7 +440,17 @@ body MemWin::newsize {height} { 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 } } @@ -460,19 +459,13 @@ body MemWin::newsize {height} { # ------------------------------------------------------------------ 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 @@ -508,8 +501,8 @@ body MemWin::update_address { {ae ""} } { 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 @@ -557,9 +550,9 @@ body MemWin::incr_addr {num} { 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 } @@ -570,71 +563,36 @@ body MemWin::incr_addr {num} { 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 } # ------------------------------------------------------------------ @@ -695,7 +653,7 @@ body MemWin::do_popup {X Y} { $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 \ @@ -713,7 +671,7 @@ body MemWin::goto { addr } { set current_addr $addr $itk_interior.f.cntl delete 0 end $itk_interior.f.cntl insert end $addr - update_address + _update_address } # ------------------------------------------------------------------ diff --git a/gdb/gdbtk/library/memwin.ith b/gdb/gdbtk/library/memwin.ith index eb350971049..356c84bbaaf 100644 --- a/gdb/gdbtk/library/memwin.ith +++ b/gdb/gdbtk/library/memwin.ith @@ -1,5 +1,5 @@ # Memory display window class definition for Insight. -# Copyright 1998, 1999, 2001 Red Hat, Inc. +# 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 @@ -37,6 +37,7 @@ class MemWin { method build_win {} method init_addr_exp {} method cursor {glyph} + method _update_address {make_busy} } public { @@ -63,7 +64,7 @@ class MemWin { method toggle_enabled {} method newsize {height} method update_address_cb {} - method update_address { {ae ""} } + method update_address {addr_exp} method BadExpr {errTxt} method incr_addr {num} method update_addr |