526 lines
15 KiB
C
526 lines
15 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++) {
|
|
snprintf(pNumber,sizeof(pNumber)-1, "%d", (int) *pPtr);
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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++) {
|
|
snprintf(pNumber,sizeof(pNumber)-1, "%d", (int) *pPtr16);
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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++) {
|
|
snprintf(pNumber,sizeof(pNumber)-1, "%d", (int) *pPtr32);
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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++) {
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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++) {
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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++) {
|
|
snprintf(pIndex,sizeof(pIndex)-1, "%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;
|
|
}
|
|
snprintf(pBueffel,sizeof(pBueffel)-1,
|
|
"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;
|
|
}
|