linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

sct_protek608.c

Browse Source 
Implements a protocol handler for the protek  608 multimeters which just allows us to read the display.
It reports all elements of the display including the bar graph, it does not provide remote control of the multimeter.  The protocol handler broadcasts a warning to all clients if the auto-off function is enabled.

sct_rfamp.c
This is a protocol handler for the Mirrortron 35V 7A AC Generator (ANSFR-83B).

sinqhttpprot.c
Copied the PSI script context http protocol handler.

sct_orhvpsprot.c
Ordela high voltage power supply protocol handler now catches unknown commands.

sct_eurotherm_2000.tcl
Eurotherm controller for the kowari load frame by Douglas Clowes.

sct_lakeshore_3xx.tcl
Latest update from Arndt.  The two control loops are now independent, settletime and tolerance now work properly.

common_instrument_dictionary.tcl
Make instrument/status saveable.

sct_orhvps_common.tcl
Provides voltage ramping and implements the dhv1 command for the Ordela HVPS via the sct_orhpsprot.c protocol handler.

hmm_configuration_common_1.tcl
Adds new "histmem clockscale" subcommand to get and set the clock scale from the fat_clock_scale FAT parameter.
You can now upload the FAT FRAME_BUFFER and FRAME_DUTYCYCLE parameters to the histogram memory.
The veto commands are now "histmem veto on" and "histmem veto off".

hmm_object.tcl
The axis order for the histmem object has been restore to t,y,x

sct_positmotor_common.tcl
Code has been simplified.

nxscripts_common_1.tcl
Removed obsolete ::nexus::data function.  TOF axis now correctly report time_of_flight instead of "time".

plc_common_1.tcl
Make PLC info saveable.

scan_common_1.tcl
SICS-385 The scan command should check the final scan variable value against he soft upper and lower limits, not against the hard limits.
Make sure that the scan variable axis is saved.

platypus, kowari, quokka hmm_configuration.tcl
Use the HOR and VER entries in the new histmem_axes hash to select the horizontal and vertical axes for the histmem.

kowari motor_configuration.tcl secondary_slit_configuration.tcl
Flatten slits motor structure to match old layout in data files.

quokka commands.tcl
SICS-380 EApPosYmm -> EApPosY

quokka detector.tcl
Use new script context controller for Ordela HVPS

quokka hmm_configuration.tcl
Set detector height to 5.08*192 the same as the width

quokka motor_configuration.tcl
Code cleanup

quokka positmotor_configuration.tcl
Use new positmotor code.

quokka aperture_configuration.tcl
Added attenuation factor column to AttRotLookupTable

quokka parameters.tcl
SICS-380 Refactor nexus, remove redundant parameters.

site_ansto.c
Added the following protocols, Httpl, Protek608, aand RFAmp.

scriptcontext.c
SICS-386 SctActionHandler: set "send" string to NULL when a chain of scripts completes with state=idle.
It turns out that if none of the scripts in the "read chain" call [sct send] each time the chain is executed, then SICS will hammer the device with calls to AsconWrite(). This can be avoided if SctActionHandler sets the 'send' string to NULL before "goto finish" in the idle state. This will be safer and still let you have chains with multiple [sct send] and read scripts.

asyncprotocol.c
Fix platypus memory leak.

devser.c
SICS-387 Started adding code to pass signals on to script context drivers.

ascon.c
AsconTask(): Make sure we return to the AsconIdle state when sending a command which expect no response, also only reconnect if there is a Timeout when there has been an error.

r2888 | ffr | 2010-04-19 14:04:41 +1000 (Mon, 19 Apr 2010) | 90 lines
This commit is contained in:
Ferdi Franceschini
2010-04-19 14:04:41 +10:00
committed by Douglas Clowes
parent aa6bb7f1da
commit d9da95a5df
35 changed files with 3936 additions and 2477 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
ascon.c
View File

