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

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [dejagnu/] [config/] [gdb-comm.exp] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom
# Copyright (C) 1996, 1997, 1998 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:
18
# DejaGnu@cygnus.com
19
 
20
# Note: some of this was cribbed from the gdb testsuite since we need
21
# to use some pretty standard gdb features (breakpoints in particular).
22
 
23
# Load up some standard junk.
24
load_lib remote.exp
25
 
26
if ![info exists board] {
27
    perror "$board must be set before loading gdb-comm"
28
}
29
 
30
# The number of times we've tried to download/execute this executable.
31
set try_again 0
32
 
33
#
34
# Delete all breakpoints and verify that they were deleted.  If anything
35
# goes wrong, return -1.
36
#
37
proc gdb_comm_delete_breakpoints {} {
38
    global gdb_prompt
39
 
40
    remote_send host "delete breakpoints\n";
41
    remote_expect host 10 {
42
        -re "Delete all breakpoints.*y or n. $" {
43
            remote_send host "y\n"
44
            exp_continue
45
        }
46
        -re ".*$gdb_prompt $" { }
47
        timeout { perror "Delete all breakpoints (timeout)" ; return -1}
48
    }
49
    remote_send host "info breakpoints\n"
50
    remote_expect host 10 {
51
        -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
52
        -re ".*$gdb_prompt $" { perror "breakpoints not deleted" ; return -1}
53
        timeout { perror "info breakpoints (timeout)" ; return -1}
54
    }
55
    return 0;
56
}
57
 
58
#
59
# Inform the debugger that we have a new exec file.
60
# return a -1 if anything goes wrong, 0 on success.
61
#
62
proc gdb_comm_file_cmd { arg } {
63
    global verbose
64
    global loadpath
65
    global loadfile
66
    global GDB
67
    global gdb_prompt
68
    upvar timeout timeout
69
 
70
    # The "file" command loads up a new symbol file for gdb, deal with
71
    # the various messages it might spew out.
72
    if [is_remote host] {
73
        set arg [remote_download host $arg a.out];
74
    }
75
    remote_send host "file $arg\n"
76
    remote_expect host 60 {
77
        -re "Reading symbols from.*done.*$gdb_prompt $" {
78
            verbose "\t\tLoaded $arg into the $GDB"
79
            return 0
80
        }
81
        -re "has no symbol-table.*$gdb_prompt $" {
82
            perror "$arg wasn't compiled with \"-g\""
83
            return -1
84
        }
85
        -re "A program is being debugged already.*Kill it.*y or n. $" {
86
            remote_send host "y\n"
87
            verbose "\t\tKilling previous program being debugged"
88
            exp_continue
89
        }
90
        -re "Load new symbol table from \".*\".*y or n.*$" {
91
            remote_send host "y\n"
92
            remote_expect host 60 {
93
                -re "Reading symbols from.*done.*$gdb_prompt $" {
94
                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
95
                    return 0
96
                }
97
                timeout {
98
                    perror "(timeout) Couldn't load $arg, other program already loaded."
99
                    return -1
100
                }
101
            }
102
        }
103
        -re ".*No such file or directory.*$gdb_prompt $" {
104
            perror "($arg) No such file or directory\n"
105
            return -1
106
        }
107
        -re "$gdb_prompt $" {
108
            perror "couldn't load $arg into $GDB."
109
            return -1
110
            }
111
        timeout {
112
            perror "couldn't load $arg into $GDB (timed out)."
113
            return -1
114
        }
115
        eof {
116
            # This is an attempt to detect a core dump, but seems not to
117
            # work.  Perhaps we need to match .* followed by eof, in which
118
            # expect does not seem to have a way to do that.
119
            perror "couldn't load $arg into $GDB (end of file)."
120
            return -1
121
        }
122
    }
123
    return 0;
124
}
125
 
126
# Disconnect from the target and forget that we have an executable. Returns
127
# -1 on failure, 0 on success.
128
 
