breakpoints.tcl

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

    pack $lbf.list -expand yes -fill both
    set hlist [$lbf.list subwidget hlist]
    $hlist column width 0 -char 10
    $hlist column width 1 -char 25
    $hlist column width 2 -char 20
    $hlist column width 3 -char 30
    $hlist header create 0 -itemtype text -text State/ID \
	-style rootTextStyle
    $hlist header create 1 -itemtype text -text Location \
	-style rootTextStyle
    $hlist header create 2 -itemtype text -text Scope \
	-style rootTextStyle
    $hlist header create 3 -itemtype text -text Condition \
	-style rootTextStyle

    $toggles config -command "Debugger:bpToolbarExec $debugfrm $hlist $toggles $inputfield"

    backmenu $lbf.popup -tearoff 0
    set menu [$lbf.popup subwidget menu]
    $menu add command -label "Enable/Disable" -command \
	 "Debugger:toggleBP $debugfrm $hlist $toggles"
    $menu add command -label "Set condition" -command \
	 "Debugger:condBP $debugfrm $hlist $toggles"
    $menu add command -label "Remove" -command \
	 "Debugger:removeBP $debugfrm $hlist $toggles"
    $lbf.popup validate \
	"Debugger:bpBackMenu $debugfrm $hlist $menu $toggles"
    $lbf.popup bind $hlist

    Debugger:buildBPDisplay $debugfrm $hlist $toggles
    bind $e <Return> "Debugger:addBP $debugfrm $hlist $toggles $inputfield"

    tixButtonBox $w.bbox -orientation horizontal -relief flat -bd 0
    $w.bbox add dismiss -text Close -command "destroy $w"
    pack $w.bbox -fill x

    set statusbar [frame $w.status -height 20 -relief sunken -bd 1]
    pack $w.status -fill x
    set Debugger:bpToolTips {}
    label $statusbar.message -textvariable Debugger:bpToolTips
    pack $statusbar.message -side left

    tkwait visibility $w
    grab $w
}

proc Debugger:toggleBP {debugfrm hlist toggles} {

    global Debugger:bplist

    set sel [$hlist info selection]

    if {$sel != {}} {
	# toggle the selected breakpoint
	set bpinfo [lindex ${Debugger:bplist} $sel]
	Debugger:toggleBreakAtLine $debugfrm $bpinfo
    } {
	# toggle all breakpoints
	for {set bpnum [expr [llength [$hlist info children]] - 1]} {$bpnum >= 0} {incr bpnum -1} {
	    set bpinfo [lindex ${Debugger:bplist} $bpnum]
	    Debugger:toggleBreakAtLine $debugfrm $bpinfo
	}
    }

    Debugger:buildBPDisplay $debugfrm $hlist $toggles
}

proc Debugger:condBP {debugfrm hlist toggles} {

    global Debugger:bplist

    set sel [$hlist info selection]

    if {$sel == {}} {
	return
    }

    set bpinfo [lindex ${Debugger:bplist} $sel]
    set condition [lindex $bpinfo 5]

    set w [winfo toplevel $hlist].cond
    toplevel $w
    wm title $w "Conditional Breakpoint"
    cascadeWindow $w [winfo toplevel $hlist]
    set lbf [frame $w.lbf -relief raised -bd 1]
    tixLabelEntry $lbf.entry -label "Stop if: " \
	-options {
	    entry.width 30
	}
    set e [$lbf.entry subwidget entry]
    $e configure -textvariable $e:value
    global $e:value
    set $e:value $condition
    bind $e <Return> "Debugger:condBPOk $debugfrm $hlist $sel"
    bind $e <Escape> "destroy $w"
    pack $lbf.entry -pady 5 -padx 15 -anchor w
    $e selection range 0 end
    $e icursor end
    pack $w.lbf -expand yes -fill both

    tixButtonBox $w.bbox -orientation horizontal -relief flat -bd 0
    $w.bbox add ok -text OK -command \
	"Debugger:condBPOk $debugfrm $hlist $sel"
    $w.bbox add cancel -text Cancel -command "destroy $w"
    pack $w.bbox -side bottom -fill x

    focus $e
    tkwait visibility $w
    grab $w
}

