debugger.tcl

rtai-3.1-test3的源代码(Real-Time Application Interface )

}

proc Debugger:showStack {debugfrm} {
    global Debugger:f2w Debugger:stacklevel
    set dataw [set Debugger:f2w($debugfrm,data)]
    $dataw manage stack
    set level [set Debugger:stacklevel($debugfrm)]
    set stackw [set Debugger:f2w($debugfrm,stack)]
    set lbox [$stackw subwidget listbox]
    catch { $lbox selection set $level }
}

proc Debugger:hideStack {debugfrm} {
    global Debugger:f2w
    set dataw [set Debugger:f2w($debugfrm,data)]
    $dataw forget stack
}

proc Debugger:showLocals {debugfrm} {

    global Debugger:f2c Debugger:f2w Debugger:localinfo
    global Debugger:stackinfo
    global Debugger:xcontext Debugger:stacklevel
    global $debugfrm:switches

    set dataw [set Debugger:f2w($debugfrm,data)]
    $dataw manage locals
    set focuscmd [Debugger:buildFocusCmd $debugfrm]
    set context [set Debugger:f2c($debugfrm)]
    set level [set Debugger:stacklevel($debugfrm)]
    set fnum [lindex [lindex [set Debugger:stackinfo($debugfrm)] $level] 0]
    set xcontext [set Debugger:xcontext($debugfrm)]

    if {[Debugger:resume $context $focuscmd $fnum] != {}} {
	set Debugger:localinfo($xcontext,$level) \
	    [gdb:getlocals]
	Debugger:suspend $context $focuscmd
    }

    set tree [set Debugger:f2w($debugfrm,locals)]
    DataDisplay:updateLocalData $debugfrm $tree
}

proc Debugger:hideLocals {debugfrm} {
    global Debugger:f2w
    set dataw [set Debugger:f2w($debugfrm,data)]
    $dataw forget locals
    DataDisplay:hideLocals $debugfrm [set Debugger:f2w($debugfrm,locals)]
}

proc Debugger:forceSwitchOn {debugfrm what} {

    global $debugfrm:switches

    if {[lsearch -exact [set $debugfrm:switches] $what] == -1} {
	# note: altering the following tracked variable
	# triggers the proper toolbarSwitch invocation...
	lappend $debugfrm:switches $what
    }
}

proc Debugger:notifyPreamble {context} {

    # restore breakpoints
    Debugger:restoreBreakpoints $context
    # restore watchpoints
    Debugger:restoreWatchpoints $context
}

proc Debugger:notifyBreak {context location} {

    global Debugger:c2f Debugger:state Project:settings
    global Debugger:configHasChanged Debugger:lockview
    global Debugger:operating
    global Monitor:stopCond

    if {${Debugger:configHasChanged}} {
	gdb:setsrc [set Project:settings(SourceDirs)]
	set Debugger:configHasChanged false
    }

    set w ${Debugger:operating}

    if {[set Debugger:lockview($w)] == 0} {

	# If a break condition has been raised, ensure the display is
	# in sync with the execution path, unless the current view
	# as been explicitely locked on a given thread. To
	# achieve this, just switch the focus of the operating frame
	# to "system".  Setting the focus to the destination value
	# prior to pick the "system" entry from the focus combo
	# prevents any attempt to update the display now. We just want
	# the proper value to be displayed in the combo.

	global Debugger:focus
	set Debugger:focus($w) system
	$w.selectors.focus pick 0
    }
    
    foreach debugfrm [set Debugger:c2f($context)] {
	$debugfrm.messages.location configure -text (Busy)
	Debugger:updateFocus $debugfrm $location
    }

    # something may fail during the focus update -- so be VERY
    # conservative and check for the GDB connection before asking for
    # global data...

    if {${Debugger:state} == "alive"} {
	DataDisplay:updateGlobalData $context
    }
}

proc Debugger:notifyException {context location siginfo} {

    global Debugger:c2f Debugger:focus Debugger:workspace

    # cancel startup timer (if any)
    set progressbar [set Debugger:workspace($context)].mtoolbar.progress

    if {[winfo exists $progressbar] == 1} {
	global Debugger:ptimer
	after cancel ${Debugger:ptimer}
	destroy $progressbar
    }

    # oops, exception raised - each frame should display
    # the faulty address - switch each frame to the system
    # context before updating focuses.

    foreach debugfrm [set Debugger:c2f($context)] {
	set Debugger:focus($debugfrm) system
    }

    Debugger:notifyBreak $context $location

    foreach debugfrm [set Debugger:c2f($context)] {
	$debugfrm.messages.warning configure -text $siginfo
	bell -displayof $debugfrm
    }

    pushEvent Application:event DebuggerExceptionEvent
}

