From mboxrd@z Thu Jan 1 00:00:00 1970 From: Fernando Nasser To: "Martin M. Hunt" Cc: Insight Mailing List Subject: Re: [RFA] memory window patch Date: Fri, 09 Nov 2001 09:06:00 -0000 Message-id: <3BEC0D01.717F7465@redhat.com> References: <200111090111.RAA01404@cygnus.com> X-SW-Source: 2001-q4/msg00299.html "Martin M. Hunt" wrote: > > The memory window has problems with 64-bit addresses due to the lack of > 64-bit arithmetic support in tcl. The solution is to keep addresses as strings > and have C functions do the math. > > Also, the memory window has problems with the new use of string_to_core_addr() > because if it receives an invalid or negative number, it dies. Bad function! To > avoid this we must be careful to always feed it proper hex numbers. > > While hacking around, I fixed the "go to" popup function. I also added > a label that indicates the target endianess; which is handy for those of us > who debug both big and little endian mips code and often get the two confused. > I also fixed some other minor errors. > > Oh, and I fixed more bit rot with editing so the bytes get swapped around correclty > based on the target endianess. > > -- > Martin Hunt > GDB Engineer > Red Hat, Inc. > Thank you so much Martin! Lets just see if your patch does not conflict with Keith's clean-ups before checking it in. Keith? Regards to all, Fernando > 2001-11-08 Martin M. Hunt > * generic/gdbtk-cmds.c (gdb_eval): Add an optional > format argument. > (hex2bin): Swap bytes around if target is little endian. > Fix loop count. > (gdb_incr_addr): New function to do address arithmetic. > Needed because some addresses are 64-bits and tcl can't > deal with them, except as strings. > > * library/memwin.itb (MemWin::build_win): Add a label > to indicate the target endianess. > (MemWin::edit): Use gdb_incr_addr. > (MemWin::busy): The constructor calls gdbtk_busy which > calls this before the window has finished drawing, so > don't disable items that don't exist yet. > (MemWin::update_address): Set a flag, bad_expr, if the > expression does not evaluate. Call gdb_eval with 'x' flag > to force the result to be hex. > (MemWin::BadExpr): Set bad_expr. > (MemWin::incr_addr): Use gdb_incr_addr. > (MemWin::update_addr): Return is bad_expr is set. Use > gdb_incr_addr. > (MemWin::goto): Call update_address. > * library/memwin.itb: Declare private variable bad_expr. > > * library/util.tcl (gdbtk_endian): New procedure. Returns > BIG or LITTLE to indicate target endianess. > > Index: generic/gdbtk-cmds.c > =================================================================== > RCS file: /cvs/src/src/gdb/gdbtk/generic/gdbtk-cmds.c,v > retrieving revision 1.43 > diff -u -p -r1.43 gdbtk-cmds.c > --- gdbtk-cmds.c 2001/11/05 19:42:48 1.43 > +++ gdbtk-cmds.c 2001/11/09 01:00:01 > @@ -146,6 +146,7 @@ static int gdb_get_mem (ClientData, Tcl_ > static int gdb_set_mem (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]); > static int gdb_immediate_command (ClientData, Tcl_Interp *, int, > Tcl_Obj * CONST[]); > +static int gdb_incr_addr (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]); > static int gdb_listfiles (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]); > static int gdb_listfuncs (ClientData, Tcl_Interp *, int, Tcl_Obj * CONST[]); > static int gdb_loadfile (ClientData, Tcl_Interp *, int, > @@ -237,6 +238,7 @@ Gdbtk_Init (interp) > Tcl_CreateObjCommand (interp, "gdb_disassemble", gdbtk_call_wrapper, > gdb_disassemble, NULL); > Tcl_CreateObjCommand (interp, "gdb_eval", gdbtk_call_wrapper, gdb_eval, NULL); > + Tcl_CreateObjCommand (interp, "gdb_incr_addr", gdbtk_call_wrapper, gdb_incr_addr, NULL); > Tcl_CreateObjCommand (interp, "gdb_clear_file", gdbtk_call_wrapper, > gdb_clear_file, NULL); > Tcl_CreateObjCommand (interp, "gdb_confirm_quit", gdbtk_call_wrapper, > @@ -612,31 +614,39 @@ gdb_stop (clientData, interp, objc, objv > * > * Tcl Arguments: > * expression - the expression to evaluate. > + * format - optional format character. Valid chars are: > + * o - octal > + * x - hex > + * d - decimal > + * u - unsigned decimal > + * t - binary > + * f - float > + * a - address > + * c - char > * Tcl Result: > * The result of the evaluation. > */ > > static int > -gdb_eval (clientData, interp, objc, objv) > - ClientData clientData; > - Tcl_Interp *interp; > - int objc; > - Tcl_Obj *CONST objv[]; > +gdb_eval (ClientData clientData, Tcl_Interp *interp, > + int objc, Tcl_Obj *CONST objv[]) > { > struct expression *expr; > struct cleanup *old_chain = NULL; > + int format = 0; > value_ptr val; > > - if (objc != 2) > + if (objc != 2 && objc != 3) > { > - Tcl_WrongNumArgs (interp, 1, objv, "expression"); > + Tcl_WrongNumArgs (interp, 1, objv, "expression [format]"); > return TCL_ERROR; > } > > - expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL)); > + if (objc == 3) > + format = *(Tcl_GetStringFromObj (objv[2], NULL)); > > + expr = parse_expression (Tcl_GetStringFromObj (objv[1], NULL)); > old_chain = make_cleanup (free_current_contents, &expr); > - > val = evaluate_expression (expr); > > /* > @@ -647,10 +657,9 @@ gdb_eval (clientData, interp, objc, objv > > val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), > VALUE_EMBEDDED_OFFSET (val), VALUE_ADDRESS (val), > - gdb_stdout, 0, 0, 0, 0); > + gdb_stdout, format, 0, 0, 0); > > do_cleanups (old_chain); > - > return TCL_OK; > } > > @@ -2464,11 +2473,19 @@ fromhex (int a) > static int > hex2bin (const char *hex, char *bin, int count) > { > - int i; > - int m, n; > + int i, m, n; > + int incr = 2; > > - for (i = 0; i < count; i++) > + > + if (TARGET_BYTE_ORDER == LITTLE_ENDIAN) > { > + /* need to read string in reverse */ > + hex += count - 2; > + incr = -2; > + } > + > + for (i = 0; i < count; i += 2) > + { > if (hex[0] == 0 || hex[1] == 0) > { > /* Hex string is short, or of uneven length. > @@ -2480,7 +2497,7 @@ hex2bin (const char *hex, char *bin, int > if (m == -1 || n == -1) > return -1; > *bin++ = m * 16 + n; > - hex += 2; > + hex += incr; > } > > return i; > @@ -3102,4 +3119,46 @@ gdbtk_set_result (Tcl_Interp *interp, co > va_end (args); > Tcl_SetObjResult (interp, Tcl_NewStringObj (buf, -1)); > xfree(buf); > +} > + > + > +/* This implements the tcl command 'gdb_incr_addr'. > + * It increments addresses, which must be implemented > + * this way because tcl cannot handle 64-bit values. > + * > + * Tcl Arguments: > + * addr - 32 or 64-bit address > + * number - optional number to add to the address > + * default is 1. > + * > + * Tcl Result: > + * addr + number > + */ > + > +static int > +gdb_incr_addr (ClientData clientData, Tcl_Interp *interp, > + int objc, Tcl_Obj *CONST objv[]) > +{ > + CORE_ADDR address; > + int number = 1; > + > + if (objc != 2 && objc != 3) > + { > + Tcl_WrongNumArgs (interp, 1, objv, "address [number]"); > + return TCL_ERROR; > + } > + > + address = string_to_core_addr (Tcl_GetStringFromObj (objv[1], NULL)); > + > + if (objc == 3) > + { > + if (Tcl_GetIntFromObj (interp, objv[2], &number) != TCL_OK) > + return TCL_ERROR; > + } > + > + address += number; > + > + Tcl_SetStringObj (result_ptr->obj_ptr, (char *)core_addr_to_string (address), -1); > + > + return TCL_OK; > } > Index: library/memwin.itb > =================================================================== > RCS file: /cvs/src/src/gdb/gdbtk/library/memwin.itb,v > retrieving revision 1.11 > diff -u -p -r1.11 memwin.itb > --- memwin.itb 2001/11/01 20:49:21 1.11 > +++ memwin.itb 2001/11/09 01:00:01 > @@ -153,10 +153,11 @@ body MemWin::build_win {} { > -decrement "after idle $this incr_addr 1" \ > -validate {} \ > -textbackground white > - > $itk_interior.f.cntl delete 0 end > $itk_interior.f.cntl insert end $addr_exp > > + label $itk_interior.f.endian -text "Target is [gdbtk_endian] endian" > + > balloon register [$itk_interior.f.cntl childsite].uparrow \ > "Scroll Up (Decrement Address)" > balloon register [$itk_interior.f.cntl childsite].downarrow \ > @@ -168,9 +169,9 @@ body MemWin::build_win {} { > balloon register $itk_interior.f.upd "Update Now" > checkbutton $itk_interior.cb -variable _mem($this,enabled) -command "$this toggle_enabled" > balloon register $itk_interior.cb "Toggles Automatic Display Updates" > - grid $itk_interior.f.upd $itk_interior.f.cntl -sticky ew -padx 5 > + grid $itk_interior.f.upd $itk_interior.f.cntl $itk_interior.f.endian -sticky ew -padx 5 > } else { > - grid $itk_interior.f.cntl x -sticky w > + grid $itk_interior.f.cntl x $itk_interior.f.endian -sticky e > grid columnconfigure $itk_interior.f 1 -weight 1 > } > > @@ -268,7 +269,7 @@ body MemWin::edit { cell } { > > if {$col == $Numcols} { > # editing the ASCII field > - set addr [expr {$current_addr + $bytes_per_row * $row}] > + set addr [gdb_incr_addr $current_addr + [expr {$bytes_per_row * $row}]] > set start_addr $addr > > # calculate number of rows to modify > @@ -292,7 +293,7 @@ body MemWin::edit { cell } { > return > } > } > - incr addr > + set addr [gdb_incr_addr $addr] > } > set addr $start_addr > set nextval 0 > @@ -306,21 +307,22 @@ body MemWin::edit { cell } { > } > set ${this}_memval($row,$col) [lindex $vals $nextval] > incr nextval > - incr addr $bytes_per_row > + set addr [gdb_incr_addr $addr $bytes_per_row] > incr row > } > return > } > > # calculate address based on row and column > - set addr [expr {$current_addr + $bytes_per_row * $row + $size * $col}] > - #debug " edit $row,$col [format "%x" $addr] = $val" > + set addr [gdb_incr_addr $current_addr [expr {$bytes_per_row * $row + $size * $col}]] > + #debug " edit $row,$col $addr = $val" > > # Pad the value with zeros, if necessary > set s [expr {$size * 2}] > set val [format "0x%0${s}x" $val] > > # set memory > + #debug "set_mem $addr $val $size" > if {[catch {gdb_set_mem $addr $val $size} res]} { > error_dialog $res > > @@ -409,6 +411,9 @@ body MemWin::busy {event} { > # cursor > cursor watch > > + # go away if window is not finished drawing > + if {![winfo exists $itk_interior.f.cntl]} { return } > + > # Disable menus > if {$mbar} { > for {set i 0} {$i <= [$itk_interior.m.addr index last]} {incr i} { > @@ -427,6 +432,7 @@ body MemWin::busy {event} { > # window is resized. > # ------------------------------------------------------------------ > body MemWin::newsize {height} { > + > if {$dont_size || $Running} { > return > } > @@ -459,16 +465,19 @@ body MemWin::update_address_cb {} { > # 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 > if {[string match {[a-zA-Z_&0-9\*]*} $addr_exp]} { > # Looks like an expression > - set retVal [catch {gdb_eval "$addr_exp"} current_addr] > + set retVal [catch {gdb_eval "$addr_exp" x} current_addr] > + #debug "retVal=$retVal current_addr=$current_addr" > if {$retVal || [string match "No symbol*" $current_addr] || \ > [string match "Invalid *" $current_addr]} { > BadExpr $current_addr > @@ -482,13 +491,14 @@ body MemWin::update_address { {ae ""} } > } > } elseif {[regexp {\$[a-zA-Z_]} $addr_exp]} { > # Looks like a local variable > - catch {gdb_eval "$addr_exp"} current_addr > - if {$current_addr == "No registers.\n"} { > - # we asked for a register value and debugging hasn't started yet > - return > + set retVal [catch {gdb_eval "$addr_exp" x} current_addr] > + #debug "retVal=$retVal current_addr=$current_addr" > + if {$retVal} { > + BadExpr $current_addr > + return > } > if {$current_addr == "void"} { > - BadExpr "No Local Variable Named \"$addr_ex\"" > + BadExpr "No Local Variable Named \"$addr_exp\"" > return > } > } else { > @@ -496,7 +506,7 @@ body MemWin::update_address { {ae ""} } > BadExpr "Can't Evaluate \"$addr_exp\"" > return > } > - > + > # Check for spaces > set index [string first \ $current_addr] > if {$index != -1} { > @@ -521,6 +531,7 @@ body MemWin::BadExpr {errTxt} { > $itk_interior.t config -bg gray -state disabled > set current_addr $saved_addr > set saved_addr "" > + set bad_expr 1 > } > > # ------------------------------------------------------------------ > @@ -528,18 +539,12 @@ body MemWin::BadExpr {errTxt} { > # the current address. > # ------------------------------------------------------------------ > body MemWin::incr_addr {num} { > - > if {$current_addr == ""} { > return > } > set old_addr $current_addr > + set current_addr [gdb_incr_addr $current_addr + [expr {$bytes_per_row * $num}]] > > - # You have to be careful with address calculations here, since the memory > - # space of the target may be bigger than a long, which will cause Tcl to > - # overflow. Let gdb do the calculations instead. > - > - set current_addr [gdb_cmd "printf \"%u\", $current_addr + $num * $bytes_per_row"] > - > # A memory address less than zero is probably not a good thing... > # > > @@ -558,14 +563,17 @@ body MemWin::incr_addr {num} { > > # ------------------------------------------------------------------ > # METHOD: update_addr - read in data starting at $current_addr > -# This is just a helper function for update_address. > +# This is just a helper function for update_address. > # ------------------------------------------------------------------ > body MemWin::update_addr {} { > global _mem ${this}_memval > > + if {$bad_expr} { > + return > + } > + > gdbtk_busy > set addr $current_addr > - > set row 0 > > if {$numbytes == 0} { > @@ -580,50 +588,48 @@ body MemWin::update_addr {} { > } else { > set asc "" > } > - > - # Last chance to verify addr > - if {![catch {gdb_eval $addr}]} { > - set retVal [catch {gdb_get_mem $addr $format \ > - $size $nb $bytes_per_row $asc} 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 > - debug "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 [format "0x%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 > - } > - incr addr $bytes_per_row > - incr row > + #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 > } > - # 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}] > + 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 > @@ -705,6 +711,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 > } > > # ------------------------------------------------------------------ > Index: library/memwin.ith > =================================================================== > RCS file: /cvs/src/src/gdb/gdbtk/library/memwin.ith,v > retrieving revision 1.6 > diff -u -p -r1.6 memwin.ith > --- memwin.ith 2001/06/04 15:49:53 1.6 > +++ memwin.ith 2001/11/09 01:00:01 > @@ -17,6 +17,7 @@ class MemWin { > > private { > variable saved_addr "" > + variable bad_expr 0 > variable current_addr "" > variable dont_size 0 > variable mbar 1 > Index: library/util.tcl > =================================================================== > RCS file: /cvs/src/src/gdb/gdbtk/library/util.tcl,v > retrieving revision 1.9 > diff -u -p -r1.9 util.tcl > --- util.tcl 2001/09/10 19:21:47 1.9 > +++ util.tcl 2001/11/09 01:00:01 > @@ -275,3 +275,23 @@ proc list_element_strcmp {index first se > > return [string compare $theFirst $theSecond] > } > + > +# ------------------------------------------------------------------ > +# PROC: gdbtk_endian - returns BIG or LITTLE depending on target > +# endianess > +# ------------------------------------------------------------------ > + > +proc gdbtk_endian {} { > + if {[catch {gdb_cmd "show endian"} result]} { > + return "UNKNOWN" > + } > + if {[regexp {.*big endian} $result]} { > + set result "BIG" > + } elseif {[regexp {.*little endian} $result]} { > + set result "LITTLE" > + } else { > + set result "UNKNOWN" > + } > + return $result > +} > + -- Fernando Nasser Red Hat Canada Ltd. E-Mail: fnasser@redhat.com 2323 Yonge Street, Suite #300 Toronto, Ontario M4P 2C9