Commit | Line | Data |
---|---|---|
19fa4a0a MW |
1 | # Copyright (C) 1988, 1990, 1991, 1992 Free Software Foundation, Inc. |
2 | ||
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 2 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with this program; if not, write to the Free Software | |
15 | # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
16 | ||
17 | # Please email any bugs, comments, and/or additions to this file to: | |
415e6208 | 18 | # bug-gdb@prep.ai.mit.edu |
19fa4a0a MW |
19 | |
20 | # This file was written by Rob Savoye. (rob@cygnus.com) | |
21 | ||
22 | # variables that need to set up | |
23 | # | |
24 | if ![info exists prompt] then { | |
25 | set prompt "\(gdb\)" | |
26 | } | |
27 | # some convenience abbreviations | |
28 | # | |
29 | if ![info exists hex] then { | |
30 | set hex "0x\[0-9A-Fa-f\]+" | |
31 | } | |
32 | if ![info exists decimal] then { | |
33 | set decimal "\[0-9\]+" | |
34 | } | |
35 | ||
36 | # | |
37 | # gdb_version -- extract and print the version number of gcc | |
38 | # | |
39 | proc gdb_version {} { | |
40 | global GDB | |
41 | global GDBFLAGS | |
32a02b2a | 42 | if {[which $GDB] != 0} then { |
19fa4a0a | 43 | set tmp [exec echo "q" | $GDB] |
faea916b RS |
44 | set version "[lindex $tmp [lsearch $tmp "\[0-9\]*"]]" |
45 | set version "[string range $version 0 [expr [string length $version]-2]]" | |
19fa4a0a | 46 | clone_output "[which $GDB] version $version $GDBFLAGS\n" |
32a02b2a RS |
47 | } else { |
48 | warning "$GDB does not exist" | |
49 | } | |
19fa4a0a MW |
50 | } |
51 | ||
52 | # | |
53 | # gdb_unload -- unload a file if one is loaded | |
54 | # | |
55 | ||
56 | proc gdb_unload {} { | |
57 | global verbose | |
58 | global GDB | |
59 | global prompt | |
60 | send "file\n" | |
61 | expect { | |
62 | -re "No exec file now\.\r" { continue -expect } | |
63 | -re "No symbol file now\.\r" { continue -expect } | |
64 | -re "A program is being debugged already..*Kill it\? \(y or n\) $"\ | |
65 | { send "y\n" | |
66 | if $verbose>1 then { | |
67 | send_user "\t\tKilling previous program being debugged\n" | |
68 | } | |
69 | continue -expect | |
70 | } | |
71 | -re "Discard symbol table from .*\? \(y or n\) $" { | |
72 | send "y\n" | |
73 | continue -expect | |
74 | } | |
75 | -re "$prompt $" {} | |
76 | timeout { | |
77 | error "Couldn't unload file in $GDB (timed out)." | |
05a291bb | 78 | return -1 |
19fa4a0a MW |
79 | } |
80 | } | |
81 | } | |
82 | ||
83 | # | |
84 | # gdb_load -- load a file into the debugger. | |
05a291bb | 85 | # return a -1 if anything goes wrong. |
19fa4a0a MW |
86 | # |
87 | proc gdb_load { arg } { | |
88 | global verbose | |
89 | global loadpath | |
90 | global loadfile | |
91 | global GDB | |
92 | global prompt | |
93 | ||
94 | set loadfile [file tail $arg] | |
95 | set loadpath [file dirname $arg] | |
19fa4a0a MW |
96 | send "file $arg\n" |
97 | expect { | |
a309ee82 RS |
98 | -re "Reading symbols from.*done.*$prompt $" { |
99 | if $verbose>1 then { | |
19fa4a0a MW |
100 | send_user "\t\tLoaded $arg into the $GDB\n" |
101 | } | |
987b4233 PS |
102 | return 0 |
103 | } | |
19fa4a0a | 104 | -re "has no symbol-table.*$prompt $" { |
a309ee82 | 105 | error "$arg wasn't compiled with \"-g\"" |
19fa4a0a MW |
106 | return -1 |
107 | } | |
a309ee82 RS |
108 | -re "A program is being debugged already..*Kill it\? \(y or n\) $" { |
109 | send "y\n" | |
19fa4a0a MW |
110 | if $verbose>1 then { |
111 | send_user "\t\tKilling previous program being debugged\n" | |
112 | } | |
113 | continue -expect | |
114 | } | |
a309ee82 RS |
115 | -re "Load new symbol table from.*\? \(y or n\) $" { |
116 | send "y\n" | |
19fa4a0a | 117 | expect { |
a309ee82 RS |
118 | -re "Reading symbols from.*done.*$prompt $" { |
119 | if $verbose>1 then { | |
19fa4a0a MW |
120 | send_user "\t\tLoaded $arg with new symbol table into $GDB\n" |
121 | } | |
a309ee82 | 122 | return 0 |
19fa4a0a | 123 | } |
a309ee82 RS |
124 | timeout { |
125 | error "(timeout) Couldn't load $arg, other program already loaded." | |
126 | return -1 | |
127 | } | |
128 | } | |
129 | } | |
130 | -re ".*No such file or directory.*$prompt $" { | |
131 | error "($arg) No such file or directory\n" | |
132 | return -1 | |
133 | } | |
134 | -re "$prompt $" { | |
135 | error "couldn't load $arg into $GDB." | |
136 | return -1 | |
19fa4a0a | 137 | } |
a309ee82 RS |
138 | timeout { |
139 | error "couldn't load $arg into $GDB (timed out)." | |
140 | return -1 | |
19fa4a0a | 141 | } |
ae039ff3 | 142 | eof { |
283bd6db JK |
143 | # This is an attempt to detect a core dump, but seems not to |
144 | # work. Perhaps we need to match .* followed by eof, in which | |
145 | # expect does not seem to have a way to do that. | |
146 | error "couldn't load $arg into $GDB (end of file)." | |
ae039ff3 JK |
147 | return -1 |
148 | } | |
19fa4a0a MW |
149 | } |
150 | } | |
151 | ||
19fa4a0a MW |
152 | # |
153 | # start gdb -- start gdb running | |
154 | # | |
155 | ||
156 | proc gdb_start {} { | |
157 | global verbose | |
158 | global GDB | |
159 | global GDBFLAGS | |
160 | global prompt | |
161 | global spawn_id | |
162 | global timeout | |
163 | if $verbose>1 then { | |
164 | send_user "Spawning $GDB $GDBFLAGS\n" | |
165 | } | |
166 | ||
167 | set oldtimeout $timeout | |
168 | set timeout [expr "$timeout + 60"] | |
169 | if [ llength $GDBFLAGS ] then { | |
32a02b2a | 170 | if {[which $GDB] != 0} then { |
19fa4a0a MW |
171 | spawn $GDB $GDBFLAGS |
172 | } else { | |
32a02b2a RS |
173 | error "$GDB does not exist." |
174 | exit 1 | |
175 | } | |
176 | } else { | |
177 | IF {[WHICH $GDB] != 0} then { | |
19fa4a0a | 178 | spawn $GDB |
a309ee82 | 179 | } else { |
32a02b2a RS |
180 | error "$GDB does not exist." |
181 | exit 1 | |
a309ee82 | 182 | } |
19fa4a0a MW |
183 | } |
184 | expect { | |
a309ee82 RS |
185 | -re ".*$prompt $" { |
186 | if $verbose>1 then { | |
187 | send_user "GDB initialized for native mode\n" | |
188 | } | |
189 | } | |
190 | -re "$prompt $" { | |
191 | error "GDB never initialized." | |
192 | return -1 | |
193 | } | |
194 | timeout { | |
195 | error "(timeout) GDB never initialized." | |
196 | return -1 | |
19fa4a0a | 197 | } |
19fa4a0a MW |
198 | } |
199 | set timeout $oldtimeout | |
200 | # force the height to "unlimited", so no pagers get used | |
201 | send "set height 0\n" | |
a309ee82 RS |
202 | expect { |
203 | -re ".*$prompt $" { | |
204 | if $verbose>2 then { | |
205 | send_user "Seting height to 0.\n" | |
206 | } | |
207 | } | |
208 | timeout { | |
209 | warning "Couldn't set the height to 0." | |
210 | } | |
211 | } | |
19fa4a0a MW |
212 | # force the width to "unlimited", so no wraparound occurs |
213 | send "set width 0\n" | |
a309ee82 RS |
214 | expect { |
215 | -re ".*$prompt $" { | |
216 | if $verbose>2 then { | |
217 | send_user "Seting width to 0.\n" | |
19fa4a0a | 218 | } |
a309ee82 RS |
219 | } |
220 | timeout { | |
221 | warning "Couldn't set the width to 0." | |
222 | } | |
223 | } | |
19fa4a0a MW |
224 | } |
225 | ||
a309ee82 RS |
226 | # These only need to be uncommented for debugging test cases. They exist |
227 | # mainly to catch programming errors | |
228 | #expect_after { | |
229 | # "<return>" { send "\n"; error "Window too small." } | |
230 | # -re "\(y or n\) " { send "n\n"; error "Got interactive prompt." } | |
231 | # buffer_full { error "internal buffer is full." } | |
653ae28f | 232 | # eof { error "eof -- there is no child process" ; cleanup ; exit $exit_status} |
a309ee82 RS |
233 | # timeout { error "timeout." } |
234 | # "virtual memory exhausted" { error "virtual memory exhausted." } | |
235 | # "Undefined command" { error "send string probably wrong." } | |
236 | #} | |
237 | ||
19fa4a0a MW |
238 | load_lib gdb.exp |
239 | ||
240 | set binpath /s1/users/rob/vxworks/bin/somewhere-bogus-that-needs-configuring | |
241 | set bin $GDB | |
242 | ||
243 | gdb_start | |
244 | ||
a309ee82 RS |
245 | |
246 | ||
247 | ||
248 | ||
249 | ||
250 |