# -------------------------------------------------------------------------- # Initialization script for testing SICS # # Started: Dr. Mark Koennecke, July 2006 #--------------------------------------------------------------------------- set home $env(HOME)/src/workspace/sics/test protocol set all #---------------------------------------------------------------------------- # O P T I O N S # --------------- ---------------------------------------------------------- # first all the server options are set ServerOption ReadTimeOut 10 # timeout when checking for commands. In the main loop SICS checks for # pending commands on each connection with the above timeout, has # PERFORMANCE impact! ServerOption AcceptTimeOut 10 # timeout when checking for connection req. # Similar to above, but for connections ServerOption ReadUserPasswdTimeout 500000 # time to wiat for a user/passwd to be sent from a client. Increase this # if there is a problem connecting to a server due to network overload\ ServerOption ServerPort 2911 # the port number the server is going to listen at. The client MUST know # this number in order to connect. It is in client.ini ServerOption InterruptPort 2913 # The UDP port where the server will wait for Interrupts from clients. # Obviously, clients wishing to interrupt need to know this number. ServerOption historylog $env(HOME)/src/workspace/sics/sim/tmp/comhistorytst.txt #--------------------------------------------------------------------------- # U S E R S # than the SICS users are specified # Syntax: SicsUser name password userRightsCode SicsUser Mugger Mugger 1 SicsUser User User 2 SicsUser Spy Spy 3 #SicsUser Spy 007 1 #----------------- SICS Variable VarMake lotte Text User #----------------- Motors --------------------------------------------------- Motor brumm regress MakeDrive #----------------- Alias ---------------------------------------------------- SicsAlias brumm miau #----------------- Counters ------------------------------------------------- MakeCounter aba regress MakeCounter hugo SIM -1. MakeCounter lieselotte SIM -1. #------------------------------ proc SICSValue {command} { set txt [eval $command] set l [split $txt =] return [string trim [lindex $l 1]] } #----------------------------- proc multitransfer {} { append res [SICSValue "aba gettime"] " " for {set i 0} {$i < 7} {incr i} { append res [SICSValue "aba getmonitor $i"] " " } return $res } #----------------------------------- MakeMultiCounter multi aba hugo lieselotte multi transferscript multitransfer #------------- For Scanning --------------------------------------------- # This is with the tricky bit set: we use a multicounter and use the # scantransfer function to return values of a gaussian for a4 positions. # This gives nice scan data which can be used to test all sorts of things. #------------------------------------------------------------------------- MakeDataNumber SicsDataNumber ./DataNumber VarMake SicsDataPath Text Mugger SicsDataPath ./ SicsDataPath lock VarMake SicsDataPrefix Text Mugger SicsDataPrefix regression SicsDataPrefix lock VarMake SicsDataPostFix Text Mugger SicsDataPostFix .dat SicsDataPostFix lock Motor a1 SIM -2 180 -.1 10 Motor a2 SIM 30 150 -.1 10 Motor a3 SIM -360 360 -.1 10 Motor a4 SIM -180 180 -.1 10 Motor a5 SIM -180 180 -.1 10 Motor a6 SIM -180 180 -.1 10 Motor sgu SIM -20 20 -.1 10 Motor sgl SIM -20 20 -.1 10 Motor chi SIM 0 360 -.1 10 Motor phi SIM 0 360 -.1 10 MakeMultiCounter scanCter aba SicsAlias scanCter counter proc scantransfer {} { set FWHM 1.5 set pos 5.33 set height 700 set stddev [expr $FWHM/2.354] set ftmp [expr ([SICSValue a4] - $pos)/$stddev] set count [expr 10 + $height*0.4*exp(-.5*$ftmp*$ftmp)] set counti [expr int($count)] append res [SICSValue "lieselotte gettime"] " " append res $counti " " for {set i 1} {$i < 7} {incr i} { append res [SICSValue "lieselotte getmonitor $i"] " " } return $res } scancter transferscript scantransfer rename scan stscan MakeScanCommand xxxscan scancter test.hdd recover.bin MakePeakCenter xxxscan source scancommand.tcl MakeOptimise opti scancter MakeMaximize scancter #------------------------------------------------------------------------- # Histogram Memory #------------------------------------------------------------------------ MakeHM hm regress hm configure rank 1 hm configure dim0 23 hm configure testval 1 hm configure errortype 0 hm configure recover 1 hm configure init 1 hm init MakeHM tof regress tof configure rank 1 tof configure HistMode TOF tof configure dim0 23 tof configure testval 1 tof configure errortype 0 tof configure recover 1 tof genbin 10 12 100 tof configure init 1 tof init #------------------------------------------------------------------------- # NXscript #------------------------------------------------------------------------- MakeNXScript #------------------------------------------------------------------------- proc makearray {} { global ar for { set i 10} {$i < 20} {incr i} { set ar([expr $i - 10]) [expr $i*1.0] } } #------------------------------------------------------------------------ proc makeintarray {} { global ar for { set i 10} {$i < 20} {incr i} { set ar([expr $i - 10]) $i } } Publish makearray User Publish makeintarray User Publish parray User #------------------------------------------------------------------------ # SicsData #------------------------------------------------------------------------ sicsdatafactory new data sicsdatafactory new duta #----------------------------------------------------------------------- # tasub #----------------------------------------------------------------------- MakeTasUB tasub #----------------------------------------------------------------------- # MultiMotors #---------------------------------------------------------------------- MakeMulti sa sa alias a3 om sa alias a4 stt sa pos noeff a3 24 a4 48 sa endconfig #----------------------------------------------------------------------- # Hipadaba #---------------------------------------------------------------------- proc SplitReply { text } { set l [split $text =] return [string trim [lindex $l 1]] } #--------------------------------------------------------------------- source ../tcl/hdbutil.tcl hmake /instrument spy none hmake /instrument/sample spy none hattach /instrument/sample a3 omega hattach /instrument/sample qh qh hmake /instrument/detector spy none hattach /instrument/detector hm data hattach /instrument lotte title hfactory /target plain spy none hfactory /target/ta3 plain internal float hattach target a3 /target/ta3 proc upsctest {} { broadcast "An update script has been called" set txt [hval /instrument/title] broadcast "Update to $txt" } restore #================================================== # ScriptContext testing #================================================== proc sendtest {} { set test [catch {sct target} msg] if {$test == 0} { set data $msg } else { set data TestDuta } sct send $data return testreply } #------------------------------------------------- proc readtest {} { set t [doubletime] sct send "Read:$t" return testreply } #------------------------------------------------- proc testreply {} { sct print [sct result] sct update [sct result] return idle } makesctcontroller testsct testprot MakeSICSObj testnode Test spy text hsetprop /sics/testnode read readtest hsetprop /sics/testnode write sendtest hsetprop /sics/testnode testreply testreply proc testprio {} { testsct queue /sics/testnode read read testsct queue /sics/testnode read read testsct queue /sics/testnode read read testsct queue /sics/testnode halt write testsct queue /sics/testnode read read testsct queue /sics/testnode read read return [testnode] } Publish testprio Spy #------------------------------------------------- proc farmFormat {par num} { hsetprop /sics/farm/$par lastError none return [format "$par %d" [string trim $num]] } #----------------------------------------------- proc farmRead {par } { hsetprop /sics/farm/$par lastError none hsetprop /sics/farm/$par replyCommand "farmReply $par" return $par } #----------------------------------------------- proc farmReply {par reply} { set action [string trim [hgetpropval /sics/farm/$par status]] hsetprop /sics/farm/$par status idle if {[string first OK $reply] >= 0} { if {[string first get $action] >= 0} { set idx [string first : $reply] if {$idx > 0} { set val [string trim [string range $reply [expr $idx +1] end]] hupdate /sics/farm/$par $val } } else { hget /sics/farm/$par } } else { if {[string first ERROR $reply] < 0} { set reply "ERROR: $reply" } clientPut $reply error $reply } } #============================================= proc schconset {val} { set com [farmFormat schnegge $val] hsetprop /sics/farm/schneggecon replyCommand schreply return $com } #---------------------------------------------- proc schreply {reply} { clientput "schreply $reply" if {[string first OK $reply] >= 0} { hsetprop /sics/farm/schneggerunning readCommand schrunget hget /sics/farm/schneggerunning hsetprop /sics/farm/schneggerunning readCommand \ "farmReply schneggerunning" } else { hsetprop /sics/farm/schneggecon status idle hsetprop /sics/farm/schneggecon lastError $reply clientput "ERROR: $reply on schnegge" } } #----------------------------------------------- proc schrun {reply} { clientput "schrun $reply" hsetprop /sics/farm/schneggerunning status idle if {[string first OK $reply] >= 0} { set idx [string first : $reply] if {$idx > 0} { set val [string trim [string range $reply [expr $idx +1] end]] hupdate /sics/farm/schneggerunning $val if {$val == 1} { clientput "schnegge creeping" hsetprop /sics/farm/schneggerunning readCommand schrunget hget /sics/farm/schneggerunning hsetprop /sics/farm/schneggerunning readCommand \ "farmReply schneggerunning" } else { clientput "schnegge finished" hsetprop /sics/farm/schneggerunning readCommand \ "farmRead schneggerunning" hsetprop /sics/farm/schneggecon status idle } } } else { clientput "schnegge has error: $reply" hsetprop /sics/farm/schneggerunning readCommand \ "farmRead schneggerunning" hsetprop /sics/farm/schneggecon status idle hsetprop /sics/farm/schneggecon lastError $reply hsetprop /sics/farm/schneggerunning lastError $reply } } #---------------------------------------------- proc schget {} { hsetprop /sics/farm/schneggecon lastError none hsetprop /sics/farm/schneggecon replyCommand "farmReply schneggecon" return schnegge } #---------------------------------------------- proc schrunget {} { hsetprop /sics/farm/schneggerunning lastError none hsetprop /sics/farm/schneggerunning replyCommand schrun return schneggerunning } #----------------------------------------------- set farm 0 if {$farm == 1} { # Generic Controller #------------------------------------------------------------------- MakeAsyncProtocol norma MakeAsyncQueue farmQueue norma localhost 9090 MakeGenController farm genconfigure asynconnect farm farmQueue #------------------------------------------------ genconfigure makepar farm hase int hsetprop /sics/farm/hase priv user hsetprop /sics/farm/hase writeCommand "farmFormat hase" hsetprop /sics/farm/hase readCommand "farmRead hase" hsetprop /sics/farm/hase replyCommand "farmReply hase" genconfigure makepar farm schnegge int hsetprop /sics/farm/schnegge priv user hsetprop /sics/farm/schnegge writeCommand "farmFormat schnegge" hsetprop /sics/farm/schnegge readCommand "farmRead schnegge" hsetprop /sics/farm/schnegge replyCommand "farmReply schnegge" genconfigure makepar farm schneggerunning int hsetprop /sics/farm/schneggerunning priv internal hsetprop /sics/farm/schneggerunning readCommand "farmRead schneggerunning" hsetprop /sics/farm/schneggerunning replyCommand "farmReply schneggerunning" genconfigure makepar farm schneggecon int hsetprop /sics/farm/schneggecon priv user hsetprop /sics/farm/schneggecon writeCommand schconset hsetprop /sics/farm/schneggecon readCommand schget hsetprop /sics/farm/schneggecon replyCommand schreply } set farm 0 if {$farm == 1} { #-------------- Test new async protocol controller makesctcontroller farmser std localhost:8080 makesctcomtask farmcom farmser MakeSICSObj farm TestObj #--------------------------- proc farmparcom {par} { sct send $par return parread } #------------------------ proc farmparread {} { set rply [sct result] if {[string first ERR $rply] >= 0} { sct geterror $rply return idle } set data [string range $rply 3 end] set node [sct] sct update $data return idle } #-------------------------- proc farmcheck {} { set val [sct target] if {$val < -100 || $val > 100} { error "Value out of range" } return OK } #--------------------------- proc farmset {par} { set val [sct target] sct send "$par $val" return setreply } #------------------------- proc farmsetreply {} { set rply [sct result] if {[string first ERR $rply] >= 0} { sct print $rply } return idle } #-------------------------- hfactory /sics/farm/hase plain spy int hsetprop /sics/farm/hase read farmparcom hase hsetprop /sics/farm/hase parread farmparread hsetprop /sics/farm/hase check farmcheck hsetprop /sics/farm/hase write farmset hase hsetprop /sics/farm/hase setreply farmsetreply farmser poll /sics/farm/hase farmser write /sics/farm/hase hfactory /sics/farm/hugo plain spy int hsetprop /sics/farm/hugo read farmparcom hugo hsetprop /sics/farm/hugo parread farmparread hsetprop /sics/farm/hugo check farmcheck hsetprop /sics/farm/hugo write farmset hugo hsetprop /sics/farm/hugo setreply farmsetreply farmser poll /sics/farm/hugo farmser write /sics/farm/hugo hfactory /sics/farm/schnegge plain spy float hsetprop /sics/farm/schnegge read farmparcom schnegge hsetprop /sics/farm/schnegge parread farmparread hsetprop /sics/farm/schnegge check farmcheck hsetprop /sics/farm/schnegge write farmset schnegge hsetprop /sics/farm/schnegge setreply farmsetreply farmser poll /sics/farm/schnegge farmser write /sics/farm/schnegge hfactory /sics/farm/schneggerunning plain spy int hsetprop /sics/farm/schneggerunning read farmparcom schneggerunning hsetprop /sics/farm/schneggerunning parread farmparread farmser poll /sics/farm/schneggerunning hfactory /sics/farm/stone plain spy int hsetprop /sics/farm/stone read farmparcom stone hsetprop /sics/farm/stone parread farmparread #farmser poll /sics/farm/stone farmser debug -1 #----------------- drivable scriptcontext adapter proc schneggechecklimits {} { return [farmcheck] } #----------------------------- proc schneggestatus {} { farmser queue /sics/farm/schneggerunning progress read set status [sct writestatus] switch $status { commandsent { set runtime [SICSValue "hgetprop /sics/farm/schneggerunning read_time"] set starttime [sct write_time] if {$runtime > $starttime} { sct writestatus evalcheck } return run } evalcheck { set tst [hval /sics/farm/schneggerunning] if {$tst == 1} { return run } else { return idle } } default { error "schneggestatus called in bad state $status" } } } #--------------------------------------------- hsetprop /sics/farm/schnegge checklimits schneggechecklimits hsetprop /sics/farm/schnegge checkstatus schneggestatus #makesctdrive schnecke /sics/farm/schnegge farmser makesctdriveobj schnecke /sics/farm/schnegge DriveAdapter farmser } #---------- test http set httptest 0 if {$httptest == 1} { makesctcontroller amorhmsct sinqhttp amorhm data 180 spy 007 #makesctcontroller amorhmsct sinqhttp localhost:8080 data 60 spy 007 MakeSICSObj amorhm HttpTest amorhmsct debug -1 #------------------ proc statget {} { sct send "admin/textstatus.egi" return statrepl } #----------------- proc statreply {} { sct update [sct result] sct utime readtime return idle } #----------------- proc readcollapse {} { sct send "admin/processhmdata.egi?bank=0&command=sum:2:0:400" return colread } #----------------- proc colreply {} { sct utime readtime set data [sct result] return idle } #------------------------- hfactory /sics/amorhm/status plain spy text hsetprop /sics/amorhm/status read statget hsetprop /sics/amorhm/status statrepl statreply amorhmsct poll /sics/amorhm/status 10 hattach /sics/amorhm data intvarar collapse hsetprop /sics/amorhm/collapse read readcollapse hsetprop /sics/amorhm/collapse colread colreply amorhmsct poll /sics/amorhm/collapse 20 } #source sansdruck.tcl #MakeRS232Controller sadu pc4639 4168 #MakeRS232Controller sadu localhost 4168 #sadu replyterminator 0x04 #sadu sendterminator 0x04 #sadu timeout 1000 #source ../sim/mars/julcho.tcl #MakeSinqRedirect lnsl15 10500 MakeSingleX singlex configure stt a4 singlex configure om a3 singlex configure chi chi singlex configure phi phi singlex configure lambda gfrth66jjjhh singlex configure nu chi singlex configure sgu chi singlex configure sgl phi singlex mode bi set secMotortest 0 if {$secMotortest == 1} { proc hdbReadOnly {} { error "Parameter is READ ONLY" } source ../tcl/secsim.tcl MakeSecSim mig3 -20 20 5 makesctcontroller pmac01 pmac ldm-elec-dev:1025 5 pmac01 debug 0 source ../tcl/deltatau.tcl MakeDeltaTau mig15 pmac01 02 } set astrium 0 if {$astrium == 1} { source ../tcl/astrium.tcl } set el737sec 0 if {$el737sec == 1} { source ../tcl/el737sec.tcl MakeSecEL737 elli psts235:3008 } #------------------------------------------------- proc loadsinqhm {file} { set f [open $file r] while {[gets $f line] >= 0} { append conf $line } close $f return $conf } #------------------------------------------------- proc appleinit {} { return [loadsinqhm sans.xml] } #--------------------------------------------------------------------- proc formattof {l} { set count 0 set delay [expr int([lindex $l 0])] foreach e $l { append txt [format " %12d" [expr int($e) - $delay]] incr count if {$count >= 5} { append txt "\n" set count 0 } } set len [llength $l] set bin [lindex $l [expr $len - 1]] set diff [expr [lindex $l 1] - [lindex $l 0]] set bin [expr $bin + int($diff)] append txt [format " %12d" [expr int($bin) - $delay]] append txt "\n" return [string trimright $txt] } #------------------------------------------------------------------ proc tofappleinit {} { set dim [string trim [hval /sics/apple/dim]] set dimlist [split $dim] set ntime [lindex $dimlist 1] append conf "\n" append conf "\n" append conf "\n" append conf " \n " append conf " \n" append conf "\n" set bins [string trim [hval /sics/apple/time_binning]] set binl [split $bins] set delay [expr int([lindex $binl 0])% 200000] # mdif write [format "DT %d" $delay] foreach b $binl { if { [string length [string trim $b]] > 1} { lappend binlist [string trim $b] } } set tlen [expr $ntime + 1] append conf "\n" append conf [formattof $binlist] "\n" append conf "\n" append conf "\n" return $conf } #------------------------------------------------- set hmhttp 0 if {$hmhttp == 1} { source ../tcl/sinqhttp.tcl # MakeHTTPHM apple 1 hm01 appleinit # MakeHTTPHM apple 1 localhost:8080 appleinit # apple dim 16384 #---------- for TOF MakeHTTPHM apple 2 hm01 tofappleinit tof apple dim 16384 10 apple genbin 10 20 100 applesct debug 0 apple init } set simhm 1 #if {$simhm == 1} { source ../tcl/simhm.tcl simhm::MakeSimHM simi 3 tof # simhm::makeSecond simi singledet 30 simi dim 64 64 5 lappend tlist 10 20 30 40 50 simi time_binning $tlist simi init #} set phytron 0 if {$phytron == 1} { #makesctcontroller phyto phytron psts234:3002 5 makesctcontroller phyto phytron morpheus-ts:3013 #makesctcontroller phyto phytron localhost:8080 5 phyto debug 0 source ../tcl/phytron.tcl phytron::make alge X phyto -360 0 } #MakeLMD200 lmd400 lnsts11 3012 set stddrive 0 if {$stddrive == 1} { makesctcontroller stdsct std localhost:8080 "\r" 10 source ../tcl/stddrive.tcl stddrive::makestddrive eule EuleDrive stdsct } set el755 0 if {$el755 == 1} { source ../tcl/stddrive.tcl source ../tcl/el755.tcl makesctcontroller el755sct std localhost:8080 "\r" 10 #el755sct debug 1 for {set i 0} {$i < 3} {incr i} { el755sct transact "RMT 1" el755sct transact "ECHO 2" } el755::makeel755 mf 5 el755sct el755sct queue /sics/mf progress read mf upperlimit 10 mf lowerlimit -10 mf tolerance .1 } set dc-804 0 if {${dc-804} == 1} { source ../tcl/pimotor.tcl makesctcontroller dc804sct std localhost:8080 "\r" 10 "\x03" "\x03" pimotor::makepimotor dc1 1 dc804sct -10000 10000 } proc testprot {input} { return "${input}_hugo_appended_by_Tcl" } proc testerr {input} { error "$input is SO abyssimally wrong!" } set slsecho 0 if {$slsecho == 1} { source ../tcl/stddrive.tcl source ../tcl/slsecho.tcl makesctcontroller slssct slsecho taspmagnet:5001 #makesctcontroller slssct slsecho localhost:8080 slsecho::makeslsecho ma1 5 slssct #slsecho::makeslsecho ma3 2 slssct } set nhq202m 0 if {$nhq202m == 1} { source ../tcl/stddrive.tcl source ../tcl/nhq202m.tcl #makesctcontroller nhq202 charbychar localhost:8005 "\r\n" #makesctcontroller nhq202 charbychar localhost:8080 "\r\n" makesctcontroller nhq202 charbychar psts225:3002 "\r\n" #------- Put him into lovely mode, it needs a few commands before it gets there nhq202 transact \# nhq202 transact \# nhq202 transact \# nhq202 debug 0 nhq202m::makehv hv1 nhq202 1 } set poldizug 0 if {$poldizug == 1} { makesctcontroller zugsct std pc6651:4167 "\r\n" 3.0 "\r\n" zugsct debug 0 source ../tcl/stddrive.tcl source ../sim/poldi_sics/zug.tcl } #MakeSPSS7 s7 203 251 129.129.195.55:2005 #MakeSPSS7 s7 203 251 localhost:8090 set jvl 0 if {$jvl == 1} { source ../sim/boa_sics/jvl.tcl makesctcontroller jvlsct jvl localhost:8080 jvlsct debug -1 jvl::make ja 2 jvlsct -10000 10000 120 } set nanotec 0 if {$nanotec == 1} { source ../sim/boa_sics/nanotec.tcl makesctcontroller nanosct std localhost:8080 \r 1 \r nanosct debug -1 nanotec::make nano 1 nanosct -100000 100000 120 } set agilent 0 if {$agilent == 1} { source ../tcl/stddrive.tcl source ../tmp/agilent.tcl makesctcontroller agi std 129.129.195.78:5025 \n 2 \n \n agilent::make agi } set secmot 1 if {$secmot == 1} { source ../sim/sicscommon/secsim.tcl MakeSecSim eva -40 40 .3 } set zwickroll 0 if {$zwickroll == 1} { source ../tcl/zwickroll.tcl # makesctcontroller zwro std pc8977:50370 \r\n 5 \r\n makesctcontroller zwro std localhost:8080 \r\n 5 \n zwickroll::makezwickroll zwro } set sputter 0 if {$sputter == 1} { source ../sim/sicscommon/stddrive.tcl source ../sim/amor_sics/sputter.tcl SputterInit }