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]
Other format: [Raw text]

Re: [RFA] memory window patch


"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


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