129
proc gdb_comm_go_idle { } {
130
    global gdb_prompt;
131
 
132
    if ![board_info host exists fileid] {
133
        return -1;
134
    }
135
 
136
    remote_send host "target exec\n";
137
    remote_expect host 10 {
138
        -re "Kill it.*y or n.*$" {
139
            remote_send host "y\n"
140
            exp_continue;
141
        }
142
        -re "No exec.* file now.*$gdb_prompt $" {
143
            return 0;
144
        }
145
        default {
146
            remote_close host;
147
            return -1;
148
        }
149
    }
150
}
151
 
152
# Start GDB running with target DEST.
153
proc gdb_comm_start { dest } {
154
    global GDB
155
    global gdb_prompt
156
    global tool_root_dir
157
 
158
    # The variable gdb_prompt is a regexp which matches the gdb prompt.  Set it
159
    # if it is not already set.
160
    if ![board_info $dest exists gdb_prompt] then {
161
        set gdb_prompt "\\(gdb\\)"
162
    } else {
163
        set gdb_prompt [board_info $dest gdb_prompt];
164
    }
165
    # Similarly for GDB.  Look in the object directory for gdb if we aren't
166
    # provided with one.
167
    if ![info exists GDB] then {
168
        set GDB "[lookfor_file ${tool_root_dir} gdb/gdb]"
169
        if { $GDB == "" } {
170
            set GDB [transform gdb]
171
        }
172
    }
173
    if [board_info host exists gdb_opts] {
174
        set gdb_opts [board_info host gdb_opts];
175
    } else {
176
        set gdb_opts ""
177
    }
178
    # Start up gdb (no startfiles, no windows) and wait for a prompt.
179
    remote_spawn host "$GDB $gdb_opts -nw -nx";
180
    remote_expect host 60 {
181
        -re ".*$gdb_prompt $" { }
182
    }
183
    remote_send host "set height 0\n";
184
    remote_expect host 10 {
185
        -re ".*$gdb_prompt $" {}
186
    }
187
    remote_send host "set width 0\n";
188
    remote_expect host 10 {
189
        -re ".*$gdb_prompt $" {}
190
    }
191
}
192
 
193
# Add a breakpoint at function FUNCTION. We assume that GDB has already been
194
# started.
195
proc gdb_comm_add_breakpoint { function } {
196
    global gdb_prompt
197
 
198
    remote_send host "break $function\n"
199
    remote_expect host 60 {
200
        -re "Breakpoint.*$gdb_prompt $" { return "" }
201
        -re "Function.*not defined.*$gdb_prompt $" { return "undef" }
202
        -re "No symbol table.*$gdb_prompt $" { return "undef" }
203
        default {
204
            return "untested"
205
        }
206
    }
207
}
208
 
209
#
210
# quit_gdb -- try to quit GDB gracefully
211
#
212
 
213
proc quit_gdb { } {
214
    global gdb_prompt;
215
 
216
    set spawn_id [board_info host fileid];
217
 
218
    if { $spawn_id != "" && $spawn_id > -1 } {
219
        if { [remote_send host "quit\n"] == "" } {
220
            remote_expect host 10 {
221
                -re ".*y or n.*$" {
222
                    remote_send host "y\n";
223
                    exp_continue;
224
                }
225
                -re ".*\[*\]\[*\]\[*\].*EXIT code" { }
226
                default { }
227
            }
228
        }
229
    }
230
    if ![is_remote host] {
231
        remote_close host;
232
    }
233
}
234
 
235
proc gdb_comm_leave { } {
236
    if [is_remote host] {
237
        quit_gdb;
238
    } else {
239
        gdb_comm_go_idle;
240
    }
241
}
242
#
243
# gdb_comm_load -- load the program and execute it
244
#
245
# PROG is a full pathname to the file to load, no arguments.
246
# Result is "untested", "pass", "fail", etc.
247
#
248
 
