660 lines
17 KiB
C
660 lines
17 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) {
|
|
snprintf(pNum,sizeof(pNum)-1, "%f", fVal);
|
|
command = combine(commandPart1, pNum);
|
|
if (command) {
|
|
status = Tcl_Eval(pTcl, command);
|
|
if (status != TCL_OK) {
|
|
strlcpy(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
|
|
*/
|
|
snprintf(pNum,sizeof(pNum)-1, "%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;
|
|
}
|