diff --git a/drive.c b/drive.c index 8e85a51c..4e92e307 100644 --- a/drive.c +++ b/drive.c @@ -39,6 +39,7 @@ #include #include #include +#include #include "fortify.h" #include "sics.h" #include "drive.h" @@ -333,32 +334,44 @@ /* interprete arguments as pairs name value and try to start */ SetStatus(eDriving); - for(i = 1; i < argc; i+=2) - { - if(argv[i+1] == NULL) - { - sprintf(pBueffel,"ERROR: no value found for driving %s", - argv[i]); - SCWrite(pCon,pBueffel,eError); - SetStatus(eOld); - return 0; - } - iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); - if (iRet == TCL_ERROR) { - SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); - StopExe(GetExecutor(),"ALL"); - SetStatus(eOld); - return 0; - } - iRet = Start2Run(pCon,pSics,argv[i],dTarget); - if(!iRet) - { - sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]); - SCWrite(pCon,pBueffel,eError); - StopExe(GetExecutor(),"ALL"); - SetStatus(eOld); - return 0; - } + for(i = 1; i < argc; i+=2) { + if(argv[i+1] == NULL) + { + sprintf(pBueffel,"ERROR: no value found for driving %s", + argv[i]); + SCWrite(pCon,pBueffel,eError); + SetStatus(eOld); + return 0; + } + iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); + if (iRet == TCL_ERROR) { + SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); + SetStatus(eOld); + return 0; + } else if (!isfinite(dTarget)) { + sprintf(pBueffel,"ERROR: target %s value for %s is not a finite number", + argv[i+1], argv[i]); + SCWrite(pCon,pBueffel,eError); + SetStatus(eOld); + return 0; + } + } + for(i = 1; i < argc; i+=2) { + iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); + if (iRet == TCL_ERROR) { + SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); + SetStatus(eOld); + return 0; + } + iRet = Start2Run(pCon,pSics,argv[i],dTarget); + if(!iRet) + { + sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]); + SCWrite(pCon,pBueffel,eError); + StopExe(GetExecutor(),"ALL"); + SetStatus(eOld); + return 0; + } } /* wait for completion */ @@ -433,32 +446,44 @@ /* interprete arguments as pairs name value and try to start */ SetStatus(eDriving); - for(i = 1; i < argc; i+=2) - { - if(argv[i+1] == NULL) - { - sprintf(pBueffel,"ERROR: no value found for driving %s", - argv[i]); - SCWrite(pCon,pBueffel,eError); - SetStatus(eOld); - return 0; - } - iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); - if (iRet == TCL_ERROR) { - SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); - StopExe(GetExecutor(),"ALL"); - SetStatus(eOld); - return 0; - } - iRet = Start2Run(pCon,pSics,argv[i],dTarget); - if(!iRet) - { - sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]); - SCWrite(pCon,pBueffel,eError); - StopExe(GetExecutor(),"ALL"); - SetStatus(eOld); - return 0; - } + for(i = 1; i < argc; i+=2) { + if(argv[i+1] == NULL) + { + sprintf(pBueffel,"ERROR: no value found for driving %s", + argv[i]); + SCWrite(pCon,pBueffel,eError); + SetStatus(eOld); + return 0; + } + iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); + if (iRet == TCL_ERROR) { + SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); + SetStatus(eOld); + return 0; + } else if (!isfinite(dTarget)) { + sprintf(pBueffel,"ERROR: target value %s for %s is not a finite number", + argv[i+1], argv[i]); + SCWrite(pCon,pBueffel,eError); + SetStatus(eOld); + return 0; + } + } + for(i = 1; i < argc; i+=2) { + iRet = Tcl_GetDouble(tcl_interp, argv[i+1], &dTarget); + if (iRet == TCL_ERROR) { + SCWrite(pCon, Tcl_GetStringResult(tcl_interp), eError); + SetStatus(eOld); + return 0; + } + iRet = Start2Run(pCon,pSics,argv[i],dTarget); + if(!iRet) + { + sprintf(pBueffel,"ERROR: cannot run %s to %s",argv[i],argv[i+1]); + SCWrite(pCon,pBueffel,eError); + StopExe(GetExecutor(),"ALL"); + SetStatus(eOld); + return 0; + } } return 1; } diff --git a/histmem.c b/histmem.c index 1b2575ef..ab8386c7 100644 --- a/histmem.c +++ b/histmem.c @@ -1148,7 +1148,7 @@ static int checkHMEnd(pHistMem self, char *text){ /* do it */ Arg2Text(argc - 3, &argv[3],pBueffel, 511); /* authorise */ - if(!SCMatchRights(pCon,usMugger)) + if(!SCMatchRights(pCon,usUser)) /* FIXME ffr stupid hack */ { sprintf(pBueffel, "ERROR: you need to be manager in order to configure %s", @@ -1254,7 +1254,7 @@ static int checkHMEnd(pHistMem self, char *text){ eError); return 0; } - if(SCMatchRights(pCon,usMugger)) + if(SCMatchRights(pCon,usUser)) /* FIXME ffr stupid hack */ { iRet = HistConfigure(self,pCon,pSics); if(iRet) diff --git a/nxdict.c b/nxdict.c index 25737a7e..263257a2 100644 --- a/nxdict.c +++ b/nxdict.c @@ -191,9 +191,9 @@ char *pPtr; int iToken; int iMode; - char pAlias[132]; - char pDefinition[1024]; /* this is > 10 lines of definition */ - char pWord[132]; + char pAlias[1024]; + char pDefinition[8192]; /* this is > 10 lines of definition */ + char pWord[1024]; assert(pBuffer); assert(pDict); diff --git a/rs232controller.h b/rs232controller.h index 1628930c..0882b895 100644 --- a/rs232controller.h +++ b/rs232controller.h @@ -14,6 +14,8 @@ #ifndef RS232CONTROLLER #define RS232CONTROLLER #include "network.h" +#include "obdes.h" //PB +#include "conman.h" //PB /* own error codes */ diff --git a/site_ansto/Makefile b/site_ansto/Makefile index 0db173c8..249ea53e 100644 --- a/site_ansto/Makefile +++ b/site_ansto/Makefile @@ -80,14 +80,17 @@ OBJ= site_ansto.o anstoutil.o\ motor_asim.o motor_dmc2280.o\ lh45.o lh45driv.o \ lakeshore340.o lakeshore340driv.o \ + west4100.o west4100driv.o \ nhq200.o \ orhvps.o \ + ls340.o \ fsm.o \ counterdriv.o \ safetyplc.o \ ../psi/tcpdornier.o \ anstohttp.o \ - hmcontrol_ansto.o + hmcontrol_ansto.o\ + lssmonitor.o all: ../matrix/libmatrix.a $(COREOBJ:%=../%) $(EXTRA:%=../%) libansto.a libhardsup $(CC) -g -o SICServer $(COREOBJ:%=../%) $(EXTRA:%=../%) $(SUBLIBS) $(PSI_SLIBS:%=../%) $(PSI_LIBS) $(GHTTP_LIBS) diff --git a/site_ansto/ansto_evcontroller.h b/site_ansto/ansto_evcontroller.h new file mode 100644 index 00000000..c1aae777 --- /dev/null +++ b/site_ansto/ansto_evcontroller.h @@ -0,0 +1,14 @@ +#ifndef ANSTO_EVCONTROLLER_H +#define ANSTO_EVCONTROLLER_H + + +#include +#include +#include "evdriver.h" +#include + + + + + +#endif diff --git a/site_ansto/hardsup/asynsrv_utility.c b/site_ansto/hardsup/asynsrv_utility.c index 2214adfe..bb2c7f0c 100644 --- a/site_ansto/hardsup/asynsrv_utility.c +++ b/site_ansto/hardsup/asynsrv_utility.c @@ -680,7 +680,7 @@ */ struct AsynSrv__info *asyn_info) { int status; - char cmnd[8], rply[8]; + //char cmnd[8], rply[8]; /*---------------------------------------------- ** Pre-set the routine name (in case of error) */ @@ -898,8 +898,8 @@ /* ================== */ char *par_id, ...) { - int i; - char buff[4]; + //int i; + //char buff[4]; va_list ap; /* Pointer to variable args */ char *txt_ptr; int intval; @@ -971,7 +971,7 @@ int *my_errno, int *vaxc_errno) { - int i, j, k; + int i;//, j, k; char buff[80]; if (AsynSrv_call_depth <= 0) { @@ -1034,7 +1034,7 @@ */ struct AsynSrv__info *asyn_info) { int status; - char cmnd[8], rply[8]; + //char cmnd[8], rply[8]; /*---------------------------------------------- ** Pre-set the routine name (in case of error) */ @@ -1124,25 +1124,25 @@ */ struct AsynSrv__info *asyn_info) { int i, status; - int my_skt; - char old_time_out[4]; - union { - char chars[4]; - int val; - } time_out; + //int my_skt; + //char old_time_out[4]; + //union { + // char chars[4]; + // int val; + //} time_out; char buff[128]; - struct RS__MsgStruct s_buff; - struct RS__RespStruct r_buff; - unsigned int oto_len, oto_status; - struct hostent *rmt_hostent; - struct in_addr *rmt_inet_addr_pntr; - struct in_addr rmt_inet_addr; - int rmt_sockname_len; - struct sockaddr_in lcl_sockname; - struct sockaddr_in rmt_sockname; + //struct RS__MsgStruct s_buff; + //struct RS__RespStruct r_buff; + //unsigned int oto_len, oto_status; + //struct hostent *rmt_hostent; + //struct in_addr *rmt_inet_addr_pntr; + //struct in_addr rmt_inet_addr; + //int rmt_sockname_len; + //struct sockaddr_in lcl_sockname; + //struct sockaddr_in rmt_sockname; - char *errtxt_ptr; - int errcode, my_errno, my_vaxc_errno; + //char *errtxt_ptr; + //int errcode, my_errno, my_vaxc_errno; /*-------------------------------------------------------- */ asyn_info->skt = 0; @@ -1225,17 +1225,17 @@ /* =============== */ struct AsynSrv__info *asyn_info) { - int i, status; + int status; //,i; int my_skt; - char old_time_out[4]; - union { - char chars[4]; - int val; - } time_out; + //char old_time_out[4]; + //union { + // char chars[4]; + // int val; + //} time_out; char buff[128]; struct RS__MsgStruct s_buff; struct RS__RespStruct r_buff; - unsigned int oto_len, oto_status; + //unsigned int oto_len, oto_status; struct hostent *rmt_hostent; struct in_addr *rmt_inet_addr_pntr; struct in_addr rmt_inet_addr; @@ -1243,8 +1243,8 @@ struct sockaddr_in lcl_sockname; struct sockaddr_in rmt_sockname; - char *errtxt_ptr; - int errcode, my_errno, my_vaxc_errno; + //char *errtxt_ptr; + //int errcode, my_errno, my_vaxc_errno; /*-------------------------------------------------------- */ asyn_info->skt = 0; @@ -1478,7 +1478,7 @@ int i, status, c_len, size, max_size, ncmnds; int bytes_to_come, bytes_left; char *nxt_byte_ptr; - char err_text[80]; +// char err_text[80]; char text[20]; va_list ap; /* Pointer to variable args */ char *txt_ptr; @@ -1724,7 +1724,7 @@ int i, status, size, max_size, ncmnds; int bytes_to_come, bytes_left; char *nxt_byte_ptr; - char err_text[80]; + //char err_text[80]; char text[20]; va_list ap; /* Pointer to variable args */ int *c_len, s_len; @@ -2046,7 +2046,7 @@ int state) { int status; - char cmnd[8], rply[8]; + char cmnd[8];//, rply[8]; /*---------------------------------------------- ** Pre-set the routine name (in case of error) */ @@ -2091,7 +2091,7 @@ */ struct AsynSrv__info *asyn_info) { int status; - char cmnd[8], rply[8]; + //char cmnd[8], rply[8]; /*---------------------------------------------- ** Pre-set the routine name (in case of error) */ diff --git a/site_ansto/hardsup/makefile b/site_ansto/hardsup/makefile index 3321d621..d543a109 100644 --- a/site_ansto/hardsup/makefile +++ b/site_ansto/hardsup/makefile @@ -10,7 +10,7 @@ SRC = . CC = gcc CFLAGS = -g -DLINUX $(DFORTIFY) -I$(SRC) -I../.. -Wall -Wno-unused -HOBJ= itc4util.o lh45util.o lakeshore340util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o +HOBJ= nhq200util.o itc4util.o lh45util.o lakeshore340util.o west4100util.o asynsrv_utility.o geterrno.o strjoin.o chopper.o modbustcp.o libhlib.a: $(HOBJ) rm -f libhlib.a diff --git a/site_ansto/hardsup/modbustcp.c b/site_ansto/hardsup/modbustcp.c new file mode 100644 index 00000000..5e5c56b1 --- /dev/null +++ b/site_ansto/hardsup/modbustcp.c @@ -0,0 +1,135 @@ +/*--------------------------------------------------------------------------- + M O D B U S T C P . C + +Paul Barron, January 2008 + +RTU Modbus functions designed for use with the WEST4100 Temperature Controller. +If another modbus device is required at ANSTO sections of this code will need +to be modified. + + MBAP: Modbus Application Protocol Header + PDU: Protocol Data Unit + + Modbus TCP Packet Format +| MBAP | PDU | +|Transact Identifier|Protocol Identifier|Length Field|Unit ID|Funct Code|Data| +| 2 Bytes | 2 Bytes | 2 Bytes | 1 Byte| 1 Byte | n | + +Paul Barron, January 2008 +----------------------------------------------------------------------------*/ + +#include +#include +#include +#include +#include "modbustcp.h" + +/*-------------------------------------------------------------------------*/ + +int ModbusTCPException(unsigned char *response); + +int MsgGenModbusTCP(unsigned char *ModbusMsg, int ModbusMsgLength, unsigned char *TcpPacket, + int *TcpPacketLength) +{ + unsigned char MBAPbyte1 = 1, MBAPbyte2 = 1; + unsigned char lengthByte1, lengthByte2; + int index; + + // Check if Device Address is Valid. This is based on RS485 having up to + // 32 devices, since we currently only have one device this won't be a problem. + if ((ModbusMsg[0] > 32) || (ModbusMsg[0] < 1)) + { + printf("Error: Modbus Address out of Range: %X\n",ModbusMsg[0]); + return MODBUSTCP_BadDataAddress; + } + + // Check if Function code is Valid + if ((ModbusMsg[1] > 16) || (ModbusMsg[1] < 1)) + { + printf("Error: Modbus Function Code Invalid: %X\n",ModbusMsg[1]); + return MODBUSTCP_BadFunction; + } + + // Calculate Legth Field + // Length should never be greater than 255 but just in case. + if ((ModbusMsgLength)>255){ + lengthByte1=ModbusMsgLength/255; + lengthByte2=ModbusMsgLength%255; + } + else{ + lengthByte1=0; + lengthByte2=ModbusMsgLength; + } + + sprintf((char *)TcpPacket,"%c%c%c%c%c%c",MBAPbyte1,MBAPbyte2,0,0,lengthByte1,lengthByte2); + + for(index=0;index<=ModbusMsgLength;index++)sprintf((char *)&TcpPacket[index+6],"%c",ModbusMsg[index]); + + *TcpPacketLength=ModbusMsgLength+6; + + return 1; +} + +/*-------------------------------------------------------------------------*/ + +int transactModbusTCP(prs232 self, unsigned char *query, int queryLength, unsigned char *response, int responseLength) +{ + unsigned char TCPquery[40]; + int iRet, index, TCPqueryLength; + + // Generate the TCP message + iRet=MsgGenModbusTCP(query,queryLength,TCPquery,&TCPqueryLength); + + // Send the message and Read the reply + memset(response,0,responseLength); // puts zeros in reply up until reply length + if ((iRet=transactRS232(self,TCPquery,/*strlen(pCommand)*/12,response,20))<=0) + { + printf("Comms error!\n"); + return iRet; // Comms problem + } + + // Check that the response transact and protocol identifier are the same + if( (strncmp((char *)TCPquery,(char *)response,3)) == 0) + { + // Check that there is not a modbus error, see page 98 from WEST4100 User manual. + if ( response[7] > 0x80 ) + { + iRet=ModbusTCPException(response); + + return iRet; + } + else + { + // Return the modbus response minus the TCP Header + for(index=0;index<6;index++) + response[index]=response[index+6]; + + return 1; + } + + return 1; // Success + } + + return MODBUSTCP_TCPError; +} + +/*-------------------------------------------------------------------------*/ + +int ModbusTCPException(unsigned char *response) +{ + if(response[8] == 0x01){ + printf("Exception Code 01h: Illegal Function\n"); + return MODBUSTCP_IllegalFunction; + }else if(response[8] == 0x02){ + printf("Exception Code 02h: Illegal Data Address\n"); + return MODBUSTCP_IllegalDataAddress; + }else if(response[8] == 0x03){ + printf("Exception Code 03h: Illegal Data Value\n"); + return MODBUSTCP_IllegalDataValue; + }else{ + printf("Error code is greater than 81h, 82h or 83h\n"); + return MODBUSTCP_UnsupportedError; + } +} + +/*-------------------------------------------------------------------------*/ diff --git a/site_ansto/hardsup/modbustcp.h b/site_ansto/hardsup/modbustcp.h new file mode 100644 index 00000000..6b5f8d07 --- /dev/null +++ b/site_ansto/hardsup/modbustcp.h @@ -0,0 +1,28 @@ +/*--------------------------------------------------------------------------- + M O D B U S T C P . H + +Modbus functions designed for use with the WEST4100 Temperature Controller. + +Paul Barron, 2008 +----------------------------------------------------------------------------*/ + +#ifndef MODBUSTCP +#define MODBUSTCP +#include "rs232controller.h" + +// Own Codes +#define MODBUSTCP_BadFunction -8001 +#define MODBUSTCP_BadDataAddress -8002 +#define MODBUSTCP_IllegalFunction -8011 +#define MODBUSTCP_IllegalDataAddress -8012 +#define MODBUSTCP_IllegalDataValue -8013 +#define MODBUSTCP_UnsupportedError -8014 // Device returned a modbus error that is not 81, 82 or 83 +#define MODBUSTCP_TCPError -8016 // Repsonse Transaction and Protocol Identifier do no match query +#define MODBUSTCP_UnknownError -8017 + + +/*---------------------------------------------------------------------------*/ + + int transactModbusTCP(prs232 self, unsigned char *query, int queryLength, unsigned char *response, int responseLength); + +#endif diff --git a/site_ansto/hardsup/serialsinq.c b/site_ansto/hardsup/serialsinq.c index 5c35846f..16b66f3b 100644 --- a/site_ansto/hardsup/serialsinq.c +++ b/site_ansto/hardsup/serialsinq.c @@ -105,14 +105,14 @@ { int status; struct SerialInfo *my_info; - void *my_hndl; - struct hostent *rmt_hostent; - struct in_addr *rmt_inet_addr_pntr; - int rmt_sockname_len; - struct sockaddr_in lcl_sockname; - struct sockaddr_in rmt_sockname; - char msr_cmnd[20]; - struct RS__RplyStruct *rply_ptr; + //void *my_hndl; + //struct hostent *rmt_hostent; + //struct in_addr *rmt_inet_addr_pntr; + //int rmt_sockname_len; + //struct sockaddr_in lcl_sockname; + //struct sockaddr_in rmt_sockname; + //char msr_cmnd[20]; + //struct RS__RplyStruct *rply_ptr; *pData = NULL; @@ -158,14 +158,14 @@ { int status; struct SerialInfo *my_info; - void *my_hndl; - struct hostent *rmt_hostent; - struct in_addr *rmt_inet_addr_pntr; - int rmt_sockname_len; - struct sockaddr_in lcl_sockname; - struct sockaddr_in rmt_sockname; - char msr_cmnd[20]; - struct RS__RplyStruct *rply_ptr; + //void *my_hndl; + //struct hostent *rmt_hostent; + //struct in_addr *rmt_inet_addr_pntr; + //int rmt_sockname_len; + //struct sockaddr_in lcl_sockname; + //struct sockaddr_in rmt_sockname; + //char msr_cmnd[20]; + //struct RS__RplyStruct *rply_ptr; *pData = NULL; @@ -246,7 +246,7 @@ int SerialGetSocket(void **pData) { struct SerialInfo *my_info = NULL; - int iTmo; +// int iTmo; my_info = (struct SerialInfo *)*pData; assert(my_info); @@ -260,7 +260,7 @@ { struct SerialInfo *info_ptr; - char buff[4]; +// char buff[4]; info_ptr = (struct SerialInfo *) *pData; if (info_ptr == NULL) return True; @@ -278,7 +278,7 @@ { struct SerialInfo *info_ptr; - char buff[4]; + // char buff[4]; info_ptr = (struct SerialInfo *) *pData; if (info_ptr == NULL) return True; @@ -348,15 +348,17 @@ int SerialSend(void **pData, char *pCommand) { struct SerialInfo *info_ptr; - int status, c_len, size, max_size, ncmnds; - int bytes_to_come, bytes_left; + //int status, c_len, size, max_size, ncmnds; + int status, c_len, size, ncmnds; + //int bytes_to_come, bytes_left; + int bytes_left; int iResult; - char *nxt_byte_ptr; - char err_text[80]; + //char *nxt_byte_ptr; + //char err_text[80]; char text[20]; char *txt_ptr; char *cmnd_lst_ptr; - char *pComCom = NULL; + //char *pComCom = NULL; /* ** Do nothing if no connection - the connection gets @@ -443,17 +445,18 @@ int SerialReceive(void **pData, char *pBuffer, int iBufLen) { struct SerialInfo *info_ptr; - int status, c_len, size, max_size, ncmnds; + int status;//, c_len, + int size, max_size; //, ncmnds; int bytes_to_come, bytes_left; int iResult; char *nxt_byte_ptr; - char err_text[80]; - char text[20]; - char *txt_ptr; - char *cmnd_lst_ptr; + //char err_text[80]; + //char text[20]; + //char *txt_ptr; + //char *cmnd_lst_ptr; struct RS__RplyStruct_V01B *ptr = NULL; - long lMask = 0L; - struct timeval tmo = {0,1}; + //long lMask = 0L; + //struct timeval tmo = {0,1}; /* @@ -565,17 +568,18 @@ int iBufLen, char *cTerm ) { struct SerialInfo *info_ptr; - int status, c_len, size, max_size, ncmnds; + int status;//, c_len, + int size, max_size;//, ncmnds; int bytes_to_come, bytes_left; int iResult; char *nxt_byte_ptr; - char err_text[80]; - char text[20]; - char *txt_ptr; - char *cmnd_lst_ptr; + //char err_text[80]; + //char text[20]; + //char *txt_ptr; + //char *cmnd_lst_ptr; struct RS__RplyStruct_V01B *ptr = NULL; - long lMask = 0L; - struct timeval tmo = {0,1}; + //long lMask = 0L; + //struct timeval tmo = {0,1}; /* @@ -889,7 +893,7 @@ void SetSerialSleep(void **pData, SerialSleep pFun, void *pUserData) { struct SerialInfo *pInfo = NULL; - int iRet; + // int iRet; pInfo = (struct SerialInfo *)*pData; pInfo->pFunc = pFun; diff --git a/site_ansto/hardsup/west4100util.c b/site_ansto/hardsup/west4100util.c new file mode 100644 index 00000000..a46e1f45 --- /dev/null +++ b/site_ansto/hardsup/west4100util.c @@ -0,0 +1,507 @@ +/*-------------------------------------------------------------------------- + + W E S T 4 1 0 0 U T I L . C + + A few utility functions for dealing with a WEST4100 temperature controller + within the SINQ setup: host -- TCP/IP -- MAC --- RS-232. + + Mark Koennecke, Juli 1997 + Mark Lesha, January 2006 (based on ITC4 code) + Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and + not the new LS340 code written by Rodney Davies Feb 08) + + Copyright: + + Labor fuer Neutronenstreuung + Paul Scherrer Institut + CH-5423 Villigen-PSI + + + The authors hereby grant permission to use, copy, modify, distribute, + and license this software and its documentation for any purpose, provided + that existing copyright notices are retained in all copies and that this + notice is included verbatim in any distributions. No written agreement, + license, or royalty fee is required for any of the authorized uses. + Modifications to this software may be copyrighted by their authors + and need not follow the licensing terms described here, provided that + the new terms are clearly indicated on the first page of each file where + they apply. + + IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY + FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY + DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + + THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE + IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE + NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR + MODIFICATIONS. +---------------------------------------------------------------------------- */ +#include +#include +#include +#include +#include +#include +#include +#include +#include "west4100util.h" +#include "modbustcp.h" +/* -------------------------------------------------------------------------*/ + + + int WEST4100_Check_Status(pWEST4100 self) + /* Can be called to check for correct operation of the WEST4100 */ + { + int iRet, iRetry; + unsigned char pCommand[20]; + unsigned char pReply[132]; + + iRetry=0; + do + { + // Check Alarm 1 + printf("%-9s %-23s","Checking:", "Status Alarm 1........"); + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x05,0x00,0x01); + if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0) + return iRet; + + if(pReply[3] != 0x0) + { + printf("Warning: Alarm 1 Activated\n"); + strcpy(self->pAns,pReply); + return 1; + }else printf("OK\n"); + + // Check Alarm 2 + printf("%-9s %-23s","Checking:", "Status Alarm 2........"); + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x06,0x00,0x01); + if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0) + return iRet; + + if(pReply[3]!=0x0) + { + printf("Warning: Alarm 2 Activated\n"); + strcpy(self->pAns,pReply); + return 1; + }else{ + printf("OK\n"); + return 1; + } + } while((++iRetry<10)); + /* If we fell out of the loop, the WEST4100 recieved a bad response*/ + sprintf(self->pAns,"Write Status=%s",pReply); + printf("Bad response received!\n"); + return WEST4100__BADREAD; + } +/* -------------------------------------------------------------------------*/ + int WEST4100_ConfigureAndQueryGen(pWEST4100 self, char *command, int fParAdr, float fVal, char *diagnosis) + { + int iRet; + unsigned char pCommandSet[79], pCommandCheck[79]; + unsigned char pReply[79]; + unsigned char fParAdrHex[2],fValHex[2]; + + // Convert int to hexstring + if((iRet=(int2hexstring((int)fParAdr,fParAdrHex)))==0) + return iRet; + if((iRet=(int2hexstring((int)fVal,fValHex)))==0) + return iRet; + + /* Construct a write command. */ + printf("%-9s %-23s","Setting: ",command); + sprintf(pCommandSet,"%c%c%c%c%c%c",self->iAdr,0x06, + fParAdrHex[0],fParAdrHex[1],fValHex[0],fValHex[1]); + + /* Issue a write command. */ + if((iRet=transactModbusTCP(self->controller,pCommandSet,/*strlen(pCommand)*/6,pReply,79))!=1) + return iRet; + printf("OK\n"); + + /* Construct a read command to check that the paramater was set.*/ + printf("%-9s %-23s","Checking:",command); + sprintf(pCommandCheck,"%c%c%c%c%c%c",self->iAdr,04,fParAdrHex[0],fParAdrHex[1],0x00,0x1); + + /* Issue a read command .*/ + if ((iRet=transactModbusTCP(self->controller,pCommandCheck,6,pReply,79))<=0) + { + printf("transactRS232 error! Code=%d.\n",iRet); + printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply)); + return iRet; + } + + // Check that the read data is the same as that was set + if ( (pCommandSet[4]!=pReply[3]) || (pCommandSet[5]!=pReply[4]) ) + { + printf("Response was bad, Data not set.\n"); + if (diagnosis&&*diagnosis) + sprintf(self->pAns,"%s response=%s (%s.)",command,pReply,diagnosis); + else + sprintf(self->pAns,"%s response=%s",command,pReply); + return WEST4100__BADREAD; + } + printf("OK\n"); + return 1; + } +/* -------------------------------------------------------------------------*/ + int WEST4100_SetControl(pWEST4100 self, int iControl) + { + // Left over from lakeshore code, West only has 1 sensor to choose from. + + return 1; + } +/* -------------------------------------------------------------------------*/ + int WEST4100_Setup(pWEST4100 self) + { + int iRet; + unsigned char pCommand[40]; + unsigned char pReply[132]; + //int fVal = 999999.; + + /* Check the WEST4100 status */ + if ((iRet=WEST4100_Check_Status(self))!=1) + return iRet; + + // Check the write status + printf("%-9s %-23s","Checking:", "Write Status.........."); + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x01,0x00,0x01,0x00,0x01); + if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0) + { + printf("Comms error!\n"); + return iRet; // Comms problem + } + if (pReply[3] & 0x1) + { + printf("OK\n"); + }else if (pReply[3] == 0x00) + { + printf("Status is Write Disabled.\n"); + return WEST4100__READONLY; + } + + /* Check that the controller is a gen-new-wine WEST4100 */ + printf("%-9s %-23s","Checking:", "ID...................."); + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x03,0x00,122,0x00,0x01); + if((iRet=transactModbusTCP(self->controller,pCommand,/*strlen*/6,pReply,79))!=1) + return iRet; + + if ((pReply[3]!=0x17) || (pReply[4]!=0xd4)) + { + printf("Error: Incorrect ID\n"); + strcpy(self->pAns,pReply); + return WEST4100__NOWEST4100; + } + else printf("OK\n"); + + // Set Output Limit + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Output Power to 100%..",20,100,""))!=1) + return iRet; + + // Set Alarm1 Limit + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Alarm1 to 1600........",13,1600,""))!=1) + return iRet; + + // Set Alarm2 Limit + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Alarm2 to 0...........",14,0,""))!=1) + return iRet; + + // Set Upper Limit + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Upper Limit to 1800...",22,1800,""))!=1) + return iRet; + + // Set Lower Limit + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Lower Limit to 0......",23,0,""))!=1) + return iRet; + + // Set Ramp Rate + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Ramp Rate to 0ff......",24,10000,""))!=1) + return iRet; + + /* Check the WEST4100 operating status one last time */ + if ((iRet=WEST4100_Check_Status(self))!=1) + return iRet; + + return 1; /* Success */ + } +/* -------------------------------------------------------------------------*/ + int WEST4100_Open(pWEST4100 *pData, char *pRS232, int iAddress, int iTransaction) + { + pWEST4100 self = NULL; + + self = (pWEST4100)malloc(sizeof(WEST4100)); + if(self == NULL) + { + return WEST4100__BADMALLOC; + } + *pData = self; + self->iAdr = iAddress; + self->iTransact = iTransaction; + + self->controller = NULL; + + self->controller = (prs232)FindCommandData(pServ->pSics,pRS232, + "RS232 Controller"); + if(!self->controller){ + /*SCWrite(pCon,"ERROR: motor controller not found",eError); */ + return WEST4100__BADCOM; + } + + return WEST4100_Setup(self); + } +/*--------------------------------------------------------------------------*/ + void WEST4100_Close(pWEST4100 *pData) + { + pWEST4100 self; + + self = *pData; + if (!self) + return; // Just in case + + return; + } +/*--------------------------------------------------------------------------*/ + int WEST4100_Config(pWEST4100 *pData, int iTmo, int iRead, int iControl) + { + pWEST4100 self; + + self = *pData; + + return 1; + } +/* --------------------------------------------------------------------------*/ + int WEST4100_Send(pWEST4100 *pData, char *pCommand, char *pReply, int iLen) + { + int iRet; + pWEST4100 self; + + self = *pData; + + char *ptr = pCommand; + unsigned int byte; + unsigned char pCommandHex[79]; + size_t i; + + // Convert char string command to hex string with every two characters concatenated to one array field + for (i=0;icontroller,pCommandHex,6,pReply,79))!=1){ + printf("%-s","Response: "); + displayHexString(pReply); + return iRet; + } + printf("OK\n"); + + printf("%-s","Response: "); + displayHexString(pReply); + + /* Check the WEST4100 operating status after issuing the command, if it was successful */ + if (iRet>=1) + iRet=WEST4100_Check_Status(self); + + return iRet; + } +/*--------------------------------------------------------------------------*/ + int WEST4100_Read(pWEST4100 *pData, float *fVal) + { + unsigned char pCommand[20], pReply[132]; + int iRet; + float fRead = -999999.; + pWEST4100 self; + + self = *pData; + + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,04,0x0,0x1,0x0,0x1); + if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0) + { + printf("transactRS232 error! Code=%d.\n",iRet); + printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply)); + return iRet; + } + + // Because a value read will never be greater than FF FF we can use a simple line to convert + fRead=(256*pReply[3])+pReply[4]; + + if(fRead > 65535 || fRead < 0) // Not a number, probably an error response + { + return WEST4100__BADREAD; + } + + *fVal = fRead; + + return 1; + } +/*--------------------------------------------------------------------------*/ + int WEST4100_Query(pWEST4100 *pData, int parAddress, int *parValue) + { + unsigned char pCommand[20], pReply[132], pAddress[1]; + int iRet; + pWEST4100 self; + + self = *pData; + + int2hexstring(parAddress,pAddress); + sprintf(pCommand,"%c%c%c%c%c%c",self->iAdr,0x4,pAddress[0],pAddress[1],0x0,0x1); + if ((iRet=transactModbusTCP(self->controller,pCommand,6,pReply,79))<=0) + { + printf("transactRS232 error! Code=%d.\n",iRet); + printf("DEBUG: pReply='%s' len=%d \n",pReply,strlen(pReply)); + return iRet; + } + + // Because a value read will never be greater than FF FF we can use a simple line to convert + *parValue=(256*pReply[3])+pReply[4]; + + if(*parValue > 65535 || *parValue < 0) // Not a number, probably an error response + { + return WEST4100__BADREAD; + } + + return 1; + } +/* -------------------------------------------------------------------------*/ + int WEST4100_Write(pWEST4100 *pData, int parAddress, int parValue) + { + unsigned char displaytext[20]; + int iRet; + pWEST4100 self; + + self = *pData; + + sprintf(displaytext,"Parameter Number %d...",parAddress); + if((iRet=WEST4100_ConfigureAndQueryGen(self,displaytext,parAddress,parValue,""))!=1) + return iRet; + + if ((iRet=WEST4100_Check_Status(self))!=1) + return iRet; + + return 1; + } +/* -------------------------------------------------------------------------*/ + int WEST4100_Set(pWEST4100 *pData, float fVal) + { + int iRet, i; + pWEST4100 self; + + self = *pData; + + for(i = 0; i < 3; i++) + { + // Set setpoint + if((iRet=WEST4100_ConfigureAndQueryGen(self,"Setpoint...",0x02,fVal,""))!=1) + return iRet; + + printf("SETP OK, checking status and returning.\n"); + iRet=WEST4100_Check_Status(self); + + return iRet; + } + printf("SETP failed!\n"); + return WEST4100__BADSET; + } +/* -------------------------------------------------------------------------*/ +void WEST4100_ErrorTxt(pWEST4100 *pData,int iCode, char *pError, int iLen) + { + char pBueffel[512]; + pWEST4100 self; + + self = *pData; + + switch(iCode) + { + case WEST4100__BADCOM: + sprintf(pBueffel,"WEST4100: Invalid command or offline, got %s", + self->pAns); + strncpy(pError,pBueffel,iLen); + break; + case WEST4100__BADPAR: + strncpy(pError,"WEST4100: Invalid parameter specified",iLen); + break; + case WEST4100__BADMALLOC: + strncpy(pError,"WEST4100: Error allocating memory in WEST4100",iLen); + break; + case WEST4100__BADREAD: + strncpy(pError,"WEST4100: Badly formatted answer",iLen); + break; + case WEST4100__BADSET: + strncpy(pError,"WEST4100: Failed three times to write new set value to WEST4100",iLen); + break; + case WEST4100__FAULT: // Covers various WEST4100 self-diagnosed fault conditions + sprintf(pBueffel,"WEST4100: Internal fault condition detected: %s",self->pAns); + strncpy(pError,pBueffel,iLen); + break; + case WEST4100__NOWEST4100: + sprintf(pBueffel,"WEST4100: Wrong model number (driver is for Model 340 only): %s",self->pAns); + strncpy(pError,pBueffel,iLen); + break; + default: + getRS232Error(iCode, pError,iLen); + break; + } + } +/* -------------------------------------------------------------------------*/ +int int2hexstring(int fVal, unsigned char *hexstring) +{ + size_t k; + int fValInt; + unsigned char temp[79]; + int result,remainder,index,index2; + + fValInt=fVal; + + if(fValInt>65535) + { + printf("Value greater than FF FF"); + return 0; + } + + // Convert integer to hex and putting each char in an array + memset(temp,0,sizeof(temp)); + result=1; + for(k=0;result!=0;k++) + { + result=fValInt/16; + remainder=fValInt%16; + fValInt=result; + temp[k]=remainder; + } + + // Formatting a new array so that there is one byte per array field + if((k%2)==0) + index2=k/2-1; + else + index2=k/2; + + if(fVal>255) + { + for(index=0;index2>=0;(index=index+2),index2--) + { + hexstring[index2]=(temp[index+1]*16)+temp[index]; + } + }else{ + hexstring[0]=0x0; + hexstring[1]=(temp[1]*16)+temp[0]; + } + + return 1; +} +/* -------------------------------------------------------------------------*/ +void displayHexString(unsigned char *hexstring) +{ + int i; + + for(i=0;(i<5)|(hexstring[i]!='\0');i++)printf("%02x ",hexstring[i]); + printf("\n"); +} diff --git a/site_ansto/hardsup/west4100util.h b/site_ansto/hardsup/west4100util.h new file mode 100644 index 00000000..3fa9a135 --- /dev/null +++ b/site_ansto/hardsup/west4100util.h @@ -0,0 +1,130 @@ +/*--------------------------------------------------------------------------- + W E S T 4 1 0 0 + + A few utility functions for talking to a Lakeshore 340 + temperature controller via the SINQ setup: TCP/IP--MAC--RS-232-- + WEST4100. + + Mark Koennecke, Juli 1997 + Mark Lesha, January 2006 (based on ITC4 code) + Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and + not the new LS340 code written by Rodney Davies Feb 08) + +----------------------------------------------------------------------------*/ +#ifndef SINQWEST4100 +#define SINQWEST4100 + +/*----------------------- ERRORCODES-------------------------------------- + Most functions return a negative error code on failure. Error codes + defined are those defined for serialsinq plus a few additional ones: +*/ + +#define WEST4100__BADCOM -501 +/* command not recognized */ +#define WEST4100__BADPAR -502 +/* bad parameter to command */ +#define WEST4100__BADMALLOC -503 +/* error allocating memory */ +#define WEST4100__BADREAD -504 +/* error analysing command string on Read */ +#define WEST4100__FAULT -505 +/* fault or overload condition exists in WEST4100 */ +#define WEST4100__NOWEST4100 -510 +/* Controller is not WEST4100 */ +#define WEST4100__BADSET -530 +/* failed three times to set temperature */ +#define WEST4100__READONLY -531 +/*------------------------------------------------------------------------*/ + typedef struct __WEST4100 { + int iAdr; + int iTransact; + void *pData; + char pAns[80]; + prs232 controller; + } WEST4100; + + typedef struct __WEST4100 *pWEST4100; + +/*-----------------------------------------------------------------------*/ + int WEST4100_Open(pWEST4100 *pData,char *pHost, int iAddress, int iTransaction); + /***** creates an WEST4100 datastructure and opens a connection to the WEST4100 + controller. Input Parameters are: + the hostname + the port number + the RS-232 channel number on the Mac. + iMode: 1 for ReadOnly, 0 for normal mode + + Return values are 1 for success, a negative error code on + failure. + + */ + + void WEST4100_Close(pWEST4100 *pData); + /****** close a connection to an WEST4100controller and frees its + data structure. The only parameter is a pointer to the data + structure for this controller. This pointer will be invalid after + this call. + */ + + int WEST4100_Config(pWEST4100 *pData, int iTmo, int iRead, + int iControl); + /***** configure some aspects of a WEST4100temperature controller. + The parameter are: + - a pointer to the data structure for the controller as + returned by WEST4100_Open + - a value for the connection timeout + - the temperature sensor to use for reading the + temperature. + - the temperature sensor used by the WEST4100controller + for regulating the temperature. + - the divisor needed to calculate the real temperature + from the sensor. + The function returns 1 on success, a negative error code on + failure. + */ + + int WEST4100_Send(pWEST4100 *pData, char *pCommand, char *pReply, int iLen); + /******* send a the command in pCommand to the WEST4100controller. + A possible reply is returned in the buffer pReply. + Maximum iLen characters are copied to pReply. + The first parameter is a pointer to a WEST4100data structure + as returned by WEST4100_Open. + + Return values are 1 for success, a negative error code on + failure. + */ + + int WEST4100_Read(pWEST4100 *pData, float *fVal); + /******* reads the current actual temperature of the sensor + configured by ConfigWEST4100for reading. The value is returned + in fVal. The first parameter is a pointer to a WEST4100 + data structure as returned by WEST4100_Open. + + Return values are 1 for success, a negative error code on + failure. + */ + + int WEST4100_Set(pWEST4100 *pData, float fVal); + /****** sets a new preset temperature in the WEST4100temperature + controller. Parameters are: + - a pointer to a WEST4100data structure as returned by WEST4100_Open. + - the new preset value. + + Return values are 1 for success, a negative error code on + failure.pEVInterface + */ + + void WEST4100_ErrorTxt(pWEST4100 *pData, int iCode, char *pError, int iLen); + /******* translates one of the negative error WEST4100error codes + into text. Maximum iLen bytes will be copied to the + buffer pError; + */ + + int WEST4100_Query(pWEST4100 *pData, int parAddress, int *parValue); + int WEST4100_Write(pWEST4100 *pData, int parAddress, int parValue); + int int2hexstring(int fVal, unsigned char *hexstring); + void displayHexString(unsigned char *hexstring); + +#endif + + diff --git a/site_ansto/instrument/MANIFEST.TXT b/site_ansto/instrument/MANIFEST.TXT index 8e6ea31f..3790ab36 100644 --- a/site_ansto/instrument/MANIFEST.TXT +++ b/site_ansto/instrument/MANIFEST.TXT @@ -1,4 +1,5 @@ server_config.tcl +barebones.tcl util gumxml.tcl config/hmm/anstohm_linked.xml diff --git a/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl b/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl index 8896b479..b4e72093 100644 --- a/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl +++ b/site_ansto/instrument/TEST_SICS/fakeDMC/simAxis.tcl @@ -1,7 +1,7 @@ -# $Revision: 1.7 $ -# $Date: 2008-05-12 01:08:15 $ +# $Revision: 1.8 $ +# $Date: 2008-05-30 00:26:54 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # Requires a configuration array for each axis that you want to simulate. # eg @@ -87,7 +87,9 @@ proc BG {_axis} { proc MG {args} { # Skip formatting if {[string index [lindex $args 0] 0] == "F"} { - set msg [lrange $args 1 end] + set msg [lrange $args 1 end] + } else { + set msg $args } # If msg starts with _ then return val for axis if {[string index $msg 0] == "_"} { @@ -111,7 +113,7 @@ proc nextstep {paxis step target} { set axis(TP) [expr int($step * $mult + $axis(TP))]; set TD_POS [expr int($axis(TD) + $step)]; set axis(TD) [expr int($TD_POS)]; - if {$axis(ST) == 1 || [expr abs($TD_POS - double($target))] < 0.5} { + if {$axis(ST) == 1} { set axis(TS) 44; # Stopped, limit switches open set axis(BG) 0; # motor has stopped set axis(ST) 0; # make sure stop flag is unset diff --git a/site_ansto/instrument/barebones.tcl b/site_ansto/instrument/barebones.tcl new file mode 100644 index 00000000..990e650a --- /dev/null +++ b/site_ansto/instrument/barebones.tcl @@ -0,0 +1,48 @@ +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:54 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# @file This is a barebones SICS configuration file, it's useful for testing +# drivers in isolation. +# +# NOTE\n +# This configuration does not create a GumTree interface or let you +# save nexus data files. + +# Required by server_config.tcl +VarMake Instrument Text Internal +Instrument echidna +Instrument lock + +#START SERVER CONFIGURATION SECTION +source sics_ports.tcl + +########source server_config.tcl + +set sicsroot ../ +source util/utility.tcl +ServerOption LogFileBaseName $sicsroot/log/serverlog + +###### installprotocolhandler + +ServerOption statusfile $sicsroot/log/status.tcl +ServerOption RedirectFile $sicsroot/log/stdout +ServerOption LogFileDir $sicsroot/log +ServerOption QuieckPort [get_portnum $quieckport ] +ServerOption ServerPort [get_portnum $serverport ] +ServerOption InterruptPort [get_portnum $interruptport ] +ServerOption TelWord sicslogin +ServerOption TelnetPort [get_portnum $telnetport ] +ServerOption ReadUserPasswdTimeout 600000 +ServerOption AcceptTimeOut 10 +ServerOption ReadTimeOut 10 +SicsUser manager ansto 1 +SicsUser user sydney 2 +SicsUser spy 007 3 + +MakeDrive + +exe batchpath ../batch +exe syspath ../batch +clientput "serverport [get_portnum $::serverport]" diff --git a/site_ansto/instrument/config/anticollider/anticollider_common.tcl b/site_ansto/instrument/config/anticollider/anticollider_common.tcl new file mode 100644 index 00000000..f464fa31 --- /dev/null +++ b/site_ansto/instrument/config/anticollider/anticollider_common.tcl @@ -0,0 +1,167 @@ +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:54 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +# TODO Handle sequencing when simultaneously moving multiple axes +# TODO Handle functional dependencies (just write your own tcl script) +# or get the generic acscript to call a user proc +# FIXME The anticollider module does not report the error messages from the +# anticollision script, we currently get around this by using broadcast. + +AntiCollisionInstall +namespace eval anticollider { + variable veto_region +} +array unset ::anticollider::veto_region +array set ::anticollider::veto_region "" + +## +# @brief Load an anticollider script +proc ::anticollider::loadscript {args} { + variable prog + set prog "" + + set fh [open $::cfPath(anticollider)/[lindex $args 0] RDONLY ] + while {[gets $fh line] >= 0} { + # Skip empty lines and comments + if [regexp {^\s*$|^ *#} $line] { + continue + } + lappend prog $line + } +} + +## +# @brief Compile compile an anticollider declaration into a veto region table +# for the anticollider script. +# +# @param vprog, an anticollider declaration as a list of quote enclosed lines. +# @return Generates the ::anticollider::veto_region lookup table. +# +# Example\n +# forbid {160 167} for stth when mtth in {87 88}\n +# forbid { {0 15} {20 25} } for stth when mtth in { {80 90} {139.5 140.5} }\n +# for pcx forbid { {80 130} {-inf 10} }\n +# when mom in {0 45} forbid {{0 15} {345 360}} for pcr\n +# for sphi forbid { {0 5} {10 15} } when schi in { {5 10} {15 20} }\n +# forbid {-inf 5} when mtth in {0 10} for sphi\n +# forbid {0 10} for samx whenall { samrot in {0 5} samy in {0 15} }\n +proc ::anticollider::genveto {vprog} { + variable veto_region + array unset veto_region + set lnum 1 + + foreach line $vprog { + array unset vp + array set vp $line + if [info exists vp(whenall)] { + foreach {mot in range} $vp(whenall) { + if {[llength [join $range]] != 2} { + error "ERROR: $range is not a valid range for $mot. Line $lnum of the veto list" + } + lappend condlist $mot $range + } + lappend veto_region($vp(for)) [list $vp(forbid) @and $condlist] + } elseif [info exists vp(when)] { + lappend veto_region($vp(for)) [list $vp(forbid) $vp(when) $vp(in)] + } else { + lappend veto_region($vp(for)) [list $vp(forbid) @any @all] + } + incr lnum + } +} + +## +# @brief Generic anti-collision script for simple collision avoidance. +# +# WARNING: This does not handle sequencing. Only run one motor at a time. +# This script requires that an ::anticollider::veto_region has been generated +# by the ::anticollider::genveto procedure. +# +# The ::anticollider::veto_region is a hash indexed by the names of the motors +# which have been registered with the anticollision module. +proc ::anticollider::acscript {args} { + variable veto_region + + foreach {regmot target} $args { + foreach row $veto_region($regmot) { + if { [lindex $row 1] == "@and"} { + set forbid [lindex $row 0] + set no_veto 0 + foreach {mot range} [lindex $row 2] { + set pos [SplitReply [$mot]] + foreach {lower upper} $range {} + if {$pos < $lower || $pos > $upper} { + set no_veto 1 + break + } + } + if {$no_veto} { + continue + } else { + foreach {min max} $forbid {} + if {$min <= $target && $target <= $max} { + broadcast "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]" + error "ERROR:The range ($forbid) is forbidden for $regmot when [lindex $row 2]" + } + } + } else { + foreach {forbidden_range obstmot obstrange} $row { + if {$obstmot == "@any"} { + if {$obstrange == "@all"} { + foreach {min max} [join $forbidden_range] { + if {$min <= $target && $target <= $max} { + broadcast "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)" + error "ERROR: $regmot target ($target) is in the forbidden region ($forbidden_range)" + } + } + } else { + broadcast "ERROR: veto table must use @all with @any" + error "ERROR: veto table must use @all with @any" + } + } else { + if {$obstrange == "@all"} { + broadcast "ERROR: veto table must use @any with @all" + error "ERROR: veto table must use @any with @all" + } else { + foreach {lower upper} [join $obstrange] { + set pos [SplitReply [$obstmot]] + if {$lower <= $pos && $pos <= $upper} { + foreach {min max} [join $forbidden_range] { + if {$min <= $target && $target <= $max} { + broadcast "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)" + error "ERROR:The range $min to $max is forbidden for $regmot when $obstmot is in this region ($obstrange)" + + } + } + } + } + } + } + } + } + } + anticollision add 0 $regmot $target + } +} + +## +# @brief Generate anticollider veto_region and register motors with anticollider +proc ::anticollider::init {} { + variable evp + variable veto_region + + if [ catch { + ::anticollider::genveto $::anticollider::prog + foreach motor [array names veto_region] { + anticollision register $motor + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +publish ::anticollider::acscript user +anticollision script ::anticollider::acscript diff --git a/site_ansto/instrument/config/commands/commands_common.tcl b/site_ansto/instrument/config/commands/commands_common.tcl new file mode 100644 index 00000000..abd884c2 --- /dev/null +++ b/site_ansto/instrument/config/commands/commands_common.tcl @@ -0,0 +1,85 @@ +## +# @file Definition of common command node procs. + +################################################################################ +# SCAN COMMANDS +namespace eval scan { +command hdb_bmonscan { + text=drivable scan_variable + float scan_start + float scan_increment + int NP + text=monitor,timer mode + float preset + int=0,2 channel +} { + + bmonscan clear +# bmonscan configure script + + bmonscan add $scan_variable $scan_start $scan_increment + bmonscan setchannel $channel; + set status [catch {bmonscan run $NP $mode $preset} msg] +# bmonscan configure soft + if {$status == 0} { + return $msg + } else { + return -code error "ERROR [info level 0]" + } + + +} +::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status +::scan::hdb_bmonscan -set feedback status IDLE + +command hdb_hmscan { + text=drivable scan_variable + float scan_start + float scan_increment + int NP + text=monitor,timer mode + float preset + int=0,2 channel +} { + + hmscan clear + + hmscan add $scan_variable $scan_start $scan_increment + hmscan setchannel $channel; + set status [catch {hmscan run $NP $mode $preset} msg] + + if {$status == 0} { + return $msg + } else { + return -code error "ERROR [info level 0]" + } + + +} +::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status +::scan::hdb_hmscan -set feedback status IDLE +} +sicslist setatt ::scan::hdb_bmonscan long_name bmonscan +sicslist setatt ::scan::hdb_hmscan long_name hmscan +################################################################################ + +################################################################################ +# MONITOR COMMANDS +namespace eval monitor { + command count { + text=timer,monitor mode + float preset + } { + ::monitor::count -set feedback status BUSY + bm setmode $mode + bm count $preset + ::monitor::count -set feedback counts [SplitReply [bm getcounts]]; + ::monitor::count -set feedback status IDLE + } + ::monitor::count -addfb int counts text status + ::monitor::count -set feedback status IDLE + array set fbarr [::monitor::count -list feedback] + ::utility::mkData $fbarr(counts) data monitor privilege user mutable true + array unset fbarr +} +################################################################################ diff --git a/site_ansto/instrument/config/counter/counter_common_1.tcl b/site_ansto/instrument/config/counter/counter_common_1.tcl index 8fe9ebc7..79a7999d 100644 --- a/site_ansto/instrument/config/counter/counter_common_1.tcl +++ b/site_ansto/instrument/config/counter/counter_common_1.tcl @@ -1,20 +1,2 @@ -#FIXME Nexus path info is coded into this source. This means that if you change the -# monitor data path in the config/hipadaba/common_instrument_dictionary.tcl then -# you may also need to change the paths here bm SetExponent 0 sicslist setatt bm privilege internal -namespace eval monitor { - command count {text:timer,monitor mode float: preset} { - #FIXME remove dependency on hdb path - ::monitor::count -set feedback status BUSY - bm setmode $mode - bm count $preset - ::monitor::count -set feedback counts [SplitReply [bm getcounts]]; - ::monitor::count -set feedback status IDLE - } - ::monitor::count -addfb int counts text status - ::monitor::count -set feedback status IDLE - array set fbarr [::monitor::count -list feedback] - ::utility::mkData $fbarr(counts) data monitor privilege user mutable true - array unset fbarr -} diff --git a/site_ansto/instrument/config/environment/temperature/lakeshore340_common.tcl b/site_ansto/instrument/config/environment/temperature/lakeshore340_common.tcl new file mode 100644 index 00000000..eebaec4f --- /dev/null +++ b/site_ansto/instrument/config/environment/temperature/lakeshore340_common.tcl @@ -0,0 +1,28 @@ +namespace eval ::environment::temperature { } + +# @brief Make a simulated temperature controller object. +# +# @param temp_sobj, name for temperature controller object. +proc ::environment::temperature::mkls340sim {temp_sobj} { + EvFactory new $temp_sobj sim + sicslist setatt $temp_sobj numsensors 4 + sicslist setatt $temp_sobj controlsensor sensora + sicslist setatt $temp_sobj sensorlist sensora,sensorb,sensorc,sensord + sicslist setatt $temp_sobj heateron 1 + sicslist setatt $temp_sobj range 2 + sicslist setatt $temp_sobj units kelvin + sicslist setatt $temp_sobj klass @none +} + +# @brief Make a lakeshore340 temperature controller object. +# +# @param temp_sobj, name for temperature controller object +# @param IP, (optional) IP address for temperature controller. +# @param port, (optional) port number for temperature controller. +proc ::environment::temperature::mkls340 {temp_sobj {IP 137.157.201.50} {port 4001}} { + Makeasyncqueue sertemp1 LS340 $IP $port + sertemp1 timeout 2000 + EvFactory new $temp_sobj ls340 sertemp1 1 D ABCD + sicslist setatt $temp_sobj units kelvin + sicslist setatt $temp_sobj klass @none +} diff --git a/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl index 6baea1e8..3a61cc0b 100644 --- a/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl +++ b/site_ansto/instrument/config/hipadaba/common_instrument_dictionary.tcl @@ -32,11 +32,107 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave false klass NXinstrument type instrument} } - instrument/status { + instrument/aperture { privilege spy - sobj {@any plc} + sobj {@any aperture} datatype @none - property {data false control true nxsave false klass @none type part} + property {data true control true nxsave false klass NXaperture type part} + } + instrument/attenuator { + privilege spy + sobj {@any attenuator} + datatype @none + property {data true control true nxsave false klass NXattenuator type part} + } + instrument/beam_stop { + privilege spy + sobj {@any beam_stop} + datatype @none + property {data true control true nxsave false klass NXbeam_stop type part} + } + instrument/bending_magnet { + privilege spy + sobj {@any bending_magnet} + datatype @none + property {data true control true nxsave false klass NXbending_magnet type part} + } + instrument/crystal { + privilege spy + sobj {@any crystal} + datatype @none + property {data true control true nxsave false klass NXcrystal type part} + } + instrument/disk_chopper { + privilege spy + sobj {@any disk_chopper} + datatype @none + property {data true control true nxsave false klass NXdisk_chopper type part} + } + instrument/fermi_chopper { + privilege spy + sobj {@any fermi_chopper} + datatype @none + property {data true control true nxsave false klass NXfermi_chopper type part} + } + instrument/filter { + privilege spy + sobj {@any filter} + datatype @none + property {data true control true nxsave false klass NXfilter type part} + } + instrument/flipper { + privilege spy + sobj {@any flipper} + datatype @none + property {data true control true nxsave false klass NXflipper type part} + } + instrument/guide { + privilege spy + sobj {@any guide} + datatype @none + property {data true control true nxsave false klass NXguide type part} + } + instrument/insertion_device { + privilege spy + sobj {@any insertion_device} + datatype @none + property {data true control true nxsave false klass NXinsertion_device type part} + } + instrument/mirror { + privilege spy + sobj {@any mirror} + datatype @none + property {data true control true nxsave false klass NXmirror type part} + } + instrument/moderator { + privilege spy + sobj {@any moderator} + datatype @none + property {data true control true nxsave false klass NXmoderator type part} + } + instrument/polarizer { + privilege spy + sobj {@any polarizer} + datatype @none + property {data true control true nxsave false klass NXpolarizer type part} + } + instrument/positioner { + privilege spy + sobj {@any positioner} + datatype @none + property {data true control true nxsave false klass NXpositioner type part} + } + instrument/source { + privilege spy + sobj {@any source} + datatype @none + property {data true control true nxsave false klass NXsource type part} + } + instrument/velocity_selector { + privilege spy + sobj {@any velocity_selector} + datatype @none + property {data true control true nxsave false klass NXvelocity_selector type part} } instrument/detector { privilege spy @@ -44,29 +140,17 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave false klass NXdetector type part} } - sample { - privilege spy - sobj {@any sample} - datatype @none - property {data true control true nxsave false klass NXsample type part} - } instrument/collimator { privilege spy sobj {@any collimator} datatype @none property {data true control true nxsave false klass NXcollimator type part} } - monitor { - privilege spy - sobj {@any monitor} - datatype @none - property {data true control true nxsave false klass NXmonitor type part} - } instrument/monochromator { privilege spy - sobj {@any monochromator @any crystal} + sobj {@any monochromator} datatype @none - property {data true control true nxsave false klass NXcrystal type part} + property {data true control true nxsave false klass NXmonochromator type part} } instrument/slits { privilege spy @@ -74,17 +158,17 @@ set instrument_dictionary [subst { datatype @none property {data true control true nxsave false klass NXfilter type part} } - user { + sample { privilege spy - sobj {@any user} + sobj {@any sample @any environment} datatype @none - property {data true control true nxsave false klass NXuser type part} + property {data true control true nxsave false klass NXsample type part} } - experiment { + monitor { privilege spy - sobj {@any experiment} + sobj {@any monitor} datatype @none - property {data true control true nxsave false klass NXnote type part} + property {data true control true nxsave false klass NXmonitor type part} } data { privilege spy @@ -92,6 +176,43 @@ set instrument_dictionary [subst { datatype @none property {data true control false nxsave false klass NXdata type part datatype UNKNOWN currentfiletype UNKNOWN} } + event_data { + privilege spy + sobj {@any event_data} + datatype @none + property {data true control false nxsave false klass NXevent_data type part datatype UNKNOWN currentfiletype UNKNOWN} + } + user { + privilege spy + sobj {@any user} + datatype @none + property {data true control true nxsave false klass NXuser type part} + } + process { + privilege spy + sobj {@any process} + datatype @none + property {data true control true nxsave false klass NXprocess type part} + } + characterization { + privilege spy + sobj {@any characterization} + datatype @none + property {data true control true nxsave false klass NXcharacterization type part} + } + + experiment { + privilege spy + sobj {@any experiment} + datatype @none + property {data true control true nxsave false klass NXnote type part} + } + instrument/status { + privilege spy + sobj {@any plc} + datatype @none + property {data false control true nxsave false klass @none type part} + } data/data_set { privilege spy datatype @none diff --git a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl index 58b3edb6..d62c4947 100644 --- a/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl +++ b/site_ansto/instrument/config/hipadaba/hipadaba_configuration_common.tcl @@ -15,8 +15,384 @@ InstallHdb namespace eval ::hdb { namespace export buildHDB attlist + +set NXlog_template { + NXlog { + $name { + $paramarr(time) + $paramarr(value) + $paramarr(raw_value) + $paramarr(description) + $paramarr(average_value) + $paramarr(average_value_error) + $paramarr(minimum_value) + $paramarr(maximum_value) + $paramarr(duration) + } + } } +set NXnote_template { + NXnote { + $name { + $paramarr(author) + $paramarr(date) + $paramarr(type) + $paramarr(file_name) + $paramarr(description) + $paramarr(data) + } + } +} + +set NXbeam_template { + $name { + $paramarr(distance) + $paramarr(incident_energy) + $paramarr(final_energy) + $paramarr(energy_transfer) + $paramarr(incident_wavelength) + $paramarr(incident_wavelength_spread) + $paramarr(incident_beam_divergence) + $paramarr(final_wavelength) + $paramarr(incident_polarization) + $paramarr(final_polarization) + $paramarr(final_wavelength_spread) + $paramarr(final_beam_divergence) + $paramarr(flux) + } +} + +# NOTE: paramarr(offset) was added for Quokka's DetPosYOffsetmm parameter +set NXgeometry_template { + NXgeometry { + geometry { + sobjlist {$paramarr(geomdescription)} + NXshape { + shape { + sobjlist {$paramarr(shape) $paramarr(size)} + } + } + NXtranslation { + position { + sobjlist {$paramarr(position) $paramarr(offset) $paramarr(coordinate_scheme)} + NXgeometry { + geometry { + link { + target {$paramarr(refpos)} + nxalias {$paramarr(position)} + } + } + } + } + } + NXorientation { + orientation { + sobjlist {$paramarr(orientation)} + } + } + } + } +} + +set NXaperture_template [subst -novariables { + NXaperture { + $name { + sobjlist {$paramarr(material) $paramarr(description)} + [ set NXgeometry_template ] + } + } +} ] + +set NXvelocity_selector_template [subst -novariables { + NXvelocity_selector { + $name { + sobjlist { + $paramarr(type) + $paramarr(rotation_speed) + $paramarr(radius) + $paramarr(spwidth) + $paramarr(length) + $paramarr(num) + $paramarr(twist) + $paramarr(table) + $paramarr(height) + $paramarr(width) + $paramarr(wavelength) + $paramarr(wavelength_spread) + } + [ set NXgeometry_template ] + } + } +} ] +} + +proc ::hdb::MakeLog {name klass paramlist} { + variable NXlog_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXlog_template + ::hdb::subtree_macro $name $klass $newtable +} +proc ::hdb::MakeNote {name klass paramlist} { + variable NXnote_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXnote_template + ::hdb::subtree_macro $name $klass $newtable +} +proc ::hdb::MakeBeam {name klass paramlist} { + variable NXbeam_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXbeam_template + ::hdb::subtree_macro $name $klass $newtable +} + +proc ::hdb:MakeEnvironment {name klass paramlist} { + variable NXenvironment_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXenvironment_template + ::hdb::subtree_macro $name $klass $newtable +} + +proc ::hdb::MakeGeometry {name klass paramlist} { + variable NXgeometry_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXgeometry_template + ::hdb::subtree_macro $name $klass $newtable +} + +## +# @brief Generates an hdb subtree macro from a named list of SICS objects. +# +# NOTE: Currently the only SICS objects supported are 'sicsvariable' and 'macro'. +# @param name, This is the name of the aperture. +# @paramlist, A name value list of aperture parameters. All parameters are optional. +proc ::hdb::MakeAperture {name paramlist} { + array set paramarr $paramlist + variable NXaperture_template + set newtable [list] + prune_NX newtable $NXaperture_template + ::hdb::subtree_macro $name instrument $newtable +} + +proc ::hdb::MakeVelocity_Selector {name paramlist} { + variable NXvelocity_selector_template + array set paramarr $paramlist + set newtable [list] + prune_NX newtable $NXvelocity_selector_template + ::hdb::subtree_macro $name instrument $newtable +} + +## +# @brief This simplifies a NeXus-class template by removing unnecessary branches. +# A NeXus-class template is a keyed-list which has Tcl variables for some of the nodes, +# if the Tcl variables aren't defined for some branch then that branch is removed. +# All other variables are expanded in place, also all 'sobjlists' are split up into type +# specific lists. This is intended as a helper function for commands which generate +# NeXus-class keyed lists from a simple set of optional parameters. +# +# @param NXklist, This is a keyed list representation of the NeXus class which will be augmented +# with the pruned nx_template. Note this can just be an empty list. +# @param nx_template, The NeXus-class template which will be pruned. +# @param path, (optional, default="") Parent path in recursive calls. +# @param node, (optional, default="") Current node in recursive calls. +# @param level, (optional,default=1) The location of the template parameters in the callstack. +proc prune_NX {NXklist nx_template {path ""} {node ""} {level 1}} { + upvar $NXklist newtable +# puts "[info level 0]\nCallstack depth = [info level]\nRecursion depth = [expr $level-1]" + if {$path == ""} { + set currpath $node + } else { + set currpath $path/$node + } + foreach {n v} $nx_template { + switch $n { + "sobjlist" { + set has_sobj 0 + foreach var $v { + if {[string index $var 0] == "$"} { + set vn [string range $var 1 end] + upvar $level $vn lvar + if [info exists lvar] { + foreach sobj $lvar { + lappend [getatt $sobj type]_list $sobj + } + set has_sobj 1 + } + } else { + foreach sobj $var { + lappend [getatt $sobj type]_list $sobj + } + set has_sobj 1 + } + } + if {$has_sobj} { + if [info exists sicsvariable_list] { + ::utility::tabset newtable $currpath/sicsvariable [subst {{$sicsvariable_list}}] + } + if [info exists macro_list] { + ::utility::tabset newtable $currpath/macro [subst {{$macro_list}}] + } + } else { + } + } + "link" { + set linktarget "" + array set linkinfo $v + if {[string index $linkinfo(target) 0] == "$"} { + set vn [string range $linkinfo(target) 1 end] + upvar $level $vn lvar + if [info exists lvar] { + set linktarget $lvar + } + } else { + set linktarget $linkinfo(target) + } + if {[string index $linkinfo(nxalias) 0] == "$"} { + set vn [string range $linkinfo(nxalias) 1 end] + upvar $level $vn avar + if [info exists avar] { + set linkname $avar + } + } else { + set linkname $linkinfo(nxalias) + } + if {$linktarget != ""} { + ::utility::tabset newtable $currpath/link/target [subst {{$linktarget}}] + ::utility::tabset newtable $currpath/link/nxalias [subst {{$linkname}}] + } + } + default { + if {[string range $n 0 1] == "NX"} { + set node $n + } elseif {[string index $n 0] == "$"} { + set vn [string range $n 1 end] + upvar $level $vn lvar + if [info exists lvar] { + set node $lvar + } else { + } + } else { + set node $n + } + prune_NX newtable $v $currpath $node [expr $level+1] + } + } + } +} + +## +# @brief Make an aperture +# +# @param args optional name and description variables +#proc MakeAperture {apname nxgeometry args} { +# set nxaperture [::hdb::NXaperture $apname $nxgeometry $args] +# ::hdb::subtree_macro $apname instrument $nxaperture +#} + +## +# @brief Generate a subtree macro procedure +# +# @param Name of the subtree macro +# @klass Category which the macro belongs to (usually a NeXus class) +# @klist A keyed list which describes the subtree. +proc ::hdb::subtree_macro {name klass klist} { + set st_macroname ${name}_subtree_macro + proc ::hdb::$st_macroname {} "return [list $klist]" + ::hdb::set_subtree_props ::hdb::$st_macroname $klass +} + +## +# @brief Publish an hdb_subtree macro and initialise it's property list +# +# @param st_name The name of the hdb_subtree macro +# @param klass Where should the subtree be placed in the hdb heirarchy +# @param control (optional, default=true) Add it to the control interface? +# @param privilege (optional, default=user) Modification privilege. +proc ::hdb::set_subtree_props {st_name klass {control "true"} {privilege "user"} } { + publish $st_name mugger + sicslist setatt $st_name klass $klass + sicslist setatt $st_name control $control + sicslist setatt $st_name privilege $privilege + sicslist setatt $st_name kind "hdb_subtree" + sicslist setatt $st_name long_name "@none" + sicslist setatt $st_name data "true" + sicslist setatt $st_name nxsave "true" +} + +# @brief Add a subtree to a given hipadaba path. +# +# @param hpath, Basepath for subtree +# @param object, SICS object name +# @param subtree, A nested Tcl list which represents the subtree +# @param type, the SICS object type if we are adding SICS object node. Optional, default = @none. +# @param makenode, type of node to make. Optional, default = @none. +proc ::hdb::add_subtree {hpath subtree {object @none} {type @none} {makenode @none}} { + set ::errorInfo "" + set SICStypes {sicsvariable macro} + if [catch { + switch $makenode { + "@none" { + foreach {n v} $subtree { + if {[lsearch -exact $::nexus_classes $n] != -1} { + add_subtree $hpath $v $object $n NXclass + } elseif {[lsearch -exact $SICStypes $n] != -1} { + add_subtree $hpath $v $object $n sicsobject + } elseif {$n=="link"} { + add_subtree $hpath $v $object $n link + } else { + error "ERROR:Unknown type, '$n'" + } + } + } + "NXclass" { + foreach {item val} $subtree { + add_hpath $hpath $item + hsetprop $hpath/$item klass $type + add_subtree $hpath/$item $val $object + } + } + "sicsobject" { + foreach item $subtree { + if {$item==$object} { + error "ERROR: Infinite recursion, cannot add $item as a node to it's own hdb subtree" + } + set objtype [getatt $item type] + if {$type != $objtype} { + error "ERROR: Specified type of '$type' doesn't match actual type, '$objtype', for $item" + } + sobjadd $hpath $item + } + } + "link" { + set target [::utility::tabget subtree target] + set nxalias [::utility::tabget subtree nxalias] + foreach l $nxalias t $target { + set refname [getatt $t long_name] + ::hdb::add_hpath $hpath $refname + hsetprop $hpath/$refname data "true" + hsetprop $hpath/$refname nxsave "false" + hsetprop $hpath/$refname control "false" + + hsetprop $hpath/$refname link $t + hsetprop $hpath/$refname nxalias ${l}_posref + hsetprop $hpath/$refname type nxvgroup + hsetprop $hpath/$refname klass @none + } + } + default { + error "ERROR: Unknown node type, $makenode" + } + } + } message ] { + if {$::errorCode=="NONE"} {return $hpath} + return -code error $message + } +} ## # @brief Add an hdb path to the hdb tree at the given basePath # @@ -87,103 +463,113 @@ proc ::hdb::add_feedback {hpath sobj name} { proc ::hdb::add_node {basePath args} { global nodeindex array unset arg_array - array set arg_array $args; - - if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} { - add_hpath $basePath $arg_array(path) - if {$basePath == "/"} { - set node_path /$arg_array(path) - } else { - set node_path $basePath/$arg_array(path) - } - # if {[info exists arg_array(prop_list)]} { - foreach {prop pval} $arg_array(prop_list) { - hsetprop $node_path $prop $pval + if [ catch { + array set arg_array $args + if {[info exists arg_array(path)] && [info exists arg_array(prop_list)]} { + add_hpath $basePath $arg_array(path) + if {$basePath == "/"} { + set node_path /$arg_array(path) + } else { + set node_path $basePath/$arg_array(path) } - # } - return $node_path - } + # if {[info exists arg_array(prop_list)]} { + foreach {prop pval} $arg_array(prop_list) { + hsetprop $node_path $prop $pval + } + # } + return $node_path + } - if {![info exists arg_array(dlen)]} { - set arg_array(dlen) "" - } - set gp_path [file dirname $arg_array(node)] - set node_name [file tail $arg_array(node)] - if {$gp_path != "."} { - add_hpath $basePath $gp_path - set basePath $basePath/$gp_path - hsetprop $basePath type part - } - if {[lsearch [hlist $basePath] $node_name] == -1} { - #TODO allow hdb nodes of type drivable countable environment - array set attribute [attlist $node_name] - switch $arg_array(kind) { - command { - # A command is a macro, node=macro name - set command $node_name - set cmd_path [add_command $basePath $command] - set node_path $cmd_path - # The extra arguments for add_node are supplied by the command parameters - # and command feedback procedures. - if {[string length [info procs ${command}_parameters]] > 0} { - ${command}_parameters add_node $cmd_path - } else { - $command -map param ::hdb::add_cmd_par $cmd_path + if {![info exists arg_array(dlen)]} { + set arg_array(dlen) "" + } + set gp_path [file dirname $arg_array(node)] + set node_name [file tail $arg_array(node)] + if {$gp_path != "."} { + add_hpath $basePath $gp_path + set basePath $basePath/$gp_path + hsetprop $basePath type part + } + if {[lsearch [hlist $basePath] $node_name] == -1} { + #TODO allow hdb nodes of type drivable countable environment + array set attribute [attlist $node_name] + switch $arg_array(kind) { + command { + # A command is a macro, node=macro name + set command $node_name + set cmd_path [add_command $basePath $command] + set node_path $cmd_path + # The extra arguments for add_node are supplied by the command parameters + # and command feedback procedures. + if {[string length [info procs ${command}_parameters]] > 0} { + ${command}_parameters add_node $cmd_path + } else { + $command -map param ::hdb::add_cmd_par $cmd_path + } + if {[string length [info procs ${command}_feedback]] > 0} { + add_hpath $cmd_path feedback + hsetprop $cmd_path/feedback type part + ${command}_feedback add_node $cmd_path/feedback + } else { + add_hpath $cmd_path feedback + hsetprop $cmd_path/feedback type part + $command -map feedback ::hdb::add_feedback $cmd_path/feedback + } } - if {[string length [info procs ${command}_feedback]] > 0} { - add_hpath $cmd_path feedback - hsetprop $cmd_path/feedback type part - ${command}_feedback add_node $cmd_path/feedback - } else { - add_hpath $cmd_path feedback - hsetprop $cmd_path/feedback type part - $command -map feedback ::hdb::add_feedback $cmd_path/feedback + hobj { + hattach $basePath $node_name $arg_array(long_name) + set node_path $basePath/$arg_array(long_name) + hsetprop $node_path data [getatt $node_name data] + hsetprop $node_path control [getatt $node_name control] + hsetprop $node_path nxsave [getatt $node_name nxsave] + hsetprop $node_path mutable [getatt $node_name mutable] + hsetprop $node_path klass [getatt $node_name klass] + if [info exists attribute(hdbchain)] { + foreach pmot [split $attribute(hdbchain) ,] { + hchain $node_path [getatt $pmot hdb_path] + } + } + foreach child [hlist $node_path] { + hsetprop $node_path/$child data false + hsetprop $node_path/$child control [getatt $node_name control] + hsetprop $node_path/$child nxsave false + hsetprop $node_path/$child klass [getatt $node_name klass] + } + } + script - getset { + # A r/w pair of scripts, node = a node path + set node_path $basePath/[getatt $node_name long_name] + set data_type [getatt $node_name dtype] + set data_length [getatt $node_name dlen] + if {[getatt $node_name access] == "read_only"} { + hmakescript $node_path $node_name hdbReadOnly $data_type $data_length + } else { + hmakescript $node_path $node_name $node_name $data_type $data_length + } + hsetprop $node_path sicsdev $node_name + hsetprop $node_path nxalias $node_name + hsetprop $node_path data [getatt $node_name data] + hsetprop $node_path control [getatt $node_name control] + hsetprop $node_path klass [getatt $node_name klass] + hsetprop $node_path sdsinfo [getatt $node_name sdsinfo] + hsetprop $node_path savecmd [getatt $node_name savecmd] + #hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen) } } - hobj { - hattach $basePath $node_name $arg_array(long_name) - set node_path $basePath/$arg_array(long_name) - hsetprop $node_path data [getatt $node_name data] - hsetprop $node_path control [getatt $node_name control] - hsetprop $node_path nxsave [getatt $node_name nxsave] - hsetprop $node_path klass [getatt $node_name klass] - foreach child [hlist $node_path] { - hsetprop $node_path/$child data false - hsetprop $node_path/$child control [getatt $node_name control] - hsetprop $node_path/$child nxsave false - hsetprop $node_path/$child klass [getatt $node_name klass] + if {[info exists attribute(units)]} { + hsetprop $node_path units $attribute(units) + } + if {[info exists arg_array(prop_list)]} { + foreach {prop pval} $arg_array(prop_list) { + hsetprop $node_path $prop $pval } } - script { - # A r/w pair of scripts, node = a node path - set node_path $basePath/[getatt $node_name long_name] - set data_type [getatt $node_name dtype] - set data_length [getatt $node_name dlen] - if {[getatt $node_name access] == "read_only"} { - hmakescript $node_path $node_name hdbReadOnly $data_type $data_length - } else { - hmakescript $node_path $node_name $node_name $data_type $data_length - } - hsetprop $node_path sicsdev $node_name - hsetprop $node_path nxalias $node_name - hsetprop $node_path data true - hsetprop $node_path control false - hsetprop $node_path klass [getatt $node_name klass] - hsetprop $node_path sdsinfo [getatt $node_name sdsinfo] - hsetprop $node_path savecmd [getatt $node_name savecmd] - #hmakescript $node_path $arg_array(rscript) $arg_array(wscript) $arg_array(dtype) $arg_array(dlen) - } + sicslist setatt $node_name hdb_path $node_path + return $node_path } - if {[info exists attribute(units)]} { - hsetprop $node_path units $attribute(units) - } - if {[info exists arg_array(prop_list)]} { - foreach {prop pval} $arg_array(prop_list) { - hsetprop $node_path $prop $pval - } - } - sicslist setatt $node_name hdb_path $node_path - return $node_path + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -218,10 +604,15 @@ proc ::hdb::add_command {basePath command} { # @param sicsobj SICS object name # @return a list of name value pairs for the sicsobj attributes proc ::hdb::attlist {sicsobj} { - foreach att [tolower_sicslist $sicsobj] { - lappend atts [split [string range $att 0 end-1] =] + if [ catch { + foreach att [tolower_sicslist $sicsobj] { + lappend atts [split [string range $att 0 end-1] =] + } + return [join $atts] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } - return [join $atts] } @@ -273,109 +664,108 @@ proc ::hdb::sobjadd {hpath sobj args} { # TODO Check if args parameter needs to be here, it might be there in case the function is called # with more than two arguments. array unset sobjatt - array set sobjatt [attlist $sobj] - sicslist setatt $sobj id $sobj - switch $sobjatt(type) { - motor - configurablevirtualmotor { - if {[info exists sobjatt(group)]} { - set hpath [add_hpath $hpath $sobjatt(group)] - if {[catch {hsetprop $hpath type part} err]} {clientput $err error} - } - if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] - if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} - if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} - if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} - if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} - } else { - clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error - } - } - macro { - # access attribute = ro,rw - if {[info exists sobjatt(group)]} { - set hpath [add_hpath $hpath $sobjatt(group)] - if {[catch {hsetprop $hpath type part} err]} {clientput $err error} - } - if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} { - clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error - } else { - set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ] - if [info exists sobjatt(mutable)] { - if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} + if [ catch { + array set sobjatt [attlist $sobj] + sicslist setatt $sobj id $sobj + switch $sobjatt(type) { + motor - configurablevirtualmotor { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + if {[catch {hsetprop $hpath type part} err]} {clientput $err error} } - } - } - sicsvariable { - if {[info exists sobjatt(group)]} { - set hpath [add_hpath $hpath $sobjatt(group)] - if {[catch {hsetprop $hpath type part} err]} {clientput $err error} - } - if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] - if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error} - if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error} - if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} - if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} - if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} - if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error} - } else { - clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error - } - } - node { - } - singlecounter { -# TODO - todo_msg "$sobjatt(type) case, add $sobj to $hpath" - } - histmem { - if {[info exists sobjatt(group)]} { - set hpath [add_hpath $hpath $sobjatt(group)] - if {[catch {hsetprop $hpath type part} err]} {clientput $err error} - } - if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} - if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error} - } else { - clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error - } + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + macro { + # access attribute = ro,rw + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + if {[catch {hsetprop $hpath type part} err]} {clientput $err error} + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] != -1} { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } elseif {$sobjatt(kind) == "hdb_subtree"} { + add_subtree $hpath [$sobj] + } else { + set node_path [add_node $hpath kind $sobjatt(kind) node $sobj priv $sobjatt(privilege) ] + if [info exists sobjatt(mutable)] { + if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} + } + } + } + sicsvariable { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + if {[catch {hsetprop $hpath type part} err]} {clientput $err error} + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { + set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error} + if {[catch {hsetprop $node_path nxalias $sobj} err]} {clientput $err error} + if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} + if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} + if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} + if {[catch {hsetprop $node_path privilege $sobjatt(privilege)} err]} {clientput $err error} + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + node { + } + singlecounter { + # TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + histmem { + if {[info exists sobjatt(group)]} { + set hpath [add_hpath $hpath $sobjatt(group)] + if {[catch {hsetprop $hpath type part} err]} {clientput $err error} + } + if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { + set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] + if {[catch {hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} + if {[catch {hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} + if {[catch {hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} + if {[catch {hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} + if {[catch {hsetprop $node_path sicsdev $sobj} err]} {clientput $err error} + } else { + clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error + } + } + nxscript { + # TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + sicsdata { + # TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + scanobject { + # TODO + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } + environment_controller { + todo_msg "$sobjatt(type) case, add $sobj to $hpath" + } } - nxscript { -# TODO - todo_msg "$sobjatt(type) case, add $sobj to $hpath" - } - sicsdata { -# TODO - todo_msg "$sobjatt(type) case, add $sobj to $hpath" - } - scanobject { -# TODO - todo_msg "$sobjatt(type) case, add $sobj to $hpath" - } - environment_controller { - if {[info exists sobjatt(group)]} { - set hpath [add_hpath $hpath $sobjatt(group)] - if {[catch {hsetprop $hpath type part} err]} {clientput $err error} - } - if {[lsearch [hlist $hpath] $sobjatt(long_name)] == -1} { - set node_path [add_node $hpath node $sobj long_name $sobjatt(long_name) kind $sobjatt(kind)] - if {[catch { hsetprop $node_path savecmd $sobjatt(savecmd)} err]} {clientput $err error} - if {[catch { hsetprop $node_path sdsinfo $sobjatt(sdsinfo)} err]} {clientput $err error} - if {[catch { hsetprop $node_path nxalias $sobjatt(nxalias)} err]} {clientput $err error} - if {[catch { hsetprop $node_path mutable $sobjatt(mutable)} err]} {clientput $err error} - hmakescript $node_path/target "$sobj target" hdbReadOnly float - hsetprop $node_path/target data false - hsetprop $node_path/target control true - } else { - clientput "ERROR: $hpath/$sobjatt(long_name) for $sobj exists" error - } - } - } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} +proc ::hdb::write_poll {pollnode val} { + hsetprop $pollnode poll_interval $val + sicspoll intervall $pollnode $val +} +proc ::hdb::read_poll {pollnode} { + return [getatt $pollnode] } ## @@ -388,12 +778,17 @@ proc ::hdb::sobjadd {hpath sobj args} { # @param given_klass A klass in instdict_specification.tcl # @see sobjadd proc ::hdb::sobjtypeadd {hpath sobjtype given_klass} { - foreach {sobj} [sobjlist $sobjtype $given_klass] { - array unset sobjatt - array set sobjatt [attlist $sobj] - if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} { - sobjadd $hpath $sobj + if [ catch { + foreach {sobj} [sobjlist $sobjtype $given_klass] { + array unset sobjatt + array set sobjatt [attlist $sobj] + if {[info exists sobjatt(privilege)] && $sobjatt(privilege) != "internal"} { + sobjadd $hpath $sobj + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -453,18 +848,23 @@ proc ::hdb::prune {instdict} { proc ::hdb::buildHDB {instDict} { #TODO add data control nxsave nxtyp properties upvar #0 $instDict dictionary -prune dictionary - foreach {n v} $dictionary { - array unset varr - array set varr $v - array unset property_array - array set property_array $varr(property) - add_node / path $n prop_list $varr(property) - if {[info exists varr(sobj)]} { - foreach {sicstype sobj_klass} $varr(sobj) { + if [ catch { + prune dictionary + foreach {n v} $dictionary { + array unset varr + array set varr $v + array unset property_array + array set property_array $varr(property) + add_node / path $n prop_list $varr(property) + if {[info exists varr(sobj)]} { + foreach {sicstype sobj_klass} $varr(sobj) { sobjtypeadd /$n $sicstype $sobj_klass + } } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } diff --git a/site_ansto/instrument/config/hipadaba/instdict_specification.tcl b/site_ansto/instrument/config/hipadaba/instdict_specification.tcl index 0226a75f..e44e1a43 100644 --- a/site_ansto/instrument/config/hipadaba/instdict_specification.tcl +++ b/site_ansto/instrument/config/hipadaba/instdict_specification.tcl @@ -11,14 +11,15 @@ set boolean {true false} #} # SICS OBJECTS MUST PROVIDE THE FOLLOWING INFORMATION -set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry experiment graphics instrument monitor monochromator plc sample scan user} +set sobj_klass_list {@none aperture attenuator collimator command crystal data detector entry environment experiment graphics instrument monitor monochromator plc sample scan sensor user} set sobj_sicstype_list {environment_controller sicsvariable macro motor configurablevirtualmotor singlecounter histmem nxscript sicsdata scanobject} # Different kinds of things are added to the hdb in different ways. # command: This is something a client can run with hset /a/b/c start, it may have parameters and feedback. # Parameters and feedback should be made available in 'ilists' named after the command. # script: Supplies an rscript and a wscript to attach to a node for hgets and hsets. # hobj: Something that can be hattached to a node. {motor sicsvariable histmem}. -set sobj_kind_list {command hobj script} +# hdb_subtree: Is a macro which returns a keyed list that describes a hdb subtree. +set sobj_kind_list {command hobj script hdb_subtree} set sobj_interfacelist [subst {drivable {$boolean} countable {$boolean} callback {$boolean} environment {$boolean} }] set privilege_list {spy user manager read_only internal} diff --git a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl index 197c8a52..b3203c07 100644 --- a/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl +++ b/site_ansto/instrument/config/hmm/hmm_configuration_common_1.tcl @@ -1,9 +1,9 @@ -# $Revision: 1.29 $ -# $Date: 2008-02-19 01:40:12 $ +# $Revision: 1.30 $ +# $Date: 2008-05-30 00:26:54 $ # Author: Ferdi Franceschini # Based on the examples in the hs_test.tcl sample configuration by Mark Lesha. # http://gumtree.ansto.gov.au:9080/nbicms/bragg-systems/histogram-server/hs_test.tcl/view -# Last revision by: $Author: mle $ +# Last revision by: $Author: ffr $ ## # @file Provides generic code and parameters for configuring the ANSTO histogram memory server @@ -27,9 +27,14 @@ if {$sim_mode == "true"} { hmm configure statuscheck false namespace eval histogram_memory { proc hmc {_start _preset _mode _pause pauseval} { - bm mode $_mode; - bm preset $_preset; - hmm countblock; + if [ catch { + bm mode $_mode; + bm preset $_preset; + hmm countblock; + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } } } else { @@ -87,33 +92,41 @@ namespace eval histogram_memory { # Procedure to read a single config (or any) file, return content as a string. proc returnconfigfile {filename} { - set ::errorInfo "" - set fh [open $filename] + if [ catch { + set fh [open $filename] set xml [read $fh] close $fh return [subst $xml] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } # Here, define a function to let us read back the value of dictionary items from the hmm # such as OAT dimensions. proc hmmdictitemval {histomem dictitem} { - set ::errorInfo "" - set resp [$histomem configure $dictitem] - set retn [lindex [split $resp " "] 2] - return $retn + if [ catch { + set resp [$histomem configure $dictitem] + set retn [lindex [split $resp " "] 2] + return $retn + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## # @brief Use histogram server to control acquisitions proc set_termination_conditions {count_method count_size count_stop} { - set ::errorInfo "" if [ catch { hmm configure FAT_COUNT_METHOD $count_method hmm configure FAT_COUNT_SIZE $count_size hmm configure FAT_COUNT_STOP $count_stop hmm init - } errmsg] { - return -code error "$errmsg\n$::errorInfo" + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -147,14 +160,14 @@ namespace eval histogram_memory { # #Function to apply OAT offsets to the histogram server. proc set_oat_offset {oatoff_x oatoff_y oatoff_t} { - set ::errorInfo "" if [ catch { hmm configure FAT_OFFSET_OAT_X $oatoff_x hmm configure FAT_OFFSET_OAT_Y $oatoff_y hmm configure FAT_OFFSET_OAT_T $oatoff_t hmm init - } errmsg] { - return -code error "$errmsg\n$::errorInfo" + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -196,22 +209,26 @@ namespace eval histogram_memory { } proc set_sobj_attributes {} { - set ::errorInfo "" - # SICS commands - sicslist setatt blockctr privilege internal; + if [ catch { + # SICS commands + sicslist setatt blockctr privilege internal; - # histogram memory macros - sicslist setatt ::histogram_memory::set_oat_offset privilege internal; - sicslist setatt ::histogram_memory::scan2_runb privilege internal; - sicslist setatt ::histogram_memory::scan2_runa privilege internal; - sicslist setatt ::histogram_memory::returnconfigfile privilege internal; - sicslist setatt ::histogram_memory::save privilege internal; + # histogram memory macros + sicslist setatt ::histogram_memory::set_oat_offset privilege internal; + sicslist setatt ::histogram_memory::scan2_runb privilege internal; + sicslist setatt ::histogram_memory::scan2_runa privilege internal; + sicslist setatt ::histogram_memory::returnconfigfile privilege internal; + sicslist setatt ::histogram_memory::save privilege internal; - foreach hm_obj [sicslist type histmem] { - set_sicsobj_atts $hm_obj detector @none $hm_obj false true; - sicslist setatt $hm_obj privilege user - sicslist setatt $hm_obj kind hobj - sicslist setatt $hm_obj nxsave false + foreach hm_obj [sicslist type histmem] { + set_sicsobj_atts $hm_obj detector @none $hm_obj false true; + sicslist setatt $hm_obj privilege user + sicslist setatt $hm_obj kind hobj + sicslist setatt $hm_obj nxsave false + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -220,10 +237,9 @@ namespace eval histogram_memory { # @brief Returns the histogram memory server clock scale. # # NOTE: The histmem server doesn't provide the clock scale to SICS\n - # so we just hardwaire 1000 nanoseconds which is the current (10/01/08)\n + # so we just hardwire 1000 nanoseconds which is the current (10/01/08)\n # value on all the servers. proc clock_scale {args} { - set ::errorInfo "" switch $args { "" { return 1 } "units" { return "microseconds"} @@ -239,49 +255,53 @@ namespace eval histogram_memory { # @param offset axis offset or @none # @param boundaries list of bin boundaries or @none proc calc_axis {proc_name scale_factor offset boundaries args} { - set ::errorInfo "" variable state - set parlist [join $args] - set opt [lindex $parlist 0] - set arglist [lrange $parlist 1 end] - if {$scale_factor == "@none" || $boundaries == "@none"} { - # Don't calculate axis values, we're just setting or getting the graph_type - } else { - set i 0 - ${proc_name}_array clear - if {$state($proc_name,graph_type) == "boundaries"} { - foreach bb $boundaries { - set val [expr {$scale_factor*$bb + $offset}] - lappend values $val - ${proc_name}_array putfloat $i $val - incr i - } + if [ catch { + set parlist [join $args] + set opt [lindex $parlist 0] + set arglist [lrange $parlist 1 end] + if {$scale_factor == "@none" || $boundaries == "@none"} { + # Don't calculate axis values, we're just setting or getting the graph_type } else { - foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] { - set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}] - lappend values $val - ${proc_name}_array putfloat $i $val - incr i + set i 0 + ${proc_name}_array clear + if {$state($proc_name,graph_type) == "boundaries"} { + foreach bb $boundaries { + set val [expr {$scale_factor*$bb + $offset}] + lappend values $val + ${proc_name}_array putfloat $i $val + incr i + } + } else { + foreach b0 [lrange $boundaries 0 end-1] b1 [lrange $boundaries 1 end] { + set val [expr {$scale_factor*($b1 + $b0)/2.0 + $offset}] + lappend values $val + ${proc_name}_array putfloat $i $val + incr i + } } } - } - switch -- $opt { - "-arrayname" { - return "${proc_name}_array" - } - "-centres" { - set state($proc_name,graph_type) "centres" - } - "-boundaries" { - set state($proc_name,graph_type) "boundaries" - } - "-graph_type" { - return $state($proc_name,graph_type) - } - default { - return $values + switch -- $opt { + "-arrayname" { + return "${proc_name}_array" + } + "-centres" { + set state($proc_name,graph_type) "centres" + } + "-boundaries" { + set state($proc_name,graph_type) "boundaries" + } + "-graph_type" { + return $state($proc_name,graph_type) + } + default { + return $values + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -289,20 +309,24 @@ namespace eval histogram_memory { ## # @brief Provides y_bin boundary array for data axes proc y_bin {args} { - set ::errorInfo "" - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist] - } - default { - return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get Y_BOUNDARIES] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] + } + "-arrayname" { + return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist] + } + default { + return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE Y -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::y_bin @@ -324,20 +348,24 @@ namespace eval histogram_memory { ## # @brief Provides x_bin boundary array for data axes proc x_bin {args} { - set ::errorInfo "" - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $opt $arglist] - } - default { - return [calc_axis $proc_name 1.0 0.0 [OAT_TABLE -get X_BOUNDARIES] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] + } + "-arrayname" { + return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] + } + default { + return [::histogram_memory::calc_axis $proc_name 1.0 0.0 [OAT_TABLE X -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::x_bin @@ -358,34 +386,36 @@ namespace eval histogram_memory { # requires detector_active_width_mm det_radius_mm sicsdatafactory new ::histogram_memory::y_pixel_offset_array proc y_pixel_offset {args} { - set ::errorInfo "" variable state - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $arglist] - } - "-arrayname" { - set det_height_mm [SplitReply [detector_active_height_mm]] - set max_b [OAT_TABLE -get Y_MAX] - set min_b [OAT_TABLE -get Y_MIN] - set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}] - set offset 0.0 - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $opt $arglist] - } - "-units" { - return "mm" - } - default { - set det_height_mm [SplitReply [detector_active_height_mm]] - set max_b [OAT_TABLE -get Y_MAX] - set min_b [OAT_TABLE -get Y_MIN] - set scale_factor [expr {$det_height_mm / ($max_b - $min_b)}] - set offset 0.0 - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get Y_BOUNDARIES] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $arglist] + } + "-arrayname" { + set det_height_mm [SplitReply [detector_active_height_mm]] + set max_chan [OAT_TABLE Y -getdata MAX_CHAN] + set scale_factor [expr {$det_height_mm / $max_chan}] + set offset 0.0 + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $opt $arglist] + } + "-units" { + return "mm" + } + default { + set det_height_mm [SplitReply [detector_active_height_mm]] + set max_chan [OAT_TABLE Y -getdata MAX_CHAN] + set scale_factor [expr {$det_height_mm / $max_chan}] + set offset 0.0 + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE Y -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::y_pixel_offset @@ -407,34 +437,36 @@ namespace eval histogram_memory { # requires detector_active_width_mm det_radius_mm sicsdatafactory new ::histogram_memory::x_pixel_offset_array proc x_pixel_offset {args} { - set ::errorInfo "" variable state - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - set det_width_mm [SplitReply [detector_active_width_mm]] - set max_b [OAT_TABLE -get X_MAX] - set min_b [OAT_TABLE -get X_MIN] - set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}] - set offset 0.0 - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $opt $arglist] - } - "-units" { - return "mm" - } - default { - set det_width_mm [SplitReply [detector_active_width_mm]] - set max_b [OAT_TABLE -get X_MAX] - set min_b [OAT_TABLE -get X_MIN] - set scale_factor [expr {$det_width_mm / ($max_b - $min_b)}] - set offset 0.0 - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_BOUNDARIES] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] + } + "-arrayname" { + set det_width_mm [SplitReply [detector_active_width_mm]] + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set scale_factor [expr {$det_width_mm / $max_chan}] + set offset 0.0 + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] + } + "-units" { + return "mm" + } + default { + set det_width_mm [SplitReply [detector_active_width_mm]] + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set scale_factor [expr {$det_width_mm / $max_chan}] + set offset 0.0 + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::x_pixel_offset @@ -455,21 +487,25 @@ namespace eval histogram_memory { sicsdatafactory new ::histogram_memory::time_channel_array proc time_channel {args} { - set ::errorInfo "" variable state - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $opt $arglist] - } - default { - return [calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE -get T_BOUNDARIES] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] + } + "-arrayname" { + return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $opt $arglist] + } + default { + return [::histogram_memory::calc_axis $proc_name [::histogram_memory::clock_scale] 0.0 [OAT_TABLE T -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::time_channel @@ -489,6 +525,50 @@ namespace eval histogram_memory { unset script_name } +################################# +# Must always specify number of channels +# bb list len <= channels+1 +# Calculate the boundaries after successfully uploading a configuration. +# set values [OAT_TABLE -get X] +# set channels [OAT_TABLE -get NXC] +# OAT_TABLE X -setdata BOUNDARIES [calc_boundaries $values $channels] +proc ::histogram_memory::calc_boundaries {values channels} { + if [ catch { + set bbnum [llength $values] + set maxbblen [expr $channels+1] + set maxchan [expr $channels - 1] + if {$bbnum > $maxbblen} { + error "ERROR: The number of bin boundaries must be less than or equal to $maxbblen" + } + set BOUNDARIES "" + if {$bbnum > 2} { + set BOUNDARIES $values + } elseif {$bbnum == 2} { + foreach {leftbb rightbb} $values {} + set bstep [expr {$rightbb-$leftbb}] + if {$bstep == 0} { + error "ERROR: The generating bin boundaries are equal" + } + set startbin [expr ($leftbb+$rightbb)/2.0] + # FIXME This check doesn't work for time, T +# if {$startbin < 0.0 || $startbin > $maxchan} { +# error "ERROR: $leftbb and $rightbb must bound a channel >= 0 or <= $maxchan" +# } + for {set bb $leftbb; set i 0} {$i < $maxbblen} {incr i; set bb [expr {$bb + $bstep}]} { + lappend BOUNDARIES $bb + } + } else { + error "ERROR: You must specify at least two bin boundaries" + } + return $BOUNDARIES + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +set hmm_xml "" + ## # @brief Provides a standard set of subcommands for the histogram server table # configuration commands. @@ -514,177 +594,369 @@ namespace eval histogram_memory { # TODO Maintain "proposed" and "current" tables. Provide a setcurrent command which can # only be called by the upload_config command to set the proposed tables as current # TODO Allow for top level content in tables and attributes in sub-elements -proc XXX_TABLE {tag attributes element_list args} { - set ::errorInfo "" +proc HISTMEM_TABLE {tpath args} { global hmm_xml - if {[llength $args] == 1} { - set arguments [lindex $args 0] - } else { - set arguments $args - } - set opt [lindex $arguments 0] - set arglist [lrange $arguments 1 end] - switch -- $opt { - "" { - foreach att $attributes { - if {$hmm_xml($tag,[string toupper $att]) != ""} { - append table "$att=\"$hmm_xml($tag,$att)\"\n" + + if [ catch { + set tpath [string toupper $tpath] + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "-dump" { + foreach {k v} $hmm_xml {clientput $k; foreach {name val} $v {clientput "$name: $val"}} + } + "-allowed_attributes" { + if {[llength $arglist] == 0} { + return [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_] + } else { + ::utility::tabset hmm_xml $tpath/_ALLOWED_ATTRIBUTES_ [lindex $arglist 0] } } - set content "" - foreach name $element_list { - append content "\n<$name>\n$hmm_xml($tag,$name)\n" - } - if {[info exists table]} { - return "<$tag\n$table>$content\n" - } - } - "-clear" { - foreach att $attributes { - set hmm_xml($tag,[string toupper $att]) "" - } - foreach element $element_list { - set hmm_xml($tag,[string toupper $element]) "" - } - } - "-init" { - foreach att $attributes { - set hmm_xml($tag,[string toupper $att]) "" - } - foreach element $element_list { - set hmm_xml($tag,[string toupper $element]) "" - } - foreach {par val} $arglist { - set hmm_xml($tag,[string toupper $par]) $val - } - } - "-set" { - foreach {par val} $arglist { - set hmm_xml($tag,[string toupper $par]) $val - } - } - "-get" { - set par [string toupper [lindex $arglist 0]] - if {[info exists hmm_xml($tag,$par)]} { - return $hmm_xml($tag,$par) - } else { - foreach name [array names hmm_xml $tag,* ] { - lappend valid_params [lindex [split $name ,] 1] - } - error_msg "$par should be one of $valid_params" - } - } - "-attlist" { - # List attributes - foreach att $attributes { - if {$hmm_xml($tag,$att) != ""} { - lappend table $att $hmm_xml($tag,[string toupper $att]) + "-allowed_elements" { + if {[llength $arglist] == 0} { + return [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_] + } else { + ::utility::tabset hmm_xml $tpath/_ALLOWED_ELEMENTS_ [lindex $arglist 0] + ::utility::tabset hmm_xml $tpath/_ELEMENTS_ [lindex $arglist 0] } } - if {[info exists table]} { - clientput $table + "-setel" { + set element [lindex $arglist 0] + set value [lindex $arglist 1] + if {[lsearch [::utility::tabget hmm_xml $tpath/_ALLOWED_ELEMENTS_] $element] != -1} { + ::utility::tabset hmm_xml $tpath/$element/_CONTENT_ $value + } else { + error "ERROR: $element is not an allowed element in $tpath" + } } - } - default { - array set param [string toupper $arguments] - foreach att [string toupper $attributes] { - if {[info exists param($att)]} { - if {[info exists hmm_xml($tag,${att}_MIN)]} { - if {$param($att) <= $hmm_xml($tag,${att}_MIN)} { - error_msg "$att must be greater than $hmm_xml($tag,${att}_MIN)" - } + "-setatt" { + set attname [lindex $arglist 0] + set value [lindex $arglist 1] + if {[lsearch [::utility::tabget hmm_xml $tpath/_ALLOWED_ATTRIBUTES_] $attname] != -1} { + ::utility::tabset hmm_xml $tpath/_ATTLIST_/$attname $value + } else { + error "ERROR: $attname is not an allowed attribute in $tpath" + } + } + "-getel" { + set element [lindex $arglist 0] + return [::utility::tabget hmm_xml $tpath/$element/_CONTENT_] + } + "-getatt" { + set attribute [lindex $arglist 0] + return [::utility::tabget hmm_xml $tpath/_ATTLIST_/$attribute] + } + "-delel" { + set element [lindex $arglist 0] + ::utility::tabdel hmm_xml $tpath/$element + } + "-delatt" { + set attribute [lindex $arglist 0] + ::utility::tabdel hmm_xml $tpath/_ATTLIST_/$attribute + } + "-clear" { + ::utility::tabdel hmm_xml $tpath/_ATTLIST_ + ::utility::tabdel hmm_xml $tpath/_CONTENT_ + foreach element [::utility::tabget hmm_xml $tpath/_ELEMENTS_] { + ::utility::tabdel hmm_xml $tpath/$element + } + } + "-setdata" { + if {[llength $arglist] == 1} { + set arglist [lindex $arglist 0] + } + foreach {name value} $arglist { + if {$value == ""} { + error "ERROR: No value supplied when setting $name at $tpath in the histogram memory table" } - if {[info exists hmm_xml($tag,${att}_MAX)]} { - if {$param($att) >= $hmm_xml($tag,${att}_MAX)} { - error_msg "$att must be less than $hmm_xml($tag,${att}_MAX)" - } - } - set hmm_xml($tag,$att) $param($att) + ::utility::tabset hmm_xml $tpath/_DATA_/$name $value } } - foreach element [string toupper $element_list] { - if {[info exists param($element)]} { - set hmm_xml($tag,$element) $param($element) + "-getdata" { + if {[llength $arglist] == 1} { + set arglist [lindex $arglist 0] } + if {[llength $arglist] <= 1} { + return [::utility::tabget hmm_xml $tpath/_DATA_/$arglist] + } else { + foreach name $arglist { + lappend values [::utility::tabget hmm_xml $tpath/_DATA_/$name] + } + return $values + } + } + "-getxml" { + return [::utility::tabxml hmm_xml $tpath] } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } ## # @brief Base Address Table configuration parameters as maintained by SICS # -# @see XXX_TABLE for subcommands. proc BAT_TABLE {args} { - set ::errorInfo "" - set attributes {} - set elements "" - set tag BAT - global hmm_xml + if [ catch { + set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE } + set elements {{ }} - switch -glob -- [lindex $args 0] { - "" { - XXX_TABLE $tag $attributes $elements $args - } - "-*" { - XXX_TABLE $tag $attributes $elements $args - } - default { - XXX_TABLE $tag $attributes $elements $args + set tag BAT + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "" { + return [HISTMEM_TABLE $tag -getxml] + } + "-init" { + HISTMEM_TABLE $tag -allowed_elements $elements + HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist] + } + "-set" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach {arg val} $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setel $arg $val + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setatt $attname $val + } + } + } + } + "-get" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach arg $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getel $arg] + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getatt $attname] + } + } + } + if {[llength $values] == 1} { + return [lindex $values 0] + } else { + return $values + } + } + "-del" { + foreach att [lindex $attributes 0] el [lindex $elements 0] { + set index [lsearch -exact $arglist $el] + if {$index != -1} { + HISTMEM_TABLE $tag -delel $el + } + set index [lsearch -exact $arglist $att] + if {$index != -1} { + HISTMEM_TABLE $tag -delatt $att + } + } + } + "-setdata" { + HISTMEM_TABLE $tag -setdata $arglist + } + "-getdata" { + return [HISTMEM_TABLE $tag -getdata $arglist] + } + "-clear" { + HISTMEM_TABLE $tag -clear + } + default { + error "ERROR: Unknown subcommand $opt" + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -BAT_TABLE -clear ## # @brief CAlibration Table configuration parameters as maintained by SICS # -# @see XXX_TABLE for subcommands. proc CAT_TABLE {args} { - set ::errorInfo "" - set attributes {} - set elements "" - set tag CAT - global hmm_xml + if [ catch { + set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE } + set elements {{ }} - switch -glob -- [lindex $args 0] { - "" { - XXX_TABLE $tag $attributes $elements $args - } - "-*" { - XXX_TABLE $tag $attributes $elements $args - } - default { - XXX_TABLE $tag $attributes $elements $args + set tag CAT + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "" { + return [HISTMEM_TABLE $tag -getxml] + } + "-init" { + HISTMEM_TABLE $tag -allowed_elements $elements + HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist] + } + "-set" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach {arg val} $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setel $arg $val + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setatt $attname $val + } + } + } + } + "-get" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach arg $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getel $arg] + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getatt $attname] + } + } + } + if {[llength $values] == 1} { + return [lindex $values 0] + } else { + return $values + } + } + "-del" { + foreach att [lindex $attributes 0] el [lindex $elements 0] { + set index [lsearch -exact $arglist $el] + if {$index != -1} { + HISTMEM_TABLE $tag -delel $el + } + set index [lsearch -exact $arglist $att] + if {$index != -1} { + HISTMEM_TABLE $tag -delatt $att + } + } + } + "-setdata" { + HISTMEM_TABLE $tag -setdata $arglist + } + "-getdata" { + return [HISTMEM_TABLE $tag -getdata $arglist] + } + "-clear" { + HISTMEM_TABLE $tag -clear + } + default { + error "ERROR: Unknown subcommand $opt" + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -CAT_TABLE -clear ## # @brief Frequency Address Table configuration parameters as maintained by SICS # -# @see XXX_TABLE for subcommands. proc FAT_TABLE {args} { - set ::errorInfo "" - set attributes {FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE} - set elements "" - set tag FAT - global hmm_xml + if [ catch { + set attributes { FRAME_FREQUENCY SIZE_PERIOD COUNT_METHOD COUNT_SIZE READ_DATA_TYPE } + set elements {{ }} - switch -glob -- [lindex $args 0] { - "" { - XXX_TABLE $tag $attributes $elements $args - } - "-*" { - XXX_TABLE $tag $attributes $elements $args - } - default { - XXX_TABLE $tag $attributes $elements $args + set tag FAT + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "" { + return [HISTMEM_TABLE $tag -getxml] + } + "-init" { + HISTMEM_TABLE $tag -allowed_elements $elements + HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist] + } + "-set" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach {arg val} $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setel $arg $val + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setatt $attname $val + } + } + } + } + "-get" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach arg $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getel $arg] + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getatt $attname] + } + } + } + if {[llength $values] == 1} { + return [lindex $values 0] + } else { + return $values + } + } + "-del" { + foreach att [lindex $attributes 0] el [lindex $elements 0] { + set index [lsearch -exact $arglist $el] + if {$index != -1} { + HISTMEM_TABLE $tag -delel $el + } + set index [lsearch -exact $arglist $att] + if {$index != -1} { + HISTMEM_TABLE $tag -delatt $att + } + } + } + "-setdata" { + HISTMEM_TABLE $tag -setdata $arglist + } + "-getdata" { + return [HISTMEM_TABLE $tag -getdata $arglist] + } + "-clear" { + HISTMEM_TABLE $tag -clear + } + default { + error "ERROR: Unknown subcommand $opt" + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -FAT_TABLE -clear ## # @brief Offset Address Table configuration parameters as maintained by SICS @@ -697,120 +969,268 @@ FAT_TABLE -clear # @param -clear clears the oat table and the fat table SIZE_PERIOD # # Sets X_BOUNDARIES, Y_BOUNDARIES and T_BOUNDARIES -# @see XXX_TABLE for subcommands. proc OAT_TABLE {args} { - set ::errorInfo "" - global hmm_xml - set attributes {NO_OAT_X_CHANNELS NO_OAT_Y_CHANNELS NO_OAT_T_CHANNELS} - set tag OAT - set coord_list {X Y T} - set elements $coord_list + if [ catch { + array set attlookup {NXC NO_OAT_X_CHANNELS NYC NO_OAT_Y_CHANNELS NTC NO_OAT_T_CHANNELS} + set elements {{ X Y T }} - switch -glob -- [lindex $args 0] { - "" { - XXX_TABLE $tag $attributes $elements $args + set tag OAT + set element [lindex $args 0] + if {[ lsearch [lindex $elements 0] $element] == -1} { + unset element + } else { + set tag $tag/$element + set args [lrange $args 1 end] } - "-*" { - XXX_TABLE $tag $attributes $elements $args - } - "-clear" { - XXX_TABLE $tag $attributes $elements $args - FAT_TABLE SIZE_PERIOD "" - } - default { - array set param $args - foreach coord $coord_list { - if {[info exists param($coord)] == 0} { - error_msg "You must specify $coord_list" + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "" { + return [HISTMEM_TABLE $tag -getxml] + } + "-init" { + HISTMEM_TABLE $tag -allowed_elements $elements + foreach {n v} [array get attlookup] { + lappend attributes $v + } + HISTMEM_TABLE $tag -allowed_attributes [concat $attributes $arglist] + } + "-set" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach {arg val} $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setel $arg $val + } else { + if [info exists attlookup($arg)] { + set attname $attlookup($arg) + } else { + set attname $arg + } + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setatt $attname $val + } + } + } + foreach {nxc nyc} [OAT_TABLE -get NXC NYC] {} + set max_nxc [::histogram_memory::max_chan_num X] + set max_nyc [::histogram_memory::max_chan_num Y] + if {$nxc > $max_nxc} { + gumput "WARNING: Reducing NO_OAT_X_CHANNELS from $nxc to maximum $max_nxc" warning + OAT_TABLE -set NXC $max_nxc + } + if {$nyc > $max_nyc} { + gumput "WARNING: Reducing NO_OAT_Y_CHANNELS from $nyc to maximum $max_nyc" warning + OAT_TABLE -set NYC $max_nyc + } + foreach axis {X Y T} { + set bins [::histogram_memory::oat_bins $axis] + set nch [::histogram_memory::number_of_channels $axis] + OAT_TABLE $axis -setdata BOUNDARIES [::histogram_memory::calc_boundaries $bins $nch] } } - set NOXCH [SplitReply [hmm configure dim0]] - set NOYCH [SplitReply [hmm configure dim1]] - set NOTCH [SplitReply [hmm configure dim2]] - foreach coord $coord_list { - if {[info exists param($coord)]} { - set bbnum [llength $param($coord)] - set hmm_xml(OAT,${coord}_BOUNDARIES) "" - if {$bbnum > 2} { - set NO${coord}CH [expr {$bbnum - 1}] - if {[info exists param(N${coord}C)]} { - set NO${coord}CH $param(N${coord}C) - } - set hmm_xml(OAT,${coord}_BOUNDARIES) [lrange $param($coord) 0 [set NO${coord}CH]] - set hmm_xml(OAT,$coord) ${coord}_BOUNDARIES - } elseif {$bbnum == 2} { - set hmm_xml(OAT,$coord) $param($coord) - set b0 [lindex $param($coord) 0] - set bstep [expr {[lindex $param($coord) 1] - $b0}] - if {$bstep == 0} { - return -code error "The generating bin boundaries for $coord are equal" - } - if {[info exists param(N${coord}C)]} { - set NO${coord}CH $param(N${coord}C) - for {set bb $b0; set i 0} {$i <= [set NO${coord}CH]} {incr i; set bb [expr {$bb + $bstep}] } { - lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb - } - } else { - if {$bstep > 0} { - set bfinal [set hmm_xml(OAT,${coord}_MAX)] - } else { - set bfinal [set hmm_xml(OAT,${coord}_MIN)] - } - set brange [expr {abs($bfinal - $b0)}] - set NO${coord}CH [expr {int(floor(abs($brange/$bstep)))}] - for {set bb $b0} {1} {set bb [expr {$bb + $bstep}] } { - lappend hmm_xml(OAT,${coord}_BOUNDARIES) $bb - if [expr {abs($bfinal - $bb) < abs($bstep)}] { break } - } - } + "-get" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach arg $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getel $arg] } else { - error_msg "You must specify at least two bin boundaries for $coord" + if [info exists attlookup($arg)] { + set attname $attlookup($arg) + } else { + set attname $arg + } + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getatt $attname] + } + } + } + if {[llength $values] == 1} { + return [lindex $values 0] + } else { + return $values + } + } + "-del" { + foreach att [array names attlookup] el [lindex $elements 0] { + set index [lsearch -exact $arglist $el] + if {$index != -1} { + HISTMEM_TABLE $tag -delel $el + } + set index [lsearch -exact $arglist $att] + if {$index != -1} { + HISTMEM_TABLE $tag -delatt $attlookup($att) } } } - set arglist [list NO_OAT_X_CHANNELS $NOXCH NO_OAT_Y_CHANNELS $NOYCH NO_OAT_T_CHANNELS $NOTCH] - XXX_TABLE $tag $attributes $elements $arglist - FAT_TABLE SIZE_PERIOD [expr {$NOXCH*$NOYCH*$NOTCH}] - return [XXX_TABLE $tag $attributes $elements] + "-setdata" { + HISTMEM_TABLE $tag -setdata $arglist + } + "-getdata" { + return [HISTMEM_TABLE $tag -getdata $arglist] + } + "-clear" { + HISTMEM_TABLE $tag -clear + } + default { + error "ERROR: Unknown subcommand $opt" + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -OAT_TABLE -clear -## # @brief Spatial Allocation Table configuration parameters as maintained by SICS # -# @see XXX_TABLE for subcommands. +# Only one element, ie SPLIT with no content just attributes. proc SAT_TABLE {args} { - set ::errorInfo "" - set attributes {} - set elements "" - set tag SAT - global hmm_xml + if [ catch { + set attributes { APPLY MIDPOINT } + set elements {{ SPLIT }} - switch -glob -- [lindex $args 0] { - "" { - XXX_TABLE $tag $attributes $elements $args - } - "-*" { - XXX_TABLE $tag $attributes $elements $args - } - default { - XXX_TABLE $tag $attributes $elements $args + set tag SAT + set attpath SAT/SPLIT + foreach {opt arglist} [::utility::get_opt_arglist $args] {} + switch -- $opt { + "" { + return [HISTMEM_TABLE $tag -getxml] + } + "-init" { + HISTMEM_TABLE $tag -allowed_elements $elements + HISTMEM_TABLE $attpath -allowed_attributes [concat $attributes $arglist] + } + "-set" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach {arg val} $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setel $arg $val + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + incr index + HISTMEM_TABLE $tag -setatt $attname $val + } + } + } + } + "-get" { + set allowed_atts [HISTMEM_TABLE $tag -allowed_attributes] + set allowed_els [HISTMEM_TABLE $tag -allowed_elements] + foreach arg $arglist { + set index [lsearch -exact $allowed_els $arg] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getel $arg] + } else { + set attname $arg + set index [lsearch -exact $allowed_atts $attname] + if {$index >= 0} { + lappend values [HISTMEM_TABLE $tag -getatt $attname] + } + } + } + if {[llength $values] == 1} { + return [lindex $values 0] + } else { + return $values + } + } + "-del" { + foreach att $attributes { + set index [lsearch -exact $arglist $att] + if {$index != -1} { + HISTMEM_TABLE $attpath -delatt $att + } + } + } + "-setdata" { + HISTMEM_TABLE $tag -setdata $arglist + } + "-getdata" { + return [HISTMEM_TABLE $tag -getdata $arglist] + } + "-clear" { + HISTMEM_TABLE $tag -clear + HISTMEM_TABLE $attpath -allowed_attributes $attributes + } + default { + error "ERROR: Unknown subcommand $opt" + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -SAT_TABLE -clear -proc ::histogram_memory::clear_tables {} { - set ::errorInfo "" - BAT_TABLE -clear - CAT_TABLE -clear - FAT_TABLE -clear - OAT_TABLE -clear - SAT_TABLE -clear +## +# @brief Resolve dependencies between the histogram memory tables +proc ::histogram_memory::synch_tables {} { + if [ catch { + set noxch [OAT_TABLE -get NXC] + set noych [OAT_TABLE -get NYC] + set notch [OAT_TABLE -get NTC] + FAT_TABLE -set SIZE_PERIOD [expr $noxch*$noych*$notch] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } +proc ::histogram_memory::clear_tables {} { + if [ catch { + set ::errorInfo "" + BAT_TABLE -clear + CAT_TABLE -clear + FAT_TABLE -clear + OAT_TABLE -clear + SAT_TABLE -clear + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +## +# @brief Calculate the maximum number of oat channels from the generating bin +# boundaries of the given axis +proc ::histogram_memory::max_chan_num {axis} { + if [ catch { + set bins [OAT_TABLE -get $axis] + set numb_bins [llength $bins] + if {$numb_bins < 2} { + error "ERROR: $axis must have at least two bin boundaries" + } elseif {$numb_bins > 2} { + return $numb_bins + } else { + foreach {leftbb rightbb} $bins {} + set bstep [expr $rightbb - $leftbb] + if {$bstep == 0} { + error "ERROR: Bin boundaries for $axis must not be equal" + } elseif {$bstep < 0} { + set binlim [OAT_TABLE $axis -getdata BMIN] + } else { + set binlim [OAT_TABLE $axis -getdata BMAX] + } + } + set numb_bins [expr {int(floor(($binlim - $leftbb)/$bstep))}] + return $numb_bins + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} ## # @brief When called without arguments this returns the name of the filler defaults file # for the histogram server. When called with an argument it sets the current name of the @@ -819,24 +1239,51 @@ proc ::histogram_memory::clear_tables {} { # When anstohm_linked.xml is uploaded to the histogram server it calls this via # command substitution to set the name of the filler defaults file. proc ::histogram_memory::filler_defaults {args} { - set ::errorInfo "" variable hmm_def_filename - if {[llength $args] == 0} { - return $hmm_def_filename - } else { - set hmm_def_filename $args + if [ catch { + if {[llength $args] == 0} { + return $hmm_def_filename + } else { + set hmm_def_filename $args + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } -# XXX DEPRECATED, use upload_config instead. -proc ::histogram_memory::configure_server {instdef} { - clientput "WARNING: ::histogram_memory::configure_server is deprecated, call ::histogram_memory::upload_config instead" - ::histogram_memory::upload_config $instdef +## +# @brief Returns the oat table bin boundaries. +# This function can be replaced with an instrument specific definition +# in the instrumenent specific configuration file. +proc ::histogram_memory::oat_bins {axis} { + if [ catch { + set bins [OAT_TABLE -get $axis] + return $bins + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } + +## +# @brief Returns the current number of channels for a given axis. +# This function can be replaced with an instrument specific definition +# in the instrumenent specific configuration file. +proc ::histogram_memory::number_of_channels {axis} { + array set channID {X NXC Y NYC T NTC} + if [ catch { + return [OAT_TABLE -get $channID($axis)] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + # TODO Set current oat table after uploading proposed oat_table proc ::histogram_memory::upload_config {filler_defaults} { - set ::errorInfo "" if [ catch { + ::histogram_memory::synch_tables ::histogram_memory::filler_defaults $filler_defaults hmm stop hmm configure init 1 @@ -852,11 +1299,19 @@ proc ::histogram_memory::upload_config {filler_defaults} { hmm stop hmm configure statuscheck false ::histogram_memory::configure_dims - } errmsg] { - hmm configure init 0 - return -code error "$errmsg\n$::errorInfo" +# foreach axis {X Y T} { +# set bins [oat_bins $axis] +# set nch [number_of_channels $axis] +# OAT_TABLE $axis -setdata BOUNDARIES [calc_boundaries $bins $nch] +# } + } message ] { + if {$::errorCode=="NONE"} { + clientput "histmem configuration uploaded" + return $message + } else { + return -code error $message + } } - clientput "histmem configuration uploaded" } @@ -864,58 +1319,62 @@ proc ::histogram_memory::upload_config {filler_defaults} { # @brief Configure the dimensions for the controlling histogram object, and for # each auxiliary histogram object. proc ::histogram_memory::configure_dims {} { - set ::errorInfo "" - if {[instname] == "wombat"} { - array set dim_map { - hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}} - hmm,fat_read_data_type HISTOPERIOD_XYT - hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}} - hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY - hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}} - hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT - hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}} - hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT - hmm_x {{hmm_dim0 stitch_nxc}} - hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X - hmm_y {{hmm_dim0 stitch_nyc}} - hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y - hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T + if [ catch { + if {[instname] == "wombat"} { + array set dim_map { + hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc} {hmm_dim2 stitch_nxc}} + hmm,fat_read_data_type HISTOPERIOD_XYT + hmm_xy {{hmm_dim0 stitch_nyc} {hmm_dim1 stitch_nxc}} + hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY + hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nxc}} + hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT + hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 stitch_nyc}} + hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT + hmm_x {{hmm_dim0 stitch_nxc}} + hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X + hmm_y {{hmm_dim0 stitch_nyc}} + hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y + hmm_t {{hmm_dim0 oat_ntc_eff}} + hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T + } + } else { + array set dim_map { + hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}} + hmm,fat_read_data_type HISTOPERIOD_XYT + hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}} + hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY + hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}} + hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT + hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}} + hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT + hmm_x {{hmm_dim0 oat_nxc_eff}} + hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X + hmm_y {{hmm_dim0 oat_nyc_eff}} + hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y + hmm_t {{hmm_dim0 oat_ntc_eff}} + hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T + } } - } else { - array set dim_map { - hmm {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff} {hmm_dim2 oat_nxc_eff}} - hmm,fat_read_data_type HISTOPERIOD_XYT - hmm_xy {{hmm_dim0 oat_nyc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xy,fat_read_data_type TOTAL_HISTOGRAM_XY - hmm_xt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nxc_eff}} - hmm_xt,fat_read_data_type TOTAL_HISTOGRAM_XT - hmm_yt {{hmm_dim0 oat_ntc_eff} {hmm_dim1 oat_nyc_eff}} - hmm_yt,fat_read_data_type TOTAL_HISTOGRAM_YT - hmm_x {{hmm_dim0 oat_nxc_eff}} - hmm_x,fat_read_data_type TOTAL_HISTOGRAM_X - hmm_y {{hmm_dim0 oat_nyc_eff}} - hmm_y,fat_read_data_type TOTAL_HISTOGRAM_Y - hmm_t {{hmm_dim0 oat_ntc_eff}} - hmm_t,fat_read_data_type TOTAL_HISTOGRAM_T - } - } - foreach hm_obj [sicslist type histmem] { - set rank [SplitReply [$hm_obj configure rank]] - set hmm_length 1 - foreach elmt $dim_map($hm_obj) { - set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]] - } - $hm_obj configure FAT_READ_DATA_TYPE $dim_map($hm_obj,fat_read_data_type) - $hm_obj stop - $hm_obj configure init 0 - $hm_obj init + foreach hm_obj [sicslist type histmem] { + set rank [SplitReply [$hm_obj configure rank]] + set hmm_length 1 + foreach elmt $dim_map($hm_obj) { + set [lindex $elmt 0] [hmmdictitemval hmm [lindex $elmt 1]] + } + $hm_obj configure FAT_READ_DATA_TYPE $dim_map($hm_obj,fat_read_data_type) + $hm_obj stop + $hm_obj configure init 0 + $hm_obj init - for {set i 0} {$i < $rank} {incr i} { - set hmm_length [expr {$hmm_length * [set hmm_dim$i]} ] - $hm_obj configure dim$i [set hmm_dim$i] + for {set i 0} {$i < $rank} {incr i} { + set hmm_length [expr {$hmm_length * [set hmm_dim$i]} ] + $hm_obj configure dim$i [set hmm_dim$i] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } ## @@ -923,29 +1382,38 @@ proc ::histogram_memory::configure_dims {} { # # @see ::histogram_memory::set_frame_source proc ::histogram_memory::frame_source_always_internal {args} { - set ::errorInfo "" variable fs_always_internal - if {$args == ""} { - return $fs_always_internal - } - set flag [lindex $args 0] - if {[string is boolean $flag] == 0} { - return -code error "$args must be a boolean" - } else { - set fs_always_internal $flag + + if [ catch { + if {$args == ""} { + return $fs_always_internal + } + set flag [lindex $args 0] + if {[string is boolean $flag] == 0} { + error "ERROR: $args must be a boolean" + } else { + set fs_always_internal $flag + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } publish ::histogram_memory::frame_source_always_internal mugger ## # @brief Return the last frame source which SICS attempted to set proc ::histogram_memory::get_frame_source {} { - set ::errorInfo "" - if [::histogram_memory::frame_source_always_internal] { - clientput "WARNING: The frame source is set to always_internal" value - clientput "Use ::histogram_memory::frame_source_always_internal to change this." value - return INTERNAL - } else { - return [SplitReply [hmm configure fat_frame_source]] + if [ catch { + if [::histogram_memory::frame_source_always_internal] { + clientput "WARNING: The frame source is set to always_internal" value + clientput "Use ::histogram_memory::frame_source_always_internal to change this." value + return INTERNAL + } else { + return [SplitReply [hmm configure fat_frame_source]] + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } ## @@ -954,7 +1422,6 @@ proc ::histogram_memory::get_frame_source {} { # @param srce EXTERNAL or INTERNAL # @param always_internal true or false (optional) (default false) proc ::histogram_memory::set_frame_source {srce} { - set ::errorInfo "" if [ catch { if [::histogram_memory::frame_source_always_internal] { clientput "WARNING: The frame source is set to always_internal" value @@ -965,14 +1432,20 @@ proc ::histogram_memory::set_frame_source {srce} { } ::histogram_memory::stop hmm init - } errmsg ] { - return -code error "$errmsg\n$::errorInfo" - } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## # @brief Return the last frame frequency which SICS attempted to set proc ::histogram_memory::get_frame_freq {} { - return [SplitReply [hmm configure fat_frame_frequency]] + if [ catch { + return [SplitReply [hmm configure fat_frame_frequency]] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## @@ -984,14 +1457,13 @@ proc ::histogram_memory::get_frame_freq {} { # If freq=0 then it sets the frequency to 50Hz with an internal frame source. This is useful # if you are setting the frequency from a chopper which is stopped. proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} { - set ::errorInfo "" variable state - if {[string is double $freq] == 0 || $freq < 0} { - return -code error "Frequency must be a non-negative floating point number" - } - if [ catch { + if {[string is double $freq] == 0 || $freq < 0} { + error "ERROR: Frequency must be a non-negative floating point number" + } + # Frame source for each instrument if freq = 0, this can happen when automatically # setting frequencies from choppers. array set frame_source_on_zero_freq { @@ -1021,17 +1493,22 @@ proc ::histogram_memory::set_frame_freq {freq {frame_source EXTERNAL}} { } ::histogram_memory::stop set clock_scale_ns 1000.0 - OAT_TABLE -set T_MAX [expr {1.0e9/($newfreq*$clock_scale_ns)}] hmm configure fat_frame_frequency $newfreq hmm init - } errmsg] { - return -code error "$errmsg\n$::errorInfo" + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } publish ::histogram_memory::set_frame_freq user proc ::histogram_memory::t_max {} { - set frame_freq [SplitReply [hmm configure fat_frame_frequency]] + if [ catch { + set frame_freq [SplitReply [hmm configure fat_frame_frequency]] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## # @brief Sets histogram server to default configuration, initialises SICS histogram memory @@ -1059,18 +1536,16 @@ proc ::histogram_memory::_initialize {} { hmm configure statuscheck true hmm stop hmm configure statuscheck false - OAT_TABLE -init - OAT_TABLE -set T_MIN 0 ::histogram_memory::frame_source_always_internal false ::histogram_memory::set_frame_freq 50 ::histogram_memory::count_method unlimited ::histogram_memory::count_size 0 - FAT_TABLE -init SIZE_PERIOD_MAX 125000000 hmm configure hmDataPath ../HMData hmm configure hmconfigscript $configuration ::histogram_memory::configure_dims - } ] { - clientput $::errorInfo + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -1093,33 +1568,32 @@ proc ::histogram_memory::post_count {} {} # # @param block (optional) default="noblock" proc ::histogram_memory::start {{blocking "noblock"}} { - set ::errorInfo "" if [ catch { set options [list block noblock] if {[lsearch $options $blocking] == -1} { - return -code error "Valid options are $options" + error "ERROR: Valid options are $options" } - ::histogram_memory::pre_count + ::histogram_memory::pre_count hmm init hmc start 1000000000 timer pause 1 set reply [SplitReply [hmm configure daq]] if {$reply != "Started"} { - return -code error "Histogram server failed to start" + error "ERROR: Histogram server failed to start" } clientput "histmem started" value if {$blocking == "block"} { blockctr count 0 ::histogram_memory::pause } - } errmsg] { - return -code error "$errmsg\n$::errorInfo" + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } ## # @brief This sends the magic incantation which stops the histogram server. proc ::histogram_memory::stop {} { - set ::errorInfo "" if [ catch { hmm pause hmm configure statuscheck true @@ -1127,28 +1601,35 @@ proc ::histogram_memory::post_count {} {} hmm configure statuscheck false set reply [SplitReply [hmm configure daq]] if {$reply != "Stopped"} { - return -code error "Histogram server failed to stop" + error "ERROR: Histogram server failed to stop" + } + } message ] { + if {$::errorCode=="NONE"} { + clientput "histmem stopped" value + return $message + } else { + return -code error $message } - clientput "histmem stopped" value - } errmsg ] { - return -code error "$errmsg\n$::errorInfo" } } ## # @brief Allows resume if MULTIPLE_DATASETS=DISABLE, otherwise if MULTIPLE_DATASETS=ENABLE # (the default) this acts like a stop but allows a fast restart. proc ::histogram_memory::pause {} { - set ::errorInfo "" if [ catch { hmm pause ::histogram_memory::post_count set reply [SplitReply [hmm configure daq]] if {$reply != "Paused"} { - return -code error "Histogram server failed to pause" + error "ERROR: Histogram server failed to pause" + } + } message ] { + if {$::errorCode=="NONE"} { + clientput "histmem paused" value + return $message + } else { + return -code error $message } - clientput "histmem paused" value - } errmsg ] { - return -code error "$errmsg\n$::errorInfo" } } @@ -1157,21 +1638,21 @@ proc ::histogram_memory::post_count {} {} # # @param method Set histmem mode or return current mode if blank proc ::histogram_memory::count_method {{method ""}} { - set ::errorInfo "" - set modes [list time monitor unlimited period count frame] - if {$method==""} { - return [SplitReply [hmm_mode]] - } else { - if {[lsearch $modes $method] == -1} { - return -code error "Count mode, $method, must be one of $modes" - } - if [ catch { + if [ catch { + set modes [list time monitor unlimited period count frame] + if {$method==""} { + return [SplitReply [hmm_mode]] + } else { + if {[lsearch $modes $method] == -1} { + error "ERROR: Count mode, $method, must be one of $modes" + } hmm configure FAT_COUNT_METHOD $method hmm init hmm_mode $method - } errmsg] { - return -code error "$errmsg\n$::errorInfo" } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -1181,22 +1662,21 @@ proc ::histogram_memory::post_count {} {} # @param preset: The interpretation of the preset depends on the count method. # @see count_method proc ::histogram_memory::count_size {{preset ""}} { - set ::errorInfo "" variable state - - if {$preset == ""} { - return $state(preset) - } else { - if {[string is double $preset] == 0 || $preset < 0} { - return -code error "The preset must be a non-negative floating point number" - } - if [ catch { + if [ catch { + if {$preset == ""} { + return $state(preset) + } else { + if {[string is double $preset] == 0 || $preset < 0} { + error "ERROR: The preset must be a non-negative floating point number" + } hmm configure FAT_COUNT_SIZE [expr {100.0 * $preset}] hmm init set state(preset) $preset - } errmsg] { - return -code error "$errmsg\n$::errorInfo" } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -1205,13 +1685,11 @@ proc ::histogram_memory::post_count {} {} # # @return Stopped, Paused, Started, or raises a Tcl error proc ::histogram_memory::status {} { - set ::errorInfo "" if [ catch { set reply [SplitReply [hmm configure daq]] - } errmsg ] { - return -code error "$errmsg\n$::errorInfo" - } else { - return $reply + } message ] { + if {$::errorCode=="NONE"} {return $reply} + return -code error $message } } @@ -1220,20 +1698,20 @@ proc ::histogram_memory::post_count {} {} # # @param condition proc ::histogram_memory::stop_condition {condition} { - set ::errorInfo "" variable state - array set count_stop {immediate IMMEDIATE period AT_END_OF_PERIOD} + if [ catch { + array set count_stop {immediate IMMEDIATE period AT_END_OF_PERIOD} if {$condition == ""} { return $state(stop_cond) } else { - if [ catch { - hmm configure FAT_COUNT_STOP $count_stop($condition) - hmm init - set state(stop_cond) $condition - } errmsg] { - return -code error "$errmsg\n$::errorInfo" - } + hmm configure FAT_COUNT_STOP $count_stop($condition) + hmm init + set state(stop_cond) $condition } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } namespace eval ::histogram_memory { #TODO Create GumTree commands to setup, start and stop the histmem @@ -1259,7 +1737,7 @@ namespace eval ::histogram_memory { # @param cmd is one of start, stop, pause, mode, preset, fsrce, status, loadconf # @param args is an optional list of arguments for the given command proc _histmem {cmd args} { - set ::errorInfo "" + #TODO Add "continue" set reply "" if [ catch { switch $cmd { @@ -1312,13 +1790,12 @@ namespace eval ::histogram_memory { } } default { - return -code error "Available commands are, start stop pause mode preset freq fsrce status loadconf" + error "ERROR: Available commands are, start stop pause mode preset freq fsrce status loadconf" } } - } errmsg ] { - return -code error $errmsg - } - if {$reply != ""} { - clientput $reply value + return $reply + } message ] { + if {$::errorCode=="NONE"} { return $reply } + return -code error $message } } diff --git a/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl b/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl index fba0c706..bf760e40 100644 --- a/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl +++ b/site_ansto/instrument/config/hmm/hmm_cylindrical_detector_configuration.tcl @@ -9,33 +9,36 @@ namespace eval histogram_memory { # requires detector_active_width_mm det_radius_mm deg_per_rad proc two_theta {args} { variable state - set opt [lindex $args 0] - set arglist [lrange $args 1 end] - set proc_name [namespace origin [lindex [info level 0] 0]] - set det_width_mm [SplitReply [detector_active_width_mm]] - set det_radius_mm [SplitReply [detector_radius_mm]] - set deg_per_radian [SplitReply [deg_per_rad]] - switch -- $opt { - "-centres" - "-boundaries" - "-graph_type" { - return [calc_axis $proc_name @none @none @none $opt $args] - } - "-arrayname" { - set max_b [OAT_TABLE -get X_MAX] - set min_b [OAT_TABLE -get X_MIN] - set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}] - set offset [::histogram_memory::detector_posn_degrees] - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $opt $arglist] - } - "-units" { - return "degrees" - } - default { - set max_b [OAT_TABLE -get X_MAX] - set min_b [OAT_TABLE -get X_MIN] - set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / ($max_b - $min_b)}] - set offset [::histogram_memory::detector_posn_degrees] - return [calc_axis $proc_name $scale_factor $offset [OAT_TABLE -get X_boundaries] $args] + if [ catch { + set opt [lindex $args 0] + set arglist [lrange $args 1 end] + set proc_name [namespace origin [lindex [info level 0] 0]] + set det_width_mm [SplitReply [detector_active_width_mm]] + set det_radius_mm [SplitReply [detector_radius_mm]] + set deg_per_radian [SplitReply [deg_per_rad]] + switch -- $opt { + "-centres" - "-boundaries" - "-graph_type" { + return [::histogram_memory::calc_axis $proc_name @none @none @none $opt $args] + } + "-arrayname" { + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}] + set offset [::histogram_memory::detector_posn_degrees] + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $opt $arglist] + } + "-units" { + return "degrees" + } + default { + set max_chan [OAT_TABLE X -getdata MAX_CHAN] + set scale_factor [expr {$deg_per_radian*($det_width_mm/$det_radius_mm) / $max_chan}] + set offset [::histogram_memory::detector_posn_degrees] + return [::histogram_memory::calc_axis $proc_name $scale_factor $offset [OAT_TABLE X -getdata BOUNDARIES] $args] + } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } set script_name ::histogram_memory::two_theta diff --git a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl index 9dba07e5..4fc9c288 100644 --- a/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl +++ b/site_ansto/instrument/config/nexus/nxscripts_common_1.tcl @@ -5,8 +5,16 @@ MakeNXScript sicsdatafactory new nxscript_data +#mkVar name type access long_name nxsave klass control data +::utility::mkVar start_seconds int user start_seconds false entry false false ::utility::mkVar estart Text user start_time true entry false true ::utility::mkVar eend Text user end_time true entry false true +::utility::mkVar timestamp int user time_stamp true entry false true +::utility::mkVar data_run_number int user run_number true instrument false true +sicslist setatt data_run_number mutable true +sicslist setatt timestamp mutable true +sicslist setatt timestamp units seconds + namespace eval nexus { variable data_gp_path "/data" set exports [list newfile closefile save data] @@ -32,12 +40,12 @@ namespace eval nexus { # TODO Put the filetype_spec in a separate file. variable filetype_spec { BEAM_MONITOR { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {data_set ::monitor::count_fb_counts} save_policy {include @all exclude {hmm hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}} } HISTOGRAM_XYT { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::time_channel} link {axis 3 ::histogram_memory::vertical_axis} link {axis 4 ::histogram_memory::horizontal_axis} @@ -45,40 +53,40 @@ namespace eval nexus { save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm_t}} } HISTOGRAM_XY { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::vertical_axis} link {axis 3 ::histogram_memory::horizontal_axis} link {data_set hmm_xy} save_policy {include @all exclude {hmm hmm_xt hmm_yt hmm_x hmm_y hmm_t}} } HISTOGRAM_XT { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::time_channel} link {axis 3 ::histogram_memory::horizontal_axis} link {data_set hmm_xt} save_policy {include @all exclude {hmm_xy hmm hmm_yt hmm_x hmm_y hmm_t}} } HISTOGRAM_YT { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::time_channel} link {axis 3 ::histogram_memory::vertical_axis} link {data_set hmm_yt} save_policy {include @all exclude {hmm_xy hmm_xt hmm hmm_x hmm_y hmm_t}} } HISTOGRAM_X { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::horizontal_axis} link {data_set hmm_x} save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm hmm_y hmm_t}} } HISTOGRAM_Y { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::vertical_axis} link {data_set hmm_y} save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm hmm_t}} } HISTOGRAM_T { - link {axis 1 ::data::gumtree_save_par_run_number} + link {axis 1 data_run_number} link {axis 2 ::histogram_memory::time_channel} link {data_set hmm_t} save_policy {include @all exclude {hmm_xy hmm_xt hmm_yt hmm_x hmm_y hmm}} @@ -187,25 +195,30 @@ proc newFileName {postfix} { variable nexusdic variable state variable data_gp_path - if {$state(file,open) == "true"} { - error_msg "Can't create a new file because the current file is still open" - } elseif {$state(file,new) == "false"} { - error_msg "This function should only be called when state(file,new) = true" - } + if [ catch { + if {$state(file,open) == "true"} { + error_msg "Can't create a new file because the current file is still open" + } elseif {$state(file,new) == "false"} { + error_msg "This function should only be called when state(file,new) = true" + } - set file_format [SplitReply [SicsDataPostFix]] - array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml] - set nxdict_path [::nexus::gen_nxdict $nexusdic] - if {$state(file,namestyle) == "scratch"} { - dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format] - } else { - sicsdatanumber incr - dataFileName [newFileName $file_format] + set file_format [SplitReply [SicsDataPostFix]] + array set nxmode [list nx.hdf create5 hdf create5 h5 create5 nx5 create5 xml createxml] + set nxdict_path [::nexus::gen_nxdict $nexusdic] + if {$state(file,namestyle) == "scratch"} { + dataFileName [format "%s/scratch.%s" [::nexus::datapath] $file_format] + } else { + sicsdatanumber incr + dataFileName [newFileName $file_format] + } + hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype] + nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path + set state(file,open) false + set state(file,new) false + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } - hsetprop $data_gp_path currentfiletype [::utility::hgetplainprop $data_gp_path datatype] - nxscript $nxmode($file_format) [SplitReply [dataFileName]] $nxdict_path - set state(file,open) false - set state(file,new) false } ## @@ -233,10 +246,11 @@ proc ::nexus::isValidFileType {type} { # state(file,open) true state(file,new) false # /data/currentfiletype == UNKNOWN proc ::nexus::newfile {type {namestyle data}} { - variable filetype_spec - variable state - variable data_gp_path + variable filetype_spec + variable state + variable data_gp_path + if [ catch { set state(file,namestyle) $namestyle set state(file,new) true hsetprop $data_gp_path currentfiletype UNKNOWN @@ -248,7 +262,11 @@ proc ::nexus::newfile {type {namestyle data}} { } else { ::nexus::process_filetype_policy $type filetype_spec } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } +} ## # @brief Save data to the currently open file and then close it. @@ -256,18 +274,29 @@ proc ::nexus::newfile {type {namestyle data}} { # @param point This is the array index for mutable data elements # # This function provides the top level call to the recursive ::nexus::savetree -# function +# function, it should only be called by the ::nexus::save command. # # @see ::nexus::savetree +# @see ::nexus::save proc ::nexus::save_data {point} { debug_msg "save point $point in [dataFileName]" - ::nexus::nxreopenfile - foreach child [hlist /] { - if {[::utility::hgetplainprop /$child data] == "true"} { - ::nexus::savetree $child $point + if [ catch { + if {[info level]<2} { + error "ERROR: The [lindex [info level 0] 0] command is for internal use only" } + set caller [namespace origin [lindex [info level -1] 0]] + if {$caller != "::nexus::save"} { + error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + } + foreach child [hlist /] { + if {[::utility::hgetplainprop /$child data] == "true"} { + ::nexus::savetree $child $point + } + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } - ::nexus::nxclosefile } ## @@ -282,64 +311,105 @@ proc ::nexus::newfile {type {namestyle data}} { variable state variable data_gp_path - if {[string is integer $point] == 0} { - error_msg "save index must be an integer" - } elseif {$point < 0} { - error_msg "save index cannot be negative" - } + if [ catch { + if {[string is integer $point] == 0} { + error_msg "save index must be an integer" + } elseif {$point < 0} { + error_msg "save index cannot be negative" + } - ::data::gumtree_save -set run_number $point +# ::data::gumtree_save -set run_number $point + data_run_number $point - set isNewFile [expr {$state(file,new) == "true"}] - set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype] - set currDataType [::utility::hgetplainprop $data_gp_path datatype] - set dataTypeChanged [expr {$currFileType != $currDataType}] - if {$currDataType == "UNKNOWN"} { - error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' " - } - - if {$isNewFile || $dataTypeChanged} { - set state(file,new) true - ::nexus::createfile - estart [lindex [sicstime] 1] - eend [lindex [sicstime] 1] - ::nexus::save_data $point - ::nexus::linkdata - } else { - eend [lindex [sicstime] 1] - ::nexus::save_data $point - } + set isNewFile [expr {$state(file,new) == "true"}] + set currFileType [::utility::hgetplainprop $data_gp_path currentfiletype] + set currDataType [::utility::hgetplainprop $data_gp_path datatype] + set dataTypeChanged [expr {$currFileType != $currDataType}] + if {$currDataType == "UNKNOWN"} { + error_msg "You must set the file type, eg 'newfile BEAM_MONITOR' or 'newfile BEAM_MONITOR scratch' " + } + if {$isNewFile || $dataTypeChanged} { + set state(file,new) true + ::nexus::createfile + estart [lindex [sicstime] 1] + eend [lindex [sicstime] 1] + start_seconds [clock seconds] + timestamp 0 + ::nexus::nxreopenfile + ::nexus::save_data $point + ::nexus::makelinks + ::nexus::set_plotdata_info + ::nexus::nxclosefile + } else { + eend [lindex [sicstime] 1] + timestamp [expr {[clock seconds] - [SplitReply [start_seconds]]}] + ::nexus::nxreopenfile + ::nexus::save_data $point + ::nexus::nxclosefile + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } return } ## # @brief Reopen the current file, close it with nxclosefile +# this should only be called by the ::nexus::save command. # # @see nxclosefile +# @see ::nexus::save proc ::nexus::nxreopenfile {} { global cfPath variable state variable nexusdic - if {$state(file,open) == "false"} { - nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic - set state(file,open) true - } + if [ catch { + if {[info level]<2} { + error "ERROR: The [lindex [info level 0] 0] command is for internal use only" + } + set caller [namespace origin [lindex [info level -1] 0]] + if {$caller != "::nexus::save"} { + error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + } + if {$state(file,open) == "false"} { + nxscript reopen [SplitReply [dataFileName]] $cfPath(nexus)/$nexusdic + set state(file,open) true + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## # @brief Close the current file. You can reopen it with nxreopenfile +# this should only be called by the ::nexus::save command. # # @see nxreopenfile +# @see ::nexus::save proc ::nexus::nxclosefile {} { variable state - if {$state(file,open) == "true"} { - nxscript close - set state(file,open) false - set flist [split [SplitReply [dataFileName]] "/"] - set fname [lindex $flist [expr [llength $flist] - 1] ] - clientput "$fname updated" "event" - } + if [ catch { + if {[info level]<2} { + error "ERROR: The [lindex [info level 0] 0] command is for internal use only" + } + set caller [namespace origin [lindex [info level -1] 0]] + if {$caller != "::nexus::save"} { + error "ERROR: [lindex [info level 0] 0] can only be called via the '::nexus::save' command, not by $caller" + } + if {$state(file,open) == "true"} { + nxscript close + set state(file,open) false + set flist [split [SplitReply [dataFileName]] "/"] + set fname [lindex $flist [expr [llength $flist] - 1] ] + clientput "$fname updated" "event" + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## # @brief Records that a given data source should be linked to nexus data target. @@ -439,25 +509,48 @@ proc ::nexus::newfile {type {namestyle data}} { } } - ## -# @brief Links data and axis into /data group +# @brief Make dataset links # -# Sets the "signal" and "axes" attributes on the plottable data + proc ::nexus::makelinks {{hpath /}} { + if [ catch { + foreach child [hlist $hpath] { + if {$hpath == "/"} { + set newpath /$child + } else { + set newpath $hpath/$child + } + # clientput $newpath + array set p_arr [::utility::hlistplainprop $newpath] + if {$p_arr(data) == "true" && $p_arr(nxsave) == "true"} { + if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + if {$p_arr(link) != "@none"} { +# clientput "Link $p_arr(nxalias) to $p_arr(link)" + nxscript makelink $p_arr(nxalias) $p_arr(link) + } + } + ::nexus::makelinks $newpath + } + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } + } +## +# @brief Sets the "signal" and "axes" attributes on the plottable data # Also sets the "axis" attribute for each of the axes. - proc ::nexus::linkdata {} { + proc ::nexus::set_plotdata_info {} { variable data_gp_path array unset axes set hpath $data_gp_path - ::nexus::nxreopenfile foreach child [hlist $hpath] { array set p_arr [::utility::hlistplainprop $hpath/$child] if {$p_arr(data) == true && $p_arr(nxsave) == true} { if {[info exists p_arr(nxalias)]} { if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { if {$p_arr(link) != "@none"} { - nxscript makelink $p_arr(nxalias) $p_arr(link) switch -glob $child { "axis_*" { set n [lindex [split $child _] 1] @@ -468,7 +561,7 @@ proc ::nexus::newfile {type {namestyle data}} { nxscript putattribute $p_arr(link) signal 1 set data_set_alias $p_arr(link) } - default {error "ERROR: [info level -1]->linkdata, Unsupported data path $hpath/$child"} + default {error "ERROR: [info level -1]->set_plotdata_info, Unsupported data path $hpath/$child"} } } } @@ -481,7 +574,6 @@ proc ::nexus::newfile {type {namestyle data}} { } nxscript putattribute $data_set_alias axes [join $axes_list :] } - ::nexus::nxclosefile } ## @@ -490,25 +582,31 @@ proc ::nexus::newfile {type {namestyle data}} { # @param hpath path of subtree to save, must not be "/" # @param pt Current array index for mutable data (optional default=0) proc ::nexus::savetree {hpath {pt 0}} { - foreach child [hlist /$hpath] { - array unset p_arr - array set p_arr [::utility::hlistplainprop /$hpath/$child] - if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { - return - } - set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] - if {$p_arr(data) == true && $p_arr(nxsave) == true } { - if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } { - if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } { - $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt - } else { - $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type - } - } elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} { - error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]" + set ::errorInfo "" + if [ catch { + foreach child [hlist /$hpath] { + array unset p_arr + array set p_arr [::utility::hlistplainprop /$hpath/$child] + if {[info exists p_arr(type)] && $p_arr(type) == "nxvgroup"} { + return } - ::nexus::savetree $hpath/$child $pt - } + set data_type [lindex [split [hinfo /$hpath/$child] , ] 0] + if {$p_arr(data) == true && $p_arr(nxsave) == true } { + if {[info exists p_arr(savecmd)] && [info exists p_arr(nxalias)] } { + if {[info exists p_arr(mutable)] && $p_arr(mutable) == "true" } { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type point $pt + } else { + $p_arr(savecmd) $p_arr(sicsdev) $p_arr(nxalias) $data_type + } + } elseif {[info exists p_arr(savecmd)] || [info exists p_arr(nxalias)]} { + error_msg "/$hpath/$child must have both 'savecmd' and 'nxalias' properties\nThe actual property list for /$hpath/$child is [array get p_arr]" + } + ::nexus::savetree $hpath/$child $pt + } + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -526,6 +624,7 @@ proc ::nexus::newfile {type {namestyle data}} { # @see gen_nxdict proc ::nexus::_gen_nxdict {hpath dictPath name nxc} { variable nxdictionary + if [ catch { if {[::utility::hgetplainprop /$hpath data] == "false"} { debug_msg "$hpath doesn't have a data property" return @@ -556,6 +655,10 @@ proc ::nexus::newfile {type {namestyle data}} { set nxdictionary($alias) "$dictPath/NXVGROUP" } } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## @@ -566,15 +669,16 @@ proc ::nexus::newfile {type {namestyle data}} { # # @param nexusdic Name of the nexus dictionary that will be created. # @return Full path to the nexus dictionary. - proc ::nexus::gen_nxdict {nexusdic} { - global cfPath - variable nxdictionary - set nxdict_path $cfPath(nexus)/$nexusdic +proc ::nexus::gen_nxdict {nexusdic} { + global cfPath + variable nxdictionary + if [ catch { + set nxdict_path $cfPath(nexus)/$nexusdic array unset nxdictionary foreach hp [hlist /] { if {[::utility::hgetplainprop /$hp data] == true} { set nxclass [::utility::hgetplainprop /$hp klass] - ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass + ::nexus::_gen_nxdict $hp /entry1,NXentry $hp $nxclass } } set fh [open $nxdict_path w] @@ -586,44 +690,57 @@ proc ::nexus::newfile {type {namestyle data}} { puts $fh "$n = $v" } close $fh - return $nxdict_path + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } + return $nxdict_path +} ## # @brief Set SICS object attributes which are required for creating nexus data files. proc ::nexus::set_sobj_attributes {} { - # SICS commands - sicslist setatt nxscript privilege internal - # SICS data objects - sicslist setatt nxscript_data privilege internal + if [ catch { + # SICS commands + sicslist setatt nxscript privilege internal + # SICS data objects + sicslist setatt nxscript_data privilege internal - foreach sobj [lrange [sicslist type motor] 1 end] { - sicslist setatt $sobj savecmd ::nexus::motor::save - sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo - } - foreach sobj [sicslist type configurablevirtualmotor] { - sicslist setatt $sobj savecmd ::nexus::motor::save - sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo - } - foreach sobj [sicslist type histmem] { - sicslist setatt $sobj savecmd ::nexus::histmem::save - sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo - } - foreach sobj [sicslist type sicsvariable] { - sicslist setatt $sobj savecmd ::nexus::sicsvariable::save - sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo - } - foreach sobj [sicslist type singlecounter] { - sicslist setatt $sobj savecmd ::nexus::singlecounter::save - sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo - } - foreach sobj [sicslist type environment_controller] { - sicslist setatt $sobj savecmd ::nexus::environment_controller::save - sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo - } - foreach sobj [sicslist kind script] { - sicslist setatt $sobj savecmd ::nexus::script::save - sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo + foreach sobj [lrange [sicslist type motor] 1 end] { + sicslist setatt $sobj savecmd ::nexus::motor::save + sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo + } + foreach sobj [sicslist type configurablevirtualmotor] { + sicslist setatt $sobj savecmd ::nexus::motor::save + sicslist setatt $sobj sdsinfo ::nexus::motor::sdsinfo + } + foreach sobj [sicslist type histmem] { + sicslist setatt $sobj savecmd ::nexus::histmem::save + sicslist setatt $sobj sdsinfo ::nexus::histmem::sdsinfo + } + foreach sobj [sicslist type sicsvariable] { + sicslist setatt $sobj savecmd ::nexus::sicsvariable::save + sicslist setatt $sobj sdsinfo ::nexus::sicsvariable::sdsinfo + } + foreach sobj [sicslist type singlecounter] { + sicslist setatt $sobj savecmd ::nexus::singlecounter::save + sicslist setatt $sobj sdsinfo ::nexus::singlecounter::sdsinfo + } + foreach sobj [sicslist type environment_controller] { + sicslist setatt $sobj savecmd ::nexus::environment_controller::save + sicslist setatt $sobj sdsinfo ::nexus::environment_controller::sdsinfo + } + foreach sobj [sicslist kind script] { + sicslist setatt $sobj savecmd ::nexus::script::save + sicslist setatt $sobj sdsinfo ::nexus::script::sdsinfo + } + foreach sobj [sicslist kind getset] { + sicslist setatt $sobj savecmd ::nexus::macro::getset_save + sicslist setatt $sobj sdsinfo ::nexus::macro::getset_sdsinfo + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -729,7 +846,41 @@ proc ::nexus::motor::sdsinfo {motor data_type args} { return " -type $dtype $units_att $name_att" } } +## +# @brief Save data from a 'getset macro' +# +# NOTE: Currently just saves floats +namespace eval ::nexus::macro {} +proc ::nexus::macro::getset_save {sobj nxalias data_type args} { + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript_data clear + nxscript_data putfloat 0 [getVal [$sobj] ] + nxscript putslab $nxalias [list $index] [list 1] nxscript_data + } else { + nxscript putfloat $nxalias [SplitReply [$sobj]] + } +} +## +# @brief Define the scientific data set path for the nexus dictionary. +proc ::nexus::macro::getset_sdsinfo {sobj data_type args} { + array set param $args + array set attribute [attlist $sobj] + set dtype [::nexus::hdb2nx_type $data_type] + if {[info exists attribute(units)]} { + set units_att " -attr {units,$attribute(units)} " + } else { + set units_att " " + } + set name_att " -attr {long_name,$attribute(long_name)} " + if {$param(mutable) == true} { + return " -type $dtype -rank 1 -dim {-1} $units_att $name_att" + } else { + return " -type $dtype $units_att $name_att" + } +} +#### proc ::nexus::environment_controller::save {evc nxalias data_type args} { if {[lindex $args 0] == "point"} { set index [lindex $args 1] @@ -806,30 +957,59 @@ proc ::nexus::singlecounter::sdsinfo {counter data_type args} { # # The macro must return a 1D associative array when called with -arrayname. proc ::nexus::script::save {script nxalias data_type args} { - array set attribute [attlist $script] - set darray [$script -arrayname] - set size [array size $darray] - set size [SplitReply [$darray used]] - if {[lindex $args 0] == "point"} { - set index [lindex $args 1] - nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray + if [ catch { + array set attribute [attlist $script] + if {$attribute(klass) == "sensor"} { + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript_data clear + nxscript_data putfloat 0 [$script] + nxscript putslab $nxalias [list $index] [list 1] nxscript_data + } else { + nxscript putfloat $nxalias [$script] + } } else { - nxscript putslab $nxalias [list 0] [list $size] $darray + set darray [$script -arrayname] + set size [array size $darray] + set size [SplitReply [$darray used]] + if {[lindex $args 0] == "point"} { + set index [lindex $args 1] + nxscript putslab $nxalias [list $index 0] [list 1 $size] $darray + } else { + nxscript putslab $nxalias [list 0] [list $size] $darray + } + if {[info exists attribute(units)]} { + nxscript putattribute $nxalias units $attribute(units) + } } - if {[info exists attribute(units)]} { - nxscript putattribute $nxalias units $attribute(units) + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } proc ::nexus::script::sdsinfo {script data_type args} { - array set param $args - set dtype [::nexus::hdb2nx_type $data_type] - set darray [$script -arrayname] - set size [SplitReply [$darray used]] - if {$param(mutable) == true} { - return " -type $dtype -rank 2 -dim {-1,$size}" - } else { - return " -type $dtype -rank 1 -dim {$size}" + if [ catch { + array set param $args + set dtype [::nexus::hdb2nx_type $data_type] + if {[getatt $script klass] == "sensor"} { + if {$param(mutable) == true} { + return " -type $dtype -rank 1 -dim {-1}" + } else { + return " -type $dtype" + } + } else { + set darray [$script -arrayname] + set size [SplitReply [$darray used]] + if {$param(mutable) == true} { + return " -type $dtype -rank 2 -dim {-1,$size}" + } else { + return " -type $dtype -rank 1 -dim {$size}" + } + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -850,26 +1030,26 @@ foreach expt $::nexus::exports { set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}] set nx_content_release_tag [lindex $tmpstr [expr [llength $tmpstr] - 1]] -set tmpstr [string map {"$" ""} {$Revision: 1.35 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.36 $}] set nx_content_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] -namespace eval data { - ## - # @brief Nexus data save command for gumtree control interface - # - # @param run_number This is the run or scan point number, it serves as the array - # index for nexus data sets which correspond to mutable data - command gumtree_save {int: run_number} { - ::nexus::save $run_number - } - sicslist setatt ::data::gumtree_save long_name save - array set param [::data::gumtree_save -list param] - ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false - command gumtree_type {text:nx.hdf,xml type} { - SicsDataPostFix $type - } - sicslist set ::data::gumtree_type long_name file_format - ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]] -} +#namespace eval data { +# ## +# # @brief Nexus data save command for gumtree control interface +# # +# # @param run_number This is the run or scan point number, it serves as the array +# # index for nexus data sets which correspond to mutable data +# command gumtree_save {int: run_number} { +# ::nexus::save $run_number +# } +# sicslist setatt ::data::gumtree_save long_name save +# array set param [::data::gumtree_save -list param] +# ::utility::mkData $param(run_number) run_number instrument privilege READ_ONLY mutable true control false +# command gumtree_type {text:nx.hdf,xml type} { +# SicsDataPostFix $type +# } +# sicslist set ::data::gumtree_type long_name file_format +# ::data::gumtree_type -set type [SplitReply [SicsDataPostFix]] +#} ::nexus::init diff --git a/site_ansto/instrument/config/scan/scan_common_1.tcl b/site_ansto/instrument/config/scan/scan_common_1.tcl index b9903660..cc46692f 100644 --- a/site_ansto/instrument/config/scan/scan_common_1.tcl +++ b/site_ansto/instrument/config/scan/scan_common_1.tcl @@ -52,7 +52,9 @@ proc ::scan::check_scanvar {sobj uobj} { set scan_increment [lindex $vlist 2]; if {[getatt $scan_variable type] == "motor"} { if {[SplitReply [$scan_variable fixed]] >= 0} { - return -code error "Can't drive scan variable, $scan_variable position is set to 'fixed'" + return -code error "ERROR: Can't drive scan variable, $scan_variable position is set to 'fixed'" + } elseif {[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 * $scan_increment] if [catch { @@ -130,6 +132,7 @@ proc ::scan::hmm_count {sobj uobj point mode preset} { ::histogram_memory::start block } +#TODO rangescan: drive to original position for rangescans, not the start position. proc ::scan::hmm_scan_finish {sobj uobj} { variable save_filetype variable reset_position @@ -273,50 +276,6 @@ hmscan function count ::scan::hmm_count hmscan function prepare ::scan::hmm_scan_prepare hmscan function finish ::scan::hmm_scan_finish -namespace eval scan { -command hdb_bmonscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { - - bmonscan clear -# bmonscan configure script - - bmonscan add $scan_variable $scan_start $scan_increment - bmonscan setchannel $channel; - set status [catch {bmonscan run $NP $mode $preset} msg] -# bmonscan configure soft - if {$status == 0} { - return $msg - } else { - return -code error "ERROR [info level 0]" - } - - -} -::scan::hdb_bmonscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status -::scan::hdb_bmonscan -set feedback status IDLE - - - -command hdb_hmscan { text:drivable scan_variable float: scan_start float: scan_increment int: NP text:monitor,timer mode float: preset int:0,2 channel} { - - hmscan clear - - hmscan add $scan_variable $scan_start $scan_increment - hmscan setchannel $channel; - set status [catch {hmscan run $NP $mode $preset} msg] - - if {$status == 0} { - return $msg - } else { - return -code error "ERROR [info level 0]" - } - - -} -::scan::hdb_hmscan -addfb text filename text mode float preset float scan_variable_value int scanpoint int counts text status -::scan::hdb_hmscan -set feedback status IDLE -} -sicslist setatt ::scan::hdb_bmonscan long_name bmonscan -sicslist setatt ::scan::hdb_hmscan long_name hmscan namespace eval scan { namespace export runscan VarMake ::scan::runscan_reset_position Text internal diff --git a/site_ansto/instrument/deploySICS.sh b/site_ansto/instrument/deploySICS.sh index d7848594..52083eb7 100755 --- a/site_ansto/instrument/deploySICS.sh +++ b/site_ansto/instrument/deploySICS.sh @@ -1,8 +1,8 @@ #!/bin/sh -# $Revision: 1.26 $ -# $Date: 2008-05-29 04:57:42 $ +# $Revision: 1.27 $ +# $Date: 2008-05-30 00:26:54 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by $Author: dcl $ +# Last revision by $Author: ffr $ # Deploys SICServer and configuration files to # an instrument control computer. @@ -187,7 +187,7 @@ INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; don SCRIPT_VALIDATOR=$(for f in $(cat $INSTSRC/script_validator/MANIFEST.TXT); do echo -n "$INSTSRC/script_validator/$f "; done) # Create Instrument Control Server directories and copy SICS configs to the 'server' directory -mkdir -p $TEMPDIR/$DESTDIR/{batch,server,data,log,tmp} +mkdir -p $TEMPDIR/$DESTDIR/{batch,server,log,tmp} copy_server_config server cp -a --preserve=timestamps ../SICServer $TEMPDIR/$DESTDIR/server diff --git a/site_ansto/instrument/hipd/DMC2280/controller1.txt b/site_ansto/instrument/hipd/DMC2280/controller1.txt index c120d698..18a74c62 100644 --- a/site_ansto/instrument/hipd/DMC2280/controller1.txt +++ b/site_ansto/instrument/hipd/DMC2280/controller1.txt @@ -1,10 +1,11 @@ ' WOMBAT - CONTROLLER 1 ' -' $Revision: 1.10 $ -' $Date: 2008-04-13 23:50:38 $ +' $Revision: 1.11 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Airpad control added by Doug Clowes -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-MONOCHROMATOR UPPER TILT ' B-MONOCHROMATOR LOWER TILT diff --git a/site_ansto/instrument/hipd/DMC2280/controller2.txt b/site_ansto/instrument/hipd/DMC2280/controller2.txt index deec8ec1..0b139fca 100644 --- a/site_ansto/instrument/hipd/DMC2280/controller2.txt +++ b/site_ansto/instrument/hipd/DMC2280/controller2.txt @@ -1,10 +1,11 @@ ' WOMBAT - CONTROLLER 2 ' -' $Revision: 1.6 $ -' $Date: 2008-03-07 05:12:47 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Airpad control added by Doug Clowes -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SAMPLE UPPER TILT ' B-SAMPLE LOWER TILT diff --git a/site_ansto/instrument/hipd/DMC2280/controller3.txt b/site_ansto/instrument/hipd/DMC2280/controller3.txt index b9feaba2..de43e224 100644 --- a/site_ansto/instrument/hipd/DMC2280/controller3.txt +++ b/site_ansto/instrument/hipd/DMC2280/controller3.txt @@ -1,10 +1,11 @@ ' WOMBAT - CONTROLLER 3 ' -' $Revision: 1.4 $ -' $Date: 2008-03-07 05:12:47 $ +' $Revision: 1.5 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Limit switch HOME routine added by Ferdi Franceschini -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-MONOCHROMATOR FOCUS ' B-MONOCHROMATOR FOCUS diff --git a/site_ansto/instrument/hipd/DMC2280/controller4.txt b/site_ansto/instrument/hipd/DMC2280/controller4.txt index 5d648451..9fe477b7 100644 --- a/site_ansto/instrument/hipd/DMC2280/controller4.txt +++ b/site_ansto/instrument/hipd/DMC2280/controller4.txt @@ -1,10 +1,11 @@ ' WOMBAT - CONTROLLER 4 ' -' $Revision: 1.3 $ -' $Date: 2008-03-07 05:12:47 $ +' $Revision: 1.4 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Limit switch HOME routine added by Ferdi Franceschini -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SPARE ' B-SPARE diff --git a/site_ansto/instrument/hipd/MANIFEST.TXT b/site_ansto/instrument/hipd/MANIFEST.TXT index 81ab55b6..c058f196 100644 --- a/site_ansto/instrument/hipd/MANIFEST.TXT +++ b/site_ansto/instrument/hipd/MANIFEST.TXT @@ -1,4 +1,6 @@ sics_ports.tcl +script_validator_ports.tcl +instrument_vars.tcl wombat_configuration.tcl config util diff --git a/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT index e19eb24d..e7ffd9c7 100644 --- a/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/hipd/config/INSTCFCOMMON.TXT @@ -1,5 +1,7 @@ +config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl +config/environment/temperature/lakeshore340_common.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl @@ -9,3 +11,4 @@ config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl diff --git a/site_ansto/instrument/hipd/config/anticollider/acscript.txt b/site_ansto/instrument/hipd/config/anticollider/acscript.txt new file mode 100644 index 00000000..0fb75104 --- /dev/null +++ b/site_ansto/instrument/hipd/config/anticollider/acscript.txt @@ -0,0 +1,16 @@ +# This script is loaded automatically by anticollider.tcl when SICS is launched +# TODO Allow sequencing +# TODO Allow functional dependencies +# +# Examples +# for pcx forbid { {80 130} {10 20} } +# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth +# +## The next example forbids movement when both schi and sx are in the given ranges +# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} } + + +for stth forbid {20 30} when mtth in {44 45} +for stth forbid {-120 -100} when mtth in {99 100} +for mtth forbid {90 100} when stth in {-120 -119} +for mtth forbid {45 55} when stth in {29 30} diff --git a/site_ansto/instrument/hipd/config/anticollider/anticollider.tcl b/site_ansto/instrument/hipd/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..b5a046db --- /dev/null +++ b/site_ansto/instrument/hipd/config/anticollider/anticollider.tcl @@ -0,0 +1,7 @@ +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:55 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source $cfPath(anticollider)/anticollider_common.tcl +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/hipd/config/commands/commands.tcl b/site_ansto/instrument/hipd/config/commands/commands.tcl new file mode 100644 index 00000000..1251d4b5 --- /dev/null +++ b/site_ansto/instrument/hipd/config/commands/commands.tcl @@ -0,0 +1 @@ +source $cfPath(commands)/commands_common.tcl diff --git a/site_ansto/instrument/hipd/config/environment/temperature/lakeshore340.tcl b/site_ansto/instrument/hipd/config/environment/temperature/lakeshore340.tcl new file mode 100644 index 00000000..209d8ad8 --- /dev/null +++ b/site_ansto/instrument/hipd/config/environment/temperature/lakeshore340.tcl @@ -0,0 +1,24 @@ +source $cfPath(environment)/temperature/lakeshore340_common.tcl + +# @brief Adds a lakeshore 340 temperature controller object. +# +# This must be called when the instrument configuration is loaded and before\n +# the buildHDB function is called. Currently there is no way to add and remove\n +# environment controllers and their hdb paths at runtime. +proc ::environment::temperature::add_ls340 {} { + set sim_mode [SplitReply [environment_simulation]] + if {$sim_mode == "true"} { + ::environment::temperature::mkls340sim tc1 + } else { + ::environment::temperature::mkls340 tc1 + tc1 tolerance 1 + tc1 Settle 30 + tc1 range 2 + tc1 UpperLimit 500 + tc1 LowerLimit 4 + } + + sicslist setatt tc1 environment_name tempone + sicslist setatt tc1 long_name control_sensor_reading + ::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} } +} diff --git a/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl index 165953c3..6f3c8f4e 100644 --- a/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/hipd/config/hmm/hmm_configuration.tcl @@ -2,51 +2,119 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl set sim_mode [SplitReply [hmm_simulation]] -##\brief Return the detector position +proc ::histogram_memory::init_OAT_TABLE {} { + if [ catch { + # We don't need a MAX_CHAN parameter for time because the time channel + # is scaled by calling the ::histogram_memory::clock_scale function + OAT_TABLE X -setdata MAX_CHAN 3872 + OAT_TABLE X -setdata MAX_CHAN_PERSEG 992 + OAT_TABLE Y -setdata MAX_CHAN 512 + OAT_TABLE X -setdata ALLOWED_RESOLUTIONS {1 2 4 8 16 32} + OAT_TABLE X -setdata BMIN -0.5 + OAT_TABLE X -setdata BMAX 991.5 + OAT_TABLE Y -setdata BMIN -0.5 + OAT_TABLE Y -setdata BMAX 511.5 + + # x bin range 0, 3871 + # y bin range 0, 511 + FAT_TABLE -set MULTI_HOST_HISTO_STITCH_OVERLAP 32 + OAT_TABLE -set X { 991.5 990.5 } NXC 992 Y { 511.5 510.5 } NYC 512 T { 0 2000 } NTC 1 + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +## +# @brief Returns the oat table bin boundaries. +proc ::histogram_memory::oat_bins {axis} { + array set channID {X NXC Y NYC T NTC} + if [ catch { + if {$axis == "X"} { + foreach {bb0 bb1} [OAT_TABLE -get $axis] {} + set bstep [expr $bb1 - $bb0] + if {$bstep < 0} { + set nch_perseg [OAT_TABLE -get $channID($axis)] + set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP] + set bb0 [expr 4*$nch_perseg - 3*$overlap + $bstep/2.0] + set bb1 [expr $bb0+$bstep] + ########### +# set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP] +# set bb0 [expr 4*$bb0 - 3*($overlap-1)] +# set bb1 [expr $bb0+$bstep] + } + return [list $bb0 $bb1] + } else { + return [OAT_TABLE -get $axis] + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} +## +# @brief Returns the current number of channels for a given axis. +proc ::histogram_memory::number_of_channels {axis} { + array set channID {X NXC Y NYC T NTC} + if [ catch { + if {$axis == "X"} { + set nch_perseg [OAT_TABLE -get $channID($axis)] + set overlap [FAT_TABLE -get MULTI_HOST_HISTO_STITCH_OVERLAP] + set nch [expr 4*$nch_perseg - 3*$overlap] + return $nch + } else { + return [OAT_TABLE -get $channID($axis)] + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +## +# @brief Return the detector position proc ::histogram_memory::detector_posn_degrees {} { - return [SplitReply [stth]] + if [ catch { + return [SplitReply [stth]] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::initialize {} { - if {$::sim_mode == "true"} { - hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 512 - hmm configure oat_nxc_eff [expr 480*8 - 1] - } - ::histogram_memory::_initialize - ::histogram_memory::two_theta -boundaries + if [ catch { + if {$::sim_mode == "true"} { + hmm configure oat_ntc_eff 1 + hmm configure stitch_nyc 512 + hmm configure stitch_nxc [expr 480*8 - 1] + } + BAT_TABLE -init + CAT_TABLE -init + SAT_TABLE -init + OAT_TABLE -init + FAT_TABLE -init MULTI_HOST_HISTO_STITCH_OVERLAP + ::histogram_memory::_initialize + ::histogram_memory::two_theta -boundaries - detector_active_height_mm 200 - detector_active_width_mm 500 - detector_radius_mm 700.0 - set x_bb0 991.5; set xbbmax -0.5 - set y_bb0 0; set ybbmax 511.5 - hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 - hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax - hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 - hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax - set x_binwidth 1 - if {[expr {$xbbmax - $x_bb0}] > 0} { - set x_bb1 [expr {$x_bb0+$x_binwidth}] - } else { - set x_bb1 [expr {$x_bb0-$x_binwidth}] - } - set y_binwidth 1 - if {[expr {$ybbmax - $y_bb0}] > 0} { - set y_bb1 [expr {$y_bb0+$y_binwidth}] - } else { - set y_bb1 [expr {$y_bb0-$y_binwidth}] - } - OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax - # We default to one big bin for time - set t_bb0 [OAT_TABLE -get T_MIN] - set t_bb1 [OAT_TABLE -get T_MAX] - OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1" - ::histogram_memory::upload_config Filler_defaults + detector_active_height_mm 200 + detector_active_width_mm 500 + detector_radius_mm 700.0 - ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset - ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta + # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 + # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax + # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 + # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax + ::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::two_theta + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } proc histmem {cmd args} { diff --git a/site_ansto/instrument/hipd/config/motors/motor_configuration.tcl b/site_ansto/instrument/hipd/config/motors/motor_configuration.tcl index e0168309..f54db9c1 100644 --- a/site_ansto/instrument/hipd/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/hipd/config/motors/motor_configuration.tcl @@ -1,7 +1,8 @@ -# $Revision: 1.20 $ -# $Date: 2008-05-29 04:53:32 $ +# $Revision: 1.21 $ +# $Date: 2008-05-30 00:26:55 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ +source $cfPath(anticollider)/anticollider.tcl # START MOTOR CONFIGURATION @@ -642,3 +643,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup proc motor_set_sobj_attributes {} { } # END MOTOR CONFIGURATION +::anticollider::init diff --git a/site_ansto/instrument/hipd/instrument_vars.tcl b/site_ansto/instrument/hipd/instrument_vars.tcl new file mode 100644 index 00000000..cbde5bcb --- /dev/null +++ b/site_ansto/instrument/hipd/instrument_vars.tcl @@ -0,0 +1,3 @@ +VarMake deg_per_rad Float Internal +deg_per_rad 57.29577951308232 +deg_per_rad lock diff --git a/site_ansto/instrument/hipd/script_validator_ports.tcl b/site_ansto/instrument/hipd/script_validator_ports.tcl new file mode 100644 index 00000000..ecec1f2e --- /dev/null +++ b/site_ansto/instrument/hipd/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport quieck-val-wombat +set serverport server-val-wombat +set interruptport interrupt-val-wombat +set telnetport telnet-val-wombat diff --git a/site_ansto/instrument/hipd/wombat_configuration.tcl b/site_ansto/instrument/hipd/wombat_configuration.tcl index ffa128c9..6bde5f7c 100644 --- a/site_ansto/instrument/hipd/wombat_configuration.tcl +++ b/site_ansto/instrument/hipd/wombat_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.19 $ -# $Date: 2007-11-07 04:57:40 $ +# $Revision: 1.20 $ +# $Date: 2008-05-30 00:26:55 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -12,9 +12,6 @@ Instrument lock source util/dmc2280/dmc2280_util.tcl source sics_ports.tcl source server_config.tcl -VarMake deg_per_rad Float Internal -deg_per_rad 57.29577951308232 -deg_per_rad lock #END SERVER CONFIGURATION SECTION ######################################## @@ -22,61 +19,36 @@ deg_per_rad lock fileeval $cfPath(motors)/motor_configuration.tcl -######## -# Parameters set above the restore command will be clobbered by -# the values in the status.tcl file -restore +source instrument_vars.tcl +source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl +#TODO Provide method for choosing environment controller +fileeval $cfPath(environment)/temperature/lakeshore340.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(scan)/scan.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(commands)/commands.tcl source gumxml.tcl +######## +# Parameters set above the restore command will be clobbered by +# the values in the status.tcl file +# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS +# AN ERROR IF THERE IS NO ../log/status.tcl FILE. +restore + ::histogram_memory::initialize +#::environment::temperature::add_ls340 -VarMake detector_layout Text Mugger -detector_layout cylinder - -VarMake detector_angle_deg Float User -detector_angle_deg 120.0 -VarMake detector_angle_rad Float User -detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ] - -VarMake crystal_type Text User -VarMake crystal_wavelength_A Float User - -VarMake bmon_distance Float User - -## Number of last pixel on vertical axis -VarMake detector_last_vert_pixel Float User -detector_last_vert_pixel 511 -## Number of last pixel on horizontal axis -VarMake detector_last_hor_pixel Float User -detector_last_hor_pixel [expr 480 * 8 - 1] -## Row number at beam centre -VarMake detector_zero_row Float User -detector_zero_row 255.5 -## Column number at beam centre for a detector rotation of 0 degrees -VarMake detector_zero_col Float User -detector_zero_col [SplitReply [detector_last_hor_pixel]] -## Row offset for region of interest -VarMake detector_ROI_row_offset Float User -detector_ROI_row_offset 0 -## Column offset for region of interest -VarMake detector_ROI_col_offset Float User -detector_ROI_col_offset 0 - -detector_type He-3 position sensitive detector -detector_type lock - -detector_description 8 curved multiwire segments -detector_description lock - MakeStateMon hmscan -fileeval extraconfig.tcl +if [file exists extraconfig.tcl] { + fileeval extraconfig.tcl +} else { + clientput "extraconfig.tcl not found. continueing" +} + server_set_sobj_attributes buildHDB instrument_dictionary diff --git a/site_ansto/instrument/hrpd/DMC2280/controller1.txt b/site_ansto/instrument/hrpd/DMC2280/controller1.txt index 33da414a..0d8b8d29 100644 --- a/site_ansto/instrument/hrpd/DMC2280/controller1.txt +++ b/site_ansto/instrument/hrpd/DMC2280/controller1.txt @@ -1,10 +1,11 @@ ' ECHIDNA - CONTROLLER 1 ' -' $Revision: 1.8 $ -' $Date: 2008-04-13 23:50:38 $ +' $Revision: 1.9 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Airpad control added by Doug Clowes -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-MONOCHROMATOR UPPER TILT (mphi) - TILT 1 ' B-MONOCHROMATOR LOWER TILT (mchi) - TILT 2 diff --git a/site_ansto/instrument/hrpd/DMC2280/controller2.txt b/site_ansto/instrument/hrpd/DMC2280/controller2.txt index fcf98b5e..da6b362d 100644 --- a/site_ansto/instrument/hrpd/DMC2280/controller2.txt +++ b/site_ansto/instrument/hrpd/DMC2280/controller2.txt @@ -1,10 +1,11 @@ ' ECHIDNA - CONTROLLER 2 ' -' $Revision: 1.6 $ -' $Date: 2008-04-13 23:50:38 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Airpad control added by Doug Clowes -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SAMPLE UPPER TILT (sphi) - TILT 1 ' B-SAMPLE LOWER TILT (schi) - TILT 2 diff --git a/site_ansto/instrument/hrpd/DMC2280/controller3.txt b/site_ansto/instrument/hrpd/DMC2280/controller3.txt index 74fd2928..d343d6da 100644 --- a/site_ansto/instrument/hrpd/DMC2280/controller3.txt +++ b/site_ansto/instrument/hrpd/DMC2280/controller3.txt @@ -1,10 +1,11 @@ ' ECHIDNA - CONTROLLER 3 ' -' $Revision: 1.10 $ -' $Date: 2008-05-08 06:48:32 $ +' $Revision: 1.11 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Limit switch HOME routine added by Ferdi Franceschini -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-MONOCHROMATOR FOCUS ' B-SPARE diff --git a/site_ansto/instrument/hrpd/DMC2280/controller4.txt b/site_ansto/instrument/hrpd/DMC2280/controller4.txt index 5dbcb9bc..2384badf 100644 --- a/site_ansto/instrument/hrpd/DMC2280/controller4.txt +++ b/site_ansto/instrument/hrpd/DMC2280/controller4.txt @@ -1,10 +1,11 @@ ' ECHIDNA - CONTROLLER 4 ' -' $Revision: 1.10 $ -' $Date: 2008-04-30 01:56:22 $ +' $Revision: 1.11 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:55 $ ' Author: Dan Bartlett ' Limit switch HOME routine added by Ferdi Franceschini -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SPARE ' B-SPARE diff --git a/site_ansto/instrument/hrpd/MANIFEST.TXT b/site_ansto/instrument/hrpd/MANIFEST.TXT index b584e30b..e770e1f6 100644 --- a/site_ansto/instrument/hrpd/MANIFEST.TXT +++ b/site_ansto/instrument/hrpd/MANIFEST.TXT @@ -1,4 +1,6 @@ sics_ports.tcl +script_validator_ports.tcl +instrument_vars.tcl echidna_configuration.tcl config util diff --git a/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT index e19eb24d..e7ffd9c7 100644 --- a/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/hrpd/config/INSTCFCOMMON.TXT @@ -1,5 +1,7 @@ +config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl +config/environment/temperature/lakeshore340_common.tcl config/hipadaba/hipadaba_configuration_common.tcl config/hipadaba/common_instrument_dictionary.tcl config/hipadaba/instdict_specification.tcl @@ -9,3 +11,4 @@ config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl diff --git a/site_ansto/instrument/hrpd/config/anticollider/acscript.txt b/site_ansto/instrument/hrpd/config/anticollider/acscript.txt new file mode 100644 index 00000000..dabc7573 --- /dev/null +++ b/site_ansto/instrument/hrpd/config/anticollider/acscript.txt @@ -0,0 +1,18 @@ +# This script is loaded automatically by anticollider.tcl when SICS is launched +# TODO Allow sequencing +# TODO Allow functional dependencies +# +# Examples +# for pcx forbid { {80 130} {10 20} } +# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth +# +## The next example forbids movement when both schi and sx are in the given ranges +# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} } + + +for pcx forbid {80 130} +for pcr forbid {-inf inf} when mom in {45 50} +for stth forbid {160 167} when mtth in {87 88} +for stth forbid {0 15} when mtth in {139.5 140.5} +for mtth forbid {87 100} when stth in {166 167} +for mtth forbid {130 140.5} when stth in {0 1} diff --git a/site_ansto/instrument/hrpd/config/anticollider/anticollider.tcl b/site_ansto/instrument/hrpd/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..87660bcf --- /dev/null +++ b/site_ansto/instrument/hrpd/config/anticollider/anticollider.tcl @@ -0,0 +1,8 @@ + +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:56 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source $cfPath(anticollider)/anticollider_common.tcl +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/hrpd/config/commands/commands.tcl b/site_ansto/instrument/hrpd/config/commands/commands.tcl new file mode 100644 index 00000000..1251d4b5 --- /dev/null +++ b/site_ansto/instrument/hrpd/config/commands/commands.tcl @@ -0,0 +1 @@ +source $cfPath(commands)/commands_common.tcl diff --git a/site_ansto/instrument/hrpd/config/environment/temperature/lakeshore340.tcl b/site_ansto/instrument/hrpd/config/environment/temperature/lakeshore340.tcl new file mode 100644 index 00000000..209d8ad8 --- /dev/null +++ b/site_ansto/instrument/hrpd/config/environment/temperature/lakeshore340.tcl @@ -0,0 +1,24 @@ +source $cfPath(environment)/temperature/lakeshore340_common.tcl + +# @brief Adds a lakeshore 340 temperature controller object. +# +# This must be called when the instrument configuration is loaded and before\n +# the buildHDB function is called. Currently there is no way to add and remove\n +# environment controllers and their hdb paths at runtime. +proc ::environment::temperature::add_ls340 {} { + set sim_mode [SplitReply [environment_simulation]] + if {$sim_mode == "true"} { + ::environment::temperature::mkls340sim tc1 + } else { + ::environment::temperature::mkls340 tc1 + tc1 tolerance 1 + tc1 Settle 30 + tc1 range 2 + tc1 UpperLimit 500 + tc1 LowerLimit 4 + } + + sicslist setatt tc1 environment_name tempone + sicslist setatt tc1 long_name control_sensor_reading + ::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager} } +} diff --git a/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl index d0ac37dc..35dae26a 100644 --- a/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/hrpd/config/hmm/hmm_configuration.tcl @@ -2,51 +2,63 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl source $cfPath(hmm)/hmm_cylindrical_detector_configuration.tcl set sim_mode [SplitReply [hmm_simulation]] -##\brief Return the detector position +proc ::histogram_memory::init_OAT_TABLE {} { + if [ catch { + # We don't need a MAX_CHAN parameter for time because the time channel + # is scaled by calling the ::histogram_memory::clock_scale function + OAT_TABLE X -setdata MAX_CHAN 128 + OAT_TABLE Y -setdata MAX_CHAN 512 + OAT_TABLE X -setdata BMIN -0.5 + OAT_TABLE X -setdata BMAX 127.5 + OAT_TABLE Y -setdata BMIN -0.5 + OAT_TABLE Y -setdata BMAX 511.5 + + OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 512 T { 0 2000 } NTC 1 + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +## +# @brief Return the detector position proc ::histogram_memory::detector_posn_degrees {} { return [SplitReply [stth]] } proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::initialize {} { - if {$::sim_mode == "true"} { - hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 1024 - hmm configure oat_nxc_eff 64 - } - ::histogram_memory::_initialize - ::histogram_memory::two_theta -boundaries + if [ catch { + if {$::sim_mode == "true"} { + hmm configure oat_ntc_eff 1 + hmm configure oat_nyc_eff 1024 + hmm configure oat_nxc_eff 64 + } + BAT_TABLE -init + CAT_TABLE -init + SAT_TABLE -init + OAT_TABLE -init + FAT_TABLE -init + ::histogram_memory::_initialize + ::histogram_memory::two_theta -boundaries - detector_active_height_mm 335 - detector_active_width_mm 500 - detector_radius_mm 1250.0 - set x_bb0 -0.5; set xbbmax 63.5 - set y_bb0 -0.5; set ybbmax 1023.5 - hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 - hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax - hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 - hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax - set x_binwidth 1 - if {[expr {$xbbmax - $x_bb0}] > 0} { - set x_bb1 [expr {$x_bb0+$x_binwidth}] - } else { - set x_bb1 [expr {$x_bb0-$x_binwidth}] - } - set y_binwidth 1 - if {[expr {$ybbmax - $y_bb0}] > 0} { - set y_bb1 [expr {$y_bb0+$y_binwidth}] - } else { - set y_bb1 [expr {$y_bb0-$y_binwidth}] - } - OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax - # We default to one big bin for time - set t_bb0 [OAT_TABLE -get T_MIN] - set t_bb1 [OAT_TABLE -get T_MAX] - OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1" - ::histogram_memory::upload_config Filler_defaults + detector_active_height_mm 335 + detector_active_width_mm 500 + detector_radius_mm 1250.0 - ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset - ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::two_theta + # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 + # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax + # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 + # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax + ::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::two_theta + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } proc histmem {cmd args} { diff --git a/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl b/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl index 0bd1f00a..e0930e70 100644 --- a/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/hrpd/config/motors/motor_configuration.tcl @@ -1,7 +1,8 @@ -# $Revision: 1.23 $ -# $Date: 2008-05-29 04:54:06 $ +# $Revision: 1.24 $ +# $Date: 2008-05-30 00:26:56 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ +source $cfPath(anticollider)/anticollider.tcl # START MOTOR CONFIGURATION @@ -256,7 +257,6 @@ mtth blockage_ratio 5 mtth backlash_offset -1 mtth creep_offset 90 mtth creep_precision 0.02 -#mtth debug 1 mtth part crystal mtth long_name takeoff_angle @@ -445,7 +445,6 @@ stth blockage_ratio 1.5 stth backlash_offset -0.1 stth creep_offset 0.1 stth creep_precision 0.00002 -stth debug 1 stth part sample stth long_name azimuthal_angle @@ -695,3 +694,4 @@ make_gap_motors ss2hg gap ss2ho offset ss2r ss2l mm $slit2HGroup proc motor_set_sobj_attributes {} { } # END MOTOR CONFIGURATION +::anticollider::init diff --git a/site_ansto/instrument/hrpd/echidna_configuration.tcl b/site_ansto/instrument/hrpd/echidna_configuration.tcl index f6d34092..b1706534 100644 --- a/site_ansto/instrument/hrpd/echidna_configuration.tcl +++ b/site_ansto/instrument/hrpd/echidna_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.26 $ -# $Date: 2007-11-05 02:28:46 $ +# $Revision: 1.27 $ +# $Date: 2008-05-30 00:26:55 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -12,9 +12,6 @@ Instrument lock source util/dmc2280/dmc2280_util.tcl source sics_ports.tcl source server_config.tcl -VarMake deg_per_rad Float Internal -deg_per_rad 57.29577951308232 -deg_per_rad lock #END SERVER CONFIGURATION SECTION ######################################## @@ -22,61 +19,36 @@ deg_per_rad lock fileeval $cfPath(motors)/motor_configuration.tcl -######## -# Parameters set above the restore command will be clobbered by -# the values in the status.tcl file -restore +source instrument_vars.tcl +source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl +#TODO Provide method for choosing environment controller +fileeval $cfPath(environment)/temperature/lakeshore340.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(scan)/scan.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(commands)/commands.tcl source gumxml.tcl +######## +# Parameters set above the restore command will be clobbered by +# the values in the status.tcl file +# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS +# AN ERROR IF THERE IS NO ../log/status.tcl FILE. +restore + ::histogram_memory::initialize +#::environment::temperature::add_ls340 -VarMake detector_layout Text Mugger -detector_layout cylinder - -VarMake detector_angle_deg Float User -detector_angle_deg 158.75 -VarMake detector_angle_rad Float User -detector_angle_rad [expr [SplitReply [detector_angle_deg]]/[SplitReply [deg_per_rad]] ] - -VarMake crystal_type Text User -VarMake crystal_wavelength_A Float User - -VarMake bmon_distance Float User - -## Number of last pixel on vertical axis -VarMake detector_last_vert_pixel Float User -detector_last_vert_pixel 511 -## Number of last pixel on horizontal axis -VarMake detector_last_hor_pixel Float User -detector_last_hor_pixel 127 -## Row number at beam centre -VarMake detector_zero_row Float User -detector_zero_row 255.5 -## Column number at beam centre for a detector rotation of 0 degrees -VarMake detector_zero_col Float User -detector_zero_col 124 -## Row offset for region of interest -VarMake detector_ROI_row_offset Float User -detector_ROI_row_offset 0 -## Column offset for region of interest -VarMake detector_ROI_col_offset Float User -detector_ROI_col_offset 0 - -detector_type He-3 position sensitive detector, tube active length=335+/-5mm, tube diameter=25.4 +/- 0.8mm -detector_type lock - -detector_description 128 He-3 proportional counter detector tubes (GE Energy Reuter Stokes Inc. item=RS-P4-0814-217) -detector_description lock - MakeStateMon hmscan -fileeval extraconfig.tcl +if [file exists extraconfig.tcl] { + fileeval extraconfig.tcl +} else { + clientput "extraconfig.tcl not found. continueing" +} + server_set_sobj_attributes buildHDB instrument_dictionary diff --git a/site_ansto/instrument/hrpd/extraconfig.tcl b/site_ansto/instrument/hrpd/extraconfig.tcl index 3e369ecf..ac7f9a29 100644 --- a/site_ansto/instrument/hrpd/extraconfig.tcl +++ b/site_ansto/instrument/hrpd/extraconfig.tcl @@ -1,70 +1,6 @@ -# Put extra config info here. -# Just some examples for now -bmon_distance -1.0 -Title "precommissioning tests" -Sample "No Sample" -# Selected wavelength in Angstroms -crystal_wavelength_A "0.0" -crystal_type "Unknown" -## LAKESHORE +# @file Put extra configuration info here. +# +# NOTE TO DEVELOPERS,\n +# Do not put this file name in the MANIFEST.TXT, it should not be automatically\n +# deployed to an instrument. -#source util/dmc2280/dmc2280_util.tcl -#First Lakshore340 tempcontroller creation -MakeRS232Controller sertemp1 127.0.0.1 4001 -sertemp1 timeout 20000 -sertemp1 sendterminator 0xd -sertemp1 replyterminator 0xd -EvFactory new tc1 lakeshore340 sertemp1 1 1 -tc1 tolerance 0.2 -tc1 UpperLimit 500 -tc1 LowerLimit 4 -tc1 sensor 3 -tc1 control 3 -#Second Lakshore340 tempcontroller creation -MakeRS232Controller sertemp2 127.0.0.1 4002 -sertemp2 timeout 20000 -sertemp2 sendterminator 0xd -sertemp2 replyterminator 0xd -EvFactory new tc2 lakeshore340 sertemp2 1 1 -tc2 tolerance 0.2 -tc2 UpperLimit 500 -tc2 LowerLimit 4 -tc2 sensor 3 -tc2 control 3 -#First Julabo tempcontroller creation -MakeRS232Controller sertemp3 127.0.0.1 4003 -sertemp3 timeout 20000 -sertemp3 sendterminator 0xd 0xa -sertemp3 replyterminator 0xd -EvFactory new tc3 lh45 sertemp3 1 1 -tc3 tolerance 0.5 -tc3 UpperLimit 110 -tc3 LowerLimit -30 -#Second Julabo tempcontroller creation -MakeRS232Controller sertemp4 127.0.0.1 4004 -sertemp4 timeout 20000 -sertemp4 sendterminator 0xd 0xa -sertemp4 replyterminator 0xd -EvFactory new tc4 lh45 sertemp4 1 1 -tc4 tolerance 0.5 -tc4 UpperLimit 110 -tc4 LowerLimit -30 - -sicslist setatt tc1 long_name tempone -sicslist setatt tc2 long_name temptwo -sicslist setatt tc3 long_name tempthree -sicslist setatt tc4 long_name tempfour -#END SERVER CONFIGURATION SECTION - -sicslist setatt tc1 units kelvin -sicslist setatt tc2 units kelvin -sicslist setatt tc3 units Celsius -sicslist setatt tc4 units Celsius -sicslist setatt tc1 savecmd ::nexus::evcontroller::save -sicslist setatt tc1 sdsinfo ::nexus::evcontroller::sdsinfo -sicslist setatt tc2 savecmd ::nexus::evcontroller::save -sicslist setatt tc2 sdsinfo ::nexus::evcontroller::sdsinfo -sicslist setatt tc3 savecmd ::nexus::evcontroller::save -sicslist setatt tc3 sdsinfo ::nexus::evcontroller::sdsinfo -sicslist setatt tc4 savecmd ::nexus::evcontroller::save -sicslist setatt tc4 sdsinfo ::nexus::evcontroller::sdsinfo \ No newline at end of file diff --git a/site_ansto/instrument/hrpd/instrument_vars.tcl b/site_ansto/instrument/hrpd/instrument_vars.tcl new file mode 100644 index 00000000..9ef0f2d2 --- /dev/null +++ b/site_ansto/instrument/hrpd/instrument_vars.tcl @@ -0,0 +1,9 @@ +# @file This file defines the instrument variables. + +VarMake deg_per_rad Float Internal +deg_per_rad 57.29577951308232 +deg_per_rad lock + + + + diff --git a/site_ansto/instrument/hrpd/script_validator_ports.tcl b/site_ansto/instrument/hrpd/script_validator_ports.tcl new file mode 100644 index 00000000..6ff92173 --- /dev/null +++ b/site_ansto/instrument/hrpd/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport quieck-val-echidna +set serverport server-val-echidna +set interruptport interrupt-val-echidna +set telnetport telnet-val-echidna diff --git a/site_ansto/instrument/reflectometer/DMC2280/controller1.txt b/site_ansto/instrument/reflectometer/DMC2280/controller1.txt index 04581987..412c912f 100644 --- a/site_ansto/instrument/reflectometer/DMC2280/controller1.txt +++ b/site_ansto/instrument/reflectometer/DMC2280/controller1.txt @@ -1,9 +1,10 @@ ' PLATYPUS - CONTROLLER 1 ' -' $Revision: 1.11 $ -' $Date: 2008-04-30 01:57:55 $ +' $Revision: 1.12 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:56 $ ' Author: Dan Bartlett -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-BEAM SHADE RAISE ' B-COLLIMATOR TRANSLATE A=7350364, B=6529772, C=6941582 diff --git a/site_ansto/instrument/reflectometer/DMC2280/controller2.txt b/site_ansto/instrument/reflectometer/DMC2280/controller2.txt index a217cc93..a8e26a65 100644 --- a/site_ansto/instrument/reflectometer/DMC2280/controller2.txt +++ b/site_ansto/instrument/reflectometer/DMC2280/controller2.txt @@ -1,9 +1,10 @@ ' PLATYPUS - CONTROLLER 2 ' -' $Revision: 1.6 $ -' $Date: 2008-04-30 01:57:55 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:56 $ ' Author: Dan Bartlett -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SAMPLE TILT 1 ' B-SAMPLE TILT 2 diff --git a/site_ansto/instrument/reflectometer/DMC2280/controller3.txt b/site_ansto/instrument/reflectometer/DMC2280/controller3.txt index 35ad8785..e910615f 100644 --- a/site_ansto/instrument/reflectometer/DMC2280/controller3.txt +++ b/site_ansto/instrument/reflectometer/DMC2280/controller3.txt @@ -1,9 +1,10 @@ ' PLATYPUS - CONTROLLER 3 ' -' $Revision: 1.6 $ -' $Date: 2008-04-30 01:57:55 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:56 $ ' Author: Dan Bartlett -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SLIT S1 WEST BLADE ' B-SLIT S1 EAST BLADE diff --git a/site_ansto/instrument/reflectometer/DMC2280/controller4.txt b/site_ansto/instrument/reflectometer/DMC2280/controller4.txt index 816b1b66..b63c4b16 100644 --- a/site_ansto/instrument/reflectometer/DMC2280/controller4.txt +++ b/site_ansto/instrument/reflectometer/DMC2280/controller4.txt @@ -1,9 +1,10 @@ ' PLATYPUS - CONTROLLER 4 ' -' $Revision: 1.6 $ -' $Date: 2008-04-30 01:57:55 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:56 $ ' Author: Dan Bartlett -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-SLIT S3 BOTTOM BLADE ' B-SLIT S3 TOP BLADE diff --git a/site_ansto/instrument/reflectometer/MANIFEST.TXT b/site_ansto/instrument/reflectometer/MANIFEST.TXT index 4109e41d..cf97d60e 100644 --- a/site_ansto/instrument/reflectometer/MANIFEST.TXT +++ b/site_ansto/instrument/reflectometer/MANIFEST.TXT @@ -1,4 +1,6 @@ platypus_configuration.tcl sics_ports.tcl +script_validator_ports.tcl +extraconfig.tcl config util diff --git a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT index c3d73db2..096693ef 100644 --- a/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/reflectometer/config/INSTCFCOMMON.TXT @@ -1,3 +1,4 @@ +config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl config/hipadaba/hipadaba_configuration_common.tcl @@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl diff --git a/site_ansto/instrument/reflectometer/config/anticollider/acscript.txt b/site_ansto/instrument/reflectometer/config/anticollider/acscript.txt new file mode 100644 index 00000000..f777e418 --- /dev/null +++ b/site_ansto/instrument/reflectometer/config/anticollider/acscript.txt @@ -0,0 +1,3 @@ +# Forbid detector motion when the detector voltage is on +forbid {-inf inf} for dy when dhv1 in {20 inf} +forbid {-inf inf} for dz when dhv1 in {20 inf} diff --git a/site_ansto/instrument/reflectometer/config/anticollider/anticollider.tcl b/site_ansto/instrument/reflectometer/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..87660bcf --- /dev/null +++ b/site_ansto/instrument/reflectometer/config/anticollider/anticollider.tcl @@ -0,0 +1,8 @@ + +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:56 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source $cfPath(anticollider)/anticollider_common.tcl +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/reflectometer/config/commands/commands.tcl b/site_ansto/instrument/reflectometer/config/commands/commands.tcl new file mode 100644 index 00000000..1251d4b5 --- /dev/null +++ b/site_ansto/instrument/reflectometer/config/commands/commands.tcl @@ -0,0 +1 @@ +source $cfPath(commands)/commands_common.tcl diff --git a/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl b/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl index 3aaa4d83..3ec8ef31 100644 --- a/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/hipadaba/hipadaba_configuration.tcl @@ -1 +1,10 @@ source $cfPath(hipadaba)/hipadaba_configuration_common.tcl +set sobj_klass_list [concat $sobj_klass_list junk] +set instrument_dictionary [concat $instrument_dictionary { + junk { + sobj {@any junk} + privilege spy + datatype @none + property {data true control true nxsave true klass NXnote type part} + } +} ] diff --git a/site_ansto/instrument/reflectometer/config/hmm/detector.tcl b/site_ansto/instrument/reflectometer/config/hmm/detector.tcl new file mode 100644 index 00000000..b4611ed0 --- /dev/null +++ b/site_ansto/instrument/reflectometer/config/hmm/detector.tcl @@ -0,0 +1,18 @@ +# Detector voltage controller + +set sim_mode [SplitReply [detector_simulation]] + +if {$::sim_mode == "true"} { + EvFactory new dhv1 sim +} else { +clientput "Detector Voltage control not yet available" +# makeasyncqueue acq NHQ200 xxxxxxxxxxxxxx yyyy +# evfactory new dhv1 nhqvps acq +# dhv1 lowerlimit xxx +# dhv1 upperlimit xxx +# dhv1 tolerance xxx +# dhv1 max xxx +# dhv1 rate xxx +# dhv1 lock +} + diff --git a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl index fbec98bc..ac4fae38 100644 --- a/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/reflectometer/config/hmm/hmm_configuration.tcl @@ -1,46 +1,55 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl set sim_mode [SplitReply [hmm_simulation]] +proc ::histogram_memory::init_OAT_TABLE {} { + if [ catch { + # We don't need a MAX_CHAN parameter for time because the time channel + # is scaled by calling the ::histogram_memory::clock_scale function + OAT_TABLE X -setdata MAX_CHAN 421 + OAT_TABLE Y -setdata MAX_CHAN 221 + OAT_TABLE X -setdata BMIN -210.5 + OAT_TABLE X -setdata BMAX 210.5 + OAT_TABLE Y -setdata BMIN -110.5 + OAT_TABLE Y -setdata BMAX 110.5 + + OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -110.5 -109.5 } NYC 221 T { 0 2000 } NTC 1 + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::initialize {} { - if {$::sim_mode == "true"} { - hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 210 - hmm configure oat_nxc_eff 210 - } - ::histogram_memory::_initialize + if [ catch { + if {$::sim_mode == "true"} { + hmm configure oat_ntc_eff 1 + hmm configure oat_nyc_eff 210 + hmm configure oat_nxc_eff 210 + } + BAT_TABLE -init + CAT_TABLE -init + SAT_TABLE -init + OAT_TABLE -init + FAT_TABLE -init + ::histogram_memory::_initialize - detector_active_height_mm 257.5 - detector_active_width_mm 500 + detector_active_height_mm 257.5 + detector_active_width_mm 500 - set x_bb0 -210.5; set xbbmax 210.5 - set y_bb0 -110.5; set ybbmax 110.5 - hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 - hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax - hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 - hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax - set x_binwidth 1 - if {[expr {$xbbmax - $x_bb0}] > 0} { - set x_bb1 [expr {$x_bb0+$x_binwidth}] - } else { - set x_bb1 [expr {$x_bb0-$x_binwidth}] - } - set y_binwidth 1 - if {[expr {$ybbmax - $y_bb0}] > 0} { - set y_bb1 [expr {$y_bb0+$y_binwidth}] - } else { - set y_bb1 [expr {$y_bb0-$y_binwidth}] - } - OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax - # We default to one big bin for time - set t_bb0 [OAT_TABLE -get T_MIN] - set t_bb1 [OAT_TABLE -get T_MAX] - OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1" - ::histogram_memory::upload_config Filler_defaults + # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 + # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax + # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 + # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax + ::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 + ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_bin + ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_bin + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } ## @@ -50,8 +59,9 @@ proc ::histogram_memory::tochfreq {} { ::chopper::ready? set chfreq [::chopper::get_frequency] ::histogram_memory::set_frame_freq $chfreq EXTERNAL - } errmsg ] { - return -code error $errmsg + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } @@ -71,11 +81,13 @@ proc histmem {cmd args} { ::histogram_memory::tochfreq } default { - eval "_histmem $cmd $args" + set reply [eval "_histmem $cmd $args"] } } - } errmsg ] { - return -code error $errmsg + return $reply + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } publish histmem user diff --git a/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl b/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl new file mode 100644 index 00000000..7c2d7d18 --- /dev/null +++ b/site_ansto/instrument/reflectometer/config/parameters/parameters.tcl @@ -0,0 +1,28 @@ +## +# @brief Instrument parameters +# TODO There should be an NXgeometry entry for each distance, and linked to an NXgeometry +# entry for the chopper [SICS-108]. We put them in a junk entry for now to avoid holding up +# testing and development. +foreach vn { + detector_distance + detector_base + slit4_distance + slit4_base + sample_distance + sample_base + slit3_distance + slit3_base +} { + ::utility::mkVar $vn float manager $vn true junk true true +} + +detector_distance 10000 +detector_base 300 +slit4_distance 6000 +slit4_base 20 +sample_distance 5800 +sample_base 50 +slit3_distance 5600 +slit3_base 20 + + diff --git a/site_ansto/instrument/reflectometer/platypus_configuration.tcl b/site_ansto/instrument/reflectometer/platypus_configuration.tcl index 02df8d0c..10c914a9 100644 --- a/site_ansto/instrument/reflectometer/platypus_configuration.tcl +++ b/site_ansto/instrument/reflectometer/platypus_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.14 $ -# $Date: 2007-10-31 06:07:10 $ +# $Revision: 1.15 $ +# $Date: 2008-05-30 00:26:56 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -17,25 +17,37 @@ source server_config.tcl ######################################## # INSTRUMENT SPECIFIC CONFIGURATION +source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(motors)/motor_configuration.tcl +fileeval $cfPath(plc)/plc.tcl +fileeval $cfPath(counter)/counter.tcl +fileeval $cfPath(hmm)/hmm_configuration.tcl +fileeval $cfPath(hmm)/detector.tcl +fileeval $cfPath(nexus)/nxscripts.tcl +fileeval $cfPath(scan)/scan.tcl +fileeval $cfPath(chopper)/chopper.tcl +fileeval $cfPath(commands)/commands.tcl +fileeval $cfPath(anticollider)/anticollider.tcl +source gumxml.tcl + ######## # Parameters set above the restore command will be clobbered by # the values in the status.tcl file +# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS +# AN ERROR IF THERE IS NO ../log/status.tcl FILE. restore -fileeval $cfPath(plc)/plc.tcl -fileeval $cfPath(counter)/counter.tcl -fileeval $cfPath(hmm)/hmm_configuration.tcl -fileeval $cfPath(nexus)/nxscripts.tcl -fileeval $cfPath(scan)/scan.tcl -fileeval $cfPath(chopper)/chopper.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl -source gumxml.tcl - ::histogram_memory::initialize MakeStateMon hmscan -fileeval extraconfig.tcl +if [file exists extraconfig.tcl] { + fileeval extraconfig.tcl +} else { + clientput "extraconfig.tcl not found. continueing" +} + +::anticollider::init server_set_sobj_attributes buildHDB instrument_dictionary diff --git a/site_ansto/instrument/reflectometer/script_validator_ports.tcl b/site_ansto/instrument/reflectometer/script_validator_ports.tcl new file mode 100644 index 00000000..25f2802a --- /dev/null +++ b/site_ansto/instrument/reflectometer/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport quieck-val-platypus +set serverport server-val-platypus +set interruptport interrupt-val-platypus +set telnetport telnet-val-platypus diff --git a/site_ansto/instrument/rsd/DMC2280/controller1.txt b/site_ansto/instrument/rsd/DMC2280/controller1.txt index 64bf62f1..e20dabdf 100644 --- a/site_ansto/instrument/rsd/DMC2280/controller1.txt +++ b/site_ansto/instrument/rsd/DMC2280/controller1.txt @@ -1,10 +1,11 @@ ' KOWARI - CONTROLLER 1 ' -' $Revision: 1.6 $ -' $Date: 2008-04-14 00:28:07 $ +' $Revision: 1.7 $ +' $Name: not supported by cvs2svn $ +' $Date: 2008-05-30 00:26:56 $ ' Author: Dan Bartlett ' Airpad control added by Doug Clowes -' Last revision by: $Author: dcl $ +' Last revision by: $Author: ffr $ ' ' A-MONOCHROMATOR UPPER TILT ' B-MONOCHROMATOR LOWER TILT diff --git a/site_ansto/instrument/rsd/DMC2280/controller2.txt b/site_ansto/instrument/rsd/DMC2280/controller2.txt index 0ea7a7ce..5b9b5dad 100644 --- a/site_ansto/instrument/rsd/DMC2280/controller2.txt +++ b/site_ansto/instrument/rsd/DMC2280/controller2.txt @@ -1,9 +1,10 @@ NO TE: KOWARI - CONTROLLER 2 NO TE: NO TE: $Revision: -NO TE: $Date: 2008-05-08 06:50:32 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:56 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dcl $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: GALIL 31 BIT FIRMWARE IS REQUIRED FOR THIS CODE NO TE: A-SAMPLE RAISE FIRST SECTION diff --git a/site_ansto/instrument/rsd/DMC2280/controller3.txt b/site_ansto/instrument/rsd/DMC2280/controller3.txt index 364774d8..37f83e29 100644 --- a/site_ansto/instrument/rsd/DMC2280/controller3.txt +++ b/site_ansto/instrument/rsd/DMC2280/controller3.txt @@ -1,9 +1,10 @@ NO TE: KOWARI - CONTROLLER 3 NO TE: -NO TE: $Revision: 1.3 $ -NO TE: $Date: 2008-05-08 06:50:04 $ +NO TE: $Revision: 1.4 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:56 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dcl $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-MONOCHROMATOR FOCUS 1 NO TE: B-MONOCHROMATOR FOCUS 2 diff --git a/site_ansto/instrument/rsd/DMC2280/controller4.txt b/site_ansto/instrument/rsd/DMC2280/controller4.txt index cdb70d16..4dd515d6 100644 --- a/site_ansto/instrument/rsd/DMC2280/controller4.txt +++ b/site_ansto/instrument/rsd/DMC2280/controller4.txt @@ -1,9 +1,10 @@ NO TE: KOWARI - CONTROLLER 4 NO TE: -NO TE: $Revision: 1.2 $ -NO TE: $Date: 2007-09-24 01:25:23 $ +NO TE: $Revision: 1.3 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:56 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dbx $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-PRE SAMPLE COLLIMATOR X (ACROSS BEAM) NO TE: B-PRE SAMPLE COLLIMATOR Y (ALONG BEAM) diff --git a/site_ansto/instrument/rsd/MANIFEST.TXT b/site_ansto/instrument/rsd/MANIFEST.TXT index 2e5e35ec..3adb26a4 100644 --- a/site_ansto/instrument/rsd/MANIFEST.TXT +++ b/site_ansto/instrument/rsd/MANIFEST.TXT @@ -1,4 +1,5 @@ sics_ports.tcl +script_validator_ports.tcl kowari_configuration.tcl extraconfig.tcl config diff --git a/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT b/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT index c3d73db2..096693ef 100644 --- a/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/rsd/config/INSTCFCOMMON.TXT @@ -1,3 +1,4 @@ +config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl config/hipadaba/hipadaba_configuration_common.tcl @@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl diff --git a/site_ansto/instrument/rsd/config/anticollider/acscript.txt b/site_ansto/instrument/rsd/config/anticollider/acscript.txt new file mode 100644 index 00000000..d0be6249 --- /dev/null +++ b/site_ansto/instrument/rsd/config/anticollider/acscript.txt @@ -0,0 +1,10 @@ +# This script is loaded automatically by anticollider.tcl when SICS is launched +# TODO Allow sequencing +# TODO Allow functional dependencies +# +# Examples +# for mphi forbid {-inf inf} when mchi in {{85 87} {93 95}} +# when stth in { {0 10} {20 30} } forbid { {10 20} {90 100} } for mtth +# +## The next example forbids movement when both schi and sx are in the given ranges +# forbid {0 10} for sphi whenall {schi in {10 15} sx {10 11} } diff --git a/site_ansto/instrument/rsd/config/anticollider/anticollider.tcl b/site_ansto/instrument/rsd/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..87660bcf --- /dev/null +++ b/site_ansto/instrument/rsd/config/anticollider/anticollider.tcl @@ -0,0 +1,8 @@ + +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:56 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source $cfPath(anticollider)/anticollider_common.tcl +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/rsd/config/commands/commands.tcl b/site_ansto/instrument/rsd/config/commands/commands.tcl new file mode 100644 index 00000000..1251d4b5 --- /dev/null +++ b/site_ansto/instrument/rsd/config/commands/commands.tcl @@ -0,0 +1 @@ +source $cfPath(commands)/commands_common.tcl diff --git a/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl index f325b392..f8d9325f 100644 --- a/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/rsd/config/hmm/hmm_configuration.tcl @@ -2,47 +2,48 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl set sim_mode [SplitReply [hmm_simulation]] +proc ::histogram_memory::init_OAT_TABLE {} { + # We don't need a MAX_CHAN parameter for time because the time channel + # is scaled by calling the ::histogram_memory::clock_scale function + OAT_TABLE X -setdata MAX_CHAN 421 + OAT_TABLE Y -setdata MAX_CHAN 421 + OAT_TABLE X -setdata BMIN -210.5 + OAT_TABLE X -setdata BMAX 210.5 + OAT_TABLE Y -setdata BMIN -210.5 + OAT_TABLE Y -setdata BMAX 210.5 + + OAT_TABLE -set X { -210.5 -209.5 } NXC 421 Y { -210.5 -209.5 } NYC 421 T { 0 2000 } NTC 1 +} proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::initialize {} { - if {$::sim_mode == "true"} { - hmm configure oat_ntc_eff 1 - hmm configure oat_nyc_eff 421 - hmm configure oat_nxc_eff 421 - } - ::histogram_memory::_initialize + if [ catch { + if {$::sim_mode == "true"} { + hmm configure oat_ntc_eff 1 + hmm configure oat_nyc_eff 421 + hmm configure oat_nxc_eff 421 + } + BAT_TABLE -init + CAT_TABLE -init + SAT_TABLE -init + OAT_TABLE -init + FAT_TABLE -init + ::histogram_memory::_initialize - detector_active_height_mm 500 - detector_active_width_mm 500 + # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 + # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax + # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 + # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax + ::histogram_memory::init_OAT_TABLE + ::histogram_memory::upload_config Filler_defaults - set x_bb0 -210.5; set xbbmax 210.5 - set y_bb0 -210.5; set ybbmax 210.5 - hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 - hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax - hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 - hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax - set x_binwidth 1 - if {[expr {$xbbmax - $x_bb0}] > 0} { - set x_bb1 [expr {$x_bb0+$x_binwidth}] - } else { - set x_bb1 [expr {$x_bb0-$x_binwidth}] + ::nexus::data alias ::histogram_memory::vertical_axis ::histogram_memory::y_pixel_offset + ::nexus::data alias ::histogram_memory::horizontal_axis ::histogram_memory::x_pixel_offset + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } - set y_binwidth 1 - if {[expr {$ybbmax - $y_bb0}] > 0} { - set y_bb1 [expr {$y_bb0+$y_binwidth}] - } else { - set y_bb1 [expr {$y_bb0-$y_binwidth}] - } - OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax - # We default to one big bin for time - set t_bb0 [OAT_TABLE -get T_MIN] - set t_bb1 [OAT_TABLE -get T_MAX] - OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1" - ::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 } proc histmem {cmd args} { diff --git a/site_ansto/instrument/rsd/config/motors/motor_configuration.tcl b/site_ansto/instrument/rsd/config/motors/motor_configuration.tcl index fa55a7b8..48de4a92 100644 --- a/site_ansto/instrument/rsd/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/rsd/config/motors/motor_configuration.tcl @@ -1,7 +1,7 @@ -# $Revision: 1.23 $ -# $Date: 2008-05-29 04:55:49 $ +# $Revision: 1.24 $ +# $Date: 2008-05-30 00:26:56 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # START MOTOR CONFIGURATION @@ -62,8 +62,7 @@ set sx_Home 9067806 set sy_Home 18782188 set som_Home 23164850 -#set stth_Home 28686300 -set stth_Home 29446192 +set stth_Home 28686300 #set psho_home 542093 set psho_home 7576691 @@ -381,18 +380,18 @@ Motor stth $motor_driver_type [params \ asyncqueue mc2\ axis F\ units degrees\ - hardlowerlim -90\ - hardupperlim 120\ + hardlowerlim 30\ + hardupperlim 150\ maxSpeed 0.5\ maxAccel 0.1\ maxDecel 0.1\ stepsPerX 25000\ absEnc 1\ absEncHome $stth_Home\ - cntsPerX -8192] -stth softlowerlim -90 -stth softupperlim 120 -stth home 0 + cntsPerX -93207] +stth softlowerlim 30 +stth softupperlim 150 +stth home 90 stth speed 0.5 stth movecount $move_count stth precision 0.01 diff --git a/site_ansto/instrument/rsd/kowari_configuration.tcl b/site_ansto/instrument/rsd/kowari_configuration.tcl index f6b98cfe..850dec4f 100644 --- a/site_ansto/instrument/rsd/kowari_configuration.tcl +++ b/site_ansto/instrument/rsd/kowari_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.9 $ -# $Date: 2007-11-05 02:29:31 $ +# $Revision: 1.10 $ +# $Date: 2008-05-30 00:26:56 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -19,42 +19,33 @@ source server_config.tcl fileeval $cfPath(motors)/motor_configuration.tcl -######## -# Parameters set above the restore command will be clobbered by -# the values in the status.tcl file -restore +source $cfPath(hipadaba)/hipadaba_configuration.tcl fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(counter)/counter.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl fileeval $cfPath(nexus)/nxscripts.tcl fileeval $cfPath(scan)/scan.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(commands)/commands.tcl +fileeval $cfPath(anticollider)/anticollider.tcl source gumxml.tcl +######## +# Parameters set above the restore command will be clobbered by +# the values in the status.tcl file +# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS +# AN ERROR IF THERE IS NO ../log/status.tcl FILE. +restore + ::histogram_memory::initialize - -VarMake crystal_type Text User -VarMake crystal_wavelength_A Float User - -VarMake bmon_distance Float User - -## Column number at beam centre -VarMake detector_zero_row Float User -detector_zero_row 255.5 -## Row number at beam centre for a detector rotation of 0 degrees -VarMake detector_zero_col Float User -detector_zero_col 100 - -detector_type Kowari detector -detector_type lock - -detector_description This detects Kowaris -detector_description lock -MakeStateMon hmscan - MakeStateMon hmscan -fileeval extraconfig.tcl +if [file exists extraconfig.tcl] { + fileeval extraconfig.tcl +} else { + clientput "extraconfig.tcl not found. continueing" +} + +::anticollider::init server_set_sobj_attributes buildHDB instrument_dictionary diff --git a/site_ansto/instrument/rsd/script_validator_ports.tcl b/site_ansto/instrument/rsd/script_validator_ports.tcl new file mode 100644 index 00000000..167c4803 --- /dev/null +++ b/site_ansto/instrument/rsd/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport quieck-val-kowari +set serverport server-val-kowari +set interruptport interrupt-val-kowari +set telnetport telnet-val-kowari diff --git a/site_ansto/instrument/sans/DMC2280/controller1.txt b/site_ansto/instrument/sans/DMC2280/controller1.txt index fe77d5c1..e7a358f2 100644 --- a/site_ansto/instrument/sans/DMC2280/controller1.txt +++ b/site_ansto/instrument/sans/DMC2280/controller1.txt @@ -1,9 +1,10 @@ NO TE: QUOKKA - CONTROLLER 1 NO TE: -NO TE: $Revision: 1.8 $ -NO TE: $Date: 2007-09-24 01:10:59 $ +NO TE: $Revision: 1.9 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:57 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dbx $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-SAMPLE UPPER TILT NO TE: B-SAMPLE LOWER TILT diff --git a/site_ansto/instrument/sans/DMC2280/controller2.txt b/site_ansto/instrument/sans/DMC2280/controller2.txt index 1c6df2d5..1e9c7626 100644 --- a/site_ansto/instrument/sans/DMC2280/controller2.txt +++ b/site_ansto/instrument/sans/DMC2280/controller2.txt @@ -1,9 +1,10 @@ NO TE: QUOKKA - CONTROLLER 2 NO TE: -NO TE: $Revision: 1.5 $ -NO TE: $Date: 2007-09-24 01:10:59 $ +NO TE: $Revision: 1.6 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:57 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dbx $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-COLLIMATION OPTICS - CHAMBER 1 NO TE: B-COLLIMATION OPTICS - CHAMBER 2 diff --git a/site_ansto/instrument/sans/DMC2280/controller3.txt b/site_ansto/instrument/sans/DMC2280/controller3.txt index 5a4958fa..67f76994 100644 --- a/site_ansto/instrument/sans/DMC2280/controller3.txt +++ b/site_ansto/instrument/sans/DMC2280/controller3.txt @@ -1,9 +1,10 @@ NO TE: QUOKKA - CONTROLLER 3 NO TE: -NO TE: $Revision: 1.5 $ -NO TE: $Date: 2007-09-24 01:10:59 $ +NO TE: $Revision: 1.6 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:57 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dbx $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-COLLIMATION OPTICS - CHAMBER 9 NO TE: B-COLLIMATION OPTICS - CHAMBER 10 diff --git a/site_ansto/instrument/sans/DMC2280/controller4.txt b/site_ansto/instrument/sans/DMC2280/controller4.txt index 2db8ce30..dce41e93 100644 --- a/site_ansto/instrument/sans/DMC2280/controller4.txt +++ b/site_ansto/instrument/sans/DMC2280/controller4.txt @@ -1,9 +1,10 @@ NO TE: QUOKKA - CONTROLLER 4 NO TE: -NO TE: $Revision: 1.7 $ -NO TE: $Date: 2007-09-24 01:10:59 $ +NO TE: $Revision: 1.8 $ +NO TE: $Name: not supported by cvs2svn $ +NO TE: $Date: 2008-05-30 00:26:57 $ NO TE: Author: Dan Bartlett -NO TE: Last revision by: $Author: dbx $ +NO TE: Last revision by: $Author: ffr $ NO TE: NO TE: A-BEAM STOPS TRANS. X (ACCROSS BEAM) +VE=WEST NO TE: B-BEAM STOPS TRANSLATION - RAISE diff --git a/site_ansto/instrument/sans/MANIFEST.TXT b/site_ansto/instrument/sans/MANIFEST.TXT index da2e16b9..a4b93e37 100644 --- a/site_ansto/instrument/sans/MANIFEST.TXT +++ b/site_ansto/instrument/sans/MANIFEST.TXT @@ -1,6 +1,6 @@ quokka_configuration.tcl -velsel.tcl sics_ports.tcl +script_validator_ports.tcl extraconfig.tcl config util diff --git a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT index c3d73db2..096693ef 100644 --- a/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT +++ b/site_ansto/instrument/sans/config/INSTCFCOMMON.TXT @@ -1,3 +1,4 @@ +config/anticollider/anticollider_common.tcl config/plc/plc_common_1.tcl config/counter/counter_common_1.tcl config/hipadaba/hipadaba_configuration_common.tcl @@ -8,3 +9,4 @@ config/hmm/anstohm_linked.xml config/scan/scan_common_1.hdd config/scan/scan_common_1.tcl config/nexus/nxscripts_common_1.tcl +config/commands/commands_common.tcl diff --git a/site_ansto/instrument/sans/config/anticollider/acscript.txt b/site_ansto/instrument/sans/config/anticollider/acscript.txt new file mode 100644 index 00000000..301aa3b7 --- /dev/null +++ b/site_ansto/instrument/sans/config/anticollider/acscript.txt @@ -0,0 +1,3 @@ +# Forbid detector motion when the detector voltage is on +forbid {-inf inf} for det when dhv1 in {20 inf} +forbid {-inf inf} for detoff when dhv1 in {20 inf} diff --git a/site_ansto/instrument/sans/config/anticollider/anticollider.tcl b/site_ansto/instrument/sans/config/anticollider/anticollider.tcl new file mode 100644 index 00000000..edb84062 --- /dev/null +++ b/site_ansto/instrument/sans/config/anticollider/anticollider.tcl @@ -0,0 +1,8 @@ + +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:57 $ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author: ffr $ + +source $cfPath(anticollider)/anticollider_common.tcl +::anticollider::loadscript acscript.txt diff --git a/site_ansto/instrument/sans/config/commands/commands.tcl b/site_ansto/instrument/sans/config/commands/commands.tcl new file mode 100644 index 00000000..7d17a46e --- /dev/null +++ b/site_ansto/instrument/sans/config/commands/commands.tcl @@ -0,0 +1,65 @@ +source $cfPath(commands)/commands_common.tcl + +namespace eval sample { + command select {int=0:8 sampid} { + SampleNum $sampid + } +} + +namespace eval optics { + VarMake ::optics::select::section text user + VarMake ::optics::polarizer::in text user + VarMake ::optics::lens::selection text user + + command rotary_attenuator {int=0,15,45,90,180 angle} { + AttRotDeg $angle + } + + command entrance_aperture { + int=0,45,90,135,180,270 angle + text=circ,squ,open,rect shape + } { + RotApDeg $angle + RotApShape $shape + } + + command sample_aperture { + int=25,50 size + text=circ,squ,open,rect shape + } { + SApXmm $size + SApZmm $size + SApShape $shape + } + +############################## +## +# @brief set_guide uses a lookup table to setup the collimation system +# @param row, selects a row from the guide configuration table +# +# eg\n +# set_guide HIRES + command guide " + text=[join [array names ::optics::guide_configuration] , ] configuration + " { + + variable guide_configuration + variable guide_configuration_columns + + array set c1_map {G 1 MT 2 P 3} + array set c2_map {MT 1 G 2 A 3} + array set c3_map {MT 1 G 2 A 3} + array set c4_map {MT 1 G 2 A 3} + array set c5_map {MT 1 G 2 A 3} + array set c6_map {MT 1 G 2 A 3} + array set c7_map {MT 1 G 2 A 3} + array set c8_map {MT 1 G 2 A 3} + array set c9_map {LP 1 MT 2 G 3 A 4 L 5} + + foreach el $guide_configuration($configuration) guide $guide_configuration_columns { + lappend to_config $guide + lappend to_config [set ${guide}_map($el)] + } + eval "drive $to_config" + } +} diff --git a/site_ansto/instrument/sans/config/hmm/detector.tcl b/site_ansto/instrument/sans/config/hmm/detector.tcl new file mode 100644 index 00000000..12d0230b --- /dev/null +++ b/site_ansto/instrument/sans/config/hmm/detector.tcl @@ -0,0 +1,17 @@ +# Detector voltage controller + +set sim_mode [SplitReply [detector_simulation]] + +if {$::sim_mode == "true"} { + EvFactory new dhv1 sim +} else { + makeasyncqueue acq ORHVPS 137.157.202.85 4001 + evfactory new dhv1 orhvps acq + dhv1 lowerlimit 0 + dhv1 upperlimit 2400 + dhv1 tolerance 19 + dhv1 max 2400 + dhv1 rate 10 + dhv1 lock +} + diff --git a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl index 9a8e7c79..622a6dc4 100644 --- a/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl +++ b/site_ansto/instrument/sans/config/hmm/hmm_configuration.tcl @@ -1,41 +1,56 @@ source $cfPath(hmm)/hmm_configuration_common_1.tcl +set sim_mode [SplitReply [hmm_simulation]] +proc ::histogram_memory::init_OAT_TABLE {} { + if [ catch { + # We don't need a MAX_CHAN parameter for time because the time channel + # is scaled by calling the ::histogram_memory::clock_scale function + OAT_TABLE X -setdata MAX_CHAN 128 + OAT_TABLE Y -setdata MAX_CHAN 128 + OAT_TABLE X -setdata BMIN -0.5 + OAT_TABLE X -setdata BMAX 127.5 + OAT_TABLE Y -setdata BMIN -0.5 + OAT_TABLE Y -setdata BMAX 127.5 + + OAT_TABLE -set X { 127.5 126.5 } NXC 128 Y { -0.5 0.5 } NYC 127 T { 0 2000 } NTC 1 + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::post_count {} {} proc ::histogram_memory::initialize {} { - ::histogram_memory::_initialize + if [ catch { + if {$::sim_mode == "true"} { + hmm configure oat_ntc_eff 1 + hmm configure oat_nyc_eff 127 + hmm configure oat_nxc_eff 127 + } + BAT_TABLE -init + CAT_TABLE -init + SAT_TABLE -init + OAT_TABLE -init + FAT_TABLE -init + ::histogram_memory::_initialize - detector_active_height_mm 192 - detector_active_width_mm 192 + detector_active_height_mm 257.5 + detector_active_width_mm 500 - set x_bb0 -0.5; set xbbmax 191.5 - set y_bb0 -0.5; set ybbmax 191.5 - hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 - hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax - hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 - hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax - set x_binwidth 1 - if {[expr {$xbbmax - $x_bb0}] > 0} { - set x_bb1 [expr {$x_bb0+$x_binwidth}] - } else { - set x_bb1 [expr {$x_bb0-$x_binwidth}] + # hmm configure FAT_SIMULATED_EVENT_Y0 $y_bb0 + # hmm configure FAT_SIMULATED_EVENT_Y1 $ybbmax + # hmm configure FAT_SIMULATED_EVENT_X0 $x_bb0 + # hmm configure FAT_SIMULATED_EVENT_X1 $xbbmax + ::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 + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } - set y_binwidth 1 - if {[expr {$ybbmax - $y_bb0}] > 0} { - set y_bb1 [expr {$y_bb0+$y_binwidth}] - } else { - set y_bb1 [expr {$y_bb0-$y_binwidth}] - } - OAT_TABLE -init X_MIN $x_bb0 X_MAX $xbbmax Y_MIN $y_bb0 Y_MAX $ybbmax - # We default to one big bin for time - set t_bb0 [OAT_TABLE -get T_MIN] - set t_bb1 [OAT_TABLE -get T_MAX] - OAT_TABLE X "$x_bb0 $x_bb1" Y "$y_bb0 $y_bb1" T "$t_bb0 $t_bb1" - ::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 } proc histmem {cmd args} { diff --git a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl index 6669a236..6b7d7531 100644 --- a/site_ansto/instrument/sans/config/motors/motor_configuration.tcl +++ b/site_ansto/instrument/sans/config/motors/motor_configuration.tcl @@ -1,7 +1,7 @@ -# $Revision: 1.15 $ -# $Date: 2008-02-19 04:27:19 $ +# $Revision: 1.16 $ +# $Date: 2008-05-30 00:26:57 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) -# Last revision by: $Author: dcl $ +# Last revision by: $Author: ffr $ # START MOTOR CONFIGURATION @@ -959,39 +959,3 @@ make_coll_motor_1 c8 section_8 pc9 $vc_units make_coll_motor_1 c9 section_9 pc10 $vc_units unset vc_units -namespace eval guide { - VarMake ::guide::select::section text user - VarMake ::guide::polarizer::in text user - VarMake ::guide::lens::selection text user - - #TODO Set aperture size variable. - command select {int:0,1,2,3,4,5,6,7,8,9 section} { - set empty {2 1 1 1 1 1 1 1 2} - set aperture {2 3 3 3 3 3 3 3 4} - set guide {1 2 2 2 2 2 2 2 3} - array set lens {left 1 right 5 none 2} - - set target $empty - if {$section > 0} { - set gr [lrange $guide 0 [expr $section -1]] - set er [lrange $empty $section 8] - set target [list $gr $er] - if {[SplitReply [::guide::polarizer::in]] == "yes"} { - lset target 0 3 - } - } else { - lset target 8 $lens([SplitReply [::guide::lens::selection]]) - } - set fh [open junk.txt w] - for {set i 1} {$i <= 9} {incr i} { - puts $fh "run vc0$i [lindex target [expr {$i-1}]]" - } - close $fh - } - command polarizer {text:yes,no in} { - ::guide::polarizer::in $in - } - command lens {text:left,right,none selection} { - ::guide::lens::selection $selection - } -} diff --git a/site_ansto/instrument/sans/config/optics/guide_configuration.tcl b/site_ansto/instrument/sans/config/optics/guide_configuration.tcl index 75a3c779..6cd22df5 100644 --- a/site_ansto/instrument/sans/config/optics/guide_configuration.tcl +++ b/site_ansto/instrument/sans/config/optics/guide_configuration.tcl @@ -10,30 +10,30 @@ namespace eval optics { # configuration parameters # Rows can be of mixed type array set guide_configuration { - GA {MT A A A A A A A A } - MT {MT MT MT MT MT MT MT MT MT } - LP {MT MT MT MT MT MT MT MT LP } - LENS {MT MT MT MT MT MT MT MT L } - P1 {P A MT MT MT MT MT MT MT } - P1LP {P A MT MT MT MT MT MT LP } - P1LENS {P A MT MT MT MT MT MT L } - G1 {G A MT MT MT MT MT MT MT } - P2 {P G A MT MT MT MT MT MT } - G2 {G G A MT MT MT MT MT MT } - P3 {P G G A MT MT MT MT MT } - G3 {G G G A MT MT MT MT MT } - P4 {P G G G A MT MT MT MT } - G4 {G G G G A MT MT MT MT } - P5 {P G G G G A MT MT MT } - G5 {G G G G G A MT MT MT } - P6 {P G G G G G A MT MT } - G6 {G G G G G G A MT MT } - P7 {P G G G G G G A MT } - G7 {G G G G G G G A MT } - P8 {P G G G G G G G A } - G8 {G G G G G G G G A } - P9 {P G G G G G G G G } - G9 {G G G G G G G G G } + ga {MT A A A A A A A A } + mt {MT MT MT MT MT MT MT MT MT } + lp {MT MT MT MT MT MT MT MT LP } + lens {MT MT MT MT MT MT MT MT L } + p1 {P A MT MT MT MT MT MT MT } + p1lp {P A MT MT MT MT MT MT LP } + p1lens {P A MT MT MT MT MT MT L } + g1 {G A MT MT MT MT MT MT MT } + p2 {P G A MT MT MT MT MT MT } + g2 {G G A MT MT MT MT MT MT } + p3 {P G G A MT MT MT MT MT } + g3 {G G G A MT MT MT MT MT } + p4 {P G G G A MT MT MT MT } + g4 {G G G G A MT MT MT MT } + p5 {P G G G G A MT MT MT } + g5 {G G G G G A MT MT MT } + p6 {P G G G G G A MT MT } + g6 {G G G G G G A MT MT } + p7 {P G G G G G G A MT } + g7 {G G G G G G G A MT } + p8 {P G G G G G G G A } + g8 {G G G G G G G G A } + p9 {P G G G G G G G G } + g9 {G G G G G G G G G } } # This list maps the motor names to columns of the @@ -49,32 +49,3 @@ namespace eval optics { variable guide_configuration_columns namespace export set_guide } -## -# @brief set_guide uses a lookup table to setup the collimation system -# @param row, selects a row from the guide configuration table -# -# eg\n -# set_guide HIRES -proc ::optics::set_guide {row} { - variable guide_configuration - variable guide_configuration_columns - - array set c1_map {G 1 MT 2 P 3} - array set c2_map {MT 1 G 2 A 3} - array set c3_map {MT 1 G 2 A 3} - array set c4_map {MT 1 G 2 A 3} - array set c5_map {MT 1 G 2 A 3} - array set c6_map {MT 1 G 2 A 3} - array set c7_map {MT 1 G 2 A 3} - array set c8_map {MT 1 G 2 A 3} - array set c9_map {LP 1 MT 2 G 3 A 4 L 5} - - foreach el $guide_configuration($row) guide $guide_configuration_columns { - lappend to_config $guide - lappend to_config [set ${guide}_map($el)] - } - eval "drive $to_config" -} -namespace import ::optics::set_guide - -publish set_guide user diff --git a/site_ansto/instrument/sans/config/parameters/parameters.tcl b/site_ansto/instrument/sans/config/parameters/parameters.tcl new file mode 100644 index 00000000..83517d3a --- /dev/null +++ b/site_ansto/instrument/sans/config/parameters/parameters.tcl @@ -0,0 +1,294 @@ +## +# @brief We can't change the coordinate scheme at runtime because this would require +# restructuring the hdb tree, but we should save it. +foreach {var nxname} { + VelSelCoordScheme coordinate_scheme + SApCoordScheme coordinate_scheme + EApCoordScheme coordinate_scheme + SampleCoordScheme coordinate_scheme + DetCoordScheme coordinate_scheme + BeamstopCoordScheme coordinate_scheme + CollCoordScheme coordinate_scheme +} { + ::utility::mkVar $var text readonly $nxname true @none false true + $var Cartesian + $var lock +} + +## +# @brief User privilege text variables +# +# TODO SICS-117 Redo as get/set macros like the "kind=command" macros but kind=getset and it is saveable +# The set parameter will have a domain. If the param is readonly then the hdb privilege is readonly +# Pros, GumTree will know the data type of the parameter (text params will have a list of valid values). +# Cons, There is no "instant" feedback, macros are polled on the hdb tree. +foreach {var nxname priv} { + EApShape shape user + RotApshape shape readonly + SApShape shape readonly + BSShape shape user +} { + ::utility::mkVar $var text $priv $nxname true @none true true +} + +# The velocity selector position is used as the reference for other instrument +# component positions. For simplicity we set it as the origin x=y=z=0. +foreach {var nxname units} { + VelSelPosXmm x mm + VelSelPosYmm y mm + VelSelPosZmm z mm + EndFacePosYmm y mm + RotApPosYmm y mm +} { + ::utility::mkVar $var float readonly $nxname true @none true true + if {$units != 1} { + sicslist setatt $var units $units + } +} + +::utility::mkVar SampleNum int readonly changer_position true sample true true + +foreach {var nxname units priv} { + LambdaA wavelength nm user + LambdaResFWHM% wavelength_spread 1 user + VSdeg twist degrees user + VSrpm rotation_speed rpm user + AttRotDeg AttRotDeg degrees readonly + PleXmm x mm user + RotApXmm x mm user + RotApZmm z mm user + RotApDeg RotApDeg degrees readonly + EApXmm x mm user + EApYmm y mm user + EApZmm z mm user + EApPosYmm y mm user + SApXmm x mm readonly + SApZmm z mm readonly + SApPosXmm x mm user + SApPosYmm y mm user + SApPosZmm z mm user + SamplePosXmm x mm user + SamplePosYmm y mm user + SamplePosZmm z mm user + SampleRotDeg SampleRotDeg degrees user + SampleTiltXdeg SampleTiltXdeg degrees user + SampleTiltYdeg SampleTiltYdeg degrees user + DetPosYOffsetmm detposyoffset mm user + BSXmm x mm user + BSZmm z mm user +} { + ::utility::mkVar $var float $priv $nxname true @none true true + if {$units != 1} { + sicslist setatt $var units $units + } +} + +proc sicsmsgfmt {args} {return "[info level -1] = $args"} +::utility::macro::getset float L1mm {} { + set efpy [SplitReply [EndFacePosYmm]] + set sapy [SplitReply [SApPosYmm]] + set eapy [SplitReply [EApPosYmm]] + return [sicsmsgfmt [expr {$efpy + $sapy - $eapy}]] +} +sicslist setatt L1mm klass sample +sicslist setatt L1mm long_name eap_sap_dist +sicslist setatt L1mm units mm + +::utility::macro::getset float L2mm {} { + set detpy [SplitReply [DetPosYmm]] + set detpyos [SplitReply [DetPosYOffsetmm]] + set sapy [SplitReply [SApPosYmm]] + return [sicsmsgfmt [expr {$detpyos + $detpyos - $sapy}]] +} +sicslist setatt L2mm klass detector +sicslist setatt L2mm long_name sample_det_dist +sicslist setatt L2mm units mm + +foreach {pname motor hdbname units} { + DetPosXmm detoff x mm + DetPosYmm det y mm + BSPosXmm bsx x mm + BSPosZmm bsz z mm +} { + ::utility::macro::getset float $pname {} [subst -nocommands { + return [sicsmsgfmt [SplitReply [$motor]]] + }] + sicslist setatt $pname units $units + sicslist setatt $pname long_name $hdbname +} + +################################################################################ +## +# @brief This is the position of the velocity selector bunker face. It is used +# as the reference for other positions. x=y=z=0. +::hdb::MakeVelocity_Selector velocity_selector { + wavelength LambdaA + wavelength_spread LambdaResFWHM% + coordinate_scheme VelSelCoordScheme + position {VelSelPosXmm VelSelPosYmm VelSelPosZmm} +} + +::hdb::MakeAperture sample_aperture { + shape SApShape + size {SApXmm SApZmm} + coordinate_scheme SApCoordScheme + position {SApPosXmm SApPosYmm SApPosZmm} + refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} +} + +::hdb::MakeAperture entrance_aperture { + shape EApShape + size {EApXmm EApYmm EApZmm} + coordinate_scheme EApCoordScheme + position EApPosYmm + refpos VelSelPosYmm +} + +::hdb::MakeAperture rotary_aperture { + shape RotApShape + size {RotApXmm RotApZmm} + position RotApPosYmm + orientation RotApDeg + refpos VelSelPosYmm +} + +::hdb::MakeGeometry sample_geometry sample { + coordinate_scheme SampleCoordScheme + position {SamplePosXmm SamplePosYmm SamplePosZmm} + orientation {SampleTiltXdeg SampleTiltYdeg SampleRotDeg} + refpos {VelSelPosXmm EndFacePosYmm VelSelPosZmm} +} + +::hdb::MakeGeometry detector_geometry detector { + coordinate_scheme DetCoordScheme + position {DetPosXmm DetPosYmm} + offset DetPosYOffsetmm + refpos {VelSelPosXmm EndFacePosYmm} +} + +::hdb::MakeGeometry collimator_geometry collimator { + coordinate_scheme CollCoordScheme + position EndFacePosYmm + refpos VelSelPosYmm +} + +::hdb::MakeGeometry beamstop_geometry beam_stop { + shape BSShape + position {BSPosXmm BSPosZmm} + size {BSXmm BSZmm} +} + +# INITIALISE PARAMETERS +# The collimation system aperture positions +# Reference position is outer wall of velocity selector bunker, ie VelSelPosYmm +array set collapposmm { + inputguide 633 + apwheel 675 + ap1 4929 + ap2 6934 + ap3 8949 + ap4 10955 + ap5 12943 + ap6 14970 + ap7 16971 + ap9 19925 +} + +VelSelPosXmm 0.0 +VelSelPosYmm 0.0 +VelSelPosZmm 0.0 +EndFacePosYmm 20095 +RotApPosYmm 675 + +################################################################################ +# Check Config + +## +# @brief List undefined parameters +proc missingparams {} { + set paramlist { + AttFactor + AttRotDeg + BS1 + BS2 + BS3 + BS4 + BS5 + BSPosXmm + BSPosZmm + BSShape + BSXmm + BSZmm + C1 + C2 + C3 + C4 + C5 + C6 + C7 + C8 + C9 + DetPosXmm + DetPosYmm + DetPosYmm + DetPosYOffsetmm + EApPosYmm + EApShape + EApXmm + EApYmm + EApZmm + EndFacePosYmm + L1mm + L2mm + LambdaA + LambdaResFWHM% + Pent + Plexmm + RotApDeg + RotApShape + RotApXmm + RotApZmm + SampleAttributes + SampleComments + SampleName + SampleNum + SamplePosXmm + SamplePosYmm + SamplePosYmm + SamplePosZmm + SampleRotDeg + SampleTiltXDeg + SampleTiltYDeg + SampleTitle + SApPosXmm + SApPosYmm + SApPosYmm + SApPosZmm + SApShape + SApXmm + SApZmm + VSdeg + VSrpm + } + set num 0 + foreach param $paramlist { + if {[sicslist match $param] == " "} { + clientput $param + incr num + } + } + if {$num > 0} { + clientput "There are $num missing parameters" + } +} + +## +# @brief Check list +proc check {args} { + switch $args { + "missing" { + missingparams + } + } +} +publish check user diff --git a/site_ansto/instrument/sans/extraconfig.tcl b/site_ansto/instrument/sans/extraconfig.tcl index 3f854a01..df1b80a4 100644 --- a/site_ansto/instrument/sans/extraconfig.tcl +++ b/site_ansto/instrument/sans/extraconfig.tcl @@ -1,11 +1,3 @@ -makeasyncqueue acq ORHVPS 137.157.202.85 4001 -evfactory new dhv1 orhvps acq -dhv1 lowerlimit 0 -dhv1 upperlimit 2400 -dhv1 tolerance 19 -dhv1 max 2400 -dhv1 rate 10 - proc TrimReply { str } { set reply [string trim $str " :"] return $reply diff --git a/site_ansto/instrument/sans/quokka_configuration.tcl b/site_ansto/instrument/sans/quokka_configuration.tcl index 8b1b53f5..1cd785c9 100644 --- a/site_ansto/instrument/sans/quokka_configuration.tcl +++ b/site_ansto/instrument/sans/quokka_configuration.tcl @@ -1,5 +1,5 @@ -# $Revision: 1.6 $ -# $Date: 2007-10-23 02:42:52 $ +# $Revision: 1.7 $ +# $Date: 2008-05-30 00:26:56 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by: $Author: ffr $ @@ -17,26 +17,38 @@ source server_config.tcl ######################################## # INSTRUMENT SPECIFIC CONFIGURATION +source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(nexus)/nxscripts.tcl +fileeval $cfPath(parameters)/parameters.tcl fileeval $cfPath(velsel)/velsel.tcl fileeval $cfPath(motors)/motor_configuration.tcl - -######## -# Parameters set above the restore command will be clobbered by -# the values in the status.tcl file -restore - fileeval $cfPath(plc)/plc.tcl fileeval $cfPath(optics)/optics.tcl fileeval $cfPath(counter)/counter.tcl fileeval $cfPath(hmm)/hmm_configuration.tcl -fileeval $cfPath(nexus)/nxscripts.tcl +fileeval $cfPath(hmm)/detector.tcl fileeval $cfPath(scan)/scan.tcl -source $cfPath(hipadaba)/hipadaba_configuration.tcl +fileeval $cfPath(commands)/commands.tcl +fileeval $cfPath(anticollider)/anticollider.tcl source gumxml.tcl + +######## +# Parameters set above the restore command will be clobbered by +# the values in the status.tcl file +# BIG WARNING: DON'T PUT 'restore' IN A CATCH BLOCK BECAUSE IT RETURNS +# AN ERROR IF THERE IS NO ../log/status.tcl FILE. +restore + ::histogram_memory::initialize MakeStateMon hmscan -fileeval extraconfig.tcl +if [file exists extraconfig.tcl] { + fileeval extraconfig.tcl +} else { + clientput "extraconfig.tcl not found. continueing" +} + +::anticollider::init server_set_sobj_attributes buildHDB instrument_dictionary diff --git a/site_ansto/instrument/sans/script_validator_ports.tcl b/site_ansto/instrument/sans/script_validator_ports.tcl new file mode 100644 index 00000000..5d41e8ca --- /dev/null +++ b/site_ansto/instrument/sans/script_validator_ports.tcl @@ -0,0 +1,4 @@ +set quieckport quieck-val-quokka +set serverport server-val-quokka +set interruptport interrupt-val-quokka +set telnetport telnet-val-quokka diff --git a/site_ansto/instrument/server_config.tcl b/site_ansto/instrument/server_config.tcl index 32faa96b..00cd4789 100644 --- a/site_ansto/instrument/server_config.tcl +++ b/site_ansto/instrument/server_config.tcl @@ -1,30 +1,104 @@ # SICS common configuration -# $Revision: 1.32 $ -# $Date: 2007-11-05 02:09:06 $ +# $Revision: 1.33 $ +# $Date: 2008-05-30 00:26:54 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ #set sicsroot /usr/local/sics -set sicsroot ../ +VarMake opal_simulation Text internal +opal_simulation false + +VarMake detector_simulation Text internal +detector_simulation false + +VarMake hmm_simulation Text internal +hmm_simulation false + +VarMake environment_simulation Text internal +environment_simulation false + +VarMake counter_simulation Text internal +counter_simulation false + +VarMake motor_simulation Text internal +motor_simulation false + +VarMake chopper_simulation Text internal +chopper_simulation false + +VarMake plc_simulation Text internal +plc_simulation false + +VarMake sics_fullsimulation Text internal + +source util/utility.tcl +proc syncbackup {file} { + backup motorSave + backup $file + backup motorSave +} +publish syncbackup Spy +if {[info exists env(SICS_SIMULATION)] != 1} { + set sicsroot ../ + source sics_ports.tcl + sics_fullsimulation false +} else { + switch $env(SICS_SIMULATION) { + "full" { + set sicsroot ../ + source sics_ports.tcl + sics_fullsimulation true + } + "script_validator" { + VarMake sics_script_validator Text internal + sics_script_validator true + set sicsroot ../script_validator/ + source script_validator_ports.tcl + sics_fullsimulation true + MakeSync localhost [expr [get_portnum $serverport ]-10] spy 007 ../log/syncfile.tcl + } + default { + error "ERROR: SICS_SIMULATION must be full or script_validator, not $env(SICS_SIMULATION)" + } + } +} + +if {[string trim [lindex [split [sics_fullsimulation] =] 1]] == "true"} { + opal_simulation true + detector_simulation true + hmm_simulation true + counter_simulation true + environment_simulation true + motor_simulation true + chopper_simulation true + plc_simulation true +} + set cfParent config + +#WARNING Make sure there are no spaces after the back-slashes array set cfPath [list\ -motors $cfParent/motors\ -optics $cfParent/optics\ -counter $cfParent/counter\ -chopper $cfParent/chopper\ -hmm $cfParent/hmm\ -scan $cfParent/scan\ -velsel $cfParent/velsel\ -nexus $cfParent/nexus\ -hipadaba $cfParent/hipadaba\ -plc $cfParent/plc] +parameters $cfParent/parameters\ +anticollider $cfParent/anticollider\ +motors $cfParent/motors\ +optics $cfParent/optics\ +counter $cfParent/counter\ +chopper $cfParent/chopper\ +environment $cfParent/environment\ +hmm $cfParent/hmm\ +scan $cfParent/scan\ +velsel $cfParent/velsel\ +nexus $cfParent/nexus\ +hipadaba $cfParent/hipadaba\ +plc $cfParent/plc\ +commands $cfParent/commands\ +] ServerOption LogFileBaseName $sicsroot/log/serverlog installprotocolhandler -source util/utility.tcl ServerOption statusfile $sicsroot/log/status.tcl ServerOption RedirectFile $sicsroot/log/stdout @@ -41,7 +115,7 @@ SicsUser manager ansto 1 SicsUser user sydney 2 SicsUser spy 007 3 -MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber +MakeDataNumber SicsDataNumber $sicsroot/DataNumber #Instrument specific configs must set the Instrument variable ::utility::mkVar SicsDataPrefix Text internal @@ -51,13 +125,13 @@ SicsDataPrefix [SplitReply [Instrument]] SicsDataPostFix nx.hdf -::utility::mkVar sics_release Text internal +::utility::mkVar sics_release Text manager sics_release true entry true true set tmpstr [string map {"$" ""} {$Name: not supported by cvs2svn $}] sics_release [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_release lock ::utility::mkVar sics_revision_num Text internal -set tmpstr [string map {"$" ""} {$Revision: 1.32 $}] +set tmpstr [string map {"$" ""} {$Revision: 1.33 $}] sics_revision_num [lindex $tmpstr [expr [llength $tmpstr] - 1]] sics_revision_num lock @@ -65,7 +139,9 @@ sics_revision_num lock SicsDataPath $sicsroot/data/ SicsDataPath lock ::utility::mkVar Title Text user title true experiment true true -::utility::mkVar Sample Text user description true sample true true +::utility::mkVar SampleDescription Text user description true sample true true +::utility::mkVar SampleName Text user name true sample true true +::utility::mkVar SampleTitle Text user short_title true sample true true ::utility::mkVar User Text user name true user true true ::utility::mkVar Email Text user email true user true true ::utility::mkVar Phone Text user phone true user true true @@ -75,38 +151,11 @@ MakeDrive exe batchpath ../batch exe syspath ../batch -::utility::mkVar detector_type Text internal -::utility::mkVar detector_description Text internal ::utility::mkVar dataFileName Text user file_name true experiment true true -::utility::mkVar hmm_simulation Text internal -hmm_simulation false - -::utility::mkVar counter_simulation Text internal -counter_simulation false - -::utility::mkVar motor_simulation Text internal -motor_simulation false - -::utility::mkVar chopper_simulation Text internal -chopper_simulation false - -::utility::mkVar plc_simulation Text internal -plc_simulation false - -::utility::mkVar sics_fullsimulation Text internal -sics_fullsimulation false - -if {[SplitReply [sics_fullsimulation]] == "true"} { - hmm_simulation true - counter_simulation true - motor_simulation true - chopper_simulation true - plc_simulation true -} - proc server_set_sobj_attributes {} { + if [ catch { motor_set_sobj_attributes ::utility::set_motor_attributes ::utility::set_histomem_attributes @@ -119,4 +168,20 @@ proc server_set_sobj_attributes {} { ## TODO move the following to the new ansto gumxml.tcl sicslist setatt getgumtreexml privilege internal clientput "serverport [get_portnum $::serverport]" + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +# Make the opal status info object +set sim_mode [SplitReply [opal_simulation]] +if {$sim_mode == "true"} { + proc opal {args} { + clientput "REACTOR POWER = 20 (woohoooooo!!!)" + } + publish opal user +} else { + MakeAsyncQueue lss_chan LSS 137.157.204.67 31250 + MakeLSSMonitor opal lss_chan 0 } diff --git a/site_ansto/instrument/util/check/README.TXT b/site_ansto/instrument/util/check/README.TXT new file mode 100644 index 00000000..28763fd5 --- /dev/null +++ b/site_ansto/instrument/util/check/README.TXT @@ -0,0 +1,33 @@ +listsobj motor { klass { detector}} +listsobj motor {-not klass { detector}} +listsobj motor { type {-not @any}} +listsobj motor { type @any} +listsobj motor { control false type @any} +listsobj motor { type @missing} +listsobj motor { control false type @missing} +listsobj motor { data true type {part instrument nxvgroup}} +listsobj motor { data true sicsdev @any type {part instrument nxvgroup}} +listsobj motor {-not data true sicsdev @any type {part instrument nxvgroup}} +listsobj motor {-not mutable {true false} privilege {spy user manager read_only internal} kind {command event hobj ilist script} drivable {true false} countable {true false} callback {true false} environment {true false} nxalias {text} units {alpha}} +listsobj motor {mutable {true false} } +listsobj motor {mutable {a true} } +listsobj sicsvariable {control false data false} +listnode / {sicsdev ::histogram_memory::y_pixel_offset} +listnode / {sicsdev ::histogram_memory::} +listnode / {sicsdev ::histogram_memory::*} +listnode / {sicsdev @any} +listnode / {control true type {command}} +listnode / {type {command}} +listnode / {type {-not command}} +listnode / {type {part instrument nxvgroup commandset}} +listnode / { data false type {part instrument nxvgroup}} +listnode / { data true sicsdev @any type {part instrument nxvgroup}} +listnode / {-not klass command} +listnode / { control false type @missing} +listnode / { data true type {part}} +listnode / {-not data true sicsdev @any type {part instrument nxvgroup}} +listnode /instrument/sample {-not mutable {true false} privilege {spy user manager read_only internal} kind {command event hobj ilist script} drivable {true false} countable {true false} callback {true false} environment {true false} nxalias {text} units {alpha}} +listnode / {data true sicsdev @any type @any} + +# To find which node the hmm has been added under do +listnode / {sicsdev hmm} diff --git a/site_ansto/instrument/util/check/check_hdb.tcl b/site_ansto/instrument/util/check/check_hdb.tcl new file mode 100644 index 00000000..f9b1e889 --- /dev/null +++ b/site_ansto/instrument/util/check/check_hdb.tcl @@ -0,0 +1,40 @@ +## \file +# Must be loaded into an instance of SICS with fileeval +# eg +# fileeval tests/query_sics.tcl +fileeval util/check/query_sics.tcl +set hdb_prop_list { + {control data} {true false} +} +proc checknode {node} { + global hdb_prop_list + foreach {att v} $hdb_prop_list { + foreach a $att { + set query "$a @missing" + if {[query_propval $node $query]} { + clientput "$node: $a is missing" + continue + } + set query "$a \{$v\}" + if {![query_propval $node $query]} { + clientput "$node: $a should be one of ($v) not [::utility::hgetplainprop $node $a]" + } + } + } +} +proc checkhdb {{hpath "/"}} { + global hdb_prop_list + if {$hpath == "/"} { + foreach hp [hlist /] { + checknode /$hp + checkhdb /$hp + } + clientput OK + } else { + foreach hp [hlist $hpath] { + checknode $hpath/$hp + checkhdb $hpath/$hp + } + } +} +publish checkhdb user diff --git a/site_ansto/instrument/util/check/check_sobj.tcl b/site_ansto/instrument/util/check/check_sobj.tcl new file mode 100644 index 00000000..e43c20e2 --- /dev/null +++ b/site_ansto/instrument/util/check/check_sobj.tcl @@ -0,0 +1,38 @@ +fileeval util/check/query_sics.tcl +proc checksobj {} { + global sobj_sicstype_list + + foreach sicstype $sobj_sicstype_list { + global ${sicstype}_attlist + clientput "Check $sicstype" + foreach sobj [tolower_sicslist type $sicstype] { + array unset sobj_attarray + array set sobj_attarray [attlist $sobj] + + # Skip it if privilege is missing or set to "internal" + if {[info exists sobj_attarray(privilege)]} { + if {$sobj_attarray(privilege) == "internal"} { + continue + } + } else { + continue + } + + foreach {att v} [set ${sicstype}_attlist] { + foreach a $att { + set attlist "$a @missing" + if {[query_attval $sobj $attlist]} { + clientput "$sobj: $a is missing" + continue + } + set attlist "$a \{$v\}" + if {![query_attval $sobj $attlist]} { + clientput "$sobj: $a should be one of ($v) not [getatt $sobj $a]" + } + } + } + } + } +} + +publish checksobj user diff --git a/site_ansto/instrument/util/check/query_sics.tcl b/site_ansto/instrument/util/check/query_sics.tcl new file mode 100644 index 00000000..ce9ed879 --- /dev/null +++ b/site_ansto/instrument/util/check/query_sics.tcl @@ -0,0 +1,118 @@ +proc query_nameval {query nameval_list} { + if {[lindex $query 0] == "-not"} { + return [expr { ! [_query_nameval [lrange $query 1 end] $nameval_list] }] + } else { + return [_query_nameval $query $nameval_list] + } +} +proc _query_nameval {query nameval_list} { + array set proparr $nameval_list + foreach {prop val} $query { + if {[lindex $val 0] == "-not"} { + set test 0 + set val [lrange $val 1 end] + } else { + set test 1 + } + if {[info exists proparr($prop)]} { + if {$val == "@missing"} { + return 0 + } + if {$val == "@any"} { + continue + } + } else { + if {$val == "@missing"} { + continue + } else { + return 0 + } + } + switch $val { + "alpha" { + if {[string is alpha $proparr($prop)] == $test} { + continue + } else { + return 0 + } + } + "text" { + if {[string is wordchar $proparr($prop)] == $test} { + continue + } else { + return 0 + } + } + "print" { + if {[string is print $proparr($prop)] == $test} { + continue + } else { + return 0 + } + } + "float" { + if {[string is double $proparr($prop)] == $test} { + continue + } else { + return 0 + } + } + "int" { + if {[string is internal $proparr($prop)] == $test} { + continue + } else { + return 0 + } + } + default { + if {([lsearch $val $proparr($prop)] >= 0) == $test} { + continue + } else { + return 0 + } + } + } + } + return 1 +} + +proc query_propval {hp query} { + return [ query_nameval $query [::utility::hlistplainprop $hp] ] +} +proc query_attval {sobj query} { + return [ query_nameval $query [attlist $sobj] ] +} +## +# prop_list list of property name value pairs +# value can be a @any @missing a single value or a list optionally preceded by -not +# listnode / {data true sicsdev @missing type {-not part instrument nxvgroup}} +proc listnode {hpath prop_list} { + if {$hpath == "/"} { + foreach hp [hlist /] { + if [query_propval /$hp $prop_list] { + clientput "/$hp" + } + listnode /$hp $prop_list + } + } else { + foreach hp [hlist $hpath] { + if [query_propval $hpath/$hp $prop_list] { + clientput "$hpath/$hp" + } + listnode $hpath/$hp $prop_list + } + } +} + +proc listsobj {sicstype att_list} { + foreach sobj [sicslist type $sicstype] { + if [query_attval $sobj $att_list] { + clientput "$sobj" + } + } +} + +publish query_propval user +publish query_attval user +publish listnode user +publish listsobj user diff --git a/site_ansto/instrument/util/command.tcl b/site_ansto/instrument/util/command.tcl index eef0bd4b..26d3140b 100644 --- a/site_ansto/instrument/util/command.tcl +++ b/site_ansto/instrument/util/command.tcl @@ -21,7 +21,7 @@ proc command {acmdName arglist body} { # puts "cmdName: $cmdName" foreach {type_spec var} $arglist { lappend params $var - foreach {type domain} [split $type_spec :] {} + foreach {type domain} [split $type_spec "="] {} lappend ${cmdName}_param_list $var ${cmdName}_par_$var set sicsvar [lindex [set ${cmdName}_param_list] end] # Make var with priv=user so we can use sicslist on it @@ -41,9 +41,13 @@ proc command {acmdName arglist body} { } } else { sicslist setatt $sicsvar argtype $type - foreach {min max} [split $domain ,] {} - sicslist setatt $sicsvar min $min - sicslist setatt $sicsvar max $max + if [string match -nocase {*:*} $domain] { + foreach {min max} [split $domain :] {} + sicslist setatt $sicsvar min $min + sicslist setatt $sicsvar max $max + } else { + sicslist setatt $sicsvar values $domain + } } } sicslist setatt $sicsvar long_name $var diff --git a/site_ansto/instrument/util/dmc2280/ckmd5.sh b/site_ansto/instrument/util/dmc2280/ckmd5.sh new file mode 100755 index 00000000..1ce9a32d --- /dev/null +++ b/site_ansto/instrument/util/dmc2280/ckmd5.sh @@ -0,0 +1,13 @@ +#!/bin/sh +# Strip all horizontal and vertical whitespace from the galil controller programs +# and compare md5 sums. + +instrument=${HOSTNAME#ics1-} +i=1 +for f in controller*.md5 +do + name=`basename $f .md5` + echo -n "$name " + ./getDMCprog.tcl -host mc${i}-$instrument -port pmc${i}-$instrument |tr -d '[:space:]'|md5sum -c $f 2> /dev/null + let i++ +done diff --git a/site_ansto/instrument/util/dmc2280/mkmd5.sh b/site_ansto/instrument/util/dmc2280/mkmd5.sh new file mode 100755 index 00000000..9dd3cdcf --- /dev/null +++ b/site_ansto/instrument/util/dmc2280/mkmd5.sh @@ -0,0 +1,8 @@ +#!/bin/sh +# Strip all horizontal and vertical whitespace from the galil controller programs +# and generate md5 sums. +for f in controller*.txt +do + name=`basename $f .txt` + cat $f |tr -d '[:space:]'|md5sum > $name.md5 +done diff --git a/site_ansto/instrument/util/extra_utility.tcl b/site_ansto/instrument/util/extra_utility.tcl index 0694a93c..e0f89ab7 100644 --- a/site_ansto/instrument/util/extra_utility.tcl +++ b/site_ansto/instrument/util/extra_utility.tcl @@ -1,5 +1,72 @@ # Many of these functions are also useful in test and debug code # running on an external Tcl interpreter. +set errorInfo "" +set errorCode NONE +set errorContext "" +set callStack "" + +proc callinfo {args} { + if {$args == "errors"} { + set msg "ERROR CONTEXT\n$::errorContext\n\nCALLSTACK\n$::callStack" + } else { + set msg "CALLSTACK\n$::callStack" + } + return $msg +} +publish callinfo user + +# @brief Reset error information variables when entering a catch command +proc entercatch {args} { + uplevel { + global errorCode errorContext callStack + if {[info level] > 0} { + set errorCode NONE +# set errorContext "" +# set callStack "" + } + } +} + +# @brief Set the errorContext and build the callStack when leaving a catch command +# +# ::errorContext is set to ::errorInfo +# ::callStack is a stack of command calls showing the argument values +proc leavecatch {args} { + uplevel { + global callStack errorContext errorCode errorInfo + if {[info level] > 0} { + if {$errorCode=="NONE"} { + set callStack "" + set errorContext "" + } else { + append callStack "\t[info level 0]\n" + } + } + } +} + +# @brief Set the ::errorCode to "ERROR" when ::errorInfo is modified. +# +# NOTE\n +# Tcl always sets errorCode=NONE when there is no additional information\n +# about an error, as well as when there is no error! However when a command\n +# returns with an error it always writes to errorInfo. +proc errorInfowrite {args} { + uplevel { + global errorContext errorCode errorInfo + if {[info level] > 0} { + if {$errorInfo != ""} { + append errorContext $errorInfo + set errorCode ERROR + } + } + } +} + +trace add variable errorInfo write errorInfowrite +trace add execution catch enter entercatch +trace add execution catch leave leavecatch + # LIST FUNCTIONS proc head {args} {lindex [join $args] 0} @@ -66,8 +133,13 @@ proc isoneof {element setb} { # Returns 'sicslist' output in lower case, this may be useful in macros. # This function is used a lot in the hdbbuilder proc tolower_sicslist {args} { + if [ catch { set result [eval sicslist $args] return [string tolower $result]; + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } # \brief Enables or disables the debug_msg command diff --git a/site_ansto/instrument/util/motor_utility.tcl b/site_ansto/instrument/util/motor_utility.tcl index 1e9aba5c..dfe60d90 100644 --- a/site_ansto/instrument/util/motor_utility.tcl +++ b/site_ansto/instrument/util/motor_utility.tcl @@ -1,9 +1,9 @@ # Some useful functions for SICS motor configuration. -# $Revision: 1.1 $ -# $Date: 2007-10-29 02:58:12 $ +# $Revision: 1.2 $ +# $Date: 2008-05-30 00:26:57 $ # Author: Douglas Clowes (dcl@ansto.gov.au) -# Last revision by $Author: dcl $ +# Last revision by $Author: ffr $ # Functions for the slit motors (echidna, wombat, platypus, ...) # @@ -60,10 +60,12 @@ sicslist setatt $vm1 units $aunits sicslist setatt $vm1 klass aperture sicslist setatt $vm1 long_name $vm1_name sicslist setatt $vm1 group $agroup +sicslist setatt $vm1 hdbchain $m1,$m2 sicslist setatt $vm2 units $aunits sicslist setatt $vm2 klass aperture sicslist setatt $vm2 long_name $vm2_name sicslist setatt $vm2 group $agroup +sicslist setatt $vm2 hdbchain $m1,$m2 } # Functions for motors with defined positions (quokka, platypus) @@ -106,6 +108,7 @@ proc make_coll_motor_1 { vm1 vm1_name pm1 aunits } { sicslist setatt $vm1 units $aunits sicslist setatt $vm1 klass collimator sicslist setatt $vm1 long_name $vm1_name + sicslist setatt $vm1 hdbchain $pm1 } proc make_coll_motor_2 { vm1 vm1_name pm1 pm2 aunits } { @@ -118,6 +121,7 @@ proc make_coll_motor_2 { vm1 vm1_name pm1 pm2 aunits } { sicslist setatt $vm1 units $aunits sicslist setatt $vm1 klass collimator sicslist setatt $vm1 long_name $vm1_name + sicslist setatt $vm1 hdbchain $pm1,$pm2 } diff --git a/site_ansto/instrument/util/utility.tcl b/site_ansto/instrument/util/utility.tcl index 36b36ecb..cd96e0e8 100644 --- a/site_ansto/instrument/util/utility.tcl +++ b/site_ansto/instrument/util/utility.tcl @@ -1,25 +1,235 @@ # Some useful functions for SICS configuration. -# $Revision: 1.10 $ -# $Date: 2007-11-05 02:11:41 $ +# $Revision: 1.11 $ +# $Date: 2008-05-30 00:26:57 $ # Author: Ferdi Franceschini (ffr@ansto.gov.au) # Last revision by $Author: ffr $ source util/extra_utility.tcl source util/motor_utility.tcl source util/command.tcl +namespace eval environment { } + # @brief Return the number of sensors for a given environment object + proc ::environment::getnumsensors {sobj} { + if [ catch { + if {[SplitReply [environment_simulation]]=="true"} { + set ns [getatt $sobj numsensors] + return $ns + } else { + set ns [SplitReply [$sobj numsensors]] + return $ns + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } + } + + # @brief Return the list of sensor names for the given environment object + proc ::environment::getsensorlist {sobj} { + if [ catch { + if {[SplitReply [environment_simulation]]=="true"} { + set sl [ split [getatt $sobj sensorlist] , ] + return $sl + } else { + set sl [ split [SplitReply [$sobj sensorlist]] , ] + return $sl + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } + } + + # @brief Create SICS variables for the environment controller + # sensor readings which we use for feedback in the GumTree interface. + # + # These sensor-reading variables will be attached to the hdb tree + # and updated at regular intervals + # + # @param sobj, SICS environment controller object name. + # @return A space separated list of the sensor-reading variable names. +proc ::environment::mkSensors {sobj} { + if [ catch { + set sim_mode [SplitReply [environment_simulation]] + set sensors [::environment::getsensorlist $sobj] + foreach sensor $sensors { + proc ::environment::${sobj}_${sensor} {} [ subst -nocommands { + if {$sim_mode == "true"} { + return [expr rand()] + } else { + return [SplitReply [$sobj $sensor]] + } + }] + set ss_script ::environment::${sobj}_${sensor} + publish $ss_script user + sicslist setatt $ss_script access read_only + sicslist setatt $ss_script privilege internal + sicslist setatt $ss_script long_name value + sicslist setatt $ss_script dtype float + sicslist setatt $ss_script dlen 1 + sicslist setatt $ss_script data true + sicslist setatt $ss_script nxsave true + sicslist setatt $ss_script mutable true + sicslist setatt $ss_script control true + sicslist setatt $ss_script units [getatt $sobj units] + sicslist setatt $ss_script klass sensor + sicslist setatt $ss_script kind script + append sensorlist [subst { + $sensor { + macro { $ss_script } + } + }] + } + return $sensorlist + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +# @brief Create the information structure +# +# @param sobj, name of SICS environment controller object +# @param paramlist a nested list of parameters and their attributes\n +# eg, {heateron {priv user} range {priv manager}}\n +# this adds the heateron and range parameters with their access privilege.\n +# Note: The priv attribute is mandatory. +# +# eg ::environment::mkenvinfo tc1 {heateron {priv user} range {priv manager}} +proc ::environment::mkenvinfo {sobj paramlist} { + lappend paramlist controlsensor {priv user} + if [ catch { + # Create polling procedure to update hdb sensor data nodes. +# proc ::environment::${sobj}_poll [subst {{sobj $sobj}}] { +# set sim_mode [SplitReply [environment_simulation]] +# set sensors [::environment::getsensorlist $sobj] +# if {$sim_mode == "true"} { +# foreach ss $sensors { +# ${sobj}_${ss} [expr rand()] +# } +# } else { +# foreach ss $sensors { +# ${sobj}_${ss} [SplitReply [$sobj $ss]] +# } +# } +# } + + set setpoint_script ::environment::${sobj}_setpoint + proc $setpoint_script [subst {{val "@none"} {_sobj $sobj}}] { + if [catch { + if {[SplitReply [environment_simulation]]=="true"} { + if {$val=="@none"} { + return [SplitReply [${_sobj}]] + } else { + ${_sobj} $val + } + } else { + if {$val=="@none"} { + return [SplitReply [${_sobj} setpoint]] + } else { + ${_sobj} $val + } + } + } message ] { + if {$::errorCode == "NONE"} {return $message} + return -code error $message + } + } + publish $setpoint_script user + sicslist setatt $setpoint_script privilege internal + sicslist setatt $setpoint_script access rw + sicslist setatt $setpoint_script long_name setpoint + sicslist setatt $setpoint_script dtype float + sicslist setatt $setpoint_script dlen 1 + sicslist setatt $setpoint_script data false + sicslist setatt $setpoint_script nxsave false + sicslist setatt $setpoint_script mutable false + sicslist setatt $setpoint_script control true + sicslist setatt $setpoint_script units K + sicslist setatt $setpoint_script klass sensor + sicslist setatt $setpoint_script kind script + lappend env_macrolist $setpoint_script + + foreach {param attlist} $paramlist { + array set atthash $attlist + proc ::environment::${sobj}_${param} [subst {{val "@none"} {_sobj $sobj} {_param $param}}] { + if {[SplitReply [environment_simulation]]=="true"} { + if {$val=="@none"} { + return [getatt ${_sobj} ${_param}] + } else { + sicslist setatt ${_sobj} ${_param} $val + } + } else { + if {$val=="@none"} { + return [SplitReply [${_sobj} ${_param}]] + } else { + ${_sobj} ${_param} $val + } + } + } + set ctrlss_script ::environment::${sobj}_${param} + publish $ctrlss_script user + sicslist setatt $ctrlss_script long_name ${param} + sicslist setatt $ctrlss_script kind script + sicslist setatt $ctrlss_script privilege $atthash(priv) + sicslist setatt $ctrlss_script klass @none + sicslist setatt $ctrlss_script data false + sicslist setatt $ctrlss_script control true + sicslist setatt $ctrlss_script nxsave false + sicslist setatt $ctrlss_script dtype "text" + sicslist setatt $ctrlss_script dlen 10 + sicslist setatt $ctrlss_script access rw + lappend env_macrolist $ctrlss_script + } + + # Create environment information structure for hdb + set env_name [getatt $sobj environment_name] + eval [subst { + proc ::${sobj}_dict {} { + return { + NXenvironment { + $env_name { + macro {$env_macrolist} + NXsensor { + [::environment::mkSensors $sobj] + } + } + } + } + } + } ] + publish ::${sobj}_dict mugger + sicslist setatt ::${sobj}_dict kind hdb_subtree + sicslist setatt ::${sobj}_dict klass environment + sicslist setatt ::${sobj}_dict privilege user + sicslist setatt ::${sobj}_dict long_name tempone + sicslist setatt ::${sobj}_dict data true + sicslist setatt ::${sobj}_dict control true + sicslist setatt ::${sobj}_dict nxsave true + sicslist setatt ::${sobj}_dict sdsinfo ::nexus::environment_controller::sdsinfo + sicslist setatt ::${sobj}_dict savecmd ::nexus::environment_controller::save + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} # Returns attribute name and value proc getatt {sicsobj att} { if [catch { lindex [split [tolower_sicslist $sicsobj $att] =] 1 } reply ] { - return -code error "[info level 0]\n$reply" + return -code error $reply } else { return $reply } } +# @brief Determine if a SICS object implements the drivable interface. +# +# @param sicsobj, Name of a SICS object +# @return 1 if drivable, otherwise 0 proc is_drivable {sicsobj} { if [catch { getatt $sicsobj drivable @@ -105,14 +315,21 @@ namespace eval utility { variable sics_port set base_port 60000 set currbase $base_port + set valbase_port 60010 + set currvalbase $valbase_port foreach inst $instrument_names { array set sics_port [list\ telnet-$inst $currbase\ interrupt-$inst [expr {$currbase+1}]\ server-$inst [expr {$currbase+2}]\ quieck-$inst [expr {$currbase+3}]\ + telnet-val-$inst $currvalbase\ + interrupt-val-$inst [expr {$currvalbase+1}]\ + server-val-$inst [expr {$currvalbase+2}]\ + quieck-val-$inst [expr {$currvalbase+3}]\ ] set currbase [expr {$currbase+100}] + set currvalbase [expr {$currvalbase+100}] } namespace export instname; namespace export get_portnum; @@ -185,6 +402,18 @@ proc echo {args} { clientput $args } +# @brief Check if a SICS object or Tcl object exists. +# +# @param obj, name of a SICS or Tcl object +# @return 1 if obj exists otherwise 0 +proc ::utility::obj_exists {obj} { + if { [sicslist match $obj ] != "" || [info exists $obj] } { + return 1 + } else { + return 0 + } +} + proc ::utility::set_sobj_attributes {} { sicslist setatt getinfo privilege internal sicslist setatt setpos privilege internal @@ -235,27 +464,48 @@ proc ::utility::set_motor_attributes {} { } } proc ::utility::set_envcontrol_attributes {} { - foreach ec [sicslist type environment_controller] { - sicslist setatt $ec kind hobj - sicslist setatt $ec data true - sicslist setatt $ec control true - sicslist setatt $ec nxsave true - sicslist setatt $ec privilege user - sicslist setatt $ec nxalias $ec - sicslist setatt $ec mutable true - sicslist setatt $ec klass sample + if [ catch { + foreach ec [sicslist type environment_controller] { + #TODO call mk + array unset sobjatt + array set sobjatt [attlist $ec] + sicslist setatt $ec kind hobj + sicslist setatt $ec data true + sicslist setatt $ec control false + sicslist setatt $ec nxsave true + sicslist setatt $ec privilege user + sicslist setatt $ec nxalias $ec + sicslist setatt $ec mutable true + if {[info exists sobjatt(klass)] == 0} { + sicslist setatt $ec klass environment + } + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message } } # Retuns plain value of hdb node property proc ::utility::hgetplainprop {hpath prop} { - return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ] + if [ catch { + return [string trim [lindex [split [hgetprop $hpath $prop] =] 1] ] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } proc ::utility::hlistplainprop {hpath} { - return [string trim [join [split [hlistprop $hpath] =] ]] + if [ catch { + return [string trim [join [split [hlistprop $hpath] =] ]] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } } proc ::utility::GetUID {userName} { + if [ catch { set fh [open /etc/passwd r] while {[gets $fh tmpName] != -1} { if {1 == [regexp "^$userName:" $tmpName]} { @@ -263,7 +513,12 @@ proc ::utility::GetUID {userName} { return [lindex [split $tmpName :] 2] } } - close $fh error "\"$userName\" not found in /etc/passwd" + close $fh + error "\"$userName\" not found in /etc/passwd" +} message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message +} } ##\brief Determine if list l1 begins with list l2 @@ -284,6 +539,7 @@ proc lstarts_with {l1 l2} { proc ::utility::get_portnum {port} { global env tcl_platform variable sics_port + if [ catch { if [string is integer $port] { return $port } else { @@ -295,6 +551,10 @@ proc ::utility::get_portnum {port} { return [portnum $port] } } +} message] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message +} } ## @@ -307,6 +567,202 @@ proc ::utility::callstack {} { } } +## +# @brief Splits "args" list into a head and tail, useful for scripts +# where the first argument is a subcommand followed by an argument list. +# +# Usage: foreach {opt arglist} [::utility::get_opt_arglist $args] {} +proc ::utility::get_opt_arglist {args} { + if [ catch { + if {[llength $args] == 1} { + set arguments [lindex $args 0] + } else { + set arguments $args + } + set opt [lindex $arguments 0] + set arglist [lrange $arguments 1 end] + return [list $opt $arglist] + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} +# These functions handle a special nested list of name value pairs +# which can be represented as an XML element. +# Examples +# To make a new table you can just create an empty list, eg +# set newtable [list ] +# You can then fill your new table using tabset, eg +# ::utility::tabset newtable a/b/c {values {1 2 3}} +# newtable looks like this +# a {b {c {values {1 2 3}}}} +# +# NOTE you can generate the previous table anonymously with +# ::utility::tabmktable {a b c values {1 2 3}} +# -> a {b {c {values {1 2 3}}}} +# +# ::utility::tabmktable {NXgeometry geometry NXshape sicsvariable {shape size}} +# returns +# NXgeometry {geometry {NXshape {sicsvariable {shape size}}}} +# ::utility::tabxml hmm_table SAT +# ::utility::tabset hmm_table SAT/SPLIT/_ATTLIST_/MIDPOINT 256 +# ::utility::tabget hmm_table SAT/SPLIT/_ATTLIST_/MIDPOINT +# ::utility::tabxml hmm_table SAT +# ::utility::tabget hmm_table OAT/_DATA_/T_MAX + + +# @brief Create a keyed list from a flat list. +# This is useful for inserting a subtable for a new branch. +# The branchpath is expressed as a list, ie a/b/c -> {a b c} +# +# @param flatlist eg {a b c values {1 2 3}} +# @return a keyed list, eg a {b {c {values {1 2 3}}}} +proc ::utility::tabmktable {flatlist} { + if [ catch { + if {[llength $flatlist] <= 2} { + return $flatlist + } + set el [lindex $flatlist 0] + set table [list $el \$subtable ] + foreach el [lrange $flatlist 1 end-2] { + set subtable [list $el \$subtable] + set table [subst $table] + } + set subtable [lrange $flatlist end-1 end] + set table [subst $table] + return $table + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +# If some component of the path doesn't exist then return +# a list of indices up to the invalid step. Note if the +# first step doesn't exist this returns nothing which is a +# valid argument to lset and lindex representing the entire list +proc ::utility::tabindices {itable tpath} { + if [ catch { + upvar $itable table + set pathlist [split $tpath /] + set subtable $table + set indices "" + foreach element $pathlist { + set datindex [expr 1+[lsearch $subtable $element]] + if {$datindex==0} { break } + lappend indices $datindex + set subtable [lindex $subtable $datindex] + } + return $indices + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +proc ::utility::tabdel {itable tpath} { + if [ catch { + upvar $itable table + set indices [::utility::tabindices table $tpath] + if {[llength $indices] != [llength [split $tpath "/"]]} { + return + } + set subtabpos [lrange $indices 0 end-1] + set subtable [lindex $table $subtabpos] + set datindex [lindex $indices end] + set subtable [lreplace $subtable $datindex $datindex] + incr datindex -1 + set subtable [lreplace $subtable $datindex $datindex] + lset table $subtabpos $subtable + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +proc ::utility::tabget {itable tpath} { + upvar $itable table + set indices [::utility::tabindices table $tpath] + if {[llength $indices] == [llength [split $tpath "/"] ]} { + return [lindex $table $indices] + } else { + return + } +} + +proc ::utility::tabset {itable tpath val} { + if [ catch { + upvar $itable table + set pathlist [split $tpath /] + set indices [::utility::tabindices table $tpath] + if {[llength $indices] == [llength $pathlist]} { + lset table $indices $val + } else { + set subtable [lindex $table $indices] + if {[llength $val] > 1} { + set val [list $val] + } + set plist [ concat [lrange $pathlist [llength $indices] end] $val ] + set subtable [concat $subtable [::utility::tabmktable $plist]] + lset table $indices $subtable + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +proc ::utility::tabxml {itable tag} { + if [ catch { + upvar $itable table + set subtable [::utility::tabget table $tag] + set attributes [::utility::tabget table $tag/_ATTLIST_] + set att_text "" + foreach {att attval} $attributes { + append att_text "\n$att=\"$attval\"" + } + set elements [::utility::tabget table $tag/_ELEMENTS_] + foreach el $elements { + append content "\n[::utility::tabxml subtable $el]" + } + append content [::utility::tabget table $tag/_CONTENT_] + if {[string trim $att_text] == "" && [string trim $content] == ""} { + return + } else { + return "<$tag $att_text>\n$content\n" + } + } message ] { + if {$::errorCode=="NONE"} {return $message} + return -code error $message + } +} + +namespace eval ::utility::macro {} +## +# @brief Construct a 'getset' kind of macro. A getset macro +# will be added automatically to the hdb tree and its return +# value will be available for saving. +proc ::utility::macro::getset {type name arglist body} { + proc ::$name $arglist [subst { + $body + }] + + publish $name user + if {$arglist == ""} { + sicslist setatt $name access read_only + } + sicslist setatt $name privilege manager + sicslist setatt $name dtype $type + sicslist setatt $name dlen 1 + sicslist setatt $name data true + sicslist setatt $name nxsave true + sicslist setatt $name mutable true + sicslist setatt $name control true + sicslist setatt $name klass @none + sicslist setatt $name kind getset + sicslist setatt $name savecmd ::nexus::macro::getset_save + sicslist setatt $name sdsinfo ::nexus::macro::getset_sdsinfo +} namespace import ::utility::*; Publish getinfo spy Publish setpos user diff --git a/site_ansto/ls340.c b/site_ansto/ls340.c new file mode 100644 index 00000000..b44bccaf --- /dev/null +++ b/site_ansto/ls340.c @@ -0,0 +1,1319 @@ +/*------------------------------------------------------------------------- + LS340 - LAKESHORE340 + Support for the Lakeshore 340 Temperature Controller + + The meaning and working of the functions defined is as desribed for a + general environment controller. + + Adapted by Rodney Davies from orhvps code written by: + Douglas Clowes, December 2007 + + Copyright: + + Labor fuer Neutronenstreuung + Paul Scherrer Institut + CH-5423 Villigen-PSI + + + The authors hereby grant permission to use, copy, modify, distribute, + and license this software and its documentation for any purpose, provided + that existing copyright notices are retained in all copies and that this + notice is included verbatim in any distributions. No written agreement, + license, or royalty fee is required for any of the authorized uses. + Modifications to this software may be copyrighted by their authors + and need not follow the licensing terms described here, provided that + the new terms are clearly indicated on the first page of each file where + they apply. + + IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY + FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY + DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + + THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE + IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE + NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR + MODIFICATIONS. + ---------------------------------------------------------------------------- + */ + +#include "ls340.h" +#include "sics.h" +#include "asyncqueue.h" +#include "nwatch.h" +#include "fsm.h" +#include "anstoutil.h" +#include +#include +#include + +#include +#include +#include + + +#define CMDLEN 64 +#define LS340_ERR_NONE (0) +#define LS340_ERR_LOCKED (-1) +#define LS340_ERR_RANGE (-2) + +#define NUM_INPUT_SENSORS 10 /* Maximum Number of Input Sensors */ + +char *strcasestr(const char *hay, const char *needle); + +/* Note: data structure supports Lakeshore 340 with 10101010101010101010 sensor inputs and 2 PID Loops */ +typedef struct ls340_s { + pEVControl controller; + int iPidLoop; /* PID Loop number 1..2 */ + int iCtrlSens; /* control sensor (this is the index in the list below, not the Lakeshore sensor number) 0..NUM_INPUT_SENSORS-1 */ + char cCtrlSensName[3]; /* control sensor name eg: A1, B, C, etc */ + char cValidSensors[NUM_INPUT_SENSORS][3]; /* list of valid sensors for this pid loop eg: A, A1, B4, C, D etc*/ + float fSensorValues[NUM_INPUT_SENSORS]; /* each valid sensor value */ + int iNumSensors; /* number of input sensors */ + float fSetPoint; /* setpoint temperature of control loop */ + int iError; /* error code */ + float fSetPointLimit; /* Setpoint temperature limit */ + float fPosSlope; /* Positive Slope value */ + float fNegSlope; /* Negative Slope value */ + int iMaxCurrent; /* Maximum Current on output */ + int iMaxRange; /* Heater Range 0..5 */ + int iRange; /* Heater Range 0..5 (0 being off) */ + int iHeaterStatus; /* heater status - 1 - on, 0 - off */ + float fValue; /* current temperature of control sensor in degrees K */ + float fTarget; /* requested target temperature */ + int iSettleTime; /* settling time (sec) */ + float fTolerance; /* settline tolerance level 0..100 */ + bool isLocked; /* changes no longer permitted */ + unsigned long ulIdleDelay; /* idle timer timeout duration in milliseconds */ + unsigned long ulIdlePollRate; /* idle timer timeout duration in milliseconds */ + unsigned long ulMonitorPollRate; /* Monitoring sensor polling cycle duration in milliseconds */ + unsigned long ulMonitorDelay; /* Monitoring timer timeout duration in milliseconds */ + char* name; + pAsyncUnit asyncUnit; + StateMachine fsm; + pNWTimer state_timer; /**< state timer */ +} LS340Driv, *pLS340Driv; + +static int LS340GetValue( pEVDriver self, float* fPos); +static int LS340SetValue( pEVDriver self, float fPos); +static int LS340Send(pEVDriver self, char *pCommand, char *pReply, int iLen); +static int LS340Error(pEVDriver self, int *iCode, char *error, int iErrLen); +static int LS340Fix(pEVDriver self, int iError); +static int LS340Init(pEVDriver self); +static int LS340Close(pEVDriver self); +static void LS340KillPrivate(void *pData); +static void LS340Notify(void* context, int event); + +/* get the index in the valid sensors list of a given sensor name */ +static int getSensorIndex(pLS340Driv priv, char sname[]) { + + int i; + + for (i = 0; i < priv->iNumSensors; i++) { + if (strcmp(priv->cValidSensors[i], sname) == 0) + return i; + } + + return -1; +} + +static int LS340_SendCmd(pLS340Driv self, + char* command, + int cmd_len, + AsyncTxnHandler callback) +{ + pStateMachine sm = &self->fsm; + return AsyncUnitSendTxn(self->asyncUnit, + command, cmd_len, + callback, sm, CMDLEN); +} + +/** + * \brief Sends a command and waits for a response + * + * \param self motor data + * \param cmd command to send + * \param reply space to return response + * \return + */ +static int LS340_SendReceive(pLS340Driv self, + char *cmd, + int cmd_len, + char* reply, + int *rep_len) { + int status; + + status = AsyncUnitTransact(self->asyncUnit, cmd, cmd_len, reply, rep_len); + + if (status != 1) { + return FAILURE; + } + + return OKOK; +} + +static void LS340State_Unknown(pStateMachine sm, pEvtEvent event); +static void LS340State_Idle(pStateMachine sm, pEvtEvent event); +static void LS340State_Raising(pStateMachine sm, pEvtEvent event); +static void LS340State_Lowering(pStateMachine sm, pEvtEvent event); + +static void str_n_cat(char* s1, int len, const char* s2) { + int i = strlen(s1); + const char* p = s2; + while (i < len - 3 && *p) { + if (*p == '\r') { + s1[i++] = '\\'; + s1[i++] = 'r'; + ++p; + } + else if (*p == '\n') { + s1[i++] = '\\'; + s1[i++] = 'n'; + ++p; + } + else + s1[i++] = *p++; + } + s1[i] = '\0'; +} + +static const char* state_name(StateFunc func) +{ + if (func == NULL) return ""; + if (func == LS340State_Unknown) return "LS340State_Unknown"; + if (func == LS340State_Idle) return "LS340State_Idle"; + if (func == LS340State_Raising) return "LS340State_Raising"; + if (func == LS340State_Lowering) return "LS340State_Lowering"; + return ""; +} + +static const char* event_name(pEvtEvent event, char* text, int length) +{ + char line[1024]; + if (event == NULL) + return ""; + switch (event->event_type) { + case eStateEvent: + snprintf(text, length, "eStateEvent"); + return text; + case eTimerEvent: + snprintf(text, length, "eTimerEvent"); + return text; + case eMessageEvent: + snprintf(text, length, "eMessageEvent:"); + fsm_textify(event->event.msg.cmd->out_buf, + event->event.msg.cmd->out_len, + line, sizeof(line)); + str_n_cat(text, length, line); + str_n_cat(text, length, "|"); + fsm_textify(event->event.msg.cmd->inp_buf, + event->event.msg.cmd->inp_idx, + line, sizeof(line)); + str_n_cat(text, length, line); + return text; + case eCommandEvent: + /* TODO Command Events */ + snprintf(text, length, "eCommandEvent:unknown"); + return text; + case eTimeoutEvent: + snprintf(text, length, "eTimeoutEvent"); + return text; + default: + snprintf(text, length, ""); + return text; + } +} + +static void LS340State_Unknown(pStateMachine sm, pEvtEvent event) { + char cmd[CMDLEN]; + + pEVDriver driv = (pEVDriver) sm->context; + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + switch (event->event_type) { + case eStateEvent: + if (priv->state_timer) + NetWatchRemoveTimer(priv->state_timer); + priv->state_timer = NULL; + sprintf(cmd, "*IDN?"); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 1; + return; + case eTimerEvent: + priv->state_timer = NULL; + return; + case eMessageEvent: + do { + pAsyncTxn pCmd = event->event.msg.cmd; + pCmd->inp_buf[pCmd->inp_idx] = '\0'; + + if (sm->mySubState == 1) { + /* IDN Request */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + sprintf(line, "IDN: %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + } +#if 0 + sprintf(cmd, "RANGE 0"); /* ensure heater is off */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); +#endif + sprintf(cmd, "CSET %d, %s, 1, %d, 1", priv->iPidLoop, priv->cValidSensors[priv->iCtrlSens], priv->iHeaterStatus); + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + sprintf(cmd, "CLIMIT? %d", priv->iPidLoop); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + + sm->mySubState = 2; + + return; + } + + if (sm->mySubState == 2) { + /* Handle CLIMIT data */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + + sprintf(line, "CLIMIT (Unknown): %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + + sscanf(pCmd->inp_buf, "%f,%f,%f,%d,%d", &priv->fSetPointLimit, &priv->fPosSlope, &priv->fNegSlope, &priv->iMaxCurrent, &priv->iMaxRange); + } + + sprintf(cmd, "SETP? %d", priv->iPidLoop); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 3; + + return; + + } + if (sm->mySubState == 3) { + + /* Handle SETP? data */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + + sprintf(line, "SETP: %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + sscanf(pCmd->inp_buf, "%f", &priv->fSetPoint); + priv->fTarget = priv->fSetPoint; /* Set target and setpoints to current values from controller */ + } + + sprintf(cmd, "KRDG? %s", priv->cValidSensors[0]); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 4; + + return; + } + + if (sm->mySubState >= 4 && sm->mySubState <= priv->iNumSensors+3) { + /* KRDG? Requests */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + priv->fSensorValues[sm->mySubState-4] = atof(pCmd->inp_buf); + + if (sm->mySubState-4 == priv->iCtrlSens) { + priv->fValue = priv->fSensorValues[sm->mySubState-4]; + } + sprintf(line, "KRDG? (Unknown) sensor %s = %8.2f", priv->cValidSensors[sm->mySubState-4], priv->fSensorValues[sm->mySubState-4]); + SICSLogWrite(line, eStatus); + } + + if (sm->mySubState >= priv->iNumSensors+3) { + fsm_change_state(sm, LS340State_Idle); + return; + } + sm->mySubState++; + sprintf(cmd, "KRDG? %s", priv->cValidSensors[sm->mySubState-4]); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + + return; + } + } while (0); + return; + case eCommandEvent: + return; + case eTimeoutEvent: + sprintf(cmd, "*IDN?"); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 1; + return; + } + return; +} + +static void LS340State_Idle(pStateMachine sm, pEvtEvent event){ + + char cmd[CMDLEN]; + + pEVDriver driv = (pEVDriver) sm->context; + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + switch (event->event_type) { + case eStateEvent: + if (priv->state_timer) + NetWatchRemoveTimer(priv->state_timer); + + NetWatchRegisterTimer(&priv->state_timer, + priv->ulIdleDelay, + fsm_tmr_callback, sm); + + sprintf(cmd, "CLIMIT? %d", priv->iPidLoop); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 1; + + return; + + case eMessageEvent: + do { + pAsyncTxn pCmd = event->event.msg.cmd; + pCmd->inp_buf[pCmd->inp_idx] = '\0'; + + if (sm->mySubState == 1) { /* CLIMIT message */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + + sprintf(line, "CLIMIT (Idle): %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + + sscanf(pCmd->inp_buf, "%f,%f,%f,%d,%d", &priv->fSetPointLimit, &priv->fPosSlope, &priv->fNegSlope, &priv->iMaxCurrent, &priv->iMaxRange); + } + + sm->mySubState++; + + } else if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + /* KRDG? Requests */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + priv->fSensorValues[sm->mySubState-2] = atof(pCmd->inp_buf); + if (sm->mySubState-2 == priv->iCtrlSens) priv->fValue = priv->fSensorValues[sm->mySubState-2]; + sprintf(line, "KRDG? (Idle) sensor %s = %8.2f", priv->cValidSensors[sm->mySubState-2], priv->fSensorValues[sm->mySubState-2]); + SICSLogWrite(line, eStatus); + } + + if (sm->mySubState >= priv->iNumSensors+1) { + fsm_change_state(sm, LS340State_Idle); + return; + } + + sm->mySubState++; + + return; + } + } while (0); + return; + case eTimerEvent: + priv->state_timer = NULL; + + if (priv->controller) { + char line[132]; + sprintf(line, "LS340 eMode: = %d", priv->controller->eMode); + SICSLogWrite(line, eStatus); + + } + + + if (priv->fTarget > priv->fSetPoint) { + priv->fSetPoint = priv->fTarget; /* set the setpoint to be the target */ + priv->iHeaterStatus = 1; + sprintf(cmd, "SETP %d, %8.2f", priv->iPidLoop, priv->fSetPoint); /* tell the Lakeshore to change the current setpoint to target */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + fsm_change_state(sm, LS340State_Raising); + return; + } + if (priv->fTarget < priv->fSetPoint) { + priv->fSetPoint = priv->fTarget; /* set the setpoint to be the target */ + + priv->iHeaterStatus = 1; + sprintf(cmd, "SETP %d, %8.2f", priv->iPidLoop, priv->fSetPoint); /* tell the Lakeshore to change the current setpoint to target */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + fsm_change_state(sm, LS340State_Lowering); + return; + } + if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + char line[132]; + sprintf(cmd, "KRDG? %s", priv->cValidSensors[sm->mySubState-2]); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sprintf(line, "eTimerEvent (Idle): Sent: %s", cmd); + SICSLogWrite(line, eStatus); + } + + /* restart timer */ + NetWatchRegisterTimer(&priv->state_timer, + priv->ulIdleDelay, + fsm_tmr_callback, sm); + return; + case eCommandEvent: + return; + case eTimeoutEvent: + return; + } + return; +} + +static void LS340State_Raising(pStateMachine sm, pEvtEvent event){ + pEVDriver driv = (pEVDriver) sm->context; + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + char cmd[CMDLEN]; + + switch (event->event_type) { + + case eStateEvent: + if (priv->state_timer) + NetWatchRemoveTimer(priv->state_timer); + + NetWatchRegisterTimer(&priv->state_timer, + priv->ulMonitorDelay, + fsm_tmr_callback, sm); + + + sprintf(cmd, "RANGE %d", priv->iRange); /* set the Range value > 0 turns heater on */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + sprintf(cmd, "CLIMIT? %d", priv->iPidLoop); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 1; + + return; + + case eMessageEvent: + do { + pAsyncTxn pCmd = event->event.msg.cmd; + pCmd->inp_buf[pCmd->inp_idx] = '\0'; + + if (sm->mySubState == 1) { /* CLIMIT message */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + + sprintf(line, "CLIMIT (Raising): %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + + sscanf(pCmd->inp_buf, "%f,%f,%f,%d,%d", &priv->fSetPointLimit, &priv->fPosSlope, &priv->fNegSlope, &priv->iMaxCurrent, &priv->iMaxRange); + } + + sm->mySubState++; + + } else if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + + /* KRDG? Requests */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + priv->fSensorValues[sm->mySubState-2] = atof(pCmd->inp_buf); + if (sm->mySubState-2 == priv->iCtrlSens) priv->fValue = priv->fSensorValues[sm->mySubState-2]; + sprintf(line, "KRDG? (Raising) sensor %s = %8.2f", priv->cValidSensors[sm->mySubState-2], priv->fSensorValues[sm->mySubState-2]); + SICSLogWrite(line, eStatus); + + } + + sm->mySubState++; + + } + + /* restart timer */ + NetWatchRegisterTimer(&priv->state_timer, + priv->ulMonitorDelay, + fsm_tmr_callback, sm); + + } while (0); + return; + + case eTimerEvent: + priv->state_timer = NULL; + + if (priv->controller->eMode != EVDrive) { + fsm_change_state(sm, LS340State_Idle); + return; + } + if (priv->fTarget < priv->fSetPoint) { + priv->fSetPoint = priv->fTarget; /* set the setpoint to be the target */ + + sprintf(cmd, "SETP %d, %8.2f", priv->iPidLoop, priv->fSetPoint); /* tell the Lakeshore to change the current setpoint to target */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + fsm_change_state(sm, LS340State_Lowering); + return; + } + + if (sm->mySubState > priv->iNumSensors+1) sm->mySubState = 2; + + if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + sprintf(cmd, "KRDG? %s", priv->cValidSensors[sm->mySubState-2]); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + } + return; + case eCommandEvent: + return; + case eTimeoutEvent: + return; + } + return; +} + +static void LS340State_Lowering(pStateMachine sm, pEvtEvent event){ + pEVDriver driv = (pEVDriver) sm->context; + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + + char cmd[CMDLEN]; + + + switch (event->event_type) { + + case eStateEvent: + if (priv->state_timer) + NetWatchRemoveTimer(priv->state_timer); + + sprintf(cmd, "RANGE %d", priv->iRange); /* set the Range value > 0 turns heater on */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + sprintf(cmd, "CLIMIT? %d", priv->iPidLoop); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + sm->mySubState = 1; + + return; + + case eMessageEvent: + do { + pAsyncTxn pCmd = event->event.msg.cmd; + pCmd->inp_buf[pCmd->inp_idx] = '\0'; + + if (sm->mySubState == 1) { /* CLIMIT message */ + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + + sprintf(line, "CLIMIT (lowering): %s", pCmd->inp_buf); + SICSLogWrite(line, eStatus); + + sscanf(pCmd->inp_buf, "%f,%f,%f,%d,%d", &priv->fSetPointLimit, &priv->fPosSlope, &priv->fNegSlope, &priv->iMaxCurrent, &priv->iMaxRange); + } + + sm->mySubState++; + + } else if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + + /* KRDG? Requests */ + + char* p = strchr(pCmd->inp_buf, '\r'); + if (p) { + char line[132]; + *p = '\0'; + priv->fSensorValues[sm->mySubState-2] = atof(pCmd->inp_buf); + if (sm->mySubState-2 == priv->iCtrlSens) priv->fValue = priv->fSensorValues[sm->mySubState-2]; + sprintf(line, "KRDG? (Lowering) sensor %s = %8.2f", priv->cValidSensors[sm->mySubState-2], priv->fSensorValues[sm->mySubState-2]); + SICSLogWrite(line, eStatus); + + } + + sm->mySubState++; + + } + + /* restart timer */ + NetWatchRegisterTimer(&priv->state_timer, + priv->ulMonitorDelay, + fsm_tmr_callback, sm); + + } while (0); + return; + case eTimerEvent: + priv->state_timer = NULL; + + if (priv->controller->eMode != EVDrive) { /* return to IDLE state when not driving */ + fsm_change_state(sm, LS340State_Idle); + return; + } + if (priv->fTarget > priv->fSetPoint) { + + priv->fSetPoint = priv->fTarget; /* set the setpoint to be the target */ + + sprintf(cmd, "SETP %d, %8.2f", priv->iPidLoop, priv->fSetPoint); /* tell the Lakeshore to change the current setpoint to target */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + fsm_change_state(sm, LS340State_Raising); + return; + } + + if (sm->mySubState > priv->iNumSensors+1) sm->mySubState = 2; + + if (sm->mySubState >= 2 && sm->mySubState <= priv->iNumSensors+1) { + sprintf(cmd, "KRDG? %s", priv->cValidSensors[sm->mySubState-2]); + LS340_SendCmd(priv, cmd, strlen(cmd), fsm_msg_callback); + } + + return; + case eCommandEvent: + return; + case eTimeoutEvent: + return; + } + return; +} + + +static int LS340GetValue( pEVDriver self, float* fPos) { + pLS340Driv me = NULL; + assert(self); + assert(self->pPrivate); + me = (pLS340Driv) self->pPrivate; + *fPos = me->fValue; + return 1; +} + +static int LS340SetValue( pEVDriver self, float fPos) { + pLS340Driv me = NULL; + assert(self); + assert(self->pPrivate); + me = (pLS340Driv) self->pPrivate; + if (me->isLocked) { + me->iError = LS340_ERR_LOCKED; + return 0; + } + if (fPos < 0.0 || fPos > me->fSetPointLimit) { + me->iError = LS340_ERR_RANGE; + return 0; + } + me->fTarget = fPos; + return 1; +} + +static int LS340Send(pEVDriver self, char *pCommand, char *pReply, int iLen) { + + int rsp_len; + rsp_len = iLen; + + LS340_SendReceive(self->pPrivate, pCommand, strlen(pCommand), pReply, &rsp_len); + + return 1; +} + +static int LS340Error(pEVDriver self, int *iCode, char *error, int iErrLen) { + pLS340Driv priv = (pLS340Driv) self->pPrivate; + *iCode = priv->iError; + switch (priv->iError) { + case LS340_ERR_RANGE: + strncpy(error,"Value out of range",iErrLen); + break; + case LS340_ERR_LOCKED: + strncpy(error,"Object is locked",iErrLen); + break; + default: + strncpy(error,"TODO Error Messages",iErrLen); + break; + } + return 1; +} +static int LS340Fix(pEVDriver self, int iError) { + /* TODO */ + return DEVFAULT; +} +static int LS340Init(pEVDriver self) { + /* TODO */ + return 1; +} +static int LS340Close(pEVDriver self) { + /* TODO */ + return -1; +} +static void LS340KillPrivate(void *pData) { + pLS340Driv pMe = (pLS340Driv) pData; + if (pMe) { + if (pMe->asyncUnit) { + AsyncUnitDestroy(pMe->asyncUnit); + pMe->asyncUnit = NULL; + } + if (pMe ->name) { + free(pMe ->name); + pMe ->name = NULL; + } + /* Not required as performed in caller + * free(pMe); + */ + return; + } +} + +static void LS340Notify(void* context, int event) +{ + /* TODO */ +#if 0 + pEVDriver self = (pEVDriver) context; + char line[132]; + + switch (event) { + case AQU_DISCONNECT: + snprintf(line, 132, "Disconnect on Device '%s'", self->name); + SICSLogWrite(line, eStatus); + /* TODO: disconnect */ + break; + case AQU_RECONNECT: + snprintf(line, 132, "Reconnect on Device '%s'", self->name); + SICSLogWrite(line, eStatus); + /* TODO: reconnect */ + if (self->has_fsm) { + /* Reset the state machine */ + if (self->state_timer) + NetWatchRemoveTimer(self->state_timer); + self->state_timer = 0; + change_state(self, DMCState_Unknown); + /* Schedule a timer event as soon as possible */ + NetWatchRegisterTimer(&self->state_timer, + 0, + state_tmr_callback, self); + } + break; + } +#endif + return; +} + +static pAsyncProtocol LS340_Protocol = NULL; + +static int LS340_Tx(pAsyncProtocol p, pAsyncTxn ctx) +{ + int iRet = 1; + pAsyncTxn myCmd = (pAsyncTxn) ctx; + + if (myCmd) { + + if (strchr(myCmd->out_buf, '?')) { + myCmd->txn_status = ATX_ACTIVE; + } else { + myCmd->txn_status = ATX_COMPLETE; + } + + iRet = AsyncUnitWrite(myCmd->unit, myCmd->out_buf, myCmd->out_len); + + /* TODO handle errors */ + if (iRet < 0) { /* TODO: EOF */ + /* + iRet = AsyncUnitReconnect(myCmd->unit); + if (iRet == 0) + */ + return 0; + } + } + return 1; +} + +static int LS340_Rx(pAsyncProtocol p, pAsyncTxn ctx, int rxchar) { + int iRet = 1; + pAsyncTxn myCmd = (pAsyncTxn) ctx; + + switch (myCmd->txn_state) { + case 0: /* first character */ + if (myCmd->inp_idx < myCmd->inp_len) + myCmd->inp_buf[myCmd->inp_idx++] = rxchar; + if (rxchar == '\r' || rxchar == '\n') + myCmd->txn_state = 99; + break; + } + if (myCmd->txn_state == 99) { + iRet = 0; + } + if (iRet == 0) { /* end of command */ + myCmd->txn_status = ATX_COMPLETE; + return AQU_POP_CMD; + } + return iRet; +} + +static int LS340_Ev(pAsyncProtocol p, pAsyncTxn pTxn, int event) { + if (event == AQU_TIMEOUT) { + /* handle command timeout */ + pTxn->txn_status = ATX_TIMEOUT; + return AQU_POP_CMD; + } + return AQU_POP_CMD; +} + +static int LS340_PrepareTxn(pAsyncProtocol p, pAsyncTxn txn, const char* cmd, int cmd_len, int rsp_len) { + + txn->out_buf = (char*) malloc(cmd_len+2); + if (txn->out_buf == NULL) { + SICSLogWrite("ERROR: Out of memory in LS340_PrepareTxn", eError); + return 0; + } + memcpy(txn->out_buf, cmd, cmd_len); + txn->out_len = cmd_len; + + if (txn->out_buf[txn->out_len-1] != '\r') { + txn->out_buf[txn->out_len++] = '\r'; +// txn->out_buf[txn->out_len++] = '\r'; + } + +// txn->out_buf[txn->out_len++] = '\0'; + return 1; +} + +void LS340InitProtocol(SicsInterp *pSics) { + if (LS340_Protocol == NULL) { + LS340_Protocol = AsyncProtocolCreate(pSics, "ls340", NULL, NULL); + LS340_Protocol->sendCommand = LS340_Tx; + LS340_Protocol->handleInput = LS340_Rx; + LS340_Protocol->handleEvent = LS340_Ev; + LS340_Protocol->prepareTxn = LS340_PrepareTxn; + LS340_Protocol->killPrivate = NULL; + } +} + + +pEVDriver CreateLS340Driver(int argc, char *argv[]) +{ + int i, d = 0; + int k, v; + char cname[3]; + + pEVDriver self = NULL; + pLS340Driv priv = NULL; + + + /* tcl script eg: EvFactory new tc1 ls340 sertemp1 1 B + * Argv[] entering CreateLS340Driver - + * 0 - + */ + + if (argc < 1) + return NULL; + self = CreateEVDriver(argc, argv); + if (!self) + return NULL; + + priv = (pLS340Driv)malloc(sizeof(LS340Driv)); + if(!priv) { + DeleteEVDriver(self); + return NULL; + } + memset(priv,0,sizeof(LS340Driv)); + priv->fValue = 0.0; + + if (!AsyncUnitCreate(argv[4], &priv->asyncUnit)) { + char line[132]; + snprintf(line, 132, "Error: did not find AsyncQueue %s for Device %s", argv[3], argv[4]); + DeleteEVDriver(self); + free(priv); + return NULL; + } + AsyncUnitSetNotify(priv->asyncUnit, self, LS340Notify); + AsyncUnitSetDelay(priv->asyncUnit, 50); + + /* initialise function pointers */ + self->SetValue = LS340SetValue; + self->GetValue = LS340GetValue; + self->Send = LS340Send; + self->GetError = LS340Error; + self->TryFixIt = LS340Fix; + self->Init = LS340Init; + self->Close = LS340Close; + + self->pPrivate = priv; + self->KillPrivate = LS340KillPrivate; + + priv->iHeaterStatus = 1; /* heater on by default */ + + priv->fsm.context = self; + priv->fsm.state_name = state_name; + priv->fsm.event_name = event_name; + priv->name = strdup(argv[3]); + priv->iPidLoop = atoi(argv[5]); /* PID Loop 1..2 */ + + + if (argc < 7) return NULL; + + strncpy(priv->cCtrlSensName, argv[6], strlen(argv[6])); /* control sensor name */ + if (strlen(priv->cCtrlSensName) > 0) { + strncpy(priv->cValidSensors[0], priv->cCtrlSensName, strlen(priv->cCtrlSensName)); + priv->iCtrlSens = 0; + d++; + } + + /* parse out valid sensor names from argv[7] */ + for (i = d; i < NUM_INPUT_SENSORS; i++) { + priv->cValidSensors[i][0] = 'X'; /* clear the list, first */ + priv->cValidSensors[i][1] = '\0'; /* clear the list, first */ + priv->cValidSensors[i][2] = '\0'; /* clear the list, first */ + } + + i = 0; + v = 0; + while (i < strlen(argv[7])) { + if (isalpha(argv[7][i]) > 0) { + cname[0] = argv[7][i]; + cname[1] = '\0'; + cname[2] = '\0'; + + if (isdigit(argv[7][i+1]) > 0) { + cname[1] = argv[7][i+1]; + i++; + } + + v = 0; + /* check to see if sensor is already in list */ + for (k = 0; k < NUM_INPUT_SENSORS; k++) { + if (priv->cValidSensors[k][0] == cname[0]) { + if (strcmp(priv->cValidSensors[k], cname) == 0) { + v = 1; + break; /* already in list, skip */ + } + /* C vs C2 */ + if (priv->cValidSensors[k][1] == '\0' && isdigit(cname[1]) > 0) { + v = 1; + break; + } + + /* C2 vs C */ + if (isdigit(priv->cValidSensors[k][1]) > 0 && cname[1] == '\0') { + v = 1; + break; + } + + } + } + if (v == 0) { /* not in list, so add it in! */ + strncpy(priv->cValidSensors[d], cname, strlen(cname)); + d++; + } + } + i++; + } + priv->iNumSensors = d; /* assign number of sensors found */ + + + priv->ulIdlePollRate = 5000; + priv->ulIdleDelay = priv->ulIdlePollRate / priv->iNumSensors+1; /* +1 to include CLIMIT query */ + + priv->ulMonitorPollRate = 200; + priv->ulMonitorDelay = priv->ulMonitorPollRate / priv->iNumSensors+1; /* +1 to include CLIMIT query */ + fsm_change_state(&priv->fsm, LS340State_Unknown); + + return self; +} + +void LS340Register(pEVControl self, pEVDriver driv) +{ + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + priv->controller = self; + if (self->pName) { + if (priv->name) + free(priv->name); + priv->name = strdup(self->pName); + } + +} + +int LS340Wrapper(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]) +{ + pEVControl self = (pEVControl)pData; + pEVDriver driv = self->pDriv; + pLS340Driv priv = (pLS340Driv) driv->pPrivate; + assert(self); + assert(pCon); + assert(pSics); + + if(argc < 2) + { + return EVControlWrapper(pCon,pSics,pData,argc,argv); + } + if (strcasecmp("send", argv[1]) == 0) { + char cmd[CMDLEN]; + int cmd_len; + char rsp[CMDLEN]; + int rsp_len; + + /* Managers only */ + if (!SCMatchRights(pCon, usMugger)) { + return 0; + } + + if (argc < 2) return 0; + + sprintf(cmd, "%s", argv[2]); + cmd_len = strlen(cmd); + + rsp_len = CMDLEN; + LS340_SendReceive(priv, cmd, cmd_len, rsp, &rsp_len); + SCWrite(pCon, rsp, eValue); + + return 1; + } + + /* assign control sensor index */ + if (strcasecmp("controlsensor", argv[1]) == 0) { + char cmd[64]; + char cname[3]; + + char rsp[CMDLEN]; + char line[132]; + int i, v; + char *p = NULL; + + v = -1; + if (argc > 2) { + + p = (char *)strcasestr(argv[2], "sensor"); + if (p) { + if (strlen(p) > 6) { + p+=6; /* point to next char after the word sensor */ + } + } else { + snprintf(line, sizeof(line), "control sensor %s specified not in list", argv[2]); + SCWrite(pCon, line, eError); + return 0; + } + + /* swap control sensor locations from [0] */ + strncpy(cname, p, sizeof(cname)); + + /* algorithm: + * 1. check to see if new sensor given is in list + * IF YES, swap [0] with location found + */ + for (i = 0; i < priv->iNumSensors; i++) { + if (strcmp(priv->cValidSensors[i], cname) == 0) { /* Yes, given sensor is in list! */ + v = i; + break; + } + } + + + if (v > -1) { /* in list, swap values */ + float temp; + + strcpy(priv->cValidSensors[0], priv->cValidSensors[v]); + temp = priv->fSensorValues[0]; + priv->fSensorValues[0] = priv->fSensorValues[v]; + priv->fSensorValues[v] = temp; + strcpy(priv->cValidSensors[v], priv->cCtrlSensName); + + strcpy(priv->cCtrlSensName, cname); + + sprintf(cmd, "CSET %d, %s, 1, %d, 1", priv->iPidLoop, priv->cValidSensors[priv->iCtrlSens], priv->iHeaterStatus); + + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + + } else { + snprintf(line, sizeof(line), "control sensor %s specified not in list", cname); + SCWrite(pCon, line, eError); + return 0; + } + } + + snprintf(rsp, CMDLEN, "%s.controlsensor = sensor%s", priv->name, priv->cValidSensors[priv->iCtrlSens]); + SCWrite(pCon, rsp, eValue); + return 1; + } + + if (strcasecmp("debug", argv[1]) == 0) { + char rsp[CMDLEN]; + if (argc > 2) { + int debug = atoi(argv[2]); + if (debug != 0) + priv->fsm.debug = true; + else + priv->fsm.debug = false; + } + snprintf(rsp, CMDLEN, "%s.debug = %d", priv->name, priv->fsm.debug ? 1 : 0); + SCWrite(pCon, rsp, eValue); + return 1; + } + if (strcasecmp("setpoint", argv[1]) == 0) { + char rsp[CMDLEN]; + snprintf(rsp, CMDLEN, "%s.setpoint = %8.2f", priv->name, priv->fSetPoint); + SCWrite(pCon, rsp, eValue); + + return 1; + } + if (strcasecmp("numsensors", argv[1]) == 0) { + char rsp[CMDLEN]; + snprintf(rsp, CMDLEN, "%s.numsensors = %d", priv->name, priv->iNumSensors); + SCWrite(pCon, rsp, eValue); + + return 1; + } + if (strcasecmp("pollingrate", argv[1]) == 0) { + char rsp[CMDLEN]; + if (argc > 2) { + priv->ulIdlePollRate = (unsigned)atol(argv[2]); + priv->ulIdleDelay = priv->ulIdlePollRate / priv->iNumSensors+1; /* +1 to include CLIMIT query */ + + fsm_change_state(&priv->fsm, LS340State_Unknown); + } + snprintf(rsp, CMDLEN, "%s.pollingrate = %lu", priv->name, priv->ulIdlePollRate); + SCWrite(pCon, rsp, eValue); + + return 1; + } + + if (strcasecmp("heateron", argv[1]) == 0) { + char rsp[CMDLEN]; + char cmd[CMDLEN]; + if (argc > 2) { + priv->iHeaterStatus = atoi(argv[2]); + if (priv->iHeaterStatus == 1) { /* turn heater on */ + /* sprintf(cmd, "RANGE %d", priv->iRange); + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + */ + } else { + sprintf(cmd, "RANGE 0"); /* turn heater off otherwise */ + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + } + } + snprintf(rsp, CMDLEN, "%s.heateron = %d", priv->name, priv->iHeaterStatus); + SCWrite(pCon, rsp, eValue); + + if (argc > 2) fsm_change_state(&priv->fsm, LS340State_Idle); /* move back to Idle state? */ + return 1; + } + if (strcasecmp("range", argv[1]) == 0) { + char rsp[CMDLEN]; + char cmd[CMDLEN]; + if (argc > 2) { + priv->iRange = atoi(argv[2]); + + if (priv->iRange > 0) priv->iHeaterStatus = 1; + + sprintf(cmd, "RANGE %d", priv->iRange); + LS340_SendCmd(priv, cmd, strlen(cmd), NULL); + } + snprintf(rsp, CMDLEN, "%s.range = %d", priv->name, priv->iRange); + SCWrite(pCon, rsp, eValue); + + return 1; + } + + + if (strcasecmp("sensorlist", argv[1]) == 0) { + + int i; + char rsp[CMDLEN]; + char senslist[132]; + char temp[132]; + + strcpy(senslist, ""); /* prepare string */ + + for (i = 0; i < priv->iNumSensors; i++) { + sprintf(temp, "sensor%s", priv->cValidSensors[i]); + strcat(senslist, temp); + if (i < priv->iNumSensors-1) strcat(senslist, ","); + } + + snprintf(rsp, CMDLEN, "%s.sensorlist = %s", priv->name, senslist); + + SCWrite(pCon, rsp, eValue); + + return 1; + } + + if (strncasecmp("sensor", argv[1], 6) == 0) { + char rsp[CMDLEN]; + int i; + char name[3]; + + name[0] = '\0'; + name[1] = '\0'; + name[2] = '\0'; + + if (strlen(argv[1]) == 7) { /* sensorA */ + name[0] = argv[1][6]; + } + + if (strlen(argv[1]) == 8) { /* sensorC1 */ + name[0] = argv[1][6]; + name[1] = argv[1][7]; + } + + i = getSensorIndex(priv, name); + + if (i >= 0) { + snprintf(rsp, CMDLEN, "%s.sensor%s = %8.2f", priv->name, priv->cValidSensors[i], priv->fSensorValues[i]); + } else { + snprintf(rsp, CMDLEN, "%s.sensor%s is not in list", priv->name, name); + } + + + SCWrite(pCon, rsp, eValue); + return 1; + + } + + + if (strcasecmp("list", argv[1]) == 0) { + int i; + int iRet; + char rsp[CMDLEN]; + char senslist[132]; + char temp[132]; + + iRet = EVControlWrapper(pCon,pSics,pData,argc,argv); + if (iRet) { + snprintf(rsp, CMDLEN, "%s.pidloop = %d", priv->name, priv->iPidLoop); + SCWrite(pCon, rsp, eValue); + + snprintf(rsp, CMDLEN, "%s.controlsensor = sensor%s", priv->name, priv->cValidSensors[priv->iCtrlSens]); + SCWrite(pCon, rsp, eValue); + + snprintf(rsp, CMDLEN, "%s.numsensors = %d", priv->name, priv->iNumSensors); + SCWrite(pCon, rsp, eValue); + + strcpy(senslist, ""); /* prepare string */ + + for (i = 0; i < priv->iNumSensors; i++) { + sprintf(temp, "sensor%s", priv->cValidSensors[i]); + strcat(senslist, temp); + if (i < priv->iNumSensors-1) strcat(senslist, ","); + } + + snprintf(rsp, CMDLEN, "%s.sensorlist = %s", priv->name, senslist); + + SCWrite(pCon, rsp, eValue); + + for (i = 0; i < priv->iNumSensors; i++) { + snprintf(rsp, CMDLEN, "%s.sensor%s = %8.2f", priv->name, priv->cValidSensors[i], priv->fSensorValues[i]); + SCWrite(pCon, rsp, eValue); + } + + snprintf(rsp, CMDLEN, "%s.pollingrate = %lu", priv->name, priv->ulIdlePollRate); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.setpoint = %8.2f", priv->name, priv->fSetPoint); + SCWrite(pCon, rsp, eValue); + + snprintf(rsp, CMDLEN, "%s.target = %8.2f", priv->name, priv->fTarget); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.setpointlimit = %8.2f", priv->name, priv->fSetPointLimit); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.positiveslope = %8.2f", priv->name, priv->fPosSlope); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.negativeslope = %8.2f", priv->name, priv->fNegSlope); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.maxcurrent = %d", priv->name, priv->iMaxCurrent); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.maxrange = %d", priv->name, priv->iMaxRange); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.range = %d", priv->name, priv->iRange); + SCWrite(pCon, rsp, eValue); + snprintf(rsp, CMDLEN, "%s.heateron = %d", priv->name, priv->iHeaterStatus); + SCWrite(pCon, rsp, eValue); + } + return iRet; + } + return EVControlWrapper(pCon,pSics,pData,argc,argv); +} + diff --git a/site_ansto/ls340.h b/site_ansto/ls340.h new file mode 100644 index 00000000..8189180d --- /dev/null +++ b/site_ansto/ls340.h @@ -0,0 +1,33 @@ +/*------------------------------------------------------------------------- + LS340 - LAKESHORE 340 + + Asynchronous state-machine based driver for controller LAKESHORE 340 + + The meaning and working of the functions defined is as desribed for a + general environment controller. + + Adapted by Rodney Davies from ORHVPS code written by: + Douglas Clowes, December 2007 + + copyright: see implementation file. + + -----------------------------------------------------------------------------*/ +#ifndef SICSLS340 +#define SICSLS340 +#include +#include +#include +#include "sics.h" +#include +#include "ansto_evcontroller.h" + +void LS340InitProtocol(SicsInterp *pSics); + +pEVDriver CreateLS340Driver(int argc, char *argv[]); + +void LS340Register(pEVControl self, pEVDriver driv); + +int LS340Wrapper(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +#endif + diff --git a/site_ansto/lssmonitor.c b/site_ansto/lssmonitor.c new file mode 100644 index 00000000..8a67685c --- /dev/null +++ b/site_ansto/lssmonitor.c @@ -0,0 +1,573 @@ +/* + * Low Side Server Monitor - obtains latest RCMS data + * + * Rodney Davies March 2008 + * + */ + +#include +#include +#include +#include "network.h" +#include "asyncqueue.h" +#include "nwatch.h" +#include "lssmonitor.h" +#include "sicsvar.h" +#include + +#define _GNU_SOURCE +#include + + +char *strcasestr(const char *haystack, const char *needle); + +extern int DMC2280MotionControl; + +#define KEY_ENABLED_BIT (1 << 0) +#define KEY_DISABLED_BIT (1 << 1) +#define SEC_OPENED_BIT (1 << 2) +#define SEC_CLOSED_BIT (1 << 3) +#define TER_OPENED_BIT (1 << 4) +#define TER_CLOSED_BIT (1 << 5) +#define MOTOR_ENABLED_BIT (1 << 6) +#define MOTOR_DISABLED_BIT (1 << 7) +#define ACCESS_LOCKED_BIT (1 << 8) +#define ACCESS_UNLOCKED_BIT (1 << 9) +#define DC_POWEROK_BIT (1 << 10) +#define EXIT_INPROGRESS_BIT (1 << 11) +#define SAFETY_TRIPPED_BIT (1 << 12) +#define SAFETY_MALFUNCTION_BIT (1 << 13) +#define TER_OPERATE_BIT (1 << 14) +#define RELAY_ENABLED_BIT (1 << 15) +#define INST_READY_BIT (1 << 16) +#define LAMP_TEST_BIT (1 << 17) + +#define KEY_BOTH_BITS (KEY_ENABLED_BIT | KEY_DISABLED_BIT) +#define SEC_BOTH_BITS (SEC_OPENED_BIT | SEC_CLOSED_BIT) +#define TER_BOTH_BITS (TER_OPENED_BIT | TER_CLOSED_BIT) +#define MOTOR_BOTH_BITS (MOTOR_ENABLED_BIT | MOTOR_DISABLED_BIT) +#define ACCESS_BOTH_BITS (ACCESS_LOCKED_BIT | ACCESS_UNLOCKED_BIT) + +static pAsyncProtocol LSS_Protocol = NULL; + +int LSS_UserPriv = 0; /* Internal */ +typedef enum { +Unknown_low, Invalid_high, Enabled, Disabled, +Opened, Closed, Locked, Unlocked, True, False,}LSS_STATUS; + +char *lss_states[] = { +"Unknown_low", "Invalid_high", "Enabled", +"Disabled", "Opened", "Closed", +"Locked", "Unlocked", "True", "False"}; + +typedef enum { +Key,Secondary,Tertiary,MotionControl,Access, +DC,Exit,Trip,Fault,Operate,Relay,Ready,}LSS_PARAM; + +char *lss_parname[] = { +"lss_key","lss_secondary","lss_tertiary","lss_motioncontrol", +"lss_access","lss_dc","lss_exit","lss_trip", +"lss_fault","lss_operate","lss_relay","lss_ready"}; + +typedef struct __LSSController LSSController, *pLSSController; + +struct __LSSController { + pObjectDescriptor pDes; + pAsyncUnit unit; /* associated AsyncUnit object */ + int iGetOut; + int iValue; + int oldValue; + pNWTimer nw_tmr; /* periodic timer handle */ + pNWTimer oneshot; /* oneshot timer handle */ + int timeout; +}; + + +struct __RCMSData { + char desc[132]; /* description */ + char tag[132]; /* tag */ + char time[25]; /* time field */ + char value[132]; /* value */ +}; + + +/* XML Tree */ +mxml_node_t *tree; + + +static int LSS_GetState(void *pData, char *param, LSS_STATUS *retState); + +static int LSS_Tx(pAsyncProtocol p, pAsyncTxn myCmd) +{ + int iRet = 1; + + if (myCmd) { + myCmd->txn_status = ATX_ACTIVE; + iRet = AsyncUnitWrite(myCmd->unit, myCmd->out_buf, myCmd->out_len); + /* TODO handle errors */ + if (iRet < 0) { /* TODO: EOF */ + iRet = AsyncUnitReconnect(myCmd->unit); + if (iRet == 0) + return 0; + } + } + return 1; +} + +static int LSS_Rx(pAsyncProtocol p, pAsyncTxn myCmd, int rxchar) +{ + int iRet = 1; + + switch (myCmd->txn_state) { + case 0: /* first character */ + /* normal data */ + myCmd->txn_state = 1; + /* note fallthrough */ + case 1: /* receiving reply */ + if (myCmd->inp_idx < myCmd->inp_len) + myCmd->inp_buf[myCmd->inp_idx++] = rxchar; + if (rxchar == 0x0D) + myCmd->txn_state = 2; + break; + case 2: /* received CR and looking for LF */ + if (myCmd->inp_idx < myCmd->inp_len) + myCmd->inp_buf[myCmd->inp_idx++] = rxchar; + if (rxchar == 0x0A) { + myCmd->txn_state = 99; + /* end of line */ + } + else + myCmd->txn_state = 1; + break; + } + if (myCmd->txn_state == 99) { + myCmd->inp_buf[myCmd->inp_idx] = '\0'; + iRet = 0; + myCmd->txn_state = 0; + myCmd->txn_status = ATX_COMPLETE; + } + if (iRet == 0) { /* end of command */ + return AQU_POP_CMD; + } + return iRet; +} + +static int LSS_Ev(pAsyncProtocol p, pAsyncTxn myCmd, int event) +{ + if (event == AQU_TIMEOUT) { + /* TODO: handle command timeout */ + myCmd->txn_status = ATX_TIMEOUT; + return AQU_POP_CMD; + } + return AQU_POP_CMD; +} + +static void LSS_Notify(void* context, int event) +{ + char line[132]; + + sprintf(line, "LSS_Notify: (AQU_RECONNECT)%d [%d]", AQU_RECONNECT, event); + SICSLogWrite(line, eStatus); + + pLSSController self = (pLSSController) context; + + switch (event) { + case AQU_RECONNECT: + do { + mkChannel* sock = AsyncUnitGetSocket(self->unit); + int flag = 1; + setsockopt(sock->sockid, /* socket affected */ + IPPROTO_TCP, /* set option at TCP level */ + TCP_NODELAY, /* name of option */ + (char *) &flag, /* the cast is historical cruft */ + sizeof(int)); /* length of option value */ + return; + } while (0); + } + return; +} + +/* Callback function to inspect each XML node as the string is parsed */ +static mxml_type_t xmlLoadStringCallback(mxml_node_t *node) { + + char line[132]; + char value[132]; + + const char *type; + mxml_type_t myType; + + + sprintf(value, "NO VALUE"); + + type = mxmlElementGetAttr(node, "type"); + + if (type == NULL) + type = node->value.element.name; + + + if (!strcmp(type, "integer")) + myType = (MXML_INTEGER); + else if (!strcmp(type, "opaque")) + myType = (MXML_OPAQUE); + else if (!strcmp(type, "real")) + myType = (MXML_REAL); + else myType = (MXML_TEXT); + + if (myType == (MXML_INTEGER)) + sprintf(value, "%d", node->value.integer); + + if (myType == (MXML_TEXT)) + sprintf(value, "%s", "text"); + + if (myType == (MXML_REAL)) + sprintf(value, "%f", node->value.real); + + if (myType == (MXML_OPAQUE)) + sprintf(value, "%s", node->value.opaque); + + +/* + if (node->value.text.string != NULL) { + if (myType == (MXML_TEXT)) + snprintf(value, 132, "[%c]", node->value.text.string); + } +*/ + sprintf(line, "xmlLoadStringCallback: [%s] [%s] [%s] [%s] [%s] [%s]", node->value.element.name, type, mxmlElementGetAttr(node, "description"), mxmlElementGetAttr(node, "time"), mxmlElementGetAttr(node, "tag"), value); + SICSLogWrite(line, eStatus); + + return myType; +} + +/* + * \brief GetCallback is the callback for the read command. + */ +static int GetCallback(pAsyncTxn txn) +{ + + FILE *fp; + char line[132]; + LSS_STATUS state; + int iRet,i; + unsigned int iRead; + char* resp = txn->inp_buf; + int resp_len = txn->inp_idx; + LSS_STATUS lssState; + pSicsVariable lssVar=NULL; + + pLSSController self = (pLSSController) txn->cntx; + if (resp_len <= 0) { + snprintf(line, 132, "lss1 = NO INPUT!!"); + SICSLogWrite(line, eStatus); + return 1; + } + else { + snprintf(line, 132, "lss1 = [%d] [%s]", strlen(resp), resp); + SICSLogWrite(line, eStatus); + + + /* free memory from previous tree */ + if (tree) { + mxmlDelete(tree); + } + + /* parse the string into an XML tree - resp *should* be raw XML data */ + tree = mxmlLoadString(NULL, resp, MXML_TEXT_CALLBACK); + + } +/* + if (self->oldValue != self->iValue) { + for (i=0; i < sizeof(lss_parname)/sizeof(lss_parname[0]); i++) { + lssVar = (pSicsVariable)FindCommandData(pServ->pSics,lss_parname[i],"SicsVariable"); + LSS_GetState(self,lss_parname[i],&lssState); + VarSetText(lssVar,lss_states[lssState],LSS_UserPriv); + } + } +*/ + self->oldValue = self->iValue; + self->iGetOut = 0; + + /* send out another read request */ + AsyncUnitSendTxn(self->unit, "READ", 4, GetCallback, self, 1024*1024); + return 0; +} + +static int MyOneShotCallback(void* context, int mode) +{ + + char line[132]; + + pLSSController self = (pLSSController) context; + self->oneshot = 0; + AsyncUnitSendTxn(self->unit, "WRITE 0", 7, NULL, NULL, 132); + sprintf(line, "lssmonitor.c: MyOneShotCallback() -> AsyncUnitSendTxn( WRITE ) "); + SICSLogWrite(line, eStatus); + return 0; +} + +static int MyTimerCallback(void* context, int mode) +{ + char line[132]; + + pLSSController self = (pLSSController) context; + if (self->iGetOut) { + /* TODO error handling */ + } + self->iGetOut = 1; + + /* disable READ-polling timer for now - wait for reply ... */ + NetWatchRemoveTimer(self->nw_tmr); + + + AsyncUnitSendTxn(self->unit, "READ", 4, GetCallback, self, 1024*1024); + sprintf(line, "lssmonitor.c: MyTimerCallback() -> AsyncUnitSendTxn(READ 1MB)"); + SICSLogWrite(line, eStatus); + + return 1; +} + +/* + * \brief PutCallback is the callback for the write command. + */ +static int PutCallback(pAsyncTxn txn) +{ + char line[132]; + + pLSSController self = (pLSSController) txn->cntx; + if (self->oneshot) + NetWatchRemoveTimer(self->oneshot); + NetWatchRegisterTimer(&self->oneshot, 1200, MyOneShotCallback, self); + + + sprintf(line, "lssmonitor.c: PutCallback() -> RegisterTimer "); + SICSLogWrite(line, eStatus); + + return 0; +} + +static int LSS_GetState(void *pData, char *param, LSS_STATUS *retState) +{ + pLSSController self = (pLSSController) pData; + /* + if (strcasecmp(param, lss_parname[Key]) == 0) { + *retState = Unknown_low; + if ((self->iValue & KEY_BOTH_BITS) == KEY_BOTH_BITS) + *retState = Invalid_high; + else if (self->iValue & KEY_ENABLED_BIT) + *retState = Enabled; + else if (self->iValue & KEY_DISABLED_BIT) + *retState = Disabled; + return OKOK; + } + */ + *retState = Unknown_low; + return OKOK; + + return 0; +} + +static int LSS_Print(SConnection *pCon, SicsInterp *pSics, + void *pData, char *name, char *param) +{ + char line[132]; + LSS_STATUS state; + + if (LSS_GetState(pData, param, &state) != OKOK) { + return 0; + } else { + snprintf(line, 132, "%s.%s = %s", name, param, lss_states[state]); + SCWrite(pCon, line, eStatus); + return OKOK; + } +} + + +static int findElement(SConnection *pCon, const char *string) { + + char line[132]; + mxml_node_t *n = NULL; + int found = 0; + + for(n = mxmlWalkNext(tree, tree, MXML_DESCEND); n != NULL; n = mxmlWalkNext(n, tree, MXML_DESCEND)) { + if (n->value.element.attrs) { + if (strcasestr(mxmlElementGetAttr(n, "description"), string) != NULL) { + snprintf(line, 132, "%s.%s %s = %s (%s)", string, mxmlElementGetAttr(n, "description"), mxmlElementGetAttr(n, "tag"), n->child->value.text.string, mxmlElementGetAttr(n, "time")); + SCWrite(pCon, line, eStatus); + found = 1; + } + + if (strcasestr(mxmlElementGetAttr(n, "tag"), string) != NULL) { + snprintf(line, 132, "%s.%s %s = %s (%s)", string, mxmlElementGetAttr(n, "description"), mxmlElementGetAttr(n, "tag"), n->child->value.text.string, mxmlElementGetAttr(n, "time")); + SCWrite(pCon, line, eStatus); + found = 1; + } + + } + } + + return found; +} + + +static int LSS_Action(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]) +{ + mxml_node_t *node; + mxml_node_t *current; + + char line[132]; + pLSSController self = (pLSSController) pData; + if (argc == 1) { + snprintf(line, 132, "%s.iValue = %06X", argv[0], self->iValue & 0xffffff); + SCWrite(pCon, line, eStatus); + return OKOK; + } + else if (argc == 2) { + if (strcasecmp(argv[1], "list") == 0) { + + current = tree; + + for (node = mxmlWalkNext(current, tree, MXML_DESCEND); node != NULL; node = mxmlWalkNext(node, tree, MXML_DESCEND)) { + if (node->value.element.attrs) { + + snprintf(line, 132, "%s.%s %s = %s (%s)", argv[0], mxmlElementGetAttr(node, "description"), mxmlElementGetAttr(node, "tag"), node->child->value.text.string, mxmlElementGetAttr(node, "time")); + SCWrite(pCon, line, eStatus); + } + } + + return OKOK; + } + + + /* search by sub string */ + if (findElement(pCon, argv[1]) > 0) { + return OKOK; + } + } + + snprintf(line, 132, "%s does not understand %s", argv[0], argv[1]); + SCWrite(pCon, line, eError); + return 0; +} + +static pLSSController LSS_Create(const char* pName) +{ + pLSSController self = NULL; + + self = (pLSSController) malloc(sizeof(LSSController)); + if (self == NULL) + return NULL; + memset(self, 0, sizeof(LSSController)); + if (AsyncUnitCreate(pName, &self->unit) == 0) { + free(self); + return NULL; + } + AsyncUnitSetNotify(self->unit, self, LSS_Notify); + AsyncUnitSetDelay(self->unit, 50); + + self->pDes = CreateDescriptor("LSS"); + return self; +} + +static int LSS_Init(pLSSController self) +{ + /* TODO: Init the controller */ + if (self->nw_tmr != NULL) + NetWatchRemoveTimer(self->nw_tmr); + + AsyncUnitSendTxn(self->unit, "READ", 4, GetCallback, self, 1024*1024); + +/* + NetWatchRegisterTimerPeriodic(&self->nw_tmr, + 2000, 2000, + MyTimerCallback, + self); + self->timeout=120000; +*/ + return 1; +} + +static void LSS_Kill(void* pData) +{ + /* free memory from previous tree */ + if (tree) { + mxmlDelete(tree); + } + + pLSSController self = (pLSSController) pData; + if (self->nw_tmr) + NetWatchRemoveTimer(self->nw_tmr); + if (self->pDes) { + DeleteDescriptor(self->pDes); + self->pDes = NULL; + } + free(self); + return; +} + +void LSSInitProtocol(SicsInterp *pSics) { + if (LSS_Protocol == NULL) { + LSS_Protocol = AsyncProtocolCreate(pSics, "LSS", NULL, NULL); + LSS_Protocol->sendCommand = LSS_Tx; + LSS_Protocol->handleInput = LSS_Rx; + LSS_Protocol->handleEvent = LSS_Ev; + LSS_Protocol->prepareTxn = NULL; + LSS_Protocol->killPrivate = NULL; + } +} + +int LSSFactory(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]) +{ + pLSSController pNew = NULL; + int iRet, status, i; + char pError[256]; + pSicsVariable lssVar=NULL; + LSS_STATUS lssState; + + if(argc < 3) + { + SCWrite(pCon,"ERROR: insufficient no of arguments to LSSFactory", + eError); + return 0; + } + + /* + create data structure and open port + */ + pNew = LSS_Create(argv[2]); + + if(!pNew) + { + SCWrite(pCon,"ERROR: failed to create LSS in LSSFactory",eError); + return 0; + } + + status = LSS_Init(pNew); + if(status != 1) + { + sprintf(pError,"ERROR: failed to connect to %s",argv[2]); + SCWrite(pCon,pError,eError); + } + /* + for (i=0; i < sizeof(lss_parname)/sizeof(lss_parname[0]); i++) { + lssVar = VarCreate(LSS_UserPriv,veText,lss_parname[i]); + LSS_GetState(pNew,lss_parname[i],&lssState); + VarSetText(lssVar,lss_states[lssState],LSS_UserPriv); + AddCommand(pSics,lss_parname[i],VarWrapper,(KillFunc)VarKill,lssVar); + } +*/ + /* + create the command + */ + + iRet = AddCommand(pSics, argv[1], LSS_Action, LSS_Kill, pNew); + if(!iRet) + { + sprintf(pError,"ERROR: duplicate command %s not created [%d]", argv[1], iRet); + SCWrite(pCon,pError,eError); + LSS_Kill(pNew); + return 0; + } + SCSendOK(pCon); + return 1; +} diff --git a/site_ansto/lssmonitor.h b/site_ansto/lssmonitor.h new file mode 100644 index 00000000..90cd3571 --- /dev/null +++ b/site_ansto/lssmonitor.h @@ -0,0 +1,15 @@ +/* + * Low Side Server RCMS data monitor + * + * Rodney Davies, March 2008 + * + */ +#ifndef SICLSSS +#define SICSLSS + +void LSSInitProtocol(SicsInterp *pSics); + +int LSSFactory(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]); + +#endif /* SICSSLSS */ diff --git a/site_ansto/motor_dmc2280.c b/site_ansto/motor_dmc2280.c index 813d2576..bbe29276 100644 --- a/site_ansto/motor_dmc2280.c +++ b/site_ansto/motor_dmc2280.c @@ -1633,6 +1633,7 @@ static void DMCState_Unknown(pDMC2280Driv self, pEvtEvent event) { /* handle pending message event */ if (self->waitResponse) { self->subState = 0; + /* FIXME: FIXME_DOUG */ return; } /* Set speed */ @@ -2376,7 +2377,7 @@ static void DMCState_Moving(pDMC2280Driv self, pEvtEvent event) { case eCommandEvent: switch (event->event.cmd.cmd_type) { case CMD_RUN: - /* RUN command while running */ + /* TODO: FIXME RUN command while running */ if (self->driver_status == HWIdle) self->driver_status = HWBusy; self->run_flag = 1; diff --git a/site_ansto/site_ansto.c b/site_ansto/site_ansto.c index 07336634..8ef34e25 100644 --- a/site_ansto/site_ansto.c +++ b/site_ansto/site_ansto.c @@ -27,6 +27,7 @@ /* Added code for new LH45 and Lakeshore 340 drivers */ #include "lh45.h" #include "lakeshore340.h" +#include "west4100.h" /* Added HTTP support for ANSTO OPAL NBI Histogram Server */ #include "anstohttp.h" #include "anstoutil.h" @@ -37,8 +38,11 @@ #include "nhq200.h" /* Added code for Oak Ridge High Voltage Power Supply */ #include "orhvps.h" +/* Added code for new LS340 LAKESORE 340 Temperature Controller */ +#include "ls340.h" #include "safetyplc.h" +#include "lssmonitor.h" /*@observer@*//*@null@*/ pCounterDriver CreateMonCounter(/*@observer@*/SConnection *pCon, /*@observer@*/char *name, char *params); @@ -64,8 +68,10 @@ static void AddCommands(SicsInterp *pInter) { DMC2280InitProtocol(pInter); SafetyPLCInitProtocol(pInter); + LSSInitProtocol(pInter); NHQ200InitProtocol(pInter); ORHVPSInitProtocol(pInter); + LS340InitProtocol(pInter); AddCommand(pInter,"MakeTCPSelector",VelSelTcpFactory,NULL,NULL); AddCommand(pInter,"portnum",portNumCmd,NULL,NULL); AddCommand(pInter,"abortbatch",AbortBatch,NULL,NULL); @@ -74,6 +80,7 @@ static void AddCommands(SicsInterp *pInter) AddCommand(pInter,"MakeAsyncQueue",AsyncQueueFactory,NULL,NULL); AddCommand(pInter,"MakeMultiChan",AsyncQueueFactory,NULL,NULL); AddCommand(pInter,"MakeSafetyPLC",SafetyPLCFactory,NULL,NULL); + AddCommand(pInter,"MakeLSSMonitor",LSSFactory,NULL,NULL); } /*---------------------------------------------------------------------*/ static void RemoveCommands(SicsInterp *pSics){ @@ -193,6 +200,18 @@ static pEVControl InstallEnvironmentController(SicsInterp *pSics, } } } + + /* Added code for new Lakeshore 340 driver */ + if(strcmp(argv[3],"west4100") == 0) { + pDriv = CreateWEST4100Driver(argc-4,&argv[4]); + if(pDriv){ + pNew = CreateEVController(pDriv,argv[2],&status); + if(pNew != NULL){ + AddCommand(pSics,argv[2],WEST4100Wrapper,DeleteEVController, + pNew); + } + } + } /* Added code for new NHQ 200 driver */ if(strcmp(argv[3],"nhq200") == 0) { @@ -220,6 +239,21 @@ static pEVControl InstallEnvironmentController(SicsInterp *pSics, } } + /* Added code for new LS340 LAKSHORE Temperature Controller 340 Driver */ + if(strcmp(argv[3],"ls340") == 0) { + pDriv = CreateLS340Driver(argc,argv); + if(pDriv){ + pNew = CreateEVController(pDriv,argv[2],&status); + if(pNew != NULL){ + LS340Register(pNew, pDriv); + AddCommand(pSics,argv[2],LS340Wrapper,DeleteEVController, + pNew); + } + } + } + + + return pNew; } /*-----------------------------------------------------------------*/ diff --git a/site_ansto/test_west.tcl b/site_ansto/test_west.tcl new file mode 100644 index 00000000..d556f00e --- /dev/null +++ b/site_ansto/test_west.tcl @@ -0,0 +1,31 @@ +# $Revision$ +# $Date$ +# Author: Ferdi Franceschini (ffr@ansto.gov.au) +# Last revision by: $Author$ + +# Required by server_config.tcl +VarMake Instrument Text Internal +Instrument echidna +Instrument lock + +#START SERVER CONFIGURATION SECTION +#source util/dmc2280/dmc2280_util.tcl + +#source sics_ports.tcl +ServerOption TelnetPort 60093 +ServerOption InterruptPort 60092 +ServerOption ServerPort 60091 +ServerOption QuieckPort 60090 +SicsUser manager ansto 1 +SicsUser user sydney 2 +SicsUser spy 007 3 + +#WEST4100 tempcontroller creation +MakeRS232Controller sertemp 127.0.0.1 4502 +sertemp timeout 300 +sertemp sendterminator 0x0 +sertemp replyterminator 0x0 +EvFactory new tc1 west4100 sertemp 1 2 +tc1 Upperlimit 1000 +tc1 Lowerlimit 0 +tc1 tolerance 10 diff --git a/site_ansto/west4100.c b/site_ansto/west4100.c new file mode 100644 index 00000000..170d13fe --- /dev/null +++ b/site_ansto/west4100.c @@ -0,0 +1,356 @@ +/*--------------------------------------------------------------------------- + W E S T 4 1 0 0 . C + + This is the implementation for a WEST4100 object derived from a more general + environment controller. + + Mark Koennecke, August 1997 + Mark Lesha, January 2006 (based on ITC4 code) + Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and + not the new LS340 code written by Rodney Davies Feb 08) + + Copyright: + + Labor fuer Neutronenstreuung + Paul Scherrer Institut + CH-5423 Villigen-PSI + + + The authors hereby grant permission to use, copy, modify, distribute, + and license this software and its documentation for any purpose, provided + that existing copyright notices are retained in all copies and that this + notice is included verbatim in any distributions. No written agreement, + license, or royalty fee is required for any of the authorized uses. + Modifications to this software may be copyrighted by their authors + and need not follow the licensing terms described here, provided that + the new terms are clearly indicated on the first page of each file where + they apply. + + IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY + FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY + DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + + THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE + IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE + NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR + MODIFICATIONS. +----------------------------------------------------------------------------*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "west4100.h" + +int SetSetpointWEST4100(pEVDriver self, int Setpoint); +int SetAlarm1WEST4100(pEVDriver self, int Alarm1); +int SetAlarm2WEST4100(pEVDriver self, int Alarm2); +int SetPowerLimitWEST4100(pEVDriver self, int PowerLimit); +int SetRampRateWEST4100(pEVDriver self, int RampRate); +int GetSetpointWEST4100(pEVDriver self); +int GetAlarm1WEST4100(pEVDriver self); +int GetAlarm2WEST4100(pEVDriver self); +int GetPowerLimitWEST4100(pEVDriver self); +int GetRampRateWEST4100(pEVDriver self); +int GetProcessValueWEST4100(pEVDriver self); +int GetAddressWEST4100(pEVDriver self); +int GetTransactWEST4100(pEVDriver self); +int GetWorkingSetpointWEST4100(pEVDriver self); + +/*---------------------------------------------------------------------------*/ + int WEST4100SetPar(pEVControl self, char *name, float fNew, SConnection *pCon) + { + int iRet; + + /* check authorisation */ + if(!SCMatchRights(pCon,usUser)) + { + SCWrite(pCon,"ERROR: you are not authorised to change this parameter", + eError); + return 0; + } + + /* just catch those three names which we understand */ + if(strcmp(name,"setpoint") == 0) + { + iRet = SetSetpointWEST4100(self->pDriv,(int)fNew); + if(!iRet) + { + SCWrite(pCon,"ERROR: value out of range",eError); + return 0; + } + iRet = ConfigWEST4100(self->pDriv); + if(iRet != 1) + { + SCWrite(pCon,"ERROR: WEST4100 configuration failed! ",eError); + SCWrite(pCon,"INFO: Probably comm problem, Retry!",eError); + return 0; + } + SCSendOK(pCon); + return 1; + } + + if(strcmp(name,"alarm1") == 0) + { + iRet = SetAlarm1WEST4100(self->pDriv,(int)fNew); + if(!iRet) + { + SCWrite(pCon,"ERROR: value out of range",eError); + return 0; + } + iRet = ConfigWEST4100(self->pDriv); + if(iRet != 1) + { + SCWrite(pCon,"ERROR: WEST4100 configuration failed! ",eError); + SCWrite(pCon,"INFO: Probably comm problem, Retry!",eError); + return 0; + } + SCSendOK(pCon); + return 1; + } + + if(strcmp(name,"alarm2") == 0) + { + iRet = SetAlarm2WEST4100(self->pDriv,(int)fNew); + if(!iRet) + { + SCWrite(pCon,"ERROR: value out of range",eError); + return 0; + } + iRet = ConfigWEST4100(self->pDriv); + if(iRet != 1) + { + SCWrite(pCon,"ERROR: WEST4100 configuration failed! ",eError); + SCWrite(pCon,"INFO: Probably comm problem, Retry!",eError); + return 0; + } + SCSendOK(pCon); + return 1; + } + + if(strcmp(name,"powerlimit") == 0) + { + iRet = SetPowerLimitWEST4100(self->pDriv,(int)fNew); + if(!iRet) + { + SCWrite(pCon,"ERROR: value out of range",eError); + return 0; + } + iRet = ConfigWEST4100(self->pDriv); + if(iRet != 1) + { + SCWrite(pCon,"ERROR: WEST4100 configuration failed! ",eError); + SCWrite(pCon,"INFO: Probably comm problem, Retry!",eError); + return 0; + } + SCSendOK(pCon); + return 1; + } + + if(strcmp(name,"ramprate") == 0) + { + iRet = SetRampRateWEST4100(self->pDriv,(int)fNew); + if(!iRet) + { + SCWrite(pCon,"ERROR: value out of range",eError); + return 0; + } + iRet = ConfigWEST4100(self->pDriv); + if(iRet != 1) + { + SCWrite(pCon,"ERROR: WEST4100 configuration failed! ",eError); + SCWrite(pCon,"INFO: Probably comm problem, Retry!",eError); + return 0; + } + SCSendOK(pCon); + return 1; + } + + else + return EVCSetPar(self,name,fNew,pCon); + } +/*--------------------------------------------------------------------------*/ + int WEST4100GetPar(pEVControl self, char *name, float *fNew) + { + int iRet; + + /* just catch those two names which we understand */ + if(strcmp(name,"setpoint") == 0) + { + iRet = GetSetpointWEST4100(self->pDriv); + *fNew = (float)iRet; + return 1; + } + else if(strcmp(name,"alarm1") == 0) + { + iRet = GetAlarm1WEST4100(self->pDriv); + *fNew = (float)iRet; + return 1; + } + else if(strcmp(name,"alarm2") == 0) + { + iRet = GetAlarm2WEST4100(self->pDriv); + *fNew = (float)iRet; + return 1; + } + else if(strcmp(name,"powerlimit") == 0) + { + iRet = GetPowerLimitWEST4100(self->pDriv); + *fNew = (float)iRet; + return 1; + } + else if(strcmp(name,"ramprate") == 0) + { + iRet = GetRampRateWEST4100(self->pDriv); + *fNew = (float)iRet; + return 1; + } + else if(strcmp(name,"numsensors") == 0) + { + iRet = 1; // Furnace only has 1 sensor + *fNew = (int)iRet; + return 1; + } + else if(strcmp(name,"sensora") == 0) + { + iRet = GetProcessValueWEST4100(self->pDriv); // Furnace only has 1 sensor + *fNew = (float)iRet; + return 1; + } + else + return EVCGetPar(self,name,fNew); + } +/*---------------------------------------------------------------------------*/ + int WEST4100List(pEVControl self, SConnection *pCon) + { + char pBueffel[132]; + int iRet; + + iRet = EVCList(self,pCon); + + sprintf(pBueffel,"%s.NumSensors = %d\n",self->pName,1); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.ControlSensor = %s\n",self->pName,"SensorA"); + SCWrite(pCon,pBueffel,eValue); + + + sprintf(pBueffel,"%s.ModbusAddress = %d\n",self->pName,GetAddressWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.TransactionNumber = %d\n",self->pName,GetTransactWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.ProcessValue = %d\n",self->pName,GetProcessValueWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.Setpoint = %d\n",self->pName,GetSetpointWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.WorkingSetpoint = %d\n",self->pName,GetWorkingSetpointWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.Alarm1 = %d\n",self->pName,GetAlarm1WEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.Alarm2 = %d\n",self->pName,GetAlarm2WEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.PowerLimit = %d\n",self->pName,GetPowerLimitWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + sprintf(pBueffel,"%s.RampRate = %d\n",self->pName,GetRampRateWEST4100(self->pDriv)); + SCWrite(pCon,pBueffel,eValue); + + return iRet; + } +/*-------------------------------------------------------------------------*/ + int WEST4100Wrapper(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]) + { + pEVControl self = NULL; + char pBueffel[256]; + int iRet; + double fNum; + float fVal; + int fValue; + + self = (pEVControl)pData; + assert(self); + assert(pCon); + assert(pSics); + + if(argc < 2) + { + return EVControlWrapper(pCon,pSics,pData,argc,argv); + } + // Set or Get + strtolower(argv[1]); + if( (strcmp(argv[1],"controlsensor") == 0) || (strcmp(argv[1],"sensorlist") == 0)){ + sprintf(pBueffel,"%s.%s = %s\n",self->pName,argv[1],"sensorA"); + SCWrite(pCon,pBueffel,eValue); + } + else if((strcmp(argv[1],"setpoint") == 0) || (strcmp(argv[1],"alarm1") == 0) + || (strcmp(argv[1],"powerlimit") == 0) || (strcmp(argv[1],"alarm2") == 0) + || (strcmp(argv[1],"ramprate") == 0) || (strcmp(argv[1],"numsensors") == 0) + || (strcmp(argv[1],"sensora") == 0)) + { + if(argc > 2) /* set case */ + { + iRet = Tcl_GetDouble(pSics->pTcl,argv[2],&fNum); + if(iRet != TCL_OK) + { + sprintf(pBueffel,"ERROR: expected number, got %s",argv[2]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + return WEST4100SetPar(self,argv[1],(float)fNum,pCon); + } + else /* get case */ + { + iRet = WEST4100GetPar(self,argv[1],&fVal); + sprintf(pBueffel,"%s.%s = %f\n",self->pName,argv[1],fVal); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + } + // Write or Query + else if(strcmp(argv[1],"parameter") == 0) + { + if(argc > 3) /* set case */ + { + return WEST4100Write(self->pDriv,atoi(argv[2]),atoi(argv[3])); + } + else /* get case */ + { + iRet = WEST4100Query(self->pDriv,atoi(argv[2]),&fValue); + sprintf(pBueffel,"%s.%s %s = %d\n",self->pName,argv[1],argv[2],fValue); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + } + // List + else if(strcmp(argv[1],"list") == 0) + { + return WEST4100List(self,pCon); + } + else + { + return EVControlWrapper(pCon,pSics,pData,argc,argv); + } + /* not reached */ + return 0; + } diff --git a/site_ansto/west4100.h b/site_ansto/west4100.h new file mode 100644 index 00000000..ea71ae0e --- /dev/null +++ b/site_ansto/west4100.h @@ -0,0 +1,41 @@ + +/*------------------------------------------------------------------------- + W E S T 4 1 0 0 + + Support for Lakeshore 340 Temperature controllers for SICS. + The meaning and working of the functions defined is as desribed for a + general environment controller. + + Mark Koennecke, Juli 1997 + Mark Lesha, January 2006 (based on ITC4 code) + Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and + not the new LS340 code written by Rodney Davies Feb 08) + + copyright: see implementation file. + +-----------------------------------------------------------------------------*/ +#ifndef SICSWEST4100 +#define SICSWEST4100 +/*------------------------- The Driver ------------------------------------*/ + + pEVDriver CreateWEST4100Driver(int argc, char *argv[]); + int ConfigWEST4100(pEVDriver self); + int SetSensorWEST4100(pEVDriver self, int iSensor); + int SetControlWEST4100(pEVDriver self, int iSensor); + int GetSensorWEST4100(pEVDriver self); + int GetControlWEST4100(pEVDriver self); + int WEST4100Query(pEVDriver self, int parameterAddress, int *parameterValue); //PB + int WEST4100Write(pEVDriver self, int parameterAddress, int parameterValue); //PB + +/*------------------------- The WEST4100 object ------------------------------*/ + + int WEST4100Wrapper(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); + int WEST4100SetPar(pEVControl self, char *name, float fNew, + SConnection *pCon); + int WEST4100GetPar(pEVControl self, char *name, float *fVal); + int WEST4100List(pEVControl self, SConnection *pCon); + + +#endif + diff --git a/site_ansto/west4100driv.c b/site_ansto/west4100driv.c new file mode 100644 index 00000000..00e2c026 --- /dev/null +++ b/site_ansto/west4100driv.c @@ -0,0 +1,601 @@ +/*-------------------------------------------------------------------------- + W E S T 4 1 0 0 D R I V + + This file contains the implementation of a driver for the + Lakeshore 340 Temperature controller. + + + Mark Koennecke, Juli 1997 + Mark Lesha, January 2006 (based on ITC4 code) + Paul Barron, January 2008 (Note: This is based on the old LAKESHORE340 code and + not the new LS340 code written by Rodney Davies Feb 08) + + Copyright: + + Labor fuer Neutronenstreuung + Paul Scherrer Institut + CH-5423 Villigen-PSI + + + The authors hereby grant permission to use, copy, modify, distribute, + and license this software and its documentation for any purpose, provided + that existing copyright notices are retained in all copies and that this + notice is included verbatim in any distributions. No written agreement, + license, or royalty fee is required for any of the authorized uses. + Modifications to this software may be copyrighted by their authors + and need not follow the licensing terms described here, provided that + the new terms are clearly indicated on the first page of each file where + they apply. + + IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY + FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES + ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY + DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. + + THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE + IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE + NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR + MODIFICATIONS. +----------------------------------------------------------------------------*/ +#include +#include +#include +#include +#include +#include +#include +#include +#include + + typedef struct __EVDriver *pEVDriver; + +#include +/* Do we need these ? +#include +#include +*/ +#include +#include "hardsup/west4100util.h" +#include "hardsup/el734_def.h" +#include "hardsup/el734fix.h" + +#define SHITTYVALUE -777 +/*------------------------- The Driver ------------------------------------*/ + + pEVDriver CreateWEST4100Driver(int argc, char *argv[]); + int ConfigWEST4100(pEVDriver self); + + +/*-----------------------------------------------------------------------*/ + typedef struct { + pWEST4100 pData; + char *pHost; + int iPort; + int iChannel; + int iAddress; + int iNumSensors; + char iSensorList[10]; + char iControlSensor[10]; + int iTransaction; + int iProcessValue; + int iSetpoint; + int iWorkingSetpoint; + int iAlarm1; + int iAlarm2; + int iPowerLimit; + int iRampRate; + int iTmo; + int iLastError; + } WEST4100Driv, *pWEST4100Driv; +/*----------------------------------------------------------------------------*/ + static int GetWEST4100Pos(pEVDriver self, float *fPos) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv)self->pPrivate; + assert(pMe); + + iRet = WEST4100_Read(&pMe->pData,fPos); + if(iRet <= 0 ) + { + pMe->iLastError = iRet; + return 0; + } + if( (*fPos < 0) || (*fPos > 10000) ) + { + *fPos = -999.; + pMe->iLastError = SHITTYVALUE; + return 0; + } + return 1; + } +/*----------------------------------------------------------------------------*/ + static int WEST4100Run(pEVDriver self, float fVal) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet = WEST4100_Set(&pMe->pData,fVal); + if(iRet != 1) + { + pMe->iLastError = iRet; + return 0; + } + return 1; + } +/*--------------------------------------------------------------------------*/ + static int WEST4100Error(pEVDriver self, int *iCode, char *error, int iErrLen) + { + pWEST4100Driv pMe = NULL; + + assert(self); + pMe = (pWEST4100Driv)self->pPrivate; + assert(pMe); + + *iCode = pMe->iLastError; + if(pMe->iLastError == SHITTYVALUE) + { + strncpy(error,"Invalid temperature returned from WEST4100, check sensor",iErrLen); + } + else + { + WEST4100_ErrorTxt(&pMe->pData,pMe->iLastError,error,iErrLen); + } + return 1; + } +/*--------------------------------------------------------------------------*/ + static int WEST4100Send(pEVDriver self, char *pCommand, char *pReply, int iLen) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet = WEST4100_Send(&pMe->pData,pCommand, pReply,iLen); + if(iRet <= 0) + { + pMe->iLastError = iRet; + return 0; + } + return 1; + + } +/*--------------------------------------------------------------------------*/ + static int WEST4100Init(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + pMe->pData = NULL; + iRet = WEST4100_Open(&pMe->pData, pMe->pHost, pMe->iAddress, pMe->iTransaction); + if(iRet != 1) + { + if(iRet == WEST4100__NOWEST4100) + { + return -1; + } + else + { + pMe->iLastError = iRet; + return 0; + } + } + return 1; + } +/*--------------------------------------------------------------------------*/ + static int WEST4100Close(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + //int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Close(&pMe->pData); + return 1; + } +/*---------------------------------------------------------------------------*/ + static int WEST4100Fix(pEVDriver self, int iError) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + switch(iError) + { + /* network errors */ + case EL734__BAD_FLUSH: + case EL734__BAD_RECV: + case EL734__BAD_RECV_NET: + case EL734__BAD_RECV_UNKN: + case EL734__BAD_RECVLEN: + case EL734__BAD_RECV1: + case EL734__BAD_RECV1_PIPE: + case EL734__BAD_RNG: + case EL734__BAD_SEND: + case EL734__BAD_SEND_PIPE: + case EL734__BAD_SEND_NET: + case EL734__BAD_SEND_UNKN: + case EL734__BAD_SENDLEN: + WEST4100Close(self); + iRet = WEST4100Init(self); + if(iRet) + { + return DEVREDO; + } + else + { + return DEVFAULT; + } + break; + /* handable protocoll errors */ + case EL734__BAD_TMO: + return DEVREDO; + break; + case -501: /* Bad_COM */ + return DEVREDO; + case -504: /* Badly formatted */ + return DEVREDO; + default: + return DEVFAULT; + break; + } + return DEVFAULT; + } + +/*--------------------------------------------------------------------------*/ +#if 0 + static int WEST4100Halt(pEVDriver *self) + { + assert(self); + + return 1; + } +#endif +/*------------------------------------------------------------------------*/ + void KillWEST4100(void *pData) + { + pWEST4100Driv pMe = NULL; + + pMe = (pWEST4100Driv)pData; + assert(pMe); + + if(pMe->pHost) + { + free(pMe->pHost); + } + free(pMe); + } +/*------------------------------------------------------------------------*/ + pEVDriver CreateWEST4100Driver(int argc, char *argv[]) + { + pEVDriver pNew = NULL; + pWEST4100Driv pSim = NULL; + + /* check for arguments */ + if(argc < 3) + { + return NULL; + } + + pNew = CreateEVDriver(argc,argv); + pSim = (pWEST4100Driv)malloc(sizeof(WEST4100Driv)); + memset(pSim,0,sizeof(WEST4100Driv)); + if(!pNew || !pSim) + { + return NULL; + } + pNew->pPrivate = pSim; + pNew->KillPrivate = KillWEST4100; + + /* initalise pWEST4100Driver */ + // This is where parameters are initialised using values from the configuration file eg. sertemp 1 2 + pSim->iAddress = atoi(argv[1]); + pSim->iTransaction = atoi(argv[2]); + pSim->iLastError = 0; + pSim->iTmo = 10; + + pSim->pHost = strdup(argv[0]); + pSim->iPort = 0; + pSim->iChannel = 0; + + + /* initialise function pointers */ + pNew->SetValue = WEST4100Run; + pNew->GetValue = GetWEST4100Pos; + pNew->Send = WEST4100Send; + pNew->GetError = WEST4100Error; + pNew->TryFixIt = WEST4100Fix; + pNew->Init = WEST4100Init; + pNew->Close = WEST4100Close; + + return pNew; + } +/*--------------------------------------------------------------------------*/ + int ConfigWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet = WEST4100_Config(&pMe->pData, pMe->iTmo, pMe->iAddress,pMe->iTransaction); + if(iRet < 0) + { + pMe->iLastError = iRet; + return 0; + } + return 1; + } +/*-------------------------------------------------------------------------*/ + int WEST4100Query(pEVDriver self, int parameterAddress, int *parameterValue) + { + pWEST4100Driv pMe = NULL; + // int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + if((parameterAddress>0 && parameterAddress<=35) || (parameterAddress>=122 && parameterAddress<=133)) + return WEST4100_Query(&pMe->pData, parameterAddress, parameterValue); + else + printf("Parameter %d out of range.\n",parameterAddress); + + return 1; + } +/*-------------------------------------------------------------------------*/ + int WEST4100Write(pEVDriver self, int parameterAddress, int parameterValue) + { + pWEST4100Driv pMe = NULL; + // int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + if((parameterAddress>0 && parameterAddress<=35) || (parameterAddress>=122 && parameterAddress<=133)) + return WEST4100_Write(&pMe->pData, parameterAddress, parameterValue); + else + printf("Parameter %d out of range.\n",parameterAddress); + + return 0; + } +/*-------------------------------------------------------------------------*/ + int GetAddressWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + // int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + return pMe->iAddress; + } +/*-------------------------------------------------------------------------*/ + int GetTransactWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + // int iRet; + + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + return pMe->iTransaction; + } +/*-------------------------------------------------------------------------*/ + int GetProcessValueWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 1, &fVal); + + pMe->iProcessValue = fVal; + + return pMe->iProcessValue; + } +/*-------------------------------------------------------------------------*/ + int GetWorkingSetpointWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 21, &fVal); + + pMe->iWorkingSetpoint = fVal; + + return pMe->iWorkingSetpoint; + } +/*-------------------------------------------------------------------------*/ + int SetSetpointWEST4100(pEVDriver self, int Setpoint) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet=WEST4100_Write(&pMe->pData, 2, Setpoint); + + pMe->iSetpoint = Setpoint; + + return 1; + } +/*-------------------------------------------------------------------------*/ + int GetSetpointWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 2, &fVal); + + pMe->iSetpoint = fVal; + + return pMe->iSetpoint; + } +/*-------------------------------------------------------------------------*/ + int SetRampRateWEST4100(pEVDriver self, int RampRate) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet=WEST4100_Write(&pMe->pData, 24, RampRate); + + pMe->iRampRate = RampRate; + + return 1; + } +/*-------------------------------------------------------------------------*/ + int GetRampRateWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 24, &fVal); + + pMe->iRampRate = fVal; + + return pMe->iRampRate; + } +/*-------------------------------------------------------------------------*/ + int SetAlarm1WEST4100(pEVDriver self, int Alarm1) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet=WEST4100_Write(&pMe->pData, 13, Alarm1); + + pMe->iAlarm1 = Alarm1; + + return 1; + } + /*-------------------------------------------------------------------------*/ + int GetAlarm1WEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 13, &fVal); + + pMe->iAlarm1 = fVal; + + return pMe->iAlarm1; + } +/*-------------------------------------------------------------------------*/ + int SetAlarm2WEST4100(pEVDriver self, int Alarm2) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet=WEST4100_Write(&pMe->pData, 14, Alarm2); + + pMe->iAlarm2 = Alarm2; + + return 1; + } + /*-------------------------------------------------------------------------*/ + int GetAlarm2WEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 14, &fVal); + + pMe->iAlarm2 = fVal; + + return pMe->iAlarm2; + } +/*-------------------------------------------------------------------------*/ + int SetPowerLimitWEST4100(pEVDriver self, int PowerLimit) + { + pWEST4100Driv pMe = NULL; + int iRet; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + iRet=WEST4100_Write(&pMe->pData, 20, PowerLimit); + + pMe->iPowerLimit = PowerLimit; + + return 1; + } +/*-------------------------------------------------------------------------*/ + int GetPowerLimitWEST4100(pEVDriver self) + { + pWEST4100Driv pMe = NULL; + int fVal; + + assert(self); + pMe = (pWEST4100Driv )self->pPrivate; + assert(pMe); + + WEST4100_Query(&pMe->pData, 20, &fVal); + + pMe->iPowerLimit = fVal; + + return pMe->iPowerLimit; + }