From: Fred Fish <fnf@specifix.com>
Date: Fri, 21 Jun 1996 17:03:22 +0000 (+0000)
Subject: 	* gdbtk.c (get_register): Support for printing raw formats.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3d9f68c05e795ef2985cade7323e3a66a013dfdb;p=binutils-gdb.git

	* 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.
PR 9457
---

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 2a97bd7a015..ebd1fce73b9 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 2e244480c72..22ef00c9072 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 2770166c48b..8546352f8a0 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
 }
 
 #