112 lines
3.6 KiB
Tcl
112 lines
3.6 KiB
Tcl
#-------------------------------------------------------------------
|
|
# These are a couple of Tcl function which help with the interface
|
|
# between SICS and McStas
|
|
#
|
|
# Mark Koennecke, June 2005
|
|
#--------------------------------------------------------------------
|
|
# washsimfile fixes the evil NXsimulation name ="./dmc.xml" thing in
|
|
# the XML file. Path separators in name attributes throw off
|
|
# NXopenpath
|
|
#--------------------------------------------------------------------
|
|
proc washsimfile {name} {
|
|
set oriname $name
|
|
set in [open $name "r"]
|
|
set name [file tail $name]
|
|
set out [open /tmp/$name "w"]
|
|
while { [gets $in line] >= 0} {
|
|
if { [string first "NXsimulation name=" $line] > 0} {
|
|
puts $out "<NXsimulation name=\"$name\">"
|
|
} else {
|
|
puts $out $line
|
|
}
|
|
}
|
|
close $in
|
|
close $out
|
|
file copy -force /tmp/$name $oriname
|
|
file delete /tmp/$name
|
|
}
|
|
#---------------------------------------------------------------------
|
|
# When McStas dumps or is killed we need to give McStas some time to
|
|
# dump its data. Otherwise we observe that data reading fails.
|
|
# mcwaittime is used for this. Increase if you see problems
|
|
#--------------------------------------------------------------------
|
|
set mcwaittime 2
|
|
#----------------------------------------------------------------------
|
|
proc mcstasdump {pid} {
|
|
global mcwaittime
|
|
if { $pid <= 0} {
|
|
error "Trying to dump invalid PID: $pid"
|
|
}
|
|
clientput "Dumping ..."
|
|
# catch {eval exec /usr/bin/kill -USR2 $pid}
|
|
catch {eval exec /bin/kill -USR2 $pid}
|
|
wait $mcwaittime
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
# mcstasisrunning has to open a pipe to ps and to read the results of
|
|
# the ps command. This is because a terminated McStas simulation turns
|
|
# into a Zombie process which finishes never. This can only be cured
|
|
# by checking for this in the STAT field of ps's output. According to
|
|
# the Unix FAQ this is the best solution......
|
|
#----------------------------------------------------------------------
|
|
proc readPID {pid} {
|
|
# set f [ open "| /bin/ps -up $pid" r]
|
|
# This is system dependent. The above works for SL, below for Suse
|
|
set f [ open "| /bin/ps up $pid" r]
|
|
set pstxt [read $f]
|
|
close $f
|
|
return $pstxt
|
|
}
|
|
#----------------------------------------------------------------------
|
|
proc mcstasisrunning {pid} {
|
|
global runningCount runningLast
|
|
|
|
# clientput "Checking McStas PID $pid"
|
|
if { $pid <= 0} {
|
|
return 0
|
|
}
|
|
set pstxt " "
|
|
set ret [catch {set pstxt [readPID $pid]} msg]
|
|
# clientput "pstext = $pstxt"
|
|
set pslist [split $pstxt "\n"]
|
|
if { [llength $pslist] < 2} {
|
|
return 0
|
|
}
|
|
set header [lindex $pslist 0]
|
|
set idx [string first STAT $header]
|
|
set stat [string trim [string range [lindex $pslist 1] $idx [expr $idx + 4]]]
|
|
if { [string first Z $stat] >= 0 || [string first T $stat] >= 0} {
|
|
mccontrol finish
|
|
return 0
|
|
} else {
|
|
return 1
|
|
}
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc mcstaskill {pid} {
|
|
global mcwaittime
|
|
if { $pid <= 0} {
|
|
error "Trying to kill invalid PID $pid"
|
|
}
|
|
clientput "Killing $pid"
|
|
# catch {eval exec /usr/bin/kill -TERM $pid} msg
|
|
# On Suse kill is /bin/kill, on others it is /usr/bin/kill
|
|
catch {eval exec /bin/kill -TERM $pid} msg
|
|
clientput "Kill message $msg"
|
|
# catch {mccontrol finish}
|
|
wait 10
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
proc mcinstall {} {
|
|
allowexec /usr/bin/kill
|
|
allowexec /bin/kill
|
|
allowexec /bin/ps
|
|
Publish mcstasdump User
|
|
Publish mcstasisrunning User
|
|
Publish mcstaskill User
|
|
mccontrol configure mcdump mcstasdump
|
|
mccontrol configure mckill mcstaskill
|
|
mccontrol configure mcisrunning mcstasisrunning
|
|
mccontrol configure update 300
|
|
}
|