summaryrefslogtreecommitdiff
path: root/gdb/gdbtk/library/blockframe.itb
blob: 09977af732c201462067fa389c568d1cec7531ab (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
# Block and frame class implementations for GDBtk.
# Copyright 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
}