@@ -469,6 +469,7 @@ AsconStatus AsconTask(Ascon *a) {
return AsconReady;
case AsconWriteDone:
if (a->noResponse) {
a->state = AsconIdle;
return AsconReady;
}
a->state = AsconReadStart;
@@ -485,7 +486,7 @@ AsconStatus AsconTask(Ascon *a) {
case AsconStart:
return AsconPending;
case AsconFailed:
if (a->state != AsconTimeout) {
if (a->state == AsconTimeout) {
now = DoubleTime();
if (now > a->lastReconnect + a->reconnectInterval) {
a->lastReconnect = now;

7
asyncprotocol.c
View File

@@ -99,13 +99,6 @@ int defaultPrepareTxn(pAsyncProtocol p, pAsyncTxn txn, const char* cmd, int cmd_
if(txn->inp_buf != NULL){
free(txn->inp_buf);
}
txn->inp_buf = malloc(rsp_len);
if (txn->inp_buf == NULL) {
SICSLogWrite("Out of memory in AsyncProtocol::defaultPrepareTxn", eError);
free(txn->out_buf);
txn->out_buf = NULL;
return 0;
}
txn->inp_len = rsp_len;
txn->inp_idx = 0;
txn->txn_state = 0;

15
devser.c
View File

@@ -158,6 +158,21 @@ int DevQueueTask(void *ds) {
return 1;
}
void DevSigFun(void *ds, int iSignal, void *pSigData) {
DevSer *devser = ds;
AsconStatus status;
DevAction *action;
SchedHeader *header;
if (devser->stopTask) {
return;
}
for (header = devser->headers; header != NULL; header = header->next) {
// TODO ffr Set interrupt level on the action handler node's sics_int property
// An action handler should clear the sics_int property after it is called.
}
}
DevSer *DevMake(SConnection *con, int argc, char *argv[]) {
DevSer *devser = NULL;
Ascon *asyncConn = NULL;

1
scriptcontext.c
View File

@@ -306,6 +306,7 @@ static char *SctActionHandler(void *actionData, char *lastReply) {
snprintf(timeKey,50,"%s_time",data->name);
snprintf(timeVal,50,"%.3f", DoubleTime());
SetHdbProperty(data->node,timeKey,timeVal);
send = NULL;
goto finish;
}
SetProp(node, controller->node, "state", state);

11
site_ansto/hardsup/sct_orhvpsprot.c
View File

@@ -1,7 +1,11 @@
/** @file OrdHVPS protocol handler for script-context based controllers.
* Author: Ferdi Franceschini
*
* ffr This is a replacement for the orhvps.c controller which suffered from state lockups
* The new driver will resend a command if it receives a NAK.
* MJL 17/9/08 implement a special command mode to make life easier
*
TODO Make dhv1 object, refer to following cmd IO for scripting.
* Examples
sct_dhv1 transact "P x4"
x4 6
sct_dhv1 transact v
@@ -84,6 +88,11 @@ int OrdHVPSWriteStart(Ascon *a) {
case 'B': pcmdrspfmt="B%Bz-B%B%dz"; break; // Query if board disabled
case 'l': pcmdrspfmt="l%Bz-%A"; break; // Re-enable a board
case 'J': pcmdrspfmt="Jz-J%dz"; break; // Check jumper settings
default:
a->state = AsconIdle;
AsconError(a, "Unknown command", 0);
return 0;
break;
}
// Prepare the command string
char *pcmd=cmd;

470
site_ansto/hardsup/sct_protek608.c Normal file
View File

@@ -0,0 +1,470 @@
/*
@file sct_protek.c
@brief Protocol handler for Protek 608 multimeter
Reads the display bitmap and generates an ASCII string similar to the
following,
SD3:0.|SD4:1|SD5: |DUTY2:0|HOLD2:0|RANGE2:0|ZD2:0|DC2:0|SIGN2:0|AC2:0|CONT2:0|PW1:0|X1:0|B1:1|B0:1|B16:0|B8:0|B4:0|B2:0|DC1:1|SIGN1:1|AC1:0|LOBAT:0|MD5:0.|MD4:0|MD3:0|X2:0|X3:0|PLUS:0|MINUS:0|RS232C:1|AUTOOFF:0|X4:0|PULSE:0|STORE:0|AVG:0|MINUSPEAK:0|MIN:0|RECALL:0|REL:0|PLUSPEAK:0|MAX:0|GO/NG:0|REF:0|MINUSPER:0|PLUSPER:0|MD2:0|MD1:2|s1:0|DEGF1:0|Hz1:0|X5:0|F1:0|A1:0|OHM1:0|X6:0|DEGC1:0|S1:0|V1:1|k1:0|n1:0|m1:0|u1:0|M1:0|B8K:0|B16K:0|X7:0|X8:0|B4K:0|B2K:0|B1K:0|B512:0|B32:0|B64:0|B128:0|B256:0|M2:1|G2:0|m2:0|PERCENT2:0|k2:0|OHM2:1|V2:0|dBm2:0|X9:0|Hz2:0|A2:0|DEGK2:0|SD1:0|SD2:5|ROTSWITCH:0
NOTE: Multimeter must be connected via a moxa box
Author: Ferdi Franceschini (ffr@ansto.gov.au)
TODO The letters I, S, and O are currently being returned as 1, 5, and 0.
*/
#include <errno.h>
#include <ascon.h>
#include <ascon.i>
#include <dynstring.h>
#define ERRLEN 128
#define CMDLEN 12
#define LASTBYTENUM 42
/* @brief Returns '1' if bit is set otherwise '0' */
#define GETBIT(MASK, BYTE) (MASK & BYTE ? '1' : '0')
/* @brief Interprets BYTE and returns a string of fields and values, eg "F1:v1|F2:v2" */
#define SETFIELD(L1, L2, L3, L4, BYTE) (sprintf(field, "%s:%c|%s:%c|%s:%c|%s:%c", L1, GETBIT(0x8, BYTE), L2, GETBIT(0x4, BYTE), L3, GETBIT(0x2, BYTE), L4, GETBIT(0x1, BYTE)))
struct protekData {
unsigned char defa, xcgb;
int first;
};
void protKill(void *private)
{
struct protekData *data = private;
free(data);
}
/*
* @brief Decodes a seven segment display bit pattern into an ASCII character
* The point bit, x in xCGB, is ignored in an 8 segment bit pattern.
*
* @param DEFA bit pattern for the left half of a seven segment display
* @param xCGB bit pattern fot the right half of the display, x is the point bit for an 8 segment pattern.
* @return ASCII numeral '0' - '9', ' ' for a blank character, 'L' (eg in OL)
* 'A', 'd', 'E', 'F', 'h', 'I', 'L', 'n', 'P', 'r', 'S', 't', or 'U' for Unknown
*
*/
unsigned char segChar(unsigned char DEFA, unsigned char xCGB)
{
unsigned char num, DEFA0CGB;
DEFA0CGB = (DEFA << 4) | (0x7 & xCGB);
switch (DEFA0CGB) {
case 0x0:
num = ' ';
break;
case 0xF5:
//TODO O or zero
num = '0';
break;
case 0x05:
//TODO I or 1
num = '1';
break;
case 0xD3:
num = '2';
break;
case 0x97:
num = '3';
break;
case 0x27:
num = '4';
break;
case 0xB6:
//TODO 5 or S
num = '5';
break;
case 0xF6:
num = '6';
break;
case 0x35:
num = '7';
break;
case 0xF7:
num = '8';
break;
case 0xB7:
num = '9';
break;
case 0x77:
num = 'A';
break;
case 0xC2:
num = 'c';
break;
case 0xD7:
num = 'd';
break;
case 0xF4:
num = 'E';
break;
case 0x72:
num = 'F';
break;
case 0x66:
num = 'h';
break;
case 0xE0:
num = 'L';
break;
case 0x46:
num = 'n';
break;
case 0x73:
num = 'P';
break;
case 0x42:
num = 'r';
break;
case 0xE2:
num = 't';
break;
default:
num = 'U';
break;
}
return num;
}
/*
* @brief Translates incoming bytes and generates the corresponding field of the status string
*
* @param byte, a character read from the protek multimeter
* @param byteNum, the position of the character in the protek protocol
* @param *str, translation of the byte into a "field:value" string where "value" is either an ASCII
* character or a boolean represented as a '1' or '0' character and "field" is a label.
* @return -1=ERROR, 0=NOTDONE, 1=DONE and str is set to translated bits
*
* The "switch" statement corresponds to the protocol table in the Protek 608 manual pg44
* with the labels for the bits written in reverse order so that they match
* the bit patterns we read from the multimeter
*/
int translateByte(struct protekData *data, char byte, int byteNum, char *str)
{
unsigned char num;
char field[64]="";
int gotSegChar=0;
switch (byteNum) {
case 1: /* SD3 p7,C,G,B */
data->xcgb = byte;
break;
case 2: /* SD3 D,E,F,A */
data->defa= byte;
gotSegChar=1;
strcpy(field, "SD3");
break;
case 3: /* SD4 p8,C,G,B */
data->xcgb = byte;
break;
case 4: /* SD4 D,E,F,A */
data->defa= byte;
gotSegChar=1;
strcpy(field, "SD4");
break;
case 5: /* SD5 p9,C,G,B */
data->xcgb = byte;
break;
case 6: /* SD5 D,E,F,A */
data->defa= byte;
gotSegChar=1;
strcpy(field, "SD5");
break;
case 7: /* bits 25-32 SUB UNIT DUTY2,HOLD2,RANGE2,ZD2 (ZENERDIODE) */
SETFIELD("DUTY2", "HOLD2", "RANGE2", "ZD2", byte);
break;
case 8: /* bits 25-32 SUB UNIT DC2,SIGN2,AC2,CONT2 */
SETFIELD("DC2", "SIGN2", "AC2", "CONT2", byte);
break;
case 9: /* BAR GRAPH PW1,x,B1,B0 */
SETFIELD("PW1", "X1", "B1", "B0", byte);
break;
case 10: /* BAR GRAPH B16,B8,B4,B2 */
SETFIELD("B16", "B8", "B4", "B2", byte);
break;
case 11: /* DC1,SIGN1,AC1,LOBAT */
SETFIELD("DC1", "SIGN1", "AC1", "LOBAT", byte);
break;
case 12: /* MD5 D,E,F,A */
data->defa = byte;
break;
case 13: /* MD5 p4,C,G,B */
data->xcgb = byte;
gotSegChar=1;
strcpy(field, "MD5");
break;
case 14: /* MD4 D,E,F,A */
data->defa = byte;
break;
case 15: /* MD4 p3,C,G,B */
data->xcgb = byte;
gotSegChar=1;
strcpy(field, "MD4");
break;
case 16: /* MD3 D,E,F,A */
data->defa = byte;
break;
case 17: /* MD3 p2,C,G,B */
data->xcgb = byte;
gotSegChar=1;
strcpy(field, "MD3");
break;
case 18: /* x,x,+,- */
SETFIELD("X2", "X3", "PLUS", "MINUS", byte);
break;
case 19: /* RS232C,AUTOOFF,x,PULSE */
SETFIELD("RS232C", "AUTOOFF", "X4", "PULSE", byte);
break;
case 20: /* STORE,AVG,MINUSPEAK,MIN */
SETFIELD("STORE", "AVG", "MINUSPEAK", "MIN", byte);
break;
case 21: /* RECALL,REL,PLUSPEAK,MAX */
SETFIELD("RECALL", "REL", "PLUSPEAK", "MAX", byte);
break;
case 22: /* GO/NG,REF,MINUSPER,PLUSPER */
SETFIELD("GO/NG", "REF", "MINUSPER", "PLUSPER", byte);
break;
case 23: /* MD2 D,E,F,A */
data->defa = byte;
break;
case 24: /* MD2 p1,C,G,B */
data->xcgb = byte;
gotSegChar=1;
strcpy(field, "MD2");
break;
case 25: /* MD1 D,E,F,A*/
data->defa = byte;
break;
case 26: /* MD1 x,C,G,B */
data->xcgb = byte;
gotSegChar=1;
strcpy(field, "MD1");
break;
case 27: /* s1,DEGF1,Hz1,x */
SETFIELD("s1", "DEGF1", "Hz1", "X5", byte);
break;
case 28: /* F1,A1,OHM1,x */
SETFIELD("F1", "A1", "OHM1", "X6", byte);
break;
case 29: /* DEGC1,S1,V1,k1 */
SETFIELD("DEGC1", "S1", "V1", "k1", byte);
break;
case 30: /* n1,m1,u1,M1 */
SETFIELD("n1", "m1", "u1", "M1", byte);
break;
case 31: /* BAR GRAPH B8K,B16K,x,x */
SETFIELD("B8K", "B16K", "X7", "X8", byte);
break;
case 32: /* BAR GRAPH B4K,B2K,B1K,B512 */
SETFIELD("B4K", "B2K", "B1K", "B512", byte);
break;
case 33: /* BAR GRAPH B32,B64,B128,B256 */
SETFIELD("B32", "B64", "B128", "B256", byte);
break;
case 34: /* BAR GRAPH M2,G2,m2,PERCENT2 */
SETFIELD("M2", "G2", "m2", "PERCENT2", byte);
break;
case 35: /* bits 133-143 SUB UNIT k2,OHM2,V2,dBm2 */
SETFIELD("k2", "OHM2", "V2", "dBm2", byte);
break;
case 36: /* bits 133-143 SUB UNIT x,Hz2,A2,DEGK2 */
SETFIELD("X9", "Hz2", "A2", "DEGK2", byte);
break;
case 37: /* SD1 x,C,G,B */
data->xcgb = byte;
break;
case 38: /* SD1 D,E,F,A */
data->defa= byte;
gotSegChar=1;
strcpy(field, "SD1");
break;
case 39: /* SD2 p6,C,G,B */
data->xcgb = byte;
break;
case 40: /* SD2 D,E,F,A */
data->defa= byte;
gotSegChar=1;
strcpy(field, "SD2");
break;
case 41:
/* Last byte is undocumented but it seems to be the rotary switch position
Positions range from 0 (V) to 8 (A).
*/
sprintf(field, "ROTSWITCH:%X", byte);
break;
default:
return -1;
break;
}
if (field[0] != '\0') {
if (gotSegChar) {
num = segChar(data->defa, data->xcgb);
if (num == 'U') {
return -1;
}
if ((010 & data->xcgb) == 010) {
sprintf(str, "%s:%c.", field, num);
} else {
sprintf(str, "%s:%c", field, num);
}
} else {
strcpy(str,field);
}
return 1;
} else {
return 0;
}
}
/*
* @brief Constructs a status string from the display map sent by the Protek
*
* The multimeter sends two data packets per second bounded by '['(0x5B) and ']'(0x5D)
* NOTE: Sometimes it sends 0x1D instead of 0x5D at the end of a packet
*/
int Protek608Reading(Ascon *a)
{
int ret, DS_AllocFailed = 0, transByteStatus = 0, transByteFailed = 0;
int errNum = 0;
char chr=0, field[64], errMsg[ERRLEN];
struct protekData *data = a->private;
/* a->readState == 0 means we haven't yet seen the start of a packet (ie the '[')
* a->readState > 0 is the current byte number
*/
while ( ( ret = AsconReadChar(a->fd, &chr) ) > 0) {
a->start = DoubleTime();
if (a->readState) {
if (a->readState >= LASTBYTENUM) {
a->readState = 0;
a->state = AsconReadDone;
data->first = 1;
if (0 == DynStringConcatChar(a->rdBuffer, '\0')) {
strcpy(errMsg, "PROTEK608: DynStringConcat or DynStringConcatChar failed:");
errNum = ENOMEM;
DS_AllocFailed = 1;
break;
}
if (chr != ']' && chr != 0x1D) {
snprintf(errMsg, ERRLEN, "PROTEK608: Unexpected value %X for last byte:", chr);
AsconError(a, errMsg, 0);
}
return 1;
}
transByteStatus = translateByte(a->private, chr, (a->readState)++, field);
if (transByteStatus == 1) {
if (data->first) {
if ( 0== DynStringConcat(a->rdBuffer, field) ) {
strcpy(errMsg, "PROTEK608: DynStringConcat or DynStringConcatChar failed:");
errNum = ENOMEM;
DS_AllocFailed = 1;
break;
}
data->first=0;
} else {
if ( 0 == DynStringConcatChar(a->rdBuffer, '|') ) {
strcpy(errMsg, "PROTEK608: DynStringConcat or DynStringConcatChar failed:");
errNum = ENOMEM;
DS_AllocFailed = 1;
break;
}
if ( 0 == DynStringConcat(a->rdBuffer, field) ) {
strcpy(errMsg, "PROTEK608: DynStringConcat or DynStringConcatChar failed:");
errNum = ENOMEM;
DS_AllocFailed = 1;
break;
}
}
} else if (transByteStatus == -1) {
snprintf(errMsg, ERRLEN, "PROTEK608: Failed to translate %X in byte number %d:", chr, a->readState-1);
errNum = 0;
transByteFailed = 1;
break;
}
} else if (chr == '[') {
a->readState = 1;
}
}
if (ret < 0) {
AsconError(a, "PROTEK608: AsconReadChar failed:", errno);
return 1;
}
if (DS_AllocFailed || transByteFailed) {
a->state = AsconReadDone;
a->readState = 0;
data->first = 1;
AsconError(a, errMsg, errNum);
return 1;
}
if (a->timeout > 0) {
if (DoubleTime() - a->start > a->timeout) {
AsconError(a, "PROTEK608: read timeout", 0);
a->state = AsconTimeout;
}
}
return 1;
}
/*
* @brief Protocol handler for Protek 608 multimeter
*
* It overrides the AsconWriteStart and AsconReading states of the standard handler.
* Available commands,
* "STATE": Requests a state report
*
* NOTE: The multimeter is always sending a display map at 0.5 second intervals, the "STATE" command
* simply forces a transition from the AsconWriteStart state to the AsconReadStart state.
*/
int Protek608ProtHandler(Ascon *a)
{
char *wrBuffArr, errMsg[ERRLEN];
switch(a->state) {
case AsconWriteStart:
wrBuffArr = GetCharArray(a->wrBuffer);
if (strncasecmp(wrBuffArr, "STATE", CMDLEN) != 0) {
a->state = AsconIdle;
snprintf(errMsg, ERRLEN, "PROTEK608: Unknown command %s", wrBuffArr);
AsconError(a, errMsg, 0);
return 0;
}
a->wrPos = 0;
AsconReadGarbage(a->fd);
a->state = AsconReadStart;
return 1;
break;
case AsconReading:
return Protek608Reading(a);
break;
default:
return AsconStdHandler(a);
}
}
int AsconProtek608Init(Ascon *a, SConnection *con, int argc, char *argv[])
{
/* greater than one when reading data */
a->readState = 0;
struct protekData *data;
a->private = data = (struct protekData *) malloc(sizeof(struct protekData));
a->killPrivate = protKill;
data->defa = 0;
data->xcgb = 0;
data->first = 1;
return AsconStdInit(a,con, argc, argv);
}
void AddProtek608Protocol()
{
AsconProtocol *prot = NULL;
prot = calloc(sizeof(AsconProtocol), 1);
prot->name = strdup("protek608");
prot->init = AsconProtek608Init;
prot->handler = Protek608ProtHandler;
AsconInsertProtocol(prot);
}

284
site_ansto/hardsup/sct_rfamp.c Normal file
View File

@@ -0,0 +1,284 @@
/**
* @brief Protocol handler for Mirrotron RF power supplies
Current should be ramped up in steps of 0.5A but it doesn't
have to be ramped down.
Provides two commands (L)ist and (S)et
eg,
The following command lists status info from the RF Amp at address 3.
sct_rfamp send L:3
The reply string has the following form
address=1|type=L|curr=00|freq=170|voltage=50|K3=1|K2=1|K1=1|O=1|CC=1|CV=0|H=1
The following command sets the current(I), frequency, switches(K1,K2,K3) and output(O).
sct_rfamp send S:3:I=5:F=170:K3=0:K2=1:k1=0:O=1
NOTE: The current is an integer which equals the desired current x10, ie 71 -> 7.1A
*/
#include <errno.h>
#include <ctype.h>
#include <ascon.h>
#include <ascon.i>
#include <dynstring.h>
#define ERRLEN 128
#define LASTBYTENUM 12
#define NOTBOOLEAN(b) (b==1 || b==0 ? 0 : 1)
#define MINCURRSPEC 0
#define MAXCURRSPEC 71
#define MINFREQ 170
#define MAXFREQ 500
struct RFAmpData {
int transactInProg;
int targetCurrent;
char rfCmd[16];
};
void RFAmpKill(void *private)
{
struct RFAmpData *data = private;
free(data);
}
/**
* @brief Translates ASCII command string into a properly formatted command for the RF amplifier
*/
int RFAmpWriteStart (Ascon *a)
{
char *dynStrBuffer, errMsg[ERRLEN], statusCmd[5];
char ctype='X', address='0';
unsigned char switches=0;
int curr, freq, outOn, K1, K2, K3;
int i, ret;
struct RFAmpData *data = a->private;
curr=freq=outOn=K1=K2=K3=0;
dynStrBuffer = GetCharArray(a->wrBuffer);
for (i=0; dynStrBuffer[i]; i++)
dynStrBuffer[i]=toupper(dynStrBuffer[i]);
ret = sscanf(dynStrBuffer, " %c:%c:I=%d:F=%d:K3=%d:K2=%d:K1=%d:O=%d ", &ctype, &address, &curr, &freq, &K3, &K2, &K1, &outOn);
if (ret==0) {
snprintf(errMsg, ERRLEN, "ANSRFAMP:Invalid command string %s", dynStrBuffer);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
switch (ctype) {
case 'L':
sprintf(data->rfCmd,"%c%c%c%c", 2, address, ctype, 3);
DynStringReplace(a->wrBuffer, data->rfCmd,0);
a->state = AsconWriting;
a->noResponse = 0;
a->wrPos = 0;
return 1;
break;
case 'S':
if (ret < 8) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Invalid command string %s", dynStrBuffer);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
if (address < '1' || address > '9') {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Invalid address %c, it should be between 1 and 9", address);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
if (curr < MINCURRSPEC || curr > MAXCURRSPEC) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Invalid current specifier %d, it should be between %d and %d. NOTE:divide by 10 to convert to Amps", curr, MINCURRSPEC, MAXCURRSPEC);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
if (freq < MINFREQ || freq > MAXFREQ) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Invalid frequency %d, it should be between %d and %d", freq, MINFREQ, MAXFREQ);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
if (NOTBOOLEAN(K1) || NOTBOOLEAN(K2) || NOTBOOLEAN(K3) || NOTBOOLEAN(outOn)) {
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, "ANSRFAMP: K1, K2, K3 and O must be boolean values (ie 1 or 0)", 0);
return 1;
}
switches = (K3 << 3) | (K2 << 2) | (K1 << 1) | outOn;
sprintf(data->rfCmd,"%c%c%c%02d%03d%c%c", 2, address, ctype, curr, freq, switches, 3);
if (data->rfCmd[0] != 2 || data->rfCmd[9] != 3) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Failed to construct a valid packet for %s", dynStrBuffer);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
}
sprintf(statusCmd,"%c%c%c%c", 2, address, 'L', 3);
DynStringReplace(a->wrBuffer, statusCmd, 0);
data->transactInProg = 1;
data->targetCurrent = curr;
a->state = AsconWriting;
a->noResponse = 0;
a->wrPos = 0;
return 1;
break;
default:
snprintf(errMsg, ERRLEN, "ANSRFAMP: Unknown command type %c, allowed types are 'L' or 'S'", ctype);
a->state = AsconWriteDone;
a->noResponse = 1;
AsconError(a, errMsg, 0);
return 1;
break;
}
}
int RFAmpReading (Ascon *a)
{
int rdChRet, scanRet, GetReplyFailed=0, errNum=0;
char chr, address, ctype, curr[3], freq[4], voltage[3], replyStr[128];
unsigned char switches, opstate;
unsigned char K3, K2, K1, outOn, CC, CV, heat;
char errMsg[ERRLEN];
struct RFAmpData *data = a->private;
switches=opstate=K3=K2=K1=outOn=CC=CV=heat=0;
// Start reading when byte = 2 and stop when 3
while ( ( rdChRet = AsconReadChar(a->fd, &chr) ) > 0) {
a->start = DoubleTime();
if (a->readState) {
if (a->readState >= LASTBYTENUM) {
a->readState = 0;
if (a->readState > LASTBYTENUM) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Packet larger than expected, size exceeds %d", LASTBYTENUM);
GetReplyFailed = 1;
break;
}
if (chr != 3) {
snprintf(errMsg, ERRLEN, "ANSRFAMP: Unexpected value %X for packet end signal", chr);
GetReplyFailed = 1;
break;
}
if (0 == DynStringConcatChar(a->rdBuffer, '\0')) {
strcpy(errMsg, "ANSRFAMP: DynStringConcatChar failed:");
errNum = ENOMEM;
GetReplyFailed = 1;
break;
}
scanRet = sscanf(GetCharArray(a->rdBuffer), "%c%c%2s%3s%2s%c%c", &address, &ctype, curr, freq, voltage, &switches, &opstate);
if (scanRet < 7) {
strcpy(errMsg, "ANSRFAMP: Failed to parse reply");
GetReplyFailed = 1;
break;
}
if (data->transactInProg) {
data->transactInProg = 0;
if (abs(data->targetCurrent - atoi(curr)) <= 5) {
DynStringReplace(a->wrBuffer, data->rfCmd,0);
a->state = AsconWriting;
a->noResponse = 1;
a->wrPos = 0;
} else {
strcpy(errMsg, "ANSRFAMP: Step size should be <= 5 for current");
GetReplyFailed = 1;
break;
}
} else {
K3 = (switches & 0x08) >> 3;
K2 = (switches & 0x04) >> 2;
K1 = (switches & 0x02) >> 1;
outOn = switches & 0x01;
CC = (opstate & 0x04) >> 2;
CV = (opstate & 0x02) >> 1;
heat = opstate & 0x01;
snprintf(replyStr, 128, "address=%c|type=%c|curr=%s|freq=%s|voltage=%s|K3=%d|K2=%d|K1=%d|O=%d|CC=%d|CV=%d|H=%d", address, ctype, curr, freq, voltage, K3, K2, K1, outOn, CC, CV, heat);
if (0 == DynStringReplace(a->rdBuffer, replyStr, 0)) {
strcpy(errMsg, "ANSRFAMP: DynStringReplace failed:");
errNum = ENOMEM;
GetReplyFailed = 1;
break;
}
a->state = AsconReadDone;
}
return 1;
}
if (0 == DynStringConcatChar(a->rdBuffer, chr)) {
strcpy(errMsg, "ANSRFAMP: DynStringConcatChar failed:");
errNum = ENOMEM;
GetReplyFailed = 1;
break;
}
a->readState++;
} else if (chr == 2) {
a->readState = 1;
}
}
if (rdChRet < 0) {
AsconError(a, "ANSRFAMP: AsconReadChar failed:", errno);
return 1;
}
if (GetReplyFailed) {
a->state = AsconReadDone;
a->readState = 0;
AsconError(a, errMsg, errNum);
return 1;
}
if (a->timeout > 0) {
if (DoubleTime() - a->start > a->timeout) {
AsconError(a, "ANSRFAMP: read timeout", 0);
a->state = AsconTimeout;
}
}
return 1;
}
int RFAmpProtHandler (Ascon *a)
{
int ret;
switch (a->state) {
case AsconWriteStart:
ret = RFAmpWriteStart(a);
return ret;
break;
case AsconReading:
ret = RFAmpReading(a);
return ret;
break;
default:
return AsconStdHandler(a);
}
}
int RFAmpInit(Ascon *a, SConnection *con, int argc, char *argv[])
{
struct RFAmpData *data;
a->readState=0;
a->private = data = (struct RFAmpData *) malloc(sizeof(struct RFAmpData));
data->transactInProg = 0;
data->targetCurrent = 0;
data->rfCmd[0] = '\0';
a->killPrivate = RFAmpKill;
return AsconStdInit(a, con, argc, argv);
}
void AddRFAmpProtocol()
{
AsconProtocol *prot = NULL;
prot = calloc(sizeof(AsconProtocol), 1);
prot->name = strdup("rfamp");
prot->init = RFAmpInit;
prot->handler = RFAmpProtHandler;
AsconInsertProtocol(prot);
}

245
site_ansto/hardsup/sinqhttpprot.c Normal file
View File

@@ -0,0 +1,245 @@
/**
* This is an asynchronous protocol implementation for HTTP.
* It includes special features to store binary data coming
* from a SINQ http histogram memory in a sinqdata object.
* Which has to be specified on initialisation.
*
* copyright: see file COPYRIGHT
*
* Mark Koennecke, June 2008
*/
#include <ascon.h>
#include <ascon.i>
#include <ghttp.h>
#include <sicsdata.h>
#include <HistMem.h>
/*---------------------------------------------------------------------*/
typedef struct {
ghttp_request *request;
char *userName;
char *password;
pSICSData binData;
}HttpProt, *pHttpProt;
/*---------------------------------------------------------------------*/
static int configRequest(Ascon *a){
pHttpProt pHttp = (pHttpProt)a->private;
pDynString request;
char *uri = NULL;
request = CreateDynString(64,64);
if(request == NULL){
AsconError(a,"Out of memory", 122);
return 0;
}
DynStringConcat(request,"http://");
DynStringConcat(request,a->hostport);
DynStringConcatChar(request,'/');
DynStringConcat(request,GetCharArray(a->wrBuffer));
uri = GetCharArray(request);
ghttp_clean(pHttp->request);
ghttp_set_type(pHttp->request,ghttp_type_get);
ghttp_set_header(pHttp->request,"connection", "keep-alive");
if(ghttp_set_uri(pHttp->request,uri) < 0){
AsconError(a,"Bad URL", a->state);
return 0;
}
if(pHttp->userName != NULL && pHttp->password != NULL){
ghttp_set_authinfo(pHttp->request,
pHttp->userName, pHttp->password);
}
ghttp_set_sync(pHttp->request,ghttp_async);
ghttp_prepare(pHttp->request);
DeleteDynString(request);
return 1;
}
/*---------------------------------------------------------------------*/
static void handleReply(Ascon *a){
char *pPtr = NULL, *pType = NULL;
int len, i, *dataPtr = NULL;
HistInt *hmData = NULL;
pHttpProt pHttp = (pHttpProt)a->private;
pPtr = ghttp_get_body(pHttp->request);
len = ghttp_get_body_len(pHttp->request);
if(strstr(pPtr,"ERROR") != NULL){
AsconError(a,pPtr, a->state);
DynStringConcat(a->rdBuffer,pPtr);
} else if(strstr(pPtr,"Authentication Error") != NULL){
DynStringConcat(a->rdBuffer,pPtr);
AsconError(a,pPtr, a->state);
} else {
pType = (char *)ghttp_get_header(pHttp->request,"Content-Type");
if(strstr(pType,"sinqhm") == NULL){
/* text data */
for(i = 0; i < len; i++){
DynStringConcatChar(a->rdBuffer, pPtr[i]);
}
} else {
hmData = (HistInt *)pPtr;
clearSICSData(pHttp->binData);
len = len/sizeof(HistInt);
dataPtr = getSICSDataPointer(pHttp->binData, 0, len);
for(i = 0; i < len; i++){
dataPtr[i] = htonl(hmData[i]);
}
assignSICSType(pHttp->binData, 0, len, INTTYPE);
DynStringCopy(a->rdBuffer,"SICSDATA");
}
}
}
/*---------------------------------------------------------------------*/
static int HttpHandler(Ascon *a) {
ghttp_status status;
pHttpProt pHttp = (pHttpProt)a->private;
int socke, selStat;
fd_set rmask;
struct timeval tmo = {0,0};
switch (a->state) {
case AsconConnectStart:
a->state = AsconConnecting;
break;
case AsconConnecting:
a->state = AsconConnectDone; /* success */
break;
case AsconWriteStart:
if(configRequest(a)){
a->state = AsconWriting;
}
break;
case AsconWriting:
status = ghttp_process(pHttp->request);
if(status == ghttp_error){
ghttp_close(pHttp->request);
configRequest(a);
status = ghttp_process(pHttp->request);
}
if(status == ghttp_error){
AsconError(a,"Server error", 123);
DynStringConcat(a->rdBuffer,"Server error");
a->state = AsconReadDone;
} else {
a->state = AsconWriteDone;
}
a->start = DoubleTime();
DynStringClear(a->rdBuffer);
break;
case AsconReadStart:
socke = ghttp_get_socket(pHttp->request);
FD_ZERO(&rmask);
FD_SET(socke,&rmask);
selStat = select(socke+1,&rmask, NULL, NULL, &tmo);
if(selStat != 0){
status = ghttp_process(pHttp->request);
a->state = AsconReading;
} else {
if(DoubleTime() > a->start + a->timeout){
AsconError(a," read timeout", 0);
a->state = AsconTimeout;
/* this to clear the line */
ghttp_close(pHttp->request);
}
}
return 1;
break;
case AsconReading:
status = ghttp_process(pHttp->request);
switch(status){
case ghttp_not_done:
if(DoubleTime() > a->start + a->timeout){
AsconError(a," read timeout", 0);
a->state = AsconTimeout;
/* this to clear the line */
ghttp_close(pHttp->request);
}
return 1;
case ghttp_done:
handleReply(a);
a->state = AsconReadDone;
break;
case ghttp_error:
/*
* A first error may not be an error but a
* reconnect
*/
ghttp_close(pHttp->request);
configRequest(a);
status = ghttp_process(pHttp->request);
if(status == ghttp_error){
AsconError(a,"Server error", a->state);
DynStringConcat(a->rdBuffer,"Server error");
a->state = AsconReadDone;
}
return 1;
break;
}
break;
default:
return AsconStdHandler(a);
}
return 1;
}
/*------------------------------------------------------------------------*/
static void killHttp(void *data){
pHttpProt prot = (pHttpProt)data;
if(prot == NULL){
return;
}
if(prot->request != NULL){
ghttp_close(prot->request);
}
if(prot->password != NULL){
free(prot->password);
}
if(prot->userName != NULL){
free(prot->userName);
}
free(prot);
}
/*------------------------------------------------------------------------*/
static int HttpProtInit(Ascon *a, SConnection *con,
int argc, char *argv[]){
pHttpProt pHttp = NULL;
pHttp = calloc(sizeof(HttpProt), 1);
if(pHttp == NULL){
SCWrite(con,"ERROR: out of memory in HttpProtInit", eError);
return 0;
}
if(argc < 3){
return 0;
}
a->hostport = strdup(argv[1]);
pHttp->binData = (pSICSData)FindCommandData(pServ->pSics,
argv[2], "SICSData");
if(pHttp->binData == NULL){
SCWrite(con,"ERROR: SICSData objct not found", eError);
return 0;
}
if(argc > 3){
a->timeout = atof(argv[3]);
} else {
a->timeout = 10.;
}
if(argc > 5){
pHttp->userName = strdup(argv[4]);
pHttp->password = strdup(argv[5]);
}
pHttp->request = ghttp_request_new();
a->private = pHttp;
a->killPrivate = killHttp;
a->state = AsconConnectStart;
return 1;
}
/*-------------------------------------------------------------------------*/
void AddHttpProtocoll(){
AsconProtocol *prot = NULL;
prot = calloc(sizeof(AsconProtocol), 1);
prot->name = strdup("sinqhttp");
prot->init = HttpProtInit;
prot->handler = HttpHandler;
AsconInsertProtocol(prot);
}

1
site_ansto/instrument/barebones.tcl
View File

@@ -39,6 +39,7 @@ SicsUser user sydney 2
SicsUser spy 007 3
MakeDrive
InstallHdb
exe batchpath ../batch
exe syspath ../batch

145
site_ansto/instrument/config/environment/sct_protek_common.tcl Normal file
View File

@@ -0,0 +1,145 @@
##
# @file sct_protek_common.tcl
# @brief Gets display state from Protek 608 multimeters.
#
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
## MULTIMETER STATE FIELDS AND VALUES
###### MODES
# AUTOOFF:1/0 PULSE:1/0 MAX:1/0 PLUSPEAK:1/0 REL:1/0 RECALL:1/0 GO/NG:1/0 MINUSPER:1/0
# RS232C:1/0 PLUS:1/0 MINUS:1/0 MIN:1/0 MINUSPEAK:1/0 AVG:1/0 STORE:1/0 REF:1/0 PLUSPER:1/0
# LOBAT:1/0
###### MAIN DISPLAY
# AC1:1/0 SIGN1:1/0 DC1:1/0 PW1:1/0
# MD5:np MD4:np MD3:np MD2:np MD1:n
# M1:1/0 k1:1/0 OHM1:1/0
# u1:1/0 Hz1:1/0
# m1:1/0 V1:1/0 A1:1/0
# n1:1/0 S1:1/0 F1:1/0
# DEGC1:1/0 s1:1/0
# DEGF1:1/0
###### BAR GRAPH
# B16K:1/0 B8K:1/0 B4K:1/0 B2K:1/0 B1K:1/0
# B512:1/0 B256:1/0 B128:1/0 B64:1/0 B32:1/0
# B16:1/0 B8:1/0 B4:1/0 B2:1/0 B1:1/0 B0:1/0
###### SUB DISPLAY
# RANGE2:1/0 HOLD2:1/0 DUTY2:1/0
# CONT2:1/0 ZD2:1/0
# AC2:1/0 SIGN2:1/0 DC2:1/0
# SD5:np SD4:np SD3:np SD2:np SD1:n
# PERCENT2:1/0 dBm2:1/0
# m2:1/0 V2:1/0 A2:1/0 DEGK2:1/0
# G2:1/0 M2:1/0 k2:1/0 OHM2:1/0 Hz2:1/0
# ROTSWITCH:[0-8]
### The return values for nine bytes is undocumented,
### they are labelled as X1 to X9
# X[1-9]:?
##
# @brief Sends a state report request to the protek script context protocol handler.
proc rqStateRep {} {
sct send "STATE"
return rdStateRep
}
##
# @brief Processes state report from the protek script context protocol handler.
proc rdStateRep {} {
set stateRep [sct result]
if {[string match "ASCERR:*" $stateRep]} {
sct geterror $stateRep
# Setting oldval forces update and clears geterror on next call
sct oldval "UNKNOWN"
return idle
}
array set stateArr [split $stateRep "|:"]
if {$stateArr(AUTOOFF)} {
broadcast "PROTEK608:[sct IP]:[sct PORT] WARNING AUTO OFF IS ENABLED"
}
if {$stateArr(LOBAT)} {
broadcast "PROTEK608: LOW BATTERY WARNING"
}
if {$stateRep != [sct oldval]} {
sct update $stateRep
sct oldval $stateRep
}
return idle
}
proc rqVal {} {
return reportVal
}
proc ProtekMainDisplay {protek} {
if [catch {
set stateRep [hval $protek/state]
set MDpath [sct]
set scale [hval $MDpath/scale]
set offset [hval $MDpath/offset]
array set SA [split $stateRep "|:"]
if {$SA(SIGN1)} {
set sign1 "-"
} else {
set sign1 ""
}
set MDISP "$sign1$SA(MD5)$SA(MD4)$SA(MD3)$SA(MD2)$SA(MD1)"
set MDISP [expr {$scale * $MDISP + $offset}]
set oldval [sct oldval]
if {$MDISP != $oldval} {
sct update $MDISP
sct oldval $MDISP
}
} msg ] {
return -code error "[info level 0] $msg"
}
return idle
}
##
# @brief Makes a state monitor object for the protek multimeter
#
# @param name, name of object which reports main display reading
# @param IP, IP address of protek moxa box
# @param PORT, port number for protek on moxa box
# @param scale, scales reading to physical units
# @param offset, offset for main display reading
# @param interval, polling interval in seconds (optional, default = 0.5seconds)
# NOTE: If the interval is negative then the multimeter will be polled on every cycle of
# the SICS task loop.
proc MakeProtek {name IP PORT {scale 1.0} {offset 0.0} {interval 0.5}} {
set sctName "sct_$name"
set sobjName "so_$name"
set soState "so_state_$name"
puts "MakeSICSObj $sobjName SCT_OBJECT"
MakeSICSObj $soState SCT_OBJECT
MakeSICSObj $sobjName SCT_OBJECT user float
sicslist setatt $sobjName long_name $sobjName
hfactory /sics/$soState/state plain user text
hsetprop /sics/$soState/state read rqStateRep
hsetprop /sics/$soState/state rdStateRep rdStateRep
hsetprop /sics/$soState/state oldval "UNKNOWN"
hsetprop /sics/$sobjName read rqVal
hsetprop /sics/$sobjName reportVal ProtekMainDisplay /sics/$soState
hfactory /sics/$sobjName/scale plain user float
hset /sics/$sobjName/scale $scale
hfactory /sics/$sobjName/offset plain user float
hset /sics/$sobjName/offset $offset
hsetprop /sics/$sobjName oldval "UNKNOWN"
sicslist setatt $sobjName klass sample
::scobj::hinitprops $sobjName
sicslist setatt $sobjName long_name $name
if {[SplitReply [environment_simulation]] == false} {
makesctcontroller $sctName protek608 $IP:$PORT
hsetprop /sics/$soState/state IP $IP
hsetprop /sics/$soState/state PORT $PORT
$sctName poll /sics/$soState/state $interval
$sctName poll /sics/$sobjName $interval
}
}

202
site_ansto/instrument/config/environment/temperature/sct_lakeshore_3xx.tcl
View File

@@ -64,7 +64,7 @@ namespace eval ::scobj::ls3xx {
# ctrl loop 1 settle parameter, threshold=allowable band around setpoint (0,..,100)
set ls340_settleThr 30
# ctrl loop 1 settle parameter, settle time in seconds
set ls340_settleTime 5
set ls340_settleTime 30
# default Heater Range (0,..,5) zero is off, hence the least dangerous
set ls3xx_range 0
# upper and lower temperature limit in Kelvin
@@ -74,6 +74,8 @@ namespace eval ::scobj::ls3xx {
set ls3xx_tempUnits "K"
# ls3xx status byte
set ls3xx_statusByte -1
# enable extra logging - can produce huge stout****.log file in /usr/local/sics/log/
set ls3xx_verbose 0
# a list of available sensors (not all may be connected/active)
set this_sensorlist [list A B C D]
# a list of controler loops
@@ -124,10 +126,12 @@ namespace eval ::scobj::ls3xx {
# @param tc_root string variable holding the path to the object's base node in sics
# @return 0, always
proc ls3xx_init {sct_controller tc_root} {
if [ catch {
if {[ catch {
# Define a constant time offset for later logging of data with timStamp
# counting from 1st Jan 2000 00:00hrs
# clock command does not work in tcl8.5 ?!
set ::scobj::ls3xx::timeInSecsSince2000 [clock scan 20000101T000000A]
#set ::scobj::ls3xx::timeInSecsSince2000 1000
# set the communication protocol: terminator <CR>, bps 9600 baud, 7 data bits +
# 1 stop bit + odd parity bit
if { $::scobj::ls3xx::ls3xx_LSmodel == 340 } {
@@ -185,7 +189,7 @@ proc ls3xx_init {sct_controller tc_root} {
# Set the default tolerances for the setpoint temperatures
hset $tc_root/control/tolerance1 $::scobj::ls3xx::ls3xx_driveTolerance1
hset $tc_root/control/tolerance2 $::scobj::ls3xx::ls3xx_driveTolerance2
} message ] {
} message ]} {
return -code error "in ls3xx_init: $message"
}
}
@@ -203,11 +207,11 @@ proc ls3xx_init {sct_controller tc_root} {
# the command belongs to
# @return nextState The next function to call after this one (typically 'rdValue')
proc getValue {tc_root nextState cmd idx} {
if [ catch {
if {[ catch {
if { 0 == [string compare -length 7 $cmd "InpSample"] } {
# we are reading from a pseudo-node where there is no direct representation
# in the device
puts "getValue(InpSample)"
# puts "getValue(InpSample)"
set ::scobj::ls3xx::ls3xx_lastQueryCmd $cmd
#sct send $cmd$::scobj::ls3xx::ls3xx_term
} elseif { 0 == [string compare -length 7 $cmd "CRVHDR?"] } {
@@ -228,7 +232,7 @@ proc getValue {tc_root nextState cmd idx} {
set ::scobj::ls3xx::ls3xx_lastQueryCmd "$cmd"
sct send $cmd
}
} message ] {
} message ]} {
return -code error "in getValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return $nextState
@@ -240,7 +244,7 @@ proc getValue {tc_root nextState cmd idx} {
# @param idx indicates which control loop or which input channel the command belongs to
# @return idle Always returns system state idle - command sequence completed.
proc rdValue {idx} {
if [ catch {
if {[ catch {
set data [sct result]
# puts "rdValue(): result is $data"
# broadcast rdValue "rdValue(): result is $data"
@@ -311,7 +315,7 @@ proc getValue {tc_root nextState cmd idx} {
set aT "T"
set timeString $ayear$amonth$aday$aT$ahour$amin$asec$aA
set timeInSecs [clock scan $timeString]
set timeInSecs [expr $timeInSecs - $::scobj::ls3xx::timeInSecsSince2000]
set timeInSecs [expr {$timeInSecs - $::scobj::ls3xx::timeInSecsSince2000}]
hset $::scobj::ls3xx::ls3xx_path2nodes/sensor/timStamp $timeInSecs
if {1==0} {
# if we could write a string value to NXsensor, then this date-time format would be nicer...
@@ -324,7 +328,7 @@ proc getValue {tc_root nextState cmd idx} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -337,7 +341,7 @@ proc getValue {tc_root nextState cmd idx} {
# @param idx indicates which control loop or which input channel the command belongs to
# @return idle Always returns system state idle - command sequence completed.
proc rdAlarmVal {iSensor} {
if [ catch {
if {[ catch {
set data [sct result]
switch -glob -- $data {
"ASCERR:*" {
@@ -396,7 +400,7 @@ proc rdAlarmVal {iSensor} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdAlarmVal: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -410,7 +414,7 @@ proc rdAlarmVal {iSensor} {
# @param idx indicates which control channel the command acts upon
# @return idle Always returns system state idle - command sequence completed.
proc rdCfgValue {idx} {
if [ catch {
if {[ catch {
set data [sct result]
switch -glob -- $data {
"ASCERR:*" {
@@ -493,7 +497,7 @@ proc rdAlarmVal {iSensor} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdCfgValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -508,7 +512,7 @@ proc rdAlarmVal {iSensor} {
# @param iSensor indicates which input channel the command belongs to
# @return idle Always returns system state idle - command sequence completed.
proc rdBitValue {iSensor} {
if [ catch {
if {[ catch {
set data [sct result]
switch -glob -- $data {
"ASCERR:*" {
@@ -539,22 +543,22 @@ proc rdBitValue {iSensor} {
}
set i $data
# puts "rdBitValue(): iSensor:$iSensor, data:$data"
set bitValue [expr $i & 1]
set bitValue [expr {$i & 1}]
if {$bitValue == 1} {set sValue "Invalid reading, "}
#set i [expr $i >> 1]
# set bitValue [expr $i & 1]
# if {$bitValue == 1} {set sValue "old reading"}
set i [expr $i >> 4]
set bitValue [expr $i & 1]
set i [expr {$i >> 4}]
set bitValue [expr {$i & 1}]
if {$bitValue == 1} { set sValue [append sValue "temp underrange, "] }
set i [expr $i >> 1]
set bitValue [expr $i & 1]
set i [expr {$i >> 1}]
set bitValue [expr {$i & 1}]
if {$bitValue == 1} { set sValue [append sValue "temp overrange, "] }
set i [expr $i >> 1]
set bitValue [expr $i & 1]
set i [expr {$i >> 1}]
set bitValue [expr {$i & 1}]
if {$bitValue == 1} { set sValue [append sValue "sensor units zero, "] }
set i [expr $i >> 1]
set bitValue [expr $i & 1]
set i [expr {$i >> 1}]
set bitValue [expr {$i & 1}]
if {$bitValue == 1} { set sValue [append sValue "sensor units overrange, "] }
if { [string length $sValue] < 4 } {
set sValue "ok"
@@ -569,7 +573,7 @@ proc rdBitValue {iSensor} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdBitValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -582,7 +586,7 @@ proc rdBitValue {iSensor} {
# @param idx indicates which input channel the command acts upon
# @return idle Always returns system state idle - command sequence completed.
proc rdInpValue {idx} {
if [ catch {
if {[ catch {
set data [sct result]
switch -glob -- $data {
"ASCERR:*" {
@@ -647,7 +651,7 @@ proc rdBitValue {iSensor} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdInpValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -664,20 +668,26 @@ proc rdBitValue {iSensor} {
# @param CtrlLoopIdx indicates which control loop the command acts upon
# @return idle Always returns system state idle - command sequence completed.
proc inTolerance {CtrlLoopIdx} {
if [ catch {
if {[ catch {
set tc_root $::scobj::ls3xx::ls3xx_path2nodes
set data [sct result]
set oldval [sct oldval]
# puts "inTolerance(): data=$data oldval=$oldval idx:$CtrlLoopIdx"
set oldvalue [sct oldval]
# puts "inTolerance(): data=$data oldvalue=$oldvalue idx:$CtrlLoopIdx"
switch -glob -- $data {
"ASCERR:*" {
puts "ASCERR in inTolerance: Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
sct geterror $data
}
default {
if {$data != $oldval} {
if {$oldval == "UNKNOWN"} {
if {$data != $oldvalue} {
# timecheck is an internal node that is set to the current time at the
# start of measurement and it is reset to current time every time the tolerance
# test for a control loop decides that it is outside tolerance. With the
# ls366 we need 2 such variables, one for each control loop.
if {$oldvalue == "UNKNOWN"} {
sct utime timecheck
sct utime timecheck2
sct utime currtime
}
sct oldval $data
sct update $data
@@ -685,6 +695,7 @@ proc inTolerance {CtrlLoopIdx} {
}
}
}
sct utime currtime
# puts "inTolerance $::scobj::ls3xx::ls3xx_sct_obj_name CtrlLoopIdx:$CtrlLoopIdx data:$data"
# now update the manual nodes reporting whether the actual temperature
# is within tolerance of the corresponding setpoint
@@ -701,27 +712,33 @@ proc inTolerance {CtrlLoopIdx} {
# puts "inTolerance 2 $::scobj::ls3xx::ls3xx_sct_obj_name CtrlLoopIdx:$CtrlLoopIdx data:$data, iSensor:$iSensor"
#puts {set intol [checktol $tc_root [sct readtime] [sct timecheck] $CtrlLoopIdx $iSensor]}
if {[string length $iSensor] == 1} {
set intol [checktol $tc_root [sct readtime] [sct timecheck] $CtrlLoopIdx $iSensor]
if {$intol==0} { sct utime timecheck }
if {$CtrlLoopIdx == 1} {
set intol [checktol $tc_root [sct currtime] [sct timecheck] $CtrlLoopIdx $iSensor]
} else {
set intol [checktol $tc_root [sct currtime] [sct timecheck2] $CtrlLoopIdx $iSensor]
}
set nodename $tc_root/sensor/setpoint$CtrlLoopIdx
set setpt [hval $nodename]
set nodename $tc_root/sensor/sensorValue$iSensor
set temp [hval $nodename]
# puts "inTolerance(): comparing sensor/setpoint$CtrlLoopIdx=$setpt with actual sensorValue$iSensor=$temp"
set diff [expr abs($setpt - $temp)]
set diff [expr {abs($setpt - $temp)}]
# $::scobj::ls3xx::ls3xx_driveTolerance = 0.2 Kelvin
set tol $::scobj::ls3xx::ls3xx_driveTolerance1
if {$CtrlLoopIdx == 2} {
set tol $::scobj::ls3xx::ls3xx_driveTolerance2
}
# puts "inTolerance(): diff=$diff tol=$tol"
if {$diff > $tol} {
# if $diff > $tol
if {$intol==0} {
set nodename $tc_root/emon/monMode_Lp$CtrlLoopIdx
hset $nodename "drive"
if {$CtrlLoopIdx == 1} {
hset $tc_root/status "busy"
if {$::scobj::ls3xx::ls3xx_verbose==1} {puts "hset $nodename drive; hset $tc_root/status busy"}
} else {
hset $tc_root/status_Ctrl_Lp2 "busy"
if {$::scobj::ls3xx::ls3xx_verbose==1} {puts "hset $nodename drive; hset $tc_root/status_Ctrl_Lp2 busy"}
}
} else {
set nodename $tc_root/sensor/setpoint$CtrlLoopIdx
@@ -730,8 +747,10 @@ proc inTolerance {CtrlLoopIdx} {
hset $nodename "monitor"
if {$CtrlLoopIdx == 1} {
hset $tc_root/status "idle"
if {$::scobj::ls3xx::ls3xx_verbose==1} {puts "hset $nodename idle; hset $tc_root/status monitor"}
} else {
hset $tc_root/status_Ctrl_Lp2 "idle"
if {$::scobj::ls3xx::ls3xx_verbose==1} {puts "hset $nodename idle; hset $tc_root/status_Ctrl_Lp2 monitor"}
}
}
}
@@ -746,7 +765,7 @@ proc inTolerance {CtrlLoopIdx} {
}
}
# puts "inTolerance 4 $::scobj::ls3xx::ls3xx_sct_obj_name CtrlLoopIdx:$CtrlLoopIdx data:$data"
} message ] {
} message ]} {
return -code error "in inTolerance: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
# puts "Leaving inTolerance idx:$CtrlLoopIdx"
@@ -759,7 +778,7 @@ proc inTolerance {CtrlLoopIdx} {
# @param idx indicates which control loop or which input channel the command belongs to
# @return idle Always returns system state idle - command sequence completed.
proc rdCrvValue {idx} {
if [ catch {
if {[ catch {
set data [sct result]
switch -glob -- $data {
"ASCERR:*" {
@@ -780,7 +799,7 @@ proc rdCrvValue {idx} {
}
}
}
} message ] {
} message ]} {
return -code error "in rdCrvValue: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return idle
@@ -799,7 +818,7 @@ proc rdCrvValue {idx} {
proc setValue {tc_root nextState cmd {idx ""}} {
# tc_root and idx are not being used - however, don't remove so we can use the
# same calling mask as for setPoint() or other $wrFunc
if [ catch {
if {[ catch {
# Some commands have no argument and no matching read command, like reset_rst or alarmResetAll.
# Provide a default value for parameter 'idx' and initialize 'par' to an empty string because [sct target]
# is not an allowed operation in this case.
@@ -810,7 +829,7 @@ proc setValue {tc_root nextState cmd {idx ""}} {
set ::scobj::ls3xx::ls3xx_lastWriteCmd "$cmd$par"
# Talking to a pseudo-node (no equivalent command in the device communication)
sct send "$cmd$par"
} message ] {
} message ]} {
return -code error "in setValue: $message. While sending command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return $nextState
@@ -827,7 +846,7 @@ proc setValue {tc_root nextState cmd {idx ""}} {
proc setPseudoValue {tc_root nextState cmd {idx ""}} {
# tc_root and idx are not being used - however, don't remove so we can use the
# same calling mask as for setPoint() or other $wrFunc
if [ catch {
if {[ catch {
# Some commands have no argument and no matching read command, like reset_rst or alarmResetAll.
# Provide a default value for parameter 'idx' and initialize 'par' to an empty string because [sct target]
# is not an allowed operation in this case.
@@ -839,7 +858,7 @@ proc setPseudoValue {tc_root nextState cmd {idx ""}} {
# Talking to a pseudo-node (no equivalent command in the device communication)
# puts "setPseudoValue($tc_root $nextState $cmd $idx)"
#sct send "$cmd$par"
} message ] {
} message ]} {
return -code error "in setPseudoValue: $message. While processing command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return $nextState
@@ -862,7 +881,7 @@ proc noResponse {} {
# @param whichCtrlLoop specifies whether the setpoint is for control loop 1 or 2
# @return nextState
proc setPoint {tc_root nextState cmd whichCtrlLoop} {
if [ catch {
if {[ catch {
#puts "executing setPoint ($tc_root $nextState $cmd $whichCtrlLoop)"
#broadcast setPoint "executing setPoint ($tc_root $nextState $cmd $whichCtrlLoop)"
set ns ::scobj::lh45
@@ -880,7 +899,7 @@ proc setPoint {tc_root nextState cmd whichCtrlLoop} {
}
#puts "setPoint(wrStatus=$wrStatus): sct send $cmd$par"
sct send "$cmd$par"
} message ] {
} message ]} {
return -code error "in setPoint: $message. Last write command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return $nextState
@@ -898,7 +917,7 @@ proc setPoint {tc_root nextState cmd whichCtrlLoop} {
proc sendCmd {tc_root nextState cmd {idx ""}} {
# tc_root and idx are not being used - however, don't remove so we can use the
# same calling mask as for setPoint() or other $wrFunc
if [ catch {
if {[ catch {
# Some commands have no argument and no matching read command, like reset_rst or alarmResetAll.
# Provide a default value for parameter 'idx' and initialize 'par' to an empty string because [sct target]
# is not an allowed operation in this case.
@@ -909,11 +928,11 @@ proc sendCmd {tc_root nextState cmd {idx ""}} {
set ::scobj::ls3xx::ls3xx_lastWriteCmd "$cmd$par"
#sct send "$cmd$par"
if { 0 == [string compare -length 4 $cmd "*RST"]} {
$sct_controller queue $tc_root/other/selftest progress read
sct_controller queue $tc_root/other/selftest progress read
} elseif { 0 == [string compare -length 6 $cmd "ALMRST"]} {
$sct_controller queue $tc_root/input/alarmResetAll progress read
sct_controller queue $tc_root/input/alarmResetAll progress read
}
} message ] {
} message ]} {
return -code error "in setValue: $message. While sending command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return $nextState
@@ -929,13 +948,13 @@ proc sendCmd {tc_root nextState cmd {idx ""}} {
# NOTE: The drive adapter initially sets the writestatus to "start" and will
# only call this when writestatus!="start"
proc drivestatus {tc_root} {
if [ catch {
if [sct driving] {
if {[ catch {
if {[sct driving]} {
set retval busy
} else {
set retval idle
}
} message ] {
} message ]} {
return -code error "in drivestatus: $message. Last write command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return $retval
@@ -993,7 +1012,7 @@ proc getValFromString {s element separator} {
# startIdx points to the first non-blank character of the value we are interested in
set returnval ""
if {$startIdx < 0} {
return returnval
return $returnval
}
set endIdx [string first $separator $s $startIdx]
incr endIdx -1
@@ -1054,7 +1073,7 @@ proc getCorrespondingInputSensor {CtrlLoopIdx} {
# @param iSensor indicates the corresponding input sensor (A,B,C or D)
# @return retVal returns 1 if in tolerance, 0 else.
proc checktol {tc_root currtime timecheck iLoop iSensor} {
if [ catch {
if {[ catch {
set retVal 0
set sensorValue $tc_root/sensor/sensorValue$iSensor
set temp [hval $sensorValue]
@@ -1064,25 +1083,40 @@ proc checktol {tc_root currtime timecheck iLoop iSensor} {
if {$iLoop == 2 } {
set tol [hval $tc_root/control/tolerance2]
}
set lotemp [expr $setpt - $tol]
set hitemp [expr $setpt + $tol]
# puts "checktol: setpt=$setpt lotemp=$lotemp, temp=$temp, hitemp=$hitemp, tol=$tol, iLoop=$iLoop"
set lotemp [expr {$setpt - $tol}]
set hitemp [expr {$setpt + $tol}]
if {$::scobj::ls3xx::ls3xx_verbose==1} {
puts "checktol(): setpt $isetp=$setpt lotemp=$lotemp, current $sensorValue=$temp, hitemp=$hitemp, tol=$tol, iLoop=$iLoop, timecheck=$timecheck, currtime=$currtime"
}
if { $temp < $lotemp || $temp > $hitemp} {
hset $tc_root/emon/isInTolerance_Lp$iLoop "outsideTolerance"
if {$::scobj::ls3xx::ls3xx_verbose==1} {puts "hset $tc_root/emon/isInTolerance_Lp$iLoop outsideTolerance"}
if {$iLoop==1} { sct utime timecheck }
if {$iLoop==2} { sct utime timecheck2 }
set retVal 0
} else {
set timeout $::scobj::ls3xx::ls340_settleTime
if { $::scobj::ls3xx::ls3xx_LSmodel == 340 } {
set timeout [hval $tc_root/control/settleTime_Loop_1]
}
set elapsedTime [expr abs($currtime - $timecheck)]
set elapsedTime [expr {$currtime - $timecheck}]
#puts "if (elapsedTime=$elapsedTime > timeout=$timeout) we are inTolerance"
if {$elapsedTime > $timeout} {
hset $tc_root/emon/isInTolerance_Lp$iLoop "inTolerance"
if {$::scobj::ls3xx::ls3xx_verbose==1} {
puts "hset $tc_root/emon/isInTolerance_Lp$iLoop inTolerance (elapsedTime=$elapsedTime greater than settleTime=$timeout)"
}
set retVal 1
} else {
# Temperature has not been within tolerance for enough time - (overshoots, oscillations,..)
hset $tc_root/emon/isInTolerance_Lp$iLoop "outsideTolerance"
if {$::scobj::ls3xx::ls3xx_verbose==1} {
puts "hset $tc_root/emon/isInTolerance_Lp$iLoop outsideTolerance (elapsedTime=$elapsedTime less than settleTime=$timeout)"
}
} message ] {
set retVal 0
}
}
} message ]} {
return -code error "in checktol: $message. Last query command: $::scobj::ls3xx::ls3xx_lastQueryCmd"
}
return $retVal
@@ -1095,7 +1129,7 @@ proc checktol {tc_root currtime timecheck iLoop iSensor} {
# @param whichCtrlLoop index of the control loop we are operating on (is 1 or 2)
# @return 'OK' if the new setpoint is within the alarm levels; else an error is reported
proc check {tc_root whichCtrlLoop} {
if [ catch {
if {[ catch {
set setpoint [sct target]
#puts "check(): setpoint= $setpoint"
# determine the corresponding input sensor
@@ -1135,7 +1169,7 @@ proc check {tc_root whichCtrlLoop} {
error "sct_ls3xx.tcl: setpoint $tc_root/sensor/sensorValue$whichSensor violates set alarm limits"
}
}
} message ] {
} message ]} {
return -code error "in check(): $message. Last write command: $::scobj::ls3xx::ls3xx_lastWriteCmd"
}
return OK
@@ -1164,7 +1198,7 @@ proc check {tc_root whichCtrlLoop} {
# from the user manual for the Lakeshore 336 and 340 but is shortened in some
# cases due to the restriction to max 500 characters.
proc helpNotes4user {scobj_hpath cmdGroup varName} {
if [ catch {
if {[ catch {
set nodeName "$scobj_hpath/$cmdGroup/$varName"
# We presume that SICServer is running on Linux but Gumtree on Windows.
# Hence multi-line help texts should use CRLF instead of only LF
@@ -1603,13 +1637,13 @@ proc helpNotes4user {scobj_hpath cmdGroup varName} {
}
default {
set helptext {Sorry mate. No help available.}
puts "No help info available for node $varName"de
puts "No help info available for node $varName"
}
}
#set sLen [string bytelength $helptext]
#puts "helptext ($sLen bytes) $helptext"
hsetprop $nodeName help $helptext
} message ] {
} message ]} {
return -code error "in helpNotes4user: $message"
}
}
@@ -1635,11 +1669,11 @@ proc helpNotes4user {scobj_hpath cmdGroup varName} {
# @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 (?)
# @param klasse Nexus class name (?)
# @return OK
proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
pollEnabled drivable idx ls340 ls336 dataType permission rdCmd rdFunc wrCmd\
wrFunc allowedValues klass lsModel} {
wrFunc allowedValues klasse lsModel} {
#puts "createing node for: $scobj_hpath $cmdGroup $varName $readable $writable $pollEnabled $drivable $idx $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc"
#puts "createNode, lsModel = $lsModel, ls340=$ls340, ls336=$ls336, varName=$varName "
if {$lsModel == 340 && $ls340 == 0} {
@@ -1652,7 +1686,7 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
return OK
}
# It is a command that is supported by the device
if [ catch {
if {[ catch {
set ns ::scobj::ls3xx
set nodeName "$scobj_hpath/$cmdGroup/$varName"
if {1 > [string length $cmdGroup]} {
@@ -1692,7 +1726,7 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
hsetprop $nodeName checkstatus ${ns}::drivestatus $scobj_hpath
hsetprop $nodeName halt ${ns}::halt $scobj_hpath $idx
}
} message ] {
} message ]} {
return -code error "in createNode $message"
}
helpNotes4user $scobj_hpath $cmdGroup $varName
@@ -1703,15 +1737,16 @@ proc createNode {scobj_hpath sct_controller cmdGroup varName readable writable\
##
# @brief mk_sct_lakeshore_3xx() creates a scriptcontext object for a Lakeshore 336 or 340 temperature controller
# @param sct_controller name of the ls3xx scriptcontext object (typically sct_ls3xx_tc1 or tc2)
# @param klass Nexus class name (?), typically 'environment'
# @param klasse Nexus class name (?), typically 'environment'
# @param tempobj short name for the temperature controller scriptcontext object (typ. tc1 or tc2)
# @param tol temperature tolerance in Kelvin (typ. 1)
# @return nothing (well, the sct object)
proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
if [ catch {
proc mk_sct_lakeshore_3xx {sct_controller klasse tempobj LSmodel tol1 tol2 verbose} {
if {[ catch {
set ::scobj::ls3xx::ls3xx_driveTolerance1 $tol1
set ::scobj::ls3xx::ls3xx_driveTolerance2 $tol2
set ::scobj::ls3xx::ls3xx_LSmodel $LSmodel
set ::scobj::ls3xx::ls3xx_verbose $verbose
set ns ::scobj::ls3xx
set ::scobj::ls3xx::ls3xx_sct_obj_name $tempobj
@@ -1722,7 +1757,7 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
#set ::scobj::ls3xx::ls3xx_term "" ! obsolete
MakeSICSObj $tempobj SCT_OBJECT
sicslist setatt $tempobj klass $klass
sicslist setatt $tempobj klass $klasse
sicslist setatt $tempobj long_name $tempobj
# Create a base node for all the state machines of this sics object
set scobj_hpath /sics/$tempobj
@@ -1871,7 +1906,7 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
hfactory $scobj_hpath/sensor plain spy none
# Flags ls340 and ls336 indicate whether this command is support by Lakeshore model ls340 and ls336, respectively
foreach {cmdGroup varName readable writable pollEnabled drivable idx ls340 ls336 dataType permission rdCmd rdFunc wrCmd wrFunc allowedValues} $deviceCommandToplevel {
createNode $scobj_hpath $sct_controller $cmdGroup $varName $readable $writable $pollEnabled $drivable $idx $ls340 $ls336 $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc $allowedValues $klass $LSmodel
createNode $scobj_hpath $sct_controller $cmdGroup $varName $readable $writable $pollEnabled $drivable $idx $ls340 $ls336 $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc $allowedValues $klasse $LSmodel
}
# create a base node for each commandGroup element - these are all polled
@@ -1882,7 +1917,7 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
hfactory $scobj_hpath/other plain spy none
foreach {cmdGroup varName readable writable pollEnabled drivable idx ls340 ls336 dataType permission rdCmd rdFunc wrCmd wrFunc allowedValues} $deviceCommand {
createNode $scobj_hpath $sct_controller $cmdGroup $varName $readable $writable $pollEnabled $drivable $idx $ls340 $ls336 $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc $allowedValues $klass $LSmodel
createNode $scobj_hpath $sct_controller $cmdGroup $varName $readable $writable $pollEnabled $drivable $idx $ls340 $ls336 $dataType $permission $rdCmd $rdFunc $wrCmd $wrFunc $allowedValues $klasse $LSmodel
# helpNotes4user $scobj_hpath $cmdGroup $varName
}
@@ -1994,8 +2029,8 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
$scobj_hpath sensorValueD sensor _sensor_sensorValueD
"
}
foreach {rootpath hpath klass priv} $nxProperties {
hsetprop $rootpath/$hpath klass $klass
foreach {rootpath hpath klasse priv} $nxProperties {
hsetprop $rootpath/$hpath klass $klasse
hsetprop $rootpath/$hpath privilege $priv
hsetprop $rootpath/$hpath control true
hsetprop $rootpath/$hpath data true
@@ -2026,13 +2061,14 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
# initialise the device
ls3xx_init $sct_controller $scobj_hpath
puts "Lakeshore $::scobj::ls3xx::ls3xx_LSmodel temperature controller ready at /sample/$tempobj (Driver 2009-11-27)"
} message ] {
puts "Lakeshore $::scobj::ls3xx::ls3xx_LSmodel temperature controller ready at /sample/$tempobj (Driver 2010-03-05)"
} message ]} {
return -code error "in mk_sct_lakeshore_3xx $message"
}
}
# endproc mk_sct_lakeshore_3xx sct_controller klasse tempobj tol ls3xx_LSmodel
namespace export mk_sct_lakeshore_3xx
# endproc mk_sct_lakeshore_3xx sct_controller klass tempobj tol ls3xx_LSmodel
}
# end of namespace mk_sct_lakeshore_3xx
@@ -2044,21 +2080,21 @@ proc mk_sct_lakeshore_3xx {sct_controller klass tempobj tol1 tol2 LSmodel} {
# @param port port number on the moxabox (typ. 4001, 4002, 4003, or 4004)
# @param tol temperature tolerance in Kelvin (typ. 1)
# @return nothing (well, the sct object)
proc add_ls3xx {name IP port terminator {_tol1 1.0} {_tol2 1.0} {_ls3xx_LSmodel 340} } {
proc add_ls3xx {name IP port terminator {_ls3xx_LSmodel 340} {_tol1 1.0} {_tol2 1.0} {_verbose 0} } {
# ffr 2009-11-09, Don't create a temperature controller for the script validator, this causes the
# lakeshore to lock up.
# NOTE: I put this outside the catch block because "return" raises an exception
if [SplitReply [environment_simulation]] {
if {[SplitReply [environment_simulation]]} {
return
}
if [ catch {
if {[ catch {
puts "\nadd_ls3xx: makesctcontroller $name std ${IP}:$port for Lakeshore model $_ls3xx_LSmodel"
makesctcontroller sct_ls3xx_$name std ${IP}:$port $terminator
mk_sct_lakeshore_3xx sct_ls3xx_$name environment $name $_tol1 $_tol2 $_ls3xx_LSmodel
mk_sct_lakeshore_3xx sct_ls3xx_$name environment $name $_ls3xx_LSmodel $_tol1 $_tol2 $_verbose
makesctemon $name /sics/$name/emon/monMode_Lp1 /sics/$name/emon/isInTolerance_Lp1 /sics/$name/emon/errhandler
# set m2 "_2"
# makesctemon $name$m2 /sics/$name/emon/monMode_Lp2 /sics/$name/emon/isInTolerance_Lp2 /sics/$name/emon/errhandler
} message ] {
} message ]} {
return -code error "in add_ls3xx: $message"
}
}

2
site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl
View File

@@ -215,7 +215,7 @@ set instrument_dictionary [subst {
privilege spy
sobj {@any plc}
datatype @none
property {data false control true nxsave false klass @none type part}
property {data true control true nxsave false klass @none type part}
}
data {
privilege spy

36
site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl
View File

@@ -269,13 +269,27 @@ if {0} {
# value on all the servers.
proc clock_scale {args} {
switch $args {
"" { return 1 }
"" { return [expr [SplitReply [hmm configure fat_clock_scale]]/1000.0] }
"units" { return "microseconds"}
default {
todo_msg "Set clock_scale as an integer number of nanoseconds"
return -code error "[info level 0]: Invalid argument $args"
}
}
}
proc get_clock_scale {} {
return [SplitReply [hmm configure fat_clock_scale]]
}
proc set_clock_scale {val} {
set catch_status [ catch {
if {[string is integer $val] == 0} {
error "ERROR: clock scale should be an integer. NOTE: The clock base is in nanoseconds"
}
hmm configure fat_clock_scale $val
::histogram_memory::stop
hmm init
} message ]
handle_exception $catch_status $message
}
## @brief Use boundaries or centres to calculate axis values
#
# @param axis_name x_bin, y_bin, x_pixel_offset, y_pixel_offset, two_theta
@@ -850,7 +864,7 @@ proc CAT_TABLE {args} {
#
proc FAT_TABLE {args} {
if [ catch {
set attributes { FRAME_FREQUENCY SIZE_PERIOD NOS_PERIODS COUNT_METHOD COUNT_SIZE READ_DATA_TYPE VIEW_MAG_X VIEW_MAG_Y HISTO_STREAMING P7888_PLL_FREQ_CARD_X P7888_PLL_FREQ_CARD_Y P7888_CARD_MODE_X P7888_CARD_MODE_Y RAW_HISTO_XMIN RAW_HISTO_XMAX RAW_HISTO_YMIN RAW_HISTO_YMAX TEST_HISTO_1D_SIZES TEST_HISTO_2D_SIZES P7888_PLL_SYNC_METHOD }
set attributes { FRAME_FREQUENCY FRAME_BUFFER FRAME_DUTYCYCLE SIZE_PERIOD NOS_PERIODS COUNT_METHOD COUNT_SIZE READ_DATA_TYPE VIEW_MAG_X VIEW_MAG_Y HISTO_STREAMING P7888_PLL_FREQ_CARD_X P7888_PLL_FREQ_CARD_Y P7888_CARD_MODE_X P7888_CARD_MODE_Y RAW_HISTO_XMIN RAW_HISTO_XMAX RAW_HISTO_YMIN RAW_HISTO_YMAX TEST_HISTO_1D_SIZES TEST_HISTO_2D_SIZES P7888_PLL_SYNC_METHOD }
set elements {{ }}
@@ -1262,6 +1276,7 @@ proc ::histogram_memory::upload_config {filler_defaults} {
# Restore the init level to 0
# subesquent inits will only upload specified FAT settings to histogram server.
hmm configure init 0
hmm init
# Now issue stop to the server.
# This not only makes sure it's stopped, but lets us see certain configuration variables
@@ -1394,7 +1409,6 @@ proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} {
::set newfreq $freq
}
::histogram_memory::stop
set clock_scale_ns 1000.0
hmm configure fat_frame_frequency $newfreq
hmm init
} message ] {
@@ -1504,6 +1518,7 @@ proc ::histogram_memory::ic_initialize {} {
::histogram_memory::initialise_dictionary
::histogram_memory::frame_source_always_internal $default_frame_source_always_internal([instname])
::histogram_memory::set_frame_freq 50
::histogram_memory::set_clock_scale 1000
::histogram_memory::set_frame_source $default_frame_source_when_there_is_no_frame_signal([instname])
::histogram_memory::count_method unlimited
::histogram_memory::count_size 0
@@ -1591,14 +1606,14 @@ proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::veto {action} {
switch $action {
"enable" {
"on" {
if {[status] == "status = Counting"} {
hmm veto
} else {
error "ERROR: veto only allowed while counting"
}
}
"disable" {
"off" {
if {[status] == "status = Paused"} {
hmm noveto
} else {
@@ -1606,7 +1621,7 @@ proc ::histogram_memory::post_count {} {}
}
}
default {
error "ERROR: $action must be 'enable' or 'disable'"
error "ERROR: $action must be 'on' or 'off'"
}
}
}
@@ -1800,6 +1815,13 @@ namespace eval ::histogram_memory {
eval "::histogram_memory::count_size $args"
}
}
"clockscale" {
if {$args == ""} {
set reply [::histogram_memory::get_clock_scale ]
} else {
eval "::histogram_memory::set_clock_scale $args"
}
}
"freq" {
if {$args == ""} {
set reply [::histogram_memory::get_frame_freq ]

36
site_ansto/instrument/config/hmm/hmm_object.tcl
View File

@@ -213,38 +213,38 @@ proc ::histogram_memory::set_axes {typelist} {
switch [string toupper $type] {
"HISTOGRAM_XYT" - "HISTOPERIOD_XYT" {
lappend rank 3
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim0 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim1 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim2 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim2 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1,$dim2"
lappend hmmslabstart [list 0 0 0]
lappend hmmslabend [list $dim0 $dim1 $dim2]
lappend hmmperiodsize [expr $dim0 * $dim1 * $dim2]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR VER TOF}]
lappend axeslist [::histogram_memory::gen_axes {SVAR TOF VER HOR}]
lappend siglist $signal
lappend hmmdatname $HMOBJ
}
"HISTOGRAM_XY" - "HISTOPERIOD_XY" {
lappend rank 2
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim0 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1"
lappend hmmslabstart [list 0 0]
lappend hmmslabend [list $dim0 $dim1]
lappend hmmperiodsize [expr $dim0 * $dim1]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR VER}]
lappend axeslist [::histogram_memory::gen_axes {SVAR VER HOR}]
lappend siglist $signal
lappend hmmdatname "${HMOBJ}_xy"
}
"HISTOGRAM_XT" - "HISTOPERIOD_XT" {
lappend rank 2
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim1 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim0 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim1 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1"
lappend hmmslabstart [list 0 0]
lappend hmmslabend [list $dim0 $dim1]
lappend hmmperiodsize [expr $dim0 * $dim1]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR TOF}]
lappend axeslist [::histogram_memory::gen_axes {SVAR TOF HOR}]
lappend siglist $signal
lappend hmmdatname "${HMOBJ}_xt"
}
@@ -295,37 +295,37 @@ proc ::histogram_memory::set_axes {typelist} {
}
"TOTAL_HISTOGRAM_XY" {
lappend rank 2
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim0 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1"
lappend hmmslabstart [list 0 0]
lappend hmmslabend [list $dim0 $dim1]
lappend hmmperiodsize [expr $dim0 * $dim1]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR VER}]
lappend axeslist [::histogram_memory::gen_axes {SVAR VER HOR}]
lappend siglist $signal
lappend hmmdatname "${HMOBJ}_total_xy"
}
"TOTAL_HISTOGRAM_XY_CORRECTED" {
lappend rank 2
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim0 [SplitReply [$HMOBJ configure $INST_NYC]]
set dim1 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1"
lappend hmmslabstart [list 0 0]
lappend hmmslabend [list $dim0 $dim1]
lappend hmmperiodsize [expr $dim0 * $dim1]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR VER}]
lappend axeslist [::histogram_memory::gen_axes {SVAR VER HOR}]
lappend siglist $signal
lappend hmmdatname "${HMOBJ}_total_xy_corrected"
}
"TOTAL_HISTOGRAM_XT" {
lappend rank 2
set dim0 [SplitReply [$HMOBJ configure $INST_NXC]]
set dim1 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim0 [SplitReply [$HMOBJ configure oat_ntc_eff]]
set dim1 [SplitReply [$HMOBJ configure $INST_NXC]]
lappend dimstr "$dim0,$dim1"
lappend hmmslabstart [list 0 0]
lappend hmmslabend [list $dim0 $dim1]
lappend hmmperiodsize [expr $dim0 * $dim1]
lappend axeslist [::histogram_memory::gen_axes {SVAR HOR TOF}]
lappend axeslist [::histogram_memory::gen_axes {SVAR TOF HOR}]
lappend siglist $signal
lappend hmmdatname "${HMOBJ}_total_xt"
}

373
site_ansto/instrument/config/hmm/sct_orhvps_common.tcl Executable file
View File

@@ -0,0 +1,373 @@
##
# @file Implements control for the Ordela high voltage power supply using the odrhvps protocol handler.
#
# This controller implements voltage ramping and always reads the current value before
# attempting to set the new voltage.
MakeSicsObj so_dhv1 SCT_OBJECT
namespace eval ::scobj::dethvps { }
##
# @brief Requests a value using the given command.
#
# @param nextSubState, Specifies the state which will handle the reply.
# @param cmd, The query command.
proc ::scobj::dethvps::rqValue {nextSubState cmd} {
set catch_status [ catch {
sct send $cmd
return $nextSubState
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Processes replies from the voltage controller and controls the
# transition between the ramping superstates.
#
# @param vPath, Hdb node path for the voltage.
proc ::scobj::dethvps::rdValue {vPath} {
variable RAMPIDLE
variable RAMPSTOP
variable RAMPSTART
variable RAMPBUSY
variable MAXPOTVAL
variable RAMPINTEREST
set catch_status [ catch {
set data [sct result]
set currSuperState [sct ramping]
switch -glob -- $data {
"ASCERR:*" {
sct geterror $data
if {$currSuperState == $RAMPBUSY || $currSuperState == $RAMPSTART} {
broadcast "ERROR: $data, dhv1 stopped ramping detector voltage"
statemon stop dhv1
} else {
# broadcast "ERROR: $data"
}
if {$currSuperState != $RAMPIDLE} {
sct ramping $RAMPIDLE
}
return idle
}
default {
if {$data != [sct oldval]} {
sct geterror ""
sct oldval $data
sct update $data
set voltage [expr [sct max] * $data / double($MAXPOTVAL) ]
hset $vPath $voltage
if {$RAMPINTEREST} {
broadcast "dhv1 = $voltage"
}
sct utime readtime
}
}
}
switch $currSuperState [ subst {
$RAMPSTART {
sct ramping $RAMPBUSY
statemon start dhv1
return ramp
}
$RAMPBUSY {
return ramp
}
$RAMPSTOP {
sct ramping $RAMPIDLE
statemon stop dhv1
return idle
}
$RAMPIDLE {
return idle
}
default {
broadcast "ERROR: dhv1([info level 0]) sct ramping = [sct ramping], STOPPING"
sct ramping $RAMPIDLE
statemon stop dhv1
return idle
}
} ]
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Checks the target voltage and sets the ramping superstate and ramp direction.
proc ::scobj::dethvps::setValue {nextSubState} {
variable RAMPIDLE
variable RAMPSTOP
variable RAMPSTART
variable RAMPBUSY
set catch_status [ catch {
set par [sct target]
set maxV [sct max]
if {$par < 0 || $par > $maxV} {
broadcast "ERROR: dhv1 target must be between 0 and $maxV"
sct seterror "ERROR: dhv1 target must be between 0 and $maxV"
return idle
}
set currSuperState [sct ramping]
set oldval [sct oldval]
if {$par == $oldval} {
if {$currSuperState == $RAMPBUSY || $currSuperState == $RAMPSTART} {
sct ramping $RAMPSTOP
}
return idle
}
if {$par < $oldval} {
sct rampstep -1
} else {
sct rampstep 1
}
if {$currSuperState != $RAMPBUSY && $currSuperState != $RAMPSTART} {
sct ramping $RAMPSTART
}
return $nextSubState
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Checks that a command has been acknowledged
proc ::scobj::dethvps::getACK {} {
variable RAMPIDLE
variable RAMPSTOP
variable RAMPSTART
variable RAMPBUSY
set catch_status [ catch {
set currSuperState [sct ramping]
set data [sct result]
switch -glob $data {
"ASCERR:*" {
sct seterror $data
if {$currSuperState == $RAMPBUSY || $currSuperState == $RAMPSTART} {
broadcast "ERROR: $data, dhv1 stopped ramping detector voltage"
statemon stop dhv1
} else {
# broadcast "ERROR: $data"
}
if {$currSuperState != $RAMPSTOP} {
sct ramping $RAMPSTOP
}
return idle
}
ACK {
return idle
}
default {
return idle
}
}
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Increments or decrements voltage until target has been reached
#
# @param cmd, The set voltage command
proc ::scobj::dethvps::ramping {cmd} {
variable RAMPIDLE
variable RAMPSTOP
variable RAMPSTART
variable RAMPBUSY
variable MINRAMPINTERVAL
set catch_status [ catch {
set rampstep [sct rampstep]
set target [sct target]
set oldval [sct oldval]
switch -- $rampstep {
1 {
if {$oldval >= $target} {
sct ramping $RAMPSTOP
return idle
}
}
-1 {
if {$oldval <= $target} {
sct ramping $RAMPSTOP
return idle
}
}
default {
sct ramping $RAMPSTOP
broadcast "ERROR: dhv1, Invalid ramp step: $rampstep STOPPING"
sct seterror "ERROR: dhv1, Invalid ramp step: $rampstep"
return idle
}
}
set target [expr [sct oldval] + [sct rampstep]]
sct send "$cmd $target"
return getACK
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Command interface for voltage controller
proc ::scobj::dethvps::drvCmd {} {
variable RAMPIDLE
variable RAMPSTOP
variable RAMPSTART
variable RAMPBUSY
variable potValPath
set catch_status [ catch {
set cmd [sct target]
switch -- $cmd {
"halt" - "stop" {
hsetprop $potValPath ramping $RAMPSTOP
}
"up" {
hset $potValPath [sct upper]
}
"down" {
hset $potValPath [sct lower]
}
"off" {
hset $potValPath 0
}
default {
clientput "ERROR: Unknown command $cmd"
sct seterror "ERROR: Unknown command $cmd"
return idle
}
}
return idle
} msg ]
handle_exception $catch_status $msg
}
##
# @brief Implements the old command line interface for the dhv1 voltage controller.
proc ::scobj::dethvps::dhv1 {{CMD getVoltage} {val ""} } {
variable RAMPINTEREST
variable potValPath
variable voltagePath
variable cmdPath
set catch_status [ catch {
set qsObjPath ""
switch -- $CMD {
"list" {
clientput "dhv1.interval = [hgetpropval $potValPath interval]"
clientput "dhv1.upper = [hgetpropval $cmdPath upper]"
clientput "dhv1.lower = [hgetpropval $cmdPath lower]"
clientput "dhv1.max = [hgetpropval $potValPath max]"
return
}
"interval" {
return "dhv1.interval = [hgetpropval $potValPath interval]"
}
"max" {
set qsObjPath $potValPath
}
"upper" {
if {$val > 63.0} {
error "dhv1 upper must be no greater than 63"
}
set qsObjPath $cmdPath
}
"lower" {
if {$val > 63.0} {
error "dhv1 lower must be no greater than 63"
}
set qsObjPath $cmdPath
}
"getVoltage" {
return "[info level 0 ] = [hval $voltagePath]"
}
"interest" {
set RAMPINTEREST 1
statemon interest
}
"uninterest" {
set RAMPINTEREST 0
statemon uninterest
}
"reset" - "lock" - "unlock" - "debug" {
return
}
default {
hset $cmdPath $CMD
}
}
if {$qsObjPath != ""} {
if {$val != ""} {
if {[SplitReply [config myrights]] == 0} {
hsetprop $qsObjPath $CMD $val
} else {
error "ERROR: $CMD can only be initialised from a configuration file"
}
} else {
return "dhv1.$CMD = [hgetpropval $qsObjPath $CMD]"
}
}
} msg ]
handle_exception $catch_status $msg
}
namespace eval ::scobj::dethvps {
variable RAMPIDLE 0
variable RAMPSTOP 1
variable RAMPSTART 2
variable RAMPBUSY 3
variable MINRAMPINTERVAL 10
variable RAMPINTEREST 0
variable MAXPOTVAL 63.0
variable INITMAXVOLTAGE 2600.0
variable INITUPPERPOTVAL 57
variable INITLOWERPOTVAL 19
variable potValPath /sics/so_dhv1/potval
variable voltagePath /sics/so_dhv1/voltage
variable cmdPath /sics/so_dhv1/cmd
namespace export dhv1
hfactory $potValPath plain user int
hsetprop $potValPath read ::scobj::dethvps::rqValue rdValue "H"
hsetprop $potValPath rdValue ::scobj::dethvps::rdValue $voltagePath
hsetprop $potValPath write ::scobj::dethvps::setValue idle
hsetprop $potValPath getACK ::scobj::dethvps::getACK
hsetprop $potValPath ramp ::scobj::dethvps::ramping "h"
hsetprop $potValPath ramping $RAMPIDLE
hsetprop $potValPath rampstep 0
hsetprop $potValPath oldval -1
hsetprop $potValPath max $INITMAXVOLTAGE
hsetprop $potValPath interval -1
hfactory $voltagePath plain internal float
hset $voltagePath -1
hfactory $cmdPath plain user text
hsetprop $cmdPath write ::scobj::dethvps::drvCmd
hsetprop $cmdPath upper $INITUPPERPOTVAL
hsetprop $cmdPath lower $INITLOWERPOTVAL
}
proc ::scobj::dethvps::init {host ip rampinterval} {
variable potValPath
variable voltagePath
variable cmdPath
variable MINRAMPINTERVAL
if {[SplitReply [detector_simulation]] == "false"} {
makesctcontroller sct_dhv ordhvps $host:$ip
set MINRAMPINTERVAL $rampinterval
hsetprop $potValPath interval $rampinterval
sct_dhv poll $potValPath $rampinterval
sct_dhv write $potValPath
sct_dhv write $cmdPath
}
}
namespace import ::scobj::dethvps::dhv1
publish dhv1 user

330
site_ansto/instrument/config/motors/sct_positmotor_common.tcl
View File

@@ -3,275 +3,115 @@
# position. The second column is the motor position.
# The lookup table must have a header which names the two columns.
namespace eval ::scobj::positmotor {
variable posit_table
variable posit_indices
# TODO Add a script to edit the posit_table and attach it to indexed nodes with read and write actions.
proc abort_on_invalid_posindex {pos motor} {
variable posit_indices
set pos0 [lindex $posit_indices($motor) 0]
set posend [lindex $posit_indices($motor) end]
if {$pos < $pos0 || $pos > $posend} {
return -code error "ERROR: Indexed position must be between $pos0 and $posend"
}
}
proc isbetween {val l1 l2} {
if {($l1 <= $val && $val <= $l2) || ($l2 <= $val && $val <= $l1)} {
return true
} else {
return false
}
}
proc iswithin {val pos prec} {
if {[expr $pos - $prec] <= $val && $val <= [expr $pos + $prec]} {
return true
} else {
return false
}
}
namespace eval ::scobj::positmotor { }
##
# @brief Convert an indexed position to a physical motor position
proc pos2val {pos motor} {
variable posit_table
if [ catch {
abort_on_invalid_posindex $pos $motor
set bot [expr int(floor($pos))]
set top [expr int(ceil($pos))]
set fract [expr fmod($pos,1)]
set val [expr $fract * ($posit_table($motor,$top) - $posit_table($motor,$bot)) + $posit_table($motor,$bot)]
} message ] {
return -code error $message
} else {
return $val
}
}
##
# @brief Convert a physical motor position to and indexed position
proc val2pos {val precision motor} {
variable posit_table
variable posit_indices
set val [expr double($val)]
set pos0 [lindex $posit_indices($motor) 0]
set posend [lindex $posit_indices($motor) end]
if {$posit_table($motor,$pos0) < $posit_table($motor,$posend)} {
set fwd_table true
if {$val < [expr $posit_table($motor,$pos0) - $precision]} {return -$pos0}
if {$val > [expr $posit_table($motor,$posend) + $precision]} {return -$posend}
} else {
set fwd_table false
if {$val < [expr $posit_table($motor,$posend) - $precision]} {return -$posend}
if {$val > [expr $posit_table($motor,$pos0) + $precision]} {return -$pos0}
}
if [catch {
set ibot $pos0
set itop [lindex $posit_indices($motor) 1]
if {$fwd_table} {
while {$val > [expr $posit_table($motor,$itop) + $precision]} {
incr ibot
incr itop
}
} else {
while {$val < [expr $posit_table($motor,$itop) - $precision]} {
incr ibot
incr itop
}
}
set bot [expr $posit_table($motor,$ibot)]
set top [expr $posit_table($motor,$itop)]
if [iswithin $val $bot $precision] {
set pos $ibot
} elseif [iswithin $val $top $precision] {
set pos $itop
} else {
# set pos [format "%.3f" [expr int(($val -$bot)/$precision)*$precision/($top - $bot) + $ibot]]
set pos [expr abs(int(($val -$bot)/$precision)*$precision/($top - $bot)) + $ibot]
}
} errmsg] {
return -code error $errmsg
} else {
return $pos
}
}
proc rd_index {par motor} {
sct result [SplitReply [$motor]]
return state_reading_index
}
##
# @brief Updates the position index and sets the associated instrument
# parameter
#
# @param path, Script context object path
# @param par, Control parameter for the positional motor
# @param motor, The name of the motor which does the actual driving
# @param staticpar, The static parameter defined in the lookup table.
# @param calc_instpar, Name of an optional function which calculates
# the instrument parameter from the staticpar. Eg attenuation
proc state_reading_index {path par motor staticpar calc_instpar} {
variable posit_table
variable posit_label
sct writestatus replyreceived
set rply [val2pos [sct result] [hval $path/$par/motprecision] $motor]
set data $rply
# broadcast state_reading_index update parameter $par $data
if {$data != [sct oldval] || [sct force_update] } {
# if {[status] == "status = Driving" && [hval $path/status] == "IDLE"} {
# hset $path/status BUSY
# }
sct oldval $data
sct update $data
if {$data > 0 && [string is integer $data]} {
if {$calc_instpar == "@none"} {
hset $path/$staticpar $posit_label($motor,$data)
} else {
hset $path/$staticpar [$calc_instpar $posit_label($motor,$data)]
}
}
sct force_update False
sct utime readtime
# @brief Translate and report the current motor reading.
proc ::scobj::positmotor::rptVal {val2IDXfn table precision_node} {
set newVal [$val2IDXfn [sct result] [hval $precision_node] $table]
if {[sct oldval] != $newVal} {
sct update $newVal
sct oldval $newVal
}
set path [sct]
if {[hval $path/status] == "STOPPING"} {
hset $path/status IDLE
hset $path/status "IDLE"
}
return idle
}
# Convert position index to a physical position before running the motor
proc w_index {sct_controller path par motor} {
variable posit_table
# broadcast w_index
if [ catch {
set val [pos2val [sct target] $motor]
hset $path/status BUSY
run $motor $val
# $sct_controller poll $path 1
} errmsg ] {
error $errmsg
return noResponse
} else {
return noResponse
}
}
proc noResponse {} {
return idle
}
# TODO Check thread 0 and motion control disabled?
proc check_motor {} {
# broadcast check_motor
set val [sct target]
return OK
}
proc setposindex {posindex val motor} {
variable posit_table
set posit_table($motor,$posindex) $val
}
##
# @brief Create a positional motor control object which lets you
# drive to an indexed position defined in a lookup table.
# @brief Request the current motor reading
proc ::scobj::positmotor::reqVal {state motor} {
sct result [SplitReply [$motor]]
return $state
}
##
# @brief Convert the target position to a motor position and drive the motor to the target.
proc ::scobj::positmotor::setVal {ID2valXfn motor table} {
set path [sct]
set pos [$ID2valXfn [sct target] $table]
hset $path/status "BUSY"
run $motor $pos
return noResponse
}
proc ::scobj::positmotor::noResponse {} {
return idle
}
##
# @brief Creates a controller which can drive motors to discrete labelled positions
#
# @param sct_controller, Name of controller created with mk_sct_positmotor
# @param klass, Controls place in hdb and nexus file hierarchy.
# @param motor, Name of motor which handles the actual driving.
# @param scobjName, Name of script-context object which we are creating.
# @param pindex, Position index, selects the position to drive to.
# @param table_ID, Tag which identifies the lookup table used for this controller.
# @param posit_list, Lookup table which maps the index set on the control parameter to a position.
# @param calc_instpar, Optional command which returns ????
proc mk_sct_positmotor {sct_controller klass motor scobjName pindex table_ID posit_list {calc_instpar @none}} {
variable posit_table
variable posit_indices
variable posit_label
set index 1
set staticpar [lindex $posit_list 0]
foreach {label position} [lrange $posit_list 2 end] {
lappend posit_indices($motor) $index
set posit_table($motor,$index) $position
set posit_label($motor,$index) $label
incr index
}
# set posit_indices [lsort -integer [array names posit_table]]
if [ catch {
# @param sct_controller, name of script-context protocol handler
# @param name, name of parameter which corresponds to the discrete motor positions
# @param type, float or int
# @param motor, name of motor
# @param klass, nexus class for parameter
# @param table, table of index versus motor positions
proc mkPosit {sct_controller name type motor klass table} {
set ns ::scobj::positmotor
MakeSICSObj $scobjName SCT_OBJECT
sicslist setatt $scobjName klass $klass
# Make setable position parameter and poll it.
set scobjPath /sics/$scobjName
hfactory $scobjPath/$pindex plain user float
hsetprop $scobjPath/$pindex read ${ns}::rd_index $pindex $motor
hsetprop $scobjPath/$pindex state_reading_index ${ns}::state_reading_index $scobjPath $pindex $motor $staticpar $calc_instpar
hsetprop $scobjPath/$pindex write ${ns}::w_index $sct_controller $scobjPath $pindex $motor
hsetprop $scobjPath/$pindex noResponse ${ns}::noResponse
hsetprop $scobjPath/$pindex check ${ns}::check_motor
MakeSICSObj $name SCT_OBJECT user $type
sicslist setatt $name klass $klass
hfactory /sics/$name/precision script "getmotpar $motor precision" "$motor precision " float 1
hsetprop /sics/$name read ::scobj::positmotor::reqVal report $motor
hsetprop /sics/$name report ::scobj::positmotor::rptVal ::scobj::positmotor::mot2ID $table /sics/$name/precision
hsetprop /sics/$name write ::scobj::positmotor::setVal ::scobj::positmotor::ID2mot $motor $table
hsetprop /sics/$name noResponse ${ns}::noResponse
hsetprop /sics/$name oldval "UNKNOWN"
hsetprop $scobjPath/$pindex oldval UNKNOWN
hsetprop $scobjPath/$pindex force_update True
# hsetprop $scobjPath/$pindex motprecision [SplitReply [samx precision]]
hfactory $scobjPath/$pindex/motprecision script "getmotpar $motor precision" "$motor precision " float 1
hfactory /sics/$name/status plain spy text
hset /sics/$name/status "IDLE"
hfactory $scobjPath/$pindex/lookup_table plain spy none
hsetprop $scobjPath/$pindex/lookup_table ID $table_ID
hsetprop $scobjPath/$pindex/lookup_table numpos [llength $posit_indices($motor)]
foreach posindex $posit_indices($motor) {
hfactory $scobjPath/$pindex/lookup_table/$posindex script "${ns}::pos2val $posindex $motor" "${ns}::setposindex $posindex $motor " float 1
hsetprop $scobjPath/$pindex/lookup_table/$posindex $staticpar $posit_label($motor,$posindex)
}
hfactory $scobjPath/$staticpar plain user float
hfactory $scobjPath/status plain spy text
hset $scobjPath/status IDLE
proc ${motor}_MOTEND {} [subst -nocommands {
if { [hval $scobjPath/status] == "BUSY"} {
# $sct_controller poll $scobjPath/$pindex 5
hset $scobjPath/status STOPPING
proc ${ns}::${motor}_MOTEND {} [subst -nocommands {
if { [hval /sics/$name/status] == "BUSY"} {
hset /sics/$name/status "STOPPING"
}
}]
publish ${ns}::${motor}_MOTEND user
scriptcallback connect $motor MOTEND ${ns}::${motor}_MOTEND
$sct_controller poll $scobjPath/$pindex 2
$sct_controller write $scobjPath/$pindex
sicslist setatt $scobjName long_name $scobjName
::scobj::hinitprops $scobjName
::scobj::hinitprops $scobjName $pindex
::scobj::hinitprops $scobjName $staticpar
} message ] {
return -code error $message
}
$sct_controller poll /sics/$name 2
$sct_controller write /sics/$name
}
namespace export mk_sct_positmotor
proc ::scobj::positmotor::ID2mot {ID table} {
set UID [string toupper $ID]
foreach {i m} $table {
if {$UID == [string toupper $i]} {
return $m
}
}
return "UNKNOWN"
}
proc ::scobj::positmotor::mot2ID {mot precision table} {
set firstMot [lindex $table 1]
set lastMot [lindex $table end]
if {abs($mot - $firstMot) <= $precision} {
return [lindex $table 0]
}
set sign [expr {$mot - $firstMot}]
set iprev [lindex $table 0]
set mprev [lindex $table 1]
foreach {i m} [lrange $table 2 end] {
if {abs($mot - $m) <= $precision} {
return $i
} elseif {[expr {$sign * ($mot - $m)} ] < 0} {
return [expr {($mot-$mprev)*($i - $iprev)/($m - $mprev)+$iprev}]
}
set iprev $i
set mprev $m
}
return -code error "lookup failed"
}
namespace import ::scobj::positmotor::*
##
# Eg
# hfactory /controllers plain spy none
#
# makesctcontroller /controllers/sct_mc1 std localhost:62034
# makesctcontroller sct_mc3 std localhost:62034
#
# mk_sct_positmotor sct_mc1 chi index { 1 0 2 15 3 20 }
# mkPosit sct_mc3 diameter float apx sample {2.5 0 5.0 -23 7.5 -47}

25
site_ansto/instrument/config/nexus/nxscripts_common_1.tcl
View File

@@ -55,7 +55,7 @@ namespace eval ::nexus::script {}
namespace eval ::histogram_memory {
variable histmem_axes
array set histmem_axes {
TOF /instrument/detector/time
TOF /instrument/detector/time_of_flight
HOR /instrument/detector/x_pixel_offset
VER /instrument/detector/y_pixel_offset
PER /instrument/run_number
@@ -320,6 +320,9 @@ proc ::nexus::newfile_collection {args} {
::hdb::set_save / false
nexus_datatype "UNKNOWN"
file_set_list "UNKNOWN"
foreach l [array names isNewFile] {
set isNewFile($l) "false"
}
# dataFileName "UNKNOWN"
} else {
foreach hp [split [::nexus::findHdbProps / link]] {
@@ -563,9 +566,6 @@ proc ::nexus::save {{point 0}} {
# Clears all link targets and sets the data type identifier to unknown
# data alias <name>, remove alias <name>
# data alias <name> <target>, set <name> as an alias for <target> unless it has already been defined.
proc ::nexus::data {args} {
# TODO This is obsolete
}
proc ::nexus::data_junk {args} {
variable state
variable data_gp_path
@@ -792,14 +792,22 @@ proc ::nexus::gen_NXentry_name {baseName} {
proc ::nexus::gen_nxdict {nexusdic} {
global cfPath
variable nxdictionary
if [ catch {
set catch_status [catch {
set nxdict_path $cfPath(nexus)/$nexusdic
array unset nxdictionary
foreach hp [hlist /] {
if {[hpropexists /$hp data] } {
if {[hgetpropval /$hp data] == true} {
if {[hpropexists /$hp klass] } {
set nxclass [hgetpropval /$hp klass]
} else {
error "/$hp does not have a 'klass' attribute"
}
::nexus::_gen_nxdict $hp /\$(pa_entryName),NXentry $hp $nxclass
}
} else {
error "/$hp does not have a 'data' attribute"
}
}
set fh [open $nxdict_path w]
puts $fh "##NXDICT-1.0"
@@ -813,9 +821,8 @@ proc ::nexus::gen_nxdict {nexusdic} {
puts $fh "$n = $v"
}
close $fh
} message ] {
return -code error "([info level 0]) $message"
}
} message ]
handle_exception $catch_status $message
return $nxdict_path
}
@@ -1344,7 +1351,7 @@ set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]]
sics_release $nx_content_release_tag
sics_release lock
set tmpstr [string map {"$" ""} {$Revision: 1.51.2.4 $}]
set tmpstr [string map {"$" ""} {$Revision: 1.51.2.5 $}]
set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]]
#namespace eval data {

4
site_ansto/instrument/config/plc/plc_common_1.tcl
View File

@@ -7,7 +7,7 @@ proc ::plc::set_sobj_attributes {} {
set objlist [sicslist match plc_*];
foreach v $objlist {
if { [SplitReply [sicslist $v type]]== "SicsVariable"} {
::utility::mkData $v [string replace $v 0 3] plc privilege user control true data false
::utility::mkData $v [string replace $v 0 3] plc privilege user control true data true
}
}
}
@@ -29,7 +29,7 @@ if {$sim_mode == "true"} {
#
# @return 1: if ready, 0: if not ready
proc ::plc::inst_ready {} {
if {[SplitReply [plc plc_ready]] == "True"} {
if {[SplitReply [plc plc_ready]] == "TRUE"} {
return 1
} else {
return 0

10
site_ansto/instrument/config/scan/scan_common_1.tcl
View File

@@ -163,10 +163,10 @@ proc ::scan::check_scanvar {sobj uobj} {
} elseif {$check_thread0 && [SplitReply [$scan_variable thread0]] == -1} {
return -code error "ERROR: Can't scan ${scan_variable}. Thread zero has stopped running on the motion controller"
}
set target [expr $scan_start + ($NP-1) * $scan_increment]
set scan_final [expr $scan_start + ($NP-1) * $scan_increment]
if [catch {
::scan::check_limit $scan_variable hardlowerlim $target
::scan::check_limit $scan_variable hardupperlim $target
::scan::check_limit $scan_variable softlowerlim $scan_final
::scan::check_limit $scan_variable softupperlim $scan_final
::scan::check_limit $scan_variable softlowerlim $scan_start
::scan::check_limit $scan_variable softupperlim $scan_start
}] {
@@ -211,8 +211,8 @@ proc ::scan::hmm_scan_prepare {sobj uobj} {
::scan::runscan_cmd -set feedback status BUSY
run_mode "hmscan"
set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [::scan::runscan_cmd -set scan_variable] hdb_path] ]
::nexus::newfile $ic_hmm_datatype $save_filetype
data axis 1 [::scan::runscan_cmd -set scan_variable]
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Datatype: $ic_hmm_datatype"
@@ -330,8 +330,8 @@ proc ::scan::bm_scan_prepare {sobj uobj} {
run_mode "bmonscan"
array set bm_fb [::scan::hdb_bmonscan -list feedback]
set ::histogram_memory::histmem_axes(SVAR) [SplitReply [sicslist [::scan::hdb_bmonscan -set scan_variable] hdb_path] ]
::nexus::newfile BEAM_MONITOR data
::nexus::data axis 1 [::scan::hdb_bmonscan -set scan_variable]
#stdscan prepare $sobj $uobj;
clientput "Scan start: $scanstart, Scan step: $scanstep, Number of points: $numpoints"
clientput "Datatype: BEAM_MONITOR"

4
site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl
View File

@@ -51,8 +51,8 @@ proc ::histogram_memory::isc_initialize {} {
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin
set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_bin
set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_bin
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message

1
site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT
View File

@@ -4,6 +4,7 @@ config/plc/plc_common_1.tcl
config/counter/counter_common_1.tcl
config/environment/temperature/sct_lakeshore_3xx.tcl
config/environment/temperature/sct_eurotherm_2000.tcl
config/environment/sct_protek_common.tcl
config/hipadaba/hipadaba_configuration_common.tcl
config/hipadaba/common_instrument_dictionary.tcl
config/hipadaba/instdict_specification.tcl

4
site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl
View File

@@ -89,8 +89,8 @@ proc ::histogram_memory::isc_initialize {} {
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_pixel_offset
set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_pixel_offset
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message

28
site_ansto/instrument/rsd/config/motors/motor_configuration.tcl
View File

@@ -597,8 +597,8 @@ Motor psho $motor_driver_type [params \
cntsPerX 8192]
psho speed 4
psho Backlash_offset -0.3
psho part slits.primary
psho long_name psho
psho part slits
psho long_name primary_psho
setHomeandRange -motor psho -home 0 -lowrange 0 -uprange 30
# Primary Slit, position 0-150mm (Y-axis)
@@ -617,8 +617,8 @@ Motor psp $motor_driver_type [params \
cntsPerX -8192]
psp speed 4
psp Backlash_offset -0.3
psp part slits.primary
psp long_name psp
psp part slits
psp long_name primary_psp
setHomeandRange -motor psp -home 0 -lowrange 0 -uprange 150
# Primary Slit, width, 0-30mm
@@ -637,8 +637,8 @@ Motor psw $motor_driver_type [params \
cntsPerX -8192]
psw speed 4
psw Backlash_offset 0.3
psw part slits.primary
psw long_name psw
psw part slits
psw long_name primary_psw
setHomeandRange -motor psw -home 0 -lowrange 0 -uprange 30
#--------------------------------------------------------
@@ -660,8 +660,8 @@ Motor ssho $motor_driver_type [params \
cntsPerX 8192]
ssho speed 4
ssho Backlash_offset -0.3
ssho part slits.secondary
ssho long_name ssho
ssho part slits
ssho long_name secondary_ssho
setHomeandRange -motor ssho -home 0 -lowrange 0 -uprange 30
# Secondary Slit, position
@@ -680,8 +680,8 @@ Motor ssp $motor_driver_type [params \
cntsPerX -8192]
ssp speed 4
ssp Backlash_offset -0.3
ssp part slits.secondary
ssp long_name ssp
ssp part slits
ssp long_name secondary_ssp
setHomeandRange -motor ssp -home 0 -lowrange 0 -uprange 150
# Primary Slit, height, 0-30mm
@@ -698,8 +698,8 @@ setHomeandRange -motor ssp -home 0 -lowrange 0 -uprange 150
# absenc 1\
# absenchome 542093\
# cntsPerX 8192]
#psh part slits.primary
#psh long_name psh
#psh part slits
#psh long_name primary_psh
#setHomeandRange -motor psh -home 0 -lowrange 0 -uprange 30
## Secondary Slit, height
@@ -716,8 +716,8 @@ setHomeandRange -motor ssp -home 0 -lowrange 0 -uprange 150
# absenc 1\
# absenchome 500000\
# cntsPerX 8192]
#ssh part slits.secondary
#ssh long_name ssh
#ssh part slits
#ssh long_name secondary_ssh
#setHomeandRange -motor ssh -home 0 -lowrange 0 -uprange 30
#--------------------------------------------------------

4
site_ansto/instrument/rsd/config/motors/secondary_slit_configuration.tcl
View File

@@ -16,6 +16,6 @@ Motor ssw $motor_driver_type [params \
cntsPerX -8192]
ssw speed 4
ssw Backlash_offset 0.3
ssw part slits.secondary
ssw long_name ssw
ssw part slits
ssw long_name secondary_ssw
setHomeandRange -motor ssw -home 0 -lowrange 0 -uprange 30

1
site_ansto/instrument/rsd/kowari_configuration.tcl
View File

@@ -24,6 +24,7 @@ fileeval $cfPath(plc)/plc.tcl
fileeval $cfPath(counter)/counter.tcl
fileeval $cfPath(environment)/temperature/sct_lakeshore_3xx.tcl
fileeval $cfPath(environment)/temperature/sct_eurotherm_2000.tcl
fileeval $cfPath(environment)/sct_protek_common.tcl
fileeval $cfPath(hmm)/hmm_configuration.tcl
fileeval $cfPath(nexus)/nxscripts.tcl
fileeval $cfPath(scan)/scan.tcl

1
site_ansto/instrument/sans/config/INSTCFCOMMON.TXT
View File

@@ -8,6 +8,7 @@ config/hipadaba/instdict_specification.tcl
config/hmm/hmm_configuration_common_1.tcl
config/hmm/hmm_object.tcl
config/hmm/anstohm_linked.xml
config/hmm/sct_orhvps_common.tcl
config/scan/scan_common_1.hdd
config/scan/scan_common_1.tcl
config/nexus/nxscripts_common_1.tcl

2
site_ansto/instrument/sans/config/commands/commands.tcl
View File

@@ -197,7 +197,7 @@ namespace eval optics {
}
::optics::guide -set feedback status BUSY
set msg [eval "drive $to_config"]
EApPosYmm $position
EApPosY $position
}
GuideConfig $configuration
} message ] {

22
site_ansto/instrument/sans/config/hmm/detector.tcl
View File

@@ -1,20 +1,6 @@
# Detector voltage controller
set sim_mode [SplitReply [detector_simulation]]
if {$::sim_mode == "true"} {
EvFactory new dhv1 sim
} else {
makeasyncqueue acq ORHVPS ca1-quokka 4001
evfactory new dhv1 orhvps acq
dhv1 lowerlimit 0
dhv1 upperlimit 2400
dhv1 tolerance 19
fileeval $cfPath(hmm)/sct_orhvps_common.tcl
::scobj::dethvps::init ca1-quokka 4001 4.1
dhv1 max 2600
dhv1 rate 10
dhv1 debug 1
dhv1 unlock
dhv1 debug 0
# dhv1 lock
}
dhv1 lower 19
dhv1 upper 57

6
site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl
View File

@@ -39,7 +39,7 @@ proc ::histogram_memory::isc_initialize {} {
FAT_TABLE -init
::histogram_memory::ic_initialize
detector_active_height_mm 980
detector_active_height_mm [expr 5.08 * 192]
detector_active_width_mm [expr 5.08 * 192]
detector_active_height_mm lock
detector_active_width_mm lock
@@ -51,8 +51,8 @@ proc ::histogram_memory::isc_initialize {} {
::histogram_memory::init_OAT_TABLE
::histogram_memory::upload_config Filler_defaults
::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset
::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset
set ::histogram_memory::histmem_axes(HOR) /instrument/detector/x_pixel_offset
set ::histogram_memory::histmem_axes(VER) /instrument/detector/y_pixel_offset
} message ] {
return -code error $message
}

6
site_ansto/instrument/sans/config/motors/motor_configuration.tcl
View File

@@ -840,7 +840,6 @@ bs1 softlowerlim 11
bs1 softupperlim 95
bs1 home 90
bs1 precision 0.05
sicslist setatt bs1 link parameters_group
Motor bs2 $motor_driver_type [params \
asyncqueue mc4\
@@ -861,7 +860,6 @@ bs2 softlowerlim 7
bs2 softupperlim 95
bs2 home 90
bs2 precision 0.05
sicslist setatt bs2 link parameters_group
Motor bs3 $motor_driver_type [params \
asyncqueue mc4\
@@ -882,7 +880,6 @@ bs3 softlowerlim 11
bs3 softupperlim 95
bs3 home 90
bs3 precision 0.05
sicslist setatt bs3 link parameters_group
Motor bs4 $motor_driver_type [params \
asyncqueue mc4\
@@ -903,7 +900,6 @@ bs4 softlowerlim 7
bs4 softupperlim 95
bs4 home 90
bs4 precision 0.05
sicslist setatt bs4 link parameters_group
Motor bs5 $motor_driver_type [params \
asyncqueue mc4\
@@ -924,7 +920,6 @@ bs5 softlowerlim 11
bs5 softupperlim 95
bs5 home 90
bs5 precision 0.05
sicslist setatt bs5 link parameters_group
Motor bs6 $motor_driver_type [params \
asyncqueue mc4\
@@ -945,7 +940,6 @@ bs6 softlowerlim 7
bs6 softupperlim 95
bs6 home 90
bs6 precision 0.05
sicslist setatt bs6 link parameters_group
# Polarizer Rotation
#Motor pol $motor_driver_type [params \

8
site_ansto/instrument/sans/config/motors/positmotor_configuration.tcl
View File

@@ -10,8 +10,8 @@ makesctcontroller sct_mc3 std mc3:$port3
makesctcontroller sct_mc4 std mc4:$port4
# label pos
#index position
set 20sample_table {
index position
1 453.7
2 411.7
3 369.7
@@ -34,10 +34,10 @@ index position
20 -464.3
}
mk_sct_positmotor sct_mc1 parameter samx changer_position samplenum 20SAMPLES $20sample_table
mkPosit sct_mc1 sampleNum float samx sample $20sample_table
#diameter position
set auto_ap_table {
diameter position
2.5 0
5.0 -23
7.5 -47
@@ -49,5 +49,5 @@ diameter position
25.0 -215
30.0 -250
}
mk_sct_positmotor sct_mc3 parameter apx autoSampleAp aperture auto_ap $auto_ap_table
mkPosit sct_mc3 diameter float apx sample $auto_ap_table

37
site_ansto/instrument/sans/config/optics/aperture_configuration.tcl
View File

@@ -1,17 +1,17 @@
namespace eval optics {
array set AttRotLookupTable {
0 0.0
30 1.3
60 3.3
90 4.9
120 6.4
150 8.3
180 9.6
210 11.2
240 13.1
270 15.0
300 18.0
330 25.0
0 { 0.0 1 }
30 { 1.3 0.498782 }
60 { 3.3 0.176433 }
90 { 4.9 0.0761367 }
120 { 6.4 0.0353985 }
150 { 8.3 0.0137137 }
180 { 9.6 0.00614167 }
210 {11.2 0.00264554 }
240 {13.1 0.000994504 }
270 {15.0 0.000358897 }
300 {18.0 7.2845e-05 }
330 {25.0 1.67827e-06 }
}
array set EApLookupTable {
@@ -30,8 +30,10 @@ namespace eval optics {
}
}
proc ::optics::AttRotLookup {angle tol} {
proc ::optics::AttRotLookup {angle column tol} {
variable AttRotLookupTable
set catch_status [ catch {
set foundit false
foreach vangle [array names AttRotLookupTable] {
if {$vangle >= [expr {$angle-$tol}] && $vangle <= [expr {$angle+$tol}]} {
@@ -40,10 +42,17 @@ proc ::optics::AttRotLookup {angle tol} {
}
}
if {$foundit == true} {
return [lindex $AttRotLookupTable($vangle) 0]
switch $column {
"plex" { set index 0 }
"attfactor" { set index 1 }
default { error "$column is unknown, allowed values are plex or attfactor" }
}
return [lindex $AttRotLookupTable($vangle) $index]
} else {
return -1
}
} message ]
handle_exception $catch_status $message
}
proc ::optics::EApLookUp {angle param tol} {

27
site_ansto/instrument/sans/config/parameters/parameters.tcl
View File

@@ -11,7 +11,6 @@ foreach {var lname type priv units klass} {
BeamCenterZ BeamCenterZ float user mm parameter
BeamStop BeamStop int user none parameter
BSdiam BSdiam float user mm parameter
DetPosYOffset DetPosYOffset float user mm parameter
EApPosY EApPosY float user mm parameter
EndFacePosY EndFacePosY float readonly mm parameter
GuideConfig GuideConfig text user none parameter
@@ -30,22 +29,19 @@ foreach {var lname type priv units klass} {
proc sicsmsgfmt {args} {return "[info level -1] = $args"}
::utility::macro::getset float SamplePosY {} {
set sy [SplitReply [samy]]
set syo [SplitReply [SamYOffset]]
return [sicsmsgfmt [expr {$sy+$syo}]]
}
sicslist setatt SamplePosY long_name SamplePosY
sicslist setatt SamplePosY klass parameter
sicslist setatt SamplePosY units mm
::utility::macro::getset float Plex {} {
return [sicsmsgfmt [ ::optics::AttRotLookup [SplitReply [att]] [SplitReply [att precision]] ]]
return [sicsmsgfmt [ ::optics::AttRotLookup [SplitReply [att]] "plex" [SplitReply [att precision]] ]]
}
sicslist setatt Plex units mm
sicslist setatt Plex long_name Plex
sicslist setatt Plex klass parameter
::utility::macro::getset float AttFactor {} {
return [sicsmsgfmt [ ::optics::AttRotLookup [SplitReply [att]] "attfactor" [SplitReply [att precision]] ]]
}
sicslist setatt AttFactor long_name AttFactor
sicslist setatt AttFactor klass parameter
::utility::macro::getset float EApX {} {
return [sicsmsgfmt [::optics::EApLookUp [SplitReply [srce]] "size" [SplitReply [srce precision]] ]]
}
@@ -69,7 +65,7 @@ sicslist setatt EApShape mutable false
::utility::macro::getset float L1 {} {
set efpy [SplitReply [EndFacePosY]]
set samposy [SplitReply [SamplePosY]]
set samposy [SplitReply [samy]]
set eapy [SplitReply [EApPosY]]
return [sicsmsgfmt [expr {$efpy + $samposy - $eapy}]]
}
@@ -79,9 +75,8 @@ sicslist setatt L1 units mm
::utility::macro::getset float L2 {} {
set detpy [SplitReply [det]]
set detpyos [SplitReply [DetPosYOffset]]
set sapy [SplitReply [SamplePosY]]
return [sicsmsgfmt [expr {$detpy + $detpyos - $sapy}]]
set sapy [SplitReply [samy]]
return [sicsmsgfmt [expr {$detpy - $sapy}]]
}
sicslist setatt L2 long_name L2
sicslist setatt L2 klass parameter
@@ -114,7 +109,6 @@ namespace eval parameters {
set paramlist {
AttFactor
BSdiam
DetPosYOffset
EApPosY
EApShape
EApX
@@ -124,7 +118,6 @@ namespace eval parameters {
L2
Plex
SamYOffset
SamplePosY
Transmission
}
}

6
site_ansto/safetyplc.c
View File

@@ -49,9 +49,9 @@ Unknown_low, Invalid_high, Enabled, Disabled,
Opened, Closed, Locked, Unlocked, True, False,}PLC_STATUS;
char *plc_states[] = {
"Unknown_low", "Invalid_high", "Enabled",
"Disabled", "Opened", "Closed",
"Locked", "Unlocked", "True", "False"};
"UNKNOWN_LOW", "INVALID_HIGH", "ENABLED",
"DISABLED", "OPEN", "CLOSED",
"LOCKED", "UNLOCKED", "TRUE", "FALSE"};
typedef enum {
Key,Secondary,Tertiary,MotionControl,Access,

32
site_ansto/site_ansto.c
View File

@@ -59,6 +59,9 @@ extern void AddOrdHVPSProtocoll();
extern void AddVelSelProtocol();
extern void AddUSBTMCProtocoll();
extern void AddAnsfrProtocol();
extern void AddHttpProtocoll();
extern void AddProtek608Protocol();
extern void AddRFAmpProtocol();
extern int ANSTO_MakeHistMemory(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]);
@@ -75,6 +78,9 @@ void SiteInit(void) {
AddVelSelProtocol();
AddUSBTMCProtocoll();
AddAnsfrProtocol();
AddHttpProtocoll();
AddProtek608Protocol();
AddRFAmpProtocol();
}
static pSite /*@null@*/ siteANSTO = NULL;
@@ -318,3 +324,29 @@ pSite getSite(void)
return siteANSTO;
}
void broadcastPrintf(int iOut, char *fmt, ...)
{
va_list ap;
char buf[256];
char *dyn;
unsigned int l;
int res;
va_start(ap, fmt);
l = vsnprintf(buf, sizeof buf, fmt, ap);
va_end(ap);
if (l >= sizeof buf) {
/* we have probably a C99 conforming snprintf and
need a larger buffer
*/
dyn = malloc(l+1);
if (dyn != NULL) {
va_start(ap, fmt);
vsnprintf(dyn, l+1, fmt, ap);
va_end(ap);
ServerWriteGlobal(dyn, iOut);
free(dyn);
}
}
ServerWriteGlobal(buf, iOut);
}