b737b4d936
- Added a log facility to scan which includes a variable which is logged but not driven during a scan. - Fixed normal beam operation
640 lines
16 KiB
C
640 lines
16 KiB
C
/*-----------------------------------------------------------------------
|
|
The code in this file allows to override or define Drivable
|
|
interfaces through tcl scripts. For more details, see
|
|
tcldrivable.tex
|
|
|
|
copyright: see file COPYRIGHT
|
|
|
|
Mark Koennecke, September 2003
|
|
----------------------------------------------------------------------*/
|
|
#include <stdio.h>
|
|
#include <assert.h>
|
|
#include "sics.h"
|
|
#include <tcl.h>
|
|
#include "fortify.h"
|
|
#include "lld.h"
|
|
#include "tcldrivable.h"
|
|
|
|
/*----------------------------------------------------------------------
|
|
The index of the list used for keeping the dictionary for mapping drivable
|
|
interface functions to scripts.
|
|
-------------------------------------------------------------------------*/
|
|
static int tclDrivableDictionary = -1;
|
|
|
|
/*=======================================================================
|
|
The structure used for keeping data associated with this scheme
|
|
--------------------------------------------------------------------------*/
|
|
typedef struct{
|
|
void *objectPointer;
|
|
char *tclName;
|
|
char *tclHalt;
|
|
char *tclCheckLimits;
|
|
char *tclSetValue;
|
|
char *tclCheckStatus;
|
|
char *tclGetValue;
|
|
}TclDrivable, *pTclDrivable;
|
|
|
|
/*=========================================================================
|
|
book keeping and search functions for the dictionary
|
|
-------------------------------------------------------------------------*/
|
|
static void clearTclDrivable(pTclDrivable pNew){
|
|
memset(pNew,0,sizeof(TclDrivable));
|
|
}
|
|
/*-----------------------------------------------------------------------*/
|
|
static void deleteTclDrivable(pTclDrivable target){
|
|
if(target->tclName != NULL){
|
|
free(target->tclName);
|
|
}
|
|
if(target->tclHalt != NULL){
|
|
free(target->tclHalt);
|
|
}
|
|
if(target->tclCheckLimits != NULL){
|
|
free(target->tclCheckLimits);
|
|
}
|
|
if(target->tclSetValue != NULL){
|
|
free(target->tclSetValue);
|
|
}
|
|
if(target->tclCheckStatus != NULL){
|
|
free(target->tclCheckStatus);
|
|
}
|
|
if(target->tclGetValue != NULL){
|
|
free(target->tclGetValue);
|
|
}
|
|
}
|
|
/*-------------- compare function for lld to find key in list
|
|
Function must return 0 if found --------*/
|
|
static int tclDrivableCompare(const void *p1, const void *p2){
|
|
pTclDrivable pt1, pt2;
|
|
|
|
pt1 = (pTclDrivable)p1;
|
|
pt2 = (pTclDrivable)p2;
|
|
|
|
if(pt1->objectPointer == pt2->objectPointer){
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
/*--------------- assignFunction --------------------------------------*/
|
|
static void assignFunction(pTclDrivable self, int functionIndex,
|
|
char *script){
|
|
switch(functionIndex){
|
|
case TCLHALT:
|
|
if(self->tclHalt != NULL){
|
|
free(self->tclHalt);
|
|
}
|
|
self->tclHalt = strdup(script);
|
|
break;
|
|
case TCLCHECK:
|
|
if(self->tclCheckLimits != NULL){
|
|
free(self->tclCheckLimits);
|
|
}
|
|
self->tclCheckLimits = strdup(script);
|
|
break;
|
|
case TCLSET:
|
|
if(self->tclSetValue != NULL){
|
|
free(self->tclSetValue);
|
|
}
|
|
self->tclSetValue = strdup(script);
|
|
break;
|
|
case TCLSTATUS:
|
|
if(self->tclCheckStatus != NULL){
|
|
free(self->tclCheckStatus);
|
|
}
|
|
self->tclCheckStatus = strdup(script);
|
|
break;
|
|
case TCLGET:
|
|
if(self->tclGetValue != NULL){
|
|
free(self->tclGetValue);
|
|
}
|
|
self->tclGetValue = strdup(script);
|
|
break;
|
|
default:
|
|
assert(0);
|
|
}
|
|
}
|
|
/*-----------------------------------------------------------------------*/
|
|
static int registerTclDrivableFunction(void *objectPointer,
|
|
int functionIndex,
|
|
char *script,
|
|
char *tclName){
|
|
TclDrivable entry;
|
|
|
|
/*
|
|
if no list: create it
|
|
*/
|
|
if(tclDrivableDictionary < 0){
|
|
tclDrivableDictionary = LLDcreate(sizeof(TclDrivable));
|
|
}
|
|
|
|
/*
|
|
find entry, or create a new one if it does not exist
|
|
*/
|
|
LLDnodePtr2First(tclDrivableDictionary);
|
|
entry.objectPointer = objectPointer;
|
|
if(LLDnodeFind(tclDrivableDictionary,tclDrivableCompare,
|
|
&entry) == 0){
|
|
LLDnodeDataTo(tclDrivableDictionary,&entry);
|
|
if(strcmp(tclName,entry.tclName) != 0){
|
|
return 0;
|
|
}
|
|
assignFunction(&entry,functionIndex,script);
|
|
LLDnodeDataFrom(tclDrivableDictionary,&entry);
|
|
} else {
|
|
clearTclDrivable(&entry);
|
|
entry.objectPointer = objectPointer;
|
|
entry.tclName = strdup(tclName);
|
|
assignFunction(&entry,functionIndex,script);
|
|
LLDnodeAppendFrom(tclDrivableDictionary,&entry);
|
|
}
|
|
return 1;
|
|
}
|
|
/*-----------------------------------------------------------------*/
|
|
static char *combine(char *t1, char *t2){
|
|
char *result = NULL;
|
|
int len;
|
|
|
|
len = strlen(t1) + strlen(t2) + 3;
|
|
result = (char *)malloc(len*sizeof(char));
|
|
if(!result){
|
|
return NULL;
|
|
}
|
|
memset(result,0,len);
|
|
strcpy(result,t1);
|
|
strcat(result," ");
|
|
strcat(result,t2);
|
|
return result;
|
|
}
|
|
/*------------------------------------------------------------------*/
|
|
static char *getTclDrivableCommand(void *objectPointer,
|
|
int functionIndex){
|
|
TclDrivable entry;
|
|
|
|
assert(tclDrivableDictionary > 0);
|
|
LLDnodePtr2First(tclDrivableDictionary);
|
|
entry.objectPointer = objectPointer;
|
|
if(LLDnodeFind(tclDrivableDictionary,tclDrivableCompare,&entry) == 0){
|
|
LLDnodeDataTo(tclDrivableDictionary,&entry);
|
|
switch(functionIndex){
|
|
case TCLHALT:
|
|
return combine(entry.tclHalt,entry.tclName);
|
|
break;
|
|
case TCLCHECK:
|
|
return combine(entry.tclCheckLimits,entry.tclName);
|
|
break;
|
|
case TCLSET:
|
|
return combine(entry.tclSetValue,entry.tclName);
|
|
break;
|
|
case TCLSTATUS:
|
|
return combine(entry.tclCheckStatus,entry.tclName);
|
|
break;
|
|
case TCLGET:
|
|
return combine(entry.tclGetValue,entry.tclName);
|
|
break;
|
|
default:
|
|
assert(0);
|
|
}
|
|
} else {
|
|
return NULL;
|
|
}
|
|
}
|
|
/*---------------------------------------------------------------------------*/
|
|
void killTclDrivable(){
|
|
TclDrivable entry;
|
|
int stat;
|
|
|
|
if(tclDrivableDictionary > 0){
|
|
stat = LLDnodePtr2First(tclDrivableDictionary);
|
|
while(stat != 0){
|
|
LLDnodeDataTo(tclDrivableDictionary,&entry);
|
|
deleteTclDrivable(&entry);
|
|
stat = LLDnodePtr2Next(tclDrivableDictionary);
|
|
}
|
|
LLDdelete(tclDrivableDictionary);
|
|
tclDrivableDictionary = -1;
|
|
}
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
int mapDrivableFunctionNames(char *name){
|
|
if(strcmp(name,"halt") == 0){
|
|
return TCLHALT;
|
|
}
|
|
if(strcmp(name,"checklimits") == 0){
|
|
return TCLCHECK;
|
|
}
|
|
if(strcmp(name,"setvalue") == 0){
|
|
return TCLSET;
|
|
}
|
|
if(strcmp(name,"checkstatus") == 0){
|
|
return TCLSTATUS;
|
|
}
|
|
if(strcmp(name,"getvalue") == 0){
|
|
return TCLGET;
|
|
}
|
|
return -1;
|
|
}
|
|
/*===========================================================================
|
|
The functions with which to overload the original functions
|
|
----------------------------------------------------------------------------*/
|
|
static int TclDrivableHalt(void *data){
|
|
char *command = NULL;
|
|
Tcl_Interp *pTcl;
|
|
int status;
|
|
|
|
pTcl = InterpGetTcl(pServ->pSics);
|
|
command = getTclDrivableCommand(data,TCLHALT);
|
|
if(command != NULL){
|
|
status = Tcl_Eval(pTcl,command);
|
|
if(status != TCL_OK){
|
|
fprintf(stderr,"Tcl ERROR: while invoking %s\n\tTcl reported %s\n",
|
|
command,pTcl->result);
|
|
status = 0 ;
|
|
} else {
|
|
status = 1;
|
|
}
|
|
free(command);
|
|
} else {
|
|
status = 0;
|
|
fprintf(stderr,"Tcl ERROR: trying to invoke non existent Tcl %s\n",
|
|
"drivable halt function");
|
|
}
|
|
return status;
|
|
}
|
|
/*--------------------------------------------------------------------*/
|
|
static int TclDrivableCheckLimits(void *data, float fVal,
|
|
char *error, int errlen){
|
|
char *commandPart1 = NULL;
|
|
char *command = NULL;
|
|
char pNum[30];
|
|
Tcl_Interp *pTcl;
|
|
int status;
|
|
|
|
pTcl = InterpGetTcl(pServ->pSics);
|
|
commandPart1 = getTclDrivableCommand(data,TCLCHECK);
|
|
if(commandPart1 != NULL){
|
|
sprintf(pNum,"%f",fVal);
|
|
command = combine(commandPart1,pNum);
|
|
if(command){
|
|
status = Tcl_Eval(pTcl,command);
|
|
if(status != TCL_OK){
|
|
strncpy(error,pTcl->result,errlen);
|
|
status = 0;
|
|
} else {
|
|
status = 1;
|
|
}
|
|
free(command);
|
|
} else {
|
|
fprintf(stderr,"Out of memory creating drivable command\n");
|
|
status = 0;
|
|
}
|
|
free(commandPart1);
|
|
} else {
|
|
status = 0;
|
|
fprintf(stderr,"Tcl ERROR: trying to invoke non existent Tcl %s\n",
|
|
"drivable CheckLimits function");
|
|
}
|
|
return status;
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
static long TclDrivableSetValue(void *data, SConnection *pCon, float fVal){
|
|
Tcl_Interp *pTcl;
|
|
int status;
|
|
char *commandHead = NULL, *command = NULL;
|
|
char pNum[30];
|
|
|
|
pTcl = InterpGetTcl(pServ->pSics);
|
|
|
|
/*
|
|
build and check command string
|
|
*/
|
|
sprintf(pNum,"%f", fVal);
|
|
commandHead = getTclDrivableCommand(data,TCLSET);
|
|
if(commandHead == NULL){
|
|
SCWrite(pCon,
|
|
"ERROR: trying to invoke non existent Tcl drivable function SetValue",
|
|
eError);
|
|
return HWFault;
|
|
}
|
|
command = combine(commandHead,pNum);
|
|
if(command == NULL){
|
|
SCWrite(pCon,"ERROR: out of memory creating tcl drivable SetValue command",
|
|
eError);
|
|
return HWFault;
|
|
}
|
|
|
|
/*
|
|
invoke
|
|
*/
|
|
status = Tcl_Eval(pTcl,command);
|
|
free(command);
|
|
free(commandHead);
|
|
|
|
if(status != TCL_OK){
|
|
SCWrite(pCon,"ERROR: Tcl drivable SetValue reported",eError);
|
|
SCWrite(pCon,pTcl->result,eError);
|
|
return HWFault;
|
|
}
|
|
|
|
status = atoi(pTcl->result);
|
|
return status;
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
static int TclDrivableCheckStatus(void *data, SConnection *pCon){
|
|
Tcl_Interp *pTcl;
|
|
int status;
|
|
char *command = NULL;
|
|
|
|
pTcl = InterpGetTcl(pServ->pSics);
|
|
|
|
/*
|
|
build and check command string
|
|
*/
|
|
command = getTclDrivableCommand(data,TCLSTATUS);
|
|
if(command == NULL){
|
|
SCWrite(pCon,
|
|
"ERROR: Tcl drivable CheckStatus not found!",
|
|
eError);
|
|
return HWFault;
|
|
}
|
|
|
|
/*
|
|
invoke
|
|
*/
|
|
status = Tcl_Eval(pTcl,command);
|
|
free(command);
|
|
|
|
if(status != TCL_OK){
|
|
SCWrite(pCon,"ERROR: Tcl drivable CheckStatus reported",eError);
|
|
SCWrite(pCon,pTcl->result,eError);
|
|
return HWFault;
|
|
}
|
|
|
|
status = atoi(pTcl->result);
|
|
return status;
|
|
}
|
|
/*--------------------------------------------------------------------------*/
|
|
static float TclDrivableGetValue(void *data, SConnection *pCon){
|
|
Tcl_Interp *pTcl;
|
|
int status;
|
|
char *command = NULL;
|
|
|
|
pTcl = InterpGetTcl(pServ->pSics);
|
|
|
|
/*
|
|
build and check command string
|
|
*/
|
|
command = getTclDrivableCommand(data,TCLGET);
|
|
if(command == NULL){
|
|
SCWrite(pCon,
|
|
"ERROR: Tcl drivable GetValue not found!",
|
|
eError);
|
|
return -999999.99;
|
|
}
|
|
|
|
/*
|
|
invoke
|
|
*/
|
|
status = Tcl_Eval(pTcl,command);
|
|
free(command);
|
|
|
|
if(status != TCL_OK){
|
|
SCWrite(pCon,"ERROR: Tcl drivable GetValue reported",eError);
|
|
SCWrite(pCon,pTcl->result,eError);
|
|
return -99999.99;
|
|
}
|
|
|
|
return atof(pTcl->result);
|
|
}
|
|
/*======================================================================
|
|
The function for doing it alltogether
|
|
------------------------------------------------------------------------*/
|
|
int replaceDrivableByTcl(void *commandData, int functionIndex,
|
|
char *script, char *tclName){
|
|
pIDrivable pDriv = NULL;
|
|
int status;
|
|
|
|
pDriv = GetDrivableInterface(commandData);
|
|
assert(pDriv != NULL);
|
|
|
|
/*
|
|
register the new script
|
|
*/
|
|
status = registerTclDrivableFunction(commandData,functionIndex,
|
|
script,tclName);
|
|
if(status <= 0){
|
|
return status;
|
|
}
|
|
|
|
/*
|
|
replace the appropriate Drivable function
|
|
*/
|
|
switch(functionIndex){
|
|
case TCLHALT:
|
|
pDriv->Halt = TclDrivableHalt;
|
|
break;
|
|
case TCLCHECK:
|
|
pDriv->CheckLimits = TclDrivableCheckLimits;
|
|
break;
|
|
case TCLSET:
|
|
pDriv->SetValue = TclDrivableSetValue;
|
|
break;
|
|
case TCLSTATUS:
|
|
pDriv->CheckStatus = TclDrivableCheckStatus;
|
|
break;
|
|
case TCLGET:
|
|
pDriv->GetValue = TclDrivableGetValue;
|
|
break;
|
|
default:
|
|
assert(0);
|
|
break;
|
|
}
|
|
return 1;
|
|
}
|
|
/*=========================================================================
|
|
Interpreter Interface
|
|
------------------------------------------------------------------------*/
|
|
int TclReplaceDrivable(SConnection *pCon, SicsInterp *pSics,
|
|
void *pData, int argc, char *argv[]){
|
|
pIDrivable pDriv = NULL;
|
|
void *commandData;
|
|
CommandList *pCom = NULL;
|
|
int functionIndex, status;
|
|
char pBueffel[256];
|
|
|
|
/*
|
|
only managers can do this!
|
|
*/
|
|
if(!SCMatchRights(pCon,usMugger)){
|
|
return 0;
|
|
}
|
|
|
|
/*
|
|
we need tons of arguments!
|
|
*/
|
|
if(argc < 5){
|
|
SCWrite(pCon,"ERROR: not enough arguments to TclReplaceDrivable",
|
|
eError);
|
|
return 0;
|
|
}
|
|
|
|
/*
|
|
get and check object
|
|
*/
|
|
strtolower(argv[1]);
|
|
pDriv = FindDrivable(pSics,argv[1]);
|
|
if(!pDriv){
|
|
snprintf(pBueffel,255,"ERROR: %s is not drivable!",argv[1]);
|
|
SCWrite(pCon,pBueffel,eError);
|
|
return 0;
|
|
}
|
|
/*
|
|
This must work as FindDrivable could not work else
|
|
*/
|
|
pCom = FindCommand(pSics,argv[1]);
|
|
commandData = pCom->pData;
|
|
|
|
/*
|
|
convert and check function name
|
|
*/
|
|
strtolower(argv[2]);
|
|
functionIndex = mapDrivableFunctionNames(argv[2]);
|
|
if(functionIndex <= 0){
|
|
snprintf(pBueffel,255,
|
|
"ERROR: %s is not a known function name for drivable",
|
|
argv[2]);
|
|
SCWrite(pCon,pBueffel,eError);
|
|
return 0;
|
|
}
|
|
|
|
status = replaceDrivableByTcl(commandData,functionIndex,argv[3],
|
|
argv[4]);
|
|
if(status <= 0){
|
|
SCWrite(pCon,"ERROR mismatch in parameter tclName",eError);
|
|
return 0;
|
|
}
|
|
SCSendOK(pCon);
|
|
return 1;
|
|
}
|
|
/*-----------------------------------------------------------------------*/
|
|
int TclDrivableInvoke(SConnection *pCon, SicsInterp *pSics,
|
|
void *pData, int argc, char *argv[]){
|
|
pIDrivable pDriv = NULL;
|
|
void *commandData;
|
|
CommandList *pCom = NULL;
|
|
int functionIndex, status;
|
|
char pBueffel[256], pError[132];
|
|
float fVal;
|
|
|
|
/*
|
|
we need tons of arguments!
|
|
*/
|
|
if(argc < 3){
|
|
SCWrite(pCon,"ERROR: not enough arguments to TclDrivableInvoke",
|
|
eError);
|
|
return 0;
|
|
}
|
|
|
|
/*
|
|
get and check object
|
|
*/
|
|
strtolower(argv[1]);
|
|
pDriv = FindDrivable(pSics,argv[1]);
|
|
if(!pDriv){
|
|
snprintf(pBueffel,255,"ERROR: %s is not drivable!",argv[1]);
|
|
SCWrite(pCon,pBueffel,eError);
|
|
return 0;
|
|
}
|
|
/*
|
|
This must work as FindDrivable could not work else
|
|
*/
|
|
pCom = FindCommand(pSics,argv[1]);
|
|
commandData = pCom->pData;
|
|
|
|
/*
|
|
convert and check function name
|
|
*/
|
|
strtolower(argv[2]);
|
|
functionIndex = mapDrivableFunctionNames(argv[2]);
|
|
if(functionIndex <= 0){
|
|
snprintf(pBueffel,255,
|
|
"ERROR: %s is not a known function name for drivable",
|
|
argv[2]);
|
|
SCWrite(pCon,pBueffel,eError);
|
|
return 0;
|
|
}
|
|
|
|
/*
|
|
invoke and report
|
|
*/
|
|
memset(pError,0,132*sizeof(char));
|
|
switch(functionIndex){
|
|
case TCLHALT:
|
|
if(!pDriv->Halt){
|
|
SCWrite(pCon,"ERROR: no drivable Halt function!",eError);
|
|
return 0;
|
|
}
|
|
status = pDriv->Halt(commandData);
|
|
snprintf(pBueffel,255,"Drivable Halt returned: %d",status);
|
|
SCWrite(pCon,pBueffel,eValue);
|
|
break;
|
|
case TCLCHECK:
|
|
if(!pDriv->CheckLimits){
|
|
SCWrite(pCon,"ERROR: no drivable CheckLimits function!",eError);
|
|
return 0;
|
|
}
|
|
if(argc < 4){
|
|
SCWrite(pCon,"ERROR: need drive target for CheckLimits",eError);
|
|
return 0;
|
|
}
|
|
status = pDriv->CheckLimits(commandData,atof(argv[3]),pError,131);
|
|
snprintf(pBueffel,255,"Drivable CheckLimits returned: %d, %s",
|
|
status,pError);
|
|
SCWrite(pCon,pBueffel,eValue);
|
|
break;
|
|
case TCLSET:
|
|
if(!pDriv->SetValue){
|
|
SCWrite(pCon,"ERROR: no drivable SetValue function!",eError);
|
|
return 0;
|
|
}
|
|
if(argc < 4){
|
|
SCWrite(pCon,"ERROR: need drive target for SetValue",eError);
|
|
return 0;
|
|
}
|
|
status = (int)pDriv->SetValue(commandData,pCon,atof(argv[3]));
|
|
snprintf(pBueffel,255,"Drivable SetValue returned %d", status);
|
|
SCWrite(pCon,pBueffel,eValue);
|
|
break;
|
|
case TCLSTATUS:
|
|
if(!pDriv->CheckStatus){
|
|
SCWrite(pCon,"ERROR: no drivable CheckStatus function!",eError);
|
|
return 0;
|
|
}
|
|
status = pDriv->CheckStatus(commandData,pCon);
|
|
snprintf(pBueffel,255,"Drivable CheckStatus returned %d", status);
|
|
SCWrite(pCon,pBueffel,eValue);
|
|
break;
|
|
case TCLGET:
|
|
if(!pDriv->GetValue){
|
|
SCWrite(pCon,"ERROR: no drivable GetValue function!",eError);
|
|
return 0;
|
|
}
|
|
fVal = pDriv->GetValue(commandData,pCon);
|
|
snprintf(pBueffel,255,"Drivable GetValue returned: %f", fVal);
|
|
SCWrite(pCon,pBueffel,eValue);
|
|
break;
|
|
default:
|
|
/*
|
|
do not know how I could get here
|
|
*/
|
|
assert(0);
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|