From mboxrd@z Thu Jan 1 00:00:00 1970 From: "Martin M. Hunt" To: Insight Mailing List Subject: [RFA] memory window patch Date: Thu, 08 Nov 2001 17:12:00 -0000 Message-id: <200111090111.RAA01404@cygnus.com> X-SW-Source: 2001-q4/msg00298.html 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. 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 +} +