This is the mail archive of the insight@sources.redhat.com mailing list for the Insight project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

[RFA] memory window patch


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
+}
+


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]