diff options
| -rw-r--r-- | gdb/ChangeLog | 14 | ||||
| -rw-r--r-- | gdb/gdbtk.c | 16 | ||||
| -rw-r--r-- | gdb/gdbtk.tcl | 360 |
3 files changed, 278 insertions, 112 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 2a97bd7..ebd1fce 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,17 @@ +start-sanitize-gdbtk +Fri Jun 21 09:46:47 1996 Fred Fish <fnf@fishfood.ninemoons.com> + + * gdbtk.c (get_register): Support for printing raw formats. + * gdbtk.tcl: Add hint for using debug_interface. + (center_window, add_breakpoint_frame, delete_breakpoint_frame): + Enclose arg in braces for consistency. + (create_registers_window, populate_reg_window, update_registers): + Major rewrite to support displaying multiple formats in the register window. + (init_reg_info): New function. + (recompute_reg_display_list): Reset reg_display_list, start + register display lines at line 2. + +end-sanitize-gdbtk Thu Jun 20 13:42:23 1996 Doug Evans <dje@canuck.cygnus.com> * configure.in: Revise sol-thread.o test. diff --git a/gdb/gdbtk.c b/gdb/gdbtk.c index 2e24448..22ef00c 100644 --- a/gdb/gdbtk.c +++ b/gdb/gdbtk.c @@ -631,8 +631,20 @@ get_register (regnum, fp) else memcpy (virtual_buffer, raw_buffer, REGISTER_VIRTUAL_SIZE (regnum)); - val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, - gdb_stdout, format, 1, 0, Val_pretty_default); + if (format == 'r') + { + int j; + printf_filtered ("0x"); + for (j = 0; j < REGISTER_RAW_SIZE (regnum); j++) + { + register int idx = TARGET_BYTE_ORDER == BIG_ENDIAN ? j + : REGISTER_RAW_SIZE (regnum) - 1 - j; + printf_filtered ("%02x", (unsigned char)raw_buffer[idx]); + } + } + else + val_print (REGISTER_VIRTUAL_TYPE (regnum), virtual_buffer, 0, + gdb_stdout, format, 1, 0, Val_pretty_default); Tcl_DStringAppend (result_ptr, " ", -1); } diff --git a/gdb/gdbtk.tcl b/gdb/gdbtk.tcl index 2770166..8546352 100644 --- a/gdb/gdbtk.tcl +++ b/gdb/gdbtk.tcl @@ -30,6 +30,8 @@ set disassemble_with_source nosource set expr_update_list(0) 0 set gdb_prompt "(gdb) " +# Hint: The following can be toggled from a tclsh window after +# using the gdbtk "tk tclsh" command to open the window. set debug_interface 0 #option add *Foreground Black @@ -66,7 +68,7 @@ proc decr {var {val 1}} { # # Center a window on the screen. # -proc center_window toplevel { +proc center_window {toplevel} { # Withdraw and update, to ensure geometry computations are finished. wm withdraw $toplevel update idletasks @@ -403,7 +405,7 @@ proc create_breakpoints_window {} { # Create a frame for bpnum in the .breakpoints canvas -proc add_breakpoint_frame bpnum { +proc add_breakpoint_frame {bpnum} { global bpframe_lasty global enabled global disposition @@ -502,7 +504,7 @@ proc add_breakpoint_frame bpnum { # Delete a breakpoint frame -proc delete_breakpoint_frame bpnum { +proc delete_breakpoint_frame {bpnum} { global bpframe_lasty if {![winfo exists .breakpoints]} return @@ -1764,60 +1766,148 @@ proc reg_config_menu {} { # proc create_registers_window {} { - global reg_format - if {[winfo exists .reg]} {raise .reg ; return} + # If we already have a register window, just use that one. -# Create an initial register display list consisting of all registers + if {[winfo exists .reg]} {raise .reg ; return} - if {![info exists reg_format]} { - global reg_display_list - global changed_reg_list - global regena + # Create an initial register display list consisting of all registers - set reg_format {} - set num_regs [llength [gdb_regnames]] - for {set regnum 0} {$regnum < $num_regs} {incr regnum} { - set regena($regnum) 1 - } - recompute_reg_display_list $num_regs - set changed_reg_list $reg_display_list - } + init_reg_info - build_framework .reg Registers + build_framework .reg Registers -# First, delete all the old menu entries + # First, delete all the old menu entries + + .reg.menubar.view.menu delete 0 last - .reg.menubar.view.menu delete 0 last + # Natural menu item + .reg.menubar.view.menu add checkbutton -label reg_format_natural(label) \ + -variable reg_format_natural(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} -# Hex menu item - .reg.menubar.view.menu add radiobutton -label Hex \ - -command {set reg_format x ; update_registers all} + # Decimal menu item + .reg.menubar.view.menu add checkbutton -label reg_format_decimal(label) \ + -variable reg_format_decimal(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} -# Decimal menu item - .reg.menubar.view.menu add radiobutton -label Decimal \ - -command {set reg_format d ; update_registers all} + # Hex menu item + .reg.menubar.view.menu add checkbutton -label reg_format_hex(label) \ + -variable reg_format_hex(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} -# Octal menu item - .reg.menubar.view.menu add radiobutton -label Octal \ - -command {set reg_format o ; update_registers all} + # Octal menu item + .reg.menubar.view.menu add checkbutton -label reg_format_octal(label) \ + -variable reg_format_octal(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} -# Natural menu item - .reg.menubar.view.menu add radiobutton -label Natural \ - -command {set reg_format {} ; update_registers all} + # Binary menu item + .reg.menubar.view.menu add checkbutton -label reg_format_binary(label) \ + -variable reg_format_binary(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} -# Config menu item - .reg.menubar.view.menu add separator + # Unsigned menu item + .reg.menubar.view.menu add checkbutton -label reg_format_unsigned(label) \ + -variable reg_format_unsigned(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} - .reg.menubar.view.menu add command -label Config -command { - reg_config_menu } + # Raw menu item + .reg.menubar.view.menu add checkbutton -label reg_format_raw(label) \ + -variable reg_format_raw(enable) -onvalue on -offvalue off \ + -command {update_registers redraw} - destroy .reg.label + # Config menu item + .reg.menubar.view.menu add separator -# Install the reg names + .reg.menubar.view.menu add command -label Config \ + -command { reg_config_menu } - populate_reg_window - update_registers all + destroy .reg.label + + # Install the reg names + + populate_reg_window + update_registers all +} + +proc init_reg_info {} { + global reg_format_natural + global reg_format_decimal + global reg_format_hex + global reg_format_octal + global reg_format_raw + global reg_format_binary + global reg_format_unsigned + global long_size + global double_size + + if {![info exists reg_format_hex]} { + global reg_display_list + global changed_reg_list + global regena + + set long_size [lindex [gdb_cmd {p sizeof(long)}] 2] + set double_size [lindex [gdb_cmd {p sizeof(double)}] 2] + + # The natural format may print floats or doubles as floating point, + # which typically takes more room that printing ints on the same + # machine. We assume that if longs are 8 bytes that this is + # probably a 64 bit machine. (FIXME) + set reg_format_natural(label) Natural + set reg_format_natural(enable) on + set reg_format_natural(format) {} + if {$long_size == 8} then { + set reg_format_natural(width) 25 + } else { + set reg_format_natural(width) 16 + } + + set reg_format_decimal(label) Decimal + set reg_format_decimal(enable) off + set reg_format_decimal(format) d + if {$long_size == 8} then { + set reg_format_decimal(width) 21 + } else { + set reg_format_decimal(width) 12 + } + + set reg_format_hex(label) Hex + set reg_format_hex(enable) off + set reg_format_hex(format) x + set reg_format_hex(width) [expr $long_size * 2 + 3] + + set reg_format_octal(label) Octal + set reg_format_octal(enable) off + set reg_format_octal(format) o + set reg_format_octal(width) [expr $long_size * 8 / 3 + 3] + + set reg_format_raw(label) Raw + set reg_format_raw(enable) off + set reg_format_raw(format) r + set reg_format_raw(width) [expr $double_size * 2 + 3] + + set reg_format_binary(label) Binary + set reg_format_binary(enable) off + set reg_format_binary(format) t + set reg_format_binary(width) [expr $long_size * 8 + 1] + + set reg_format_unsigned(label) Unsigned + set reg_format_unsigned(enable) off + set reg_format_unsigned(format) u + if {$long_size == 8} then { + set reg_format_unsigned(width) 21 + } else { + set reg_format_unsigned(width) 11 + } + + set num_regs [llength [gdb_regnames]] + for {set regnum 0} {$regnum < $num_regs} {incr regnum} { + set regena($regnum) 1 + } + recompute_reg_display_list $num_regs + #set changed_reg_list $reg_display_list + set changed_reg_list {} + } } # Convert regena into a list of the enabled $regnums @@ -1828,8 +1918,9 @@ proc recompute_reg_display_list {num_regs} { global regena catch {unset reg_display_list} + set reg_display_list {} - set line 1 + set line 2 for {set regnum 0} {$regnum < $num_regs} {incr regnum} { if {[set regena($regnum)] != 0} { @@ -1844,38 +1935,56 @@ proc recompute_reg_display_list {num_regs} { # reg_display_list. proc populate_reg_window {} { - global max_regname_width - global reg_display_list - - .reg.text configure -state normal - - .reg.text delete 0.0 end - + global reg_format_natural + global reg_format_decimal + global reg_format_hex + global reg_format_octal + global reg_format_raw + global reg_format_binary + global reg_format_unsigned + global max_regname_width + global reg_display_list + + set win .reg.text + $win configure -state normal + + # Clear the entire widget and insert a blank line at the top where + # the column labels will appear. + $win delete 0.0 end + $win insert end "\n" + + if {[llength $reg_display_list] > 0} { set regnames [eval gdb_regnames $reg_display_list] + } else { + set regnames {} + } -# Figure out the longest register name - - set max_regname_width 0 + # Figure out the longest register name - foreach reg $regnames { - set len [string length $reg] - if {$len > $max_regname_width} {set max_regname_width $len} - } + set max_regname_width 0 - set width [expr $max_regname_width + 15] + foreach reg $regnames { + set len [string length $reg] + if {$len > $max_regname_width} {set max_regname_width $len} + } - set height [llength $regnames] + set width [expr $max_regname_width + 15] - if {$height > 60} {set height 60} + set height [llength $regnames] - .reg.text configure -height $height -width $width + if {$height > 60} {set height 60} - foreach reg $regnames { - .reg.text insert end [format "%-*s \n" $max_regname_width ${reg}] - } + $win configure -height $height -width $width + foreach reg $regnames { + $win insert end [format "%-*s\n" $width ${reg}] + } - .reg.text yview 0 - .reg.text configure -state disabled + #Delete the blank line left at end by last insertion. + if {[llength $regnames] > 0} { + $win delete {end - 1 char} end + } + $win yview 0 + $win configure -state disabled } # @@ -1885,60 +1994,91 @@ proc populate_reg_window {} { # # Description: # -# This procedure updates the registers window. +# This procedure updates the registers window according to the value of +# the "which" arg. # proc update_registers {which} { - global max_regname_width - global reg_format - global reg_display_list - global changed_reg_list - global highlight - global regmap - - set margin [expr $max_regname_width + 1] - set win .reg.text - set winwidth [lindex [$win configure -width] 4] - set valwidth [expr $winwidth - $margin] - - $win configure -state normal - - if {$which == "all"} { - set lineindex 1 - foreach regnum $reg_display_list { - set regval [gdb_fetch_registers $reg_format $regnum] - set regval [format "%-*s" $valwidth $regval] - $win delete $lineindex.$margin "$lineindex.0 lineend" - $win insert $lineindex.$margin $regval - incr lineindex - } - $win configure -state disabled - return + global max_regname_width + global reg_format_natural + global reg_format_decimal + global reg_format_hex + global reg_format_octal + global reg_format_binary + global reg_format_unsigned + global reg_format_raw + global reg_display_list + global changed_reg_list + global highlight + global regmap + + # margin is the column where we start printing values + set margin [expr $max_regname_width + 1] + set win .reg.text + $win configure -state normal + + if {$which == "all" || $which == "redraw"} { + set display_list $reg_display_list + $win delete 1.0 1.end + $win insert 1.0 [format "%*s" $max_regname_width " "] + foreach format {natural decimal unsigned hex octal raw binary } { + set field (enable) + set var reg_format_$format$field + if {[set $var] == "on"} { + set field (label) + set var reg_format_$format$field + set label [set $var] + set field (width) + set var reg_format_$format$field + set var [format "%*s" [set $var] $label] + $win insert 1.end $var + } } - -# Unhighlight the old values - + } else { + # Unhighlight the old values foreach regnum $changed_reg_list { - $win tag delete $win.$regnum + $win tag delete $win.$regnum } - -# Now, highlight the changed values of the interesting registers - set changed_reg_list [eval gdb_changed_register_list $reg_display_list] - - set lineindex 1 + set display_list $changed_reg_list + } + foreach regnum $display_list { + set lineindex $regmap($regnum) + $win delete $lineindex.$margin "$lineindex.0 lineend" + foreach format {natural decimal unsigned hex octal raw binary } { + set field (enable) + set var reg_format_$format$field + if {[set $var] == "on"} { + set field (format) + set var reg_format_$format$field + set regval [gdb_fetch_registers [set $var] $regnum] + set field (width) + set var reg_format_$format$field + set regval [format "%*s" [set $var] $regval] + $win insert $lineindex.end $regval + } + } + } + # Now, highlight the changed values of the interesting registers + if {$which != "all"} { foreach regnum $changed_reg_list { - set regval [gdb_fetch_registers $reg_format $regnum] - set regval [format "%-*s" $valwidth $regval] - - set lineindex $regmap($regnum) - $win delete $lineindex.$margin "$lineindex.0 lineend" - $win insert $lineindex.$margin $regval - $win tag add $win.$regnum $lineindex.0 "$lineindex.0 lineend" - eval $win tag configure $win.$regnum $highlight + set lineindex $regmap($regnum) + $win tag add $win.$regnum $lineindex.0 "$lineindex.0 lineend" + eval $win tag configure $win.$regnum $highlight } - - $win configure -state disabled + } + set winwidth $margin + foreach format {natural decimal unsigned hex octal raw binary} { + set field (enable) + set var reg_format_$format$field + if {[set $var] == "on"} { + set field (width) + set var reg_format_$format$field + set winwidth [expr $winwidth + [set $var]] + } + } + $win configure -width $winwidth + $win configure -state disabled } # |