576 lines
20 KiB
C
576 lines
20 KiB
C
/*--------------------------------------------------------------------------
|
|
|
|
Tcl interface functions for the SINQ histogram memory.
|
|
|
|
Mark Koennecke, April 1997
|
|
|
|
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 <string.h>
|
|
#include <stdlib.h>
|
|
#include <assert.h>
|
|
#include <tcl.h>
|
|
#include "fupa.h"
|
|
#include "sinqhm.h"
|
|
/*
|
|
as you are reading this: check if the typedefs below match your machine
|
|
*/
|
|
typedef short int SQint16; /* 16 bit integer */
|
|
typedef int SQint32; /* 32 bit integer */
|
|
|
|
/*--------------------------------------------------------------------------*/
|
|
static void SINQKill(void *pData)
|
|
{
|
|
pSINQHM self;
|
|
|
|
self = (pSINQHM)pData;
|
|
DeleteSINQHM(self);
|
|
}
|
|
|
|
/*--------------------------------------------------------------------------*/
|
|
static int DAQAction(ClientData pData, Tcl_Interp *interp,
|
|
int argc, char *argv[])
|
|
{
|
|
|
|
pSINQHM self;
|
|
int iMode, iDaq, iRank, iBin, iLength, iClients, iByte, i;
|
|
FuPaResult PaRes;
|
|
void *pBuffer;
|
|
SQint16 *pPtr16;
|
|
SQint32 *pPtr32;
|
|
char *pPtr, *pVal;
|
|
char pNumber[20];
|
|
char pIndex[20];
|
|
char **argx;
|
|
int iRet, status, iVal;
|
|
char pBueffel[256];
|
|
FuncTemplate BufferTemplate[] = {
|
|
{"read",4,{FUPAINT, FUPAINT, FUPAINT,FUPATEXT} },
|
|
{"write",4,{FUPAINT, FUPAINT, FUPAINT, FUPATEXT} },
|
|
{"zero",3,{FUPAINT,FUPAINT,FUPAINT}},
|
|
{"start",0,{FUPATEXT}},
|
|
{"stop",0,{FUPATEXT}},
|
|
{"inhibit",0,{FUPATEXT}},
|
|
{"continue",0,{FUPATEXT}},
|
|
};
|
|
|
|
self = (pSINQHM)pData;
|
|
assert(self);
|
|
|
|
/* parse function args */
|
|
argx = &argv[1];
|
|
iRet = EvaluateFuPa((pFuncTemplate)&BufferTemplate,7,argc-1,argx,&PaRes);
|
|
if(iRet < 0)
|
|
{
|
|
Tcl_AppendResult(interp,PaRes.pError,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
switch(iRet)
|
|
{
|
|
case 0: /* read */
|
|
/* get status first, in order to get info */
|
|
status = SINQHMGetStatus(self,&iMode, &iDaq,
|
|
&iRank,&iBin, &iLength,&iClients);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
/* calculate necessary buffer size */
|
|
iByte = iBin * PaRes.Arg[2].iVal;
|
|
pBuffer = NULL;
|
|
pBuffer = malloc(iByte);
|
|
if(!pBuffer)
|
|
{
|
|
Tcl_AppendResult(interp,"Out of memory in DAQAction",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* read histogram's */
|
|
status = SINQHMRead(self,PaRes.Arg[0].iVal,
|
|
PaRes.Arg[1].iVal,PaRes.Arg[2].iVal,
|
|
pBuffer, iByte);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* convert to list, depending on BinWidth */
|
|
if(iBin == 1) /* char's */
|
|
{
|
|
pPtr = (char *)pBuffer;
|
|
for(i = 0; i < PaRes.Arg[2].iVal; i++, pPtr++)
|
|
{
|
|
sprintf(pNumber,"%d",(int)*pPtr);
|
|
sprintf(pIndex,"%d",i);
|
|
Tcl_SetVar2(interp,argv[5],pIndex,pNumber,TCL_LEAVE_ERR_MSG);
|
|
}
|
|
free(pBuffer);
|
|
}
|
|
else if(iBin == 2)
|
|
{
|
|
pPtr16 = (SQint16 *)pBuffer;
|
|
for(i = 0; i < PaRes.Arg[2].iVal; i++, pPtr16++)
|
|
{
|
|
sprintf(pNumber,"%d",(int)*pPtr16);
|
|
sprintf(pIndex,"%d",i);
|
|
Tcl_SetVar2(interp,argv[5],pIndex,pNumber,TCL_LEAVE_ERR_MSG);
|
|
}
|
|
free(pBuffer);
|
|
}
|
|
else if(iBin == 4)
|
|
{
|
|
pPtr32 = (SQint32 *)pBuffer;
|
|
for(i = 0; i < PaRes.Arg[2].iVal; i++, pPtr32++)
|
|
{
|
|
sprintf(pNumber,"%d",(int)*pPtr32);
|
|
sprintf(pIndex,"%d",i);
|
|
Tcl_SetVar2(interp,argv[5],pIndex,pNumber,TCL_LEAVE_ERR_MSG);
|
|
}
|
|
free(pBuffer);
|
|
}
|
|
else
|
|
{
|
|
Tcl_AppendResult(interp,"Invalid bin width in DAQAction",NULL);
|
|
free(pBuffer);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 1: /* write */
|
|
/* get status first, in order to get info */
|
|
status = SINQHMGetStatus(self,&iMode, &iDaq,
|
|
&iRank,&iBin, &iLength,&iClients);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* calculate necessary buffer size */
|
|
iByte = iBin * PaRes.Arg[2].iVal;
|
|
pBuffer = NULL;
|
|
pBuffer = malloc(iByte);
|
|
if(!pBuffer)
|
|
{
|
|
Tcl_AppendResult(interp,"Out of memory in DAQAction",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
memset(pBuffer,0,iByte);
|
|
|
|
/* read data array into buffer, sorted for binwidth */
|
|
if(iBin == 1)
|
|
{
|
|
pPtr = pBuffer;
|
|
for(i = 0; i < PaRes.Arg[3].iVal; i++, pPtr++)
|
|
{
|
|
sprintf(pIndex,"%d",i);
|
|
pVal = Tcl_GetVar2(interp,argv[5],pIndex,TCL_LEAVE_ERR_MSG);
|
|
if(pVal)
|
|
{
|
|
Tcl_GetInt(interp,pVal,&iVal);
|
|
*pPtr = (char )iVal;
|
|
}
|
|
}
|
|
}
|
|
else if(iBin == 2)
|
|
{
|
|
pPtr16 = pBuffer;
|
|
for(i = 0; i < PaRes.Arg[3].iVal; i++, pPtr16++)
|
|
{
|
|
sprintf(pIndex,"%d",i);
|
|
pVal = Tcl_GetVar2(interp,argv[5],pIndex,TCL_LEAVE_ERR_MSG);
|
|
if(pVal)
|
|
{
|
|
Tcl_GetInt(interp,pVal,&iVal);
|
|
*pPtr16 = iVal;
|
|
}
|
|
}
|
|
}
|
|
else if(iBin == 4)
|
|
{
|
|
pPtr32 = pBuffer;
|
|
for(i = 0; i < PaRes.Arg[2].iVal; i++, pPtr32++)
|
|
{
|
|
sprintf(pIndex,"%d",i);
|
|
pVal = Tcl_GetVar2(interp,argv[5],pIndex,TCL_LEAVE_ERR_MSG);
|
|
if(pVal)
|
|
{
|
|
Tcl_GetInt(interp,pVal,&iVal);
|
|
*pPtr32 = iVal;
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
Tcl_AppendResult(interp,"Invalid bin width in DAQAction",NULL);
|
|
free(pBuffer);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* write ! */
|
|
status = SINQHMWrite(self,PaRes.Arg[0].iVal,
|
|
PaRes.Arg[1].iVal,PaRes.Arg[2].iVal,
|
|
pBuffer);
|
|
free(pBuffer);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 2: /* zero */
|
|
status = SINQHMZero(self,PaRes.Arg[0].iVal,
|
|
PaRes.Arg[1].iVal,PaRes.Arg[2].iVal);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 3: /* start */
|
|
status = SINQHMStartDAQ(self);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 4: /* stop */
|
|
status = SINQHMStopDAQ(self);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 5: /* inhibit */
|
|
status = SINQHMInhibitDAQ(self);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 6: /* continue */
|
|
status = SINQHMContinueDAQ(self);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
default:
|
|
Tcl_AppendResult(interp,"Internal error in DAQAction",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
return TCL_OK;
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
static int Text2Mode(char *text)
|
|
{
|
|
char *pText[] = {
|
|
"SQHM_TRANS",
|
|
"SQHM_HM_DIG",
|
|
"SQHM_HM_PSD",
|
|
"SQHM_HM_TOF",
|
|
NULL };
|
|
int i = 0;
|
|
while(pText[i] != NULL)
|
|
{
|
|
if(strcmp(text,pText[i]) == 0)
|
|
{
|
|
break;
|
|
}
|
|
i++;
|
|
}
|
|
|
|
switch(i)
|
|
{
|
|
case 0:
|
|
return SQHM__TRANS;
|
|
break;
|
|
case 1:
|
|
return SQHM__HM_DIG;
|
|
break;
|
|
case 2:
|
|
return SQHM__HM_PSD;
|
|
break;
|
|
case 3:
|
|
return SQHM__TOF;
|
|
break;
|
|
default:
|
|
return -1;
|
|
}
|
|
return -1;
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
static int Text2Modifier(char *text)
|
|
{
|
|
char *pText[] = {
|
|
"SQHM_DEBUG",
|
|
"SQHM_UD",
|
|
"SQHM_CNT_OR",
|
|
"SQHM_BO_MSK",
|
|
"SQHM_BO_IGN",
|
|
"SQHM_BO_SMAX",
|
|
"SQHM_BO_CNT",
|
|
"SQHM_STROBO",
|
|
"NULL",
|
|
NULL };
|
|
int i = 0;
|
|
while(pText[i] != NULL)
|
|
{
|
|
if(strcmp(text,pText[i]) == 0)
|
|
{
|
|
break;
|
|
}
|
|
i++;
|
|
}
|
|
|
|
switch(i)
|
|
{
|
|
case 0:
|
|
return SQHM__DEBUG;
|
|
break;
|
|
case 1:
|
|
return SQHM__UD;
|
|
break;
|
|
case 2:
|
|
return SQHM__CNT_OR;
|
|
break;
|
|
case 3:
|
|
return SQHM__BO_MSK;
|
|
break;
|
|
case 4:
|
|
return SQHM__BO_IGN;
|
|
break;
|
|
case 5:
|
|
return SQHM__BO_SMAX;
|
|
break;
|
|
case 6:
|
|
return SQHM__BO_CNT;
|
|
break;
|
|
case 7:
|
|
return SQHM__STROBO;
|
|
break;
|
|
case 8:
|
|
return 0;
|
|
break;
|
|
default:
|
|
return -1;
|
|
}
|
|
return -1;
|
|
}
|
|
|
|
/*--------------------------------------------------------------------------*/
|
|
static int ControlAction(ClientData pData, Tcl_Interp *interp,
|
|
int argc, char *argv[])
|
|
{
|
|
int iRet;
|
|
int status;
|
|
char **argx;
|
|
int iMode, iModifier, iDaq, iRank, iBin, iLength, iClients;
|
|
pSINQHM self;
|
|
pSINQHM pNew = NULL;
|
|
char pBueffel[256];
|
|
FuPaResult PaRes;
|
|
FuncTemplate BufferTemplate[] = {
|
|
{"config",5,{FUPATEXT, FUPATEXT, FUPAINT, FUPAINT, FUPAINT} },
|
|
{"deconfig",1,{FUPAINT} },
|
|
{"debug",1,{FUPAINT}},
|
|
{"exit",0,{FUPATEXT}},
|
|
{"DAQ",1,{FUPATEXT}},
|
|
{"status",0,{FUPATEXT}},
|
|
{"delDAQ",1,{FUPATEXT}}
|
|
};
|
|
|
|
self = (pSINQHM)pData;
|
|
assert(self);
|
|
|
|
/* parse function args */
|
|
argx = &argv[1];
|
|
iRet = EvaluateFuPa((pFuncTemplate)&BufferTemplate,6,argc-1,argx,&PaRes);
|
|
if(iRet < 0)
|
|
{
|
|
Tcl_AppendResult(interp,PaRes.pError,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
switch(iRet)
|
|
{
|
|
case 0: /* config */
|
|
iMode = Text2Mode(PaRes.Arg[0].text);
|
|
if(iMode < 0)
|
|
{
|
|
Tcl_AppendResult(interp,"Invalid Mode parameter",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
iModifier = Text2Modifier(PaRes.Arg[1].text);
|
|
if(iModifier < 0)
|
|
{
|
|
Tcl_AppendResult(interp,"Invalid Modifier parameter",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
iMode = iMode | iModifier;
|
|
status = SINQHMConfigure(self,iMode,
|
|
PaRes.Arg[2].iVal,PaRes.Arg[3].iVal,
|
|
PaRes.Arg[4].iVal,0,0);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 1: /* deconfig */
|
|
status = SINQHMDeconfigure(self,PaRes.Arg[0].iVal);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 2: /* debug */
|
|
status = SINQHMDebug(self,PaRes.Arg[0].iVal);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 3: /* exit */
|
|
status = SINQHMKill(self);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
break;
|
|
case 4: /* DAQ */
|
|
pNew = CopySINQHM(self);
|
|
if(!pNew)
|
|
{
|
|
Tcl_AppendResult(interp,"Memory error in ControlAction",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
status = SINQHMOpenDAQ(pNew);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
DeleteSINQHM(pNew);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* initialise internal data fields */
|
|
status = SINQHMGetStatus(self,&iMode, &iDaq,
|
|
&iRank,&iBin, &iLength,&iClients);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
SINQHMSetPar(pNew,iRank, iLength, iBin);
|
|
Tcl_CreateCommand(interp,strdup(argv[2]),DAQAction,pNew,
|
|
SINQKill);
|
|
break;
|
|
case 5: /* status */
|
|
status = SINQHMGetStatus(self,&iMode, &iDaq,
|
|
&iRank,&iBin, &iLength,&iClients);
|
|
if(status < 0)
|
|
{
|
|
SINQHMError2Text(status, pBueffel,131);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
sprintf(pBueffel,
|
|
"Mode = %d, DAQ = %d, Rank = %d, BinWidth = %d, Length = %d, NoClients = %d",
|
|
iMode, iDaq, iRank, iBin,iLength,iClients);
|
|
Tcl_AppendResult(interp,pBueffel,NULL);
|
|
break;
|
|
case 6: /* delDAQ */
|
|
return Tcl_DeleteCommand(interp,PaRes.Arg[0].text);
|
|
default:
|
|
Tcl_AppendResult(interp,"Internal error in ControlAction",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
return TCL_OK;
|
|
}
|
|
/*-------------------------------------------------------------------------*/
|
|
int SINQHM(ClientData pData, Tcl_Interp *interp,
|
|
int argc, char *argv[])
|
|
{
|
|
int iPort, status;
|
|
pSINQHM pNew = NULL;
|
|
|
|
/* check arguments, first number */
|
|
if(argc < 4)
|
|
{
|
|
Tcl_AppendResult(interp,"Insufficient number of arguments to ",
|
|
argv[0],NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* last argument must be port number */
|
|
status = Tcl_GetInt(interp,argv[3],&iPort);
|
|
if(status != TCL_OK)
|
|
{
|
|
return status;
|
|
}
|
|
|
|
/* open the HM */
|
|
pNew = CreateSINQHM(argv[2],iPort);
|
|
if(!pNew)
|
|
{
|
|
Tcl_AppendResult(interp,"Error allocating SINQHM datastructure",NULL);
|
|
return TCL_ERROR;
|
|
}
|
|
|
|
/* install the command */
|
|
Tcl_CreateCommand(interp,argv[1],ControlAction,pNew,SINQKill);
|
|
return TCL_OK;
|
|
}
|