From 3cf7bfbf506c42bc123453ac73e040451c9a3cbf Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Thu, 24 Mar 2011 14:51:13 +1100 Subject: [PATCH] Add RVA SC driver and associated Newport protocol r3081 | dcl | 2011-03-24 14:51:13 +1100 (Thu, 24 Mar 2011) | 1 line --- site_ansto/hardsup/makefile | 21 +- site_ansto/hardsup/sct_newportprot.c | 228 +++++ .../environment/temperature/sct_rvasm2.tcl | 818 ++++++++++++++++++ site_ansto/site_ansto.c | 2 + 4 files changed, 1068 insertions(+), 1 deletion(-) create mode 100644 site_ansto/hardsup/sct_newportprot.c create mode 100644 site_ansto/instrument/config/environment/temperature/sct_rvasm2.tcl diff --git a/site_ansto/hardsup/makefile b/site_ansto/hardsup/makefile index f041b161..a11642a5 100644 --- a/site_ansto/hardsup/makefile +++ b/site_ansto/hardsup/makefile @@ -10,7 +10,26 @@ SRC = . CC = gcc CFLAGS = -g -DLINUX $(DFORTIFY) -I$(SRC) -I../.. $(INC_TCL8) -Wall -Wno-unused -Wextra -HOBJ= nhq200util.o itc4util.o lh45util.o lakeshore340util.o west4100util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o modbustcp.o sct_galilprot.o sct_modbusprot.o sct_oxfordprot.o sct_orhvpsprot.o sct_velselprot.o sct_usbtmcprot.o sct_rfamp.o sinqhttpprot.o sct_protek608.o +HOBJ = nhq200util.o +HOBJ += itc4util.o +HOBJ += lh45util.o +HOBJ += lakeshore340util.o +HOBJ += west4100util.o +HOBJ += asynsrv_utility.o +HOBJ += geterrno.o +HOBJ += strjoin.o +HOBJ += chopper.o +HOBJ += modbustcp.o +HOBJ += sct_galilprot.o +HOBJ += sct_modbusprot.o +HOBJ += sct_oxfordprot.o +HOBJ += sct_newportprot.o +HOBJ += sct_orhvpsprot.o +HOBJ += sct_velselprot.o +HOBJ += sct_usbtmcprot.o +HOBJ += sct_rfamp.o +HOBJ += sinqhttpprot.o +HOBJ += sct_protek608.o libhlib.a: $(HOBJ) rm -f libhlib.a diff --git a/site_ansto/hardsup/sct_newportprot.c b/site_ansto/hardsup/sct_newportprot.c new file mode 100644 index 00000000..aa12d7b5 --- /dev/null +++ b/site_ansto/hardsup/sct_newportprot.c @@ -0,0 +1,228 @@ +/** @file Newport protocol handler for script-context based controllers. +* +* If you 'send' commands to a oxford controller using this protocol you +* will get one of three possible responses, +* 1. A response +* eg +* 2. An acknowledgement (ie 'OK') +* eg +* sct_rva send "STT03E8" +* OK +* 3. An error message +* eg +* sct_mc2 send "BGG" +* ASCERR: 20 Begin not valid with motor off (during read finished) +*/ +#include +#include +#include +#include +#include + +struct NewportProtocol_t { + unsigned int magic; + Ascon* parent; + double last_line_time; + double last_char_time; + double inter_line_time; + double inter_char_time; +}; +typedef struct NewportProtocol_t NewportProtocol; + +/** @brief Set line terminator before sending command +*/ +int NewportWriteStart(Ascon *a) { + NewportProtocol* private; + double now; + int i, len; + char *text; + private = (NewportProtocol*) a->private; + assert(private->magic == 0xcafef00d); + now = DoubleTime(); + if (now < private->last_line_time) { + private->last_line_time = now; + } + private->last_char_time = now; + /* + if (now > private->last_line_time + private->inter_line_time) { + return 1; + } + */ + len = GetDynStringLength(a->wrBuffer); + text = GetCharArray(a->wrBuffer); + if (len < 1 || text[len - 1] != '\r') + DynStringConcat(a->wrBuffer, "\r"); + len = GetDynStringLength(a->wrBuffer); + /* if there is only the terminator, do not send it */ + if (len <= 1) { + a->state = AsconWriteDone; + return 1; + } + a->wrPos = 0; + a->state = AsconWriting; + text = GetCharArray(a->wrBuffer); + for (i = 0; i < len; ++i) + if (islower(text[i])) + text[i] = toupper(text[i]); + return 1; +} + +/** @brief Write the line one character at a time +*/ +int NewportWriting(Ascon *a) { + NewportProtocol* private; + int ret; + double now; + private = (NewportProtocol*) a->private; + assert(private->magic == 0xcafef00d); + now = DoubleTime(); + if (now < private->last_char_time) { + private->last_char_time = now; + } + if (now < private->last_char_time + private->inter_char_time) { + return 1; + } + if (a->wrPos == 0) + AsconReadGarbage(a->fd); + ret = AsconWriteChars(a->fd, GetCharArray(a->wrBuffer) + a->wrPos, 1); + if (ret < 0) { + AsconError(a, "send failed:", errno); + /* + * Ooops: which state shall we go to after a write fail? + * This seems to retry. + */ + } else { + private->last_char_time = now; + a->wrPos += ret; + if (a->wrPos >= GetDynStringLength(a->wrBuffer)) { + private->last_line_time = now; + a->state = AsconWriteDone; + } + } + return 1; +} + +/** @brief Map replies to OK, ASCERR:..., value. +* You can not use the first character to sort replies from a Newport controller +*/ +int NewportReading(Ascon *a) { + int ret; + char chr, ch[2]; + char* cp = NULL; + + ret = AsconReadChar(a->fd, &chr); + while (ret > 0) { + a->start = DoubleTime(); + + DynStringConcatChar(a->rdBuffer, chr); + + ret = AsconReadChar(a->fd, &chr); + } + if (ret < 0) { + AsconError(a, "AsconReadChar failed:", errno); + return 0; + } else { + /* TODO: should always timeout and check for trailing CR */ + double now = DoubleTime(); + char *text = GetCharArray(a->rdBuffer); + int len = GetDynStringLength(a->rdBuffer); + double timeout; + if (len < 5) { + if (a->timeout > 0.0) + timeout = a->timeout; + else + timeout = 1.0; + } else if (text[len - 1] == '\r') { + timeout = 0.1; + } else { + timeout = 0.1; + } + if ((now - a->start) > timeout) { + if (len < 5) { + a->state = AsconTimeout; + AsconError(a, "read timeout", 0); + } else if (text[len - 1] != '\r') { + AsconError(a, "missing terminator", 0); + } else if (len > 5 && text[len - 6] != '\r') { + AsconError(a, "format error", 0); + } else { + int i; + for (i = 0; i < len - 1; ++i) + if (text[i] == '\r') + text[i] = ' '; + text[len - 1] = '\0'; + a->state = AsconReadDone; + } + } + } + return 0; +} + +/** @brief Newport protocol handler. +* This handler formats commands (ie adds cr line terminator) and +* sorts replies into standard responses of +* +* OK +* ASCERR:... +*/ +int NewportProtHandler(Ascon *a) { + int ret; + + switch(a->state){ + case AsconWriteStart: + ret = NewportWriteStart(a); + return ret; + break; + case AsconWriting: + ret = NewportWriting(a); + return ret; + break; + case AsconReadStart: + a->start = DoubleTime(); + ret = AsconStdHandler(a); + return ret; + break; + case AsconReading: + ret = NewportReading(a); + return ret; + break; + default: + ret = AsconStdHandler(a); + return ret; + break; + } + return 1; +} + +void NewportKillPrivate(void *arg) { + NewportProtocol *private = (NewportProtocol *) arg; + assert(private->magic == 0xcafef00d); + assert(private->parent->private == private); + private->magic = 0; + free(arg); +} + +int NewportInit(Ascon *a, SConnection *con, + int argc, char *argv[]) { + NewportProtocol *private; + int ret; + ret = AsconStdInit(a, con, argc, argv); + private = calloc(sizeof(NewportProtocol), 1); + a->private = (void *) private; + private->magic = 0xcafef00d; + private->parent = a; + private->inter_line_time = 0.100; + private->inter_char_time = 0.010; + a->killPrivate = NewportKillPrivate; + return ret; +} + +void AddNewportProtocoll(){ + AsconProtocol *prot = NULL; + + prot = calloc(sizeof(AsconProtocol), 1); + prot->name = strdup("newport"); + prot->init = NewportInit; + prot->handler = NewportProtHandler; + AsconInsertProtocol(prot); +} diff --git a/site_ansto/instrument/config/environment/temperature/sct_rvasm2.tcl b/site_ansto/instrument/config/environment/temperature/sct_rvasm2.tcl new file mode 100644 index 00000000..7aa1cf0a --- /dev/null +++ b/site_ansto/instrument/config/environment/temperature/sct_rvasm2.tcl @@ -0,0 +1,818 @@ +# vim: ts=8 sts=2 sw=2 expandtab si sta +# Script Context Driver for the Perten (Newport Scientific) Rapid Visco Analyzer Starch Master 2 +# or Techmaster - hence the terms Newport, RVA and SM2 or TM in documentation. +# +# Define procs in ::scobj::xxx namespace +# MakeSICSObj $obj SCT_ +# The MakeSICSObj cmd adds a /sics/$obj node. NOTE the /sics node is not browsable. + + +namespace eval ::scobj::newport_rva { +# Temperature controllers must have at least the following nodes +# /tempcont/setpoint +# /tempcont/sensor/value + proc debug_log {args} { + set fd [open "/tmp/newport_rva.log" a] + puts $fd "[clock format [clock seconds] -format "%T"] $args" + close $fd + } + +# issue a command with a value in the target property of the variable + proc setValue {tc_root nextState cmd} { + set par [sct target] + sct send "$cmd $par" +debug_log "setValue $cmd $par" + return $nextState + } + +# issue a command to read a register and expect a value response + proc getValue {tc_root nextState cmd} { +debug_log "getValue $cmd => $nextState" + sct send "$cmd" + return $nextState + } + +# process the response to getValue and save the value + proc rdValue {tc_root} { +debug_log "rdValue [sct] [sct result]" + set data [sct result] + switch -glob -- $data { + "ASCERR:*" { + sct geterror $data + } + default { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + } + } + return idle + } + + proc setTemp {tc_root nextState cmd} { + debug_log "setTemp $tc_root $nextState $cmd [sct]=[sct target] [hget [sct]]" + # ANSTO special temperature + set temp [expr {10.0 * [sct target]}] + set cmd "STT[format %04X [expr {int($temp)}]]" + debug_log "sct send $cmd" + sct send "$cmd" + return $nextState + } + + proc rdTemp {tc_root} { +debug_log "rdTemp [sct] [sct result]" + set data [sct result] + switch -glob -- $data { + "ASCERR:*" { + sct geterror $data + } + default { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set flist [split $data " "] + if {[llength $flist] != 2} { + sct geterror "Field error: expected two fields, received $data" + return idle + } + set data [lindex $flist 0] + set stts [lindex $flist 1] + if {[string length $stts] != 4} { + sct geterror "Length error: expected RSxx but received $data" + } elseif {[string range $stts 0 1] != "RS"} { + sct geterror "Unexpected status: expected RSxx but received $stts" + } elseif {![string is xdigit [string range $stts 2 3]]} { + sct geterror "Hexadecimal error: expected RSxx but received $data" + } elseif {[string length $data] != 7} { + sct geterror "Length error: expected SRTxxxx but received $data" + } elseif {[string range $data 0 2] != "SRT"} { + sct geterror "Unexpected response: expected SRTxxxx but received $data" + } elseif {![string is xdigit [string range $data 3 6]]} { + sct geterror "Hexadecimal error: expected SRTxxxx but received $data" + } else { + debug_log "scan [string range $data 3 6] %4x data" + set rslt [scan [string range $data 3 6] %4x data] + # ANSTO special temp + set data [expr {0.1 * $data}] + debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + } + } + } + return idle + } + + proc setSpeed {tc_root nextState cmd} { + debug_log "setSpeed $tc_root $nextState $cmd [sct]=[sct target] [hget [sct]]" + set speed [sct target] + set cmd "STS[format %04X [expr {int($speed)}]]" + debug_log "sct send $cmd" + sct send $cmd + return $nextState + } + + proc rdSpeed {tc_root} { +debug_log "rdSpeed [sct] [sct result]" + set data [sct result] + switch -glob -- $data { + "ASCERR:*" { + sct geterror $data + } + default { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set flist [split $data " "] + if {[llength $flist] != 2} { + sct geterror "Field error: expected two fields, received $data" + return idle + } + set data [lindex $flist 0] + set stts [lindex $flist 1] + if {[string length $stts] != 4} { + sct geterror "Length error: expected RSxx but received $data" + } elseif {[string range $stts 0 1] != "RS"} { + sct geterror "Unexpected status: expected RSxx but received $stts" + } elseif {![string is xdigit [string range $stts 2 3]]} { + sct geterror "Hexadecimal error: expected RSxx but received $data" + } elseif {[string length $data] != 7} { + sct geterror "Length error: expected SRRxxxx but received $data" + } elseif {[string range $data 0 2] != "SRR"} { + sct geterror "Unexpected response: expected SRRxxxx but received $data" + } elseif {![string is xdigit [string range $data 3 6]]} { + sct geterror "Hexadecimal error: expected SRRxxxx but received $data" + } else { + debug_log "scan [string range $data 3 6] %4x data" + set rslt [scan [string range $data 3 6] %4x data] + debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + } + } + } + return idle + } + + proc rdPower {tc_root} { +debug_log "rdPower [sct] [sct result]" + set data [sct result] + switch -glob -- $data { + "ASCERR:*" { + sct geterror $data + } + default { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set flist [split $data " "] + if {[llength $flist] != 2} { + sct geterror "Field error: expected two fields, received $data" + return idle + } + set data [lindex $flist 0] + set stts [lindex $flist 1] + if {[string length $stts] != 4} { + sct geterror "Length error: expected RSxx but received $data" + } elseif {[string range $stts 0 1] != "RS"} { + sct geterror "Unexpected status: expected RSxx but received $stts" + } elseif {![string is xdigit [string range $stts 2 3]]} { + sct geterror "Hexadecimal error: expected RSxx but received $data" + } elseif {[string length $data] != 5} { + sct geterror "Length error: expected SRCxx but received $data" + } elseif {[string range $data 0 2] != "SRC"} { + sct geterror "Unexpected response: expected SRCxx but received $data" + } elseif {![string is xdigit [string range $data 3 4]]} { + sct geterror "Hexadecimal error: expected SRCxx but received $data" + } else { + debug_log "scan [string range $data 3 4] %4x data" + set rslt [scan [string range $data 3 4] %4x data] + debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + } + } + } + return idle + } + proc rdVisc {tc_root} { +debug_log "rdVisc [sct] [sct result]" + set data [sct result] + switch -glob -- $data { + "ASCERR:*" { + sct geterror $data + } + default { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + set flist [split $data " "] + if {[llength $flist] != 2} { + sct geterror "Field error: expected two fields, received $data" + return idle + } + set data [lindex $flist 0] + set stts [lindex $flist 1] + if {[string length $stts] != 4} { + sct geterror "Length error: expected RSxx but received $data" + } elseif {[string range $stts 0 1] != "RS"} { + sct geterror "Unexpected status: expected RSxx but received $stts" + } elseif {![string is xdigit [string range $stts 2 3]]} { + sct geterror "Hexadecimal error: expected RSxx but received $data" + } elseif {[string length $data] != 9} { + sct geterror "Length error: expected SRIxxxxxx but received $data" + } elseif {[string range $data 0 2] != "SRI"} { + sct geterror "Unexpected response: expected SRIxxxxxx but received $data" + } elseif {![string is xdigit [string range $data 3 8]]} { + sct geterror "Hexadecimal error: expected SRIxxxxxx but received $data" + } else { + debug_log "scan [string range $data 3 8] %6x data" + set rslt [scan [string range $data 3 8] %6x data] + debug_log "scan result rslt=$rslt, data=$data, oldval=[sct oldval]" + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + } + } + } + return idle + } + + proc getState {tc_root nextState cmd} { + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + debug_log "getState $tc_root $nextState $cmd sct=[sct]" + if {[ catch { + set my_state [SplitReply [hgetprop $tc_root/device_state state]] + set my_substate [SplitReply [hgetprop $tc_root/device_state substate]] + if {$my_state == "STATE_LT"} { + set my_cmd "LT..." + } elseif {$my_state == "STATE_RT"} { + set my_cmd "RTF" + } elseif {$my_state == "STATE_RD"} { + set my_cmd "RD..." + } elseif {$my_state == "STATE_LOAD"} { + set my_cmd "RTC" + } elseif {$my_state == "STATE_LOADED"} { + set my_cmd "RTC" + } elseif {$my_state == "STATE_LOADING"} { + set table [split " " [SplitReply [hgetprop $tc_root/device_state profile_table]]] + set tablen [llength $table] + if {$my_substate < 0 || $my_substate >= $tablen} { + # TODO ERROR handling + } + set my_cmd [lindex $table $my_substate] + } elseif {$my_state == "STATE_INIT"} { + if {$my_substate == 0} { + set my_cmd "SEC04" + } elseif {$my_substate == 1} { + set my_cmd "RSV" + } elseif {$my_substate == 2} { + set my_cmd "STT..." + } + } else { + hsetprop $tc_root/device_state state "STATE_INIT" + hsetprop $tc_root/device_state substate "0" + set my_cmd "SEC04" + } + sct send "$my_cmd" + } catch_message ]} { + debug_log "getState error: $catch_message" + } + return $nextState + } + + ## + # @brief Reads the current newport state and error messages. + proc rdState {tc_root} { +debug_log "rdState [sct] [sct result]" + set data [sct result] + set my_driving [SplitReply [hgetprop $tc_root/setpoint driving]] + debug_log "rdState $tc_root: driving=$my_driving, result=$data" + if {[ catch { + set my_state [SplitReply [hgetprop $tc_root/device_state my_state]] + if {$my_state == "STATE_LT"} { + set parts [split [sct result] " "] + if {[llength $parts] == 2 && [lindex $parts end] == "LT00" && [string range [lindex $parts 0] 0 1] == "TL"} { + set index [string range [lindex $parts 0] 2 3] + } else { + debug_log "Load Table error: [sct result]" + } + } elseif {$my_state == "STATE_RT"} { + set parts [split [sct result] " "] + if {[llength $parts] >= 2 && [lindex $parts end] == "RT00"} { + set parts [lreplace $parts end end] + # TODO process the data + } else { + debug_log "Read Table error: [sct result]" + } + } elseif {$my_state == "STATE_RD"} { + set parts [split [sct result] " "] + if {[llength $parts] >= 2 && [lindex $parts end] == "RD00"} { + set parts [lreplace $parts end end] + debug_log "scan [lindex $parts 0] DR%6x%4x%6x%2x%4x%2x the_t the_c the_v the_e the_s the_r" + set rslt [scan [lindex $parts 0] "DR%6x%4x%6x%2x%4x%2x" the_t the_c the_v the_e the_s the_r] + debug_log "scan result rslt=$rslt, the_t=$the_t , the_c=$the_c , the_v=$the_v , the_e=$the_e , the_s=$the_s , the_r=$the_r" + if {$rslt == 6} { + # TODO process the data and increment through to list? + } else { + debug_log "Read Data format error: [sct result]" + } + } else { + debug_log "Read Data error: [sct result]" + } + } elseif {$my_state == "STATE_INIT"} { + set parts [split [sct result] " "] + if {[llength $parts] == 2 && [lindex $parts end] == "RD00"} { + set parts [lreplace $parts end end] + debug_log "scan [lindex $parts 0] DR%6x%4x%6x%2x%4x%2x the_t the_c the_v the_e the_s the_r" + set rslt [scan [lindex $parts 0] "DR%6x%4x%6x%2x%4x%2x" the_t the_c the_v the_e the_s the_r] + debug_log "scan result rslt=$rslt, the_t=$the_t , the_c=$the_c , the_v=$the_v , the_e=$the_e , the_s=$the_s , the_r=$the_r" + if {$rslt == 6} { + # TODO handle the data, test start, test end + sct print "[lindex $parts 0]" + } else { + debug_log "Read Data format error: [sct result]" + } + } else { + debug_log "Read Data error: [sct result]" + } + } elseif {$my_state == "STATE_LOAD"} { + # TODO + hsetprop $tc_root/device_state state "STATE_LOADING" + hsetprop $tc_root/device_state substate "0" + return read + } elseif {$my_state == "STATE_LOADING"} { + # TODO + set my_substate [SplitReply [hgetprop $tc_root/device_state substate]] + set table [split " " [SplitReply [hgetprop $tc_root/device_state profile_table]]] + set tablen [llength $table] + if {$my_substate < 0 || $my_substate >= $tablen} { + # TODO ERROR handling + } elseif {$my_substate == $tablen} { + hsetprop $tc_root/device_state state "STATE_LOADED" + hsetprop $tc_root/device_state substate "0" + } else { + hsetprop $tc_root/device_state substate [expr {[SplitReply [hgetprop $tc_root/device_state substate]] + 1}] + } + return read + } elseif {$my_state == "STATE_LOADED"} { + # TODO + hsetprop $tc_root/device_state state "STATE_LOADING" + hsetprop $tc_root/device_state substate "0" + return read + } else { + hsetprop $tc_root/device_state state "STATE_IDLE" + hsetprop $tc_root/device_state substate "0" + return idle + } + } catch_message ]} { + debug_log "getState error: $catch_message" + } + + set data [SplitReply [hgetprop $tc_root/setpoint driving]] + debug_log "rdState $tc_root: result=$data" + if {[string first "ASCERR:" $data] >=0} { + sct geterror $data + } elseif {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + return idle + } + + proc getHP {tc_root nextState cmd} { + set data [hval $tc_root/Loop1/power] + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + debug_log "getHP $tc_root $nextState $cmd [sct] $data" + return idle + } + + proc getPV {tc_root nextState cmd} { + set data [hval $tc_root/Loop1/sensor] + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime + } + debug_log "getPV $tc_root $nextState $cmd [sct] $data" + return idle + } + + proc setPoint {tc_root nextState cmd} { + set par [sct target] + + if {[sct writestatus] == "start"} { + # Called by drive adapter + hset $tc_root/status "busy" + hsetprop $tc_root/setpoint driving 1 + } + sct send "$cmd $par" +debug_log "setPoint $cmd $par" + return $nextState + } + + proc setProf {tc_root nextState cmd} { + debug_log "setProf $tc_root [sct] [sct target]" + sct print "setProf $tc_root [sct] [sct target]" + sct print "Value: [hval [sct]]" + sct print "Props: [hlistprop [sct]]" + set my_index [sct index] + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if {$my_index < 0} { + if {"[sct target]" != "[hval [sct]]"} { + set lines [list] + if {[file exists "[sct target]"] && [file readable "[sct target]"]} { + sct print "opening [file normalize "[sct target]"]" + set f [open "[sct target]"] + while {1} { + set line [gets $f] + if {[eof $f]} { + close $f + break + } + if {[string range $line 0 1] != "LT"} { + sct geterror "Profile error: $line" + sct print "Profile error: $line" + close $f + return idle + } + lappend lines $line + } + sct profile "[join $lines " "]" + sct oldval [sct target] + sct update [sct target] + sct utime readtime + } else { + sct geterror "file [sct target] is [file normalize "[sct target]"], exists: [file exists "[sct target]"], readable: [file readable "[sct target]"]" + sct print "file [sct target] is [file normalize "[sct target]"], exists: [file exists "[sct target]"], readable: [file readable "[sct target]"]" + return idle + } + } + sct send "RTC" + } else { + set my_list [split [sct profile] " "] + set my_item [lindex $my_list $my_index] + sct send "$my_item" + } + return $nextState + } + + proc ackProf {tc_root} { + debug_log "ackProf $tc_root [sct result]" + sct print "ackProf $tc_root [sct] [sct result]" + sct print "Value: [hval [sct]]" + sct print "Props: [hlistprop [sct]]" + set my_index [sct index] + if { [hpropexists [sct] geterror] } { + hdelprop [sct] geterror + } + if {$my_index < 0} { + # TODO Check response to RTC + sct print "RTC=>[sct result]" + } else { + # TODO Check response to LT... + sct print "LT=>[sct result]" + } + set my_list [split [sct profile] " "] + set my_index [expr {$my_index + 1}] + sct index $my_index + if {$my_index > [llength $my_list]} { + sct index -1 + return idle + } + set my_item [lindex $my_list $my_index] + return write + } + + proc chkWrite {tc_root} { + set data [sct result] +debug_log "chkWrite resp=$data sct=[sct] tc_root=$tc_root" + if {[string equal -nocase -length 7 $data "ASCERR:"]} { + sct geterror "$data" + } elseif {[string equal -nocase -length 1 $data "?"]} { + sct geterror "Error: $data" + } else { + set data [sct target] + if {$data != [sct oldval]} { + sct oldval $data + sct update $data + sct utime readtime +debug_log "chkWrite new data for $tc_root [sct] result=$data" + } + } + return idle + } + + proc noResponse {} { + return idle + } + +# check that a target is within allowable limits + proc check {tc_root} { + set setpoint [sct target] + set lolimit [hval $tc_root/lowerlimit] + set hilimit [hval $tc_root/upperlimit] + if {$setpoint < $lolimit || $setpoint > $hilimit} { + error "setpoint violates limits" + } + return OK + } + +# Check that the sensor is reading within tolerance of the setpoint. +# Return 1 or 0 if it is or is not, respectively. + proc checktol {tc_root currtime timecheck} { +debug_log "checktol $tc_root $currtime $timecheck" + set temp [hval $tc_root/sensor/value] + set lotemp [hval $tc_root/subtemp_warnlimit] + set hitemp [hval $tc_root/overtemp_warnlimit] + if { $temp < $lotemp || $temp > $hitemp} { + hset $tc_root/emon/isintol 0 + return 0 + } else { + set timeout [hval $tc_root/tolerance/settletime] + if { ($currtime - $timecheck) > $timeout } { + hset $tc_root/emon/isintol 1 + } + return 1 + } + } + +## +# @brief Implement the checkstatus command for the drivable interface +# +# NOTE: The drive adapter initially sets the writestatus to "start" and will +# only call this when writestatus!="start" + proc drivestatus {tc_root} { + if {[sct driving]} { + return busy + } else { + sct print "drivestatus: idle" + return idle + } + } + + proc halt {tc_root} { +debug_log "halt $tc_root" + hset $tc_root/setpoint [hval $tc_root/sensor/value] + hsetprop $tc_root/setpoint driving 0 + return idle + } + +## +# @brief createNode() creates a node for the given nodename with the properties and virtual +# function names provided +# @param scobj_hpath string variable holding the path to the object's base node in sics (/sample/tc1) +# @param sct_controller name of the scriptcontext object (typically sct_xxx_yyy) +# @param cmdGroup subdirectory (below /sample/tc*/) in which the node is to be created +# @param varName name of the actual node typically representing one device command +# @param readable set to 1 if the node represents a query command, 0 if it is not +# @param writable set to 1 if the node represents a request for a change in settings sent to the device +# @param drivable if set to 1 it prepares the node to provide a drivable interface +# @param dataType data type of the node, must be one of none, int, float, text +# @param permission defines what user group may read/write to this node (is one of spy, user, manager) +# @param rdCmd actual device query command to be sent to the device +# @param rdFunc nextState Function to be called after the getValue function, typically rdValue() +# @param wrCmd actual device write command to be sent to the device +# @param wrFunc Function to be called to send the wrCmd to the device, typically setValue() +# @param allowedValues allowed values for the node data - does not permit other +# @param klass Nexus class name (?) +# @return OK +proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\ + drivable dataType permission rdCmd rdFunc wrCmd\ + wrFunc allowedValues klass} { + + set catch_status [ catch { +# set ns ::scobj::ls460 + set ns "[namespace current]" + set nodeName "$scobj_hpath/$cmdGroup/$varName" + if {1 > [string length $cmdGroup]} { + set nodeName "$scobj_hpath/$varName" + } + debug_log "Creating node $nodeName" + hfactory $nodeName plain $permission $dataType + if {$readable > 0} { + set parts [split "$rdFunc" "."] + if { [llength $parts] == 2 } { + set func_name [lindex $parts 0] + set next_state [lindex $parts 1] + hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $next_state $rdCmd + hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath + } else { + set func_name "getValue" + hsetprop $nodeName read ${ns}::$func_name $scobj_hpath $rdFunc $rdCmd + hsetprop $nodeName $rdFunc ${ns}::$rdFunc $scobj_hpath + } + set poll_period 30 + if { $readable >= 0 && $readable <= 9 } { + set poll_period [lindex [list 0 1 2 3 4 5 10 15 20 30] $readable] + } + debug_log "Registering node $nodeName for poll at $poll_period seconds" + $sct_controller poll $nodeName $poll_period + } + if {$writable == 1} { + set parts [split "$wrFunc" "."] + if { [llength $parts] == 2 } { + set func_name [lindex $parts 0] + set next_state [lindex $parts 1] + hsetprop $nodeName write ${ns}::$func_name $scobj_hpath $next_state $wrCmd + hsetprop $nodeName $next_state ${ns}::$next_state $scobj_hpath + } else { + hsetprop $nodeName write ${ns}::$wrFunc $scobj_hpath noResponse $wrCmd + hsetprop $nodeName noResponse ${ns}::noResponse + } + hsetprop $nodeName writestatus UNKNOWN + debug_log "Registering node $nodeName for write callback" + $sct_controller write $nodeName + } + switch -exact $dataType { + "none" { } + "int" { hsetprop $nodeName oldval -1 } + "float" { hsetprop $nodeName oldval -1.0 } + default { hsetprop $nodeName oldval UNKNOWN } + } + if {1 < [string length $allowedValues]} { + hsetprop $nodeName values $allowedValues + } + # Drive adapter interface + if {$drivable == 1} { + hsetprop $nodeName check ${ns}::check $scobj_hpath + hsetprop $nodeName driving 0 + hsetprop $nodeName checklimits ${ns}::check $scobj_hpath + hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath + hsetprop $nodeName halt ${ns}::halt $scobj_hpath + } else { + hsetprop $nodeName driving 0 + } + } message ] + if {$catch_status != 0} { + return -code error "in createNode $message" + } + return OK +} + + proc mk_sct_newport_rva {sct_controller klass tempobj tol} { + set catch_status [ catch { + set ns "[namespace current]" + + MakeSICSObj $tempobj SCT_OBJECT + sicslist setatt $tempobj klass $klass + sicslist setatt $tempobj long_name $tempobj + + set scobj_hpath /sics/$tempobj + + set deviceCommand {\ + sensor value 1 0 0 float user {RST} {rdTemp} {0} {} {}\ + {} setpoint 0 1 0 float user {} {} {0} {setTemp.chkWrite} {}\ + {} speed 1 1 0 float user {RSR} {rdSpeed} {0} {setSpeed.chkWrite} {}\ + {} power 1 0 0 float internal {RSC} {rdPower} {0} {} {}\ + {} viscosity 1 0 0 float internal {RSI} {rdVisc} {0} {} {}\ + {} profile 0 1 0 text user {RTF} {rdProf} {0} {setProf.ackProf} {}\ + } + + hfactory $scobj_hpath/sensor plain spy none + hfactory $scobj_hpath/Loop1 plain spy none + + foreach {cmdGroup varName readable writable drivable dataType permission rdCmd rdFunc wrCmd wrFunc allowedValues} $deviceCommand { + createNode $scobj_hpath $sct_controller $cmdGroup $varName $readable $writable $drivable $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc $allowedValues $klass + } + + hsetprop $scobj_hpath/sensor/value lowerlimit 0 + hsetprop $scobj_hpath/sensor/value upperlimit 500 + hsetprop $scobj_hpath/sensor/value units "C" + + hfactory $scobj_hpath/apply_tolerance plain user int + hsetprop $scobj_hpath/apply_tolerance values 0,1 + hset $scobj_hpath/apply_tolerance 1 + + hfactory $scobj_hpath/tolerance plain user float + hsetprop $scobj_hpath/tolerance units "C" + hfactory $scobj_hpath/tolerance/settletime plain user float + hset $scobj_hpath/tolerance/settletime 5.0 + hsetprop $scobj_hpath/tolerance/settletime units "s" + hset $scobj_hpath/tolerance $tol + + hfactory $scobj_hpath/status plain spy text + hset $scobj_hpath/status "idle" + hsetprop $scobj_hpath/status values busy,idle + + hfactory $scobj_hpath/device_state plain spy text + hsetprop $scobj_hpath/device_state read ${ns}::getState $scobj_hpath rdState "NOT USED" + hsetprop $scobj_hpath/device_state rdState ${ns}::rdState $scobj_hpath + hsetprop $scobj_hpath/device_state oldval UNKNOWN + hsetprop $scobj_hpath/device_state state "STATE_INIT" + hsetprop $scobj_hpath/device_state substate "0" + hsetprop $scobj_hpath/device_state profile_table "" + + hfactory $scobj_hpath/remote_ctrl plain spy text + hset $scobj_hpath/remote_ctrl UNKNOWN + + hfactory $scobj_hpath/device_lasterror plain user text + hset $scobj_hpath/device_lasterror "" + + hfactory $scobj_hpath/lowerlimit plain mugger float + hsetprop $scobj_hpath/lowerlimit units "C" + hset $scobj_hpath/lowerlimit 0 + + hfactory $scobj_hpath/upperlimit plain mugger float + hsetprop $scobj_hpath/upperlimit units "C" + hset $scobj_hpath/upperlimit 500 + + hfactory $scobj_hpath/emon plain spy none + hfactory $scobj_hpath/emon/monmode plain user text + hsetprop $scobj_hpath/emon/monmode values idle,drive,monitor,error + hset $scobj_hpath/emon/monmode "idle" + hfactory $scobj_hpath/emon/isintol plain user int + hset $scobj_hpath/emon/isintol 1 + hfactory $scobj_hpath/emon/errhandler plain user text + hset $scobj_hpath/emon/errhandler "pause" + + hsetprop $scobj_hpath/profile index -1 + + if {[SplitReply [environment_simulation]]=="false"} { + $sct_controller poll $scobj_hpath/device_state 1 halt read + } + + ::scobj::hinitprops $tempobj + hsetprop $scobj_hpath klass NXenvironment + ::scobj::set_required_props $scobj_hpath + foreach {rootpath hpath klass priv} " + $scobj_hpath sensor NXsensor spy + $scobj_hpath sensor/value sensor user + " { + hsetprop $rootpath/$hpath klass $klass + hsetprop $rootpath/$hpath privilege $priv + hsetprop $rootpath/$hpath control true + hsetprop $rootpath/$hpath data true + hsetprop $rootpath/$hpath nxsave true + } + hsetprop $scobj_hpath type part + hsetprop $scobj_hpath/sensor type part + hsetprop $scobj_hpath/sensor/value nxalias tc1_sensor_value + hsetprop $scobj_hpath/sensor/value mutable true + hsetprop $scobj_hpath/sensor/value sdsinfo ::nexus::scobj::sdsinfo + + hsetprop $scobj_hpath privilege spy + ::scobj::hinitprops $tempobj setpoint + hsetprop $scobj_hpath/setpoint data true + if {[SplitReply [environment_simulation]]=="false"} { + ansto_makesctdrive ${tempobj}_driveable $scobj_hpath/setpoint $scobj_hpath/sensor/value $sct_controller + } + } catch_message ] + if {$catch_status != 0} { + return -code error $catch_message + } + } + namespace export mk_sct_newport_rva +} + +## +# @brief Create a Newport Rapid Visco Analyzer +# +# @param name, the name of the temperature controller (eg tc1) +# @param IP, the IP address of the device, this can be a hostname, (eg ca5-kowari) +# @param port, the IP protocol port number of the device (502 for modbus) +# @param _tol (optional), this is the initial tolerance setting +proc add_newport_rva {name IP port {_tol 5.0}} { + set fd [open "/tmp/newport_rva.log" a] + if {[SplitReply [environment_simulation]]=="false"} { + puts $fd "makesctcontroller sct_${name} newport ${IP}:$port" + makesctcontroller sct_${name} newport ${IP}:$port + } +puts $fd "mk_sct_newport_rva sct_${name} environment $name $_tol" +mk_sct_newport_rva sct_${name} environment $name $_tol +# puts $fd "makesctemon $name /sics/$name/emon/monmode /sics/$name/emon/isintol /sics/$name/emon/errhandler" +# makesctemon $name /sics/$name/emon/monmode /sics/$name/emon/isintol /sics/$name/emon/errhandler + close $fd +} + +puts stdout "file evaluation of sct_newport_rva.tcl" +set fd [open "/tmp/newport_rva.log" w] +puts $fd "file evaluation of sct_newport_rva.tcl" +close $fd + +namespace import ::scobj::newport_rva::* diff --git a/site_ansto/site_ansto.c b/site_ansto/site_ansto.c index f6ebaaad..1c2e3c39 100644 --- a/site_ansto/site_ansto.c +++ b/site_ansto/site_ansto.c @@ -58,6 +58,7 @@ extern pCodri MakeTcpDoChoDriver(char *tclArray, SConnection *pCon); extern void AddGalilProtocoll(); extern void AddModbusProtocoll(); extern void AddOxfordProtocoll(); +extern void AddNewportProtocoll(); extern void AddOrdHVPSProtocoll(); extern void AddVelSelProtocol(); extern void AddUSBTMCProtocoll(); @@ -77,6 +78,7 @@ void SiteInit(void) { AddGalilProtocoll(); AddModbusProtocoll(); AddOxfordProtocoll(); + AddNewportProtocoll(); AddOrdHVPSProtocoll(); AddVelSelProtocol(); AddUSBTMCProtocoll();