74 lines
2.4 KiB
Tcl
74 lines
2.4 KiB
Tcl
#------------------------------------------------------------------
|
|
# This is a helper file in order to debug SICS Tcl scripts. The idea
|
|
# is that a connection to a SICS interpreter at localhost:2911 is opened.
|
|
# Then unknown is reimplemented to send unknown commands (which must be
|
|
# SICS commands) to the SICS interpreter for evaluation. This is done
|
|
# with transact in order to figure out when SICS finished processing.
|
|
# Thus is should be possible to debug SICS Tcl scripts in a normal
|
|
# standalone interpreter without the overhead of restarting SICS
|
|
# all the time. It may even be possible to use one of the normal
|
|
# Tcl debuggers then....
|
|
#
|
|
# Mark Koennecke, February 2006
|
|
#
|
|
# Revamped for use in testing SICS instruments.
|
|
# Mark Koennecke, November 2006
|
|
#------------------------------------------------------------------
|
|
set host(amor) amor.psi.ch
|
|
set host(dmc) dmc.psi.ch
|
|
set host(focus) focus.psi.ch
|
|
set host(hrpt) hrpt.psi.ch
|
|
set host(mars) mars.psi.ch
|
|
set host(morpheus) morpheus.psi.ch
|
|
set host(narziss) narziss.psi.ch
|
|
set host(poldi) poldi.psi.ch
|
|
set host(rita2) rita2.psi.ch
|
|
set host(sans) sans.psi.ch
|
|
set host(sansli) sans2.psi.ch
|
|
set host(tasp) tasp.psi.ch
|
|
set host(trics) trics.psi.ch
|
|
set host(local) localhost
|
|
|
|
#-------------------------------------------------------------------
|
|
# initialize the socket before debugging. If local == 1, then a
|
|
# connection to localhost is built
|
|
#------------------------------------------------------------------
|
|
proc initSicsDebug {instrument} {
|
|
global socke host
|
|
catch {close $socke}
|
|
set status [catch {set compi $host($instrument)} msg]
|
|
if {$status != 0} {
|
|
error "Host for $instrument not found"
|
|
}
|
|
set socke [socket $compi 2911]
|
|
gets $socke
|
|
puts $socke "Spy 007"
|
|
flush $socke
|
|
gets $socke
|
|
}
|
|
#----------------------------------------------------------------
|
|
proc sicscommand args {
|
|
global socke
|
|
append com "transact " [join $args]
|
|
puts $socke $com
|
|
flush $socke
|
|
set reply ""
|
|
while {1} {
|
|
set line [gets $socke]
|
|
if {[string first TRANSACTIONFINISHED $line] >= 0} {
|
|
return $reply
|
|
} else {
|
|
append reply $line "\n"
|
|
}
|
|
}
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc unknown args {
|
|
return [sicscommand $args]
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc clientput args {
|
|
puts stdout [join $args]
|
|
}
|
|
#------------------------------------------------------------------
|