proc Debugger:condBPOk {debugfrm hlist sel} {

    global Debugger:bplist

    set bpinfo [lindex ${Debugger:bplist} $sel]
    set bpnum [lindex $bpinfo 2]
    set w [winfo toplevel $hlist].cond
    set lbf $w.lbf
    set e [$lbf.entry subwidget entry]

    global $e:value
    set condition [set $e:value]
    set cmd "setbpcondition $bpnum [list $condition]"

    # the stop condition should be set in the current program scope: so use
    # the evaluation worker to reinstate it and perform the command.
    if {[DataDisplay:evalWorker $debugfrm $cmd false] != {}} {
	global gdb:lastexpr
	set condition [set gdb:lastexpr]
	set bpinfo [lreplace $bpinfo 5 5 $condition]
	set Debugger:bplist [lreplace ${Debugger:bplist} $sel $sel $bpinfo]
	$hlist item config $sel 3 -text $condition
    } {
	global gdb:lasterror
	tk_messageBox \
	    -message [set gdb:lasterror] \
	    -type ok -icon error -title Error
	# do not raise $w -- this causes some unexpected delay under KDE...
	return
    }

    raise [winfo toplevel $hlist]
    destroy $w
}

proc Debugger:removeBP {debugfrm hlist toggles} {

    global Debugger:bplist

    set sel [$hlist info selection]

    if {$sel != {}} {
	# remove the selected breakpoint
	set bpinfo [lindex ${Debugger:bplist} $sel]
	Debugger:removeBreakAtLine $debugfrm $bpinfo
    } {
	# remove all breakpoints
	set bpcount [llength [$hlist info children]]

	if {$bpcount == 0} {
	    return
	}
	if {[tk_messageBox \
		 -message "About to delete all breakpoints...\nAre you sure? Please confirm." \
		 -type yesno -icon warning -title Warning] != "yes"} {
	    return
	}
	while {$bpcount > 0} {
	    set bpinfo [lindex ${Debugger:bplist} 0]
	    Debugger:removeBreakAtLine $debugfrm $bpinfo
	    incr bpcount -1
	}
    }

    Debugger:buildBPDisplay $debugfrm $hlist $toggles
}

proc Debugger:addBP {debugfrm hlist toggles inputfield} {

    global Debugger:bplist
    global Debugger:f2w Debugger:f2c
    global Debugger:bpToolTips

    set stoploc [$inputfield subwidget entry get]

    if {$stoploc == {}} {
	return
    }
    
    $inputfield subwidget entry delete 0 end
    set context [set Debugger:f2c($debugfrm)]

    # get "hard" control over debuggee
    if {[Debugger:resume $context] == "false"} {
	return
    }

    set bpnum [gdb:sethardbp $stoploc]
    
    if {$bpnum != {}} {
	set bploc [gdb:getbpinfo $bpnum]
	if {[llength $bploc] == 4} {
	    # convert "hard" breakpoints to "soft" (synchronized) breakpoints
	    # if we have access to the source. Note that the file path
	    # returned by GDB must already be absolute.
	    # Calling getAbsolutePath canonicalizes the path.
	    set file [getAbsolutePath [lindex $bploc 2]]
	    set lineno [lindex $bploc 3]
	    gdb:removebp $bpnum
	    set bpnum [gdb:setsoftbp $context \
			   {SYSTEM_SCOPE 0} $file $lineno]
	    set bpinfo [list {SYSTEM_SCOPE 0} enabled $bpnum $file $lineno {}]
	} {
	    # "hard" breakpoints have a supplemental info. field tacked
	    # to the regular bpinfo list. This field should give the system
	    # address of the breakpoint as defined by the debugger.
	    set bpinfo [list HARD_SCOPE enabled $bpnum {} 0 {} $bploc]
	}
    }

    Debugger:suspend $context

    if {$bpnum == {}} {
	global gdb:lasterror
	set Debugger:bpToolTips [set gdb:lasterror]
	bell -displayof $debugfrm
	return
    }

    lappend Debugger:bplist $bpinfo
    Debugger:plotBreakpoints $context
    Debugger:buildBPDisplay $debugfrm $hlist $toggles
}

