gdb.tcl

tarnado 程序demo

# gdb.tcl - example GDB customization file

##############################################################################
# Fix some obsolete code...
##############################################################################
#
# gdbTaskNameToId - convert a task name to a task ID
#
# This routine takes a task name and converts it to a task ID
#
# RETURNS:
#    The task ID or 0 on error

proc gdbTaskNameToId { name } {
    # FIXME: Should vector through a pointer based on kernel type
	return [taskNameToId $name]
}


##############################################################################
#
# multiContinue - continue tasks with names matching regular expressions
#
# This routine will continue all tasks (except a task which gdb is attached
# to) whose names match one of the regular expressions passed as arguments.
#
# RETURNS:
#   0 (OK) or -1 (ERROR)
#

proc multiContinue {args} {
    global gdbTaskAttached
    global gdbCurrentTask

    if {[catch {activeTaskNameMap} taskMap]} {
	gdb echo "multiContinue: failed getting task list.\n"
	return -1
    }

    foreach pattern $args {
	set map $taskMap
	set i 0

	while {[llength $map] > 0} {
	    set taskId [lindex $map 0]
	    set taskName [lindex $map 1]
	    set map [lrange $map 2 end]

	    if {[regexp $pattern $taskName]} {
		# Don't try to continue the task GDB is attached to.
		if {! $gdbTaskAttached || $gdbCurrentTask != $taskId} {
		    if {[catch {wtxContextCont CONTEXT_TASK $taskId} dummy]} {
			gdb echo "multiContinue: failed continuing task " \
				 "$taskId ($taskName).\n"
		    } else {
			gdb echo "Continuing task $taskId ($taskName).\n"
		    }
		    # delete task from list, so as to only resume it once
		    set taskMap [lreplace $taskMap $i [expr $i + 1]]
		    continue 
		}
	    }
	    incr i 2
	}
    }
    return 0
}


##############################################################################
#
# Define gdb command "mc" corresponding to tcl command multiContinue
#

gdb tclproc mc multiContinue