249
proc gdb_comm_load { dest prog args } {
250
    global GDB
251
    global GDBFLAGS
252
    global gdb_prompt
253
    global timeout
254
    set argnames { "command-line arguments" "input file" "output file" }
255
 
256
    for { set x 0; } { $x < [llength $args] } { incr x } {
257
        if { [lindex $args $x] != "" } {
258
            return [list "unsupported" "no support for [lindex $argnames $x] on this target"];
259
        }
260
    }
261
    # Make sure the file we're supposed to load really exists.
262
    if ![file exists $prog] then {
263
        perror "$prog does not exist."
264
        return [list "untested" ""];
265
    }
266
 
267
    if { [is_remote host] || ![board_info host exists fileid] } {
268
        gdb_comm_start $dest;
269
    }
270
 
271
    # Remove all breakpoints, then tell the debugger that we have
272
    # new exec file.
273
    if { [gdb_comm_delete_breakpoints] != 0 } {
274
        gdb_comm_leave;
275
        return [gdb_comm_reload $dest $prog $args];
276
    }
277
    if { [gdb_comm_file_cmd $prog] != 0 } {
278
        gdb_comm_leave;
279
        return [gdb_comm_reload $dest $prog $args];
280
    }
281
    if [board_info $dest exists gdb_sect_offset] {
282
        set textoff [board_info $dest gdb_sect_offset];
283
        remote_send host "sect .text $textoff\n";
284
        remote_expect host 10 {
285
            -re "(0x\[0-9a-z]+) - 0x\[0-9a-z\]+ is \\.data" {
286
                set dataoff $expect_out(1,string);
287
                exp_continue;
288
            }
289
            -re "(0x\[0-9a-z\]+) - 0x\[0-9a-z\]+ is \\.bss" {
290
                set bssoff $expect_out(1,string);
291
                exp_continue;
292
            }
293
            -re "$gdb_prompt" { }
294
        }
295
        set dataoff [format 0x%x [expr $dataoff + $textoff]];
296
        set bssoff [format 0x%x [expr $bssoff + $textoff]];
297
        remote_send host "sect .data $dataoff\n";
298
        remote_expect host 10 {
299
            -re "$gdb_prompt" { }
300
        }
301
        remote_send host "sect .bss $bssoff\n";
302
        remote_expect host 10 {
303
            -re "$gdb_prompt" { }
304
        }
305
    }
306
 
307
    # Now set up breakpoints in exit, _exit, and abort.  These
308
    # are used to determine if a c-torture test passed or failed.  More
309
    # work would be necessary for things like the g++ testsuite which
310
    # use printf to indicate pass/fail status.
311
 
312
    if { [gdb_comm_add_breakpoint _exit] != "" } {
313
        gdb_comm_add_breakpoint exit;
314
    }
315
    gdb_comm_add_breakpoint abort;
316
 
317
    set protocol [board_info $dest gdb_protocol];
318
    if [board_info $dest exists gdb_serial] {
319
        set targetname [board_info $dest gdb_serial];
320
    } elseif [board_info $dest exists netport] {
321
        set targetname [board_info $dest netport];
322
    } else {
323
        if [board_info $dest exists serial] {
324
            set targetname [board_info $dest serial];
325
        } else {
326
            set targetname ""
327
        }
328
    }
329
    if [board_info $dest exists baud] {
330
        remote_send host "set remotebaud [board_info $dest baud]\n"
331
        remote_expect host 10 {
332
            -re ".*$gdb_prompt $" {}
333
            default {
334
                warning "failed setting baud rate";
335
            }
336
        }
337
    }
338
    remote_send host "target $protocol $targetname\n";
339
    remote_expect host 60 {
340
        -re "Couldn.t establish conn.*$gdb_prompt $" {
341
            warning "Unable to connect to $targetname with GDB."
342
            quit_gdb;
343
            return [gdb_comm_reload $dest $prog $args]
344
        }
345
        -re "Ending remote.*$gdb_prompt $" {
346
            warning "Unable to connect to $targetname with GDB."
347
            quit_gdb;
348
            return [gdb_comm_reload $dest $prog $args]
349
        }
350
        -re "Remote target $protocol connected to.*$gdb_prompt $" { }
351
        -re "Remote target $targetname connected to.*$gdb_prompt $" { }
352
        -re "Connected to ARM RDI target.*$gdb_prompt $" { }
353
        -re "Connected to the simulator.*$gdb_prompt $" { }
354
        -re "Remote.*using $targetname.*$gdb_prompt $" { }
355
        -re "$gdb_prompt $" {
356
            warning "Unable to connect to $targetname with GDB."
357
            quit_gdb;
358
            return [gdb_comm_reload $dest $prog $args]
359
        }
360
        -re ".*RDI_open.*should reset target.*" {
361
            warning "RDI Open Failed"
362
            quit_gdb;
363
            return [gdb_comm_reload $dest $prog $args]
364
        }
365
        default {
366
            warning "Unable to connect to $targetname with GDB."
367
            quit_gdb;
368
            return [gdb_comm_reload $dest $prog $args]
369
        }
370
    }
371
 
372
    if [target_info exists gdb_init_command] {
373
        remote_send host "[target_info gdb_init_command]\n";
374
        remote_expect host 10 {
375
            -re ".*$gdb_prompt $" { }
376
            default {
377
                gdb_comm_leave;
378
                return [list "fail" ""];
379
            }
380
        }
381
    }
382
    # Now download the executable to the target board.  If communications
383
    # with the target are very slow the timeout might need to be increased.
384
    if [board_info $dest exists gdb_load_offset] {
385
        remote_send host "load $prog [board_info $dest gdb_load_offset]\n";
386
    } else {
387
        remote_send host "load\n"
388
    }
389
    remote_expect host 600 {
390
        -re "text.*data.*$gdb_prompt $" { }
391
        -re "data.*text.*$gdb_prompt $" { }
392
        -re "$gdb_prompt $" {
393
            warning "Unable to send program to target board."
394
            gdb_comm_leave;
395
            return [gdb_comm_reload $dest $prog $args];
396
        }
397
        default {
398
            warning "Unable to send program to target board."
399
            gdb_comm_leave;
400
            return [gdb_comm_reload $dest $prog $args];
401
        }
402
    }
403
 
404
    set output ""
405
 
406
    # Now start up the program and look for our magic breakpoints.
407
    # And a whole lot of other magic stuff too.
408
 
409
    if [board_info $dest exists gdb_run_command] {
410
        remote_send host "[board_info $dest gdb_run_command]\n";
411
    } else {
412
        remote_send host "run\n"
413
    }
414
    # FIXME: The value 300 below should be a parameter.
415
    if [board_info $dest exists testcase_timeout] {
416
        set testcase_timeout [board_info $dest testcase_timeout];
417
    } else {
418
        set testcase_timeout 300;
419
    }
420
    remote_expect host $testcase_timeout {
421
        -re "Line.*Jump anyway.*.y or n.*" {
422
            remote_send host "y\n";
423
            exp_continue;
424
        }
425
        -re "Continuing( at |\\.| with no signal\\.)\[^\r\n\]*\[\r\n\]" {
426
            exp_continue;
427
        }
428
        -re ".*Start it from the beginning?.*y or n.*" {
429
            remote_send host "n\n";
430
            remote_expect host 10 {
431
                -re ".*$gdb_prompt $" {
432
                    remote_send host "signal 0\n";
433
                    remote_expect host 10 {
434
                        -re "signal 0\[\r\n\]+" { exp_continue; }
435
                        -re "Continuing(\\.| with no signal\\.)\[\r\n\]" {}
436
                    }
437
                }
438
            }
439
            exp_continue
440
        }
441
        -re "(run\[\r\n\]*|)Starting program: \[^\r\n\]*\[\r\n\]" {
442
            exp_continue
443
        }
444
        -re "$gdb_prompt (signal 0|continue)\[\r\n\]+Continuing(\\.| with no signal\\.)\[\r\n\]" {
445
            exp_continue
446
        }
447
        -re "(.*)Breakpoint.*exit.*=0.*$gdb_prompt $" {
448
            append output $expect_out(1,string);
449
            set result [check_for_board_status output];
450
            gdb_comm_leave;
451
            if { $result > 0 } {
452
                return [list "fail" $output];
453
            }
454
            return [list "pass" $output];
455
        }
456
        -re "(.*)Breakpoint.*exit.*=\[1-9\]\[0-9\]*.*$gdb_prompt $" {
457
            append output $expect_out(1,string);
458
            set result [check_for_board_status output];
459
            gdb_comm_leave;
460
            if { $result == 0 } {
461
                return [list "pass" $output];
462
            }
463
            if [board_info $dest exists exit_statuses_bad] {
464
                return [list "pass" $output];
465
            }
466
            return [list "fail" $output];
467
        }
468
        -re "(.*)Breakpoint.*exit.*$gdb_prompt $" {
469
            append output $expect_out(1,string);
470
            set status [check_for_board_status output];
471
            gdb_comm_leave;
472
            if { $status > 0 } {
473
                return [list "fail" $output];
474
            }
475
            return [list "pass" $output];
476
        }
477
        -re "(.*)Breakpoint.*abort.*$gdb_prompt $" {
478
            append output $expect_out(1,string);
479
            check_for_board_status output;
480
            gdb_comm_leave;
481
            return [list "fail" $output];
482
        }
483
        -re "SIGTRAP.*$gdb_prompt $" {
484
            return [gdb_comm_reload $dest $prog $args];
485
        }
486
        -re "(.*)Program (received |terminated ).*$gdb_prompt $" {
487
            set output $expect_out(1,string);
488
            check_for_board_status output;
489
            gdb_comm_leave;
490
            remote_reboot $dest;
491
            return [list "fail" $output];
492
        }
493
        -re "(.*)Program exited with code \[0-9\]+.*$gdb_prompt $" {
494
            set output $expect_out(1,string);
495
            set status [check_for_board_status output];
496
            gdb_comm_leave;
497
            if { $status > 0 } {
498
                return [list "fail" $output];
499
            }
500
            return [list "pass" $output];
501
        }
502
        default {
503
            gdb_comm_leave;
504
            if [board_info $dest exists unreliable] {
505
                if { [board_info $dest unreliable] > 0 } {
506
                    global board_info;
507
                    set name [board_info $dest name];
508
                    incr board_info($name,unreliable) -1;
509
                    set result [gdb_comm_reload $dest $prog $args];
510
                    incr board_info($name,unreliable);
511
                    return $result;
512
                }
513
            }
514
            return [list "fail" ""];
515
        }
516
    }
517
    gdb_comm_leave;
518
    return [list "fail" ""];
519
}
520
 
