From ee81bcc3b7d60867cb88e1b541ce3ad16863e9f8 Mon Sep 17 00:00:00 2001 From: cvs Date: Wed, 3 Sep 2003 14:01:02 +0000 Subject: [PATCH] - Added a means to overload or define drivable interfaces in tcl --- make_gen | 5 +- nserver.c | 12 +- ofac.c | 3 + sicsstatus.tcl | 3 - tcldrivable.c | 638 +++++++++++++++++++++++++++++++++++++++++++++++++ tcldrivable.h | 53 ++++ tcldrivable.w | 119 +++++++++ tclintimpl.c | 23 +- 8 files changed, 846 insertions(+), 10 deletions(-) create mode 100644 tcldrivable.c create mode 100644 tcldrivable.h create mode 100644 tcldrivable.w diff --git a/make_gen b/make_gen index 86ba7ae1..b3d4e556 100644 --- a/make_gen +++ b/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 diff --git a/nserver.c b/nserver.c index 426314b9..1e185f50 100644 --- a/nserver.c +++ b/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(); diff --git a/ofac.c b/ofac.c index 0ad4cc8d..0d334d4f 100644 --- a/ofac.c +++ b/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 diff --git a/sicsstatus.tcl b/sicsstatus.tcl index 31186de3..e69de29b 100644 --- a/sicsstatus.tcl +++ b/sicsstatus.tcl @@ -1,3 +0,0 @@ -# Counter counter -counter SetPreset 100.000000 -counter SetMode Monitor diff --git a/tcldrivable.c b/tcldrivable.c new file mode 100644 index 00000000..eb0bbaff --- /dev/null +++ b/tcldrivable.c @@ -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 +#include +#include "sics.h" +#include +#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; +} + + + + + + + diff --git a/tcldrivable.h b/tcldrivable.h new file mode 100644 index 00000000..d4f92088 --- /dev/null +++ b/tcldrivable.h @@ -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 + diff --git a/tcldrivable.w b/tcldrivable.w new file mode 100644 index 00000000..e48d5d30 --- /dev/null +++ b/tcldrivable.w @@ -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 + +@} + diff --git a/tclintimpl.c b/tclintimpl.c index 5ab50506..c94d54d6 100644 --- a/tclintimpl.c +++ b/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; } +