debugger.tcl

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

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

proc Debugger:pickSourceSel {debugfrm listbox} {

    set lbox [$listbox subwidget listbox]
    set sel [$lbox curselection]

    if {$sel != {}} {
	set filepath [string range [$lbox get $sel] 3 end]
	Debugger:displaySource $debugfrm $filepath
    }
}

proc Debugger:cacheSourcePath {filepath} {

    global Debugger:fcache

    # insert the path of the just open source file into the cache
    # list, ensuring that no more than 8 entries are concurrently
    # kept...

    set cacheix [lsearch -exact ${Debugger:fcache} $filepath]

    if {$cacheix != -1} {
	set Debugger:fcache \
	    [lreplace ${Debugger:fcache} $cacheix $cacheix]
    }
    if {[llength ${Debugger:fcache}] >= 8} {
	set Debugger:fcache \
	    [lreplace ${Debugger:fcache} end end]
    }
    # LIFO ordering
    set Debugger:fcache \
	[linsert ${Debugger:fcache} 0 $filepath]
}

proc Debugger:sourceSynch {debugfrm} {

    global Debugger:pcfile

    set hotfile [set Debugger:pcfile($debugfrm)]

    if {$hotfile != {}} {
	Debugger:displaySource $debugfrm $hotfile
    }
}

proc Debugger:sourceReload {debugfrm} {

    global Debugger:f2s

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

    if {$filepath != {}} {
	Debugger:displaySource $debugfrm $filepath true
	$debugfrm.messages.warning configure \
	-text "[file tail $filepath] reloaded..."
    }
}

proc Debugger:displaySource {debugfrm filepath {freload false}} {

    global Debugger:f2c
    global Debugger:f2s
    global Debugger:f2w
    global Debugger:bplist
    global Project:settings
    global Debugger:fpos

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

    if {$freload == "false" && $oldpath == $filepath} {
	# hotspot may have changed however -- try updating it
	Debugger:displayHotSpot $debugfrm
	return
    }

    # fetch back context and text widget of the designated
    # debug frame
    set context [set Debugger:f2c($debugfrm)]
    set textw [set Debugger:f2w($debugfrm,source)]

    if {$oldpath != {}} {
	set Debugger:fpos($oldpath) [$textw index @0,0]
    }
    set Debugger:f2s($debugfrm) $filepath

    $textw tag delete hotspot
    $textw configure -state normal
    $textw delete 1.0 end
    
    # Open the file, and read it into the text widget
    if {[catch {open $filepath} fh]} {
	# File can't be read.
	$textw configure -state disabled
	return
    }
    
    set lineno 1
    foreach line [split [read $fh] \n] {
	if {[set Project:settings(Options,lineNumbering)] == 1} {
	    $textw insert $lineno.0 [format "  \t%4d  %s\n" $lineno "$line"]
	} else {
	    $textw insert $lineno.0 "  \t$line\n"
	}
	incr lineno
    }

    catch {
	set oldpos [set Debugger:fpos($filepath)]
	# restore last view if the file used to be displayed
	$textw yview $oldpos
    }

    close $fh
    $textw configure -state disabled

    # insert breakpoint spots in the current source
    Debugger:plotBreakpoints $context $debugfrm

    # try to highlight the hotspot in this file
    Debugger:displayHotSpot $debugfrm

    # update the file position when the view is stable
    # if this is the first time this file is loaded
    if {[array get Debugger:fpos $filepath] == {}} {
	set Debugger:fpos($filepath) [$textw index @0,0]
    }

    # cache source file path
    Debugger:cacheSourcePath $filepath
}

proc Debugger:redisplaySources {context} {

    global Project:settings
    global Debugger:c2f
    global Debugger:f2s

    foreach debugfrm [set Debugger:c2f($context)] {
	Debugger:displaySource $debugfrm [set Debugger:f2s($debugfrm)] true
    }
}

proc Debugger:displayHotSpot {debugfrm} {

    global Debugger:f2s
    global Debugger:f2w
    global Debugger:pcfile
    global Debugger:pcline

    if {[set Debugger:f2s($debugfrm)] == [set Debugger:pcfile($debugfrm)]} {
	set textw [set Debugger:f2w($debugfrm,source)]
	$textw tag delete hotspot
	set pcline [set Debugger:pcline($debugfrm)]
	$textw tag add hotspot $pcline.1 $pcline.end
	global Application:visualType Project:settings
	if {${Application:visualType} == "color" &&
	    [set Project:settings(Options,useGlyphCursor)] == 0} {
	    $textw tag configure hotspot -background yellow
	} {
	    # use a cursor to mark the hotspot with monochrome displays
	    # or if the use of the glyph cursor has been otherwised forced.
	    set mark $textw.hotspot
	    catch { destroy $mark }
	    set image [fetchImage cursor]
	    label $mark -bd 0 -relief flat -padx 0 -pady 0 \
		-image $image -bg [$textw cget -bg]
	    $textw configure -state normal
	    $textw window create $pcline.1 -window $mark
	    $textw configure -state disabled
	}
	catch { $textw see $pcline.0 }
    }
}

