- Changed strncpy to strlcpy, strncat to strlcat
- Added strlcpy and strlcat to SICS - Added a driver for the POLDI power supplies SKIPPED: psi/A1931.c psi/autowin.c psi/bruker.c psi/docho.c psi/dornier2.c psi/dspcode.c psi/ease.c psi/ecb.c psi/ecbcounter.c psi/ecbdriv.c psi/el734dc.c psi/el734driv.c psi/el734hp.c psi/el737driv.c psi/el737hpdriv.c psi/el737hpdrivsps.c psi/el737hpv2driv.c psi/el755driv.c psi/eurodriv.c psi/haakedriv.c psi/itc4driv.c psi/julcho.c psi/linadriv.c psi/lmd200.c psi/lscsupport.c psi/ltc11.c psi/make_gen psi/oicom.c psi/oxinst.c psi/pimotor.c psi/pipiezo.c psi/polterwrite.c psi/psi.c psi/sanscook.c psi/sanslirebin.c psi/sanswave.c psi/sinqhmdriv.c psi/sinqhttp.c psi/slsecho.c psi/slsmagnet.c psi/slsvme.c psi/sps.c psi/swmotor.c psi/swmotor2.c psi/tabledrive.c psi/tasscan.c psi/tdchm.c psi/velodorn.c psi/velodornier.c
This commit is contained in:
145
tcl/nhq202m.tcl
Normal file
145
tcl/nhq202m.tcl
Normal file
@ -0,0 +1,145 @@
|
||||
#----------------------------------------------------------
|
||||
# This is a scriptcontext driver for a NHQ 202M high
|
||||
# voltage power supply as used at the POLDI for the
|
||||
# detector. This has a peculiar protocol and requires the
|
||||
# charbychar protocol driver.
|
||||
#
|
||||
# If this responds only with ?WCN, then it is on the wrong
|
||||
# channel.
|
||||
#
|
||||
# Mark Koennecke, April 2010
|
||||
#--------------------------------------------------------
|
||||
|
||||
namespace eval nhq202m {}
|
||||
|
||||
#-------------------------------------------------------
|
||||
# Sometimes numbers come in the form: polarity/mantissse/exponent
|
||||
# This checks for this and converts it into a proper number
|
||||
#-------------------------------------------------------
|
||||
proc nhq202m::fixnumber {num} {
|
||||
set c [string index $num 0]
|
||||
if {[string compare $c -] == 0} {
|
||||
set num [string range $num 1 end]
|
||||
}
|
||||
clientput $num
|
||||
if {[string first - $num] > 0} {
|
||||
set l [split $num -]
|
||||
set man [string trimleft [lindex $l 0] 0]
|
||||
set exp [string trimleft [lindex $l 1] 0]
|
||||
clientput "$num, $man, $exp"
|
||||
return [expr $man * pow(10,-$exp)]
|
||||
} elseif { [string first + $num] > 0} {
|
||||
set l [split $num +]
|
||||
set man [string trimleft [lindex $l 0] 0]
|
||||
set exp [string trimleft [lindex $l 1] 0]
|
||||
return [expr $man * pow(10,$exp)]
|
||||
} else {
|
||||
return $num
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc nhq202m::sendreadcommand {command} {
|
||||
sct send $command
|
||||
return readreply
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc nhq202m::readreply {} {
|
||||
set val [sct result]
|
||||
if {[string first ? $val] >= 0} {
|
||||
clientput "Read Command not understood, result = $val"
|
||||
} else {
|
||||
sct update [nhq202m::fixnumber $val]
|
||||
}
|
||||
return idle
|
||||
}
|
||||
#--------------------------------------------------------
|
||||
proc nhq202m::sendwrite {command} {
|
||||
set val [sct target]
|
||||
sct send [format "%s=%d" $command $val]
|
||||
return writereply
|
||||
}
|
||||
#------------------------------------------------------
|
||||
proc nhq202m::writereply {} {
|
||||
set val [sct result]
|
||||
if {[string first ? $val] >= 0} {
|
||||
clientput "Write command not understood, result = $val"
|
||||
}
|
||||
[sct controller] queue [sct] progress read
|
||||
return idle
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc nhq202m::startwrite {} {
|
||||
hupdate [sct]/stop 0
|
||||
set num [sct numpower]
|
||||
set com [format "D%1.1d" $num]
|
||||
nhq202m::sendwrite $com
|
||||
return setreply
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc nhq202m::setreply {} {
|
||||
set val [sct result]
|
||||
if {[string first ? $val] >= 0} {
|
||||
clientput "Write command not understood, result = $val"
|
||||
}
|
||||
set num [sct numpower]
|
||||
sct send [format "G%1.1d" $num]
|
||||
return goreply
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc nhq202m::goreply {} {
|
||||
set badcodes [list MAN ERR OFF]
|
||||
set val [sct result]
|
||||
if {[string first ? $val] >= 0} {
|
||||
clientput "Write command not understood, result = $val"
|
||||
}
|
||||
set l [split $val =]
|
||||
set code [string trim [lindex $l 1]]
|
||||
if {[lsearch $badcodes $code] >= 0} {
|
||||
hupdate [sct]/stop 1
|
||||
error "Bad code in $val, probably front panel switches fucked up"
|
||||
}
|
||||
return idle
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc nhq202m::makehv {name sct num} {
|
||||
makesctdriveobj $name float mugger NHQ202M $sct
|
||||
hfactory /sics/${name}/tolerance plain mugger int
|
||||
hset /sics/${name}/tolerance 2
|
||||
hfactory /sics/${name}/upperlimit plain mugger int
|
||||
hset /sics/${name}/upperlimit 4000
|
||||
hfactory /sics/${name}/lowerlimit plain mugger int
|
||||
hset /sics/${name}/lowerlimit 0
|
||||
hfactory /sics/${name}/stop plain mugger int
|
||||
hset /sics/${name}/stop 0
|
||||
|
||||
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
|
||||
hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
|
||||
hsetprop /sics/${name} halt stddrive::stop $name
|
||||
|
||||
hsetprop /sics/${name} read nhq202m::sendreadcommand [format "U%1.1d" $num]
|
||||
hsetprop /sics/${name} readreply nhq202m::readreply
|
||||
hsetprop /sics/${name} numpower $num
|
||||
hsetprop /sics/${name} write nhq202m::startwrite
|
||||
hsetprop /sics/${name} setreply nhq202m::setreply
|
||||
hsetprop /sics/${name} goreply nhq202m::goreply
|
||||
$sct write /sics/${name}
|
||||
$sct poll /sics/${name} 180
|
||||
$sct queue /sics/${name} progress read
|
||||
|
||||
hfactory /sics/${name}/ramp plain mugger int
|
||||
hsetprop /sics/${name}/ramp read nhq202m::sendreadcommand [format "V%1.1d" $num]
|
||||
hsetprop /sics/${name}/ramp readreply nhq202m::readreply
|
||||
hsetprop /sics/${name}/ramp write nhq202m::sendwrite [format "V%1.1d" $num]
|
||||
hsetprop /sics/${name}/ramp writereply nhq202m::writereply
|
||||
$sct poll /sics/${name}/ramp 180
|
||||
$sct write /sics/${name}/ramp
|
||||
$sct queue /sics/${name}/ramp progress read
|
||||
|
||||
|
||||
hfactory /sics/${name}/current plain mugger int
|
||||
hsetprop /sics/${name}/current read nhq202m::sendreadcommand [format "N%1.1d" $num]
|
||||
hsetprop /sics/${name}/current readreply nhq202m::readreply
|
||||
$sct poll /sics/${name}/current 180
|
||||
$sct queue /sics/${name}/current progress read
|
||||
|
||||
}
|
@ -24,6 +24,7 @@ proc slsecho::readreply {} {
|
||||
#--------------------------------------------------------------
|
||||
proc slsecho::sendwrite {num} {
|
||||
set val [sct target]
|
||||
hupdate [sct]/stop 0
|
||||
sct send "$num:w:0x90:$val:write"
|
||||
return readreply
|
||||
}
|
||||
@ -87,7 +88,7 @@ proc slsecho::errorreply {} {
|
||||
set reply [sct result]
|
||||
set l [split $reply :]
|
||||
set val [lindex $l 1]
|
||||
set key [format "0x%x" $val]
|
||||
set key [format "0x%x" [expr int($val)]]
|
||||
clientput "$key"
|
||||
clientput "$slsecho::error($key)"
|
||||
sct update $slsecho::error($key)
|
||||
@ -102,7 +103,7 @@ proc slsecho::makeslsecho {name num sct} {
|
||||
hset /sics/${name}/upperlimit 10
|
||||
hfactory /sics/${name}/lowerlimit plain internal float
|
||||
hset /sics/${name}/lowerlimit -10
|
||||
hfactory /sics/${name}/stop plain internal int
|
||||
hfactory /sics/${name}/stop plain user int
|
||||
hset /sics/${name}/stop 0
|
||||
|
||||
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
|
||||
|
@ -50,7 +50,7 @@ proc stddrive::stdstatus {name} {
|
||||
#-------------------------------------------------------
|
||||
proc stddrive::stop {name} {
|
||||
hset /sics/${name}/stop 1
|
||||
return OK
|
||||
return idle
|
||||
}
|
||||
#-------------------------------------------------------
|
||||
proc stddrive::deread {} {
|
||||
@ -87,7 +87,7 @@ proc stddrive::makestddrive {name sicsclass sct} {
|
||||
hset /sics/${name}/upperlimit 300
|
||||
hfactory /sics/${name}/lowerlimit plain user float
|
||||
hset /sics/${name}/lowerlimit 10
|
||||
hfactory /sics/${name}/stop plain internal int
|
||||
hfactory /sics/${name}/stop plain user int
|
||||
hset /sics/${name}/stop 0
|
||||
|
||||
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
|
||||
|
Reference in New Issue
Block a user