This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
Re: [RFA] memory window patch
- To: "Martin M. Hunt" <hunt at redhat dot com>
- Subject: Re: [RFA] memory window patch
- From: Fernando Nasser <fnasser at redhat dot com>
- Date: Fri, 09 Nov 2001 12:06:09 -0500
- CC: Insight Mailing List <insight at sources dot redhat dot com>
- Organization: Red Hat Canada
- References: <200111090111.RAA01404@cygnus.com>
"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 <hunt@redhat.com>
> * 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