521
# If we've tried less than 4 times to load PROG, reboot the target, restart GDB
522
# and try again. Otherwise, return "untested".
523
proc gdb_comm_reload { dest prog aargs } {
524
    global try_again;
525
 
526
    # how many times have we done this?
527
    set n_reloads [board_info $dest n_reloads]
528
    if {$n_reloads == ""} {
529
        set n_reloads 0
530
    }
531
 
532
    # increment it
533
    global board_info
534
    set name [board_info $dest name]
535
    set board_info($dest,n_reloads) [expr {$n_reloads + 1}]
536
 
537
    # how many times are we allowed to do this?
538
    set max [board_info $dest max_reload_reboots]
539
    if {$max == ""} {
540
        set max 15
541
    }
542
 
543
    # if we've been doing this too much, something's very
544
    # wrong.  just give up, to reduce stress on boards.
545
    if {$max == $n_reloads} {
546
        perror "Too many reboots.  Giving up."
547
    }
548
    if {$max <= $n_reloads} {
549
        return {untested {}}
550
    }
551
 
552
    if { $try_again < 4 } {
553
        global GDB;
554
        remote_reboot $dest;
555
        remote_close host;
556
        incr try_again;
557
        set result [eval remote_load \"$dest\" \"$prog\" $aargs]
558
        set try_again 0;
559
        return "$result";
560
    } else {
561
        set try_again 0;
562
        return [list "untested" ""];
563
    }
564
}
565
 
566
set_board_info protocol  "gdb_comm";

powered by: WebSVN 2.1.0

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