itcl::class Iipc {
private variable socklist
private variable portnum 9909
private variable serversock
constructor {} {
init
}
destructor {
debug
foreach sock $socklist {
catch {::close $sock}
}
if {$serversock != "0"} {
catch {::close $serversock}
}
set ::iipc 0
}
private method init {} {
debug "iipc init"
set socklist {}
set serversock 0
set portnum [pref get gdb/ipc/port]
if {[catch {socket -server [code $this accept] $portnum} serversock]} {
debug "server already exists. Connecting to it."
set socklist [socket localhost $portnum]
fconfigure $socklist -buffering line -blocking 0
fileevent $socklist readable [code $this read $socklist]
}
set ::iipc 1
}
private method accept {sock addr port} {
debug "accepting connecting from $sock -> $addr:$port"
fconfigure $sock -buffering line -blocking 0
lappend socklist $sock
fileevent $sock readable [code $this sread $sock]
}
private method read {s} {
if [eof $s] {
debug "The server died on $s!!"
catch {::close $s}
init
return
}
gets $s res
debug "Server: $res"
switch $res {
quit { gdb_force_quit }
stop { gdbtk_stop }
run { gdbtk_run }
default {
catch {gdb_immediate "$res"}
}
}
}
private method sread {s} {
if [eof $s] {
close $s
return
}
gets $s res
if {$res != ""} {
debug "Got: $res"
foreach sock $socklist {
if {$s != $sock} {
if {[catch {puts $sock $res}]} {
close $sock
}
}
}
switch $res {
quit { gdb_force_quit }
stop { gdbtk_stop }
run { gdbtk_run }
default {
catch {gdb_immediate "$res"}
}
}
}
}
public method send {cmd} {
debug "send $cmd"
foreach sock $socklist {
if {[catch {puts $sock $cmd}]} {
close $sock
}
}
}
private method close {s} {
debug "closing socket $s"
set socklist [lremove $socklist $s]
catch {::close $s}
}
}