You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
228 lines
4.6 KiB
Plaintext
228 lines
4.6 KiB
Plaintext
# Block and frame class implementations for GDBtk.
|
|
# Copyright (C) 1997, 1998, 1999 Cygnus Solutions
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify it
|
|
# under the terms of the GNU General Public License (GPL) as published by
|
|
# the Free Software Foundation; either version 2 of the License, or (at
|
|
# your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
|
|
# ------------------------------------------------------------------
|
|
# Block
|
|
# ------------------------------------------------------------------
|
|
itcl::body Block::constructor {start end args} {
|
|
|
|
# Record runtime info about this block
|
|
set _start $start
|
|
set _end $end
|
|
set _variables [_findVariables]
|
|
eval configure $args
|
|
}
|
|
|
|
# Destroy ourself.
|
|
itcl::body Block::destructor {} {
|
|
|
|
# Each block is responsible for destroying its
|
|
# variables and removing them from the list of
|
|
# of all variables for this frame
|
|
foreach var $_variables {
|
|
$var delete
|
|
}
|
|
}
|
|
|
|
# Return a list of variables defined in this block
|
|
# This list is determined when we are created.
|
|
itcl::body Block::variables {} {
|
|
return $_variables
|
|
}
|
|
|
|
# Find the new variables for this block.
|
|
itcl::body Block::_findVariables {} {
|
|
|
|
# Find the new variables for this block.
|
|
set variables [gdb_block_variables $_start $_end]
|
|
|
|
# Create variables.
|
|
set vars {}
|
|
foreach variable $variables {
|
|
# Be paranoid: catch errors constructing variable.
|
|
set err [catch {gdb_variable create -expr $variable} obj]
|
|
if {!$err} {
|
|
lappend vars $obj
|
|
}
|
|
}
|
|
|
|
return $vars
|
|
}
|
|
|
|
itcl::body Block::update {} {
|
|
|
|
set changed {}
|
|
foreach var $_variables {
|
|
set changed [concat $changed [$var update]]
|
|
}
|
|
|
|
return $changed
|
|
}
|
|
|
|
itcl::body Block::info {} {
|
|
|
|
return [list $_start $_end]
|
|
}
|
|
|
|
# ------------------------------------------------------------------
|
|
# Frame
|
|
# ------------------------------------------------------------------
|
|
itcl::body Frame::constructor {addr} {
|
|
|
|
set _addr $addr
|
|
|
|
# Create all blocks in the selected frame
|
|
set _blocks {}
|
|
_createBlocks [gdb_get_blocks]
|
|
|
|
}
|
|
|
|
itcl::body Frame::destructor {} {
|
|
# destroy our own blocks
|
|
foreach block $_blocks {
|
|
_removeBlock $block
|
|
}
|
|
}
|
|
|
|
itcl::body Frame::_removeBlock {blockObj} {
|
|
|
|
set i [lsearch $_blocks $blockObj]
|
|
if {$i != -1} {
|
|
set _blocks [lreplace $_blocks $i $i]
|
|
delete object $blockObj
|
|
}
|
|
}
|
|
|
|
itcl::body Frame::_addBlock {block} {
|
|
|
|
set start [lindex $block 0]
|
|
set end [lindex $block 1]
|
|
set b [Block \#auto $start $end]
|
|
lappend _blocks $b
|
|
|
|
return $b
|
|
}
|
|
|
|
itcl::body Frame::_createBlocks {blocks} {
|
|
|
|
foreach block $blocks {
|
|
set b [_addBlock $block]
|
|
}
|
|
}
|
|
|
|
itcl::body Frame::update {} {
|
|
|
|
set vars {}
|
|
foreach block $_blocks {
|
|
set vars [concat $vars [$block update]]
|
|
}
|
|
|
|
return $vars
|
|
}
|
|
|
|
itcl::body Frame::variables {} {
|
|
|
|
set vars {}
|
|
foreach block $_blocks {
|
|
set vars [concat $vars [$block variables]]
|
|
}
|
|
|
|
return $vars
|
|
}
|
|
|
|
itcl::body Frame::new {} {
|
|
# find any new variables. So get a list of all blocks,
|
|
# eliminate duplicates, and get those variables.
|
|
|
|
set blocks [gdb_get_blocks]
|
|
set new {}
|
|
|
|
foreach block $blocks {
|
|
set b [_findBlock $block]
|
|
if {$b == ""} {
|
|
# Found a new block. Create it get its variables
|
|
set b [_addBlock $block]
|
|
set new [concat $new [$b variables]]
|
|
}
|
|
}
|
|
|
|
return $new
|
|
}
|
|
|
|
itcl::body Frame::deleteOld {} {
|
|
|
|
foreach block [_oldBlocks] {
|
|
_removeBlock $block
|
|
}
|
|
}
|
|
|
|
itcl::body Frame::_oldBlocks {} {
|
|
|
|
set blocks [gdb_get_blocks]
|
|
set oldObjs $_blocks
|
|
|
|
foreach block $blocks {
|
|
set obj [_findBlock $block]
|
|
if {$obj != ""} {
|
|
# Found it.. Remove it from old
|
|
set i [lsearch $oldObjs $obj]
|
|
set oldObjs [lreplace $oldObjs $i $i]
|
|
}
|
|
}
|
|
|
|
return $oldObjs
|
|
}
|
|
|
|
itcl::body Frame::old {} {
|
|
|
|
# All the variables in the blocks in old are now gone...
|
|
# We don't remove blocks here, since the frontend viewer
|
|
# might want to keep these variables around for a little while
|
|
# longer.
|
|
set vars {}
|
|
set old [_oldBlocks]
|
|
foreach block $old {
|
|
set vars [concat $vars [$block variables]]
|
|
}
|
|
|
|
return $vars
|
|
}
|
|
|
|
itcl::body Frame::_findBlock {block} {
|
|
|
|
foreach b $_blocks {
|
|
set info [$b info]
|
|
if {$info == $block} {
|
|
return $b
|
|
}
|
|
}
|
|
|
|
return ""
|
|
}
|
|
|
|
itcl::body Frame::_findBlockIndex {block} {
|
|
|
|
set i 0
|
|
foreach b $_blocks {
|
|
set info [$b info]
|
|
if {$info == $block} {
|
|
return $i
|
|
}
|
|
incr i
|
|
}
|
|
|
|
return -1
|
|
}
|
|
|
|
|