proc Debugger:updateSource {debugfrm location {freload false}} {

    global Debugger:pcfile Debugger:pcline
    global Debugger:xcontext gdb:obsoleted

    set function [lindex $location 0]

    if {$function == "?"} {
	# function does not belong to the code location --
	# the latter is however the first viewable inner location
	# which is available for display. This is our best-effort
	# to show a familiar source to the user.
	set function [lindex $location 1]
	set filepath [lindex $location 2]
	set lineno [lindex $location 3]
	set besteffort true
    } {
	set filepath [lindex $location 1]
	set lineno [lindex $location 2]
	set besteffort false
    }

    # xxx:getproto{} should return a 2-element list of
    # the form { xlation-type name-to-display }
    # where the 1st one is a non-null number if a
    # translation occurred, zero otherwise, and the
    # second is the function name to display.

    set funinfo [gdb:getproto $function]
    set thread [Debugger:getContextInfo $debugfrm]
    set locmsg [format "$thread stopped in %s" [lindex $funinfo 1]]
    if {[lindex $funinfo 0] == 0} {
	# "call" operator need to be appended to regular
	# function names
	append locmsg "()"
    }

    # may have break in a spot with no debug information
    # available - check for it...

    if {$filepath != {}} {
	set filepath [getAbsolutePath $filepath]
	set Debugger:pcfile($debugfrm) $filepath
	set Debugger:pcline($debugfrm) $lineno
	Debugger:displaySource $debugfrm $filepath $freload

	if {$besteffort == "false"} {
	    append locmsg [format ", %s:%d" \
			       [file tail $filepath] $lineno]
	}
    }

    foreach {_ctx _iid imask ticks modeflags} \
	[set Debugger:xcontext($debugfrm)] {
	    if {$modeflags != {}} {
		if {$imask > 0} {
		    append locmsg " ($modeflags, imask=${imask})"
		} {
		    append locmsg " ($modeflags)"
		}
	    } {
		if {$imask > 0} {
		    append locmsg " (imask=${imask})"
		}
	    }
	    global $debugfrm:tickval
	    set $debugfrm:tickval "Ticks: $ticks"
	}

    $debugfrm.messages.location configure -text $locmsg

    if {${gdb:obsoleted} == "true"} {
	$debugfrm.messages.warning configure \
	    -text "Source file is more recent than executable"
	set gdb:obsoleted false
    }
}

proc Debugger:buildFocusCmd {debugfrm} {

    global Debugger:focus

    set scope [lindex [set Debugger:focus($debugfrm)] 0]
    set tid 0

    switch $scope {
	system {
	    set cmd SYSTEM_SCOPE
	}

	default {
	    # i.e. some thread context...
	    set cmd THREAD_SCOPE
	    set tid [set Debugger:focus($debugfrm)]
	}
    }

    return [list $cmd $tid]
}

proc Debugger:getContextInfo {debugfrm} {

    global Debugger:xcontext

    set scope [lindex [set Debugger:xcontext($debugfrm)] 0]

    switch $scope {
	callout {
	    set thread Callout
	}
	ihandler {
	    set thread "Interrupt handler"
	}
	thread {
	    set tid [lindex [set Debugger:xcontext($debugfrm)] 1]
	    set tsktype [Debugger:getThreadTypeName]
	    set thread "$tsktype [Debugger:getThreadName $tid]"
	}
	preamble {
	    set thread Preamble
	}
	init -
	idle -
	default {
	    set thread System
	}
    }

    return $thread
}

proc Debugger:buildStepCmd {debugfrm} {

    global Debugger:focus $debugfrm:switches

    set scope [lindex [set Debugger:focus($debugfrm)] 0]
    set tid 0

    switch $scope {
	system {
	    set scope system
	}

	default {
	    # i.e. some thread context...
	    set scope thread
	    set tid [set Debugger:focus($debugfrm)]
	}
    }

    if {[lsearch -exact [set $debugfrm:switches] asynch] != -1} {
	return [list asynch $scope $tid]
    }

    return [list $scope $tid]
}

