# Copyright (C) 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License 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.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@prep.ai.mit.edu
# This file was written by Rob Savoye. (rob@welcomehome.org)
#
# set target variables only if needed.
#
global targetname
global connectmode
global env
if ![info exists targetname] {
if [info exists env(TARGETNAME)] {
set targetname $env(TARGETNAME)
} else {
puts stderr "ERROR: Need a target name for the udi target."
puts stderr " Use the --name option\n"
exit 1
}
}
# the default connect program to use
if ![info exists connectmode] {
set connectmode "mondfe"
warning "Using default of $connectmode for target communication."
if {[which mondfe] == 0} {
perror "\"mondfe\" does not exist. Check your path."
exit 1
}
}
#
# Connect to udi using mondfe
#
# HOSTNAME can be `iss' to talk to the simulator.
# The result is the value of `spawn_id' or -1 for failure.
#
proc mondfe { hostname } {
global shell_prompt
global spawn_id
set retries 0
set result -1
verbose "Attempting to connect to $hostname via mondfe."
spawn mondfe -D -TIP $hostname
expect {
"$shell_prompt" {
verbose "Got prompt"
set result 0
}
"*server bind*failed: Address already in use*" {
warning "Socket file already exists."
incr retries
if { $retries <= 2 } {
continue -expect
}
}
-indices -re ".*(UDIERROR\[^\r\n\]*)\[\r\n\]" {
warning "$expect_out(1,string)"
continue -expect
}
-indices -re ".*(DFEERROR\[^\r\n\]*)\[\r\n\]" {
warning "$expect_out(1,string)"
continue -expect
}
timeout {
warning "Timed out trying to connect."
set result -1
incr retries
if { $retries <= 2 } {
send -i $spawn_id "\n"
continue -expect
}
}
}
if { $result < 0 } {
perror "Couldn't connect after $retries retries."
return -1
} else {
return $spawn_id
}
}
#
# Downloads using the y (yank) command in mondfe
#
# SHELL_ID is the from the result of `mondfe'.
# ARG is a full path name to the file to download.
# Returns 1 if an error occured, 0 otherwise.
#
proc mondfe_download { shell_id arg } {
global decimal ;# ??? What is this?
global shell_prompt
if ![file exists $arg] {
perror "$arg doesn't exist."
return 1
}
verbose "Downloading $arg." 2
set result 1
send -i $shell_id "y $arg\n"
expect {
-i $shell_id "y $arg*loading $arg*" {
continue -expect
}
-i $shell_id -re "Loading *TEXT section from\[^\r\]*\r" {
verbose -n "." 2
continue -expect
}
-i $shell_id -re "Loaded *TEXT section from\[^\n\]*\n" {
verbose " TEXT section loaded." 2
continue -expect
}
-i $shell_id -re "Loading *LIT section from\[^\r\]*\r" {
verbose -n "." 2
continue -expect
}
-i $shell_id -re "Loaded *LIT section from\[^\n\]*\n" {
verbose " LIT section loaded." 2
continue -expect
}
-i $shell_id -re "Loading *DATA section from\[^\r\]*\r" {
verbose -n "." 2
continue -expect
}
-i $shell_id -re "Loaded *DATA section from\[^\n\]*\n" {
verbose " DATA section loaded." 2
continue -expect
}
-i $shell_id -re "Clearing *BSS section from\[^\r\]*\r" {
verbose -n "." 2
continue -expect
}
-i $shell_id -re ".*Cleared *BSS section from.*$shell_prompt$" {
verbose " BSS section cleared." 2
verbose "Downloaded $arg successfully." 2
set result 0
}
-i $shell_id -re "DFEWARNING: $decimal : EMMAGIC: Bad COFF file magic number.*Command failed.*$shell_prompt$" {
warning "Bad COFF file magic number"
set result 1
}
-i $shell_id -re ".*Ignoring COMMENT section \($decimal bytes\).*$shell_prompt$" {
verbose "Ignoring COMMENT section" 2
verbose "Downloaded $arg successfully." 2
set result 0
}
-i $shell_id timeout {
perror "Timed out trying to download $arg."
set result 1
}
}
# FIXME: the following keeps the download from working
# "Could not read COFF section" {
# perror "Couldn't read COFF section."
# set result 1
# }
if { $result && [info exists expect_out(buffer)] } {
send_log $expect_out(buffer)
}
return $result
}
#
# Exit the remote shell
#
proc exit_mondfe { shell_id } {
send -i $shell_id "q\n"
expect {
-i $shell_id "Goodbye." {
verbose "Exited mondfe $shell_id"
}
timeout {
warning "mondfe didn't exit cleanly"
}
}
catch "close -i $shell_id"
return 0
}
#
# Exit the remote shell
#
proc exit_montip { shell_id } {
verbose "exiting montip $shell_id"
catch "close -i $shell_id"
return 0
}