You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2972 lines
92 KiB
Plaintext
2972 lines
92 KiB
Plaintext
15 years ago
|
# Paned text widget for source code, for Insight
|
||
|
|
# Copyright (C) 1997, 1998, 1999, 2001, 2002, 2008 Red Hat, Inc.
|
||
|
|
#
|
||
|
|
# This program is free software; you can redistribute it and/or modify it
|
||
|
|
# under the terms of the GNU General Public License (GPL) as published by
|
||
|
|
# the Free Software Foundation; either version 2 of the License, or (at
|
||
|
|
# your option) any later version.
|
||
|
|
#
|
||
|
|
# This program is distributed in the hope that it will be useful,
|
||
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
|
|
# GNU General Public License for more details.
|
||
|
|
|
||
|
|
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
# Implements the paned text widget with the source code in it.
|
||
|
|
# This widget is typically embedded in a SrcWin widget.
|
||
|
|
#
|
||
|
|
# ----------------------------------------------------------------------
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# CONSTRUCTOR - create new source text window
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::constructor {args} {
|
||
|
|
eval itk_initialize $args
|
||
|
|
set top [winfo toplevel $itk_interior]
|
||
|
|
if {$parent == {}} {
|
||
|
|
set parent [winfo parent $itk_interior]
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![info exists break_images(bp)]} {
|
||
|
|
set size [font measure [pref get gdb/src/font] "W"]
|
||
|
|
set break_images(bp) [makeBreakDot $size \
|
||
|
|
[pref get gdb/src/bp_fg]]
|
||
|
|
set break_images(temp_bp) [makeBreakDot $size \
|
||
|
|
[pref get gdb/src/temp_bp_fg]]
|
||
|
|
set break_images(disabled_bp) [makeBreakDot $size \
|
||
|
|
[pref get gdb/src/disabled_fg]]
|
||
|
|
set break_images(tp) [makeBreakDot $size \
|
||
|
|
[pref get gdb/src/trace_fg]]
|
||
|
|
set break_images(thread_bp) [makeBreakDot $size \
|
||
|
|
[pref get gdb/src/thread_fg]]
|
||
|
|
set break_images(bp_and_tp) [makeBreakDot $size \
|
||
|
|
[list [pref get gdb/src/trace_fg] \
|
||
|
|
[pref get gdb/src/bp_fg]]]
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$ignore_var_balloons} {
|
||
|
|
set UseVariableBalloons 0
|
||
|
|
} else {
|
||
|
|
set UseVariableBalloons [pref get gdb/src/variableBalloons]
|
||
|
|
}
|
||
|
|
|
||
|
|
set Linenums [pref get gdb/src/linenums]
|
||
|
|
|
||
|
|
#Initialize state variables
|
||
|
|
_initialize_srctextwin
|
||
|
|
|
||
|
|
build_popups
|
||
|
|
build_win
|
||
|
|
|
||
|
|
# add hooks
|
||
|
|
if {$Tracing} {
|
||
|
|
add_hook control_mode_hook "$this set_control_mode"
|
||
|
|
add_hook gdb_trace_find_hook "$this trace_find_hook"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$UseVariableBalloons} {
|
||
|
|
add_hook gdb_idle_hook "$this updateBalloon"
|
||
|
|
}
|
||
|
|
global ${this}_balloon
|
||
|
|
trace variable ${this}_balloon w "$this trace_help"
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# DESTRUCTOR - destroy window containing widget
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::destructor {} {
|
||
|
|
if {$Tracing} {
|
||
|
|
remove_hook control_mode_hook "$this set_control_mode"
|
||
|
|
}
|
||
|
|
if {$UseVariableBalloons} {
|
||
|
|
remove_hook gdb_idle_hook "$this updateBalloon"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: trace_find_hook - response to the tfind command. All we
|
||
|
|
# need to do here is to remove the trace tags, if we are exiting
|
||
|
|
# trace mode
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::trace_find_hook {mode from_tty} {
|
||
|
|
if {[string compare $mode -1] == 0} {
|
||
|
|
if {$Browsing} {
|
||
|
|
$twin tag remove STACK_TAG 1.0 end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: set_control_mode- switches the src window between
|
||
|
|
# browsing -> mode = 1
|
||
|
|
# controlling -> mode = 0
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::set_control_mode {mode} {
|
||
|
|
# debug "Setting control mode of $twin to $mode"
|
||
|
|
if {$mode} {
|
||
|
|
set Browsing 1
|
||
|
|
} else {
|
||
|
|
set Browsing 0
|
||
|
|
}
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SOURCE {
|
||
|
|
config_win $twin
|
||
|
|
}
|
||
|
|
ASSEMBLY {
|
||
|
|
config_win $twin A
|
||
|
|
}
|
||
|
|
MIXED {
|
||
|
|
config_win $twin M
|
||
|
|
}
|
||
|
|
SRC+ASM {
|
||
|
|
config_win $twin
|
||
|
|
config_win $bwin A
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: build_popups - build the popups for the source window(s)
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
#
|
||
|
|
# The popups array holds the data for the breakpoint & tracepoint popup menus.
|
||
|
|
# The elements are:
|
||
|
|
# Menus:
|
||
|
|
# break_rgn - the popup for clicking in a bare break region
|
||
|
|
# bp - the popup for clicking on a set breakpoint
|
||
|
|
# tp - the popup for clicking on a set tracepoint
|
||
|
|
# bp_and_tp - the popup for clicking on the break_region when the
|
||
|
|
# line contains both a bp & a tp
|
||
|
|
# source - the popup for clicking on the source region of the window
|
||
|
|
#
|
||
|
|
# State:
|
||
|
|
# saved_y - the y value of the mouse click that posted the popup
|
||
|
|
# saved_win- the Tk window which recieved the posting click
|
||
|
|
#
|
||
|
|
# Disable info:
|
||
|
|
# run_disabled - a list of {menu entry} pairs for all the menus that
|
||
|
|
# should be disabled when you are not running
|
||
|
|
# browse_disabled - a similar list for menus that should be disabled
|
||
|
|
# when you are browsing a trace expt.
|
||
|
|
#
|
||
|
|
itcl::body SrcTextWin::build_popups {} {
|
||
|
|
|
||
|
|
set popups(bp) $itk_interior.bp_menu
|
||
|
|
set popups(tp) $itk_interior.tp_menu
|
||
|
|
set popups(bp_and_tp) $itk_interior.tp_bp_menu
|
||
|
|
set popups(tp_browse) $itk_interior.tp_browse_menu
|
||
|
|
set popups(break_rgn) $itk_interior.break_menu
|
||
|
|
set popups(source) $itk_interior.src_menu
|
||
|
|
set popups(disabled_bp) $itk_interior.disabled_bp_menu
|
||
|
|
|
||
|
|
# This is a scratch popup menu we use when we are not over a bp...
|
||
|
|
if {![winfo exists $popups(source)]} {
|
||
|
|
menu $popups(source) -tearoff 0
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $popups(break_rgn)]} {
|
||
|
|
# breakpoint popup menu
|
||
|
|
# don't enable hardware or conditional breakpoints until they are tested
|
||
|
|
menu $popups(break_rgn) -tearoff 0
|
||
|
|
|
||
|
|
set bp_fg [pref get gdb/src/bp_fg]
|
||
|
|
set tp_fg [pref get gdb/src/trace_fg]
|
||
|
|
|
||
|
|
if {[pref get gdb/control_target]} {
|
||
|
|
|
||
|
|
addPopup break_rgn "Continue to Here" "$this continue_to_here" \
|
||
|
|
[pref get gdb/src/PC_TAG] 0 0
|
||
|
|
addPopup break_rgn "Jump to Here" "$this jump_to_here" \
|
||
|
|
[pref get gdb/src/PC_TAG] 0 0
|
||
|
|
$popups(break_rgn) add separator
|
||
|
|
|
||
|
|
addPopup break_rgn "Set Breakpoint" "$this set_bp_at_line" $bp_fg
|
||
|
|
|
||
|
|
lappend popups(break_rgn-browse) 1
|
||
|
|
lappend popups(break_rgn-control) 1
|
||
|
|
|
||
|
|
addPopup break_rgn "Set Temporary Breakpoint" "$this set_bp_at_line T" \
|
||
|
|
[pref get gdb/src/temp_bp_fg]
|
||
|
|
|
||
|
|
addPopup break_rgn "Set Breakpoint on Thread(s)..." \
|
||
|
|
"$this ask_thread_bp" [pref get gdb/src/thread_fg] 0 0
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$Tracing} {
|
||
|
|
$popups(break_rgn) add separator
|
||
|
|
addPopup break_rgn "Set Tracepoint" "$this set_tp_at_line" $tp_fg
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $popups(bp)]} {
|
||
|
|
# this popup is used when the line contains a set breakpoint
|
||
|
|
menu $popups(bp) -tearoff 0
|
||
|
|
|
||
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
||
|
|
addPopup bp "Continue to Here" "$this continue_to_here" {} 0 0
|
||
|
|
addPopup bp "Jump to Here" "$this jump_to_here" {} 0 0
|
||
|
|
$popups(bp) add separator
|
||
|
|
|
||
|
|
addPopup bp "Disable Breakpoint" "$this enable_disable_at_line disable" \
|
||
|
|
$bp_fg
|
||
|
|
$popups(bp) add separator
|
||
|
|
}
|
||
|
|
|
||
|
|
addPopup bp "Delete Breakpoint" "$this remove_bp_at_line"
|
||
|
|
|
||
|
|
# Currently you cannot set a tracepoint and a breakpoint at the same line...
|
||
|
|
#
|
||
|
|
# if {$Tracing} {
|
||
|
|
# addPopup bp "Set Tracepoint" "$this set_tp_at_line" $tp_fg
|
||
|
|
# }
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $popups(tp)]} {
|
||
|
|
# This is the popup to use when the line contains a set tracepoint
|
||
|
|
|
||
|
|
menu $popups(tp) -tearoff 0
|
||
|
|
|
||
|
|
if {[pref get gdb/control_target]} {
|
||
|
|
|
||
|
|
addPopup tp "Continue to Here" "$this continue_to_here" green 0 0
|
||
|
|
addPopup tp "Jump to Here" "$this jump_to_here" {} 0 0
|
||
|
|
# $popups(tp) add separator
|
||
|
|
|
||
|
|
# Currently you cannot set a tracepoint and a breakpoint at the same line...
|
||
|
|
#
|
||
|
|
# addPopup tp "Set Breakpoint" "$this set_bp_at_line" $bp_fg
|
||
|
|
|
||
|
|
# addPopup tp "Set Temporary Breakpoint" "$this set_bp_at_line T" \
|
||
|
|
# [pref get gdb/src/temp_bp_fg]
|
||
|
|
|
||
|
|
# addPopup tp "Set Breakpoint on Thread(s)..." \
|
||
|
|
# "$this ask_thread_bp" \
|
||
|
|
# [pref get gdb/src/thread_fg] 0 0
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$Tracing} {
|
||
|
|
$popups(tp) add separator
|
||
|
|
addPopup tp "Modify Tracepoint" "$this set_tp_at_line" $tp_fg
|
||
|
|
addPopup tp "Delete Tracepoint" "$this remove_tp_at_line" $tp_fg
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# This is not currently used, since you can't set a bp & a tp on the same line.
|
||
|
|
# N.B. however, we don't exclude this on the command line, but...
|
||
|
|
|
||
|
|
if {![winfo exists $popups(bp_and_tp)]} {
|
||
|
|
|
||
|
|
# this popup is used when the line contains a set breakpoint & tracepoint
|
||
|
|
menu $popups(bp_and_tp) -tearoff 0
|
||
|
|
|
||
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
||
|
|
addPopup bp_and_tp "Continue to Here" "$this continue_to_here" \
|
||
|
|
green 0 0
|
||
|
|
addPopup bp_and_tp "Jump to Here" "$this jump_to_here" \
|
||
|
|
green 0 0
|
||
|
|
$popups(bp_and_tp) add separator
|
||
|
|
}
|
||
|
|
|
||
|
|
addPopup bp_and_tp "Delete Breakpoint" "$this remove_bp_at_line" $bp_fg
|
||
|
|
if {$Tracing} {
|
||
|
|
addPopup bp_and_tp "Modify Tracepoint" "$this set_tp_at_line" $tp_fg
|
||
|
|
addPopup bp_and_tp "Delete Tracepoint" \
|
||
|
|
"$this remove_tp_at_line" $tp_fg
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $popups(disabled_bp)]} {
|
||
|
|
menu $popups(disabled_bp) -tearoff 0
|
||
|
|
|
||
|
|
addPopup disabled_bp "Enable Breakpoint" \
|
||
|
|
"$this enable_disable_at_line enable" $bp_fg
|
||
|
|
|
||
|
|
$popups(disabled_bp) add separator
|
||
|
|
addPopup disabled_bp "Delete Breakpoint" "$this remove_bp_at_line"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {![winfo exists $popups(tp_browse)]} {
|
||
|
|
|
||
|
|
# this popup is on a tracepoint when browsing.
|
||
|
|
|
||
|
|
menu $popups(tp_browse) -tearoff 0
|
||
|
|
addPopup tp_browse "Next hit Here" "$this next_hit_at_line" \
|
||
|
|
green
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: build_win - build the main source paned window
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::build_win {} {
|
||
|
|
cyg::panedwindow $itk_interior.p
|
||
|
|
|
||
|
|
set _tpane pane$filenum
|
||
|
|
incr filenum
|
||
|
|
|
||
|
|
$itk_interior.p add $_tpane
|
||
|
|
set pane1 [$itk_interior.p childsite $_tpane]
|
||
|
|
set Stwc(gdbtk_scratch_widget:pane) $_tpane
|
||
|
|
set Stwc(gdbtk_scratch_widget:dirty) 0
|
||
|
|
|
||
|
|
set twinp [iwidgets::scrolledtext $pane1.st \
|
||
|
|
-hscrollmode dynamic -vscrollmode dynamic]
|
||
|
|
set twin [$twinp component text]
|
||
|
|
pack $twinp -fill both -expand yes
|
||
|
|
pack $itk_interior.p -fill both -expand yes
|
||
|
|
config_win $twin
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: SetRunningState - set state based on if GDB is running or not.
|
||
|
|
# This disables the popup menus when GDB is not running yet.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::SetRunningState {state} {
|
||
|
|
# debug "$state"
|
||
|
|
foreach elem $popups(run_disabled) {
|
||
|
|
$popups([lindex $elem 0]) entryconfigure [lindex $elem 1] -state $state
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: enable - enable or disable bindings and change cursor
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::enable {on} {
|
||
|
|
if {$on} {
|
||
|
|
set Running 0
|
||
|
|
set glyph ""
|
||
|
|
set bnd ""
|
||
|
|
set status normal
|
||
|
|
} else {
|
||
|
|
set Running 1
|
||
|
|
set glyph watch
|
||
|
|
set bnd "break"
|
||
|
|
set status disabled
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[winfo exists $twin]} {
|
||
|
|
bind $twin <B1-Motion> $bnd
|
||
|
|
bind $twin <Double-1> $bnd
|
||
|
|
bind $twin <Triple-1> $bnd
|
||
|
|
enable_disable_src_tags $twin $status
|
||
|
|
$twin configure -cursor $glyph
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$bwin != ""} {
|
||
|
|
bind $bwin <B1-Motion> $bnd
|
||
|
|
bind $bwin <Double-1> $bnd
|
||
|
|
bind $bwin <Triple-1> $bnd
|
||
|
|
enable_disable_src_tags $bwin $status
|
||
|
|
$bwin configure -cursor $glyph
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PROC: makeBreakDot - make the break dot for the screen
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::makeBreakDot {size colorList {image {}}} {
|
||
|
|
if {$size > 32} {
|
||
|
|
set size 32
|
||
|
|
} elseif {$size < 1} {
|
||
|
|
set size 1
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$image == ""} {
|
||
|
|
set image [image create photo -width $size -height $size]
|
||
|
|
} else {
|
||
|
|
$image blank
|
||
|
|
$image configure -width $size -height $size
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[llength $colorList] == 1} {
|
||
|
|
set x1 1
|
||
|
|
set x2 [expr {1 + $size}]
|
||
|
|
set y1 1
|
||
|
|
set y2 $x2
|
||
|
|
$image put $colorList -to 1 1 $x2 $y2
|
||
|
|
} else {
|
||
|
|
set x1 1
|
||
|
|
set x3 [expr {1 + $size}]
|
||
|
|
set x2 [expr int((1 + $size)/2)]
|
||
|
|
set y1 1
|
||
|
|
set y2 $x3
|
||
|
|
$image put [lindex $colorList 0] -to 1 1 $x2 $y2
|
||
|
|
$image put [lindex $colorList 1] -to [expr $x2 + 1] 1 $x3 $y2
|
||
|
|
}
|
||
|
|
|
||
|
|
return $image
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: setTabs - set the tabs for the assembly/src windows
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::setTabs {win {asm S}} {
|
||
|
|
set fsize [font measure [pref get gdb/src/font] "W"]
|
||
|
|
set tsize [pref get gdb/src/tab_size]
|
||
|
|
set rest ""
|
||
|
|
|
||
|
|
if {[string compare $asm "S"] != 0} {
|
||
|
|
set first [expr {$fsize * 12}]
|
||
|
|
set second [expr {$fsize * 13}]
|
||
|
|
set third [expr {$fsize * 34}]
|
||
|
|
for {set i 1} {$i < 8} {incr i} {
|
||
|
|
lappend rest [expr {(34 + ($i * $tsize)) * $fsize}] left
|
||
|
|
}
|
||
|
|
set tablist [concat [list $first right $second left $third left] $rest]
|
||
|
|
} else {
|
||
|
|
# SOURCE window
|
||
|
|
# The first tab right-justifies the line numbers and the second
|
||
|
|
# tab is the left margin for the start on the source code. The remaining
|
||
|
|
# tabs should be regularly spaced depending on prefs.
|
||
|
|
if {$Linenums} {
|
||
|
|
set first [expr {$fsize * 6}] ;# "- " plus 4 digit line number
|
||
|
|
set second [expr {$fsize * 7}] ;# plus a space after the number
|
||
|
|
for {set i 1} {$i < 8} {incr i} {
|
||
|
|
lappend rest [expr {(7 + ($i * $tsize)) * $fsize}] left
|
||
|
|
}
|
||
|
|
set tablist [concat [list $first right $second left] $rest]
|
||
|
|
} else {
|
||
|
|
set first [expr {$fsize * 2}]
|
||
|
|
for {set i 1} {$i < 8} {incr i} {
|
||
|
|
lappend rest [expr {(2 + ($i * $tsize)) * $fsize}] left
|
||
|
|
}
|
||
|
|
set tablist [concat [list $first left] $rest]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$win configure -tabs $tablist
|
||
|
|
}
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::enable_disable_src_tags {win how} {
|
||
|
|
|
||
|
|
switch $how {
|
||
|
|
normal {
|
||
|
|
set cur1 dot
|
||
|
|
set cur2 xterm
|
||
|
|
}
|
||
|
|
disabled {
|
||
|
|
set cur1 watch
|
||
|
|
set cur2 $cur1
|
||
|
|
}
|
||
|
|
browse {
|
||
|
|
set cur1 dot
|
||
|
|
set cur2 xterm
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[string compare $how browse] == 0} {
|
||
|
|
|
||
|
|
$win tag bind break_rgn_tag <Enter> { }
|
||
|
|
$win tag bind break_rgn_tag <Leave> { }
|
||
|
|
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Enter> { }
|
||
|
|
$win tag bind ${type}_tag <Motion> { }
|
||
|
|
$win tag bind ${type}_tag <Leave> { }
|
||
|
|
}
|
||
|
|
|
||
|
|
} else {
|
||
|
|
|
||
|
|
$win tag bind break_rgn_tag <Enter> "$win config -cursor $cur1"
|
||
|
|
$win tag bind break_rgn_tag <Leave> "$win config -cursor $cur2"
|
||
|
|
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Enter> "$win config -cursor $cur1"
|
||
|
|
$win tag bind ${type}_tag <Motion> "$this motion bp %W %x %y"
|
||
|
|
$win tag bind ${type}_tag <Leave> \
|
||
|
|
"$this cancelMotion;$win config -cursor $cur2"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$win tag bind tp_tag <Enter> "$win config -cursor $cur1"
|
||
|
|
$win tag bind tp_tag <Motion> "$this motion bp %W %x %y"
|
||
|
|
$win tag bind tp_tag <Leave> "$this cancelMotion;$win config -cursor $cur2"
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: config_win - configure the source or assembly text window
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::config_win {win {asm S}} {
|
||
|
|
# debug "$win $asm Tracing=$Tracing Browsing=$Browsing"
|
||
|
|
|
||
|
|
$win config -borderwidth 2 -insertwidth 0 -wrap none
|
||
|
|
|
||
|
|
# font
|
||
|
|
set font [pref get gdb/src/font]
|
||
|
|
$win configure -font $font -bg $::Colors(textbg) -fg $::Colors(textfg)
|
||
|
|
|
||
|
|
setTabs $win $asm
|
||
|
|
|
||
|
|
# set up some tags. should probably be done differently
|
||
|
|
# !! change bg?
|
||
|
|
|
||
|
|
$win tag configure break_rgn_tag
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag configure ${type}_tag
|
||
|
|
}
|
||
|
|
$win tag configure tp_tag
|
||
|
|
$win tag configure source_tag2 -foreground [pref get gdb/src/source2_fg]
|
||
|
|
$win tag configure PC_TAG -background [pref get gdb/src/PC_TAG]
|
||
|
|
$win tag configure STACK_TAG -background [pref get gdb/src/STACK_TAG]
|
||
|
|
$win tag configure BROWSE_TAG -background [pref get gdb/src/BROWSE_TAG]
|
||
|
|
|
||
|
|
# search tag used to highlight searches
|
||
|
|
foreach option [$win tag configure sel] {
|
||
|
|
set op [lindex $option 0]
|
||
|
|
set val [lindex $option 4]
|
||
|
|
eval $win tag configure search $op $val
|
||
|
|
}
|
||
|
|
|
||
|
|
# bind mouse button 3 to the popup men
|
||
|
|
$win tag bind source_tag <Button-3> "$this do_source_popup %X %Y %x %y"
|
||
|
|
$win tag bind source_tag2 <Button-3> "$this do_source_popup %X %Y %x %y"
|
||
|
|
|
||
|
|
# bind mouse button 3 to the popup menus
|
||
|
|
if {!$Browsing} {
|
||
|
|
|
||
|
|
$win tag bind break_rgn_tag <Button-3> \
|
||
|
|
"$this do_tag_popup break_rgn %X %Y %y; break"
|
||
|
|
foreach type $bp_types {
|
||
|
|
if {$type == "disabled_bp"} then {
|
||
|
|
set tag disabled_bp
|
||
|
|
} else {
|
||
|
|
set tag bp
|
||
|
|
}
|
||
|
|
$win tag bind ${type}_tag <Button-3> \
|
||
|
|
"$this do_tag_popup $tag %X %Y %y; break"
|
||
|
|
}
|
||
|
|
$win tag bind tp_tag <Button-3> "$this do_tag_popup tp %X %Y %y; break"
|
||
|
|
$win tag bind bp_and_tp_tag <Button-3> "$this do_tag_popup bp_and_tp %X %Y %y; break"
|
||
|
|
} else {
|
||
|
|
$win tag bind tp_tag <Button-3> "$this do_tag_popup tp_browse %X %Y %y; break"
|
||
|
|
$win tag bind break_rgn_tag <Button-3> { }
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Button-3> { }
|
||
|
|
}
|
||
|
|
$win tag bind bp_and_tp_tag <Button-3> "$this do_tag_popup tp_browse %X %Y %y; break"
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# Disable printing and cut and paste keys; makes the window readonly
|
||
|
|
# We do this so we don't have to enable and disable the
|
||
|
|
# text widget everytime we want to modify it.
|
||
|
|
|
||
|
|
bind $win <Key> {if {"%A" != "{}"} {break}}
|
||
|
|
bind $win <Delete> break
|
||
|
|
bind $win <ButtonRelease-2> {break}
|
||
|
|
|
||
|
|
# GDB key bindings
|
||
|
|
# We need to explicitly ignore keys with the Alt modifier, since
|
||
|
|
# otherwise they will interfere with selecting menus on Windows.
|
||
|
|
|
||
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
||
|
|
bind_plain_key $win c "$this do_key continue; break"
|
||
|
|
bind_plain_key $win r "$this do_key run; break"
|
||
|
|
bind_plain_key $win f "$this do_key finish; break"
|
||
|
|
} else {
|
||
|
|
bind_plain_key $win n "$this do_key tfind_next; break"
|
||
|
|
bind_plain_key $win p "$this do_key tfind_prev; break"
|
||
|
|
bind_plain_key $win f "$this do_key tfind_start; break"
|
||
|
|
bind_plain_key $win l "$this do_key tfind_line; break"
|
||
|
|
bind_plain_key $win h "$this do_key tfind_tp; break"
|
||
|
|
}
|
||
|
|
bind_plain_key $win u "$this do_key up; break"
|
||
|
|
bind_plain_key $win d "$this do_key down; break"
|
||
|
|
bind_plain_key $win x "$this do_key quit; break"
|
||
|
|
|
||
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
||
|
|
if {[string compare $asm "S"] != 0} {
|
||
|
|
bind_plain_key $win s "$this do_key stepi; break"
|
||
|
|
bind_plain_key $win n "$this do_key nexti; break"
|
||
|
|
} else {
|
||
|
|
bind_plain_key $win s "$this do_key step; break"
|
||
|
|
bind_plain_key $win n "$this do_key next; break"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
bind_plain_key $win Control-h "$this do_key thread_list; break"
|
||
|
|
bind_plain_key $win Control-f "$this do_key browser; break"
|
||
|
|
bind_plain_key $win Control-d "$this do_key download; break"
|
||
|
|
bind_plain_key $win Control-p "$this do_key print"
|
||
|
|
bind_plain_key $win Control-u "$this do_key debug; break"
|
||
|
|
bind_plain_key $win Control-o [list $this do_key open]
|
||
|
|
bind_plain_key $win Control-a [list $this do_key attach]
|
||
|
|
bind_plain_key $win Control-w [code $this do_key close]
|
||
|
|
|
||
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
||
|
|
# Ctrl+F5 is another accelerator for Run
|
||
|
|
bind_plain_key $win Control-F5 "$this do_key run"
|
||
|
|
}
|
||
|
|
|
||
|
|
bind_plain_key $win Control-F11 "$this do_key debug"
|
||
|
|
bind_plain_key $win Alt-v "$win yview scroll -1 pages"
|
||
|
|
bind_plain_key $win Control-v [format {
|
||
|
|
%s yview scroll 1 pages
|
||
|
|
break
|
||
|
|
} $win]
|
||
|
|
|
||
|
|
# bind mouse button 1 to the breakpoint method or tracepoint,
|
||
|
|
# depending on the settings of the B1_behavior setting. We don't
|
||
|
|
# have to bind to bp_and_tp because that will fall through to either
|
||
|
|
# the tp or the bp tag. We have to put in the break so that we don't
|
||
|
|
# both remove & reinsert a BP when we have both a tp & a bp on the same line.
|
||
|
|
# If we are browsing, then disable Button-1
|
||
|
|
|
||
|
|
if {!$Browsing} {
|
||
|
|
if {[pref get gdb/B1_behavior]} {
|
||
|
|
$win tag bind break_rgn_tag <Button-1> "$this set_bp_at_line N $win %y; break"
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Button-1> "$this remove_bp_at_line $win %y; break"
|
||
|
|
}
|
||
|
|
$win tag bind tp_tag <Button-1> "$this set_bp_at_line N $win %y; break"
|
||
|
|
} else {
|
||
|
|
$win tag bind break_rgn_tag <Button-1> "$this set_tp_at_line $win %y; break"
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Button-1> "$this set_tp_at_line $win %y; break"
|
||
|
|
}
|
||
|
|
$win tag bind tp_tag <Button-1> "$this set_tp_at_line $win %y; break"
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
$win tag bind break_rgn_tag <Button-1> { }
|
||
|
|
foreach type $bp_types {
|
||
|
|
$win tag bind ${type}_tag <Button-1> { }
|
||
|
|
}
|
||
|
|
$win tag bind tp_tag <Button-1> { }
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# avoid special handling of double and triple clicks in break area
|
||
|
|
bind $win <Double-1> [format {
|
||
|
|
if {[lsearch [%s tag names @%%x,%%y] break_rgn_tag] >= 0} {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
} $win $win]
|
||
|
|
bind $win <Triple-1> [format {
|
||
|
|
if {[lsearch [%s tag names @%%x,%%y] break_rgn_tag] >= 0} {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
} $win $win]
|
||
|
|
|
||
|
|
# bind window shortcuts
|
||
|
|
bind_plain_key $win Control-s "$this do_key stack"
|
||
|
|
bind_plain_key $win Control-r "$this do_key registers"
|
||
|
|
bind_plain_key $win Control-m "$this do_key memory"
|
||
|
|
bind_plain_key $win Control-t "$this do_key watch"
|
||
|
|
bind_plain_key $win Control-l "$this do_key locals"
|
||
|
|
bind_plain_key $win Control-k "$this do_key kod"
|
||
|
|
if { !$Tracing } {
|
||
|
|
bind_plain_key $win Control-b "$this do_key breakpoints"
|
||
|
|
} else {
|
||
|
|
bind_plain_key $win Control-t "$this do_key tracepoints"
|
||
|
|
bind_plain_key $win Control-u "$this do_key tdump"
|
||
|
|
}
|
||
|
|
bind_plain_key $win Control-n "$this do_key console"
|
||
|
|
|
||
|
|
if {$Browsing} {
|
||
|
|
enable_disable_src_tags $win browse
|
||
|
|
} else {
|
||
|
|
enable_disable_src_tags $win normal
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$UseVariableBalloons} {
|
||
|
|
$win tag bind source_tag <Motion> "$this motion var %W %x %y"
|
||
|
|
$win tag bind source_tag <Leave> "$this cancelMotion"
|
||
|
|
}
|
||
|
|
|
||
|
|
# Up/Down arrow key bindings
|
||
|
|
bind_plain_key $win Up [list %W yview scroll -1 units]
|
||
|
|
bind_plain_key $win Down [list %W yview scroll +1 units]
|
||
|
|
|
||
|
|
# After loading a new file, focus sometimes gets lost
|
||
|
|
# so point it back to this window if it doesn't already
|
||
|
|
# point elsewhere.
|
||
|
|
if {[focus -displayof $win] == ""} {focus $win}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: addPopup - adds a popup to one of the source popup menus
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::addPopup {menu label command {abg {}} {browse 1} {run 1}} {
|
||
|
|
|
||
|
|
if {$abg == ""} {
|
||
|
|
$popups($menu) add command -label $label -command $command
|
||
|
|
} else {
|
||
|
|
$popups($menu) add command -label $label -command $command \
|
||
|
|
-activebackground $abg
|
||
|
|
}
|
||
|
|
|
||
|
|
set index [$popups($menu) index last]
|
||
|
|
if {!$run} {
|
||
|
|
lappend popups(run_disabled) [list $menu $index]
|
||
|
|
}
|
||
|
|
if {!$browse} {
|
||
|
|
lappend popups(browse_disabled) [list $menu $index]
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PUBLIC METHOD: set_variable - Handle changes in the gdb variables
|
||
|
|
# changed through the "set" gdb command.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::set_variable {event} {
|
||
|
|
set var [$event get variable]
|
||
|
|
set val [$event get value]
|
||
|
|
debug "Set hook got called with $var $val"
|
||
|
|
switch $var {
|
||
|
|
disassembly-flavor {
|
||
|
|
disassembly_changed
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: disassembly_changed - The disassembly flavor has changed,
|
||
|
|
# mark all the cached assembly windows dirty, and force the
|
||
|
|
# visible window to be redisplayed.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::disassembly_changed {} {
|
||
|
|
foreach name [array names Stwc *:pane] {
|
||
|
|
debug "Looking at $name"
|
||
|
|
set vals [split $name ,]
|
||
|
|
if {([string compare [lindex $vals 1] "A"] == 0)
|
||
|
|
|| ([string compare [lindex $vals 1] "M"] == 0)} {
|
||
|
|
debug "Setting $name to dirty"
|
||
|
|
set Stwc([lindex $vals 0]:dirty) 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[string compare $current(mode) "SOURCE"] != 0} {
|
||
|
|
location $current(tag) $current(filename) $current(funcname) $current(line) \
|
||
|
|
$current(addr) $pc(addr) $current(lib)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: reconfig - used when preferences change
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::reconfig {} {
|
||
|
|
# debug
|
||
|
|
|
||
|
|
# Make sure we redo the break images when we reconfigure
|
||
|
|
set size [font measure [pref get gdb/src/font] "W"]
|
||
|
|
makeBreakDot $size [pref get gdb/src/bp_fg] $break_images(bp)
|
||
|
|
makeBreakDot $size [pref get gdb/src/temp_bp_fg] $break_images(temp_bp)
|
||
|
|
makeBreakDot $size [pref get gdb/src/disabled_fg] $break_images(disabled_bp)
|
||
|
|
makeBreakDot $size [pref get gdb/src/trace_fg] $break_images(tp)
|
||
|
|
makeBreakDot $size \
|
||
|
|
[list [pref get gdb/src/trace_fg] [pref get gdb/src/bp_fg]] \
|
||
|
|
$break_images(bp_and_tp)
|
||
|
|
makeBreakDot $size [pref get gdb/src/thread_fg] $break_images(thread_bp)
|
||
|
|
|
||
|
|
# Tags
|
||
|
|
$twin tag configure PC_TAG -background [pref get gdb/src/PC_TAG]
|
||
|
|
$twin tag configure STACK_TAG -background [pref get gdb/src/STACK_TAG]
|
||
|
|
$twin tag configure BROWSE_TAG -background [pref get gdb/src/BROWSE_TAG]
|
||
|
|
switch $current(mode) {
|
||
|
|
SOURCE {
|
||
|
|
setTabs $twin
|
||
|
|
}
|
||
|
|
SRC+ASM {
|
||
|
|
setTabs $twin
|
||
|
|
setTabs $bwin A
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
setTabs $twin A
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Variable Balloons
|
||
|
|
if {$ignore_var_balloons} {
|
||
|
|
set balloons 0
|
||
|
|
} else {
|
||
|
|
set balloons [pref get gdb/src/variableBalloons]
|
||
|
|
}
|
||
|
|
if {$UseVariableBalloons != $balloons} {
|
||
|
|
set UseVariableBalloons $balloons
|
||
|
|
if {$UseVariableBalloons} {
|
||
|
|
$twin tag bind source_tag <Motion> "$this motion var %W %x %y"
|
||
|
|
$twin tag bind source_tag <Leave> "$this cancelMotion"
|
||
|
|
add_hook gdb_idle_hook [list $this updateBalloon]
|
||
|
|
} else {
|
||
|
|
cancelMotion
|
||
|
|
$twin tag bind source_tag <Motion> {}
|
||
|
|
$twin tag bind source_tag <Leave> {}
|
||
|
|
$twin tag remove _show_variable 1.0 end
|
||
|
|
remove_hook gdb_idle_hook [list $this updateBalloon]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Tracing Hooks
|
||
|
|
catch {remove_hook control_mode_hook "$this set_control_mode"}
|
||
|
|
catch {remove_hook gdb_trace_find_hook "$this trace_find_hook"}
|
||
|
|
if {$Tracing} {
|
||
|
|
add_hook control_mode_hook "$this set_control_mode"
|
||
|
|
add_hook gdb_trace_find_hook "$this trace_find_hook"
|
||
|
|
}
|
||
|
|
|
||
|
|
# Popup colors
|
||
|
|
|
||
|
|
# need to rewrite because of the new addPopup function
|
||
|
|
# if {$Tracing} {
|
||
|
|
# $twin.bmenu entryconfigure 0 -activebackground [pref get gdb/src/trace_fg]
|
||
|
|
# } else {
|
||
|
|
# $twin.bmenu entryconfigure 0 -activebackground [pref get gdb/src/PC_TAG]
|
||
|
|
# $twin.bmenu entryconfigure 1 -activebackground [pref get gdb/src/bp_fg]
|
||
|
|
# $twin.bmenu entryconfigure 2 -activebackground \
|
||
|
|
# [pref get gdb/src/temp_bp_fg]
|
||
|
|
# $twin.bmenu entryconfigure 3 -activebackground \
|
||
|
|
# [pref get gdb/src/thread_fg]
|
||
|
|
# }
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: updateBalloon - we have gone idle, update the balloon
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::updateBalloon {} {
|
||
|
|
|
||
|
|
set err [catch {$_balloon_var update} changed]
|
||
|
|
catch {$_balloon_var name} var
|
||
|
|
|
||
|
|
if {!$err} {
|
||
|
|
if {$changed != ""} {
|
||
|
|
# The variable's value has changed, so update the
|
||
|
|
# balloon with its new value
|
||
|
|
balloon register $twin "$var=[balloon_value $_balloon_var]" _show_variable
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::balloon_value {variable} {
|
||
|
|
|
||
|
|
catch {$variable value} value
|
||
|
|
set value [string trim $value \ \r\t\n]
|
||
|
|
|
||
|
|
# Insert the variable's type for things like ptrs, etc.
|
||
|
|
catch {$variable type} type
|
||
|
|
if {$value == "{...}"} {
|
||
|
|
set val "$type $value"
|
||
|
|
} elseif {[regexp -- {0x([0-9a-fA-F]+) <[a-zA-Z_].*} $value str]} {
|
||
|
|
set val $str
|
||
|
|
} elseif {[string first * $type] != -1} {
|
||
|
|
set val "($type) $value"
|
||
|
|
} elseif {[string first \[ $type] != -1} {
|
||
|
|
set val "$type"
|
||
|
|
} else {
|
||
|
|
set val "$value"
|
||
|
|
}
|
||
|
|
|
||
|
|
return $val
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: ClearTags - clear all tags
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::ClearTags {} {
|
||
|
|
foreach tag {PC_TAG BROWSE_TAG STACK_TAG} {
|
||
|
|
catch {
|
||
|
|
$twin tag remove $tag $current(line).2 $current(line).end
|
||
|
|
$twin tag remove $tag $pc(line).2 $pc(line).end
|
||
|
|
$twin tag remove $tag $current(asm_line).2 $current(asm_line).end
|
||
|
|
if {$bwin != ""} {
|
||
|
|
$bwin tag remove $tag $current(asm_line).2 $current(asm_line).end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: _mtime_changed - check if the modtime for a file
|
||
|
|
# has changed.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::_mtime_changed {filename} {
|
||
|
|
global gdbtk_platform
|
||
|
|
|
||
|
|
if [catch {gdb_find_file $filename} f] {
|
||
|
|
set r 1
|
||
|
|
} elseif {$f == ""} {
|
||
|
|
set r 1
|
||
|
|
} else {
|
||
|
|
if {[string compare $gdbtk_platform(os) "cygwin"] == 0} {
|
||
|
|
set f [ide_cygwin_path to_win32 $f]
|
||
|
|
}
|
||
|
|
if {[catch {file mtime $f} mtime]} {
|
||
|
|
debug "Could not stat file \"$f\" - \"$mtime\""
|
||
|
|
# The return code is not of much significance in this case
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
if {![info exists Stwc($filename:mtime)]} {
|
||
|
|
debug "no mtime. resetting to zero"
|
||
|
|
set Stwc($filename:mtime) 0
|
||
|
|
}
|
||
|
|
# debug "Stwc($filename:mtime)=$Stwc($filename:mtime); mtime=$mtime"
|
||
|
|
|
||
|
|
if {$mtime == $Stwc($filename:mtime)} {
|
||
|
|
set r 0
|
||
|
|
} else {
|
||
|
|
set r 1
|
||
|
|
set Stwc($filename:mtime) $mtime
|
||
|
|
set Stwc($filename:dirty) 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return $r
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: FillSource - fill a window with source
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::FillSource {w tagname filename funcname line addr pc_addr lib} {
|
||
|
|
global gdb_running
|
||
|
|
upvar ${w}win win
|
||
|
|
|
||
|
|
# debug "$gdb_running $tagname line=$line pc(line)=$pc(line)"
|
||
|
|
# debug "current(filename)=$current(filename) filename=$filename"
|
||
|
|
|
||
|
|
if {$filename != ""} {
|
||
|
|
# load new file if necessary
|
||
|
|
set mtime [_mtime_changed $filename]
|
||
|
|
if {[string compare $filename $current(filename)] != 0 \
|
||
|
|
|| $mode_changed || $mtime} {
|
||
|
|
if {![LoadFile $w $filename $lib $mtime]} {
|
||
|
|
# failed to find source file
|
||
|
|
dbug W "Changing to ASSEMBLY"
|
||
|
|
|
||
|
|
# We have to update this data here (it is also done by the caller)
|
||
|
|
# because we want to call mode, which calls mode_set, which calls
|
||
|
|
# location using these values.
|
||
|
|
set current(line) $line
|
||
|
|
set current(tag) $tagname
|
||
|
|
set current(addr) $addr
|
||
|
|
set current(funcname) $funcname
|
||
|
|
set current(filename) $filename
|
||
|
|
set current(lib) $lib
|
||
|
|
|
||
|
|
set oldmode SOURCE
|
||
|
|
$parent mode "" ASSEMBLY
|
||
|
|
return
|
||
|
|
}
|
||
|
|
if {$current(mode) != "SRC+ASM"} {
|
||
|
|
# reset this flag in FillAssembly for SRC+ASM mode
|
||
|
|
set mode_changed 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# debug "cf=$current(filename) pc=$pc(filename) filename=$filename"
|
||
|
|
if {$current(filename) != ""} {
|
||
|
|
if {$gdb_running && $pc(filename) == $filename} {
|
||
|
|
# set the PC tag in this file
|
||
|
|
$win tag add PC_TAG $pc(line).2 $pc(line).end
|
||
|
|
}
|
||
|
|
if {$tagname != "PC_TAG"} {
|
||
|
|
if {$gdb_running && ($pc(filename) == $filename) \
|
||
|
|
&& ($pc(line) == $line)} {
|
||
|
|
# if the tag is on the same line as the PC, set a PC tag
|
||
|
|
$win tag add PC_TAG $line.2 $line.end
|
||
|
|
} else {
|
||
|
|
$win tag add $tagname $line.2 $line.end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if {$pc(filename) == $filename && $line == 0} {
|
||
|
|
# no line specified, so show line with PC
|
||
|
|
display_line $win $pc(line)
|
||
|
|
} else {
|
||
|
|
display_line $win $line
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return
|
||
|
|
}
|
||
|
|
# no source; switch to assembly
|
||
|
|
dbug W "no source file; switch to assembly"
|
||
|
|
|
||
|
|
# We have to update this data here (it is also done by the caller)
|
||
|
|
# because we want to call mode, which calls mode_set, which calls
|
||
|
|
# location using these values.
|
||
|
|
set current(line) $line
|
||
|
|
set current(tag) $tagname
|
||
|
|
set current(addr) $addr
|
||
|
|
set current(funcname) $funcname
|
||
|
|
set current(filename) $filename
|
||
|
|
set current(lib) $lib
|
||
|
|
|
||
|
|
set oldmode $current(mode)
|
||
|
|
$parent mode "" ASSEMBLY
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: FillAssembly - fill a window with disassembled code
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::FillAssembly {w tagname filename funcname line addr pc_addr lib} {
|
||
|
|
global gdb_running
|
||
|
|
upvar ${w}win win
|
||
|
|
upvar _${w}pane pane
|
||
|
|
# debug "$win $tagname $filename $funcname $line $addr $pc_addr"
|
||
|
|
# debug "mode_changed=$mode_changed"
|
||
|
|
# debug "funcname=$funcname"
|
||
|
|
# debug "current(funcname)=$current(funcname)"
|
||
|
|
if {$funcname == ""} {
|
||
|
|
set oldpane $pane
|
||
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
$win delete 0.0 end
|
||
|
|
$win insert 0.0 "Select function name to disassemble"
|
||
|
|
if {$oldpane != "" && $oldpane != $pane} {
|
||
|
|
$itk_interior.p replace $oldpane $pane
|
||
|
|
} else {
|
||
|
|
$itk_interior.p show $pane
|
||
|
|
}
|
||
|
|
return
|
||
|
|
} elseif {$funcname != $current(funcname) || $mode_changed
|
||
|
|
|| ([info exists Stwc($addr:dirty)] && $Stwc($addr:dirty))} {
|
||
|
|
set mode_changed 0
|
||
|
|
set oldpane $pane
|
||
|
|
set result [LoadFromCache $w $addr A $lib]
|
||
|
|
if {$result == 1} {
|
||
|
|
#debug "Disassembling at $addr"
|
||
|
|
#debug "cf=$current(filename) name=$filename"
|
||
|
|
if {[catch {gdb_load_disassembly $win nosource \
|
||
|
|
[scope _map] $Cname $addr} mess]} {
|
||
|
|
# print some intelligent error message?
|
||
|
|
dbug E "Disassemble failed: $mess"
|
||
|
|
UnLoadFromCache $w $oldpane $addr A $lib
|
||
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
$win delete 0.0 end
|
||
|
|
$win insert 0.0 "$mess"
|
||
|
|
if {$oldpane != "" && $oldpane != $pane} {
|
||
|
|
$itk_interior.p replace $oldpane $pane
|
||
|
|
} else {
|
||
|
|
$itk_interior.p show $pane
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
debug "address range is $mess"
|
||
|
|
}
|
||
|
|
} elseif {$result == 0} {
|
||
|
|
debug "LoadFromCache returned 0"
|
||
|
|
} else {
|
||
|
|
# This branch should not ever happen. In assembly mode, there
|
||
|
|
# are no checks in LoadFromCache that can fail.
|
||
|
|
debug "LoadFromCache returned -1"
|
||
|
|
}
|
||
|
|
set current(filename) $filename
|
||
|
|
set do_display_breaks 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# highlight proper line number
|
||
|
|
_highlightAsmLine $win $addr $pc_addr $tagname $filename $funcname
|
||
|
|
|
||
|
|
display_line $win $current(asm_line)
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: FillMixed - fill a window with mixed source and assembly
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::FillMixed {w tagname filename funcname line addr pc_addr lib} {
|
||
|
|
global gdb_running
|
||
|
|
upvar ${w}win win
|
||
|
|
upvar _${w}pane pane
|
||
|
|
# debug "$win $tagname $filename $funcname $line $addr $pc_addr"
|
||
|
|
|
||
|
|
if {$funcname == ""} {
|
||
|
|
set oldpane $pane
|
||
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
$win delete 0.0 end
|
||
|
|
$win insert 0.0 "Select function name to disassemble"
|
||
|
|
if {$oldpane != ""} {
|
||
|
|
$itk_interior.p replace $oldpane $pane
|
||
|
|
} else {
|
||
|
|
$itk_interior.p show $pane
|
||
|
|
}
|
||
|
|
} elseif {$funcname != $current(funcname) || $mode_changed
|
||
|
|
|| ([info exists Stwc($funcname:dirty)] && $Stwc($funcname:dirty))} {
|
||
|
|
set mode_changed 0
|
||
|
|
set oldpane $pane
|
||
|
|
if {[LoadFromCache $w $funcname M $lib]} {
|
||
|
|
# debug "Disassembling at $addr"
|
||
|
|
if {[catch {gdb_load_disassembly $win source \
|
||
|
|
[scope _map] $Cname $addr} mess] } {
|
||
|
|
# print some intelligent error message
|
||
|
|
dbug W "Disassemble Failed: $mess"
|
||
|
|
UnLoadFromCache $w $oldpane $funcname M $lib
|
||
|
|
set current(line) $line
|
||
|
|
set current(tag) $tagname
|
||
|
|
set current(addr) $addr
|
||
|
|
set current(funcname) $funcname
|
||
|
|
set current(filename) $filename
|
||
|
|
set current(lib) $lib
|
||
|
|
set oldmode MIXED
|
||
|
|
$parent mode "" ASSEMBLY
|
||
|
|
return
|
||
|
|
} else {
|
||
|
|
debug "address range is $mess"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set current(filename) $filename
|
||
|
|
# now set the breakpoints
|
||
|
|
set do_display_breaks 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# highlight proper line number
|
||
|
|
_highlightAsmLine $win $addr $pc_addr $tagname $filename $funcname
|
||
|
|
display_line $win $current(asm_line)
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: _highlightAsmLine - highlight the current execution line
|
||
|
|
# in one of the assembly modes
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::_highlightAsmLine {win addr pc_addr \
|
||
|
|
tagname filename funcname} {
|
||
|
|
global gdb_running
|
||
|
|
|
||
|
|
# Some architectures allow multiple instructions in each asm source
|
||
|
|
# line...
|
||
|
|
if {[info exists _map($Cname,pc=$addr)]} {
|
||
|
|
set current(asm_line) $_map($Cname,pc=$addr)
|
||
|
|
} else {
|
||
|
|
set x [gdb_incr_addr $current(addr) -2]
|
||
|
|
if {[info exists _map($Cname,pc=$x)]} {
|
||
|
|
set current(asm_line) $_map($Cname,pc=$x)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# if current file has PC, highlight that too
|
||
|
|
if {$gdb_running && $tagname != "PC_TAG" && $pc(filename) == $filename
|
||
|
|
&& $pc(func) == $funcname} {
|
||
|
|
set pc(asm_line) $_map($Cname,pc=$pc_addr)
|
||
|
|
$win tag add PC_TAG $pc(asm_line).2 $pc(asm_line).end
|
||
|
|
}
|
||
|
|
|
||
|
|
# don't set browse tag if it is at PC
|
||
|
|
if {$pc_addr != $addr || $tagname == "PC_TAG"} {
|
||
|
|
# HACK. In STACK mode we usually want the previous instruction
|
||
|
|
# but not when we are browsing a trace experiment.
|
||
|
|
if {[string compare $tagname "STACK_TAG"] == 0 && !$Browsing} {
|
||
|
|
incr current(asm_line) -1
|
||
|
|
}
|
||
|
|
$win tag add $tagname $current(asm_line).2 $current(asm_line).end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: set_tag - update tag to STACK without making other changes
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::set_tag_to_stack {} {
|
||
|
|
foreach window [list $twin $bwin] {
|
||
|
|
if {$window == ""} then {
|
||
|
|
continue
|
||
|
|
}
|
||
|
|
foreach {start end} [$window tag ranges PC_TAG] {
|
||
|
|
$window tag remove PC_TAG $start $end
|
||
|
|
$window tag add STACK_TAG $start $end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set current(tag) STACK_TAG
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: location - display a location in a file
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::location {tagname filename funcname line addr pc_addr lib} {
|
||
|
|
# debug "$tagname $filename $line $addr $pc_addr, mode=$current(mode) oldmode=$oldmode cf=$current(filename) lib=$lib"
|
||
|
|
|
||
|
|
ClearTags
|
||
|
|
|
||
|
|
# It seems odd to do this as a string compare, but on the Alpha,
|
||
|
|
# where ints are 32 bit but addresses are 64, a numerical compare
|
||
|
|
# will overflow Tcl's ints.
|
||
|
|
|
||
|
|
if {$tagname == "PC_TAG" && [string compare $addr $pc_addr] == 0} {
|
||
|
|
set pc(filename) $filename
|
||
|
|
set pc(line) $line
|
||
|
|
set pc(addr) $addr
|
||
|
|
set pc(func) $funcname
|
||
|
|
set pc(lib) $lib
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$oldmode != "" \
|
||
|
|
&& [string compare $filename $current(filename)] != 0} {
|
||
|
|
|
||
|
|
if [catch {gdb_find_file $filename} fullname] {
|
||
|
|
dbug W "$filename: $fullname"
|
||
|
|
set fullname ""
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$fullname != ""} {
|
||
|
|
set tmp $oldmode
|
||
|
|
set oldmode ""
|
||
|
|
$parent mode "" $tmp 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
set oldpane $_tpane
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SOURCE {
|
||
|
|
FillSource t $tagname $filename $funcname $line $addr $pc_addr $lib
|
||
|
|
}
|
||
|
|
ASSEMBLY {
|
||
|
|
FillAssembly t $tagname $filename $funcname $line $addr $pc_addr $lib
|
||
|
|
}
|
||
|
|
MIXED {
|
||
|
|
FillMixed t $tagname $filename $funcname $line $addr $pc_addr $lib
|
||
|
|
}
|
||
|
|
SRC+ASM {
|
||
|
|
FillSource t $tagname $filename $funcname $line $addr $pc_addr $lib
|
||
|
|
# This may seem redundant, but it is NOT. FillSource can change
|
||
|
|
# the mode from SOURCE to ASSEMBLY if sources were not found. If
|
||
|
|
# this happens, then MIXED mode is pointless, so forget the bottom
|
||
|
|
# pane.
|
||
|
|
if {$current(mode) == "SRC+ASM"} {
|
||
|
|
FillAssembly b $tagname $filename $funcname $line $addr $pc_addr $lib
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# After switching panes, clear the previous pane's cursor so that it isn't
|
||
|
|
# used as the default when no other cursors are set.
|
||
|
|
if { "$oldpane" != "$_tpane" } {
|
||
|
|
$twin configure -cursor ""
|
||
|
|
}
|
||
|
|
|
||
|
|
set current(line) $line
|
||
|
|
set current(tag) $tagname
|
||
|
|
set current(addr) $addr
|
||
|
|
set current(funcname) $funcname
|
||
|
|
set current(filename) $filename
|
||
|
|
set current(lib) $lib
|
||
|
|
if {$do_display_breaks} {
|
||
|
|
display_breaks
|
||
|
|
set do_display_breaks 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: LoadFile - loads in a new source file
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::LoadFile {w name lib mtime_changed} {
|
||
|
|
debug "$name $current(filename) $current(mode)"
|
||
|
|
upvar ${w}win win
|
||
|
|
upvar _${w}pane pane
|
||
|
|
|
||
|
|
set oldpane $pane
|
||
|
|
set result [LoadFromCache $w $name "S" $lib]
|
||
|
|
if {$result == -1} {
|
||
|
|
# This is a source file we could not find the source for...
|
||
|
|
return 0
|
||
|
|
} elseif {$result == 1 || $mtime_changed} {
|
||
|
|
$win delete 0.0 end
|
||
|
|
debug "READING $name"
|
||
|
|
if {[catch {gdb_loadfile $win $name $Linenums} msg]} {
|
||
|
|
dbug W "Error opening $name: $msg"
|
||
|
|
#if {$msg != ""} {
|
||
|
|
# tk_messageBox -icon error -title "GDB" -type ok \
|
||
|
|
# -modal task -message $msg
|
||
|
|
#}
|
||
|
|
UnLoadFromCache $w $oldpane $name "" $lib
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set current(filename) $name
|
||
|
|
# Display all breaks/traces
|
||
|
|
set do_display_breaks 1
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: display_line - make sure a line is displayed and near the center
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::display_line { win line } {
|
||
|
|
::update idletasks
|
||
|
|
# keep line near center of display
|
||
|
|
set pixHeight [winfo height $win]
|
||
|
|
set topLine [lindex [split [$win index @0,0] .] 0]
|
||
|
|
set botLine [lindex [split [$win index @0,${pixHeight}] .] 0]
|
||
|
|
set margin [expr {int(0.2*($botLine - $topLine))}]
|
||
|
|
if {$line < [expr {$topLine + $margin}]} {
|
||
|
|
set num [expr {($topLine - $botLine) / 2}]
|
||
|
|
} elseif {$line > [expr {$botLine - $margin}]} {
|
||
|
|
set num [expr {($botLine - $topLine) / 2}]
|
||
|
|
} else {
|
||
|
|
set num 0
|
||
|
|
}
|
||
|
|
$win yview scroll $num units
|
||
|
|
$win see $line.0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: display_breaks - insert all breakpoints and tracepoints
|
||
|
|
# uses current(filename) in SOURCE mode
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::display_breaks {} {
|
||
|
|
# debug
|
||
|
|
|
||
|
|
# clear any previous breakpoints
|
||
|
|
foreach type "$bp_types tp" {
|
||
|
|
foreach {start stop} [$twin tag ranges ${type}_tag] {
|
||
|
|
scan $start "%d." linenum
|
||
|
|
removeBreakTag $twin $linenum ${type}_tag
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# now do second pane if it exists
|
||
|
|
if {[info exists bwin]} {
|
||
|
|
foreach type "$bp_types tp" {
|
||
|
|
foreach {start stop} [$twin tag ranges ${type}_tag] {
|
||
|
|
scan $start "%d." linenum
|
||
|
|
removeBreakTag $twin $linenum ${type}_tag
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Display any existing breakpoints.
|
||
|
|
foreach bpnum [gdb_get_breakpoint_list] {
|
||
|
|
set info [gdb_get_breakpoint_info $bpnum]
|
||
|
|
set addr [lindex $info 3]
|
||
|
|
set line [lindex $info 2]
|
||
|
|
set file [lindex $info 0]
|
||
|
|
set type [lindex $info 6]
|
||
|
|
set enabled [lindex $info 5]
|
||
|
|
bp create $bpnum $addr $line $file $type $enabled
|
||
|
|
}
|
||
|
|
# Display any existing tracepoints.
|
||
|
|
foreach bpnum [gdb_get_tracepoint_list] {
|
||
|
|
set info [gdb_get_tracepoint_info $bpnum]
|
||
|
|
set addr [lindex $info 3]
|
||
|
|
set line [lindex $info 2]
|
||
|
|
set file [lindex $info 0]
|
||
|
|
bp create $bpnum $addr $line $file tracepoint
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: insertBreakTag - insert the right amount of tag chars
|
||
|
|
# into the text window WIN, at line linenum.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::insertBreakTag {win linenum tag} {
|
||
|
|
# debug "$win $linenum $tag"
|
||
|
|
|
||
|
|
# Get the tags at the current line.
|
||
|
|
|
||
|
|
# If there is a "break_rgn_tag", then there are currently no other
|
||
|
|
# break/trace points at this line. So replace the break_rgn_tag
|
||
|
|
# with this tag. Otherwise, add the new tag, and then the joint
|
||
|
|
# tag. We will query the length of the previous tag, so we don't have
|
||
|
|
# to hard code it here.
|
||
|
|
|
||
|
|
set tag_list [$win tag names $linenum.0]
|
||
|
|
set img_name [string range $tag 0 [expr [string length $tag] - 5]]
|
||
|
|
|
||
|
|
if {[lsearch $tag_list break_rgn_tag] != -1} {
|
||
|
|
set stop [lindex [$win tag nextrange break_rgn_tag \
|
||
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
||
|
|
$win tag remove break_rgn_tag $linenum.0 "$linenum.0 lineend"
|
||
|
|
$win delete $linenum.0
|
||
|
|
|
||
|
|
# Strip the "_tag" off the end of the tag to get the image name.
|
||
|
|
$win image create $linenum.0 -image $break_images($img_name)
|
||
|
|
$win tag add $tag $linenum.0 $stop
|
||
|
|
} else {
|
||
|
|
set other_tag [lindex $tag_list \
|
||
|
|
[lsearch -glob $tag_list {*[bt]p_tag}]]
|
||
|
|
if {$other_tag == ""} {
|
||
|
|
set stop 4
|
||
|
|
} else {
|
||
|
|
set stop [lindex [$win tag nextrange $other_tag \
|
||
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
||
|
|
}
|
||
|
|
|
||
|
|
$win tag add $tag $linenum.0 $stop
|
||
|
|
$win image configure $linenum.0 -image $break_images($img_name)
|
||
|
|
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: removeBreakTag - remove a break tag (breakpoint or tracepoint)
|
||
|
|
# from the given line. If this is the last break tag on the
|
||
|
|
# line reinstall the break_rgn_tag
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::removeBreakTag {win linenum tag } {
|
||
|
|
# debug "$win $linenum $tag"
|
||
|
|
|
||
|
|
set tag_list [$win tag names $linenum.0]
|
||
|
|
|
||
|
|
if {[set pos [lsearch -exact $tag_list $tag]] == -1} {
|
||
|
|
debug "Tried to remove non-existant tag $tag"
|
||
|
|
return
|
||
|
|
} else {
|
||
|
|
set tag_list [lreplace $tag_list $pos $pos]
|
||
|
|
}
|
||
|
|
|
||
|
|
# Use the range of the removed tag for any insertions, so we don't
|
||
|
|
# have to hard code it here.
|
||
|
|
|
||
|
|
set stop [lindex [$win tag nextrange $tag \
|
||
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
||
|
|
|
||
|
|
$win tag remove $tag $linenum.0 "$linenum.0 lineend"
|
||
|
|
|
||
|
|
# Now check what other tags are on this line. If there are both bp & tp
|
||
|
|
# tags, also remove the joint tag, otherwise install the break_rgn_tag.
|
||
|
|
|
||
|
|
switch -glob $tag {
|
||
|
|
*bp_tag {
|
||
|
|
set only_one_tag [expr [set next_tag_index \
|
||
|
|
[lsearch -glob $tag_list tp_tag]] == -1]
|
||
|
|
}
|
||
|
|
tp_tag {
|
||
|
|
# Got to find out what kind of tag is here...
|
||
|
|
set only_one_tag [expr [set next_tag_index \
|
||
|
|
[lsearch -glob $tag_list *bp_tag]] == -1]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$only_one_tag} {
|
||
|
|
catch {$win image configure $linenum.0 -image {}}
|
||
|
|
$win delete $linenum.0
|
||
|
|
$win insert $linenum.0 "-"
|
||
|
|
$win tag add break_rgn_tag $linenum.0 $stop
|
||
|
|
} else {
|
||
|
|
set other_tag [lindex $tag_list $next_tag_index]
|
||
|
|
set img_name [string range $other_tag 0 \
|
||
|
|
[expr [string length $other_tag] - 5]]
|
||
|
|
$win image configure $linenum.0 -image $break_images($img_name)
|
||
|
|
$win tag remove bp_and_tp_tag $linenum.0 "$linenum.0 lineend"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PUBLIC METHOD: breakpoint - Handle a breakpoint create, delete,
|
||
|
|
# or modify event from the backend.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::breakpoint {bp_event} {
|
||
|
|
|
||
|
|
bp [$bp_event get action] [$bp_event get number] [$bp_event get address] \
|
||
|
|
[$bp_event get line] [$bp_event get file] [$bp_event get disposition] \
|
||
|
|
[$bp_event get enabled] [$bp_event get thread]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# PUBLIC METHOD: tracepoint - Handle a tracepoint create, delete,
|
||
|
|
# modify event from the backend.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::tracepoint {tp_event} {
|
||
|
|
|
||
|
|
bp [$tp_event get action] [$tp_event get number] [$tp_event get address] \
|
||
|
|
[$tp_event get line] [$tp_event get file] tracepoint \
|
||
|
|
[$tp_event get pass_count]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: bp - set and remove breakpoints
|
||
|
|
#
|
||
|
|
# if $addr is valid, the breakpoint will be set in the assembly or
|
||
|
|
# mixed window at that address. If $line and $file are valid,
|
||
|
|
# a breakpoint will be set in the source window if appropriate.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::bp {action bpnum addr {linenum {}} {file {}} {type 0} {enabled 0} {thread -1}} {
|
||
|
|
# debug "$action addr=$addr line=$linenum file=$file type=$type current(filename)=$current(filename)"
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SOURCE {
|
||
|
|
if {[string compare $file $current(filename)] == 0 && $linenum != {}} {
|
||
|
|
do_bp $twin $action $linenum $type $bpnum $enabled $thread 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
SRC+ASM {
|
||
|
|
if {$addr != {} && [info exists _map($Cname,pc=$addr)]} {
|
||
|
|
do_bp $bwin $action $_map($Cname,pc=$addr) $type $bpnum \
|
||
|
|
$enabled $thread 1
|
||
|
|
}
|
||
|
|
if {[string compare $file $current(filename)] == 0 && $linenum != {}} {
|
||
|
|
do_bp $twin $action $linenum $type $bpnum $enabled $thread 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
ASSEMBLY {
|
||
|
|
if {$addr != {} &&[info exists _map($Cname,pc=$addr)]} {
|
||
|
|
do_bp $twin $action $_map($Cname,pc=$addr) $type $bpnum \
|
||
|
|
$enabled $thread 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
MIXED {
|
||
|
|
if {$addr != {} && [info exists _map($Cname,pc=$addr)]} {
|
||
|
|
do_bp $twin $action $_map($Cname,pc=$addr) $type $bpnum \
|
||
|
|
$enabled $thread 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: do_bp - bp helper function
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::do_bp { win action linenum type bpnum enabled thread asm} {
|
||
|
|
# debug "$action line=$linenum type=$type bpnum=$bpnum enabled=$enabled thread=$thread"
|
||
|
|
|
||
|
|
if {$dont_change_appearance} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$action == "delete" && [string compare $type tracepoint] != 0} {
|
||
|
|
# make sure there are no more breakpoints on
|
||
|
|
# this line.
|
||
|
|
if {!$asm} {
|
||
|
|
set bps [gdb_find_bp_at_line $current(filename) $linenum]
|
||
|
|
} else {
|
||
|
|
if {[info exists _map($Cname,line=$linenum)]} {
|
||
|
|
set bps [gdb_find_bp_at_addr $_map($Cname,line=$linenum)]
|
||
|
|
} else {
|
||
|
|
set bps {}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if {[llength $bps] > 0} {
|
||
|
|
foreach b $bps {
|
||
|
|
if {$b != $bpnum} {
|
||
|
|
# OK we found another BP on this line.
|
||
|
|
# So we really just want to modify whats
|
||
|
|
# displayed on the line instead of deleting it.
|
||
|
|
# Also, for lack of a better solution, we will
|
||
|
|
# just display an image corresponding to the
|
||
|
|
# first found BP. If you have a temporary and
|
||
|
|
# a perm BP on the same line, the image for the one
|
||
|
|
# with the lower bpnum will be displayed.
|
||
|
|
set inf [gdb_get_breakpoint_info $b]
|
||
|
|
set action "modify"
|
||
|
|
set type [lindex $inf 6]
|
||
|
|
set bpnum $b
|
||
|
|
break
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[string compare $type "tracepoint"] == 0} {
|
||
|
|
if {[string compare $action "delete"] != 0
|
||
|
|
&& [lindex [gdb_get_tracepoint_info $bpnum] 4] == 0} {
|
||
|
|
set type disabled_tracepoint
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if {$enabled == "0" } {
|
||
|
|
set type disabled_bp
|
||
|
|
} elseif {$thread != "-1"} {
|
||
|
|
set type thread
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
switch $type {
|
||
|
|
donttouch {
|
||
|
|
set tag_type bp_tag
|
||
|
|
set remove_type disabled_bp_tag
|
||
|
|
}
|
||
|
|
delete {
|
||
|
|
set tag_type temp_bp_tag
|
||
|
|
}
|
||
|
|
disabled_bp {
|
||
|
|
set tag_type disabled_bp_tag
|
||
|
|
set remove_type bp_tag
|
||
|
|
}
|
||
|
|
tracepoint {
|
||
|
|
set tag_type tp_tag
|
||
|
|
set remove_type disabled_tp_tag
|
||
|
|
}
|
||
|
|
disabled_tracepoint {
|
||
|
|
set tag_type disabled_tp_tag
|
||
|
|
set remove_type tp_tag
|
||
|
|
}
|
||
|
|
thread {
|
||
|
|
set tag_type thread_bp_tag
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
dbug E "UNKNOWN BP TYPE action=\"$action\" type=\"$type\""
|
||
|
|
$win insert $linenum.0 "X" bp_tag
|
||
|
|
set tag_type bp_tag
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[string compare $action "delete"] == 0} {
|
||
|
|
removeBreakTag $win $linenum $tag_type
|
||
|
|
} else {
|
||
|
|
if {[string compare $action "modify"] == 0 && $remove_type != ""} {
|
||
|
|
removeBreakTag $win $linenum $remove_type
|
||
|
|
}
|
||
|
|
insertBreakTag $win $linenum $tag_type
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: hasBP - see if a line number has a breakpoint set
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::hasBP {win line} {
|
||
|
|
if {$win == ""} {
|
||
|
|
set win $popups(saved_win)
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[lsearch -glob [$win tag names $line.0] *bp_tag] >= 0} {
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: hasTP - see if a line number has a tracepoint set
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::hasTP {win line} {
|
||
|
|
if {$win == ""} {
|
||
|
|
set win $popups(saved_win)
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[lsearch -exact [$win tag names $line.0] tp_tag] == 1} {
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: report_source_location
|
||
|
|
#
|
||
|
|
# This function reports the "current" location in the source
|
||
|
|
# window, where current means what gdb_loc would return, if
|
||
|
|
# that point is actually visible in the window, or the middle
|
||
|
|
# of the current window, if that point is not visible.
|
||
|
|
#
|
||
|
|
# Return:
|
||
|
|
# The gdb_loc result for the location found
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::report_source_location {} {
|
||
|
|
|
||
|
|
if {$current(filename) == ""} {
|
||
|
|
error "No source file in window"
|
||
|
|
}
|
||
|
|
|
||
|
|
# Figure out if the return from gdb_loc is visible.
|
||
|
|
|
||
|
|
set not_visible 1
|
||
|
|
if {![catch {gdb_loc} loc_info]} {
|
||
|
|
set loc_long_name [lindex $loc_info 2]
|
||
|
|
set loc_line [lindex $loc_info 3]
|
||
|
|
# debug "Got loc_info: \"$loc_info\" and filename $current(filename) long_name: $loc_long_name"
|
||
|
|
if {[string compare $current(filename) $loc_long_name] != 0} {
|
||
|
|
set not_visible 1
|
||
|
|
} else {
|
||
|
|
foreach {name line} [lookup_line $twin 1] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
if {$line < $loc_line} {
|
||
|
|
foreach {name line} [lookup_line $twin [winfo height $twin]] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
if {$line > $loc_line} {
|
||
|
|
set not_visible 0
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
debug "gdb_loc returned $loc_info"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$not_visible} {
|
||
|
|
set y [expr int([winfo height $twin] / 2)]
|
||
|
|
foreach {name line addr type} [lookup_line $twin $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
switch $type {
|
||
|
|
src {
|
||
|
|
return [gdb_loc $name:$addr]
|
||
|
|
}
|
||
|
|
asm {
|
||
|
|
return [gdb_loc *$addr]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
return $loc_info
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: lookup_line - translated win & y position line info
|
||
|
|
#
|
||
|
|
# If win is {}, or y is -1, then the saved values from the popup
|
||
|
|
# array are used.
|
||
|
|
#
|
||
|
|
# Return:
|
||
|
|
# name - the fileName
|
||
|
|
# line - the line number in the text widget
|
||
|
|
# addr - the source line number, if in source mode, the
|
||
|
|
# address if in assembly mode, and if in mixed mode,
|
||
|
|
# the line if it is a source line, or the address if it
|
||
|
|
# is an assembly line
|
||
|
|
# type - src if it is a source line, asm if an assembly line.
|
||
|
|
# set_cmd - for convenience, this is the command needed to set a
|
||
|
|
# breakpoint at this address.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::lookup_line {win y} {
|
||
|
|
#debug "$win $y"
|
||
|
|
if {$y == -1} {
|
||
|
|
set y $popups(saved_y)
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$win == {}} {
|
||
|
|
set win $popups(saved_win)
|
||
|
|
}
|
||
|
|
|
||
|
|
scan [$win index @0,$y] "%d." line
|
||
|
|
set name [lindex [::file split $current(filename)] end]
|
||
|
|
|
||
|
|
# If we are in the SOURCE window (either because the mode is SOURCE,
|
||
|
|
# or SRC+ASM, and we are in the upper pane, then return the
|
||
|
|
if {([string compare $current(mode) SOURCE] == 0)
|
||
|
|
|| ([string compare $current(mode) SRC+ASM] == 0
|
||
|
|
&& [string compare $win $twin] == 0)} {
|
||
|
|
set addr $line
|
||
|
|
set type "src"
|
||
|
|
} else {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set type "asm"
|
||
|
|
} else {
|
||
|
|
# This is a source line in MIXED mode
|
||
|
|
set line_contents [$win get $line.0 "$line.0 lineend"]
|
||
|
|
#debug "Looking at line: $line contents: \"$line_contents\""
|
||
|
|
regexp "^\t(\[0-9\]*)" $line_contents match srcline
|
||
|
|
set addr $srcline
|
||
|
|
set type "src"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
switch $type {
|
||
|
|
asm {
|
||
|
|
set set_cmd [list gdb_set_bp_addr $addr]
|
||
|
|
}
|
||
|
|
src {
|
||
|
|
set set_cmd [list gdb_set_bp $current(filename) $addr]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#debug "Lookup line returning [list $name $line $addr $type $set_cmd]"
|
||
|
|
return [list $name $line $addr $type $set_cmd]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: continue_to_here - Advance to the line pointed to by the
|
||
|
|
# y coordinate in the window win. If win is {} or y is -1, the values
|
||
|
|
# saved in the popups array are used.
|
||
|
|
#
|
||
|
|
# The threads parameter is not currently used.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::continue_to_here {{win {}} {y -1} {threads -1}} {
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
foreach {name line addr type set_cmd} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
set dont_change_appearance 1
|
||
|
|
foreach i [gdb_get_breakpoint_list] {
|
||
|
|
set enabled($i) [lindex [gdb_get_breakpoint_info $i] 5]
|
||
|
|
}
|
||
|
|
gdb_cmd "disable"
|
||
|
|
eval $set_cmd temp $threads
|
||
|
|
gdb_immediate "continue"
|
||
|
|
gdb_cmd "enable"
|
||
|
|
foreach i [gdb_get_breakpoint_list] {
|
||
|
|
if {![info exists enabled($i)]} {
|
||
|
|
gdb_cmd "delete $i"
|
||
|
|
} elseif {!$enabled($i)} {
|
||
|
|
gdb_cmd "disable $i"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set dont_change_appearance 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: jump_to_here - Advance to the line pointed to by the
|
||
|
|
# y coordinate in the window win. If win is {} or y is -1, the values
|
||
|
|
# saved in the popups array are used.
|
||
|
|
#
|
||
|
|
# The threads parameter is not currently used.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::jump_to_here {{win {}} {y -1} {threads -1}} {
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
foreach {name line addr type set_cmd} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
# Unfortunately we cant set the pc to a linespec and we have to do a
|
||
|
|
# trick with a temporary breakpoint and the jump command.
|
||
|
|
# FIXME: Get the address from the linespec.
|
||
|
|
# FIXME: Even in the case we do have an address, I was not able to just
|
||
|
|
# change the PC and get things updated wright. While I work on that,
|
||
|
|
# I will use the temp breakpoint and jump trick for that case as well.
|
||
|
|
|
||
|
|
set dont_change_appearance 1
|
||
|
|
|
||
|
|
foreach i [gdb_get_breakpoint_list] {
|
||
|
|
set enabled($i) [lindex [gdb_get_breakpoint_info $i] 5]
|
||
|
|
}
|
||
|
|
gdb_cmd "disable"
|
||
|
|
|
||
|
|
if {$type == "asm"} {
|
||
|
|
gdb_immediate "tbreak *$addr"
|
||
|
|
gdb_immediate "jump *$addr"
|
||
|
|
} else {
|
||
|
|
eval $set_cmd temp $threads
|
||
|
|
gdb_immediate "jump $name:$line"
|
||
|
|
}
|
||
|
|
gdb_cmd "enable"
|
||
|
|
foreach i [gdb_get_breakpoint_list] {
|
||
|
|
if {![info exists enabled($i)]} {
|
||
|
|
gdb_cmd "delete $i"
|
||
|
|
} elseif {!$enabled($i)} {
|
||
|
|
gdb_cmd "disable $i"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set dont_change_appearance 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: set_bp_at_line - called when an empty break tag is clicked on
|
||
|
|
#
|
||
|
|
# When "threads" is set it means to set a bp on each thread in the list.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::set_bp_at_line {{type N} {win {}} {y -1} {threads "-1"}} {
|
||
|
|
# debug "$win $y $type $current(filename) Tracing=$Tracing"
|
||
|
|
if {$Running} {return}
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
|
||
|
|
foreach {name line addr addr_type set_cmd} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
foreach th $threads {
|
||
|
|
switch $type {
|
||
|
|
N {
|
||
|
|
if {[catch {eval $set_cmd normal $th} msg]} {
|
||
|
|
dbug W $msg
|
||
|
|
}
|
||
|
|
}
|
||
|
|
T {
|
||
|
|
if {[catch {eval $set_cmd temp $th} msg]} {
|
||
|
|
dbug W $msg
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: enable_disable_at_line - Enable or disable breakpoint
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::enable_disable_at_line {action} {
|
||
|
|
if {$Running} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
# FIXME: should this work on $bwin as well? In that case we'd need
|
||
|
|
# a `win' argument...
|
||
|
|
|
||
|
|
set y $popups(saved_y)
|
||
|
|
|
||
|
|
$twin tag remove _show_variable 1.0 end
|
||
|
|
set line [lindex [split [$twin index @0,$y] .] 0]
|
||
|
|
set bps ""
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SRC+ASM {
|
||
|
|
}
|
||
|
|
ASSEMBLY {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set bps [gdb_find_bp_at_addr $addr]
|
||
|
|
} else {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
MIXED {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set bps [gdb_find_bp_at_addr $addr]
|
||
|
|
} else {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$bps == ""} {
|
||
|
|
set bps [gdb_find_bp_at_line $current(filename) $line]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ACTION is `enable' or `disable'
|
||
|
|
gdb_cmd "$action $bps"
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: remove_bp_at_line - called when a bp tag is clicked on
|
||
|
|
#
|
||
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::remove_bp_at_line {{win {}} {y -1}} {
|
||
|
|
|
||
|
|
if {$Running} {return}
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
|
||
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
# FIXME: if there are multiple bp/tp at a single line,
|
||
|
|
# we will (right now) always take the first one we find...
|
||
|
|
switch $type {
|
||
|
|
src { set bps [gdb_find_bp_at_line $name $addr] }
|
||
|
|
asm { set bps [gdb_find_bp_at_addr $addr] }
|
||
|
|
}
|
||
|
|
|
||
|
|
set number [lindex $bps 0]
|
||
|
|
gdb_cmd "delete $number"
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: set_tp_at_line - called when an empty break region tag is clicked on
|
||
|
|
#
|
||
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::set_tp_at_line {{win {}} {y -1}} {
|
||
|
|
# debug "$win $y $current(filename) Tracing=$Tracing"
|
||
|
|
|
||
|
|
if {$Running} {return}
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
|
||
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
switch $type {
|
||
|
|
src {
|
||
|
|
after idle [list ManagedWin::open TraceDlg -File $name -Lines $addr]
|
||
|
|
}
|
||
|
|
asm {
|
||
|
|
after idle [list ManagedWin::open TraceDlg -File $name -Addresses [list $addr]]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: next_hit_at_line - Finds the next trace hit at the line
|
||
|
|
# given by win & y...
|
||
|
|
#
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::next_hit_at_line {{win {}} {y -1}} {
|
||
|
|
# debug "$win $y $current(filename) Tracing=$Tracing"
|
||
|
|
|
||
|
|
if {!$Browsing} {return}
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
|
||
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
# If the line and the addr are the same, then the specification was
|
||
|
|
# given by line. Otherwise is was a memory address.
|
||
|
|
|
||
|
|
switch $type {
|
||
|
|
src {
|
||
|
|
tfind_cmd "tfind line $name:$addr"
|
||
|
|
}
|
||
|
|
asm {
|
||
|
|
tfind_cmd "tfind line *$addr"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: remove_tp_at_line - called when a tp tag is clicked on
|
||
|
|
#
|
||
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::remove_tp_at_line {{win {}} {y -1}} {
|
||
|
|
|
||
|
|
if {$Running} {return}
|
||
|
|
|
||
|
|
# Look up the line... This foreach is an lassign...
|
||
|
|
|
||
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
switch $type {
|
||
|
|
src {
|
||
|
|
set tp_num [gdb_tracepoint_exists $name:$addr]
|
||
|
|
}
|
||
|
|
asm {
|
||
|
|
set tp_num [gdb_tracepoint_exists *$addr]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$tp_num != -1} {
|
||
|
|
if {[catch {gdb_cmd "delete tracepoints $tp_num"} errTxt]} {
|
||
|
|
tk_messageBox -type error -message "Could not delete tracepoint number $tp_num
|
||
|
|
Error was: $errTxt"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: do_tag_popup - The tag bind function for breakpoint popups
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::do_tag_popup {name X Y y} {
|
||
|
|
|
||
|
|
# debug "$name $X $Y $y"
|
||
|
|
|
||
|
|
if {$Running || [winfo ismapped $popups($name)]} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
set popups(saved_y) $y
|
||
|
|
set popups(saved_win) [winfo containing -displayof $itk_interior $X $Y]
|
||
|
|
|
||
|
|
# Hide variable balloons before showing the popup
|
||
|
|
$twin tag remove _show_variable 1.0 end
|
||
|
|
balloon withdraw $twin
|
||
|
|
|
||
|
|
tk_popup $popups($name) $X $Y
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: do_source_popup - tag bind function for source popups
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::do_source_popup { X Y x y } {
|
||
|
|
if {$Running || [winfo ismapped $popups(source)]} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
# Figure out what window we are over...
|
||
|
|
set win [winfo containing -displayof $itk_interior $X $Y]
|
||
|
|
|
||
|
|
# Hide variable balloons before showing the popup
|
||
|
|
$win tag remove _show_variable 1.0 end
|
||
|
|
balloon withdraw $win
|
||
|
|
catch {$_balloon_var delete}
|
||
|
|
|
||
|
|
|
||
|
|
# Try to get the selection. If you fail, get the word around the
|
||
|
|
# click point.
|
||
|
|
# Note that we don't have to worry about the user clicking over the
|
||
|
|
# break area, since the break_rgn_tag will override this...
|
||
|
|
|
||
|
|
set hit_point [$win index @$x,$y]
|
||
|
|
if {([$win tag ranges sel] != "")
|
||
|
|
&& ([$win compare sel.first < $hit_point]
|
||
|
|
&& [$win compare $hit_point < sel.last])} {
|
||
|
|
set sel_first [$win index sel.first]
|
||
|
|
set sel_last [$win index sel.last]
|
||
|
|
|
||
|
|
# If there was a selection, see if it spans multiple lines.
|
||
|
|
scan $sel_first "%d.%d" range_low sel_start_char
|
||
|
|
scan $sel_last "%d.%d" range_high sel_end_char
|
||
|
|
|
||
|
|
if {$range_low == $range_high} {
|
||
|
|
set range -1
|
||
|
|
set target_range [$win get sel.first sel.last]
|
||
|
|
} else {
|
||
|
|
# If the selection encompasses multiple lines, we only care about
|
||
|
|
# the start and ending line numbers
|
||
|
|
set range 1
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
set target_range [$win get "$hit_point wordstart" "$hit_point wordend"]
|
||
|
|
set range 0
|
||
|
|
}
|
||
|
|
|
||
|
|
$popups(source) delete 0 end
|
||
|
|
|
||
|
|
if {$range && $Tracing} {
|
||
|
|
# If the selection spans more than one line, it can't be a variable name...
|
||
|
|
# So just insert the tracepoint range item
|
||
|
|
$popups(source) add command -label "Set Tracepoint Range" \
|
||
|
|
-command "$this tracepoint_range $win $range_low $range_high"
|
||
|
|
$popups(source) add separator
|
||
|
|
} elseif {$range != 1} {
|
||
|
|
# RANGE = -1 means that we have already found the word we want (it was
|
||
|
|
# a selection)...
|
||
|
|
# RANGE = 1 means we got the word around the point, and we are just saving
|
||
|
|
# getVariable the trouble of parsing it again.
|
||
|
|
if {$range == -1} {
|
||
|
|
set variable $target_range
|
||
|
|
} else {
|
||
|
|
set variable [lindex [getVariable -1 -1 $target_range] 0]
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$variable != ""} {
|
||
|
|
# LAME: check to see if VARIABLE is really a number (constants??)
|
||
|
|
set is_var [catch {expr {$variable+1}}]
|
||
|
|
|
||
|
|
if {$is_var} {
|
||
|
|
$popups(source) add command -label "Add $variable to Watch" \
|
||
|
|
-command [list $this addToWatch $variable]
|
||
|
|
$popups(source) add command -label "Dump Memory at $variable" \
|
||
|
|
-command [list ManagedWin::open MemWin -force -addr_exp $variable]
|
||
|
|
$popups(source) add command -label "Set Breakpoint at $variable" \
|
||
|
|
-command [list gdb_cmd "break $variable"]
|
||
|
|
$popups(source) add separator
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$popups(source) add command -label "Open Another Source Window" \
|
||
|
|
-command {ManagedWin::open SrcWin -force}
|
||
|
|
$popups(source) add command -label "Open Source in external editor" \
|
||
|
|
-command [code $parent edit]
|
||
|
|
|
||
|
|
tk_popup $popups(source) $X $Y
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: addToWatch - add a variable to the watch window
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::addToWatch {var} {
|
||
|
|
[ManagedWin::open WatchWin] add $var
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: do_key -- wrapper for all key bindings
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::do_key {key} {
|
||
|
|
if {!$Running} {
|
||
|
|
switch $key {
|
||
|
|
print { print $top }
|
||
|
|
download { Download::download_it }
|
||
|
|
run { $parent inferior run }
|
||
|
|
stack { ManagedWin::open StackWin }
|
||
|
|
registers { ManagedWin::open RegWin }
|
||
|
|
memory { ManagedWin::open MemWin }
|
||
|
|
watch { ManagedWin::open WatchWin }
|
||
|
|
locals { ManagedWin::open LocalsWin }
|
||
|
|
breakpoints { ManagedWin::open BpWin }
|
||
|
|
console { ManagedWin::open Console }
|
||
|
|
step { $parent inferior step }
|
||
|
|
next { $parent inferior next }
|
||
|
|
finish { $parent inferior finish }
|
||
|
|
continue { $parent inferior continue }
|
||
|
|
stepi { $parent inferior stepi }
|
||
|
|
nexti { $parent inferior nexti }
|
||
|
|
up { catch {gdb_cmd up} }
|
||
|
|
down { catch {gdb_cmd down} }
|
||
|
|
quit { gdbtk_quit }
|
||
|
|
tdump { ManagedWin::open TdumpWin }
|
||
|
|
tracepoints { ManagedWin::open BpWin -tracepoints 1}
|
||
|
|
tfind_next { catch {gdb_immediate tfind} }
|
||
|
|
tfind_prev { catch {gdb_immediate "tfind -"} }
|
||
|
|
tfind_start { catch {gdb_immediate "tfind start"} }
|
||
|
|
tfind_line { catch {gdb_immediate "tfind line"} }
|
||
|
|
tfind_tp { catch {gdb_immediate "tfind tracepoint"} }
|
||
|
|
open { catch {_open_file} }
|
||
|
|
close { catch {_close_file} }
|
||
|
|
browser { catch {ManagedWin::open BrowserWin} }
|
||
|
|
thread_list { catch {ManagedWin::open ProcessWin} }
|
||
|
|
debug { catch {ManagedWin::open DebugWin} }
|
||
|
|
kod { catch {ManagedWin::open KodWin} }
|
||
|
|
attach { catch {gdbtk_attach_native} }
|
||
|
|
default {
|
||
|
|
dbug E "Unknown key binding: \"$key\""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# debug "ignoring keypress -- running"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: mode_get - get the source mode
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::mode_get {} {
|
||
|
|
return $current(mode)
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: mode_set - change the source mode
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::mode_set {new_mode {go 1}} {
|
||
|
|
debug "$new_mode"
|
||
|
|
|
||
|
|
if {$new_mode != $current(mode)} {
|
||
|
|
|
||
|
|
if {$current(mode) == "SRC+ASM"} {
|
||
|
|
if {$_bpane != ""} {$itk_interior.p hide $_bpane}
|
||
|
|
set _bpane ""
|
||
|
|
set _bwin ""
|
||
|
|
}
|
||
|
|
|
||
|
|
set current(mode) $new_mode
|
||
|
|
set mode_changed 1
|
||
|
|
|
||
|
|
if {$go} {
|
||
|
|
location $current(tag) $current(filename) $current(funcname) \
|
||
|
|
$current(line) $current(addr) $pc(addr) $current(lib)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: cancelMotion - cancel any pending motion callbacks for
|
||
|
|
# the source window's variable balloons
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::cancelMotion {} {
|
||
|
|
catch {after cancel $timeoutID}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: motion - callback for mouse motion within the source
|
||
|
|
# window's text widget
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::motion {type win x y} {
|
||
|
|
global gdb_running
|
||
|
|
cancelMotion
|
||
|
|
|
||
|
|
# The showBalloon method can sometimes raise errors (for instance in
|
||
|
|
# assembly code with no sources, and when gdb coughs over a path
|
||
|
|
# that contains a space. These functions should error quietly.
|
||
|
|
# but write to the debug window so we can trace problems.
|
||
|
|
|
||
|
|
if {$type == "var"} {
|
||
|
|
set cmd_bit ""
|
||
|
|
} else {
|
||
|
|
set cmd_bit BP
|
||
|
|
}
|
||
|
|
set cmd_line [format {
|
||
|
|
if {[catch {%s show%sBalloon %s %d %d} err]} {
|
||
|
|
debug "show%sBalloon got error: $err"
|
||
|
|
}
|
||
|
|
} $this $cmd_bit $win $x $y $cmd_bit]
|
||
|
|
set timeoutID [after $TimeOut $cmd_line]
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: showBPBalloon - show BP information in a balloon
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::showBPBalloon {win x y} {
|
||
|
|
if {$Running} { return }
|
||
|
|
$win tag remove _show_variable 1.0 end
|
||
|
|
set line [lindex [split [$win index @0,$y] .] 0]
|
||
|
|
set bps ""
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SRC+ASM {
|
||
|
|
if {$win == $bwin} {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set bps [gdb_find_bp_at_addr $addr]
|
||
|
|
} else {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
ASSEMBLY {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set bps [gdb_find_bp_at_addr $addr]
|
||
|
|
} else {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
MIXED {
|
||
|
|
if {[info exists _map($Cname,line=$line)]} {
|
||
|
|
set addr $_map($Cname,line=$line)
|
||
|
|
set bps [gdb_find_bp_at_addr $addr]
|
||
|
|
} else {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$bps == ""} {
|
||
|
|
set bps [gdb_find_bp_at_line $current(filename) $line]
|
||
|
|
}
|
||
|
|
|
||
|
|
set str ""
|
||
|
|
set need_lf 0
|
||
|
|
foreach b $bps {
|
||
|
|
set bpinfo [gdb_get_breakpoint_info $b]
|
||
|
|
lassign $bpinfo file func linenum addr type enabled disposition \
|
||
|
|
ignore_count commands cond thread hit_count user_specification
|
||
|
|
set file [lindex [file split $file] end]
|
||
|
|
if {$enabled} {
|
||
|
|
set enabled "ENA"
|
||
|
|
} else {
|
||
|
|
set enabled "DIS"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$need_lf} {append str \n}
|
||
|
|
|
||
|
|
append str [format "breakpoint %d at %s:%d (%s)\n %s %s %s" \
|
||
|
|
$b $file $linenum $addr $enabled $type $disposition]
|
||
|
|
|
||
|
|
if {$thread != "-1"} {
|
||
|
|
append str "\n threads: $thread"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$ignore_count != 0} {
|
||
|
|
append str "\n ignore: $ignore_count"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$cond != ""} {
|
||
|
|
append str "\n condition: $cond"
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$commands != ""} {
|
||
|
|
if {[string length $commands] > 50} {
|
||
|
|
append str "\n commands: [string range $commands 0 50] ..."
|
||
|
|
} else {
|
||
|
|
append str "\n commands: $commands"
|
||
|
|
}
|
||
|
|
}
|
||
|
|
set need_lf 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# Scope out which break type is set here, and use the tag to get
|
||
|
|
# the break region range...
|
||
|
|
|
||
|
|
set tag_list [$win tag names $line.0]
|
||
|
|
set break_tag [lindex $tag_list [lsearch -glob $tag_list *bp_tag]]
|
||
|
|
set end [lindex [$win tag nextrange $break_tag $line.0 $line.end] 1]
|
||
|
|
|
||
|
|
if {$end != ""} {
|
||
|
|
$win tag add _show_variable $line.0 $end
|
||
|
|
balloon register $win $str _show_variable
|
||
|
|
balloon show $win _show_variable 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: showBalloon - (possibly) show a variable's value in
|
||
|
|
# a balloon-help widget
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::showBalloon {win x y} {
|
||
|
|
if {$Running} { return }
|
||
|
|
|
||
|
|
$twin tag remove _show_variable 1.0 end
|
||
|
|
catch {tmp delete}
|
||
|
|
|
||
|
|
|
||
|
|
if {[catch {getVariable $x $y} variable]} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[llength $variable] != 3} {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
# We get the variable name, and its start and stop indices in the text
|
||
|
|
# widget, so all we need to do is set the tag and register the balloon help
|
||
|
|
set varName [lindex $variable 0]
|
||
|
|
set start [lindex $variable 1]
|
||
|
|
set stop [lindex $variable 2]
|
||
|
|
|
||
|
|
# Get the address associated with this line
|
||
|
|
foreach {file text_line source_line type} [lookup_line $twin $y] {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
|
||
|
|
# Reduce the areas over which we will show balloons.
|
||
|
|
# 1) Only pop up a balloon if we are over the function in
|
||
|
|
# the currently selected frame, or in the static data for
|
||
|
|
# the file.
|
||
|
|
# 2) We would also like to exclude cases where the line that
|
||
|
|
# under the mouse cursor does not contain executable code,
|
||
|
|
# but we can't since gdb considers continuation lines to not
|
||
|
|
# have executible code so we would lose on these...
|
||
|
|
|
||
|
|
set cur_fn [lindex [gdb_loc $file:$source_line] 1]
|
||
|
|
set selected_frame_fn [lindex [gdb_loc] 1]
|
||
|
|
|
||
|
|
if {[string compare $cur_fn $selected_frame_fn] == 0} {
|
||
|
|
# Create the variable object
|
||
|
|
catch {$_balloon_var delete}
|
||
|
|
set err [catch {gdb_variable create -expr $varName} _balloon_var]
|
||
|
|
if {!$err} {
|
||
|
|
set value [balloon_value $_balloon_var]
|
||
|
|
if {$value != ""} {
|
||
|
|
$win tag add _show_variable $start $stop
|
||
|
|
|
||
|
|
# display variable's value
|
||
|
|
balloon register $twin "$varName=$value" _show_variable
|
||
|
|
balloon show $win _show_variable
|
||
|
|
} else {
|
||
|
|
# No value/error. Don't show it.
|
||
|
|
catch {$_balloon_var delete}
|
||
|
|
set _balloon_var {}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
set _balloon_var {}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
set _balloon_var {}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: getVariable - get the name of the 'variable' under the
|
||
|
|
# mouse pointer in the text widget
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::getVariable {x y {line {}}} {
|
||
|
|
#debug "$x $y $line"
|
||
|
|
set hit_point [$twin index @$x,$y]
|
||
|
|
|
||
|
|
if {$x != -1 && $y != -1} {
|
||
|
|
# If we are over a selection, just report that:
|
||
|
|
if {([$twin tag ranges sel] != "")
|
||
|
|
&& ([$twin compare sel.first < $hit_point]
|
||
|
|
&& [$twin compare $hit_point < sel.last])} {
|
||
|
|
return [list [$twin get sel.first sel.last] [$twin index sel.first] [$twin index sel.last]]
|
||
|
|
}
|
||
|
|
# Since we will only be concerned with this line, get it
|
||
|
|
set line [$twin get "$hit_point linestart" "$hit_point lineend"]
|
||
|
|
# debug "new line=$line"
|
||
|
|
set simple 0
|
||
|
|
} else {
|
||
|
|
# This is not quite right -- still want constants to appear...
|
||
|
|
set simple 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# The index into LINE that contains the char at which the pointer hangs
|
||
|
|
set a [split [$twin index @$x,$y] .]
|
||
|
|
set lineNo [lindex $a 0]
|
||
|
|
set index [lindex $a 1]
|
||
|
|
set s [string range $line $index end]
|
||
|
|
set last {}
|
||
|
|
foreach char [split $s {}] {
|
||
|
|
if {[regexp -- {([^a-zA-Z0-9_>.-])} $char dummy]} {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
lappend last $char
|
||
|
|
}
|
||
|
|
set last [string trimright [join $last {}] ->]
|
||
|
|
|
||
|
|
# Decrement index for string -- will need to increment it later
|
||
|
|
incr index -1
|
||
|
|
set tmp [string range $line 0 $index]
|
||
|
|
set s {}
|
||
|
|
foreach char [split $tmp {}] {
|
||
|
|
set s [linsert $s 0 $char]
|
||
|
|
}
|
||
|
|
|
||
|
|
set first {}
|
||
|
|
foreach char $s {
|
||
|
|
if {[regexp -- {([^a-zA-Z0-9_>.-])} $char dummy]} {
|
||
|
|
break
|
||
|
|
}
|
||
|
|
set first [linsert $first 0 $char]
|
||
|
|
}
|
||
|
|
#set first [string trimleft [join $first {}] ->]
|
||
|
|
set first [join $first {}]
|
||
|
|
#debug "FIRST=$first\nLAST=$last"
|
||
|
|
|
||
|
|
# Validate the variable
|
||
|
|
set variable [string trim $first$last \ ]
|
||
|
|
if {!$simple && ![regexp {^[a-zA-Z_]} $variable dummy]} {
|
||
|
|
#debug "Rejecting: $variable"
|
||
|
|
return {}
|
||
|
|
}
|
||
|
|
|
||
|
|
incr index
|
||
|
|
# Find the boundaries of this word in the text box
|
||
|
|
set a [string length $first]
|
||
|
|
set b [string length $last]
|
||
|
|
|
||
|
|
# Gag! If there is a breakpoint at a line, this is off by one!
|
||
|
|
if {[hasBP $twin $lineNo] || [hasTP $twin $lineNo]} {
|
||
|
|
incr a -1
|
||
|
|
incr b 1
|
||
|
|
}
|
||
|
|
set start "$lineNo.[expr {$index - $a}]"
|
||
|
|
set end "$lineNo.[expr {$index + $b}]"
|
||
|
|
return [list $variable $start $end]
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: trace_help - update statusbar with ballon help message
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::trace_help {args} {
|
||
|
|
upvar #0 ${this}_balloon a
|
||
|
|
if {$a == ""} {
|
||
|
|
$parent set_status
|
||
|
|
} else {
|
||
|
|
$parent set_status $a 1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::line_is_executable {win line} {
|
||
|
|
# there should be an image or a "-" on the line
|
||
|
|
set res [catch {$win image cget $line.0 -image}]
|
||
|
|
if {!$res || [$win get $line.0] == "-"} {
|
||
|
|
return 1
|
||
|
|
}
|
||
|
|
return 0
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: tracepoint_range - create tracepoints at every line in
|
||
|
|
# a range of lines on the screen
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::tracepoint_range {win low high} {
|
||
|
|
# debug "$win $low $high"
|
||
|
|
|
||
|
|
switch $current(mode) {
|
||
|
|
SOURCE {
|
||
|
|
set lines {}
|
||
|
|
for {set i $low} {$i <= $high} {incr i} {
|
||
|
|
if {[line_is_executable $win $i]} {
|
||
|
|
lappend lines $i
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
ASSEMBLY {
|
||
|
|
set addrs {}
|
||
|
|
for {set i $low} {$i <= $high} {incr i} {
|
||
|
|
lappend addrs $_map($Cname,line=$i)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
MIXED {
|
||
|
|
set addrs {}
|
||
|
|
for {set i $low} {$i <= $high} {incr i} {
|
||
|
|
if {[line_is_executable $win $i]} {
|
||
|
|
lappend addrs $_map($Cname,line=$i)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
SRC+ASM {
|
||
|
|
if {$win == $awin} {
|
||
|
|
# Assembly
|
||
|
|
set addrs {}
|
||
|
|
for {set i $low} {$i <= $high} {incr i} {
|
||
|
|
lappend addrs $_map($Cname,line=$i)
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# Source
|
||
|
|
set lines {}
|
||
|
|
for {set i $low} {$i <= $high} {incr i} {
|
||
|
|
if {[line_is_executable $win $i]} {
|
||
|
|
lappend lines $i
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
if {[info exists lines]} {
|
||
|
|
# debug "Got executible lines: $lines"
|
||
|
|
if {[llength $lines]} {
|
||
|
|
set name [::file tail $current(filename)]
|
||
|
|
ManagedWin::open TraceDlg -File $name -Lines $lines
|
||
|
|
}
|
||
|
|
} elseif {[info exists addrs]} {
|
||
|
|
# debug "Got executible addresses: $addrs"
|
||
|
|
if {[llength $addrs]} {
|
||
|
|
set name [::file tail $current(filename)]
|
||
|
|
ManagedWin::open TraceDlg -File $name -Addresses $addrs
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# debug "Got no executible lines in the selected range..."
|
||
|
|
}
|
||
|
|
|
||
|
|
# Clear the selection -- it looks a lot better.
|
||
|
|
$twin tag remove sel 1.0 end
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: search - search for text or jump to a specific line
|
||
|
|
# in source window, going in the specified DIRECTION.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::search {exp direction} {
|
||
|
|
if {$exp != ""} {
|
||
|
|
set result {}
|
||
|
|
if {[regexp {^@([0-9]+)} $exp dummy index]} {
|
||
|
|
append index .0
|
||
|
|
set end [$twin index "$index lineend"]
|
||
|
|
} else {
|
||
|
|
set index [$twin search -exact -count len -$direction -- $exp $SearchIndex]
|
||
|
|
|
||
|
|
if {$index != ""} {
|
||
|
|
set end [split $index .]
|
||
|
|
set line [lindex $end 0]
|
||
|
|
set char [lindex $end 1]
|
||
|
|
set char [expr {$char + $len}]
|
||
|
|
set end $line.$char
|
||
|
|
set result "Match of \"$exp\" found on line $line"
|
||
|
|
if {$direction == "forwards"} {
|
||
|
|
set SearchIndex $end
|
||
|
|
} else {
|
||
|
|
set SearchIndex $index
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if {$index != ""} {
|
||
|
|
# Highlight word and save index
|
||
|
|
$twin tag remove search 1.0 end
|
||
|
|
$twin tag add search $index $end
|
||
|
|
$twin see $index
|
||
|
|
} else {
|
||
|
|
set result "No match for \"$exp\" found"
|
||
|
|
}
|
||
|
|
return $result
|
||
|
|
} else {
|
||
|
|
$twin tag remove search 1.0 end
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# -----------------------------------------------------------------------------
|
||
|
|
# NAME: SrcTextWin::LoadFromCache
|
||
|
|
#
|
||
|
|
# SYNOPSIS: LoadFromCache {w name asm lib}
|
||
|
|
#
|
||
|
|
# DESC: Looks up $name in the cache. If $name is cached, replace the
|
||
|
|
# pane $w with the cached pane. Otherwise create a new
|
||
|
|
# pane and scrolledtext widget and set _${w}pane and _${w}win.
|
||
|
|
#
|
||
|
|
# ARGS: w "t" or "b" (for Top and Bottom pane)
|
||
|
|
# name name to look for in cache. This will be a filename if
|
||
|
|
# we are filling in a source window, or an address
|
||
|
|
# otherwise.
|
||
|
|
# asm 'S' for source,
|
||
|
|
# 'A' for assembly mode
|
||
|
|
# 'M' for mixed mode.
|
||
|
|
# lib library name
|
||
|
|
#
|
||
|
|
# RETURNS: 0 - read from cache
|
||
|
|
# 1 - created new (blank) widget
|
||
|
|
# -1 - could not find the contents you are trying to load,
|
||
|
|
# so far this only happens for "Source" files.
|
||
|
|
#
|
||
|
|
# NOTES: If you call this and a new widget is created which cannot be
|
||
|
|
# filled in later due to errors, call UnLoadFromCache.
|
||
|
|
# -----------------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::LoadFromCache {w name asm lib} {
|
||
|
|
debug "LoadFromCache $w $name $asm"
|
||
|
|
global gdbtk_platform
|
||
|
|
upvar ${w}win win
|
||
|
|
upvar _${w}pane pane
|
||
|
|
|
||
|
|
if {[string compare gdbtk_scratch_widget $name]} {
|
||
|
|
append full_name $name "," $asm "," $lib
|
||
|
|
} else {
|
||
|
|
set full_name $name
|
||
|
|
}
|
||
|
|
|
||
|
|
set loadingSource [expr ![string compare $asm "S"]]
|
||
|
|
|
||
|
|
set oldpane $pane
|
||
|
|
if {[info exists Stwc($full_name:pane)]} {
|
||
|
|
debug "READING CACHE $full_name->$Stwc($full_name:pane)"
|
||
|
|
set pane $Stwc($full_name:pane)
|
||
|
|
if {$oldpane != ""} {
|
||
|
|
$itk_interior.p replace $oldpane $pane
|
||
|
|
} else {
|
||
|
|
$itk_interior.p show $pane
|
||
|
|
}
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
if {!$loadingSource} {
|
||
|
|
set Cname $full_name
|
||
|
|
}
|
||
|
|
|
||
|
|
# If the text in this cache file is dirty, clean the window, and
|
||
|
|
# return 1, which will tell the caller to refill it. Otherwise
|
||
|
|
# return 0, and the caller will just display the window.
|
||
|
|
|
||
|
|
if {$Stwc($name:dirty)} {
|
||
|
|
$win delete 0.0 end
|
||
|
|
set res 1
|
||
|
|
set Stwc($name:dirty) 0
|
||
|
|
} else {
|
||
|
|
set res 0
|
||
|
|
}
|
||
|
|
|
||
|
|
} else {
|
||
|
|
debug "name=$name"
|
||
|
|
# If we are trying to load a source file, check the time
|
||
|
|
# to see if we need to update it. If we can't stat the
|
||
|
|
# file then we probably can't open it either, so error
|
||
|
|
# out.
|
||
|
|
|
||
|
|
if {$loadingSource} {
|
||
|
|
if {[string compare $gdbtk_platform(os) "cygwin"] == 0} {
|
||
|
|
set f [ide_cygwin_path to_win32 $name]
|
||
|
|
} else {
|
||
|
|
set f $name
|
||
|
|
}
|
||
|
|
if {[catch {file mtime $f} file_time]} {
|
||
|
|
debug "Could not stat file \"$f\" - \"$file_time\""
|
||
|
|
return -1
|
||
|
|
} else {
|
||
|
|
set Stwc($full_name:pane) pane$filenum
|
||
|
|
set Stwc($name:mtime) $file_time
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# FIXME: This is wrong. For Assembly files we need to
|
||
|
|
# check whether the executable is newer than the cached
|
||
|
|
# disassembly. For mixed files, we need to check BOTH
|
||
|
|
# the source file mtime, and the executable time.
|
||
|
|
|
||
|
|
set Stwc($full_name:pane) pane$filenum
|
||
|
|
set Stwc($name:mtime) 0
|
||
|
|
}
|
||
|
|
|
||
|
|
set Stwc($full_name:pane) pane$filenum
|
||
|
|
|
||
|
|
set Stwc($name:dirty) 0
|
||
|
|
incr filenum
|
||
|
|
|
||
|
|
set pane $Stwc($full_name:pane)
|
||
|
|
debug "pane=$pane"
|
||
|
|
if {$oldpane != ""} {$itk_interior.p hide $oldpane}
|
||
|
|
$itk_interior.p add $pane
|
||
|
|
set p [$itk_interior.p childsite $pane]
|
||
|
|
set st [iwidgets::scrolledtext $p.st \
|
||
|
|
-hscrollmode dynamic -vscrollmode dynamic]
|
||
|
|
set win [$st component text]
|
||
|
|
|
||
|
|
if {!$loadingSource} {
|
||
|
|
set Cname $full_name
|
||
|
|
}
|
||
|
|
pack $st -expand yes -fill both
|
||
|
|
set res 1
|
||
|
|
}
|
||
|
|
|
||
|
|
# reconfigure in case some preferences have changed
|
||
|
|
config_win $win $asm
|
||
|
|
return $res
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: UnLoadFromCache - revert back to previously cached widget
|
||
|
|
# This is used when a new widget is created with LoadFromCache but
|
||
|
|
# there is a problem with filling the widget.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::UnLoadFromCache {w oldpane name asm lib} {
|
||
|
|
# debug "$w $oldpane $name"
|
||
|
|
upvar ${w}win win
|
||
|
|
upvar _${w}pane pane
|
||
|
|
# debug "pane=$pane win=$win"
|
||
|
|
|
||
|
|
|
||
|
|
set full_name ${name},${asm},${lib}
|
||
|
|
$itk_interior.p delete $pane
|
||
|
|
foreach elem [array names Stwc $full_name:*] {
|
||
|
|
unset Stwc($elem)
|
||
|
|
}
|
||
|
|
foreach elem [array names Stwc $name:*] {
|
||
|
|
unset Stwc($elem)
|
||
|
|
}
|
||
|
|
|
||
|
|
if {$oldpane != ""} {
|
||
|
|
$itk_interior.p show $oldpane
|
||
|
|
set pane $oldpane
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: print - print the contents of the text widget
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::print {top} {
|
||
|
|
# FIXME
|
||
|
|
send_printer -ascii [$twin get 1.0 end] -parent $top
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: ask_thread_bp - prompt for thread(s) for BP
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::ask_thread_bp {} {
|
||
|
|
# debug
|
||
|
|
if {[catch {gdb_cmd "info thread"} threads]} {
|
||
|
|
# failed. Just leave
|
||
|
|
return
|
||
|
|
}
|
||
|
|
set threads [split $threads \n]
|
||
|
|
set num_threads [expr {[llength $threads] - 1}]
|
||
|
|
if {$num_threads <= 0} {
|
||
|
|
show_warning "No threads were found.\nYou may only set breakpoints on threads\nthat have already been created."
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
set a [toplevel .[gensym]]
|
||
|
|
wm title $a "Thread Selection"
|
||
|
|
|
||
|
|
iwidgets::scrolledlistbox $a.slb \
|
||
|
|
-vscrollmode dynamic -hscrollmode dynamic \
|
||
|
|
-selectmode multiple -textfont global/fixed
|
||
|
|
|
||
|
|
set i [expr $num_threads - 1]
|
||
|
|
set width 0
|
||
|
|
foreach line $threads {
|
||
|
|
# Active line starts with "*"
|
||
|
|
if {[string index $line 0] == "*"} {
|
||
|
|
# strip off leading "*"
|
||
|
|
set line " [string trimleft $line "*"]"
|
||
|
|
}
|
||
|
|
# scan for GDB ID number at start of line
|
||
|
|
if {[scan $line "%d" id($i)] == 1} {
|
||
|
|
if {[string length $line] > $width} {
|
||
|
|
set width [string length $line]
|
||
|
|
}
|
||
|
|
$a.slb insert 0 $line
|
||
|
|
incr i -1
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$a.slb configure -visibleitems ${width}x$num_threads
|
||
|
|
[$a.slb component listbox] configure -bg $::Colors(textbg) -fg $::Colors(textfg)
|
||
|
|
|
||
|
|
frame $a.b
|
||
|
|
button $a.b.ok -text OK -underline 0 -width 7 \
|
||
|
|
-command "$this do_thread_bp $a.slb"
|
||
|
|
button $a.b.cancel -text Cancel -width 7 -underline 0 -command "destroy $a"
|
||
|
|
pack $a.b.ok $a.b.cancel -side left
|
||
|
|
standard_button_box $a.b
|
||
|
|
pack $a.b -fill x -expand yes -side bottom -padx 5 -pady 5
|
||
|
|
center_window $a -over [winfo toplevel [namespace tail $this]]
|
||
|
|
pack $a.slb -side top -fill both -expand yes
|
||
|
|
bind $a.b.ok <Return> "$a.b.ok flash; $a.b.ok invoke"
|
||
|
|
focus $a.b.ok
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: do_thread_bp - callback from thread selection
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::do_thread_bp {listbox} {
|
||
|
|
# debug "$listbox [$listbox curselection]"
|
||
|
|
set x ""
|
||
|
|
foreach i [$listbox curselection] {
|
||
|
|
lappend x $id($i)
|
||
|
|
}
|
||
|
|
$this set_bp_at_line N {} -1 $x
|
||
|
|
destroy [winfo toplevel $listbox]
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
# public method for testing use only!
|
||
|
|
itcl::body SrcTextWin::test_get {var} {
|
||
|
|
if {[array exists $var]} {
|
||
|
|
return [array get $var]
|
||
|
|
} else {
|
||
|
|
return [set $var]
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: get_file - Return name of current file.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::get_file {} {
|
||
|
|
return $current(filename)
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: clear_file - Clear out state so that user may load
|
||
|
|
# new executable. For the SrcTextWin class, this means:
|
||
|
|
#
|
||
|
|
# Delete all srctextwin caches
|
||
|
|
# Delete the variable balloon if it exists.
|
||
|
|
# Clear the screen.
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::clear_file {} {
|
||
|
|
|
||
|
|
debug "In clear_file"
|
||
|
|
# delete all caches
|
||
|
|
_clear_cache
|
||
|
|
|
||
|
|
set oldpane {}
|
||
|
|
|
||
|
|
# clear window
|
||
|
|
# FIXME - We don't do this here, because is causes a wierd error
|
||
|
|
# where the "Source file more recent than executible" error gets
|
||
|
|
# for no apparent reason. This only effects the case where the
|
||
|
|
# user types just "file" in the command line, then the window will
|
||
|
|
# not get cleared.
|
||
|
|
|
||
|
|
# delete variable balloon
|
||
|
|
catch {$_balloon_var delete}
|
||
|
|
set _balloon_var {}
|
||
|
|
|
||
|
|
# reinit state
|
||
|
|
_initialize_srctextwin
|
||
|
|
|
||
|
|
# update the screen
|
||
|
|
update idletasks
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
itcl::body SrcTextWin::_initialize_srctextwin {} {
|
||
|
|
set pc(filename) ""
|
||
|
|
set pc(func) ""
|
||
|
|
set pc(line) 0
|
||
|
|
set pc(addr) ""
|
||
|
|
set pc(asm_line) 0
|
||
|
|
set pc(lib) ""
|
||
|
|
set current(filename) ""
|
||
|
|
set current(funcname) ""
|
||
|
|
set current(line) 0
|
||
|
|
set current(addr) ""
|
||
|
|
set current(asm_line) 0
|
||
|
|
set current(tag) "BROWSE_TAG"
|
||
|
|
set current(mode) "SOURCE"
|
||
|
|
set current(lib) ""
|
||
|
|
}
|
||
|
|
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
# METHOD: _clear_cache - Clear the cache
|
||
|
|
# ------------------------------------------------------------------
|
||
|
|
itcl::body SrcTextWin::_clear_cache {} {
|
||
|
|
|
||
|
|
# display empty scratch frame
|
||
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
||
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
||
|
|
$win delete 0.0 end
|
||
|
|
$itk_interior.p show $pane
|
||
|
|
|
||
|
|
# delete all cached frames
|
||
|
|
foreach p [array names Stwc *:pane] {
|
||
|
|
set p [lindex [split $p :] 0]
|
||
|
|
if {$p != "gdbtk_scratch_widget"} {
|
||
|
|
catch {
|
||
|
|
#debug "clearing cache: \"$p\""
|
||
|
|
$itk_interior.p delete $Stwc($p:pane)
|
||
|
|
unset Stwc($p:pane)
|
||
|
|
unset Stwc($p:mtime)
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
_initialize_srctextwin
|
||
|
|
set filenum 0
|
||
|
|
set Cname ""
|
||
|
|
set _tpane pane$filenum
|
||
|
|
incr filenum
|
||
|
|
set _bpane ""
|
||
|
|
}
|