- Added a means to overload or define drivable interfaces in tcl
This commit is contained in:
cvs
638
tcldrivable.c
Normal file
638
tcldrivable.c
Normal file
@ -0,0 +1,638 @@
|
||||
/*-----------------------------------------------------------------------
|
||||
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
|
||||
*/
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user