proc Debugger:buildBPDisplay {debugfrm hlist toggles} {

    global Debugger:bplist

    $hlist delete all
    set nth 0

    foreach bpinfo ${Debugger:bplist} {
	foreach {focuscmd state bpnum file lineno condition systeminfo} $bpinfo {
	    set filename [file tail $file]
	    if {$focuscmd != "HARD_SCOPE"} {
		# not a hard bp
		set focusinfo [Debugger:getBreakpointFocus $focuscmd]
		set location "at $filename:$lineno"
	    } {
		# hard breakpoints have a misc. information member
		# ending the bpinfo list
		set addr [lindex $systeminfo 0]
		set spot [lindex $systeminfo 1]
		set location "in $spot ($addr)"
		if {$filename != {}} {
		    # got source
		    append location " at $filename:$lineno"
		}
		set focusinfo hard
	    }

	    if {$state == "enabled"} {
		set img stopenb
	    } {
		set img stopdis
	    }

	    $hlist add $nth -itemtype imagetext \
		-image [fetchImage $img] -text $bpnum \
		-style leafImageStyle
	    $hlist item create $nth 1 -itemtype text -text $location \
		-style leafTextStyle
	    $hlist item create $nth 2 -itemtype text -text $focusinfo \
		-style leafTextStyle
	    $hlist item create $nth 3 -itemtype text -text $condition \
		-style leafTextStyle
	}
	incr nth
    }
}

proc Debugger:bpToolbarExec {debugfrm hlist toggles inputfield button state} {
    # a little trick to have the tix select widget
    # behave like a toolbar: a selected button is
    # immediately re-invoked to restore its initial
    # graphic state. This is why the button state is
    # checked to filter out "off" invocations.
    if {$state == 1} {
	global Debugger:bpToolTips
	set Debugger:bpToolTips {}
	$toggles invoke $button
	switch -- $button {
	    addbp {
		Debugger:addBP $debugfrm $hlist $toggles $inputfield
	    }
	    rembp {
		Debugger:removeBP $debugfrm $hlist $toggles
	    }
	    togglebp {
		Debugger:toggleBP $debugfrm $hlist $toggles
	    }
	}
    }
}

proc Debugger:bpBackMenu {debugfrm hlist menu toggles rootx rooty} {

    $hlist selection clear
    # turn root coordinates into local coordinates
    set y [expr $rooty - [winfo rooty $hlist]]
    set entry [$hlist nearest $y]

    if {$entry == {}} {
	return false
    }

    $hlist selection set $entry

    return true
}

proc Debugger:saveBreakpoints {context} {

    global Debugger:bplist
    Project:setResource DebuggerBreakpoints ${Debugger:bplist}
}

# Resynchronizing breakpoints means recalculating their
# symbolic location (i.e. file and linenum). For instance, this
# information may become obsolete after the source directory
# information has been changed at GDB level.

proc Debugger:resynchBreakpoints {context} {

    global Debugger:bplist

    set bplist {}

    foreach bpinfo ${Debugger:bplist} {
	set focuscmd [lindex $bpinfo 0]
	if {$focuscmd != "HARD_SCOPE"} {
	    # only resynchronize "soft" breakpoints for which we
	    # have symbolic information...
	    foreach {focuscmd status bpnum file lineno condition} $bpinfo {
		set bploc [gdb:getbpinfo $bpnum]
		if {$bploc != {}} {
		    set file [lindex $bploc 2]
		    set lineno [lindex $bploc 3]
		    lappend bplist [list $focuscmd $status $bpnum $file $lineno $condition]
		} {
		    lappend bplist $bpinfo
		}
	    }
	} {
	    lappend bplist $bpinfo
	}
    }

    set Debugger:bplist $bplist
}

proc Debugger:restoreBreakpoints {context} {

    global Debugger:bplist

    set bplist [Project:getResource DebuggerBreakpoints]
    set Debugger:bplist {}

    foreach bpinfo $bplist {
	foreach {focuscmd status bpnum file lineno condition} $bpinfo {
	    # validate focus command validity before trying to reinstate
	    # the breakpoint.
	    set focusinfo [Debugger:getBreakpointFocus $focuscmd]
	    if {$focusinfo != {} && $focuscmd != "HARD_SCOPE"} {
		# only reinstate "soft" breakpoints for which we
		# have symbolic information...
		set bpnum [gdb:setsoftbp $context \
			       $focuscmd $file $lineno]
		if {$bpnum == {}} {
		    global gdb:lasterror
		    $context.messages.warning configure \
			-text [set gdb:lasterror]
		    bell -displayof $context
		} {
		    if {$condition != {}} {
			if {[gdb:setbpcondition $bpnum $condition] == {}} {
			    global gdb:lasterror
			    $context.messages.warning configure \
				-text [set gdb:lasterror]
			    bell -displayof $context
			    set condition {}
			}
		    }
		    lappend Debugger:bplist [list $focuscmd $status $bpnum \
						 $file $lineno $condition]
		    if {$status == "disabled"} {
			gdb:disablebp $bpnum
		    }
		}
	    }
	}
    }
}