proc Debugger:updateThreads {debugfrm} {

    global Debugger:f2c Debugger:threadlist Project:settings

    Debugger:clearFocus $debugfrm
    set context [set Debugger:f2c($debugfrm)]
    set threadlist [TkRequest $context GetThreads]
    set Debugger:threadlist $threadlist

    foreach threaddef $threadlist {
	set name [lindex $threaddef 1]
	set body [lindex $threaddef 2]
	if {[set Project:settings(Options,threadQualify)] == 0 || $body == {}} {
	    set idstring $name
	} {
	    set idstring [format "%s(%s)" $body $name]
	}
	$debugfrm.selectors.focus insert end $idstring
    }
}

proc Debugger:clearFocus {debugfrm} {

    set lbox [$debugfrm.selectors.focus subwidget listbox]
    $lbox delete 0 end
    $lbox insert end (system)
}

proc Debugger:setFocus {debugfrm focus} {

    if {$focus == {}} {
	return
    }

    global Debugger:focus Debugger:f2c Debugger:lockview

    set context [set Debugger:f2c($debugfrm)]
    set oldfocus [set Debugger:focus($debugfrm)]

    switch $focus {
	(system) {
	    set Debugger:focus($debugfrm) system
	    set Debugger:lockview($debugfrm) 0
	}
	default {
	    global Debugger:threadlist
	    set lbox [$debugfrm.selectors.focus subwidget listbox]
	    set sel [$lbox curselection]
	    set id [lindex [lindex ${Debugger:threadlist} [expr $sel - 1]] 0]
	    set Debugger:focus($debugfrm) $id
	    set Debugger:lockview($debugfrm) 1
	}
    }

    if {$oldfocus != [set Debugger:focus($debugfrm)] &&
	[Debugger:resume $context] != "false"} {
	Debugger:updateFocus $debugfrm {} false
	Debugger:suspend $context
    }
}

proc Debugger:resume {context {focuscmd {}} {fnum {}}} {

    TkRequest $context HoldSimulation
    return [gdb:getctl $context $focuscmd $fnum]
}

proc Debugger:suspend {context {focuscmd {}}} {

    gdb:relctl $context $focuscmd
}

proc Debugger:listen {context {state Running}} {

    global Debugger:state Debugger:c2f
    global Debugger:operating Project:settings

    foreach debugfrm [set Debugger:c2f($context)] {
	$debugfrm.messages.location configure -text ($state)
    }
    pushEvent Application:event DebuggeeReleasedEvent
    gdb:release $context

    # The debug session may have been aborted while listening to GDB:
    # check for this condition before actually sending an event
    # telling that we hold the debuggee...

    if {${Debugger:state} == "alive"} {
	pushEvent Application:event DebuggeeHeldEvent
	if {[set Project:settings(Options,forceFocusOnBreak)] == 1} {
	    global Monitor:initState Monitor:stopCond
	    if {${Monitor:initState} == "ok" && ${Monitor:stopCond} >= 5} {
		# stopCond 5/6 == breakpoint/watchpoint"
		Debugger:setThreadLock ${Debugger:operating}
	    }
	}
    }
}

proc Debugger:progress {context} {

    global Debugger:ptimer Debugger:workspace

    catch {
	set meter [set Debugger:workspace($context)].mtoolbar.progress
	set v [$meter cget -value]
	set msg [$meter cget -text]

	if {$v < 1.0} {
	    set v [expr $v + 0.025]
	    $meter config -value $v
	} {
	    set v 0.025
	    set fg [$meter cget -fillcolor]
	    $meter config -value $v -fillcolor [$meter cget -background]
	    $meter config -fillcolor $fg
	}

	if {$msg == " "} {
	    set msg "Loading..."
	} {
	    set msg " "
	}
	$meter config -value $v -text $msg
	set Debugger:ptimer [after 250 "Debugger:progress $context"]
    }
}

