OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [gdbtcl/] [session.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Local preferences functions for GDBtk.
2
# Copyright 2000 Red Hat, Inc.
3
#
4
# This program is free software; you can redistribute it and/or modify it
5
# under the terms of the GNU General Public License (GPL) as published by
6
# the Free Software Foundation; either version 2 of the License, or (at
7
# your option) any later version.
8
#
9
# This program is distributed in the hope that it will be useful,
10
# but WITHOUT ANY WARRANTY; without even the implied warranty of
11
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
# GNU General Public License for more details.
13
 
14
# An internal function used when saving sessions.  Returns a string
15
# that can be used to recreate all pertinent breakpoint state.
16
proc SESSION_serialize_bps {} {
17
  set result {}
18
 
19
  foreach bp_num [gdb_get_breakpoint_list] {
20
    lassign [gdb_get_breakpoint_info $bp_num] file function line_number \
21
      address type enabled disposition ignore_count command_list \
22
      condition thread hit_count user_specification
23
 
24
    switch -glob -- $type {
25
      "breakpoint" -
26
      "hw breakpoint" {
27
        if {$disposition == "delete"} {
28
          set cmd tbreak
29
        } else {
30
          set cmd break
31
        }
32
 
33
        append cmd " "
34
        if {$user_specification != ""} {
35
          append cmd "$user_specification"
36
        } elseif {$file != ""} {
37
          # BpWin::bp_store uses file tail here, but I think that is
38
          # wrong.
39
          append cmd "$file:$line_number"
40
        } else {
41
          append cmd "*$address"
42
        }
43
      }
44
      "watchpoint" -
45
      "hw watchpoint" {
46
        set cmd watch
47
        if {$user_specification != ""} {
48
          append cmd " $user_specification"
49
        } else {
50
          # There's nothing sensible to do.
51
          continue
52
        }
53
      }
54
 
55
      "catch*" {
56
        # FIXME: Don't know what to do.
57
        continue
58
      }
59
 
60
      default {
61
        # Can't serialize anything other than those listed above.
62
        continue
63
      }
64
    }
65
 
66
    lappend result [list $cmd $enabled $condition $command_list]
67
  }
68
 
69
  return $result
70
}
71
 
72
# An internal function used when loading sessions.  It takes a
73
# breakpoint string and recreates all the breakpoints.
74
proc SESSION_recreate_bps {specs} {
75
  foreach spec $specs {
76
    lassign $spec create enabled condition commands
77
 
78
    # Create the breakpoint
79
    gdb_cmd $create
80
 
81
    # Below we use `\$bpnum'.  This means we don't have to figure out
82
    # the number of the breakpoint when doing further manipulations.
83
 
84
    if {! $enabled} {
85
      gdb_cmd "disable \$bpnum"
86
    }
87
 
88
    if {$condition != ""} {
89
      gdb_cmd "cond \$bpnum $condition"
90
    }
91
 
92
    if {[llength $commands]} {
93
      lappend commands end
94
      gdb_cmd "commands \$bpnum\n[join $commands \n]"
95
    }
96
  }
97
}
98
 
99
#
100
# This procedure decides what makes up a gdb `session'.  Roughly a
101
# session is whatever the user found useful when debugging a certain
102
# executable.
103
#
104
# Eventually we should expand this procedure to know how to save
105
# window placement and contents.  That requires more work.
106
#
107
proc session_save {} {
108
  global gdb_exe_name gdb_target_name
109
  global gdb_current_directory gdb_source_path
110
 
111
  # gdb sessions are named after the executable.
112
  set name $gdb_exe_name
113
  set key gdb/session/$name
114
 
115
  # We fill a hash and then use that to set the actual preferences.
116
 
117
  # Always set the exe. name in case we later decide to change the
118
  # interpretation of the session key.
119
  set values(executable) $gdb_exe_name
120
 
121
  # Some simple state the user wants.
122
  set values(args) [gdb_get_inferior_args]
123
  set values(dirs) $gdb_source_path
124
  set values(pwd) $gdb_current_directory
125
  set values(target) $gdb_target_name
126
 
127
  # Breakpoints.
128
  set values(breakpoints) [SESSION_serialize_bps]
129
 
130
  # Recompute list of recent sessions.  Trim to no more than 5 sessions.
131
  set recent [concat [list $name] \
132
                [lremove [pref getd gdb/recent-projects] $name]]
133
  if {[llength $recent] > 5} then {
134
    set recent [lreplace $recent 5 end]
135
  }
136
  pref setd gdb/recent-projects $recent
137
 
138
  foreach k [array names values] {
139
    pref setd $key/$k $values($k)
140
  }
141
  pref setd $key/all-keys [array names values]
142
}
143
 
144
#
145
# Load a session saved with session_save.  NAME is the pretty name of
146
# the session, as returned by session_list.
147
#
148
proc session_load {name} {
149
  global gdb_target_name
150
 
151
  # gdb sessions are named after the executable.
152
  set key gdb/session/$name
153
 
154
  # Fetch all keys for this session into an array.
155
  foreach k [pref getd $key/all-keys] {
156
    set values($k) [pref getd $key/$k]
157
  }
158
 
159
  if {[info exists values(dirs)]} {
160
    # FIXME: short-circuit confirmation.
161
    gdb_cmd "directory"
162
    gdb_cmd "directory $values(dirs)"
163
  }
164
 
165
  if {[info exists values(pwd)]} {
166
    gdb_cmd "cd $values(pwd)"
167
  }
168
 
169
  if {[info exists values(args)]} {
170
    gdb_set_inferior_args $values(args)
171
  }
172
 
173
  if {[info exists values(executable)]} {
174
    gdb_clear_file
175
    set_exe_name $values(executable)
176
    set_exe
177
  }
178
 
179
  if {[info exists values(breakpoints)]} {
180
    SESSION_recreate_bps $values(breakpoints)
181
  }
182
 
183
  if {[info exists values(target)]} {
184
    debug "Restoring Target: $values(target)"
185
    set gdb_target_name $values(target)
186
  }
187
}
188
 
189
#
190
# Delete a session.  NAME is the internal name of the session.
191
#
192
proc session_delete {name} {
193
  # FIXME: we can't yet fully define this because the libgui
194
  # preference code doesn't supply a delete method.
195
  set recent [lremove [pref getd gdb/recent-projects] $name]
196
  pref setd gdb/recent-projects $recent
197
}
198
 
199
#
200
# Return a list of all known sessions.  This returns the `pretty name'
201
# of the session -- something suitable for a menu.
202
#
203
proc session_list {} {
204
  set newlist {}
205
  set result {}
206
  foreach name [pref getd gdb/recent-projects] {
207
    set exe [pref getd gdb/session/$name/executable]
208
    # Take this opportunity to prune the list.
209
    if {[file exists $exe]} then {
210
      lappend newlist $name
211
      lappend result $exe
212
    } else {
213
      # FIXME: if we could delete keys we would delete all keys
214
      # associated with NAME now.
215
    }
216
  }
217
  pref setd gdb/recent-projects $newlist
218
  return $result
219
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.