1 |
578 |
markom |
# Paned text widget for source code, for Insight
|
2 |
|
|
# Copyright 1997, 1998, 1999, 2001 Red Hat, Inc.
|
3 |
|
|
#
|
4 |
|
|
# This program is free software; you can redistribute it and/or modify it
|
5 |
|
|
# under the terms of the GNU General Public License (GPL) as published by
|
6 |
|
|
# the Free Software Foundation; either version 2 of the License, or (at
|
7 |
|
|
# your option) any later version.
|
8 |
|
|
#
|
9 |
|
|
# This program is distributed in the hope that it will be useful,
|
10 |
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
11 |
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
12 |
|
|
# GNU General Public License for more details.
|
13 |
|
|
|
14 |
|
|
|
15 |
|
|
# ----------------------------------------------------------------------
|
16 |
|
|
# Implements the paned text widget with the source code in it.
|
17 |
|
|
# This widget is typically embedded in a SrcWin widget.
|
18 |
|
|
#
|
19 |
|
|
# ----------------------------------------------------------------------
|
20 |
|
|
|
21 |
|
|
# ------------------------------------------------------------------
|
22 |
|
|
# CONSTRUCTOR - create new source text window
|
23 |
|
|
# ------------------------------------------------------------------
|
24 |
|
|
body SrcTextWin::constructor {args} {
|
25 |
|
|
eval itk_initialize $args
|
26 |
|
|
set top [winfo toplevel $itk_interior]
|
27 |
|
|
if {$parent == {}} {
|
28 |
|
|
set parent [winfo parent $itk_interior]
|
29 |
|
|
}
|
30 |
|
|
|
31 |
|
|
if {![info exists break_images(bp)]} {
|
32 |
|
|
set size [font measure [pref get gdb/src/font] "W"]
|
33 |
|
|
set break_images(bp) [makeBreakDot $size \
|
34 |
|
|
[pref get gdb/src/bp_fg]]
|
35 |
|
|
set break_images(temp_bp) [makeBreakDot $size \
|
36 |
|
|
[pref get gdb/src/temp_bp_fg]]
|
37 |
|
|
set break_images(disabled_bp) [makeBreakDot $size \
|
38 |
|
|
[pref get gdb/src/disabled_fg]]
|
39 |
|
|
set break_images(tp) [makeBreakDot $size \
|
40 |
|
|
[pref get gdb/src/trace_fg]]
|
41 |
|
|
set break_images(thread_bp) [makeBreakDot $size \
|
42 |
|
|
[pref get gdb/src/thread_fg]]
|
43 |
|
|
set break_images(bp_and_tp) [makeBreakDot $size \
|
44 |
|
|
[list [pref get gdb/src/trace_fg] \
|
45 |
|
|
[pref get gdb/src/bp_fg]]]
|
46 |
|
|
}
|
47 |
|
|
|
48 |
|
|
if {$ignore_var_balloons} {
|
49 |
|
|
set UseVariableBalloons 0
|
50 |
|
|
} else {
|
51 |
|
|
set UseVariableBalloons [pref get gdb/src/variableBalloons]
|
52 |
|
|
}
|
53 |
|
|
|
54 |
|
|
set Linenums [pref get gdb/src/linenums]
|
55 |
|
|
|
56 |
|
|
#Initialize state variables
|
57 |
|
|
_initialize_srctextwin
|
58 |
|
|
|
59 |
|
|
build_popups
|
60 |
|
|
build_win
|
61 |
|
|
|
62 |
|
|
# add hooks
|
63 |
|
|
if {$Tracing} {
|
64 |
|
|
add_hook control_mode_hook "$this set_control_mode"
|
65 |
|
|
add_hook gdb_trace_find_hook "$this trace_find_hook"
|
66 |
|
|
}
|
67 |
|
|
|
68 |
|
|
if {$UseVariableBalloons} {
|
69 |
|
|
add_hook gdb_idle_hook "$this updateBalloon"
|
70 |
|
|
}
|
71 |
|
|
global ${this}_balloon
|
72 |
|
|
trace variable ${this}_balloon w "$this trace_help"
|
73 |
|
|
|
74 |
|
|
}
|
75 |
|
|
|
76 |
|
|
# ------------------------------------------------------------------
|
77 |
|
|
# DESTRUCTOR - destroy window containing widget
|
78 |
|
|
# ------------------------------------------------------------------
|
79 |
|
|
body SrcTextWin::destructor {} {
|
80 |
|
|
if {$Tracing} {
|
81 |
|
|
remove_hook control_mode_hook "$this set_control_mode"
|
82 |
|
|
}
|
83 |
|
|
if {$UseVariableBalloons} {
|
84 |
|
|
remove_hook gdb_idle_hook "$this updateBalloon"
|
85 |
|
|
}
|
86 |
|
|
}
|
87 |
|
|
|
88 |
|
|
# ------------------------------------------------------------------
|
89 |
|
|
# METHOD: trace_find_hook - response to the tfind command. All we
|
90 |
|
|
# need to do here is to remove the trace tags, if we are exiting
|
91 |
|
|
# trace mode
|
92 |
|
|
# ------------------------------------------------------------------
|
93 |
|
|
body SrcTextWin::trace_find_hook {mode from_tty} {
|
94 |
|
|
if {[string compare $mode -1] == 0} {
|
95 |
|
|
if {$Browsing} {
|
96 |
|
|
$twin tag remove STACK_TAG 1.0 end
|
97 |
|
|
}
|
98 |
|
|
}
|
99 |
|
|
}
|
100 |
|
|
|
101 |
|
|
# ------------------------------------------------------------------
|
102 |
|
|
# METHOD: set_control_mode- switches the src window between
|
103 |
|
|
# browsing -> mode = 1
|
104 |
|
|
# controlling -> mode = 0
|
105 |
|
|
# ------------------------------------------------------------------
|
106 |
|
|
body SrcTextWin::set_control_mode {mode} {
|
107 |
|
|
# debug "Setting control mode of $twin to $mode"
|
108 |
|
|
if {$mode} {
|
109 |
|
|
set Browsing 1
|
110 |
|
|
} else {
|
111 |
|
|
set Browsing 0
|
112 |
|
|
}
|
113 |
|
|
|
114 |
|
|
switch $current(mode) {
|
115 |
|
|
SOURCE {
|
116 |
|
|
config_win $twin
|
117 |
|
|
}
|
118 |
|
|
ASSEMBLY {
|
119 |
|
|
config_win $twin A
|
120 |
|
|
}
|
121 |
|
|
MIXED {
|
122 |
|
|
config_win $twin M
|
123 |
|
|
}
|
124 |
|
|
SRC+ASM {
|
125 |
|
|
config_win $twin
|
126 |
|
|
config_win $bwin A
|
127 |
|
|
}
|
128 |
|
|
}
|
129 |
|
|
|
130 |
|
|
}
|
131 |
|
|
|
132 |
|
|
# ------------------------------------------------------------------
|
133 |
|
|
# METHOD: build_popups - build the popups for the source window(s)
|
134 |
|
|
# ------------------------------------------------------------------
|
135 |
|
|
#
|
136 |
|
|
# The popups array holds the data for the breakpoint & tracepoint popup menus.
|
137 |
|
|
# The elements are:
|
138 |
|
|
# Menus:
|
139 |
|
|
# break_rgn - the popup for clicking in a bare break region
|
140 |
|
|
# bp - the popup for clicking on a set breakpoint
|
141 |
|
|
# tp - the popup for clicking on a set tracepoint
|
142 |
|
|
# bp_and_tp - the popup for clicking on the break_region when the
|
143 |
|
|
# line contains both a bp & a tp
|
144 |
|
|
# source - the popup for clicking on the source region of the window
|
145 |
|
|
#
|
146 |
|
|
# State:
|
147 |
|
|
# saved_y - the y value of the mouse click that posted the popup
|
148 |
|
|
# saved_win- the Tk window which recieved the posting click
|
149 |
|
|
#
|
150 |
|
|
# Disable info:
|
151 |
|
|
# run_disabled - a list of {menu entry} pairs for all the menus that
|
152 |
|
|
# should be disabled when you are not running
|
153 |
|
|
# browse_disabled - a similar list for menus that should be disabled
|
154 |
|
|
# when you are browsing a trace expt.
|
155 |
|
|
#
|
156 |
|
|
body SrcTextWin::build_popups {} {
|
157 |
|
|
|
158 |
|
|
set popups(bp) $itk_interior.bp_menu
|
159 |
|
|
set popups(tp) $itk_interior.tp_menu
|
160 |
|
|
set popups(bp_and_tp) $itk_interior.tp_bp_menu
|
161 |
|
|
set popups(tp_browse) $itk_interior.tp_browse_menu
|
162 |
|
|
set popups(break_rgn) $itk_interior.break_menu
|
163 |
|
|
set popups(source) $itk_interior.src_menu
|
164 |
|
|
set popups(disabled_bp) $itk_interior.disabled_bp_menu
|
165 |
|
|
|
166 |
|
|
# This is a scratch popup menu we use when we are not over a bp...
|
167 |
|
|
if {![winfo exists $popups(source)]} {
|
168 |
|
|
menu $popups(source) -tearoff 0
|
169 |
|
|
}
|
170 |
|
|
|
171 |
|
|
if {![winfo exists $popups(break_rgn)]} {
|
172 |
|
|
# breakpoint popup menu
|
173 |
|
|
# don't enable hardware or conditional breakpoints until they are tested
|
174 |
|
|
menu $popups(break_rgn) -tearoff 0
|
175 |
|
|
|
176 |
|
|
set bp_fg [pref get gdb/src/bp_fg]
|
177 |
|
|
set tp_fg [pref get gdb/src/trace_fg]
|
178 |
|
|
|
179 |
|
|
if {[pref get gdb/control_target]} {
|
180 |
|
|
|
181 |
|
|
addPopup break_rgn "Continue to Here" "$this continue_to_here" \
|
182 |
|
|
[pref get gdb/src/PC_TAG] 0 0
|
183 |
|
|
addPopup break_rgn "Jump to Here" "$this jump_to_here" \
|
184 |
|
|
[pref get gdb/src/PC_TAG] 0 0
|
185 |
|
|
$popups(break_rgn) add separator
|
186 |
|
|
|
187 |
|
|
addPopup break_rgn "Set Breakpoint" "$this set_bp_at_line" $bp_fg
|
188 |
|
|
|
189 |
|
|
lappend popups(break_rgn-browse) 1
|
190 |
|
|
lappend popups(break_rgn-control) 1
|
191 |
|
|
|
192 |
|
|
addPopup break_rgn "Set Temporary Breakpoint" "$this set_bp_at_line T" \
|
193 |
|
|
[pref get gdb/src/temp_bp_fg]
|
194 |
|
|
|
195 |
|
|
addPopup break_rgn "Set Breakpoint on Thread(s)..." \
|
196 |
|
|
"$this ask_thread_bp" [pref get gdb/src/thread_fg] 0 0
|
197 |
|
|
}
|
198 |
|
|
|
199 |
|
|
if {$Tracing} {
|
200 |
|
|
$popups(break_rgn) add separator
|
201 |
|
|
addPopup break_rgn "Set Tracepoint" "$this set_tp_at_line" $tp_fg
|
202 |
|
|
}
|
203 |
|
|
|
204 |
|
|
}
|
205 |
|
|
|
206 |
|
|
if {![winfo exists $popups(bp)]} {
|
207 |
|
|
# this popup is used when the line contains a set breakpoint
|
208 |
|
|
menu $popups(bp) -tearoff 0
|
209 |
|
|
|
210 |
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
211 |
|
|
addPopup bp "Continue to Here" "$this continue_to_here" {} 0 0
|
212 |
|
|
addPopup bp "Jump to Here" "$this jump_to_here" {} 0 0
|
213 |
|
|
$popups(bp) add separator
|
214 |
|
|
|
215 |
|
|
addPopup bp "Disable Breakpoint" "$this enable_disable_at_line disable" \
|
216 |
|
|
$bp_fg
|
217 |
|
|
$popups(bp) add separator
|
218 |
|
|
}
|
219 |
|
|
|
220 |
|
|
addPopup bp "Delete Breakpoint" "$this remove_bp_at_line"
|
221 |
|
|
|
222 |
|
|
# Currently you cannot set a tracepoint and a breakpoint at the same line...
|
223 |
|
|
#
|
224 |
|
|
# if {$Tracing} {
|
225 |
|
|
# addPopup bp "Set Tracepoint" "$this set_tp_at_line" $tp_fg
|
226 |
|
|
# }
|
227 |
|
|
}
|
228 |
|
|
|
229 |
|
|
if {![winfo exists $popups(tp)]} {
|
230 |
|
|
# This is the popup to use when the line contains a set tracepoint
|
231 |
|
|
|
232 |
|
|
menu $popups(tp) -tearoff 0
|
233 |
|
|
|
234 |
|
|
if {[pref get gdb/control_target]} {
|
235 |
|
|
|
236 |
|
|
addPopup tp "Continue to Here" "$this continue_to_here" green 0 0
|
237 |
|
|
addPopup tp "Jump to Here" "$this jump_to_here" {} 0 0
|
238 |
|
|
# $popups(tp) add separator
|
239 |
|
|
|
240 |
|
|
# Currently you cannot set a tracepoint and a breakpoint at the same line...
|
241 |
|
|
#
|
242 |
|
|
# addPopup tp "Set Breakpoint" "$this set_bp_at_line" $bp_fg
|
243 |
|
|
|
244 |
|
|
# addPopup tp "Set Temporary Breakpoint" "$this set_bp_at_line T" \
|
245 |
|
|
# [pref get gdb/src/temp_bp_fg]
|
246 |
|
|
|
247 |
|
|
# addPopup tp "Set Breakpoint on Thread(s)..." \
|
248 |
|
|
# "$this ask_thread_bp" \
|
249 |
|
|
# [pref get gdb/src/thread_fg] 0 0
|
250 |
|
|
}
|
251 |
|
|
|
252 |
|
|
if {$Tracing} {
|
253 |
|
|
$popups(tp) add separator
|
254 |
|
|
addPopup tp "Modify Tracepoint" "$this set_tp_at_line" $tp_fg
|
255 |
|
|
addPopup tp "Delete Tracepoint" "$this remove_tp_at_line" $tp_fg
|
256 |
|
|
}
|
257 |
|
|
}
|
258 |
|
|
|
259 |
|
|
# This is not currently used, since you can't set a bp & a tp on the same line.
|
260 |
|
|
# N.B. however, we don't exclude this on the command line, but...
|
261 |
|
|
|
262 |
|
|
if {![winfo exists $popups(bp_and_tp)]} {
|
263 |
|
|
|
264 |
|
|
# this popup is used when the line contains a set breakpoint & tracepoint
|
265 |
|
|
menu $popups(bp_and_tp) -tearoff 0
|
266 |
|
|
|
267 |
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
268 |
|
|
addPopup bp_and_tp "Continue to Here" "$this continue_to_here" \
|
269 |
|
|
green 0 0
|
270 |
|
|
addPopup bp_and_tp "Jump to Here" "$this jump_to_here" \
|
271 |
|
|
green 0 0
|
272 |
|
|
$popups(bp_and_tp) add separator
|
273 |
|
|
}
|
274 |
|
|
|
275 |
|
|
addPopup bp_and_tp "Delete Breakpoint" "$this remove_bp_at_line" $bp_fg
|
276 |
|
|
if {$Tracing} {
|
277 |
|
|
addPopup bp_and_tp "Modify Tracepoint" "$this set_tp_at_line" $tp_fg
|
278 |
|
|
addPopup bp_and_tp "Delete Tracepoint" \
|
279 |
|
|
"$this remove_tp_at_line" $tp_fg
|
280 |
|
|
}
|
281 |
|
|
}
|
282 |
|
|
|
283 |
|
|
if {![winfo exists $popups(disabled_bp)]} {
|
284 |
|
|
menu $popups(disabled_bp) -tearoff 0
|
285 |
|
|
|
286 |
|
|
addPopup disabled_bp "Enable Breakpoint" \
|
287 |
|
|
"$this enable_disable_at_line enable" $bp_fg
|
288 |
|
|
|
289 |
|
|
$popups(disabled_bp) add separator
|
290 |
|
|
addPopup disabled_bp "Delete Breakpoint" "$this remove_bp_at_line"
|
291 |
|
|
}
|
292 |
|
|
|
293 |
|
|
if {![winfo exists $popups(tp_browse)]} {
|
294 |
|
|
|
295 |
|
|
# this popup is on a tracepoint when browsing.
|
296 |
|
|
|
297 |
|
|
menu $popups(tp_browse) -tearoff 0
|
298 |
|
|
addPopup tp_browse "Next hit Here" "$this next_hit_at_line" \
|
299 |
|
|
green
|
300 |
|
|
}
|
301 |
|
|
}
|
302 |
|
|
|
303 |
|
|
# ------------------------------------------------------------------
|
304 |
|
|
# METHOD: build_win - build the main source paned window
|
305 |
|
|
# ------------------------------------------------------------------
|
306 |
|
|
body SrcTextWin::build_win {} {
|
307 |
|
|
cyg::panedwindow $itk_interior.p -background white
|
308 |
|
|
|
309 |
|
|
set _tpane pane$filenum
|
310 |
|
|
incr filenum
|
311 |
|
|
|
312 |
|
|
$itk_interior.p add $_tpane
|
313 |
|
|
set pane1 [$itk_interior.p childsite $_tpane]
|
314 |
|
|
set Stwc(gdbtk_scratch_widget:pane) $_tpane
|
315 |
|
|
set Stwc(gdbtk_scratch_widget:dirty) 0
|
316 |
|
|
|
317 |
|
|
set twinp [iwidgets::scrolledtext $pane1.st -textbackground white \
|
318 |
|
|
-hscrollmode dynamic -vscrollmode dynamic]
|
319 |
|
|
set twin [$twinp component text]
|
320 |
|
|
pack $twinp -fill both -expand yes
|
321 |
|
|
pack $itk_interior.p -fill both -expand yes
|
322 |
|
|
config_win $twin
|
323 |
|
|
}
|
324 |
|
|
|
325 |
|
|
# ------------------------------------------------------------------
|
326 |
|
|
# METHOD: SetRunningState - set state based on if GDB is running or not.
|
327 |
|
|
# This disables the popup menus when GDB is not running yet.
|
328 |
|
|
# ------------------------------------------------------------------
|
329 |
|
|
body SrcTextWin::SetRunningState {state} {
|
330 |
|
|
# debug "$state"
|
331 |
|
|
foreach elem $popups(run_disabled) {
|
332 |
|
|
$popups([lindex $elem 0]) entryconfigure [lindex $elem 1] -state $state
|
333 |
|
|
}
|
334 |
|
|
}
|
335 |
|
|
|
336 |
|
|
# ------------------------------------------------------------------
|
337 |
|
|
# METHOD: enable - enable or disable bindings and change cursor
|
338 |
|
|
# ------------------------------------------------------------------
|
339 |
|
|
body SrcTextWin::enable {on} {
|
340 |
|
|
if {$on} {
|
341 |
|
|
set Running 0
|
342 |
|
|
set glyph ""
|
343 |
|
|
set bnd ""
|
344 |
|
|
set status normal
|
345 |
|
|
} else {
|
346 |
|
|
set Running 1
|
347 |
|
|
set glyph watch
|
348 |
|
|
set bnd "break"
|
349 |
|
|
set status disabled
|
350 |
|
|
}
|
351 |
|
|
|
352 |
|
|
bind $twin $bnd
|
353 |
|
|
bind $twin $bnd
|
354 |
|
|
bind $twin $bnd
|
355 |
|
|
enable_disable_src_tags $twin $status
|
356 |
|
|
if {$bwin != ""} {
|
357 |
|
|
bind $bwin $bnd
|
358 |
|
|
bind $bwin $bnd
|
359 |
|
|
bind $bwin $bnd
|
360 |
|
|
enable_disable_src_tags $bwin $status
|
361 |
|
|
}
|
362 |
|
|
|
363 |
|
|
$twin configure -cursor $glyph
|
364 |
|
|
if {$bwin != ""} {
|
365 |
|
|
$bwin configure -cursor $glyph
|
366 |
|
|
}
|
367 |
|
|
}
|
368 |
|
|
|
369 |
|
|
# ------------------------------------------------------------------
|
370 |
|
|
# PROC: makeBreakDot - make the break dot for the screen
|
371 |
|
|
# ------------------------------------------------------------------
|
372 |
|
|
body SrcTextWin::makeBreakDot {size colorList {image {}}} {
|
373 |
|
|
if {$size > 32} {
|
374 |
|
|
set size 32
|
375 |
|
|
} elseif {$size < 1} {
|
376 |
|
|
set size 1
|
377 |
|
|
}
|
378 |
|
|
|
379 |
|
|
if {$image == ""} {
|
380 |
|
|
set image [image create photo -width $size -height $size]
|
381 |
|
|
} else {
|
382 |
|
|
$image blank
|
383 |
|
|
$image configure -width $size -height $size
|
384 |
|
|
}
|
385 |
|
|
|
386 |
|
|
if {[llength $colorList] == 1} {
|
387 |
|
|
set x1 1
|
388 |
|
|
set x2 [expr {1 + $size}]
|
389 |
|
|
set y1 1
|
390 |
|
|
set y2 $x2
|
391 |
|
|
$image put $colorList -to 1 1 $x2 $y2
|
392 |
|
|
} else {
|
393 |
|
|
set x1 1
|
394 |
|
|
set x3 [expr {1 + $size}]
|
395 |
|
|
set x2 [expr int((1 + $size)/2)]
|
396 |
|
|
set y1 1
|
397 |
|
|
set y2 $x3
|
398 |
|
|
$image put [lindex $colorList 0] -to 1 1 $x2 $y2
|
399 |
|
|
$image put [lindex $colorList 1] -to [expr $x2 + 1] 1 $x3 $y2
|
400 |
|
|
}
|
401 |
|
|
|
402 |
|
|
return $image
|
403 |
|
|
}
|
404 |
|
|
|
405 |
|
|
# ------------------------------------------------------------------
|
406 |
|
|
# METHOD: setTabs - set the tabs for the assembly/src windows
|
407 |
|
|
# ------------------------------------------------------------------
|
408 |
|
|
body SrcTextWin::setTabs {win {asm S}} {
|
409 |
|
|
set fsize [font measure src-font "W"]
|
410 |
|
|
set tsize [pref get gdb/src/tab_size]
|
411 |
|
|
set rest ""
|
412 |
|
|
|
413 |
|
|
if {[string compare $asm "S"] != 0} {
|
414 |
|
|
set first [expr {$fsize * 12}]
|
415 |
|
|
set second [expr {$fsize * 13}]
|
416 |
|
|
set third [expr {$fsize * 34}]
|
417 |
|
|
for {set i 1} {$i < 8} {incr i} {
|
418 |
|
|
lappend rest [expr {(34 + ($i * $tsize)) * $fsize}] left
|
419 |
|
|
}
|
420 |
|
|
set tablist [concat [list $first right $second left $third left] $rest]
|
421 |
|
|
} else {
|
422 |
|
|
# SOURCE window
|
423 |
|
|
# The first tab right-justifies the line numbers and the second
|
424 |
|
|
# tab is the left margin for the start on the source code. The remaining
|
425 |
|
|
# tabs should be regularly spaced depending on prefs.
|
426 |
|
|
if {$Linenums} {
|
427 |
|
|
set first [expr {$fsize * 6}] ;# "- " plus 4 digit line number
|
428 |
|
|
set second [expr {$fsize * 7}] ;# plus a space after the number
|
429 |
|
|
for {set i 1} {$i < 8} {incr i} {
|
430 |
|
|
lappend rest [expr {(7 + ($i * $tsize)) * $fsize}] left
|
431 |
|
|
}
|
432 |
|
|
set tablist [concat [list $first right $second left] $rest]
|
433 |
|
|
} else {
|
434 |
|
|
set first [expr {$fsize * 2}]
|
435 |
|
|
for {set i 1} {$i < 8} {incr i} {
|
436 |
|
|
lappend rest [expr {(2 + ($i * $tsize)) * $fsize}] left
|
437 |
|
|
}
|
438 |
|
|
set tablist [concat [list $first left] $rest]
|
439 |
|
|
}
|
440 |
|
|
}
|
441 |
|
|
$win configure -tabs $tablist
|
442 |
|
|
}
|
443 |
|
|
|
444 |
|
|
body SrcTextWin::enable_disable_src_tags {win how} {
|
445 |
|
|
|
446 |
|
|
switch $how {
|
447 |
|
|
normal {
|
448 |
|
|
set cur1 dot
|
449 |
|
|
set cur2 xterm
|
450 |
|
|
}
|
451 |
|
|
disabled {
|
452 |
|
|
set cur1 watch
|
453 |
|
|
set cur2 $cur1
|
454 |
|
|
}
|
455 |
|
|
browse {
|
456 |
|
|
set cur1 dot
|
457 |
|
|
set cur2 xterm
|
458 |
|
|
}
|
459 |
|
|
}
|
460 |
|
|
|
461 |
|
|
if {[string compare $how browse] == 0} {
|
462 |
|
|
|
463 |
|
|
$win tag bind break_rgn_tag { }
|
464 |
|
|
$win tag bind break_rgn_tag { }
|
465 |
|
|
|
466 |
|
|
foreach type $bp_types {
|
467 |
|
|
$win tag bind ${type}_tag { }
|
468 |
|
|
$win tag bind ${type}_tag { }
|
469 |
|
|
$win tag bind ${type}_tag { }
|
470 |
|
|
}
|
471 |
|
|
|
472 |
|
|
} else {
|
473 |
|
|
|
474 |
|
|
$win tag bind break_rgn_tag "$win config -cursor $cur1"
|
475 |
|
|
$win tag bind break_rgn_tag "$win config -cursor $cur2"
|
476 |
|
|
|
477 |
|
|
foreach type $bp_types {
|
478 |
|
|
$win tag bind ${type}_tag "$win config -cursor $cur1"
|
479 |
|
|
$win tag bind ${type}_tag "$this motion bp %W %x %y"
|
480 |
|
|
$win tag bind ${type}_tag \
|
481 |
|
|
"$this cancelMotion;$win config -cursor $cur2"
|
482 |
|
|
}
|
483 |
|
|
}
|
484 |
|
|
|
485 |
|
|
$win tag bind tp_tag "$win config -cursor $cur1"
|
486 |
|
|
$win tag bind tp_tag "$this motion bp %W %x %y"
|
487 |
|
|
$win tag bind tp_tag "$this cancelMotion;$win config -cursor $cur2"
|
488 |
|
|
}
|
489 |
|
|
|
490 |
|
|
# ------------------------------------------------------------------
|
491 |
|
|
# METHOD: config_win - configure the source or assembly text window
|
492 |
|
|
# ------------------------------------------------------------------
|
493 |
|
|
body SrcTextWin::config_win {win {asm S}} {
|
494 |
|
|
# debug "$win $asm Tracing=$Tracing Browsing=$Browsing"
|
495 |
|
|
|
496 |
|
|
$win config -borderwidth 2 -insertwidth 0 -wrap none -bg white
|
497 |
|
|
|
498 |
|
|
# font
|
499 |
|
|
set font [pref get gdb/src/font]
|
500 |
|
|
$win configure -font $font
|
501 |
|
|
|
502 |
|
|
setTabs $win $asm
|
503 |
|
|
|
504 |
|
|
# set up some tags. should probably be done differently
|
505 |
|
|
# !! change bg?
|
506 |
|
|
|
507 |
|
|
$win tag configure break_rgn_tag -foreground [pref get gdb/src/break_fg]
|
508 |
|
|
foreach type $bp_types {
|
509 |
|
|
$win tag configure ${type}_tag -foreground [pref get gdb/src/break_fg]
|
510 |
|
|
}
|
511 |
|
|
$win tag configure tp_tag -foreground [pref get gdb/src/break_fg]
|
512 |
|
|
$win tag configure source_tag2 -foreground [pref get gdb/src/source2_fg]
|
513 |
|
|
$win tag configure PC_TAG -background [pref get gdb/src/PC_TAG]
|
514 |
|
|
$win tag configure STACK_TAG -background [pref get gdb/src/STACK_TAG]
|
515 |
|
|
$win tag configure BROWSE_TAG -background [pref get gdb/src/BROWSE_TAG]
|
516 |
|
|
|
517 |
|
|
# search tag used to highlight searches
|
518 |
|
|
foreach option [$win tag configure sel] {
|
519 |
|
|
set op [lindex $option 0]
|
520 |
|
|
set val [lindex $option 4]
|
521 |
|
|
eval $win tag configure search $op $val
|
522 |
|
|
}
|
523 |
|
|
|
524 |
|
|
# bind mouse button 3 to the popup men
|
525 |
|
|
$win tag bind source_tag "$this do_source_popup %X %Y %x %y"
|
526 |
|
|
$win tag bind source_tag2 "$this do_source_popup %X %Y %x %y"
|
527 |
|
|
|
528 |
|
|
# bind mouse button 3 to the popup menus
|
529 |
|
|
if {!$Browsing} {
|
530 |
|
|
|
531 |
|
|
$win tag bind break_rgn_tag \
|
532 |
|
|
"$this do_tag_popup break_rgn %X %Y %y; break"
|
533 |
|
|
foreach type $bp_types {
|
534 |
|
|
if {$type == "disabled_bp"} then {
|
535 |
|
|
set tag disabled_bp
|
536 |
|
|
} else {
|
537 |
|
|
set tag bp
|
538 |
|
|
}
|
539 |
|
|
$win tag bind ${type}_tag \
|
540 |
|
|
"$this do_tag_popup $tag %X %Y %y; break"
|
541 |
|
|
}
|
542 |
|
|
$win tag bind tp_tag "$this do_tag_popup tp %X %Y %y; break"
|
543 |
|
|
$win tag bind bp_and_tp_tag "$this do_tag_popup bp_and_tp %X %Y %y; break"
|
544 |
|
|
} else {
|
545 |
|
|
$win tag bind tp_tag "$this do_tag_popup tp_browse %X %Y %y; break"
|
546 |
|
|
$win tag bind break_rgn_tag { }
|
547 |
|
|
foreach type $bp_types {
|
548 |
|
|
$win tag bind ${type}_tag { }
|
549 |
|
|
}
|
550 |
|
|
$win tag bind bp_and_tp_tag "$this do_tag_popup tp_browse %X %Y %y; break"
|
551 |
|
|
|
552 |
|
|
}
|
553 |
|
|
|
554 |
|
|
# Disable printing and cut and paste keys; makes the window readonly
|
555 |
|
|
# We do this so we don't have to enable and disable the
|
556 |
|
|
# text widget everytime we want to modify it.
|
557 |
|
|
|
558 |
|
|
bind $win {if {"%A" != "{}"} {break}}
|
559 |
|
|
bind $win break
|
560 |
|
|
bind $win {break}
|
561 |
|
|
|
562 |
|
|
# GDB key bindings
|
563 |
|
|
# We need to explicitly ignore keys with the Alt modifier, since
|
564 |
|
|
# otherwise they will interfere with selecting menus on Windows.
|
565 |
|
|
|
566 |
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
567 |
|
|
bind_plain_key $win c "$this do_key continue; break"
|
568 |
|
|
bind_plain_key $win r "$this do_key run; break"
|
569 |
|
|
bind_plain_key $win f "$this do_key finish; break"
|
570 |
|
|
} else {
|
571 |
|
|
bind_plain_key $win n "$this do_key tfind_next; break"
|
572 |
|
|
bind_plain_key $win p "$this do_key tfind_prev; break"
|
573 |
|
|
bind_plain_key $win f "$this do_key tfind_start; break"
|
574 |
|
|
bind_plain_key $win l "$this do_key tfind_line; break"
|
575 |
|
|
bind_plain_key $win h "$this do_key tfind_tp; break"
|
576 |
|
|
}
|
577 |
|
|
bind_plain_key $win u "$this do_key up; break"
|
578 |
|
|
bind_plain_key $win d "$this do_key down; break"
|
579 |
|
|
bind_plain_key $win x "$this do_key quit; break"
|
580 |
|
|
|
581 |
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
582 |
|
|
if {[string compare $asm "S"] != 0} {
|
583 |
|
|
bind_plain_key $win s "$this do_key stepi; break"
|
584 |
|
|
bind_plain_key $win n "$this do_key nexti; break"
|
585 |
|
|
} else {
|
586 |
|
|
bind_plain_key $win s "$this do_key step; break"
|
587 |
|
|
bind_plain_key $win n "$this do_key next; break"
|
588 |
|
|
}
|
589 |
|
|
}
|
590 |
|
|
|
591 |
|
|
bind_plain_key $win Control-h "$this do_key thread_list; break"
|
592 |
|
|
bind_plain_key $win Control-f "$this do_key browser; break"
|
593 |
|
|
bind_plain_key $win Control-d "$this do_key download; break"
|
594 |
|
|
bind_plain_key $win Control-p "$this do_key print"
|
595 |
|
|
bind_plain_key $win Control-u "$this do_key debug; break"
|
596 |
|
|
bind_plain_key $win Control-o [list $this do_key open]
|
597 |
|
|
bind_plain_key $win Control-a [list $this do_key attach]
|
598 |
|
|
bind_plain_key $win Control-w [code $this do_key close]
|
599 |
|
|
|
600 |
|
|
if {!$Browsing && [pref get gdb/control_target]} {
|
601 |
|
|
# Ctrl+F5 is another accelerator for Run
|
602 |
|
|
bind_plain_key $win Control-F5 "$this do_key run"
|
603 |
|
|
}
|
604 |
|
|
|
605 |
|
|
bind_plain_key $win Control-F11 "$this do_key debug"
|
606 |
|
|
bind_plain_key $win Alt-v "$win yview scroll -1 pages"
|
607 |
|
|
bind_plain_key $win Control-v [format {
|
608 |
|
|
%s yview scroll 1 pages
|
609 |
|
|
break
|
610 |
|
|
} $win]
|
611 |
|
|
|
612 |
|
|
# bind mouse button 1 to the breakpoint method or tracepoint,
|
613 |
|
|
# depending on the settings of the B1_behavior setting. We don't
|
614 |
|
|
# have to bind to bp_and_tp because that will fall through to either
|
615 |
|
|
# the tp or the bp tag. We have to put in the break so that we don't
|
616 |
|
|
# both remove & reinsert a BP when we have both a tp & a bp on the same line.
|
617 |
|
|
# If we are browsing, then disable Button-1
|
618 |
|
|
|
619 |
|
|
if {!$Browsing} {
|
620 |
|
|
if {[pref get gdb/B1_behavior]} {
|
621 |
|
|
$win tag bind break_rgn_tag "$this set_bp_at_line N $win %y; break"
|
622 |
|
|
foreach type $bp_types {
|
623 |
|
|
$win tag bind ${type}_tag "$this remove_bp_at_line $win %y; break"
|
624 |
|
|
}
|
625 |
|
|
$win tag bind tp_tag "$this set_bp_at_line N $win %y; break"
|
626 |
|
|
} else {
|
627 |
|
|
$win tag bind break_rgn_tag "$this set_tp_at_line $win %y; break"
|
628 |
|
|
foreach type $bp_types {
|
629 |
|
|
$win tag bind ${type}_tag "$this set_tp_at_line $win %y; break"
|
630 |
|
|
}
|
631 |
|
|
$win tag bind tp_tag "$this set_tp_at_line $win %y; break"
|
632 |
|
|
}
|
633 |
|
|
} else {
|
634 |
|
|
$win tag bind break_rgn_tag { }
|
635 |
|
|
foreach type $bp_types {
|
636 |
|
|
$win tag bind ${type}_tag { }
|
637 |
|
|
}
|
638 |
|
|
$win tag bind tp_tag { }
|
639 |
|
|
}
|
640 |
|
|
|
641 |
|
|
|
642 |
|
|
# avoid special handling of double and triple clicks in break area
|
643 |
|
|
bind $win [format {
|
644 |
|
|
if {[lsearch [%s tag names @%%x,%%y] break_rgn_tag] >= 0} {
|
645 |
|
|
break
|
646 |
|
|
}
|
647 |
|
|
} $win $win]
|
648 |
|
|
bind $win [format {
|
649 |
|
|
if {[lsearch [%s tag names @%%x,%%y] break_rgn_tag] >= 0} {
|
650 |
|
|
break
|
651 |
|
|
}
|
652 |
|
|
} $win $win]
|
653 |
|
|
|
654 |
|
|
# bind window shortcuts
|
655 |
|
|
bind_plain_key $win Control-s "$this do_key stack"
|
656 |
|
|
bind_plain_key $win Control-r "$this do_key registers"
|
657 |
|
|
bind_plain_key $win Control-m "$this do_key memory"
|
658 |
|
|
bind_plain_key $win Control-t "$this do_key watch"
|
659 |
|
|
bind_plain_key $win Control-l "$this do_key locals"
|
660 |
|
|
bind_plain_key $win Control-k "$this do_key kod"
|
661 |
|
|
if { !$Tracing } {
|
662 |
|
|
bind_plain_key $win Control-b "$this do_key breakpoints"
|
663 |
|
|
} else {
|
664 |
|
|
bind_plain_key $win Control-t "$this do_key tracepoints"
|
665 |
|
|
bind_plain_key $win Control-u "$this do_key tdump"
|
666 |
|
|
}
|
667 |
|
|
bind_plain_key $win Control-n "$this do_key console"
|
668 |
|
|
|
669 |
|
|
if {$Browsing} {
|
670 |
|
|
enable_disable_src_tags $win browse
|
671 |
|
|
} else {
|
672 |
|
|
enable_disable_src_tags $win normal
|
673 |
|
|
}
|
674 |
|
|
|
675 |
|
|
if {$UseVariableBalloons} {
|
676 |
|
|
$win tag bind source_tag "$this motion var %W %x %y"
|
677 |
|
|
$win tag bind source_tag "$this cancelMotion"
|
678 |
|
|
}
|
679 |
|
|
|
680 |
|
|
# Up/Down arrow key bindings
|
681 |
|
|
bind_plain_key $win Up [list %W yview scroll -1 units]
|
682 |
|
|
bind_plain_key $win Down [list %W yview scroll +1 units]
|
683 |
|
|
|
684 |
|
|
# Make key bindings usable immediately (without mouse click in window).
|
685 |
|
|
focus $win
|
686 |
|
|
}
|
687 |
|
|
|
688 |
|
|
# ------------------------------------------------------------------
|
689 |
|
|
# METHOD: addPopup - adds a popup to one of the source popup menus
|
690 |
|
|
# ------------------------------------------------------------------
|
691 |
|
|
body SrcTextWin::addPopup {menu label command {abg {}} {browse 1} {run 1}} {
|
692 |
|
|
|
693 |
|
|
if {$abg == ""} {
|
694 |
|
|
$popups($menu) add command -label $label -command $command
|
695 |
|
|
} else {
|
696 |
|
|
$popups($menu) add command -label $label -command $command \
|
697 |
|
|
-activebackground $abg
|
698 |
|
|
}
|
699 |
|
|
|
700 |
|
|
set index [$popups($menu) index last]
|
701 |
|
|
if {!$run} {
|
702 |
|
|
lappend popups(run_disabled) [list $menu $index]
|
703 |
|
|
}
|
704 |
|
|
if {!$browse} {
|
705 |
|
|
lappend popups(browse_disabled) [list $menu $index]
|
706 |
|
|
}
|
707 |
|
|
|
708 |
|
|
}
|
709 |
|
|
|
710 |
|
|
# ------------------------------------------------------------------
|
711 |
|
|
# PUBLIC METHOD: set_variable - Handle changes in the gdb variables
|
712 |
|
|
# changed through the "set" gdb command.
|
713 |
|
|
# ------------------------------------------------------------------
|
714 |
|
|
body SrcTextWin::set_variable {event} {
|
715 |
|
|
set var [$event get variable]
|
716 |
|
|
set val [$event get value]
|
717 |
|
|
debug "Set hook got called with $var $val"
|
718 |
|
|
switch $var {
|
719 |
|
|
disassembly-flavor {
|
720 |
|
|
disassembly_changed
|
721 |
|
|
}
|
722 |
|
|
}
|
723 |
|
|
}
|
724 |
|
|
|
725 |
|
|
# ------------------------------------------------------------------
|
726 |
|
|
# METHOD: disassembly_changed - The disassembly flavor has changed,
|
727 |
|
|
# mark all the cached assembly windows dirty, and force the
|
728 |
|
|
# visible window to be redisplayed.
|
729 |
|
|
# ------------------------------------------------------------------
|
730 |
|
|
body SrcTextWin::disassembly_changed {} {
|
731 |
|
|
foreach name [array names Stwc *:pane] {
|
732 |
|
|
debug "Looking at $name"
|
733 |
|
|
set vals [split $name ,]
|
734 |
|
|
if {([string compare [lindex $vals 1] "A"] == 0)
|
735 |
|
|
|| ([string compare [lindex $vals 1] "M"] == 0)} {
|
736 |
|
|
debug "Setting $name to dirty"
|
737 |
|
|
set Stwc([lindex $vals 0]:dirty) 1
|
738 |
|
|
}
|
739 |
|
|
}
|
740 |
|
|
|
741 |
|
|
if {[string compare $current(mode) "SOURCE"] != 0} {
|
742 |
|
|
location $current(tag) $current(filename) $current(funcname) $current(line) \
|
743 |
|
|
$current(addr) $pc(addr) $current(lib)
|
744 |
|
|
}
|
745 |
|
|
}
|
746 |
|
|
|
747 |
|
|
# ------------------------------------------------------------------
|
748 |
|
|
# METHOD: reconfig - used when preferences change
|
749 |
|
|
# ------------------------------------------------------------------
|
750 |
|
|
body SrcTextWin::reconfig {} {
|
751 |
|
|
# debug
|
752 |
|
|
|
753 |
|
|
# Make sure we redo the break images when we reconfigure
|
754 |
|
|
set size [font measure src-font "W"]
|
755 |
|
|
makeBreakDot $size [pref get gdb/src/bp_fg] $break_images(bp)
|
756 |
|
|
makeBreakDot $size [pref get gdb/src/temp_bp_fg] $break_images(temp_bp)
|
757 |
|
|
makeBreakDot $size [pref get gdb/src/disabled_fg] $break_images(disabled_bp)
|
758 |
|
|
makeBreakDot $size [pref get gdb/src/trace_fg] $break_images(tp)
|
759 |
|
|
makeBreakDot $size \
|
760 |
|
|
[list [pref get gdb/src/trace_fg] [pref get gdb/src/bp_fg]] \
|
761 |
|
|
$break_images(bp_and_tp)
|
762 |
|
|
makeBreakDot $size [pref get gdb/src/thread_fg] $break_images(thread_bp)
|
763 |
|
|
|
764 |
|
|
# Tags
|
765 |
|
|
$twin tag configure PC_TAG -background [pref get gdb/src/PC_TAG]
|
766 |
|
|
$twin tag configure STACK_TAG -background [pref get gdb/src/STACK_TAG]
|
767 |
|
|
$twin tag configure BROWSE_TAG -background [pref get gdb/src/BROWSE_TAG]
|
768 |
|
|
switch $current(mode) {
|
769 |
|
|
SOURCE {
|
770 |
|
|
setTabs $twin
|
771 |
|
|
}
|
772 |
|
|
SRC+ASM {
|
773 |
|
|
setTabs $twin
|
774 |
|
|
setTabs $bwin A
|
775 |
|
|
}
|
776 |
|
|
default {
|
777 |
|
|
setTabs $twin A
|
778 |
|
|
}
|
779 |
|
|
}
|
780 |
|
|
|
781 |
|
|
# Variable Balloons
|
782 |
|
|
if {$ignore_var_balloons} {
|
783 |
|
|
set balloons 0
|
784 |
|
|
} else {
|
785 |
|
|
set balloons [pref get gdb/src/variableBalloons]
|
786 |
|
|
}
|
787 |
|
|
if {$UseVariableBalloons != $balloons} {
|
788 |
|
|
set UseVariableBalloons $balloons
|
789 |
|
|
if {$UseVariableBalloons} {
|
790 |
|
|
$twin tag bind source_tag "$this motion var %W %x %y"
|
791 |
|
|
$twin tag bind source_tag "$this cancelMotion"
|
792 |
|
|
add_hook gdb_idle_hook [list $this updateBalloon]
|
793 |
|
|
} else {
|
794 |
|
|
cancelMotion
|
795 |
|
|
$twin tag bind source_tag {}
|
796 |
|
|
$twin tag bind source_tag {}
|
797 |
|
|
$twin tag remove _show_variable 1.0 end
|
798 |
|
|
remove_hook gdb_idle_hook [list $this updateBalloon]
|
799 |
|
|
}
|
800 |
|
|
}
|
801 |
|
|
|
802 |
|
|
# Tracing Hooks
|
803 |
|
|
catch {remove_hook control_mode_hook "$this set_control_mode"}
|
804 |
|
|
catch {remove_hook gdb_trace_find_hook "$this trace_find_hook"}
|
805 |
|
|
if {$Tracing} {
|
806 |
|
|
add_hook control_mode_hook "$this set_control_mode"
|
807 |
|
|
add_hook gdb_trace_find_hook "$this trace_find_hook"
|
808 |
|
|
}
|
809 |
|
|
|
810 |
|
|
# Popup colors
|
811 |
|
|
|
812 |
|
|
# need to rewrite because of the new addPopup function
|
813 |
|
|
# if {$Tracing} {
|
814 |
|
|
# $twin.bmenu entryconfigure 0 -activebackground [pref get gdb/src/trace_fg]
|
815 |
|
|
# } else {
|
816 |
|
|
# $twin.bmenu entryconfigure 0 -activebackground [pref get gdb/src/PC_TAG]
|
817 |
|
|
# $twin.bmenu entryconfigure 1 -activebackground [pref get gdb/src/bp_fg]
|
818 |
|
|
# $twin.bmenu entryconfigure 2 -activebackground \
|
819 |
|
|
# [pref get gdb/src/temp_bp_fg]
|
820 |
|
|
# $twin.bmenu entryconfigure 3 -activebackground \
|
821 |
|
|
# [pref get gdb/src/thread_fg]
|
822 |
|
|
# }
|
823 |
|
|
}
|
824 |
|
|
|
825 |
|
|
# ------------------------------------------------------------------
|
826 |
|
|
# METHOD: updateBalloon - we have gone idle, update the balloon
|
827 |
|
|
# ------------------------------------------------------------------
|
828 |
|
|
body SrcTextWin::updateBalloon {} {
|
829 |
|
|
|
830 |
|
|
set err [catch {$_balloon_var update} changed]
|
831 |
|
|
catch {$_balloon_var name} var
|
832 |
|
|
|
833 |
|
|
if {!$err} {
|
834 |
|
|
if {$changed != ""} {
|
835 |
|
|
# The variable's value has changed, so update the
|
836 |
|
|
# balloon with its new value
|
837 |
|
|
balloon register $twin "$var=[balloon_value $_balloon_var]" _show_variable
|
838 |
|
|
}
|
839 |
|
|
}
|
840 |
|
|
}
|
841 |
|
|
|
842 |
|
|
body SrcTextWin::balloon_value {variable} {
|
843 |
|
|
|
844 |
|
|
catch {$variable value} value
|
845 |
|
|
set value [string trim $value \ \r\t\n]
|
846 |
|
|
|
847 |
|
|
# Insert the variable's type for things like ptrs, etc.
|
848 |
|
|
catch {$variable type} type
|
849 |
|
|
if {$value == "{...}"} {
|
850 |
|
|
set val "$type $value"
|
851 |
|
|
} elseif {[regexp -- {0x([0-9a-fA-F]+) <[a-zA-Z_].*} $value str]} {
|
852 |
|
|
set val $str
|
853 |
|
|
} elseif {[string first * $type] != -1} {
|
854 |
|
|
set val "($type) $value"
|
855 |
|
|
} elseif {[string first \[ $type] != -1} {
|
856 |
|
|
set val "$type"
|
857 |
|
|
} else {
|
858 |
|
|
set val "$value"
|
859 |
|
|
}
|
860 |
|
|
|
861 |
|
|
return $val
|
862 |
|
|
}
|
863 |
|
|
|
864 |
|
|
# ------------------------------------------------------------------
|
865 |
|
|
# METHOD: ClearTags - clear all tags
|
866 |
|
|
# ------------------------------------------------------------------
|
867 |
|
|
body SrcTextWin::ClearTags {} {
|
868 |
|
|
foreach tag {PC_TAG BROWSE_TAG STACK_TAG} {
|
869 |
|
|
catch {
|
870 |
|
|
$twin tag remove $tag $current(line).2 $current(line).end
|
871 |
|
|
$twin tag remove $tag $pc(line).2 $pc(line).end
|
872 |
|
|
$twin tag remove $tag $current(asm_line).2 $current(asm_line).end
|
873 |
|
|
if {$bwin != ""} {
|
874 |
|
|
$bwin tag remove $tag $current(asm_line).2 $current(asm_line).end
|
875 |
|
|
}
|
876 |
|
|
}
|
877 |
|
|
}
|
878 |
|
|
}
|
879 |
|
|
|
880 |
|
|
# ------------------------------------------------------------------
|
881 |
|
|
# METHOD: _mtime_changed - check if the modtime for a file
|
882 |
|
|
# has changed.
|
883 |
|
|
# ------------------------------------------------------------------
|
884 |
|
|
body SrcTextWin::_mtime_changed {filename} {
|
885 |
|
|
global tcl_platform
|
886 |
|
|
|
887 |
|
|
if [catch {gdb_find_file $filename} f] {
|
888 |
|
|
set r 1
|
889 |
|
|
} elseif {$f == ""} {
|
890 |
|
|
set r 1
|
891 |
|
|
} else {
|
892 |
|
|
if {[string compare $tcl_platform(platform) "windows"] == 0} {
|
893 |
|
|
set f [ide_cygwin_path to_win32 $f]
|
894 |
|
|
}
|
895 |
|
|
if {[catch {file mtime $f} mtime]} {
|
896 |
|
|
debug "Could not stat file \"$f\" - \"$mtime\""
|
897 |
|
|
# The return code is not of much significance in this case
|
898 |
|
|
return 1
|
899 |
|
|
}
|
900 |
|
|
if {![info exists Stwc($filename:mtime)]} {
|
901 |
|
|
debug "no mtime. resetting to zero"
|
902 |
|
|
set Stwc($filename:mtime) 0
|
903 |
|
|
}
|
904 |
|
|
# debug "Stwc($filename:mtime)=$Stwc($filename:mtime); mtime=$mtime"
|
905 |
|
|
|
906 |
|
|
if {$mtime == $Stwc($filename:mtime)} {
|
907 |
|
|
set r 0
|
908 |
|
|
} else {
|
909 |
|
|
set r 1
|
910 |
|
|
set Stwc($filename:mtime) $mtime
|
911 |
|
|
set Stwc($filename:dirty) 1
|
912 |
|
|
}
|
913 |
|
|
}
|
914 |
|
|
|
915 |
|
|
return $r
|
916 |
|
|
}
|
917 |
|
|
|
918 |
|
|
# ------------------------------------------------------------------
|
919 |
|
|
# METHOD: FillSource - fill a window with source
|
920 |
|
|
# ------------------------------------------------------------------
|
921 |
|
|
body SrcTextWin::FillSource {w tagname filename funcname line addr pc_addr lib} {
|
922 |
|
|
global gdb_running
|
923 |
|
|
upvar ${w}win win
|
924 |
|
|
|
925 |
|
|
# debug "$gdb_running $tagname line=$line pc(line)=$pc(line)"
|
926 |
|
|
# debug "current(filename)=$current(filename) filename=$filename"
|
927 |
|
|
|
928 |
|
|
if {$filename != ""} {
|
929 |
|
|
# load new file if necessary
|
930 |
|
|
set mtime [_mtime_changed $filename]
|
931 |
|
|
if {[string compare $filename $current(filename)] != 0 \
|
932 |
|
|
|| $mode_changed || $mtime} {
|
933 |
|
|
if {![LoadFile $w $filename $lib $mtime]} {
|
934 |
|
|
# failed to find source file
|
935 |
|
|
dbug W "Changing to ASSEMBLY"
|
936 |
|
|
|
937 |
|
|
# We have to update this data here (it is also done by the caller)
|
938 |
|
|
# because we want to call mode, which calls mode_set, which calls
|
939 |
|
|
# location using these values.
|
940 |
|
|
set current(line) $line
|
941 |
|
|
set current(tag) $tagname
|
942 |
|
|
set current(addr) $addr
|
943 |
|
|
set current(funcname) $funcname
|
944 |
|
|
set current(filename) $filename
|
945 |
|
|
set current(lib) $lib
|
946 |
|
|
|
947 |
|
|
set oldmode SOURCE
|
948 |
|
|
$parent mode "" ASSEMBLY
|
949 |
|
|
return
|
950 |
|
|
}
|
951 |
|
|
if {$current(mode) != "SRC+ASM"} {
|
952 |
|
|
# reset this flag in FillAssembly for SRC+ASM mode
|
953 |
|
|
set mode_changed 0
|
954 |
|
|
}
|
955 |
|
|
}
|
956 |
|
|
|
957 |
|
|
# debug "cf=$current(filename) pc=$pc(filename) filename=$filename"
|
958 |
|
|
if {$current(filename) != ""} {
|
959 |
|
|
if {$gdb_running && $pc(filename) == $filename} {
|
960 |
|
|
# set the PC tag in this file
|
961 |
|
|
$win tag add PC_TAG $pc(line).2 $pc(line).end
|
962 |
|
|
}
|
963 |
|
|
if {$tagname != "PC_TAG"} {
|
964 |
|
|
if {$gdb_running && ($pc(filename) == $filename) \
|
965 |
|
|
&& ($pc(line) == $line)} {
|
966 |
|
|
# if the tag is on the same line as the PC, set a PC tag
|
967 |
|
|
$win tag add PC_TAG $line.2 $line.end
|
968 |
|
|
} else {
|
969 |
|
|
$win tag add $tagname $line.2 $line.end
|
970 |
|
|
}
|
971 |
|
|
}
|
972 |
|
|
if {$pc(filename) == $filename && $line == 0} {
|
973 |
|
|
# no line specified, so show line with PC
|
974 |
|
|
display_line $win $pc(line)
|
975 |
|
|
} else {
|
976 |
|
|
display_line $win $line
|
977 |
|
|
}
|
978 |
|
|
}
|
979 |
|
|
return
|
980 |
|
|
}
|
981 |
|
|
# no source; switch to assembly
|
982 |
|
|
dbug W "no source file; switch to assembly"
|
983 |
|
|
|
984 |
|
|
# We have to update this data here (it is also done by the caller)
|
985 |
|
|
# because we want to call mode, which calls mode_set, which calls
|
986 |
|
|
# location using these values.
|
987 |
|
|
set current(line) $line
|
988 |
|
|
set current(tag) $tagname
|
989 |
|
|
set current(addr) $addr
|
990 |
|
|
set current(funcname) $funcname
|
991 |
|
|
set current(filename) $filename
|
992 |
|
|
set current(lib) $lib
|
993 |
|
|
|
994 |
|
|
set oldmode $current(mode)
|
995 |
|
|
$parent mode "" ASSEMBLY
|
996 |
|
|
}
|
997 |
|
|
|
998 |
|
|
# ------------------------------------------------------------------
|
999 |
|
|
# METHOD: FillAssembly - fill a window with disassembled code
|
1000 |
|
|
# ------------------------------------------------------------------
|
1001 |
|
|
body SrcTextWin::FillAssembly {w tagname filename funcname line addr pc_addr lib} {
|
1002 |
|
|
global gdb_running
|
1003 |
|
|
upvar ${w}win win
|
1004 |
|
|
upvar _${w}pane pane
|
1005 |
|
|
# debug "$win $tagname $filename $funcname $line $addr $pc_addr"
|
1006 |
|
|
# debug "mode_changed=$mode_changed"
|
1007 |
|
|
# debug "funcname=$funcname"
|
1008 |
|
|
# debug "current(funcname)=$current(funcname)"
|
1009 |
|
|
if {$funcname == ""} {
|
1010 |
|
|
set oldpane $pane
|
1011 |
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
1012 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
1013 |
|
|
$win delete 0.0 end
|
1014 |
|
|
$win insert 0.0 "Select function name to disassemble"
|
1015 |
|
|
if {$oldpane != "" && $oldpane != $pane} {
|
1016 |
|
|
$itk_interior.p replace $oldpane $pane
|
1017 |
|
|
} else {
|
1018 |
|
|
$itk_interior.p show $pane
|
1019 |
|
|
}
|
1020 |
|
|
return
|
1021 |
|
|
} elseif {$funcname != $current(funcname) || $mode_changed
|
1022 |
|
|
|| ([info exists Stwc($addr:dirty)] && $Stwc($addr:dirty))} {
|
1023 |
|
|
set mode_changed 0
|
1024 |
|
|
set oldpane $pane
|
1025 |
|
|
set result [LoadFromCache $w $addr A $lib]
|
1026 |
|
|
if {$result == 1} {
|
1027 |
|
|
#debug [format "Disassembling at %x" $addr]
|
1028 |
|
|
#debug "cf=$current(filename) name=$filename"
|
1029 |
|
|
if {[catch {gdb_load_disassembly $win nosource \
|
1030 |
|
|
[scope _map] $Cname $addr} mess]} {
|
1031 |
|
|
# print some intelligent error message?
|
1032 |
|
|
dbug E "Disassemble failed: $mess"
|
1033 |
|
|
UnLoadFromCache $w $oldpane $addr A $lib
|
1034 |
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
1035 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
1036 |
|
|
$win delete 0.0 end
|
1037 |
|
|
$win insert 0.0 "Unable to Read Instructions at $addr"
|
1038 |
|
|
if {$oldpane != "" && $oldpane != $pane} {
|
1039 |
|
|
$itk_interior.p replace $oldpane $pane
|
1040 |
|
|
} else {
|
1041 |
|
|
$itk_interior.p show $pane
|
1042 |
|
|
}
|
1043 |
|
|
} else {
|
1044 |
|
|
foreach {asm_lo_addr asm_hi_addr} $mess {break}
|
1045 |
|
|
debug "Got low address: $asm_lo_addr and high: $asm_hi_addr"
|
1046 |
|
|
}
|
1047 |
|
|
} elseif {$result == 0} {
|
1048 |
|
|
debug "LoadFromCache returned 0"
|
1049 |
|
|
} else {
|
1050 |
|
|
# This branch should not ever happen. In assembly mode, there
|
1051 |
|
|
# are no checks in LoadFromCache that can fail.
|
1052 |
|
|
debug "LoadFromCache returned -1"
|
1053 |
|
|
}
|
1054 |
|
|
set current(filename) $filename
|
1055 |
|
|
set do_display_breaks 1
|
1056 |
|
|
}
|
1057 |
|
|
|
1058 |
|
|
# highlight proper line number
|
1059 |
|
|
_highlightAsmLine $win $addr $pc_addr $tagname $filename $funcname
|
1060 |
|
|
|
1061 |
|
|
display_line $win $current(asm_line)
|
1062 |
|
|
}
|
1063 |
|
|
|
1064 |
|
|
|
1065 |
|
|
# ------------------------------------------------------------------
|
1066 |
|
|
# METHOD: FillMixed - fill a window with mixed source and assembly
|
1067 |
|
|
# ------------------------------------------------------------------
|
1068 |
|
|
body SrcTextWin::FillMixed {w tagname filename funcname line addr pc_addr lib} {
|
1069 |
|
|
global gdb_running
|
1070 |
|
|
upvar ${w}win win
|
1071 |
|
|
upvar _${w}pane pane
|
1072 |
|
|
# debug "$win $tagname $filename $funcname $line $addr $pc_addr"
|
1073 |
|
|
|
1074 |
|
|
set asm_lo_addr ""
|
1075 |
|
|
|
1076 |
|
|
if {$funcname == ""} {
|
1077 |
|
|
set oldpane $pane
|
1078 |
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
1079 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
1080 |
|
|
$win delete 0.0 end
|
1081 |
|
|
$win insert 0.0 "Select function name to disassemble"
|
1082 |
|
|
if {$oldpane != ""} {
|
1083 |
|
|
$itk_interior.p replace $oldpane $pane
|
1084 |
|
|
} else {
|
1085 |
|
|
$itk_interior.p show $pane
|
1086 |
|
|
}
|
1087 |
|
|
} elseif {$funcname != $current(funcname) || $mode_changed
|
1088 |
|
|
|| ([info exists Stwc($funcname:dirty)] && $Stwc($funcname:dirty))} {
|
1089 |
|
|
set mode_changed 0
|
1090 |
|
|
set oldpane $pane
|
1091 |
|
|
if {[LoadFromCache $w $funcname M $lib]} {
|
1092 |
|
|
# debug [format "Disassembling at %x" $addr]
|
1093 |
|
|
if {[catch {gdb_load_disassembly $win source \
|
1094 |
|
|
[scope _map] $Cname $addr} mess] } {
|
1095 |
|
|
# print some intelligent error message
|
1096 |
|
|
dbug W "Disassemble Failed: $mess"
|
1097 |
|
|
UnLoadFromCache $w $oldpane $funcname M $lib
|
1098 |
|
|
set current(line) $line
|
1099 |
|
|
set current(tag) $tagname
|
1100 |
|
|
set current(addr) $addr
|
1101 |
|
|
set current(funcname) $funcname
|
1102 |
|
|
set current(filename) $filename
|
1103 |
|
|
set current(lib) $lib
|
1104 |
|
|
set oldmode MIXED
|
1105 |
|
|
$parent mode "" ASSEMBLY
|
1106 |
|
|
return
|
1107 |
|
|
} else {
|
1108 |
|
|
foreach {asm_lo_addr asm_hi_addr} $mess {break}
|
1109 |
|
|
debug "Got low address: $asm_lo_addr and high: $asm_hi_addr"
|
1110 |
|
|
}
|
1111 |
|
|
}
|
1112 |
|
|
set current(filename) $filename
|
1113 |
|
|
# now set the breakpoints
|
1114 |
|
|
set do_display_breaks 1
|
1115 |
|
|
}
|
1116 |
|
|
|
1117 |
|
|
# highlight proper line number
|
1118 |
|
|
_highlightAsmLine $win $addr $pc_addr $tagname $filename $funcname
|
1119 |
|
|
display_line $win $current(asm_line)
|
1120 |
|
|
}
|
1121 |
|
|
|
1122 |
|
|
# ------------------------------------------------------------------
|
1123 |
|
|
# METHOD: _highlightAsmLine - highlight the current execution line
|
1124 |
|
|
# in one of the assembly modes
|
1125 |
|
|
# ------------------------------------------------------------------
|
1126 |
|
|
body SrcTextWin::_highlightAsmLine {win addr pc_addr \
|
1127 |
|
|
tagname filename funcname} {
|
1128 |
|
|
global gdb_running
|
1129 |
|
|
|
1130 |
|
|
# Some architectures allow multiple instructions in each asm source
|
1131 |
|
|
# line...
|
1132 |
|
|
if {[info exists _map($Cname,pc=$addr)]} {
|
1133 |
|
|
set current(asm_line) $_map($Cname,pc=$addr)
|
1134 |
|
|
} else {
|
1135 |
|
|
set x [format "0x%x" [expr $current(addr)-2]]
|
1136 |
|
|
if {[info exists _map($Cname,pc=$x)]} {
|
1137 |
|
|
set current(asm_line) $_map($Cname,pc=$x)
|
1138 |
|
|
}
|
1139 |
|
|
}
|
1140 |
|
|
|
1141 |
|
|
# if current file has PC, highlight that too
|
1142 |
|
|
if {$gdb_running && $tagname != "PC_TAG" && $pc(filename) == $filename
|
1143 |
|
|
&& $pc(func) == $funcname} {
|
1144 |
|
|
set pc(asm_line) $_map($Cname,pc=$pc_addr)
|
1145 |
|
|
$win tag add PC_TAG $pc(asm_line).2 $pc(asm_line).end
|
1146 |
|
|
}
|
1147 |
|
|
|
1148 |
|
|
# don't set browse tag if it is at PC
|
1149 |
|
|
if {$pc_addr != $addr || $tagname == "PC_TAG"} {
|
1150 |
|
|
# HACK. In STACK mode we usually want the previous instruction
|
1151 |
|
|
# but not when we are browsing a trace experiment.
|
1152 |
|
|
if {[string compare $tagname "STACK_TAG"] == 0 && !$Browsing} {
|
1153 |
|
|
incr current(asm_line) -1
|
1154 |
|
|
}
|
1155 |
|
|
$win tag add $tagname $current(asm_line).2 $current(asm_line).end
|
1156 |
|
|
}
|
1157 |
|
|
}
|
1158 |
|
|
|
1159 |
|
|
# ------------------------------------------------------------------
|
1160 |
|
|
# METHOD: set_tag - update tag to STACK without making other changes
|
1161 |
|
|
# ------------------------------------------------------------------
|
1162 |
|
|
body SrcTextWin::set_tag_to_stack {} {
|
1163 |
|
|
foreach window [list $twin $bwin] {
|
1164 |
|
|
if {$window == ""} then {
|
1165 |
|
|
continue
|
1166 |
|
|
}
|
1167 |
|
|
foreach {start end} [$window tag ranges PC_TAG] {
|
1168 |
|
|
$window tag remove PC_TAG $start $end
|
1169 |
|
|
$window tag add STACK_TAG $start $end
|
1170 |
|
|
}
|
1171 |
|
|
}
|
1172 |
|
|
set current(tag) STACK_TAG
|
1173 |
|
|
}
|
1174 |
|
|
|
1175 |
|
|
# ------------------------------------------------------------------
|
1176 |
|
|
# METHOD: location - display a location in a file
|
1177 |
|
|
# ------------------------------------------------------------------
|
1178 |
|
|
body SrcTextWin::location {tagname filename funcname line addr pc_addr lib} {
|
1179 |
|
|
# debug "$tagname $filename $line $addr $pc_addr, mode=$current(mode) oldmode=$oldmode cf=$current(filename) lib=$lib"
|
1180 |
|
|
|
1181 |
|
|
ClearTags
|
1182 |
|
|
|
1183 |
|
|
# It seems odd to do this as a string compare, but on the Alpha,
|
1184 |
|
|
# where ints are 32 bit but addresses are 64, a numerical compare
|
1185 |
|
|
# will overflow Tcl's ints.
|
1186 |
|
|
|
1187 |
|
|
if {$tagname == "PC_TAG" && [string compare $addr $pc_addr] == 0} {
|
1188 |
|
|
set pc(filename) $filename
|
1189 |
|
|
set pc(line) $line
|
1190 |
|
|
set pc(addr) $addr
|
1191 |
|
|
set pc(func) $funcname
|
1192 |
|
|
set pc(lib) $lib
|
1193 |
|
|
}
|
1194 |
|
|
|
1195 |
|
|
if {$oldmode != "" \
|
1196 |
|
|
&& [string compare $filename $current(filename)] != 0} {
|
1197 |
|
|
|
1198 |
|
|
if [catch {gdb_find_file $filename} fullname] {
|
1199 |
|
|
dbug W "$filename: $fullname"
|
1200 |
|
|
set fullname ""
|
1201 |
|
|
}
|
1202 |
|
|
|
1203 |
|
|
if {$fullname != ""} {
|
1204 |
|
|
set tmp $oldmode
|
1205 |
|
|
set oldmode ""
|
1206 |
|
|
$parent mode "" $tmp 0
|
1207 |
|
|
}
|
1208 |
|
|
}
|
1209 |
|
|
|
1210 |
|
|
set oldpane $_tpane
|
1211 |
|
|
|
1212 |
|
|
switch $current(mode) {
|
1213 |
|
|
SOURCE {
|
1214 |
|
|
FillSource t $tagname $filename $funcname $line $addr $pc_addr $lib
|
1215 |
|
|
}
|
1216 |
|
|
ASSEMBLY {
|
1217 |
|
|
FillAssembly t $tagname $filename $funcname $line $addr $pc_addr $lib
|
1218 |
|
|
}
|
1219 |
|
|
MIXED {
|
1220 |
|
|
FillMixed t $tagname $filename $funcname $line $addr $pc_addr $lib
|
1221 |
|
|
}
|
1222 |
|
|
SRC+ASM {
|
1223 |
|
|
FillSource t $tagname $filename $funcname $line $addr $pc_addr $lib
|
1224 |
|
|
# This may seem redundant, but it is NOT. FillSource can change
|
1225 |
|
|
# the mode from SOURCE to ASSEMBLY if sources were not found. If
|
1226 |
|
|
# this happens, then MIXED mode is pointless, so forget the bottom
|
1227 |
|
|
# pane.
|
1228 |
|
|
if {$current(mode) == "SRC+ASM"} {
|
1229 |
|
|
FillAssembly b $tagname $filename $funcname $line $addr $pc_addr $lib
|
1230 |
|
|
}
|
1231 |
|
|
}
|
1232 |
|
|
}
|
1233 |
|
|
|
1234 |
|
|
# After switching panes, clear the previous pane's cursor so that it isn't
|
1235 |
|
|
# used as the default when no other cursors are set.
|
1236 |
|
|
if { "$oldpane" != "$_tpane" } {
|
1237 |
|
|
$twin configure -cursor ""
|
1238 |
|
|
}
|
1239 |
|
|
|
1240 |
|
|
set current(line) $line
|
1241 |
|
|
set current(tag) $tagname
|
1242 |
|
|
set current(addr) $addr
|
1243 |
|
|
set current(funcname) $funcname
|
1244 |
|
|
set current(filename) $filename
|
1245 |
|
|
set current(lib) $lib
|
1246 |
|
|
if {$do_display_breaks} {
|
1247 |
|
|
display_breaks
|
1248 |
|
|
set do_display_breaks 0
|
1249 |
|
|
}
|
1250 |
|
|
}
|
1251 |
|
|
|
1252 |
|
|
# ------------------------------------------------------------------
|
1253 |
|
|
# METHOD: LoadFile - loads in a new source file
|
1254 |
|
|
# ------------------------------------------------------------------
|
1255 |
|
|
body SrcTextWin::LoadFile {w name lib mtime_changed} {
|
1256 |
|
|
debug "$name $current(filename) $current(mode)"
|
1257 |
|
|
upvar ${w}win win
|
1258 |
|
|
upvar _${w}pane pane
|
1259 |
|
|
|
1260 |
|
|
set oldpane $pane
|
1261 |
|
|
set result [LoadFromCache $w $name "S" $lib]
|
1262 |
|
|
if {$result == -1} {
|
1263 |
|
|
# This is a source file we could not find the source for...
|
1264 |
|
|
return 0
|
1265 |
|
|
} elseif {$result == 1 || $mtime_changed} {
|
1266 |
|
|
$win delete 0.0 end
|
1267 |
|
|
debug "READING $name"
|
1268 |
|
|
if {[catch {gdb_loadfile $win $name $Linenums} msg]} {
|
1269 |
|
|
dbug W "Error opening $name: $msg"
|
1270 |
|
|
#if {$msg != ""} {
|
1271 |
|
|
# tk_messageBox -icon error -title "GDB" -type ok \
|
1272 |
|
|
# -modal task -message $msg
|
1273 |
|
|
#}
|
1274 |
|
|
UnLoadFromCache $w $oldpane $name "" $lib
|
1275 |
|
|
return 0
|
1276 |
|
|
}
|
1277 |
|
|
}
|
1278 |
|
|
set current(filename) $name
|
1279 |
|
|
# Display all breaks/traces
|
1280 |
|
|
set do_display_breaks 1
|
1281 |
|
|
return 1
|
1282 |
|
|
}
|
1283 |
|
|
|
1284 |
|
|
# ------------------------------------------------------------------
|
1285 |
|
|
# METHOD: display_line - make sure a line is displayed and near the center
|
1286 |
|
|
# ------------------------------------------------------------------
|
1287 |
|
|
|
1288 |
|
|
body SrcTextWin::display_line { win line } {
|
1289 |
|
|
::update idletasks
|
1290 |
|
|
# keep line near center of display
|
1291 |
|
|
set pixHeight [winfo height $win]
|
1292 |
|
|
set topLine [lindex [split [$win index @0,0] .] 0]
|
1293 |
|
|
set botLine [lindex [split [$win index @0,${pixHeight}] .] 0]
|
1294 |
|
|
set margin [expr {int(0.2*($botLine - $topLine))}]
|
1295 |
|
|
if {$line < [expr {$topLine + $margin}]} {
|
1296 |
|
|
set num [expr {($topLine - $botLine) / 2}]
|
1297 |
|
|
} elseif {$line > [expr {$botLine - $margin}]} {
|
1298 |
|
|
set num [expr {($botLine - $topLine) / 2}]
|
1299 |
|
|
} else {
|
1300 |
|
|
set num 0
|
1301 |
|
|
}
|
1302 |
|
|
$win yview scroll $num units
|
1303 |
|
|
$win see $line.0
|
1304 |
|
|
}
|
1305 |
|
|
|
1306 |
|
|
# ------------------------------------------------------------------
|
1307 |
|
|
# METHOD: display_breaks - insert all breakpoints and tracepoints
|
1308 |
|
|
# uses current(filename) in SOURCE mode
|
1309 |
|
|
# ------------------------------------------------------------------
|
1310 |
|
|
|
1311 |
|
|
body SrcTextWin::display_breaks {} {
|
1312 |
|
|
# debug
|
1313 |
|
|
|
1314 |
|
|
# clear any previous breakpoints
|
1315 |
|
|
foreach type "$bp_types tp" {
|
1316 |
|
|
foreach {start stop} [$twin tag ranges ${type}_tag] {
|
1317 |
|
|
scan $start "%d." linenum
|
1318 |
|
|
removeBreakTag $twin $linenum ${type}_tag
|
1319 |
|
|
}
|
1320 |
|
|
}
|
1321 |
|
|
|
1322 |
|
|
# now do second pane if it exists
|
1323 |
|
|
if {[info exists bwin]} {
|
1324 |
|
|
foreach type "$bp_types tp" {
|
1325 |
|
|
foreach {start stop} [$twin tag ranges ${type}_tag] {
|
1326 |
|
|
scan $start "%d." linenum
|
1327 |
|
|
removeBreakTag $twin $linenum ${type}_tag
|
1328 |
|
|
}
|
1329 |
|
|
}
|
1330 |
|
|
}
|
1331 |
|
|
|
1332 |
|
|
# Display any existing breakpoints.
|
1333 |
|
|
foreach bpnum [gdb_get_breakpoint_list] {
|
1334 |
|
|
set info [gdb_get_breakpoint_info $bpnum]
|
1335 |
|
|
set addr [lindex $info 3]
|
1336 |
|
|
set line [lindex $info 2]
|
1337 |
|
|
set file [lindex $info 0]
|
1338 |
|
|
set type [lindex $info 6]
|
1339 |
|
|
set enabled [lindex $info 5]
|
1340 |
|
|
bp create $bpnum $addr $line $file $type $enabled
|
1341 |
|
|
}
|
1342 |
|
|
# Display any existing tracepoints.
|
1343 |
|
|
foreach bpnum [gdb_get_tracepoint_list] {
|
1344 |
|
|
set info [gdb_get_tracepoint_info $bpnum]
|
1345 |
|
|
set addr [lindex $info 3]
|
1346 |
|
|
set line [lindex $info 2]
|
1347 |
|
|
set file [lindex $info 0]
|
1348 |
|
|
bp create $bpnum $addr $line $file tracepoint
|
1349 |
|
|
}
|
1350 |
|
|
}
|
1351 |
|
|
|
1352 |
|
|
# ------------------------------------------------------------------
|
1353 |
|
|
# METHOD: insertBreakTag - insert the right amount of tag chars
|
1354 |
|
|
# into the text window WIN, at line linenum.
|
1355 |
|
|
# ------------------------------------------------------------------
|
1356 |
|
|
body SrcTextWin::insertBreakTag {win linenum tag} {
|
1357 |
|
|
# debug "$win $linenum $tag"
|
1358 |
|
|
|
1359 |
|
|
# Get the tags at the current line.
|
1360 |
|
|
|
1361 |
|
|
# If there is a "break_rgn_tag", then there are currently no other
|
1362 |
|
|
# break/trace points at this line. So replace the break_rgn_tag
|
1363 |
|
|
# with this tag. Otherwise, add the new tag, and then the joint
|
1364 |
|
|
# tag. We will query the length of the previous tag, so we don't have
|
1365 |
|
|
# to hard code it here.
|
1366 |
|
|
|
1367 |
|
|
set tag_list [$win tag names $linenum.0]
|
1368 |
|
|
set img_name [string range $tag 0 [expr [string length $tag] - 5]]
|
1369 |
|
|
|
1370 |
|
|
if {[lsearch $tag_list break_rgn_tag] != -1} {
|
1371 |
|
|
set stop [lindex [$win tag nextrange break_rgn_tag \
|
1372 |
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
1373 |
|
|
$win tag remove break_rgn_tag $linenum.0 "$linenum.0 lineend"
|
1374 |
|
|
$win delete $linenum.0
|
1375 |
|
|
|
1376 |
|
|
# Strip the "_tag" off the end of the tag to get the image name.
|
1377 |
|
|
$win image create $linenum.0 -image $break_images($img_name)
|
1378 |
|
|
$win tag add $tag $linenum.0 $stop
|
1379 |
|
|
} else {
|
1380 |
|
|
set other_tag [lindex $tag_list \
|
1381 |
|
|
[lsearch -glob $tag_list {*[bt]p_tag}]]
|
1382 |
|
|
if {$other_tag == ""} {
|
1383 |
|
|
set stop 4
|
1384 |
|
|
} else {
|
1385 |
|
|
set stop [lindex [$win tag nextrange $other_tag \
|
1386 |
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
1387 |
|
|
}
|
1388 |
|
|
|
1389 |
|
|
$win tag add $tag $linenum.0 $stop
|
1390 |
|
|
$win image configure $linenum.0 -image $break_images($img_name)
|
1391 |
|
|
|
1392 |
|
|
}
|
1393 |
|
|
}
|
1394 |
|
|
|
1395 |
|
|
# ------------------------------------------------------------------
|
1396 |
|
|
# METHOD: removeBreakTag - remove a break tag (breakpoint or tracepoint)
|
1397 |
|
|
# from the given line. If this is the last break tag on the
|
1398 |
|
|
# line reinstall the break_rgn_tag
|
1399 |
|
|
# ------------------------------------------------------------------
|
1400 |
|
|
body SrcTextWin::removeBreakTag {win linenum tag } {
|
1401 |
|
|
# debug "$win $linenum $tag"
|
1402 |
|
|
|
1403 |
|
|
set tag_list [$win tag names $linenum.0]
|
1404 |
|
|
|
1405 |
|
|
if {[set pos [lsearch -exact $tag_list $tag]] == -1} {
|
1406 |
|
|
debug "Tried to remove non-existant tag $tag"
|
1407 |
|
|
return
|
1408 |
|
|
} else {
|
1409 |
|
|
set tag_list [lreplace $tag_list $pos $pos]
|
1410 |
|
|
}
|
1411 |
|
|
|
1412 |
|
|
# Use the range of the removed tag for any insertions, so we don't
|
1413 |
|
|
# have to hard code it here.
|
1414 |
|
|
|
1415 |
|
|
set stop [lindex [$win tag nextrange $tag \
|
1416 |
|
|
$linenum.0 "$linenum.0 lineend"] 1]
|
1417 |
|
|
|
1418 |
|
|
$win tag remove $tag $linenum.0 "$linenum.0 lineend"
|
1419 |
|
|
|
1420 |
|
|
# Now check what other tags are on this line. If there are both bp & tp
|
1421 |
|
|
# tags, also remove the joint tag, otherwise install the break_rgn_tag.
|
1422 |
|
|
|
1423 |
|
|
switch -glob $tag {
|
1424 |
|
|
*bp_tag {
|
1425 |
|
|
set only_one_tag [expr [set next_tag_index \
|
1426 |
|
|
[lsearch -glob $tag_list tp_tag]] == -1]
|
1427 |
|
|
}
|
1428 |
|
|
tp_tag {
|
1429 |
|
|
# Got to find out what kind of tag is here...
|
1430 |
|
|
set only_one_tag [expr [set next_tag_index \
|
1431 |
|
|
[lsearch -glob $tag_list *bp_tag]] == -1]
|
1432 |
|
|
}
|
1433 |
|
|
}
|
1434 |
|
|
|
1435 |
|
|
if {$only_one_tag} {
|
1436 |
|
|
catch {$win image configure $linenum.0 -image {}}
|
1437 |
|
|
$win delete $linenum.0
|
1438 |
|
|
$win insert $linenum.0 "-"
|
1439 |
|
|
$win tag add break_rgn_tag $linenum.0 $stop
|
1440 |
|
|
} else {
|
1441 |
|
|
set other_tag [lindex $tag_list $next_tag_index]
|
1442 |
|
|
set img_name [string range $other_tag 0 \
|
1443 |
|
|
[expr [string length $other_tag] - 5]]
|
1444 |
|
|
$win image configure $linenum.0 -image $break_images($img_name)
|
1445 |
|
|
$win tag remove bp_and_tp_tag $linenum.0 "$linenum.0 lineend"
|
1446 |
|
|
}
|
1447 |
|
|
}
|
1448 |
|
|
|
1449 |
|
|
# ------------------------------------------------------------------
|
1450 |
|
|
# PUBLIC METHOD: breakpoint - Handle a breakpoint create, delete,
|
1451 |
|
|
# or modify event from the backend.
|
1452 |
|
|
# ------------------------------------------------------------------
|
1453 |
|
|
body SrcTextWin::breakpoint {bp_event} {
|
1454 |
|
|
|
1455 |
|
|
bp [$bp_event get action] [$bp_event get number] [$bp_event get address] \
|
1456 |
|
|
[$bp_event get line] [$bp_event get file] [$bp_event get disposition] \
|
1457 |
|
|
[$bp_event get enabled] [$bp_event get thread]
|
1458 |
|
|
}
|
1459 |
|
|
|
1460 |
|
|
# ------------------------------------------------------------------
|
1461 |
|
|
# PUBLIC METHOD: tracepoint - Handle a tracepoint create, delete,
|
1462 |
|
|
# modify event from the backend.
|
1463 |
|
|
# ------------------------------------------------------------------
|
1464 |
|
|
body SrcTextWin::tracepoint {tp_event} {
|
1465 |
|
|
|
1466 |
|
|
bp [$tp_event get action] [$tp_event get number] [$tp_event get address] \
|
1467 |
|
|
[$tp_event get line] [$tp_event get file] tracepoint \
|
1468 |
|
|
[$tp_event get pass_count]
|
1469 |
|
|
}
|
1470 |
|
|
|
1471 |
|
|
# ------------------------------------------------------------------
|
1472 |
|
|
# METHOD: bp - set and remove breakpoints
|
1473 |
|
|
#
|
1474 |
|
|
# if $addr is valid, the breakpoint will be set in the assembly or
|
1475 |
|
|
# mixed window at that address. If $line and $file are valid,
|
1476 |
|
|
# a breakpoint will be set in the source window if appropriate.
|
1477 |
|
|
# ------------------------------------------------------------------
|
1478 |
|
|
body SrcTextWin::bp {action bpnum addr {linenum {}} {file {}} {type 0} {enabled 0} {thread -1}} {
|
1479 |
|
|
# debug "$action addr=$addr line=$linenum file=$file type=$type current(filename)=$current(filename)"
|
1480 |
|
|
|
1481 |
|
|
switch $current(mode) {
|
1482 |
|
|
SOURCE {
|
1483 |
|
|
if {[string compare $file $current(filename)] == 0 && $linenum != {}} {
|
1484 |
|
|
do_bp $twin $action $linenum $type $bpnum $enabled $thread 0
|
1485 |
|
|
}
|
1486 |
|
|
}
|
1487 |
|
|
|
1488 |
|
|
SRC+ASM {
|
1489 |
|
|
if {$addr != {} && [info exists _map($Cname,pc=$addr)]} {
|
1490 |
|
|
do_bp $bwin $action $_map($Cname,pc=$addr) $type $bpnum \
|
1491 |
|
|
$enabled $thread 1
|
1492 |
|
|
}
|
1493 |
|
|
if {[string compare $file $current(filename)] == 0 && $linenum != {}} {
|
1494 |
|
|
do_bp $twin $action $linenum $type $bpnum $enabled $thread 0
|
1495 |
|
|
}
|
1496 |
|
|
}
|
1497 |
|
|
|
1498 |
|
|
ASSEMBLY {
|
1499 |
|
|
if {$addr != {} &&[info exists _map($Cname,pc=$addr)]} {
|
1500 |
|
|
do_bp $twin $action $_map($Cname,pc=$addr) $type $bpnum \
|
1501 |
|
|
$enabled $thread 1
|
1502 |
|
|
}
|
1503 |
|
|
}
|
1504 |
|
|
|
1505 |
|
|
MIXED {
|
1506 |
|
|
if {$addr != {} && [info exists _map($Cname,pc=$addr)]} {
|
1507 |
|
|
do_bp $twin $action $_map($Cname,pc=$addr) $type $bpnum \
|
1508 |
|
|
$enabled $thread 1
|
1509 |
|
|
}
|
1510 |
|
|
}
|
1511 |
|
|
}
|
1512 |
|
|
}
|
1513 |
|
|
|
1514 |
|
|
# ------------------------------------------------------------------
|
1515 |
|
|
# METHOD: do_bp - bp helper function
|
1516 |
|
|
# ------------------------------------------------------------------
|
1517 |
|
|
body SrcTextWin::do_bp { win action linenum type bpnum enabled thread asm} {
|
1518 |
|
|
# debug "$action line=$linenum type=$type bpnum=$bpnum enabled=$enabled thread=$thread"
|
1519 |
|
|
|
1520 |
|
|
if {$dont_change_appearance} {
|
1521 |
|
|
return
|
1522 |
|
|
}
|
1523 |
|
|
|
1524 |
|
|
if {$action == "delete" && [string compare $type tracepoint] != 0} {
|
1525 |
|
|
# make sure there are no more breakpoints on
|
1526 |
|
|
# this line.
|
1527 |
|
|
if {!$asm} {
|
1528 |
|
|
set bps [gdb_find_bp_at_line $current(filename) $linenum]
|
1529 |
|
|
} else {
|
1530 |
|
|
if {[info exists _map($Cname,line=$linenum)]} {
|
1531 |
|
|
set bps [gdb_find_bp_at_addr $_map($Cname,line=$linenum)]
|
1532 |
|
|
} else {
|
1533 |
|
|
set bps {}
|
1534 |
|
|
}
|
1535 |
|
|
}
|
1536 |
|
|
if {[llength $bps] > 0} {
|
1537 |
|
|
foreach b $bps {
|
1538 |
|
|
if {$b != $bpnum} {
|
1539 |
|
|
# OK we found another BP on this line.
|
1540 |
|
|
# So we really just want to modify whats
|
1541 |
|
|
# displayed on the line instead of deleting it.
|
1542 |
|
|
# Also, for lack of a better solution, we will
|
1543 |
|
|
# just display an image corresponding to the
|
1544 |
|
|
# first found BP. If you have a temporary and
|
1545 |
|
|
# a perm BP on the same line, the image for the one
|
1546 |
|
|
# with the lower bpnum will be displayed.
|
1547 |
|
|
set inf [gdb_get_breakpoint_info $b]
|
1548 |
|
|
set action "modify"
|
1549 |
|
|
set type [lindex $inf 6]
|
1550 |
|
|
set bpnum $b
|
1551 |
|
|
break
|
1552 |
|
|
}
|
1553 |
|
|
}
|
1554 |
|
|
}
|
1555 |
|
|
}
|
1556 |
|
|
|
1557 |
|
|
if {[string compare $type "tracepoint"] == 0} {
|
1558 |
|
|
if {[string compare $action "delete"] != 0
|
1559 |
|
|
&& [lindex [gdb_get_tracepoint_info $bpnum] 4] == 0} {
|
1560 |
|
|
set type disabled_tracepoint
|
1561 |
|
|
}
|
1562 |
|
|
} else {
|
1563 |
|
|
if {$enabled == "0" } {
|
1564 |
|
|
set type disabled_bp
|
1565 |
|
|
} elseif {$thread != "-1"} {
|
1566 |
|
|
set type thread
|
1567 |
|
|
}
|
1568 |
|
|
}
|
1569 |
|
|
|
1570 |
|
|
switch $type {
|
1571 |
|
|
donttouch {
|
1572 |
|
|
set tag_type bp_tag
|
1573 |
|
|
set remove_type disabled_bp_tag
|
1574 |
|
|
}
|
1575 |
|
|
delete {
|
1576 |
|
|
set tag_type temp_bp_tag
|
1577 |
|
|
}
|
1578 |
|
|
disabled_bp {
|
1579 |
|
|
set tag_type disabled_bp_tag
|
1580 |
|
|
set remove_type bp_tag
|
1581 |
|
|
}
|
1582 |
|
|
tracepoint {
|
1583 |
|
|
set tag_type tp_tag
|
1584 |
|
|
set remove_type disabled_tp_tag
|
1585 |
|
|
}
|
1586 |
|
|
disabled_tracepoint {
|
1587 |
|
|
set tag_type disabled_tp_tag
|
1588 |
|
|
set remove_type tp_tag
|
1589 |
|
|
}
|
1590 |
|
|
thread {
|
1591 |
|
|
set tag_type thread_bp_tag
|
1592 |
|
|
}
|
1593 |
|
|
default {
|
1594 |
|
|
dbug E "UNKNOWN BP TYPE action=\"$action\" type=\"$type\""
|
1595 |
|
|
$win insert $linenum.0 "X" bp_tag
|
1596 |
|
|
set tag_type bp_tag
|
1597 |
|
|
}
|
1598 |
|
|
}
|
1599 |
|
|
|
1600 |
|
|
if {[string compare $action "delete"] == 0} {
|
1601 |
|
|
removeBreakTag $win $linenum $tag_type
|
1602 |
|
|
} else {
|
1603 |
|
|
if {[string compare $action "modify"] == 0 && $remove_type != ""} {
|
1604 |
|
|
removeBreakTag $win $linenum $remove_type
|
1605 |
|
|
}
|
1606 |
|
|
insertBreakTag $win $linenum $tag_type
|
1607 |
|
|
}
|
1608 |
|
|
}
|
1609 |
|
|
|
1610 |
|
|
|
1611 |
|
|
# ------------------------------------------------------------------
|
1612 |
|
|
# METHOD: hasBP - see if a line number has a breakpoint set
|
1613 |
|
|
# ------------------------------------------------------------------
|
1614 |
|
|
body SrcTextWin::hasBP {win line} {
|
1615 |
|
|
if {$win == ""} {
|
1616 |
|
|
set win $popups(saved_win)
|
1617 |
|
|
}
|
1618 |
|
|
|
1619 |
|
|
if {[lsearch -glob [$win tag names $line.0] *bp_tag] >= 0} {
|
1620 |
|
|
return 1
|
1621 |
|
|
}
|
1622 |
|
|
return 0
|
1623 |
|
|
}
|
1624 |
|
|
|
1625 |
|
|
# ------------------------------------------------------------------
|
1626 |
|
|
# METHOD: hasTP - see if a line number has a tracepoint set
|
1627 |
|
|
# ------------------------------------------------------------------
|
1628 |
|
|
body SrcTextWin::hasTP {win line} {
|
1629 |
|
|
if {$win == ""} {
|
1630 |
|
|
set win $popups(saved_win)
|
1631 |
|
|
}
|
1632 |
|
|
|
1633 |
|
|
if {[lsearch -exact [$win tag names $line.0] tp_tag] == 1} {
|
1634 |
|
|
return 1
|
1635 |
|
|
}
|
1636 |
|
|
return 0
|
1637 |
|
|
}
|
1638 |
|
|
|
1639 |
|
|
# ------------------------------------------------------------------
|
1640 |
|
|
# METHOD: report_source_location
|
1641 |
|
|
#
|
1642 |
|
|
# This function reports the "current" location in the source
|
1643 |
|
|
# window, where current means what gdb_loc would return, if
|
1644 |
|
|
# that point is actually visible in the window, or the middle
|
1645 |
|
|
# of the current window, if that point is not visible.
|
1646 |
|
|
#
|
1647 |
|
|
# Return:
|
1648 |
|
|
# The gdb_loc result for the location found
|
1649 |
|
|
# ------------------------------------------------------------------
|
1650 |
|
|
body SrcTextWin::report_source_location {} {
|
1651 |
|
|
|
1652 |
|
|
if {$current(filename) == ""} {
|
1653 |
|
|
error "No source file in window"
|
1654 |
|
|
}
|
1655 |
|
|
|
1656 |
|
|
# Figure out if the return from gdb_loc is visible.
|
1657 |
|
|
|
1658 |
|
|
set not_visible 1
|
1659 |
|
|
if {![catch {gdb_loc} loc_info]} {
|
1660 |
|
|
set loc_long_name [lindex $loc_info 2]
|
1661 |
|
|
set loc_line [lindex $loc_info 3]
|
1662 |
|
|
# debug "Got loc_info: \"$loc_info\" and filename $current(filename) long_name: $loc_long_name"
|
1663 |
|
|
if {[string compare $current(filename) $loc_long_name] != 0} {
|
1664 |
|
|
set not_visible 1
|
1665 |
|
|
} else {
|
1666 |
|
|
foreach {name line} [lookup_line $twin 1] {
|
1667 |
|
|
break
|
1668 |
|
|
}
|
1669 |
|
|
if {$line < $loc_line} {
|
1670 |
|
|
foreach {name line} [lookup_line $twin [winfo height $twin]] {
|
1671 |
|
|
break
|
1672 |
|
|
}
|
1673 |
|
|
if {$line > $loc_line} {
|
1674 |
|
|
set not_visible 0
|
1675 |
|
|
}
|
1676 |
|
|
}
|
1677 |
|
|
}
|
1678 |
|
|
} else {
|
1679 |
|
|
debug "gdb_loc returned $loc_info"
|
1680 |
|
|
}
|
1681 |
|
|
|
1682 |
|
|
if {$not_visible} {
|
1683 |
|
|
set y [expr int([winfo height $twin] / 2)]
|
1684 |
|
|
foreach {name line addr type} [lookup_line $twin $y] {
|
1685 |
|
|
break
|
1686 |
|
|
}
|
1687 |
|
|
switch $type {
|
1688 |
|
|
src {
|
1689 |
|
|
return [gdb_loc $name:$addr]
|
1690 |
|
|
}
|
1691 |
|
|
asm {
|
1692 |
|
|
return [gdb_loc *$addr]
|
1693 |
|
|
}
|
1694 |
|
|
}
|
1695 |
|
|
} else {
|
1696 |
|
|
return $loc_info
|
1697 |
|
|
}
|
1698 |
|
|
}
|
1699 |
|
|
|
1700 |
|
|
# ------------------------------------------------------------------
|
1701 |
|
|
# METHOD: lookup_line - translated win & y position line info
|
1702 |
|
|
#
|
1703 |
|
|
# If win is {}, or y is -1, then the saved values from the popup
|
1704 |
|
|
# array are used.
|
1705 |
|
|
#
|
1706 |
|
|
# Return:
|
1707 |
|
|
# name - the fileName
|
1708 |
|
|
# line - the line number in the text widget
|
1709 |
|
|
# addr - the source line number, if in source mode, the
|
1710 |
|
|
# address if in assembly mode, and if in mixed mode,
|
1711 |
|
|
# the line if it is a source line, or the address if it
|
1712 |
|
|
# is an assembly line
|
1713 |
|
|
# type - src if it is a source line, asm if an assembly line.
|
1714 |
|
|
# set_cmd - for convenience, this is the command needed to set a
|
1715 |
|
|
# breakpoint at this address.
|
1716 |
|
|
# ------------------------------------------------------------------
|
1717 |
|
|
body SrcTextWin::lookup_line {win y} {
|
1718 |
|
|
#debug "$win $y"
|
1719 |
|
|
if {$y == -1} {
|
1720 |
|
|
set y $popups(saved_y)
|
1721 |
|
|
}
|
1722 |
|
|
|
1723 |
|
|
if {$win == {}} {
|
1724 |
|
|
set win $popups(saved_win)
|
1725 |
|
|
}
|
1726 |
|
|
|
1727 |
|
|
scan [$win index @0,$y] "%d." line
|
1728 |
|
|
set name [lindex [::file split $current(filename)] end]
|
1729 |
|
|
|
1730 |
|
|
# If we are in the SOURCE window (either because the mode is SOURCE,
|
1731 |
|
|
# or SRC+ASM, and we are in the upper pane, then return the
|
1732 |
|
|
if {([string compare $current(mode) SOURCE] == 0)
|
1733 |
|
|
|| ([string compare $current(mode) SRC+ASM] == 0
|
1734 |
|
|
&& [string compare $win $twin] == 0)} {
|
1735 |
|
|
set addr $line
|
1736 |
|
|
set type "src"
|
1737 |
|
|
} else {
|
1738 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
1739 |
|
|
set addr $_map($Cname,line=$line)
|
1740 |
|
|
set type "asm"
|
1741 |
|
|
} else {
|
1742 |
|
|
# This is a source line in MIXED mode
|
1743 |
|
|
set line_contents [$win get $line.0 "$line.0 lineend"]
|
1744 |
|
|
#debug "Looking at line: $line contents: \"$line_contents\""
|
1745 |
|
|
regexp "^\t(\[0-9\]*)" $line_contents match srcline
|
1746 |
|
|
set addr $srcline
|
1747 |
|
|
set type "src"
|
1748 |
|
|
}
|
1749 |
|
|
}
|
1750 |
|
|
|
1751 |
|
|
switch $type {
|
1752 |
|
|
asm {
|
1753 |
|
|
set set_cmd [list gdb_set_bp_addr $addr]
|
1754 |
|
|
}
|
1755 |
|
|
src {
|
1756 |
|
|
set set_cmd [list gdb_set_bp $current(filename) $addr]
|
1757 |
|
|
}
|
1758 |
|
|
}
|
1759 |
|
|
|
1760 |
|
|
#debug "Lookup line returning [list $name $line $addr $type $set_cmd]"
|
1761 |
|
|
return [list $name $line $addr $type $set_cmd]
|
1762 |
|
|
}
|
1763 |
|
|
|
1764 |
|
|
# ------------------------------------------------------------------
|
1765 |
|
|
# METHOD: continue_to_here - Advance to the line pointed to by the
|
1766 |
|
|
# y coordinate in the window win. If win is {} or y is -1, the values
|
1767 |
|
|
# saved in the popups array are used.
|
1768 |
|
|
#
|
1769 |
|
|
# The threads parameter is not currently used.
|
1770 |
|
|
# ------------------------------------------------------------------
|
1771 |
|
|
body SrcTextWin::continue_to_here {{win {}} {y -1} {threads -1}} {
|
1772 |
|
|
|
1773 |
|
|
# Look up the line... This foreach is an lassign...
|
1774 |
|
|
foreach {name line addr type set_cmd} [lookup_line $win $y] {
|
1775 |
|
|
break
|
1776 |
|
|
}
|
1777 |
|
|
|
1778 |
|
|
set dont_change_appearance 1
|
1779 |
|
|
foreach i [gdb_get_breakpoint_list] {
|
1780 |
|
|
set enabled($i) [lindex [gdb_get_breakpoint_info $i] 5]
|
1781 |
|
|
}
|
1782 |
|
|
gdb_cmd "disable"
|
1783 |
|
|
eval $set_cmd temp $threads
|
1784 |
|
|
gdb_immediate "continue"
|
1785 |
|
|
gdb_cmd "enable"
|
1786 |
|
|
foreach i [gdb_get_breakpoint_list] {
|
1787 |
|
|
if {![info exists enabled($i)]} {
|
1788 |
|
|
gdb_cmd "delete $i"
|
1789 |
|
|
} elseif {!$enabled($i)} {
|
1790 |
|
|
gdb_cmd "disable $i"
|
1791 |
|
|
}
|
1792 |
|
|
}
|
1793 |
|
|
set dont_change_appearance 0
|
1794 |
|
|
}
|
1795 |
|
|
|
1796 |
|
|
# ------------------------------------------------------------------
|
1797 |
|
|
# METHOD: jump_to_here - Advance to the line pointed to by the
|
1798 |
|
|
# y coordinate in the window win. If win is {} or y is -1, the values
|
1799 |
|
|
# saved in the popups array are used.
|
1800 |
|
|
#
|
1801 |
|
|
# The threads parameter is not currently used.
|
1802 |
|
|
# ------------------------------------------------------------------
|
1803 |
|
|
body SrcTextWin::jump_to_here {{win {}} {y -1} {threads -1}} {
|
1804 |
|
|
|
1805 |
|
|
# Look up the line... This foreach is an lassign...
|
1806 |
|
|
foreach {name line addr type set_cmd} [lookup_line $win $y] {
|
1807 |
|
|
break
|
1808 |
|
|
}
|
1809 |
|
|
|
1810 |
|
|
# Unfortunately we cant set the pc to a linespec and we have to do a
|
1811 |
|
|
# trick with a temporary breakpoint and the jump command.
|
1812 |
|
|
# FIXME: Get the address from the linespec.
|
1813 |
|
|
# FIXME: Even in the case we do have an address, I was not able to just
|
1814 |
|
|
# change the PC and get things updated wright. While I work on that,
|
1815 |
|
|
# I will use the temp breakpoint and jump trick for that case as well.
|
1816 |
|
|
|
1817 |
|
|
set dont_change_appearance 1
|
1818 |
|
|
|
1819 |
|
|
foreach i [gdb_get_breakpoint_list] {
|
1820 |
|
|
set enabled($i) [lindex [gdb_get_breakpoint_info $i] 5]
|
1821 |
|
|
}
|
1822 |
|
|
gdb_cmd "disable"
|
1823 |
|
|
|
1824 |
|
|
if {$type == "asm"} {
|
1825 |
|
|
gdb_immediate "tbreak *$addr"
|
1826 |
|
|
gdb_immediate "jump *$addr"
|
1827 |
|
|
} else {
|
1828 |
|
|
eval $set_cmd temp $threads
|
1829 |
|
|
gdb_immediate "jump $name:$line"
|
1830 |
|
|
}
|
1831 |
|
|
gdb_cmd "enable"
|
1832 |
|
|
foreach i [gdb_get_breakpoint_list] {
|
1833 |
|
|
if {![info exists enabled($i)]} {
|
1834 |
|
|
gdb_cmd "delete $i"
|
1835 |
|
|
} elseif {!$enabled($i)} {
|
1836 |
|
|
gdb_cmd "disable $i"
|
1837 |
|
|
}
|
1838 |
|
|
}
|
1839 |
|
|
set dont_change_appearance 0
|
1840 |
|
|
}
|
1841 |
|
|
|
1842 |
|
|
# ------------------------------------------------------------------
|
1843 |
|
|
# METHOD: set_bp_at_line - called when an empty break tag is clicked on
|
1844 |
|
|
#
|
1845 |
|
|
# When "threads" is set it means to set a bp on each thread in the list.
|
1846 |
|
|
# ------------------------------------------------------------------
|
1847 |
|
|
body SrcTextWin::set_bp_at_line {{type N} {win {}} {y -1} {threads "-1"}} {
|
1848 |
|
|
# debug "$win $y $type $current(filename) Tracing=$Tracing"
|
1849 |
|
|
if {$Running} {return}
|
1850 |
|
|
|
1851 |
|
|
# Look up the line... This foreach is an lassign...
|
1852 |
|
|
|
1853 |
|
|
foreach {name line addr addr_type set_cmd} [lookup_line $win $y] {
|
1854 |
|
|
break
|
1855 |
|
|
}
|
1856 |
|
|
|
1857 |
|
|
foreach th $threads {
|
1858 |
|
|
switch $type {
|
1859 |
|
|
N {
|
1860 |
|
|
if {[catch {eval $set_cmd normal $th} msg]} {
|
1861 |
|
|
dbug W $msg
|
1862 |
|
|
}
|
1863 |
|
|
}
|
1864 |
|
|
T {
|
1865 |
|
|
if {[catch {eval $set_cmd temp $th} msg]} {
|
1866 |
|
|
dbug W $msg
|
1867 |
|
|
}
|
1868 |
|
|
}
|
1869 |
|
|
}
|
1870 |
|
|
}
|
1871 |
|
|
}
|
1872 |
|
|
|
1873 |
|
|
# ------------------------------------------------------------------
|
1874 |
|
|
# METHOD: enable_disable_at_line - Enable or disable breakpoint
|
1875 |
|
|
# ------------------------------------------------------------------
|
1876 |
|
|
body SrcTextWin::enable_disable_at_line {action} {
|
1877 |
|
|
if {$Running} {
|
1878 |
|
|
return
|
1879 |
|
|
}
|
1880 |
|
|
|
1881 |
|
|
# FIXME: should this work on $bwin as well? In that case we'd need
|
1882 |
|
|
# a `win' argument...
|
1883 |
|
|
|
1884 |
|
|
set y $popups(saved_y)
|
1885 |
|
|
|
1886 |
|
|
$twin tag remove _show_variable 1.0 end
|
1887 |
|
|
set line [lindex [split [$twin index @0,$y] .] 0]
|
1888 |
|
|
set bps ""
|
1889 |
|
|
|
1890 |
|
|
switch $current(mode) {
|
1891 |
|
|
SRC+ASM {
|
1892 |
|
|
}
|
1893 |
|
|
ASSEMBLY {
|
1894 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
1895 |
|
|
set addr $_map($Cname,line=$line)
|
1896 |
|
|
set bps [gdb_find_bp_at_addr $addr]
|
1897 |
|
|
} else {
|
1898 |
|
|
return
|
1899 |
|
|
}
|
1900 |
|
|
}
|
1901 |
|
|
MIXED {
|
1902 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
1903 |
|
|
set addr $_map($Cname,line=$line)
|
1904 |
|
|
set bps [gdb_find_bp_at_addr $addr]
|
1905 |
|
|
} else {
|
1906 |
|
|
return
|
1907 |
|
|
}
|
1908 |
|
|
}
|
1909 |
|
|
}
|
1910 |
|
|
|
1911 |
|
|
if {$bps == ""} {
|
1912 |
|
|
set bps [gdb_find_bp_at_line $current(filename) $line]
|
1913 |
|
|
}
|
1914 |
|
|
|
1915 |
|
|
# ACTION is `enable' or `disable'
|
1916 |
|
|
gdb_cmd "$action $bps"
|
1917 |
|
|
}
|
1918 |
|
|
|
1919 |
|
|
# ------------------------------------------------------------------
|
1920 |
|
|
# METHOD: remove_bp_at_line - called when a bp tag is clicked on
|
1921 |
|
|
#
|
1922 |
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
1923 |
|
|
# ------------------------------------------------------------------
|
1924 |
|
|
body SrcTextWin::remove_bp_at_line {{win {}} {y -1}} {
|
1925 |
|
|
|
1926 |
|
|
if {$Running} {return}
|
1927 |
|
|
|
1928 |
|
|
# Look up the line... This foreach is an lassign...
|
1929 |
|
|
|
1930 |
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
1931 |
|
|
break
|
1932 |
|
|
}
|
1933 |
|
|
|
1934 |
|
|
# FIXME: if there are multiple bp/tp at a single line,
|
1935 |
|
|
# we will (right now) always take the first one we find...
|
1936 |
|
|
switch $type {
|
1937 |
|
|
src { set bps [gdb_find_bp_at_line $name $addr] }
|
1938 |
|
|
asm { set bps [gdb_find_bp_at_addr $addr] }
|
1939 |
|
|
}
|
1940 |
|
|
|
1941 |
|
|
set number [lindex $bps 0]
|
1942 |
|
|
gdb_cmd "delete $number"
|
1943 |
|
|
}
|
1944 |
|
|
|
1945 |
|
|
|
1946 |
|
|
# ------------------------------------------------------------------
|
1947 |
|
|
# METHOD: set_tp_at_line - called when an empty break region tag is clicked on
|
1948 |
|
|
#
|
1949 |
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
1950 |
|
|
# ------------------------------------------------------------------
|
1951 |
|
|
body SrcTextWin::set_tp_at_line {{win {}} {y -1}} {
|
1952 |
|
|
# debug "$win $y $current(filename) Tracing=$Tracing"
|
1953 |
|
|
|
1954 |
|
|
if {$Running} {return}
|
1955 |
|
|
|
1956 |
|
|
# Look up the line... This foreach is an lassign...
|
1957 |
|
|
|
1958 |
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
1959 |
|
|
break
|
1960 |
|
|
}
|
1961 |
|
|
|
1962 |
|
|
switch $type {
|
1963 |
|
|
src {
|
1964 |
|
|
after idle [list ManagedWin::open TraceDlg -File $name -Lines $addr]
|
1965 |
|
|
}
|
1966 |
|
|
asm {
|
1967 |
|
|
after idle [list ManagedWin::open TraceDlg -File $name -Addresses [list $addr]]
|
1968 |
|
|
}
|
1969 |
|
|
}
|
1970 |
|
|
}
|
1971 |
|
|
|
1972 |
|
|
# ------------------------------------------------------------------
|
1973 |
|
|
# METHOD: next_hit_at_line - Finds the next trace hit at the line
|
1974 |
|
|
# given by win & y...
|
1975 |
|
|
#
|
1976 |
|
|
# ------------------------------------------------------------------
|
1977 |
|
|
body SrcTextWin::next_hit_at_line {{win {}} {y -1}} {
|
1978 |
|
|
# debug "$win $y $current(filename) Tracing=$Tracing"
|
1979 |
|
|
|
1980 |
|
|
if {!$Browsing} {return}
|
1981 |
|
|
|
1982 |
|
|
# Look up the line... This foreach is an lassign...
|
1983 |
|
|
|
1984 |
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
1985 |
|
|
break
|
1986 |
|
|
}
|
1987 |
|
|
|
1988 |
|
|
# If the line and the addr are the same, then the specification was
|
1989 |
|
|
# given by line. Otherwise is was a memory address.
|
1990 |
|
|
|
1991 |
|
|
switch $type {
|
1992 |
|
|
src {
|
1993 |
|
|
tfind_cmd "tfind line $name:$addr"
|
1994 |
|
|
}
|
1995 |
|
|
asm {
|
1996 |
|
|
tfind_cmd "tfind line *$addr"
|
1997 |
|
|
}
|
1998 |
|
|
}
|
1999 |
|
|
|
2000 |
|
|
}
|
2001 |
|
|
|
2002 |
|
|
# ------------------------------------------------------------------
|
2003 |
|
|
# METHOD: remove_tp_at_line - called when a tp tag is clicked on
|
2004 |
|
|
#
|
2005 |
|
|
# when "threads" is set it means to set a bp on each thread in the list.
|
2006 |
|
|
# ------------------------------------------------------------------
|
2007 |
|
|
body SrcTextWin::remove_tp_at_line {{win {}} {y -1}} {
|
2008 |
|
|
|
2009 |
|
|
if {$Running} {return}
|
2010 |
|
|
|
2011 |
|
|
# Look up the line... This foreach is an lassign...
|
2012 |
|
|
|
2013 |
|
|
foreach {name line addr type} [lookup_line $win $y] {
|
2014 |
|
|
break
|
2015 |
|
|
}
|
2016 |
|
|
switch $type {
|
2017 |
|
|
src {
|
2018 |
|
|
set tp_num [gdb_tracepoint_exists $name:$addr]
|
2019 |
|
|
}
|
2020 |
|
|
asm {
|
2021 |
|
|
set tp_num [gdb_tracepoint_exists *$addr]
|
2022 |
|
|
}
|
2023 |
|
|
}
|
2024 |
|
|
|
2025 |
|
|
if {$tp_num != -1} {
|
2026 |
|
|
if {[catch {gdb_cmd "delete tracepoints $tp_num"} errTxt]} {
|
2027 |
|
|
tk_messageBox -type error -message "Could not delete tracepoint number $tp_num
|
2028 |
|
|
Error was: $errTxt"
|
2029 |
|
|
}
|
2030 |
|
|
}
|
2031 |
|
|
|
2032 |
|
|
}
|
2033 |
|
|
|
2034 |
|
|
# ------------------------------------------------------------------
|
2035 |
|
|
# METHOD: do_tag_popup - The tag bind function for breakpoint popups
|
2036 |
|
|
# ------------------------------------------------------------------
|
2037 |
|
|
|
2038 |
|
|
body SrcTextWin::do_tag_popup {name X Y y} {
|
2039 |
|
|
|
2040 |
|
|
# debug "$name $X $Y $y"
|
2041 |
|
|
|
2042 |
|
|
if {$Running || [winfo ismapped $popups($name)]} {
|
2043 |
|
|
return
|
2044 |
|
|
}
|
2045 |
|
|
|
2046 |
|
|
set popups(saved_y) $y
|
2047 |
|
|
set popups(saved_win) [winfo containing -displayof $itk_interior $X $Y]
|
2048 |
|
|
|
2049 |
|
|
# Hide variable balloons before showing the popup
|
2050 |
|
|
$twin tag remove _show_variable 1.0 end
|
2051 |
|
|
balloon withdraw $twin
|
2052 |
|
|
|
2053 |
|
|
tk_popup $popups($name) $X $Y
|
2054 |
|
|
|
2055 |
|
|
}
|
2056 |
|
|
|
2057 |
|
|
# ------------------------------------------------------------------
|
2058 |
|
|
# METHOD: do_source_popup - tag bind function for source popups
|
2059 |
|
|
# ------------------------------------------------------------------
|
2060 |
|
|
|
2061 |
|
|
body SrcTextWin::do_source_popup { X Y x y } {
|
2062 |
|
|
if {$Running || [winfo ismapped $popups(source)]} {
|
2063 |
|
|
return
|
2064 |
|
|
}
|
2065 |
|
|
|
2066 |
|
|
# Figure out what window we are over...
|
2067 |
|
|
set win [winfo containing -displayof $itk_interior $X $Y]
|
2068 |
|
|
|
2069 |
|
|
# Hide variable balloons before showing the popup
|
2070 |
|
|
$win tag remove _show_variable 1.0 end
|
2071 |
|
|
balloon withdraw $win
|
2072 |
|
|
catch {$_balloon_var delete}
|
2073 |
|
|
|
2074 |
|
|
|
2075 |
|
|
# Try to get the selection. If you fail, get the word around the
|
2076 |
|
|
# click point.
|
2077 |
|
|
# Note that we don't have to worry about the user clicking over the
|
2078 |
|
|
# break area, since the break_rgn_tag will override this...
|
2079 |
|
|
|
2080 |
|
|
set hit_point [$win index @$x,$y]
|
2081 |
|
|
if {([$win tag ranges sel] != "")
|
2082 |
|
|
&& ([$win compare sel.first < $hit_point]
|
2083 |
|
|
&& [$win compare $hit_point < sel.last])} {
|
2084 |
|
|
set sel_first [$win index sel.first]
|
2085 |
|
|
set sel_last [$win index sel.last]
|
2086 |
|
|
|
2087 |
|
|
# If there was a selection, see if it spans multiple lines.
|
2088 |
|
|
scan $sel_first "%d.%d" range_low sel_start_char
|
2089 |
|
|
scan $sel_last "%d.%d" range_high sel_end_char
|
2090 |
|
|
|
2091 |
|
|
if {$range_low == $range_high} {
|
2092 |
|
|
set range -1
|
2093 |
|
|
set target_range [$win get sel.first sel.last]
|
2094 |
|
|
} else {
|
2095 |
|
|
# If the selection encompasses multiple lines, we only care about
|
2096 |
|
|
# the start and ending line numbers
|
2097 |
|
|
set range 1
|
2098 |
|
|
}
|
2099 |
|
|
} else {
|
2100 |
|
|
set target_range [$win get "$hit_point wordstart" "$hit_point wordend"]
|
2101 |
|
|
set range 0
|
2102 |
|
|
}
|
2103 |
|
|
|
2104 |
|
|
$popups(source) delete 0 end
|
2105 |
|
|
|
2106 |
|
|
if {$range && $Tracing} {
|
2107 |
|
|
# If the selection spans more than one line, it can't be a variable name...
|
2108 |
|
|
# So just insert the tracepoint range item
|
2109 |
|
|
$popups(source) add command -label "Set Tracepoint Range" \
|
2110 |
|
|
-command "$this tracepoint_range $win $range_low $range_high"
|
2111 |
|
|
$popups(source) add separator
|
2112 |
|
|
} elseif {$range != 1} {
|
2113 |
|
|
# RANGE = -1 means that we have already found the word we want (it was
|
2114 |
|
|
# a selection)...
|
2115 |
|
|
# RANGE = 1 means we got the word around the point, and we are just saving
|
2116 |
|
|
# getVariable the trouble of parsing it again.
|
2117 |
|
|
if {$range == -1} {
|
2118 |
|
|
set variable $target_range
|
2119 |
|
|
} else {
|
2120 |
|
|
set variable [lindex [getVariable -1 -1 $target_range] 0]
|
2121 |
|
|
}
|
2122 |
|
|
|
2123 |
|
|
if {$variable != ""} {
|
2124 |
|
|
# LAME: check to see if VARIABLE is really a number (constants??)
|
2125 |
|
|
set is_var [catch {expr {$variable+1}}]
|
2126 |
|
|
|
2127 |
|
|
if {$is_var} {
|
2128 |
|
|
$popups(source) add command -label "Add $variable to Watch" \
|
2129 |
|
|
-command [list $this addToWatch $variable]
|
2130 |
|
|
$popups(source) add command -label "Dump Memory at $variable" \
|
2131 |
|
|
-command [list ManagedWin::open MemWin -force -addr_exp $variable]
|
2132 |
|
|
$popups(source) add command -label "Set Breakpoint at $variable" \
|
2133 |
|
|
-command [list gdb_cmd "break $variable"]
|
2134 |
|
|
$popups(source) add separator
|
2135 |
|
|
}
|
2136 |
|
|
}
|
2137 |
|
|
}
|
2138 |
|
|
|
2139 |
|
|
$popups(source) add command -label "Open Another Source Window" \
|
2140 |
|
|
-command {ManagedWin::open SrcWin -force}
|
2141 |
|
|
if {[info exists ::enable_external_editor] && $::enable_external_editor} {
|
2142 |
|
|
$popups(source) add command -label "Open Source in external editor" \
|
2143 |
|
|
-command [list $parent edit]
|
2144 |
|
|
}
|
2145 |
|
|
|
2146 |
|
|
tk_popup $popups(source) $X $Y
|
2147 |
|
|
}
|
2148 |
|
|
|
2149 |
|
|
# ------------------------------------------------------------------
|
2150 |
|
|
# METHOD: addToWatch - add a variable to the watch window
|
2151 |
|
|
# ------------------------------------------------------------------
|
2152 |
|
|
body SrcTextWin::addToWatch {var} {
|
2153 |
|
|
[ManagedWin::open WatchWin] add $var
|
2154 |
|
|
}
|
2155 |
|
|
|
2156 |
|
|
# ------------------------------------------------------------------
|
2157 |
|
|
# METHOD: do_key -- wrapper for all key bindings
|
2158 |
|
|
# ------------------------------------------------------------------
|
2159 |
|
|
body SrcTextWin::do_key {key} {
|
2160 |
|
|
if {!$Running} {
|
2161 |
|
|
switch $key {
|
2162 |
|
|
print { print }
|
2163 |
|
|
download { Download::download_it }
|
2164 |
|
|
run { $parent inferior run }
|
2165 |
|
|
stack { ManagedWin::open StackWin }
|
2166 |
|
|
registers { ManagedWin::open RegWin }
|
2167 |
|
|
memory { ManagedWin::open MemWin }
|
2168 |
|
|
watch { ManagedWin::open WatchWin }
|
2169 |
|
|
locals { ManagedWin::open LocalsWin }
|
2170 |
|
|
breakpoints { ManagedWin::open BpWin }
|
2171 |
|
|
console { ManagedWin::open Console }
|
2172 |
|
|
step { $parent inferior step }
|
2173 |
|
|
next { $parent inferior next }
|
2174 |
|
|
finish { $parent inferior finish }
|
2175 |
|
|
continue { $parent inferior continue }
|
2176 |
|
|
stepi { $parent inferior stepi }
|
2177 |
|
|
nexti { $parent inferior nexti }
|
2178 |
|
|
up { catch {gdb_cmd up} }
|
2179 |
|
|
down { catch {gdb_cmd down} }
|
2180 |
|
|
quit { gdbtk_quit }
|
2181 |
|
|
tdump { ManagedWin::open TdumpWin }
|
2182 |
|
|
tracepoints { ManagedWin::open BpWin -tracepoints 1}
|
2183 |
|
|
tfind_next { catch {gdb_immediate tfind} }
|
2184 |
|
|
tfind_prev { catch {gdb_immediate "tfind -"} }
|
2185 |
|
|
tfind_start { catch {gdb_immediate "tfind start"} }
|
2186 |
|
|
tfind_line { catch {gdb_immediate "tfind line"} }
|
2187 |
|
|
tfind_tp { catch {gdb_immediate "tfind tracepoint"} }
|
2188 |
|
|
open { catch {_open_file} }
|
2189 |
|
|
close { catch {_close_file} }
|
2190 |
|
|
browser { catch {ManagedWin::open BrowserWin} }
|
2191 |
|
|
thread_list { catch {ManagedWin::open ProcessWin} }
|
2192 |
|
|
debug { catch {ManagedWin::open DebugWin} }
|
2193 |
|
|
kod { catch {ManagedWin::open KodWin} }
|
2194 |
|
|
attach { catch {gdbtk_attach_native} }
|
2195 |
|
|
default {
|
2196 |
|
|
dbug E "Unknown key binding: \"$key\""
|
2197 |
|
|
}
|
2198 |
|
|
}
|
2199 |
|
|
} else {
|
2200 |
|
|
# debug "ignoring keypress -- running"
|
2201 |
|
|
}
|
2202 |
|
|
}
|
2203 |
|
|
|
2204 |
|
|
# ------------------------------------------------------------------
|
2205 |
|
|
# METHOD: mode_get - get the source mode
|
2206 |
|
|
# ------------------------------------------------------------------
|
2207 |
|
|
body SrcTextWin::mode_get {} {
|
2208 |
|
|
return $current(mode)
|
2209 |
|
|
}
|
2210 |
|
|
|
2211 |
|
|
# ------------------------------------------------------------------
|
2212 |
|
|
# METHOD: mode_set - change the source mode
|
2213 |
|
|
# ------------------------------------------------------------------
|
2214 |
|
|
body SrcTextWin::mode_set {new_mode {go 1}} {
|
2215 |
|
|
debug "$new_mode"
|
2216 |
|
|
|
2217 |
|
|
if {$new_mode != $current(mode)} {
|
2218 |
|
|
|
2219 |
|
|
if {$current(mode) == "SRC+ASM"} {
|
2220 |
|
|
if {$_bpane != ""} {$itk_interior.p hide $_bpane}
|
2221 |
|
|
set _bpane ""
|
2222 |
|
|
set _bwin ""
|
2223 |
|
|
}
|
2224 |
|
|
|
2225 |
|
|
set current(mode) $new_mode
|
2226 |
|
|
set mode_changed 1
|
2227 |
|
|
|
2228 |
|
|
if {$go} {
|
2229 |
|
|
location $current(tag) $current(filename) $current(funcname) \
|
2230 |
|
|
$current(line) $current(addr) $pc(addr) $current(lib)
|
2231 |
|
|
}
|
2232 |
|
|
}
|
2233 |
|
|
}
|
2234 |
|
|
|
2235 |
|
|
# ------------------------------------------------------------------
|
2236 |
|
|
# METHOD: cancelMotion - cancel any pending motion callbacks for
|
2237 |
|
|
# the source window's variable balloons
|
2238 |
|
|
# ------------------------------------------------------------------
|
2239 |
|
|
body SrcTextWin::cancelMotion {} {
|
2240 |
|
|
catch {after cancel $timeoutID}
|
2241 |
|
|
}
|
2242 |
|
|
|
2243 |
|
|
# ------------------------------------------------------------------
|
2244 |
|
|
# METHOD: motion - callback for mouse motion within the source
|
2245 |
|
|
# window's text widget
|
2246 |
|
|
# ------------------------------------------------------------------
|
2247 |
|
|
body SrcTextWin::motion {type win x y} {
|
2248 |
|
|
global gdb_running
|
2249 |
|
|
cancelMotion
|
2250 |
|
|
|
2251 |
|
|
# The showBalloon method can sometimes raise errors (for instance in
|
2252 |
|
|
# assembly code with no sources, and when gdb coughs over a path
|
2253 |
|
|
# that contains a space. These functions should error quietly.
|
2254 |
|
|
# but write to the debug window so we can trace problems.
|
2255 |
|
|
|
2256 |
|
|
if {$type == "var"} {
|
2257 |
|
|
set cmd_bit ""
|
2258 |
|
|
} else {
|
2259 |
|
|
set cmd_bit BP
|
2260 |
|
|
}
|
2261 |
|
|
set cmd_line [format {
|
2262 |
|
|
if {[catch {%s show%sBalloon %s %d %d} err]} {
|
2263 |
|
|
debug "show%sBalloon got error: $err"
|
2264 |
|
|
}
|
2265 |
|
|
} $this $cmd_bit $win $x $y $cmd_bit]
|
2266 |
|
|
set timeoutID [after $TimeOut $cmd_line]
|
2267 |
|
|
}
|
2268 |
|
|
|
2269 |
|
|
|
2270 |
|
|
# ------------------------------------------------------------------
|
2271 |
|
|
# METHOD: showBPBalloon - show BP information in a balloon
|
2272 |
|
|
# ------------------------------------------------------------------
|
2273 |
|
|
body SrcTextWin::showBPBalloon {win x y} {
|
2274 |
|
|
if {$Running} { return }
|
2275 |
|
|
$win tag remove _show_variable 1.0 end
|
2276 |
|
|
set line [lindex [split [$win index @0,$y] .] 0]
|
2277 |
|
|
set bps ""
|
2278 |
|
|
|
2279 |
|
|
switch $current(mode) {
|
2280 |
|
|
SRC+ASM {
|
2281 |
|
|
if {$win == $bwin} {
|
2282 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
2283 |
|
|
set addr $_map($Cname,line=$line)
|
2284 |
|
|
set bps [gdb_find_bp_at_addr $addr]
|
2285 |
|
|
} else {
|
2286 |
|
|
return
|
2287 |
|
|
}
|
2288 |
|
|
}
|
2289 |
|
|
}
|
2290 |
|
|
ASSEMBLY {
|
2291 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
2292 |
|
|
set addr $_map($Cname,line=$line)
|
2293 |
|
|
set bps [gdb_find_bp_at_addr $addr]
|
2294 |
|
|
} else {
|
2295 |
|
|
return
|
2296 |
|
|
}
|
2297 |
|
|
}
|
2298 |
|
|
MIXED {
|
2299 |
|
|
if {[info exists _map($Cname,line=$line)]} {
|
2300 |
|
|
set addr $_map($Cname,line=$line)
|
2301 |
|
|
set bps [gdb_find_bp_at_addr $addr]
|
2302 |
|
|
} else {
|
2303 |
|
|
return
|
2304 |
|
|
}
|
2305 |
|
|
}
|
2306 |
|
|
}
|
2307 |
|
|
|
2308 |
|
|
if {$bps == ""} {
|
2309 |
|
|
set bps [gdb_find_bp_at_line $current(filename) $line]
|
2310 |
|
|
}
|
2311 |
|
|
|
2312 |
|
|
set str ""
|
2313 |
|
|
set need_lf 0
|
2314 |
|
|
foreach b $bps {
|
2315 |
|
|
set bpinfo [gdb_get_breakpoint_info $b]
|
2316 |
|
|
lassign $bpinfo file func linenum addr type enabled disposition \
|
2317 |
|
|
ignore_count commands cond thread hit_count user_specification
|
2318 |
|
|
if {$thread == "-1"} {set thread "all"}
|
2319 |
|
|
set file [lindex [file split $file] end]
|
2320 |
|
|
if {$enabled} {
|
2321 |
|
|
set enabled "ENA"
|
2322 |
|
|
} else {
|
2323 |
|
|
set enabled "DIS"
|
2324 |
|
|
}
|
2325 |
|
|
if {$cond == ""} {set cond "none"}
|
2326 |
|
|
if {$need_lf} {
|
2327 |
|
|
append str \n
|
2328 |
|
|
} else {
|
2329 |
|
|
set need_lf 1
|
2330 |
|
|
}
|
2331 |
|
|
append str [format "breakpoint %d at %s:%d (%#x)\n\t%s %s %s %s %s" \
|
2332 |
|
|
$b $file $linenum $addr $enabled $type $disposition \
|
2333 |
|
|
threads=$thread cond=$cond]
|
2334 |
|
|
}
|
2335 |
|
|
|
2336 |
|
|
# Scope out which break type is set here, and use the tag to get
|
2337 |
|
|
# the break region range...
|
2338 |
|
|
|
2339 |
|
|
set tag_list [$win tag names $line.0]
|
2340 |
|
|
set break_tag [lindex $tag_list [lsearch -glob $tag_list *bp_tag]]
|
2341 |
|
|
set end [lindex [$win tag nextrange $break_tag $line.0 $line.end] 1]
|
2342 |
|
|
|
2343 |
|
|
if {$end != ""} {
|
2344 |
|
|
$win tag add _show_variable $line.0 $end
|
2345 |
|
|
balloon register $win $str _show_variable
|
2346 |
|
|
balloon show $win _show_variable 1
|
2347 |
|
|
}
|
2348 |
|
|
}
|
2349 |
|
|
|
2350 |
|
|
# ------------------------------------------------------------------
|
2351 |
|
|
# METHOD: showBalloon - (possibly) show a variable's value in
|
2352 |
|
|
# a balloon-help widget
|
2353 |
|
|
# ------------------------------------------------------------------
|
2354 |
|
|
body SrcTextWin::showBalloon {win x y} {
|
2355 |
|
|
if {$Running} { return }
|
2356 |
|
|
|
2357 |
|
|
$twin tag remove _show_variable 1.0 end
|
2358 |
|
|
catch {tmp delete}
|
2359 |
|
|
|
2360 |
|
|
|
2361 |
|
|
if {[catch {getVariable $x $y} variable]} {
|
2362 |
|
|
return
|
2363 |
|
|
}
|
2364 |
|
|
|
2365 |
|
|
if {[llength $variable] != 3} {
|
2366 |
|
|
return
|
2367 |
|
|
}
|
2368 |
|
|
|
2369 |
|
|
# We get the variable name, and its start and stop indices in the text
|
2370 |
|
|
# widget, so all we need to do is set the tag and register the balloon help
|
2371 |
|
|
set varName [lindex $variable 0]
|
2372 |
|
|
set start [lindex $variable 1]
|
2373 |
|
|
set stop [lindex $variable 2]
|
2374 |
|
|
|
2375 |
|
|
# Get the address associated with this line
|
2376 |
|
|
foreach {file text_line source_line type} [lookup_line $twin $y] {
|
2377 |
|
|
break
|
2378 |
|
|
}
|
2379 |
|
|
|
2380 |
|
|
# Reduce the areas over which we will show balloons.
|
2381 |
|
|
# 1) Only pop up a balloon if we are over the function in
|
2382 |
|
|
# the currently selected frame, or in the static data for
|
2383 |
|
|
# the file.
|
2384 |
|
|
# 2) We would also like to exclude cases where the line that
|
2385 |
|
|
# under the mouse cursor does not contain executable code,
|
2386 |
|
|
# but we can't since gdb considers continuation lines to not
|
2387 |
|
|
# have executible code so we would lose on these...
|
2388 |
|
|
|
2389 |
|
|
set cur_fn [lindex [gdb_loc $file:$source_line] 1]
|
2390 |
|
|
set selected_frame_fn [lindex [gdb_loc] 1]
|
2391 |
|
|
|
2392 |
|
|
if {[string compare $cur_fn $selected_frame_fn] == 0} {
|
2393 |
|
|
# Create the variable object
|
2394 |
|
|
catch {$_balloon_var delete}
|
2395 |
|
|
set err [catch {gdb_variable create -expr $varName} _balloon_var]
|
2396 |
|
|
if {!$err} {
|
2397 |
|
|
set value [balloon_value $_balloon_var]
|
2398 |
|
|
if {$value != ""} {
|
2399 |
|
|
$win tag add _show_variable $start $stop
|
2400 |
|
|
|
2401 |
|
|
# display variable's value
|
2402 |
|
|
balloon register $twin "$varName=$value" _show_variable
|
2403 |
|
|
balloon show $win _show_variable
|
2404 |
|
|
} else {
|
2405 |
|
|
# No value/error. Don't show it.
|
2406 |
|
|
catch {$_balloon_var delete}
|
2407 |
|
|
set _balloon_var {}
|
2408 |
|
|
}
|
2409 |
|
|
} else {
|
2410 |
|
|
set _balloon_var {}
|
2411 |
|
|
}
|
2412 |
|
|
} else {
|
2413 |
|
|
set _balloon_var {}
|
2414 |
|
|
}
|
2415 |
|
|
}
|
2416 |
|
|
|
2417 |
|
|
# ------------------------------------------------------------------
|
2418 |
|
|
# METHOD: getVariable - get the name of the 'variable' under the
|
2419 |
|
|
# mouse pointer in the text widget
|
2420 |
|
|
# ------------------------------------------------------------------
|
2421 |
|
|
body SrcTextWin::getVariable {x y {line {}}} {
|
2422 |
|
|
#debug "$x $y $line"
|
2423 |
|
|
set hit_point [$twin index @$x,$y]
|
2424 |
|
|
|
2425 |
|
|
if {$x != -1 && $y != -1} {
|
2426 |
|
|
# If we are over a selection, just report that:
|
2427 |
|
|
if {([$twin tag ranges sel] != "")
|
2428 |
|
|
&& ([$twin compare sel.first < $hit_point]
|
2429 |
|
|
&& [$twin compare $hit_point < sel.last])} {
|
2430 |
|
|
return [list [$twin get sel.first sel.last] [$twin index sel.first] [$twin index sel.last]]
|
2431 |
|
|
}
|
2432 |
|
|
# Since we will only be concerned with this line, get it
|
2433 |
|
|
set line [$twin get "$hit_point linestart" "$hit_point lineend"]
|
2434 |
|
|
# debug "new line=$line"
|
2435 |
|
|
set simple 0
|
2436 |
|
|
} else {
|
2437 |
|
|
# This is not quite right -- still want constants to appear...
|
2438 |
|
|
set simple 1
|
2439 |
|
|
}
|
2440 |
|
|
|
2441 |
|
|
# The index into LINE that contains the char at which the pointer hangs
|
2442 |
|
|
set a [split [$twin index @$x,$y] .]
|
2443 |
|
|
set lineNo [lindex $a 0]
|
2444 |
|
|
set index [lindex $a 1]
|
2445 |
|
|
set s [string range $line $index end]
|
2446 |
|
|
set last {}
|
2447 |
|
|
foreach char [split $s {}] {
|
2448 |
|
|
if {[regexp -- {([^a-zA-Z0-9_>.-])} $char dummy]} {
|
2449 |
|
|
break
|
2450 |
|
|
}
|
2451 |
|
|
lappend last $char
|
2452 |
|
|
}
|
2453 |
|
|
set last [string trimright [join $last {}] ->]
|
2454 |
|
|
|
2455 |
|
|
# Decrement index for string -- will need to increment it later
|
2456 |
|
|
incr index -1
|
2457 |
|
|
set tmp [string range $line 0 $index]
|
2458 |
|
|
set s {}
|
2459 |
|
|
foreach char [split $tmp {}] {
|
2460 |
|
|
set s [linsert $s 0 $char]
|
2461 |
|
|
}
|
2462 |
|
|
|
2463 |
|
|
set first {}
|
2464 |
|
|
foreach char $s {
|
2465 |
|
|
if {[regexp -- {([^a-zA-Z0-9_>.-])} $char dummy]} {
|
2466 |
|
|
break
|
2467 |
|
|
}
|
2468 |
|
|
set first [linsert $first 0 $char]
|
2469 |
|
|
}
|
2470 |
|
|
#set first [string trimleft [join $first {}] ->]
|
2471 |
|
|
set first [join $first {}]
|
2472 |
|
|
#debug "FIRST=$first\nLAST=$last"
|
2473 |
|
|
|
2474 |
|
|
# Validate the variable
|
2475 |
|
|
set variable [string trim $first$last \ ]
|
2476 |
|
|
if {!$simple && ![regexp {^[a-zA-Z_]} $variable dummy]} {
|
2477 |
|
|
#debug "Rejecting: $variable"
|
2478 |
|
|
return {}
|
2479 |
|
|
}
|
2480 |
|
|
|
2481 |
|
|
incr index
|
2482 |
|
|
# Find the boundaries of this word in the text box
|
2483 |
|
|
set a [string length $first]
|
2484 |
|
|
set b [string length $last]
|
2485 |
|
|
|
2486 |
|
|
# Gag! If there is a breakpoint at a line, this is off by one!
|
2487 |
|
|
if {[hasBP $twin $lineNo] || [hasTP $twin $lineNo]} {
|
2488 |
|
|
incr a -1
|
2489 |
|
|
incr b 1
|
2490 |
|
|
}
|
2491 |
|
|
set start "$lineNo.[expr {$index - $a}]"
|
2492 |
|
|
set end "$lineNo.[expr {$index + $b}]"
|
2493 |
|
|
return [list $variable $start $end]
|
2494 |
|
|
}
|
2495 |
|
|
|
2496 |
|
|
# ------------------------------------------------------------------
|
2497 |
|
|
# METHOD: trace_help - update statusbar with ballon help message
|
2498 |
|
|
# ------------------------------------------------------------------
|
2499 |
|
|
body SrcTextWin::trace_help {args} {
|
2500 |
|
|
upvar #0 ${this}_balloon a
|
2501 |
|
|
if {$a == ""} {
|
2502 |
|
|
$parent set_status
|
2503 |
|
|
} else {
|
2504 |
|
|
$parent set_status $a 1
|
2505 |
|
|
}
|
2506 |
|
|
}
|
2507 |
|
|
|
2508 |
|
|
body SrcTextWin::line_is_executable {win line} {
|
2509 |
|
|
# there should be an image or a "-" on the line
|
2510 |
|
|
set res [catch {$win image cget $line.0 -image}]
|
2511 |
|
|
if {!$res || [$win get $line.0] == "-"} {
|
2512 |
|
|
return 1
|
2513 |
|
|
}
|
2514 |
|
|
return 0
|
2515 |
|
|
}
|
2516 |
|
|
|
2517 |
|
|
# ------------------------------------------------------------------
|
2518 |
|
|
# METHOD: tracepoint_range - create tracepoints at every line in
|
2519 |
|
|
# a range of lines on the screen
|
2520 |
|
|
# ------------------------------------------------------------------
|
2521 |
|
|
body SrcTextWin::tracepoint_range {win low high} {
|
2522 |
|
|
# debug "$win $low $high"
|
2523 |
|
|
|
2524 |
|
|
switch $current(mode) {
|
2525 |
|
|
SOURCE {
|
2526 |
|
|
set lines {}
|
2527 |
|
|
for {set i $low} {$i <= $high} {incr i} {
|
2528 |
|
|
if {[line_is_executable $win $i]} {
|
2529 |
|
|
lappend lines $i
|
2530 |
|
|
}
|
2531 |
|
|
}
|
2532 |
|
|
}
|
2533 |
|
|
|
2534 |
|
|
ASSEMBLY {
|
2535 |
|
|
set addrs {}
|
2536 |
|
|
for {set i $low} {$i <= $high} {incr i} {
|
2537 |
|
|
lappend addrs $_map($Cname,line=$i)
|
2538 |
|
|
}
|
2539 |
|
|
}
|
2540 |
|
|
|
2541 |
|
|
MIXED {
|
2542 |
|
|
set addrs {}
|
2543 |
|
|
for {set i $low} {$i <= $high} {incr i} {
|
2544 |
|
|
if {[line_is_executable $win $i]} {
|
2545 |
|
|
lappend addrs $_map($Cname,line=$i)
|
2546 |
|
|
}
|
2547 |
|
|
}
|
2548 |
|
|
}
|
2549 |
|
|
|
2550 |
|
|
SRC+ASM {
|
2551 |
|
|
if {$win == $awin} {
|
2552 |
|
|
# Assembly
|
2553 |
|
|
set addrs {}
|
2554 |
|
|
for {set i $low} {$i <= $high} {incr i} {
|
2555 |
|
|
lappend addrs $_map($Cname,line=$i)
|
2556 |
|
|
}
|
2557 |
|
|
} else {
|
2558 |
|
|
# Source
|
2559 |
|
|
set lines {}
|
2560 |
|
|
for {set i $low} {$i <= $high} {incr i} {
|
2561 |
|
|
if {[line_is_executable $win $i]} {
|
2562 |
|
|
lappend lines $i
|
2563 |
|
|
}
|
2564 |
|
|
}
|
2565 |
|
|
}
|
2566 |
|
|
}
|
2567 |
|
|
}
|
2568 |
|
|
|
2569 |
|
|
if {[info exists lines]} {
|
2570 |
|
|
# debug "Got executible lines: $lines"
|
2571 |
|
|
if {[llength $lines]} {
|
2572 |
|
|
set name [::file tail $current(filename)]
|
2573 |
|
|
ManagedWin::open TraceDlg -File $name -Lines $lines
|
2574 |
|
|
}
|
2575 |
|
|
} elseif {[info exists addrs]} {
|
2576 |
|
|
# debug "Got executible addresses: $addrs"
|
2577 |
|
|
if {[llength $addrs]} {
|
2578 |
|
|
set name [::file tail $current(filename)]
|
2579 |
|
|
ManagedWin::open TraceDlg -File $name -Addresses $addrs
|
2580 |
|
|
}
|
2581 |
|
|
} else {
|
2582 |
|
|
# debug "Got no executible lines in the selected range..."
|
2583 |
|
|
}
|
2584 |
|
|
|
2585 |
|
|
# Clear the selection -- it looks a lot better.
|
2586 |
|
|
$twin tag remove sel 1.0 end
|
2587 |
|
|
}
|
2588 |
|
|
|
2589 |
|
|
|
2590 |
|
|
# ------------------------------------------------------------------
|
2591 |
|
|
# METHOD: search - search for text or jump to a specific line
|
2592 |
|
|
# in source window, going in the specified DIRECTION.
|
2593 |
|
|
# ------------------------------------------------------------------
|
2594 |
|
|
body SrcTextWin::search {exp direction} {
|
2595 |
|
|
if {$exp != ""} {
|
2596 |
|
|
set result {}
|
2597 |
|
|
if {[regexp {^@([0-9]+)} $exp dummy index]} {
|
2598 |
|
|
append index .0
|
2599 |
|
|
set end [$twin index "$index lineend"]
|
2600 |
|
|
} else {
|
2601 |
|
|
set index [$twin search -exact -count len -$direction -- $exp $SearchIndex]
|
2602 |
|
|
|
2603 |
|
|
if {$index != ""} {
|
2604 |
|
|
set end [split $index .]
|
2605 |
|
|
set line [lindex $end 0]
|
2606 |
|
|
set char [lindex $end 1]
|
2607 |
|
|
set char [expr {$char + $len}]
|
2608 |
|
|
set end $line.$char
|
2609 |
|
|
set result "Match of \"$exp\" found on line $line"
|
2610 |
|
|
if {$direction == "forwards"} {
|
2611 |
|
|
set SearchIndex $end
|
2612 |
|
|
} else {
|
2613 |
|
|
set SearchIndex $index
|
2614 |
|
|
}
|
2615 |
|
|
}
|
2616 |
|
|
}
|
2617 |
|
|
if {$index != ""} {
|
2618 |
|
|
# Highlight word and save index
|
2619 |
|
|
$twin tag remove search 1.0 end
|
2620 |
|
|
$twin tag add search $index $end
|
2621 |
|
|
$twin see $index
|
2622 |
|
|
} else {
|
2623 |
|
|
set result "No match for \"$exp\" found"
|
2624 |
|
|
}
|
2625 |
|
|
return $result
|
2626 |
|
|
} else {
|
2627 |
|
|
$twin tag remove search 1.0 end
|
2628 |
|
|
}
|
2629 |
|
|
}
|
2630 |
|
|
|
2631 |
|
|
# -----------------------------------------------------------------------------
|
2632 |
|
|
# NAME: SrcTextWin::LoadFromCache
|
2633 |
|
|
#
|
2634 |
|
|
# SYNOPSIS: LoadFromCache {w name asm lib}
|
2635 |
|
|
#
|
2636 |
|
|
# DESC: Looks up $name in the cache. If $name is cached, replace the
|
2637 |
|
|
# pane $w with the cached pane. Otherwise create a new
|
2638 |
|
|
# pane and scrolledtext widget and set _${w}pane and _${w}win.
|
2639 |
|
|
#
|
2640 |
|
|
# ARGS: w "t" or "b" (for Top and Bottom pane)
|
2641 |
|
|
# name name to look for in cache. This will be a filename if
|
2642 |
|
|
# we are filling in a source window, or an address
|
2643 |
|
|
# otherwise.
|
2644 |
|
|
# asm 'S' for source,
|
2645 |
|
|
# 'A' for assembly mode
|
2646 |
|
|
# 'M' for mixed mode.
|
2647 |
|
|
# lib library name
|
2648 |
|
|
#
|
2649 |
|
|
# RETURNS: 0 - read from cache
|
2650 |
|
|
# 1 - created new (blank) widget
|
2651 |
|
|
# -1 - could not find the contents you are trying to load,
|
2652 |
|
|
# so far this only happens for "Source" files.
|
2653 |
|
|
#
|
2654 |
|
|
# NOTES: If you call this and a new widget is created which cannot be
|
2655 |
|
|
# filled in later due to errors, call UnLoadFromCache.
|
2656 |
|
|
# -----------------------------------------------------------------------------
|
2657 |
|
|
|
2658 |
|
|
body SrcTextWin::LoadFromCache {w name asm lib} {
|
2659 |
|
|
debug "LoadFromCache $w $name $asm"
|
2660 |
|
|
global tcl_platform
|
2661 |
|
|
upvar ${w}win win
|
2662 |
|
|
upvar _${w}pane pane
|
2663 |
|
|
|
2664 |
|
|
if {[string compare gdbtk_scratch_widget $name]} {
|
2665 |
|
|
append full_name $name "," $asm "," $lib
|
2666 |
|
|
} else {
|
2667 |
|
|
set full_name $name
|
2668 |
|
|
}
|
2669 |
|
|
|
2670 |
|
|
set loadingSource [expr ![string compare $asm "S"]]
|
2671 |
|
|
|
2672 |
|
|
set oldpane $pane
|
2673 |
|
|
if {[info exists Stwc($full_name:pane)]} {
|
2674 |
|
|
debug "READING CACHE $full_name->$Stwc($full_name:pane)"
|
2675 |
|
|
set pane $Stwc($full_name:pane)
|
2676 |
|
|
if {$oldpane != ""} {
|
2677 |
|
|
$itk_interior.p replace $oldpane $pane
|
2678 |
|
|
} else {
|
2679 |
|
|
$itk_interior.p show $pane
|
2680 |
|
|
}
|
2681 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
2682 |
|
|
if {!$loadingSource} {
|
2683 |
|
|
set Cname $full_name
|
2684 |
|
|
}
|
2685 |
|
|
|
2686 |
|
|
# If the text in this cache file is dirty, clean the window, and
|
2687 |
|
|
# return 1, which will tell the caller to refill it. Otherwise
|
2688 |
|
|
# return 0, and the caller will just display the window.
|
2689 |
|
|
|
2690 |
|
|
if {$Stwc($name:dirty)} {
|
2691 |
|
|
$win delete 0.0 end
|
2692 |
|
|
set res 1
|
2693 |
|
|
set Stwc($name:dirty) 0
|
2694 |
|
|
} else {
|
2695 |
|
|
set res 0
|
2696 |
|
|
}
|
2697 |
|
|
|
2698 |
|
|
} else {
|
2699 |
|
|
debug "name=$name"
|
2700 |
|
|
# If we are trying to load a source file, check the time
|
2701 |
|
|
# to see if we need to update it. If we can't stat the
|
2702 |
|
|
# file then we probably can't open it either, so error
|
2703 |
|
|
# out.
|
2704 |
|
|
|
2705 |
|
|
if {$loadingSource} {
|
2706 |
|
|
if {[string compare $tcl_platform(platform) "windows"] == 0} {
|
2707 |
|
|
set f [ide_cygwin_path to_win32 $name]
|
2708 |
|
|
} else {
|
2709 |
|
|
set f $name
|
2710 |
|
|
}
|
2711 |
|
|
if {[catch {file mtime $f} file_time]} {
|
2712 |
|
|
debug "Could not stat file \"$f\" - \"$file_time\""
|
2713 |
|
|
return -1
|
2714 |
|
|
} else {
|
2715 |
|
|
set Stwc($full_name:pane) pane$filenum
|
2716 |
|
|
set Stwc($name:mtime) $file_time
|
2717 |
|
|
}
|
2718 |
|
|
} else {
|
2719 |
|
|
# FIXME: This is wrong. For Assembly files we need to
|
2720 |
|
|
# check whether the executable is newer than the cached
|
2721 |
|
|
# disassembly. For mixed files, we need to check BOTH
|
2722 |
|
|
# the source file mtime, and the executable time.
|
2723 |
|
|
|
2724 |
|
|
set Stwc($full_name:pane) pane$filenum
|
2725 |
|
|
set Stwc($name:mtime) 0
|
2726 |
|
|
}
|
2727 |
|
|
|
2728 |
|
|
set Stwc($full_name:pane) pane$filenum
|
2729 |
|
|
|
2730 |
|
|
set Stwc($name:dirty) 0
|
2731 |
|
|
incr filenum
|
2732 |
|
|
|
2733 |
|
|
set pane $Stwc($full_name:pane)
|
2734 |
|
|
debug "pane=$pane"
|
2735 |
|
|
if {$oldpane != ""} {$itk_interior.p hide $oldpane}
|
2736 |
|
|
$itk_interior.p add $pane
|
2737 |
|
|
set p [$itk_interior.p childsite $pane]
|
2738 |
|
|
set st [iwidgets::scrolledtext $p.st \
|
2739 |
|
|
-hscrollmode dynamic -vscrollmode dynamic]
|
2740 |
|
|
set win [$st component text]
|
2741 |
|
|
|
2742 |
|
|
if {!$loadingSource} {
|
2743 |
|
|
set Cname $full_name
|
2744 |
|
|
}
|
2745 |
|
|
pack $st -expand yes -fill both
|
2746 |
|
|
set res 1
|
2747 |
|
|
}
|
2748 |
|
|
|
2749 |
|
|
# reconfigure in case some preferences have changed
|
2750 |
|
|
config_win $win $asm
|
2751 |
|
|
return $res
|
2752 |
|
|
}
|
2753 |
|
|
|
2754 |
|
|
# ------------------------------------------------------------------
|
2755 |
|
|
# METHOD: UnLoadFromCache - revert back to previously cached widget
|
2756 |
|
|
# This is used when a new widget is created with LoadFromCache but
|
2757 |
|
|
# there is a problem with filling the widget.
|
2758 |
|
|
# ------------------------------------------------------------------
|
2759 |
|
|
|
2760 |
|
|
body SrcTextWin::UnLoadFromCache {w oldpane name asm lib} {
|
2761 |
|
|
# debug "$w $oldpane $name"
|
2762 |
|
|
upvar ${w}win win
|
2763 |
|
|
upvar _${w}pane pane
|
2764 |
|
|
# debug "pane=$pane win=$win"
|
2765 |
|
|
|
2766 |
|
|
|
2767 |
|
|
set full_name ${name},${asm},${lib}
|
2768 |
|
|
$itk_interior.p delete $pane
|
2769 |
|
|
foreach elem [array names Stwc $full_name:*] {
|
2770 |
|
|
unset Stwc($elem)
|
2771 |
|
|
}
|
2772 |
|
|
foreach elem [array names Stwc $name:*] {
|
2773 |
|
|
unset Stwc($elem)
|
2774 |
|
|
}
|
2775 |
|
|
|
2776 |
|
|
$itk_interior.p show $oldpane
|
2777 |
|
|
set pane $oldpane
|
2778 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
2779 |
|
|
}
|
2780 |
|
|
|
2781 |
|
|
# ------------------------------------------------------------------
|
2782 |
|
|
# METHOD: print - print the contents of the text widget
|
2783 |
|
|
# ------------------------------------------------------------------
|
2784 |
|
|
body SrcTextWin::print {top} {
|
2785 |
|
|
# FIXME
|
2786 |
|
|
send_printer -ascii [$twin get 1.0 end] -parent $top
|
2787 |
|
|
}
|
2788 |
|
|
|
2789 |
|
|
# ------------------------------------------------------------------
|
2790 |
|
|
# METHOD: ask_thread_bp - prompt for thread(s) for BP
|
2791 |
|
|
# ------------------------------------------------------------------
|
2792 |
|
|
body SrcTextWin::ask_thread_bp {} {
|
2793 |
|
|
# debug
|
2794 |
|
|
if {[catch {gdb_cmd "info thread"} threads]} {
|
2795 |
|
|
# failed. Just leave
|
2796 |
|
|
return
|
2797 |
|
|
}
|
2798 |
|
|
set threads [split $threads \n]
|
2799 |
|
|
set num_threads [expr {[llength $threads] - 1}]
|
2800 |
|
|
if {$num_threads <= 0} {
|
2801 |
|
|
show_warning "No threads were found.\nYou may only set breakpoints on threads\nthat have already been created."
|
2802 |
|
|
return
|
2803 |
|
|
}
|
2804 |
|
|
|
2805 |
|
|
set a [toplevel .[gensym]]
|
2806 |
|
|
wm title $a "Thread Selection"
|
2807 |
|
|
CygScrolledListbox $a.slb -selectmode multiple -height $num_threads
|
2808 |
|
|
|
2809 |
|
|
set i [expr $num_threads - 1]
|
2810 |
|
|
set width 0
|
2811 |
|
|
foreach line $threads {
|
2812 |
|
|
# Active line starts with "*"
|
2813 |
|
|
if {[string index $line 0] == "*"} {
|
2814 |
|
|
# strip off leading "*"
|
2815 |
|
|
set line " [string trimleft $line "*"]"
|
2816 |
|
|
}
|
2817 |
|
|
# scan for GDB ID number at start of line
|
2818 |
|
|
if {[scan $line "%d" id($i)] == 1} {
|
2819 |
|
|
if {[string length $line] > $width} {
|
2820 |
|
|
set width [string length $line]
|
2821 |
|
|
}
|
2822 |
|
|
$a.slb.list insert 0 $line
|
2823 |
|
|
incr i -1
|
2824 |
|
|
}
|
2825 |
|
|
}
|
2826 |
|
|
$a.slb.list configure -width $width
|
2827 |
|
|
|
2828 |
|
|
frame $a.b
|
2829 |
|
|
button $a.b.ok -text OK -underline 0 -width 7 \
|
2830 |
|
|
-command "$this do_thread_bp $a.slb.list"
|
2831 |
|
|
button $a.b.cancel -text Cancel -width 7 -underline 0 -command "destroy $a"
|
2832 |
|
|
pack $a.b.ok $a.b.cancel -side left
|
2833 |
|
|
standard_button_box $a.b
|
2834 |
|
|
pack $a.b -fill x -expand yes -side bottom -padx 5 -pady 5
|
2835 |
|
|
pack $a.slb -side top -fill both -expand yes
|
2836 |
|
|
bind $a.b.ok "$a.b.ok flash; $a.b.ok invoke"
|
2837 |
|
|
focus $a.b.ok
|
2838 |
|
|
}
|
2839 |
|
|
|
2840 |
|
|
# ------------------------------------------------------------------
|
2841 |
|
|
# METHOD: do_thread_bp - callback from thread selection
|
2842 |
|
|
# ------------------------------------------------------------------
|
2843 |
|
|
body SrcTextWin::do_thread_bp {listbox} {
|
2844 |
|
|
# debug "$listbox [$listbox curselection]"
|
2845 |
|
|
set x ""
|
2846 |
|
|
foreach i [$listbox curselection] {
|
2847 |
|
|
lappend x $id($i)
|
2848 |
|
|
}
|
2849 |
|
|
$this set_bp_at_line N {} -1 $x
|
2850 |
|
|
destroy [winfo toplevel $listbox]
|
2851 |
|
|
}
|
2852 |
|
|
|
2853 |
|
|
|
2854 |
|
|
# public method for testing use only!
|
2855 |
|
|
body SrcTextWin::test_get {var} {
|
2856 |
|
|
if {[array exists $var]} {
|
2857 |
|
|
return [array get $var]
|
2858 |
|
|
} else {
|
2859 |
|
|
return [set $var]
|
2860 |
|
|
}
|
2861 |
|
|
}
|
2862 |
|
|
|
2863 |
|
|
# ------------------------------------------------------------------
|
2864 |
|
|
# METHOD: get_file - Return name of current file.
|
2865 |
|
|
# ------------------------------------------------------------------
|
2866 |
|
|
body SrcTextWin::get_file {} {
|
2867 |
|
|
return $current(filename)
|
2868 |
|
|
}
|
2869 |
|
|
|
2870 |
|
|
# ------------------------------------------------------------------
|
2871 |
|
|
# METHOD: clear_file - Clear out state so that user may load
|
2872 |
|
|
# new executable. For the SrcTextWin class, this means:
|
2873 |
|
|
#
|
2874 |
|
|
# Delete all srctextwin caches
|
2875 |
|
|
# Delete the variable balloon if it exists.
|
2876 |
|
|
# Clear the screen.
|
2877 |
|
|
# ------------------------------------------------------------------
|
2878 |
|
|
body SrcTextWin::clear_file {} {
|
2879 |
|
|
|
2880 |
|
|
debug "In clear_file"
|
2881 |
|
|
# delete all caches
|
2882 |
|
|
_clear_cache
|
2883 |
|
|
|
2884 |
|
|
set oldpane {}
|
2885 |
|
|
|
2886 |
|
|
# clear window
|
2887 |
|
|
# FIXME - We don't do this here, because is causes a wierd error
|
2888 |
|
|
# where the "Source file more recent than executible" error gets
|
2889 |
|
|
# for no apparent reason. This only effects the case where the
|
2890 |
|
|
# user types just "file" in the command line, then the window will
|
2891 |
|
|
# not get cleared.
|
2892 |
|
|
|
2893 |
|
|
# delete variable balloon
|
2894 |
|
|
catch {$_balloon_var delete}
|
2895 |
|
|
set _balloon_var {}
|
2896 |
|
|
|
2897 |
|
|
# reinit state
|
2898 |
|
|
_initialize_srctextwin
|
2899 |
|
|
|
2900 |
|
|
# update the screen
|
2901 |
|
|
update idletasks
|
2902 |
|
|
|
2903 |
|
|
}
|
2904 |
|
|
|
2905 |
|
|
body SrcTextWin::_initialize_srctextwin {} {
|
2906 |
|
|
set pc(filename) ""
|
2907 |
|
|
set pc(func) ""
|
2908 |
|
|
set pc(line) 0
|
2909 |
|
|
set pc(addr) ""
|
2910 |
|
|
set pc(asm_line) 0
|
2911 |
|
|
set pc(lib) ""
|
2912 |
|
|
set current(filename) ""
|
2913 |
|
|
set current(funcname) ""
|
2914 |
|
|
set current(line) 0
|
2915 |
|
|
set current(addr) ""
|
2916 |
|
|
set current(asm_line) 0
|
2917 |
|
|
set current(tag) "BROWSE_TAG"
|
2918 |
|
|
set current(mode) "SOURCE"
|
2919 |
|
|
set current(lib) ""
|
2920 |
|
|
}
|
2921 |
|
|
|
2922 |
|
|
# ------------------------------------------------------------------
|
2923 |
|
|
# METHOD: _clear_cache - Clear the cache
|
2924 |
|
|
# ------------------------------------------------------------------
|
2925 |
|
|
body SrcTextWin::_clear_cache {} {
|
2926 |
|
|
|
2927 |
|
|
# display empty scratch frame
|
2928 |
|
|
set pane $Stwc(gdbtk_scratch_widget:pane)
|
2929 |
|
|
set win [[$itk_interior.p childsite $pane].st component text]
|
2930 |
|
|
$win delete 0.0 end
|
2931 |
|
|
$itk_interior.p show $pane
|
2932 |
|
|
|
2933 |
|
|
# delete all cached frames
|
2934 |
|
|
foreach p [array names Stwc *:pane] {
|
2935 |
|
|
set p [lindex [split $p :] 0]
|
2936 |
|
|
if {$p != "gdbtk_scratch_widget"} {
|
2937 |
|
|
catch {
|
2938 |
|
|
#debug "clearing cache: \"$p\""
|
2939 |
|
|
$itk_interior.p delete $Stwc($p:pane)
|
2940 |
|
|
unset Stwc($p:pane)
|
2941 |
|
|
unset Stwc($p:mtime)
|
2942 |
|
|
}
|
2943 |
|
|
}
|
2944 |
|
|
}
|
2945 |
|
|
|
2946 |
|
|
_initialize_srctextwin
|
2947 |
|
|
set filenum 0
|
2948 |
|
|
set Cname ""
|
2949 |
|
|
set _tpane pane$filenum
|
2950 |
|
|
incr filenum
|
2951 |
|
|
set _bpane ""
|
2952 |
|
|
}
|