proc Debugger:postSourceMenu {debugfrm rootx rooty} {

    global Debugger:childState Debugger:f2w
    global Debugger:focus Debugger:f2s
    global Debugger:hotSymbol

    if {${Debugger:childState} != "held" &&
	${Debugger:childState} != "zombie"} {
	# no source menu is available until the debuggee
	# is under control (i.e. in a held or zombie state)
	return false
    }

    # clear last warning (if any)
    $debugfrm.messages.warning configure -text {}

    set file [set Debugger:f2s($debugfrm)]

    if {$file == {}} {
	# no source file displayed
	return false
    }

    set w [set Debugger:f2w($debugfrm,source)]
    # turn root coordinates into text widget coordinates
    set x [expr $rootx - [winfo rootx $w]]
    set y [expr $rooty - [winfo rooty $w]]
    # compute line number from pixel coordinates
    set lineno [lindex [split [$w index @$x,$y] .] 0]
    set menu [$w.popup subwidget menu]
    $menu delete 0 end

    # try using the hot symbol first (shut down the evaluation
    # bubble to stop noise)
    set sel ${Debugger:hotSymbol}
    Debugger:stopPointerNoise $debugfrm $w

    if {$sel == {} && [catch {set sel [$w get sel.first sel.last]}] == 1} {
	# try using the scratchpad value if no selection is active
	# in the source buffer...
	set sel [$debugfrm.selectors.scratchpad cget -selection]
    }

    if {$sel != {} && ![regexp -- "^ +$" $sel]} {
	# truncate the expr to a reasonable length for displaying
	# a label (e.g. 25c)
	if {[string length $sel] > 25} {
	    set selabel [string range $sel 0 24]...
	} {
	    set selabel $sel
	}
	$menu add command -label "Display `$selabel'" \
	    -command "DataDisplay:displayExprLocal $debugfrm [list $sel]"
	$menu add command -label "Display `*$selabel'" \
	    -command "DataDisplay:dereferenceExprLocal $debugfrm [list $sel]"
	$menu add command -label "Type of `$selabel'" \
	    -command "DataDisplay:showTypeWorker $debugfrm [winfo toplevel $debugfrm] [list $sel]"
	$menu add separator
	$menu add command -label "Seek `$selabel'" \
	    -command "Debugger:lookupSymbol $debugfrm [list $sel]"
	$menu add command -label "Find `$selabel'" \
	    -command "Debugger:doFindString $debugfrm [list $sel]"
	$menu add separator
    }

    if {${Debugger:childState} == "held"} {
	# no break in zombie state
	Debugger:selectBreakAtLine $debugfrm $menu $file $lineno
	$menu add separator
    }

    $menu add command -label "Search string" \
	-command "Debugger:findString $debugfrm"

    return true
}

proc Debugger:findString {debugfrm} {

    global Debugger:searchinfo Debugger:f2w

    set textw [set Debugger:f2w($debugfrm,source)]

    if {[catch {set sel [$textw get sel.first sel.last]}] == 0} {
	set pretyped $sel
    } {
	set pretyped {}
    }

    set w $debugfrm.find

    if {[winfo exists $w]} {
	wm deiconify $w
	raise $w
	set e [$w.f.re subwidget entry]
	if {$pretyped != {}} {
	    $e delete 0 end
	    $e insert end $pretyped
	}
	focus $e
	return
    }

    toplevel $w
    wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
    wm title $w "Search String"
    wm resizable $w 0 0
    cascadeWindow $w

    set f [frame $w.f -bd 1 -relief sunken]
    pack $f -side top -fill both -expand yes

    tixLabelEntry $f.re -label "Find:" \
	-options {
	    label.anchor w
	    entry.width 22
	}

    set e [$f.re subwidget entry]
    pack $f.re -pady 5 -anchor w -padx 5
    bind $e <Return> "Debugger:doFindString $debugfrm"
    bind $e <Escape> "wm withdraw $w"
    $e insert end $pretyped

    set f2 [frame $f.opt -relief flat -bd 0]
    pack $f2 -fill both -expand yes

    set Debugger:searchinfo($debugfrm,searchwhence) -forward
    set Debugger:searchinfo($debugfrm,searchindex) @0,0

    radiobutton $f2.bck -text backward \
	-variable Debugger:searchinfo($debugfrm,searchwhence) \
	-relief flat -bd 2 -pady 0 -anchor w \
	-value -backward

    radiobutton $f2.fwd -text forward \
	-variable Debugger:searchinfo($debugfrm,searchwhence) \
	-relief flat -bd 2 -pady 0 -anchor w \
	-value -forward

    pack $f2.fwd $f2.bck -side right -padx 5

    set status [frame $w.status -height 20 -relief sunken -bd 1]
    pack $w.status -fill x -expand no
    label $w.status.msg
    pack $w.status.msg -side left

    tixButtonBox $w.bbox -orientation horizontal -relief flat -bd 0
    $w.bbox add search -text Search -command "Debugger:doFindString $debugfrm"
    $w.bbox add clear -text Clear -command "$e delete 0 end"
    $w.bbox add dismiss -text Close -command "wm withdraw $w"
    pack $w.bbox -expand no -fill x

    focus $e
}

proc Debugger:doFindString {debugfrm {s {}}} {

    global Debugger:searchinfo Debugger:f2w

    set textw [set Debugger:f2w($debugfrm,source)]

    if {$s == {}} {
	# using find window to specify the search string...
	set w $debugfrm.find
	set e [$w.f.re subwidget entry]
	set s [$e get]
	if {$s == {}} {
	    return
	}
	set whence [set Debugger:searchinfo($debugfrm,searchwhence)]
	set sow [set Debugger:searchinfo($debugfrm,searchindex)]
    } {
	set w {}
	set whence -forward
	if {[catch { set sow [set Debugger:searchinfo($debugfrm,searchindex)] }] == 1} {
	    set sow @0,0
	}
    }

    if {[catch { set sow \
 		     [$textw search $whence -exact -count n -- $s $sow] }] == 0} {
	if {$sow != {}} {
	    set eow [lindex [split $sow .] 0].[expr [lindex [split $sow .] 1] + $n]
	    $textw tag remove sel 1.0 end
	    $textw tag add sel $sow $eow
	    $textw see $sow
	    if {$whence == "-forward"} {