proc Debugger:updateFocus {debugfrm location {freload false}} {

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

    set focuscmd [Debugger:buildFocusCmd $debugfrm]
    set context [set Debugger:f2c($debugfrm)]
    set Debugger:stacklevel($debugfrm) 0
    set Debugger:xcontext($debugfrm) {init 0 0 0}
    set locals {}
    set xcontext {}

    if {[lsearch -exact [set $debugfrm:switches] locals] != -1} {
	# locals displayed -- because it is a costly operation
	# to trace local variables, they are only polled if their
	# display frame is packed within the data subwindow.
	set Debugger:stackinfo($debugfrm) \
	    [gdb:backtrace $context \
		 $focuscmd location xcontext locals]
	set depth [llength [set Debugger:stackinfo($debugfrm)]]
	set Debugger:xcontext($debugfrm) $xcontext
	set Debugger:localinfo($xcontext,0) $locals
	# length of call chain must be up-to-date before
	# DataDisplay:updateLocalData is invoked
	set Debugger:stacklength($debugfrm) $depth

	DataDisplay:updateLocalData $debugfrm \
	    [set Debugger:f2w($debugfrm,locals)]
    } {
	set Debugger:stackinfo($debugfrm) \
	    [gdb:backtrace $context \
		 $focuscmd location xcontext]

	set depth [llength [set Debugger:stackinfo($debugfrm)]]
	set Debugger:xcontext($debugfrm) $xcontext
	set Debugger:localinfo($xcontext,0) {}
	set Debugger:stacklength($debugfrm) $depth
    }

    if {[set Debugger:stackinfo($debugfrm)] != {}} {
	set stackw [set Debugger:f2w($debugfrm,stack)]
	set lbox [$stackw subwidget listbox]
	$lbox delete 0 end
	set level 0

	foreach frame [set Debugger:stackinfo($debugfrm)] {
	    $lbox insert end [concat \#$level " " [lindex $frame 1]]
	    incr level
	}

	if {[lsearch -exact [set $debugfrm:switches] stack] != -1} {
	    $lbox selection set 0
	}
    }

    if {[lsearch -exact [set $debugfrm:switches] asynch] == -1 &&
	[lindex $xcontext 0] != "thread"} {
	# enable asynchronous contexts view if we stopped
	# in such kind of context.
	lappend $debugfrm:switches asynch
    }

    Debugger:updateSource $debugfrm $location $freload
}

proc Debugger:displayStackFrame {debugfrm} {

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

    set focuscmd [Debugger:buildFocusCmd $debugfrm]
    set level [set Debugger:stacklevel($debugfrm)]
    set fnum [lindex [lindex [set Debugger:stackinfo($debugfrm)] $level] 0]
    set context [set Debugger:f2c($debugfrm)]

    set hotspot [Debugger:resume $context $focuscmd $fnum]

    if {$hotspot != {}} {
	Debugger:updateSource $debugfrm $hotspot
	if {[lsearch -exact [set $debugfrm:switches] stack] != -1} {
	    # highlight the selected frame in the stack
	    # listbox if open
	    set stackw [set Debugger:f2w($debugfrm,stack)]
	    set lbox [$stackw subwidget listbox]
	    $lbox selection clear 0 end
	    $lbox selection set $level
	}
	if {[lsearch -exact [set $debugfrm:switches] locals] != -1} {
	    global Debugger:xcontext
	    set xcontext [set Debugger:xcontext($debugfrm)]
	    set Debugger:localinfo($xcontext,$level) [gdb:getlocals]
	    # note: "false" last arg means that we do not need
	    # auto-focus to be done by the update procedure
	    # as we already point to the right context after
	    # a successful Debugger:resume
	    DataDisplay:updateLocalData $debugfrm \
		[set Debugger:f2w($debugfrm,locals)] false
	}
	Debugger:suspend $context $focuscmd
    }
}

proc Debugger:browseStack {debugfrm} {

    global Debugger:f2w Debugger:stacklevel

    set stackw [set Debugger:f2w($debugfrm,stack)]
    set lbox [$stackw subwidget listbox]
    set level [$lbox curselection]

    if {$level != {} && $level != [set Debugger:stacklevel($debugfrm)]} {
	$debugfrm.messages.warning configure -text {}
	# the stack display list follows the same ordering
	# rules than stack levels do: from 0 (the outer one,
	# on top of display) to [llength(stackinfo) - 1]
	# (the inner one, at bottom).
	set Debugger:stacklevel($debugfrm) $level
	Debugger:displayStackFrame $debugfrm
    }