- Added a means to overload or define drivable interfaces in tcl
This commit is contained in:
cvs
5
make_gen
5
make_gen
@ -26,13 +26,12 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.o \
|
||||
simchop.o choco.o chadapter.o trim.o scaldate.o \
|
||||
hklscan.o xytable.o \
|
||||
circular.o maximize.o sicscron.o \
|
||||
d_sign.o d_mod.o \
|
||||
d_sign.o d_mod.o tcldrivable.o \
|
||||
synchronize.o definealias.o \
|
||||
hmcontrol.o userscan.o rs232controller.o lomax.o \
|
||||
fourlib.o motreg.o motreglist.o anticollider.o \
|
||||
s_rnge.o sig_die.o gpibcontroller.o $(NIOBJ) \
|
||||
hmdata.o nxscript.o \
|
||||
tclintimpl.o sicsdata.o
|
||||
hmdata.o nxscript.o tclintimpl.o sicsdata.o
|
||||
|
||||
MOTOROBJ = motor.o simdriv.o
|
||||
COUNTEROBJ = countdriv.o simcter.o counter.o
|
||||
|
||||
12
nserver.c
12
nserver.c
@ -34,6 +34,7 @@
|
||||
#include "ofac.h"
|
||||
#include "telnet.h"
|
||||
#include "site.h"
|
||||
#include "tcldrivable.h"
|
||||
#include "nserver.h"
|
||||
|
||||
int ServerSetupInterrupt(int iPort, pNetRead pNet, pTaskMan pTasker);
|
||||
@ -360,9 +361,6 @@
|
||||
/* Remove Status Callback */
|
||||
KillStatus(NULL);
|
||||
|
||||
/* close the List system */
|
||||
LLDsystemClose();
|
||||
|
||||
/*
|
||||
kill the site data structure
|
||||
*/
|
||||
@ -372,6 +370,14 @@
|
||||
site->KillSite(site);
|
||||
}
|
||||
|
||||
/*
|
||||
kill overloaded interfaces data
|
||||
*/
|
||||
killTclDrivable();
|
||||
|
||||
/* close the List system */
|
||||
LLDsystemClose();
|
||||
|
||||
/* make fortify print his findings */
|
||||
Fortify_DumpAllMemory(iFortifyScope);
|
||||
Fortify_LeaveScope();
|
||||
|
||||
3
ofac.c
3
ofac.c
@ -99,6 +99,7 @@
|
||||
#include "gpibcontroller.h"
|
||||
#include "nxscript.h"
|
||||
#include "tclintimpl.h"
|
||||
#include "tcldrivable.h"
|
||||
#include "sicsdata.h"
|
||||
#include "site.h"
|
||||
/*----------------------- Server options creation -------------------------*/
|
||||
@ -268,6 +269,8 @@
|
||||
AddCommand(pInter,"MakeGPIB",MakeGPIB,NULL,NULL);
|
||||
AddCommand(pInter,"MakeNXScript",MakeNXScript,NULL,NULL);
|
||||
AddCommand(pInter,"MakeTclInt",MakeTclInt,NULL,NULL);
|
||||
AddCommand(pInter,"TclReplaceDrivable",TclReplaceDrivable,NULL,NULL);
|
||||
AddCommand(pInter,"DrivableInvoke", TclDrivableInvoke,NULL,NULL);
|
||||
|
||||
/*
|
||||
install site specific commands
|
||||
|
||||
@ -1,3 +0,0 @@
|
||||
# Counter counter
|
||||
counter SetPreset 100.000000
|
||||
counter SetMode Monitor
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
53
tcldrivable.h
Normal file
53
tcldrivable.h
Normal file
@ -0,0 +1,53 @@
|
||||
|
||||
/*-----------------------------------------------------------------------
|
||||
The code in this file allows to override or define Drivable
|
||||
interfaces through tcl scripts. More more details, see
|
||||
tcldrivable.tex
|
||||
|
||||
copyright: see file COPYRIGHT
|
||||
|
||||
Mark Koennecke, September 2003
|
||||
----------------------------------------------------------------------*/
|
||||
#ifndef SICSTCLDRIVABLE
|
||||
#define SICSTCLDRIVABLE
|
||||
|
||||
/*
|
||||
Function codes for functionIndex
|
||||
*/
|
||||
#define TCLHALT 1
|
||||
#define TCLCHECK 2
|
||||
#define TCLSET 3
|
||||
#define TCLSTATUS 4
|
||||
#define TCLGET 5
|
||||
|
||||
/*
|
||||
This installs a Tcl replacement for a drivable function
|
||||
*/
|
||||
int TclReplaceDrivable(SConnection *pCon, SicsInterp *pSics,
|
||||
void *pData, int argc, char *argv[]);
|
||||
/*
|
||||
This allows to invoke a replaced function for debugging
|
||||
purposes
|
||||
*/
|
||||
int TclDrivableInvoke(SConnection *pCon, SicsInterp *pSics,
|
||||
void *pData, int argc, char *argv[]);
|
||||
|
||||
/*
|
||||
This is for use from C
|
||||
*/
|
||||
int replaceDrivableByTcl(void *sicsObject, int functionIndex,
|
||||
char *scriptName, char *tclName);
|
||||
|
||||
/*
|
||||
map name to a functionIndex for use in replaceDrivableByTcl.
|
||||
Returns 0 on failure, a usefule index > 0 in the case of success
|
||||
*/
|
||||
int mapDrivableFunctionNames(char *name);
|
||||
|
||||
/*
|
||||
This is called from StopServer/nserver.c in order to remove
|
||||
all memory related to this class
|
||||
*/
|
||||
void killTclDrivable(void);
|
||||
#endif
|
||||
|
||||
119
tcldrivable.w
Normal file
119
tcldrivable.w
Normal file
@ -0,0 +1,119 @@
|
||||
\subsection{Tcl Drivable Interface}
|
||||
This is a module which allows to override or specify a drivable
|
||||
interface through Tcl procedures. The corresponding member function
|
||||
of the drivable interface will be replaced by a function which does
|
||||
the following things:
|
||||
\begin{itemize}
|
||||
\item Given the object pointer as key, it will find a data structure
|
||||
which holds the name of the Tcl procedure to invoke and a user
|
||||
specified name (general to this interface) which the Tcl procedure can
|
||||
use in order to locate instance specific data.
|
||||
\item With this data, a Tcl command is constructed.
|
||||
\item This Tcl command is then invoked.
|
||||
\item Suitable Tcl commands return the numeric equivalents of the HW*
|
||||
codes returned by the equivalent ANSII C functions.
|
||||
\end{itemize}
|
||||
Overrriding a drivable interface functions is done by a call like:
|
||||
\begin{verbatim}
|
||||
DrivableTclReplace objectName functionName tclReplaceProcedure tclName
|
||||
\end{verbatim}
|
||||
|
||||
In order to implement a drivable completely in Tcl, create an empty
|
||||
object with MakeTclInt and assign functions with
|
||||
DrivableTclReplace. Please note that SICS will die if any of the
|
||||
required functions is left out!
|
||||
|
||||
The first thing needed in order to implement this scheme is a data
|
||||
structure holding the necessary information. This data structure also
|
||||
doubles as an entry into the dictionary for mapping object pointers to
|
||||
the corresponding data structure. This dictionary is implemented on
|
||||
top of the general linked list package used within SICS. The index to
|
||||
this linked list is kept as a module static within the implementation
|
||||
file for this object. This is also where the original for this data
|
||||
structure is placed.
|
||||
|
||||
\begin{verbatim}
|
||||
struct{
|
||||
void *objectPointer;
|
||||
char *tclName;
|
||||
char *tclHalt;
|
||||
char *tclCheckLimits;
|
||||
char *tclSetValue;
|
||||
char *tclCheckStatus;
|
||||
char *tclGetValue;
|
||||
}TclDrivable, *pTclDrivable;
|
||||
\end{verbatim}
|
||||
|
||||
The fields in this data structure:
|
||||
\begin{description}
|
||||
\item[objectPointer] A pointer to the SICS object this overloaded
|
||||
interface belongs to. Also used as key in searches.
|
||||
\item[tclName] The name passed over to the Tcl procedures in order to
|
||||
allow them to find application specific data.
|
||||
\item[tclHalt] A replacement Halt Tcl script.
|
||||
\item[tclCheckLimits] A Tcl script for replacing the CheckLimits
|
||||
function.
|
||||
\item[tclSetvalue] A replacement for the Setvalue function.
|
||||
\item[tclCheckStatus] a replacement for the CheckStatus function.
|
||||
\item[tclGetValue] a replacement for the GetValue function.
|
||||
\end{description}
|
||||
|
||||
The interface of this module to SICS is mainly its interpreter
|
||||
functions. In order to allow for configuring Tcl functions from C a
|
||||
function is provided.
|
||||
|
||||
@o tcldrivable.h @{
|
||||
/*-----------------------------------------------------------------------
|
||||
The code in this file allows to override or define Drivable
|
||||
interfaces through tcl scripts. More more details, see
|
||||
tcldrivable.tex
|
||||
|
||||
copyright: see file COPYRIGHT
|
||||
|
||||
Mark Koennecke, September 2003
|
||||
----------------------------------------------------------------------*/
|
||||
#ifndef SICSTCLDRIVABLE
|
||||
#define SICSTCLDRIVABLE
|
||||
|
||||
/*
|
||||
Function codes for functionIndex
|
||||
*/
|
||||
#define TCLHALT 1
|
||||
#define TCLCHECK 2
|
||||
#define TCLSET 3
|
||||
#define TCLSTATUS 4
|
||||
#define TCLGET 5
|
||||
|
||||
/*
|
||||
This installs a Tcl replacement for a drivable function
|
||||
*/
|
||||
int TclReplaceDrivable(SConnection *pCon, SicsInterp *pSics,
|
||||
void *pData, int argc, char *argv[]);
|
||||
/*
|
||||
This allows to invoke a replaced function for debugging
|
||||
purposes
|
||||
*/
|
||||
int TclDrivableInvoke(SConnection *pCon, SicsInterp *pSics,
|
||||
void *pData, int argc, char *argv[]);
|
||||
|
||||
/*
|
||||
This is for use from C
|
||||
*/
|
||||
int replaceDrivableByTcl(void *sicsObject, int functionIndex,
|
||||
char *scriptName, char *tclName);
|
||||
|
||||
/*
|
||||
map name to a functionIndex for use in replaceDrivableByTcl.
|
||||
Returns 0 on failure, a usefule index > 0 in the case of success
|
||||
*/
|
||||
int mapDrivableFunctionNames(char *name);
|
||||
|
||||
/*
|
||||
This is called from StopServer/nserver.c in order to remove
|
||||
all memory related to this class
|
||||
*/
|
||||
void killTclDrivable(void);
|
||||
#endif
|
||||
|
||||
@}
|
||||
|
||||
23
tclintimpl.c
23
tclintimpl.c
@ -19,6 +19,7 @@
|
||||
/*================== our data structure ===================================*/
|
||||
typedef struct {
|
||||
pObjectDescriptor pDes;
|
||||
pIDrivable pDriv;
|
||||
char *saveScript;
|
||||
FILE *fd;
|
||||
} tclInt, *pTclInt;
|
||||
@ -48,6 +49,20 @@ static int TclSaveStatus(void *pData, char *name, FILE *fd){
|
||||
|
||||
return 1;
|
||||
}
|
||||
/*-----------------------------------------------------------------------*/
|
||||
static void *TclGetInterface(void *pData, int id){
|
||||
pTclInt self = NULL;
|
||||
self = (pTclInt)pData;
|
||||
if(self == NULL){
|
||||
return NULL;
|
||||
}
|
||||
|
||||
if(id == DRIVEID){
|
||||
return self->pDriv;
|
||||
} else {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
/*======================== data structure creation and deletion ==========*/
|
||||
static pTclInt MakeTclIntData(void){
|
||||
pTclInt pNew = NULL;
|
||||
@ -59,7 +74,9 @@ static pTclInt MakeTclIntData(void){
|
||||
memset(pNew,0,sizeof(tclInt));
|
||||
pNew->pDes = CreateDescriptor("SICS Interfaces in Tcl");
|
||||
pNew->pDes->SaveStatus = TclSaveStatus;
|
||||
if(!pNew->pDes){
|
||||
pNew->pDes->GetInterface = TclGetInterface;
|
||||
pNew->pDriv = CreateDrivableInterface();
|
||||
if(!pNew->pDes || !pNew->pDriv){
|
||||
free(pNew);
|
||||
return NULL;
|
||||
}
|
||||
@ -80,6 +97,9 @@ static void KillTclInt(void *pData){
|
||||
if(self->saveScript != NULL){
|
||||
free(self->saveScript);
|
||||
}
|
||||
if(self->pDriv){
|
||||
free(self->pDriv);
|
||||
}
|
||||
free(self);
|
||||
}
|
||||
/*=============== interpreter interface + helper functions =============*/
|
||||
@ -154,3 +174,4 @@ int TclIntAction(SConnection *pCon, SicsInterp *pSics, void *pData,
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user