src/runtest-ugdb/native-ugdb-config.exp

   1 # Copyright 2010 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 3 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, see <http://www.gnu.org/licenses/>.
  15
  16 # Override its functions
  17 load_config gdbserver.exp
  18
  19 proc port_open { port } {
  20     set fi [open "/proc/net/tcp" "r"]
  21     fconfigure $fi -translation binary
  22     set data [read $fi]
  23     close $fi
  24
  25     #   0: 00000000:07D0 00000000:0000 0A 00000000:00000000 00:00000000 00000000   500 ...
  26
  27     set port_hex4 [format "%04X" $port]
  28     return [regexp -line "^ *\[0-9\]+: 0100007F:${port_hex4} 00000000:0000 0A " $data]
  29 }
  30
  31 # OPTIONS and ARGUMENTS are ignored now.
  32 proc gdbserver_start { options arguments } {
  33     set port 2000
  34     set delay 0.1
  35     set timeout 100
  36
  37     verbose -log "gdbserver_start options=$options arguments=$arguments"
  38
  39     if [port_open $port] {
  40         error "Port $port is already allocated"
  41     }
  42
  43     # FIXME: IPv6 wrt /proc/net/tcp.
  44     set cmd "nc -l 127.0.0.1 $port <>/proc/ugdb >&0"
  45     set cmd "exec $cmd"
  46     regsub -all { } $cmd {\ } cmd
  47     set cmd "bash -c $cmd"
  48     set server_spawn_id [remote_spawn target $cmd]
  49
  50     for {set i 0} {$i < $timeout} {incr i} {
  51         if [port_open $port] {
  52             break
  53         }
  54         sleep $delay
  55     }
  56     if {$i == $timeout} {
  57         error "Port $port is still closed"
  58     }
  59
  60     return [list "extended-remote" "localhost:$port"]
  61 }
  62
  63 load_lib mi-support.exp
  64
  65 proc mi_gdb_start { args } {
  66     set retval [default_mi_gdb_start $args]
  67
  68     if {$retval == 0} {
  69         global mi_gdb_prompt ugdb_debug
  70
  71         set test "-gdb-set debug remote $ugdb_debug"
  72         gdb_test_multiple $test $test {
  73             -re "\\\^done\r\n$mi_gdb_prompt$" {
  74                 pass $test
  75             }
  76         }
  77     }
  78
  79     return $retval
  80 }
  81
  82 load_lib gdb.exp
  83
  84 proc gdb_start { } {
  85     set retval [default_gdb_start]
  86
  87     if {$retval == 0} {
  88         global ugdb_debug
  89         gdb_test_no_output "set debug remote $ugdb_debug"
  90         gdb_test_no_output "set target-async on"
  91         gdb_test_no_output "set non-stop on"
  92     }
  93
  94     return $retval
  95 }
  96
  97 load_lib gdbserver-support.exp
  98
  99 # Do not prepend the "extended-" string.
 100 proc gdbserver_start_extended { } {
 101     set res [gdbserver_start "--multi" ""]
 102     set gdbserver_protocol [lindex $res 0]
 103     set gdbserver_gdbport [lindex $res 1]
 104
 105     return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
 106 }