This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
[RFA] memory window patch
- To: Insight Mailing List <insight at sources dot redhat dot com>
- Subject: [RFA] memory window patch
- From: "Martin M. Hunt" <hunt at redhat dot com>
- Date: Thu, 8 Nov 2001 17:10:57 -0800
- Organization: Red Hat Inc
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 <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
+}
+