From 3168325921e00d550a80249197030b5e9ed670d4 Mon Sep 17 00:00:00 2001 From: Ferdi Franceschini Date: Mon, 12 Feb 2007 12:20:21 +1100 Subject: [PATCH] PSI update r1464 | ffr | 2007-02-12 12:20:21 +1100 (Mon, 12 Feb 2007) | 2 lines --- HistDriv.i | 11 +- HistMem.h | 16 +- HistMem.i | 6 +- SCinter.c | 69 +- Scommon.h | 3 +- anticollider.c | 1 + conman.c | 91 +- conman.h | 10 + countdriv.h | 6 + counter.c | 14 +- devexec.c | 36 +- devexec.h | 10 +- devexec.tex | 2 + devexec.w | 2 + doc/manager/nxscript.htm | 18 +- doc/manager/nxupdate.htm | 3 + doc/manager/tas.htm | 31 + doc/user/commandlog.htm | 5 + doc/user/exeman.html | 14 +- doc/user/optimise.htm | 24 +- doc/user/sansdocbook.xml | 5284 ++++++++++++++++++++++++ doc/user/tasub.htm | 6 + evcontroller.c | 8 +- event.c | 5 + event.h | 22 +- event.tex | 7 + event.w | 7 + exe.w | 1 + exebuf.h | 4 +- exebuf.i | 4 +- exeman.c | 56 + exeman.h | 1 + exeman.i | 4 +- fitcenter.c | 13 + fourlib.c | 24 + hdbcommand.c | 291 ++ hdbcommand.h | 96 + hipadaba.c | 353 +- hipadaba.h | 119 +- histmem.c | 87 +- histogram.tex | 3 + histogram.w | 3 + histregress.c | 273 ++ histsim.c | 9 +- hkl.c | 89 +- hkl.i | 1 - hkl.tex | 1 - hkl.w | 1 - hmcontrol.c | 2 +- hmdata.c | 130 +- hmdata.h | 4 +- hmdata.w | 6 +- initializer.c | 57 +- initializer.h | 6 +- lin2ang.c | 4 +- linux_def | 2 +- macro.c | 134 +- macro.h | 3 + make_gen | 12 +- makefile_linux | 12 +- makefile_slinux | 2 +- maximize.c | 110 +- mcstas/dmc/README | 36 + mcstas/dmc/dmcafter.c | 8454 ++++++++++++++++++++++++++++++++++++++ mcstas/dmc/nxdmc.tcl | 27 +- mcstas/dmc/vdmc.tcl | 109 +- mcstas/dmc/vdmccom.tcl | 22 +- mesure.c | 64 +- modriv.h | 1 + moregress.c | 258 ++ motor.c | 36 +- motor.h | 8 + multicounter.c | 429 ++ multicounter.h | 19 + mumoconf.c | 8 +- network.c | 14 +- nread.c | 7 + nserver.c | 8 +- nxscript.c | 65 +- nxutil.c | 15 +- obdes.c | 2 +- ofac.c | 17 +- optimise.c | 84 +- outcode.c | 3 +- polldriv.c | 97 + polldriv.h | 42 + polldriv.tc | 88 + protocol.c | 83 +- protocol.h | 1 + regresscter.c | 262 ++ remob.c | 7 +- rs232controller.c | 36 + rs232controller.h | 1 + scan.c | 23 +- sics.h | 2 +- sicscron.c | 34 +- sicsdata.c | 160 +- sicsdata.h | 7 + sicsdata.w | 9 + sicshdbadapter.c | 513 +++ sicshdbadapter.h | 23 + sicshipadaba.c | 1653 ++++++-- sicshipadaba.h | 161 +- sicspoll.c | 360 ++ sicspoll.h | 53 + sicspoll.tc | 306 ++ sicsstat.tcl | 26 +- sicstemplates.tcl | 107 + simcter.c | 2 +- splitter.c | 27 +- splitter.h | 6 + statemon.c | 322 ++ statemon.h | 21 + statistics.c | 63 +- stringdict.c | 3 +- tasdrive.c | 46 +- tasub.c | 239 +- tasublib.c | 123 +- tasublib.h | 22 + tcl/analyzedevexeclog | 274 ++ tcl/gumxml.tcl | 51 + tcl/makemodrivskel | 177 + tcl/ritaframe | 51 + tcl/tjxp | 73 + tcl/tjxphelp | 38 + test/DataNumber | 3 + test/batchtest.tcl | 128 + test/countertest.tcl | 271 ++ test/histtest.tcl | 342 ++ test/interrupt.tcl | 14 + test/job1.tcl | 5 + test/job2.tcl | 6 + test/job3.tcl | 6 + test/job4.tcl | 5 + test/mottest.tcl | 303 ++ test/nxscripttest.tcl | 106 + test/object.tcl | 305 ++ test/optitest.tcl | 171 + test/scancommand.tcl | 486 +++ test/scantest.tcl | 177 + test/sicsdatasoll.dat | 23 + test/sicsstat.tcl | 163 + test/sicstcldebug.tcl | 40 + test/tcltest.tcl | 3354 +++++++++++++++ test/test.dic | 31 + test/test.hdd | 7 + test/testinc.tcl | 10 + test/testini.tcl | 196 + test/testmisc.tcl | 21 + test/testmumo.tcl | 80 + test/testsics | 60 + test/testsicsdata.tcl | 218 + test/testsoll.xml | 79 + test/testtasub.tcl | 265 ++ test/testutil.tcl | 165 + tmp/hdbscan.tcl | 9 + velo.c | 8 +- 157 files changed, 29053 insertions(+), 910 deletions(-) create mode 100644 doc/user/sansdocbook.xml create mode 100644 hdbcommand.c create mode 100644 hdbcommand.h create mode 100644 histregress.c create mode 100644 mcstas/dmc/README create mode 100644 mcstas/dmc/dmcafter.c create mode 100644 moregress.c create mode 100644 multicounter.c create mode 100644 multicounter.h create mode 100644 polldriv.c create mode 100644 polldriv.h create mode 100644 polldriv.tc create mode 100644 regresscter.c create mode 100644 sicshdbadapter.c create mode 100644 sicshdbadapter.h create mode 100644 sicspoll.c create mode 100644 sicspoll.h create mode 100644 sicspoll.tc create mode 100644 sicstemplates.tcl create mode 100644 statemon.c create mode 100644 statemon.h create mode 100755 tcl/analyzedevexeclog create mode 100644 tcl/gumxml.tcl create mode 100755 tcl/makemodrivskel create mode 100755 tcl/ritaframe create mode 100755 tcl/tjxp create mode 100644 tcl/tjxphelp create mode 100644 test/DataNumber create mode 100644 test/batchtest.tcl create mode 100644 test/countertest.tcl create mode 100644 test/histtest.tcl create mode 100755 test/interrupt.tcl create mode 100644 test/job1.tcl create mode 100644 test/job2.tcl create mode 100644 test/job3.tcl create mode 100644 test/job4.tcl create mode 100644 test/mottest.tcl create mode 100644 test/nxscripttest.tcl create mode 100644 test/object.tcl create mode 100644 test/optitest.tcl create mode 100644 test/scancommand.tcl create mode 100644 test/scantest.tcl create mode 100644 test/sicsdatasoll.dat create mode 100644 test/sicsstat.tcl create mode 100644 test/sicstcldebug.tcl create mode 100644 test/tcltest.tcl create mode 100644 test/test.dic create mode 100644 test/test.hdd create mode 100644 test/testinc.tcl create mode 100644 test/testini.tcl create mode 100644 test/testmisc.tcl create mode 100644 test/testmumo.tcl create mode 100755 test/testsics create mode 100644 test/testsicsdata.tcl create mode 100644 test/testsoll.xml create mode 100644 test/testtasub.tcl create mode 100644 test/testutil.tcl create mode 100644 tmp/hdbscan.tcl diff --git a/HistDriv.i b/HistDriv.i index ae5e646d..1e033d86 100644 --- a/HistDriv.i +++ b/HistDriv.i @@ -1,5 +1,5 @@ -#line 462 "histogram.w" +#line 465 "histogram.w" /*--------------------------------------------------------------------------- H I S T D R I V @@ -58,6 +58,9 @@ SConnection *pCon); float (*GetTime)(pHistDriver self, SConnection *pCon); + HistInt *(*SubSample)(pHistDriver self, + SConnection *pCon,int bank, + char *command); int (*Preset)(pHistDriver self, SConnection *pCon, HistInt iVal); @@ -69,17 +72,17 @@ void *pPriv; } HistDriver; -#line 474 "histogram.w" +#line 477 "histogram.w" -#line 229 "histogram.w" +#line 232 "histogram.w" pHistDriver CreateHistDriver(pStringDict pDict); void DeleteHistDriver(pHistDriver self); int HistDriverConfig(pHistDriver self, pStringDict pOpt, SConnection *pCon); -#line 475 "histogram.w" +#line 478 "histogram.w" #endif diff --git a/HistMem.h b/HistMem.h index a05cb32f..b0872505 100644 --- a/HistMem.h +++ b/HistMem.h @@ -1,5 +1,5 @@ -#line 435 "histogram.w" +#line 438 "histogram.w" /*-------------------------------------------------------------------------- H I S T M E M @@ -42,22 +42,22 @@ eReflect } OverFlowMode; -#line 455 "histogram.w" +#line 458 "histogram.w" /*--------------------------------------------------------------------------*/ -#line 287 "histogram.w" +#line 290 "histogram.w" pHistMem CreateHistMemory(char *drivername); void DeleteHistMemory(void *self); -#line 303 "histogram.w" +#line 306 "histogram.w" int HistGetOption(pHistMem self, char *name, char *result, int iResultLen); int HistSetOption(pHistMem self, char *name, char *value); int HistConfigure(pHistMem self, SConnection *pCon, SicsInterp *pSics); -#line 331 "histogram.w" +#line 334 "histogram.w" float GetHistPreset(pHistMem self); int SetHistPreset(pHistMem self, float fVal); @@ -73,7 +73,7 @@ void HistDirty(pHistMem self); -#line 361 "histogram.w" +#line 364 "histogram.w" int SetHistogram(pHistMem self, SConnection *pCon, int i,int iStart, int iEnd, HistInt *lData); @@ -85,7 +85,7 @@ HistInt *lData, int iDataLen); int PresetHistogram(pHistMem self, SConnection *pCon, HistInt lVal); -#line 404 "histogram.w" +#line 407 "histogram.w" int MakeHistMemory(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); @@ -94,7 +94,7 @@ int argc, char *argv[]); -#line 457 "histogram.w" +#line 460 "histogram.w" #endif diff --git a/HistMem.i b/HistMem.i index c3bc4a22..8ff674ed 100644 --- a/HistMem.i +++ b/HistMem.i @@ -1,5 +1,5 @@ -#line 480 "histogram.w" +#line 483 "histogram.w" /*--------------------------------------------------------------------------- H I S T M E M -- Internal @@ -11,7 +11,7 @@ #ifndef SICSHISTMEMINT #define SICSHISTMEMINT -#line 251 "histogram.w" +#line 254 "histogram.w" typedef struct __HistMem { pObjectDescriptor pDes; @@ -23,7 +23,7 @@ pICallBack pCall; } HistMem; -#line 490 "histogram.w" +#line 493 "histogram.w" #endif diff --git a/SCinter.c b/SCinter.c index 52d10f11..1ba7f178 100644 --- a/SCinter.c +++ b/SCinter.c @@ -41,7 +41,7 @@ Mark Koennecke, August 2001, modified SicsWriteStatus to write motor positions on demand. - Made ListObjects moe intelligent: list objects according to interface etc. + Made ListObjects more intelligent: list objects according to interface etc. Mark Koennecke, December 2003 Extended 'dir' command (function ListObjects) to list via typename from @@ -50,6 +50,8 @@ Modified printXXX functions to fix duplicate write of last buffer line. Paul Hathaway, May 2004 + + Added FindAlias function, Mark Koennecke, January 2007 ---------------------------------------------------------------------------*/ #include #include @@ -67,6 +69,7 @@ #include "motor.h" #include "obdes.h" #include "lld.h" +#include "dynstring.h" /* M.Z. */ #include "definealias.h" @@ -134,6 +137,7 @@ static void freeList(int listID); SICSLogWrite(pBueffel,eInternal); return 0; } + memset(pNew,0,sizeof(CommandList)); /* if no data given, initialise with Dummy struct */ if(!pData) @@ -431,7 +435,7 @@ extern char *SkipSpace(char *pPtr); } if(fVal > -990.) { - fprintf(fd,"run %s %f\n",pCurrent->pName, fVal); + fprintf(fd,"drive %s %f\n",pCurrent->pName, fVal); } } } @@ -1041,3 +1045,64 @@ static void freeList(int listID) pCurrent = pNext; } } +/*---------------------------------------------------------------------*/ +char *FindAliases(SicsInterp *pSics, char *name) +{ + pDynString result = NULL; + CommandList *pOri = NULL, *pCom = NULL; + char *pTrans = NULL, *charResult = NULL; + int first; + + pOri = FindCommand(pSics, name); + if(pOri == NULL) + { + return NULL; + } + if(pOri->pData == NULL) + { + return NULL; + } + + result = CreateDynString(64,64); + if(result == NULL) + { + return NULL; + } + + /* try first to locate Markus style aliases */ + pTrans = TranslateAlias(&pSics->AList,name); + if(strcmp(pTrans,name) != 0) + { + DynStringCopy(result,pTrans); + charResult = strdup(GetCharArray(result)); + DeleteDynString(result); + return charResult; + } + + /* + * locate SicsAlias style aliases by comparing the original + * data pointer with the data pointers of other commands + */ + first = 1; + pCom = pSics->pCList; + while(pCom != NULL) + { + if(pCom != pOri && pCom->pData == pOri->pData) + { + if(first) + { + DynStringCopy(result,pCom->pName); + first = 0; + } + else + { + DynStringConcat(result,","); + DynStringConcat(result,pCom->pName); + } + } + pCom = pCom->pNext; + } + charResult = strdup(GetCharArray(result)); + DeleteDynString(result); + return charResult; +} diff --git a/Scommon.h b/Scommon.h index 7cc639c1..bf7da342 100644 --- a/Scommon.h +++ b/Scommon.h @@ -51,7 +51,8 @@ typedef enum { eEvent, eWarning, eError, - eHdb + eHdbValue, + eHdbEvent } OutCode; #include "interrupt.h" diff --git a/anticollider.c b/anticollider.c index f17fc583..6c58dbee 100644 --- a/anticollider.c +++ b/anticollider.c @@ -113,6 +113,7 @@ static long ColliderSetValue(void *pData, SConnection *pCon, float fTarget){ iRet = Tcl_Eval(pServ->pSics->pTcl,Tcl_DStringValue(&command)); if(iRet != TCL_OK){ SCWrite(pCon,"ERROR: Movement not possible or bad collider script",eError); + SCWrite(pCon,Tcl_DStringValue(&command),eError); /* SCWrite(pCon,pServ->pSics->pTcl->result,eError); */ diff --git a/conman.c b/conman.c index c341ec79..3f4378b1 100644 --- a/conman.c +++ b/conman.c @@ -39,6 +39,8 @@ fields. Mark Koennecke, December 2004 + Aded buffering support, Mark Koennecke, July 2006 + Copyright: see copyright.h -----------------------------------------------------------------------------*/ #include "fortify.h" @@ -92,6 +94,8 @@ extern pServer pServ; static int iName = 0; static SConnection *freeConnections = NULL; static long lastIdent = 0; +/*------------- sending connection (prevent double write when listening) ----*/ + static SConnection *sendingConnection = NULL; /*===========================================================================*/ static char *ConName(long ident) { static char name[32]; @@ -457,6 +461,11 @@ extern pServer pServ; DeleteCommandStack(pVictim->pStack); } + /* remove possible buffers */ + if(pVictim->data != NULL) + { + DeleteDynString(pVictim->data); + } pVictim->lMagic=0; /* make a write to a freed connection harmless */ /* finally free pVictim*/ @@ -692,10 +701,21 @@ static void writeToLogFiles(SConnection *self, char *buffer) SICSLogWrite(buffer,iOut); /* write to commandlog if user or manager privilege */ - if(SCGetRights(self) <= usUser && self->iMacro != 1) + if(SCGetRights(self) <= usUser) { - sprintf(pBueffel,"To sock %d :",iRet); - WriteToCommandLog(pBueffel,buffer); + if(self->iMacro != 1) + { + sprintf(pBueffel,"To sock %d :",iRet); + WriteToCommandLog(pBueffel,buffer); + } + else + { + if(iOut == eError || iOut == eWarning) + { + sprintf(pBueffel,"To sock %d :",iRet); + WriteToCommandLog(pBueffel,buffer); + } + } } /* put it into the interpreter if present */ @@ -754,7 +774,9 @@ static void writeToLogFiles(SConnection *self, char *buffer) if(SCGetRights(self) <= usUser && self->iMacro != 1) { sprintf(pBueffel,"To sock %d :",iRet); + sendingConnection = self; WriteToCommandLog(pBueffel,buffer); + sendingConnection = NULL; } /* @@ -809,6 +831,52 @@ static void writeToLogFiles(SConnection *self, char *buffer) free(bufPtr); return 1; } +/*-------------------------------------------------------------------------*/ +static int SCBufferWrite(SConnection *self, char *buffer, int iOut) +{ + if(!VerifyConnection(self)) + { + return 0; + } + assert(self->data != NULL); + DynStringConcat(self->data,buffer); + if(strchr(buffer,'\n') == NULL){ + DynStringConcat(self->data,"\n"); + } + return 1; +} +/*-------------------------------------------------------------------------*/ +int SCStartBuffering(SConnection *pCon) +{ + if(!VerifyConnection(pCon)) + { + return 0; + } + if(pCon->data != NULL) + { + DeleteDynString(pCon->data); + } + pCon->data = CreateDynString(128,128); + if(pCon->data == NULL) + { + return 0; + } + pCon->oldWriteFunc = pCon->write; + pCon->write = SCBufferWrite; + return 1; +} +/*-------------------------------------------------------------------------*/ +pDynString SCEndBuffering(SConnection *pCon) +{ + if(!VerifyConnection(pCon)) + { + return 0; + } + assert(pCon->oldWriteFunc != NULL); + pCon->write = pCon->oldWriteFunc; + pCon->oldWriteFunc = NULL; + return pCon->data; +} /*--------------------------------------------------------------------------*/ int SCOnlySockWrite(SConnection *self, char *buffer, int iOut) { @@ -1378,7 +1446,16 @@ static void writeToLogFiles(SConnection *self, char *buffer) { strcat(pBueffel,"CONT or CRON>> "); } - WriteToCommandLog(pBueffel,pCommand); + /* + * This is a fix to suppress cron messages in the success + * case + */ + if(SCGetWriteFunc(self) != SCNotWrite) + { + sendingConnection = self; + WriteToCommandLog(pBueffel,pCommand); + sendingConnection = NULL; + } } /* invoke */ @@ -1900,8 +1977,8 @@ static void writeToLogFiles(SConnection *self, char *buffer) SCSetRights(self,iRet); pHost[0] = '\0'; NETInfo(self->pSock,pHost,131); - sprintf(pBueffel,"Accepted connection on socket %d from %s", - self->pSock->sockid, pHost); + sprintf(pBueffel,"Accepted connection %s on socket %d from %s", + ConName(self->ident), self->pSock->sockid, pHost); SICSLogWrite(pBueffel,eInternal); WriteToCommandLog("SYS >", pBueffel); free(pPtr); @@ -1965,7 +2042,7 @@ static void writeToLogFiles(SConnection *self, char *buffer) else if(iSignal == COMLOG && self->listening == 1) { pPtr = (char *)pSigData; - if(pPtr != NULL) + if(pPtr != NULL && self != sendingConnection) { doSockWrite(self,pPtr); } diff --git a/conman.h b/conman.h index 17928a5b..af9fd299 100644 --- a/conman.h +++ b/conman.h @@ -24,6 +24,7 @@ #include "network.h" #include "obdes.h" #include "commandcontext.h" +#include "dynstring.h" #define MAXLOGFILES 10 @@ -59,6 +60,12 @@ typedef int (*writeFunc)(struct __SConnection *pCon, int iGrab; /* grab flag for token*/ int parameterChange; int sicsError; + + /* + * for I/O Buffering + */ + pDynString data; + writeFunc oldWriteFunc; /* stuff supporting the sycamore protocol and a @@ -116,6 +123,9 @@ typedef int (*writeFunc)(struct __SConnection *pCon, int SCNotWrite(SConnection *self, char *buffer, int iOut); int SCNormalWrite(SConnection *self, char *buffer, int iOut); int SCWriteWithOutcode(SConnection *self, char *buffer, int iOut); +/*********************** I/O Buffering ***********************************/ + int SCStartBuffering(SConnection *pCon); + pDynString SCEndBuffering(SConnection *pCon); /************************* CallBack *********************************** */ int SCRegister(SConnection *pCon, SicsInterp *pSics, void *pInter, long lID); diff --git a/countdriv.h b/countdriv.h index 4bb86fed..4f7603aa 100644 --- a/countdriv.h +++ b/countdriv.h @@ -88,4 +88,10 @@ * file: mcstascounter.c */ pCounterDriver NewMcStasCounter(char *name); + + /* + * for regression testing + * file: regresscter.c + */ + pCounterDriver NewRegressCounter(char *name); #endif diff --git a/counter.c b/counter.c index a29a443f..7f585787 100644 --- a/counter.c +++ b/counter.c @@ -103,9 +103,9 @@ if(iRet == OKOK) { self->isUpToDate = 0; - self->badStatusCount = 0; + self->badStatusCount = 0; self->tStart = time(&tX); - InvokeCallBack(self->pCall,COUNTSTART,pCon); + InvokeCallBack(self->pCall,COUNTSTART,pCon); return iRet; } else @@ -314,7 +314,7 @@ for(i = 0; i < 3; i++) { iRet = self->pDriv->ReadValues(self->pDriv); - if(iRet) + if(iRet == OKOK) { self->isUpToDate = 1; return OKOK; @@ -529,6 +529,13 @@ } } + /* + * test for regression testing counter + */ + if(strcmp(argv[2],"regress") == 0){ + pDriv = NewRegressCounter(argv[1]); + } + /* * test for McStas simulation counter driver */ @@ -907,6 +914,7 @@ SCSendOK(pCon); return 1; case 11: /* status */ + self->pCountInt->TransferData(self,pCon); if(GetCounterMode(self) == ePreset) { sprintf(pBueffel,"%s.CountStatus = %d %d Beam: %ld E6", diff --git a/devexec.c b/devexec.c index 88ff73c7..bfd6911f 100644 --- a/devexec.c +++ b/devexec.c @@ -70,18 +70,23 @@ static FILE *devLog = NULL; int openDevexecLog(){ char *fileName = NULL; char fileBuffer[1024]; + time_t iDate; + struct tm *psTime; + if(devLog == NULL){ fileName = IFindOption(pSICSOptions,"devexeclog"); if(fileName != NULL){ strcpy(fileBuffer,fileName); } else { + iDate = time(NULL); + psTime = localtime(&iDate); fileBuffer[0] = '\0'; fileName = getenv("HOME"); if(fileName != NULL){ - strcpy(fileBuffer,fileName); + snprintf(fileBuffer,1023,"%s/log/devexec%4.4d.log", + fileName, psTime->tm_year + 1900); } - strcat(fileBuffer,"/log/devexec.log"); } devLog = fopen(fileBuffer,"a+"); } @@ -168,6 +173,20 @@ typedef struct { } ExeList; static pExeList pExecutor = NULL; +/*--------------------------------------------------------------------------*/ + static void *DevexecInterface(void *pData, int iInter) + { + pExeList self = NULL; + + self = (pExeList)pData; + assert(self); + + if(iInter == CALLBACKINTERFACE) + { + return self->pCall; + } + return NULL; + } /*--------------------------------------------------------------------------*/ pExeList CreateExeList(pTaskMan pTask) { @@ -200,8 +219,10 @@ typedef struct { pRes->lTask = -1; pRes->iLock = 0; pRes->drivePrint = 0; + pRes->paused = 0; pRes->pCall = CreateCallBackInterface(); pRes->lastRun = time(NULL); + pRes->pDes->GetInterface = DevexecInterface; return pRes; } /*-------------------------------------------------------------------------*/ @@ -508,7 +529,7 @@ typedef struct { ExeInterest(self, pDev, "finished"); DeleteDevEntry(pDev); LLDnodeDelete(self->iList); - SCWrite(pCon, "Finished", eFinish); + SCWrite(pCon, "", eFinish); iRet = LLDnodePtr2Prev(self->iList); if(SCGetInterrupt(self->pOwner) != eContinue) { @@ -667,7 +688,6 @@ static int errorDevice(pCheckContext pCheck){ ExeInterest(pCheck->self, pCheck->pDev, "finished with problem"); DevexecLog("STOP",pCheck->pDev->name); - DeleteDevEntry(pCheck->pDev); LLDnodeDelete(pCheck->self->iList); status = LLDnodePtr2Prev(pCheck->self->iList); SCWrite(pCheck->self->pOwner, "", eFinish); @@ -675,7 +695,9 @@ static int errorDevice(pCheckContext pCheck){ if(pCheck->pDrivInt != NULL) { pCheck->pDrivInt->iErrorCount++; } - return checkInterrupt(pCheck,status); + status = checkInterrupt(pCheck,status); + DeleteDevEntry(pCheck->pDev); + return status; } /*-------------------------------------------------------------------------*/ static int testFinish(pExeList self){ @@ -1121,7 +1143,7 @@ static int testFinish(pExeList self){ { ListPending(self,pCon); return 1; - } + } iRet = StopExe(self,argv[1]); if(!iRet) @@ -1143,7 +1165,7 @@ static int testFinish(pExeList self){ SCPopContext(pCon); return 1; } -/*--------------------------------------------------------------------------*/ + /*--------------------------------------------------------------------------*/ int ListExe(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]) { diff --git a/devexec.h b/devexec.h index 49ed26ea..028d5e37 100644 --- a/devexec.h +++ b/devexec.h @@ -118,6 +118,8 @@ #line 259 "devexec.w" /*-------------------------- Commands ------------------------------------*/ + int DevexecAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); int StopCommand(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); /* @@ -152,11 +154,7 @@ /* continues execution */ - int DevexecAction(SConnection *pCon, SicsInterp *pSics, void *pData, - int argc, char *argv[]); - /* - * various commands - */ + /*--------------------------- Locking ---------------------------------*/ #line 183 "devexec.w" @@ -165,7 +163,7 @@ void UnlockDeviceExecutor(pExeList self); -#line 297 "devexec.w" +#line 299 "devexec.w" /* -------------------------- Executor management -------------------------*/ diff --git a/devexec.tex b/devexec.tex index 20dd2e56..6ebd2463 100644 --- a/devexec.tex +++ b/devexec.tex @@ -312,6 +312,8 @@ to the global SICS device executor. \mbox{}\verb@/*-------------------------------------------------------------------------*/@\\ \mbox{}\verb@@$\langle$devstop {\footnotesize ?}$\rangle$\verb@@\\ \mbox{}\verb@/*-------------------------- Commands ------------------------------------*/@\\ +\mbox{}\verb@ int DevexecAction(SConnection *pCon, SicsInterp *pSics, void *pData,@\\ +\mbox{}\verb@ int argc, char *argv[]);@\\ \mbox{}\verb@ int StopCommand(SConnection *pCon, SicsInterp *pSics, void *pData,@\\ \mbox{}\verb@ int argc, char *argv[]);@\\ \mbox{}\verb@ /*@\\ diff --git a/devexec.w b/devexec.w index f97023f3..12acf662 100644 --- a/devexec.w +++ b/devexec.w @@ -258,6 +258,8 @@ to the global SICS device executor. /*-------------------------------------------------------------------------*/ @ /*-------------------------- Commands ------------------------------------*/ + int DevexecAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); int StopCommand(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); /* diff --git a/doc/manager/nxscript.htm b/doc/manager/nxscript.htm index 04db765e..6a0492c5 100644 --- a/doc/manager/nxscript.htm +++ b/doc/manager/nxscript.htm @@ -104,7 +104,7 @@ the dictionary file: would denote the normal counting tube at a scanning type of experiment. -
nxscript puthm hmAlias hmName ?start? ?length? +
nxscript puthm hmAlias hmName ?start? ?length? ?bank?
Writes data from the histogram memory hmName to a NeXus file using the alias hmAlias. Nxscript automatically updates the dim0, dim1, ..., timedim dictionary variables. Thus these can be used to define the dimensions in the @@ -116,7 +116,9 @@ subset writing, the dimensions have to be specified in the definition string belonging to the alias. Nxscript sets a variable timedim in the dictionary though which contains the length of a time binning if appropriate. This is a special feauture for writing extra detectors at -SANS and AMOR. +SANS and AMOR. Optionally, together with start and length, a bank number can +be given. This is a feauture to support the rare case of having multiple banks +in one histogram memory. If not give bank defaults to 0.
nxscript puttimebinning aliasName hmName
Writes the time binning at histogram memory hmName to file using the alias aliasName. The length of the time binning data is @@ -125,11 +127,19 @@ automatically appended to the definition string for the alias.
Writes the Tcl array arrayName to file using the aliasName. The definiton string belonging to aliasName does not need to contain a -dim argument as this is set by this routine. The parameter length is -the length of the array. Only rank 1 arrays are supported. +the length of the array. Only rank 1 arrays are supported. The array is +considered a float array. +
nxscript putintarray aliasName arrayName length +
The same as above, but the data is considered integer.
nxsript putglobal attName bla bla bla
This writes an global attribute attName. Everything after attName is concatenated to a string which then respresents the value of the -attribute. +attribute. +
nxscript putsicsdata alias dataname +
Writes the sicsdata array dataname to alias. +
nxscript putattribute alias name value +
Add another text attribute to alias. The name of the attribute is name, the + value value.
nxscript makelink targetAlias victimAlias
This creates a symbolic link for victimAlias in the group designated by targetAlias. diff --git a/doc/manager/nxupdate.htm b/doc/manager/nxupdate.htm index 6b0e1373..0c20845d 100644 --- a/doc/manager/nxupdate.htm +++ b/doc/manager/nxupdate.htm @@ -65,6 +65,9 @@ file.
updateintervall
The time intervall in seconds between updates. The defualt is 1200, eg. 20 minutes. +
onoff +
can be 1 or 0. Switches automatic updates on or off. It might be usefule for + scans to switch this off.

diff --git a/doc/manager/tas.htm b/doc/manager/tas.htm index 4a774030..f7c1b85d 100644 --- a/doc/manager/tas.htm +++ b/doc/manager/tas.htm @@ -21,6 +21,37 @@ The TAS requires the following initializations in its instrument file:
MakeTasUB tasub
Installs the TAS crystallographic calculation module into SICS. It will have the name tasub (recommended). +
MakeTasUB tasub a1 a2 mcv mch a3 a4 sgu sgl a5 a6 acv ach +
Installs the TAS crystallographic calculation module into SICS. It will + have the name tasub (recommended). This versions allows to specifiy motor names for functions. If there is no motor for + a function it can be replaced with a placeholder in the parameter list, like dummy. This is only allowed for the + curvature motors. The motor functions: +
+
a1 +
monochormator rotation +
a2 +
monochromator two theta +
mcv +
monochromator vertical curvature +
mch +
monochromator horizontal curvature +
a3 +
sample rotation +
a4 +
sample tow theta +
sgu +
sample tilt +
sgl +
second sample tilt +
a5 +
analyzer rotation +
a6 +
analyzer two theta +
acv +
analyzer vertical curvature +
ach +
analyzer horizontal curvature +
MakeTasScan iscan tasub
Installs the module with the TAS specific scan functions into SICS. The TAS implements its own data format resembling the ILL TAS data format. diff --git a/doc/user/commandlog.htm b/doc/user/commandlog.htm index 2dcd7216..bff36ae1 100644 --- a/doc/user/commandlog.htm +++ b/doc/user/commandlog.htm @@ -35,6 +35,11 @@ started. In order to make this work a ServerOption with the name logstartfile must exist in the instrument configuration file. The value of this option must be the full path name of the file to execute.

+

+Note: with the command config listen 1 you can have the output +to the command log printed into your client, too. With config listen 0 you can switch this off again. This is useful for listening into a running + instrument. +

diff --git a/doc/user/exeman.html b/doc/user/exeman.html index 963493f3..f0880351 100644 --- a/doc/user/exeman.html +++ b/doc/user/exeman.html @@ -45,6 +45,13 @@ named buffer within the stack of nested buffers.
Clears the queue of batch buffers
exe queue
Prints the content of the batch buffer queue. +
exe fullpath filename +
Prints the full path name for filename if the file can be located + somewhere in exe paths. Else an error is printed. The purpose is to use + exe file management facilties in scripts. +
exe makepath filename +
Prints the full path name for filename in the first direcory of batch path. + This is a tool to have scripts open files in the proper user directory.
exe run
Starts executing the batch buffers in the queue.
exe print buffername @@ -58,7 +65,12 @@ most useful for SICS clients watching the progress of the experiment.
exe append some text
Appends a line with everything after append to the upload buffer
exe save filename -
saves the recently uploaded buffer under filename on the SICS server. +
saves the recently uploaded buffer under filename on the SICS server. Does not overwrite + existing files. +
exe forcesave filename +
saves the recently uploaded buffer under filename on the SICS server. Overwrites existing file. +
exe clearupload +
clears any pending upload operations.

diff --git a/doc/user/optimise.htm b/doc/user/optimise.htm index 8d80b76c..4e97d439 100644 --- a/doc/user/optimise.htm +++ b/doc/user/optimise.htm @@ -29,6 +29,18 @@ maximum number of cycles was reached. This routine requires that the instrument is currently placed somewhere on the peak and not miles away.

+The peak optimiser supports another optimisation algorithm which is faster but +may not be as accurate. This is hill climbing: +

+while errors gt precision and cycles lt maxcycles
+  for all variables 
+	  find the direction into which the intensity rises
+	  step into this direction until the intensity drops
+   end for
+end while
+
+

+

The Peak Optimiser is implemented as an object with the name opti. It understand the following commands:

@@ -43,7 +55,10 @@ and number of steps parameters should cover the whole peak. However, the Optimiser will extend the scan is the specified range is not sufficient.
opti run
Starts the optimiser. It will then optimise the peak. This may take some -time. +time as it uses a time consuming scan based algorithm. +
opti climb +
Starts the optimiser in hill climbing mode. Hill climbing is faster but may + not be as accurate as a scan based optimization.
The behaviour of the optimiser can be configured by modifying some parameters. The synatx is easy: opti parameter prints the value of the @@ -72,5 +87,12 @@ status of the countmode parameter this is either a preset time or a preset monitor.

+

+It is the users reponsability to provide meaningful step widths. Usually this is +dependent on the instrument resolution and thus fairly constant. Also these +optimisation algorithms will fail if the instrument is not positioned at the +flank of a peak. Probaly the best will be to do several cycles of hill +climbing first, followed by one cycle of scan optimisation for extra accuracy. +

diff --git a/doc/user/sansdocbook.xml b/doc/user/sansdocbook.xml new file mode 100644 index 00000000..9f02cdc6 --- /dev/null +++ b/doc/user/sansdocbook.xml @@ -0,0 +1,5284 @@ + + + + + SICS manual for the SANS I instrument + + + + Dr + Joachim + Kohlbrecher + +
+ + Paul Scherrer Institute PSI + LNS, Laboratory for Neutron Scattering + + Villigen + 5232 + Switzerland +
+ + + + + Dr + Mark + Könnecke + +
+ + Paul Scherrer Institute PSI + LDM, Laboratory for Developments and Methods + + Villigen + 5232 + Switzerland +
+ + + + + Abstract + This manual describes how to set up the small angle neutron scattering instrument at + the SINQ spallation source at PSI and gives a short remainder of important command. + This document can be downloaded + http://sans.web.psi.ch/SANSDoc/SANSDoc.ps.gz + as a gzipped postscript file. + + + + + + + Quick reference Guide +
+ Instrument control programs + + + + + + startsics & + + + + starts the SICS server. + + + + + + + killsics & + + + + kills the SICS server. + + + + + + + sics & + + + + starts the SICS command line client. + + + + + + + sansstatus & + + + + starts the SANS status display. + + + + + + + varwatch & + + + + starts the variable watcher. + + + + + + +
+
+ The <computeroutput>token</computeroutput> command + + + + + + token grab + + + + reserves control over the instrument to the client issuing this command. + + + + + + + token release + + + + releases the token. + + + + + + + token force <passwd> + + + + This command forces an exiting grab on a token to be released (manager privileges required). + + + + + + + +
+
+ Executing a macro + + + + + + FileEval <file> + + + + executes the script in the file <file> (needs absolute path). + + + + + + + BatchRoot [<path>] + + + + defines directory for script files executed by BatchRun. + + + + + + + Batchrun <filename> + + + + executes script file <filename> + located in directory defined by BatchRoot. + + + + + + + exe BatchPath [<path>] + + + + defines directory for script files executed by exe. + + + + + + + exe <filename> + + + + executes script file <filename> + located in directory defined by exe BatchPath. Compared to + BatchRun, this command allows enhanced batch control through + the SICSBatchEditor. + + + + + + + Clientput <text> + + + + writes <text> + to client. + + + + + + + TCL command language interface + + + + is implemented in the SICS server. + + + + + + +
+
+ Logging executed commands + + + + + + commandlog new <filename> + + + + starts a new commandlog writing to file <filename> + (file stored in /home/SANS/log). + + + + + + + commandlog + + + + displays status of commandlog. + + + + + + + commandlog close + + + + closes the command log. + + + + + + + commandlog auto + + + + switches the automatic log on. + + + + + + commandlog tail <n> + + + + prints the last <n> lines of the log file. + + + + + + +
+
+ Driving a motor + + + + + + run <mot1> <val1> [<mot2> <val2> ...] + + + + starts motion of the motors to the new values without waiting for the requested operation to finish. + + + + + + + drive <mot1> <val1> [<mot2> <val2> ...] + + + + drives the motors and waits until movement is finished. + + + + + + + success + + + + waits and blocks the command connection until all pending operations have finished. + + + + + + + <mot> list + + + + lists all the motor <mot> parameters. + + + + + + +
+
+ Motor handling + + + + + + <motor> list + + + + lists all motor parameters. + + + + + + + <motor> reset + + + + resets motor parameters to default values. + + + + + + + <motor> position + + + + prints actual position. + + + + + + + <motor> interest + + + + prints position changes. + + + + + + + <motor> hardlowerlim + + + + prints hardware lower limit. + + + + + + + <motor> hardupperlim + + + + prints hardware upper limit + + + + + + + <motor> softlowerlim [<val>] + + + + prints/sets software lower limit. + + + + + + + <motor> softupperlim [<val>] + + + + prints/sets software upper limit. + + + + + + + <motor> softzero [<val>] + + + + prints/sets software zero. + + + + + + + <motor> fixed [<val>] + + + + fixes motor for <val> ≥ 0 or releases it for + <val> < 0. + + + + + + + <motor> interruptmode [<val>] + + + + defines interrupt issued if motor movement fails. + + + + + + + <motor> precision [<val>] + + + + denotes the positioning precision. + + + + + + + <motor> accesscode [<val>] + + + + specify user privileges of <motor>. + + + + + + + <motor> speed + + + + defunct. + + + + + + + <motor> sign [<val>] + + + + reverses operation sense. + + + + + + + +
+
+ Special commands (e.g. <computeroutput>st</computeroutput>, + <computeroutput>dt</computeroutput> ...) + + + + + + <cop> + + + + lists current position. + + + + + + + <cop> back + + + + drives component to last position. + + + + + + + <cop> pos <name> + + + + defines a name for actual position. + + + + + + + <cop> <name> + + + + drives component to named position. + + + + + + + <cop> drop <name> + + + + deletes named position. + + + + + + + <cop> drop all + + + + deletes all named positions. + + + + + + + <cop> list + + + + lists all named position. + + + + + + + <cop> find + + + + returns name of actual position. + + + + + + + <cop> <axis> [=] <val> ... + + + + drive component to new position. + + + + + + +
+
+ Sample environment devices + + + + + + EVFactory new <ED> <type> <par> ... + + + + creates a new sample environment device called <ED>. + + + + + + + EVFactory del <ED> + + + + deletes sample environment device <ED>. + + + + + + + emon list + + + + lists all registered environment devices. + + + + + + + emon register <ED> + + + + registers environment device <ED>. + + + + + + + emon unregister <ED> + + + + unregisters environment device <ED>. + + + + + + + <ED> Tolerance [<val>] + + + + allowed deviation from preset. + + + + + + + <ED> Access [<val>] + + + + changes access to device. + + + + + + + <ED> Lowerlimit [<val>] + + + + lower limit for controller. + + + + + + + <ED> Upperlimit [<val>] + + + + upper limit for controller. + + + + + + + <ED> ErrHandler [<val>] + + + + error handler to use for this controller. + + + + + + + <ED> Interrupt [<val>] + + + + interrupt to issue when an error is detected. + + + + + + + <ED> SafeValue [<val>] + + + + The value to drive the controller to when an error is detected and safe error handling is set. + + + + + + + <ED> send <par> [<par> ...] + + + + sends everything after send directly to the controller and returns its response. + + + + + + + <ED> list + + + + lists all parameters. + + + + + + + <ED> [<val>] + + + + returns current value or will drive device to new value <val>. + + + + + + + <ED> log on/off + + + + switches logging on/off. + + + + + + + <ED> log clear + + + + clears all recorded time stamps and values. + + + + + + + <ED> log gettime + + + + retrieves list of all recorded time stamps. + + + + + + + <ED> log getval + + + + retrieves list of all recorded values. + + + + + + + <ED> log getmean + + + + calculates mean value and standard deviation of logged values. + + + + + + + <ED> log frequency [<val>] + + + + specifies the time intervall in seconds between log records. + + + + + + +
+
+ Beam shutter + + + + + + shutter + + + + returns status of instrument shutter. + + + + + + + shutter open + + + + opens beam shutter. + + + + + + + shutter close + + + + closes beam shutter. + + + + + + +
+
+ Neutron Velocity Selector + + + + + + lambda + + + + prints the current wavelength in nm. + + + + + + + drive lambda <val> + + + + changes wavelength to value <val> in nm. + + + + + + + lambda rot <val> + + + + calculates the rotation speed for the wavelength given by <val>. + + + + + + + lambda wl <val> + + + + calculates the wavelength for the rotation speed given by <val>. + + + + + + + nvs status + + + + prints status summary. + + + + + + + nvs list + + + + displays rotation speed and tilt angle. + + + + + + + nvs [rot=<val1>] [tilt=<val2>] + + + + sets a new tilt angle and/or rotation speed. + + + + + + + nvs rotinteres + + + + enables printing of status message about the current state of the selector when it is driven. + + + + + + + nvs loss + + + + start a loss current measurement. + + + + + + + nvswatch [<par>] ... + + + + is the object for monitoring the velocity selector and understands the commands for sample environment devices. + + + + + + +
+
+ Positioning an attenuator + + + + + + att + + + + prints the current positioned attenuator. + + + + + + + att <val> + + + + positions attenuator <val>. + Allowed attenuator numbers are: 0, 1, 2, 3, 4 and 5. + + 0 : square 50 mm x 50 mm slit, attenuation = 1 + + 1 : circular 41 x diameter 0.4 mm slit, attenuation = 1/485 + + 2 : circular 9 x diameter 2 mm slit, attenuation = 1/88 + + 3 : circular 20 mm diameter slit, attenuation = 1/8 + + 4 : circular 30 mm diameter slit, attenuation = 1/3.5 + + 5 : circular 15 mm diameter slit, attenuation = 1/?? + + + + + + + + +
+
+ Changing collimation + + + + + + coll + + + + prints the current collimatin length. + + + + + + + coll <val> + + + + positions the collimation <val>. + Allowed collimation lengths are: 1, 1.4, 2, 3, 4.5, 6, 8, 11, 15 and 18. + + + + + + +
+
+ Positioning the detector + + + + + + detectorx + + + + motor to change sample detector distance (x). + + + + + + + detectory + + + + motor for lateral displacement (y). + + + + + + + detectorrotation + + + + motor for detector rotation (phi). + + + + + + + dt [x=<val1>] [y=<val2>] [phi=<val3>] + + + + special SANS command for controlling all three detector axes together. + + + + + + +
+
+ Positioning the beam stop + + + + + + beamstopx + + + + motor for horizontal movement. + + + + + + + beamstopy + + + + motor for vertical movement. + + + + + + + bs [x=<val1>] [y=<val2>] + + + + special SANS command for controlling both beam stop axes together. + + + + + + + bsout + + + + moves beam stop out of detecion area. + + + + + + + bsin + + + + moves beam stop back into position. + + + + + + + bscfree + + + + releases the beam stop motors. + + + + + + + bschange [<val>] + + + + changes beam stop size, without parameter it returns the beam stop type. + + 1 for beam stop size of 40 mm x 40 mm + + 2 for beam stop size of 70 mm x 70 mm + + 3 for beam stop size of 85 mm x 85 mm + + 4 for beam stop size of 100 mm x 100 mm + + + + + + + + + bscslot + + + + returns value of the beam stop type. + + + + + + +
+ +
+ Sample table + + + + + + saz + + + + motor for vertical translation (z). + + + + + + + say + + + + motor for horizontal translation parallel to neutron beam (y). + + + + + + + sax + + + + motor for horizontal translation perpendicular to neutron beam (x). + + + + + + + som + + + + motor for rotation around vertical axis (phi). + + + + + + + gtheta + + + + motor for rotation around horizontal axis (theta). + + + + + + + sposi + + + + horizontal translation for linear translator (posi). + + + + + + + st [<axis n>=<val n>] ... + + + + is a special SANS command for controlling all seven sample axes together. + <axis n> can be x, y, z, omega, phi, theta, posi. + + + + + + +
+
+ Sample holder for electro magnet + + + + + + mz + + + + motor for vertical movement (z). + + + + + + + mom + + + + motor for rotation around vertical axis (omega). + + + + + + + msh [z=<val1>] [omega=<val2>] + + + + is a special SANS command for controlling both axes of the magnet sample holder together. + + + + + + +
+
+ Haake temperature controller + + + + + + inihaakearray eimer lnsa10 4000 1 + + + + + evfactory new temperature tcl eimer + + + + initialisation sequence. + + + + + + + temperature + + + + is a valid sample environment device if initialised as above. + + + + + + + temperature list + + + + overview of the temperature controller parameters. Use 'emon unregister temperature' + to avoid out of range error messages. + + + + + + + temperature sensor <val> + + + + selects the controlling sensor. <val> can be + intern or extern. + + + + + + +
+
+ Bruker electro magnet + + + + + + evfactory new magnet bruker + + + + + lnsa10.psi.ch 4000 9 + + + + initialisation sequence. + + + + + + + magnet + + + + is a valid sample environment device if initialised as above. + + + + + + + magnet polarity + + + + prints polarity of magnet. + + + + + + + magnet polarity <val> + + + + sets polarity, <val> can be + plus or minus. + + + + + + + magnet mode + + + + prints the mode of the controller. + + + + + + + magnet mode <val> + + + + sets mode, <val> can be + field or current. + + + + + + + magnet field + + + + prints the magnetic field. + + + + + + + magnet current + + + + prints the current. + + + + + + +
+
+ Eurotherm controller + + + + + + evfactory new temperature euro + + + + + lnsa10.psi.ch 4000 <port> + + + + initialisation sequence. <port> is the serial port number at sans.psi.ch where + the controller is connected (usually port 13). + + + + + + + temperature + + + + is a valid sample environment device if initialised as above. + + + + + + + temperature list + + + + overview of the temperature controller parameters. Use 'emon unregister temperature' + to avoid out of range error messages. + + + + + + +
+
+ ITC-4 and ITC-503 temperature controllers + + *outdated controllers, will be replaced* + +
+
+ Analogue and digital input and output + + + + + + init_adios.tcl + + + + + initialisation sequence. + + + + + + + AO <channel> <value> + + + + sends an analogue signal (-10V -> 10V) to channel 0 or 1. + + + + + + AI <channel> + + + + reads the tension at channels 0 to 7. Channels 0 and 1 are reserved for the CJC and + the thermocouple readout. + + + + + + temp <type> + + + + returns the temperature as measured by a thermocouple (tc) or a resistor (pt). + + + + + + log <time interval> <channel1> + <channel2> ... + + + + stores the values measured at the specified channels into a file in the + speficied time interval. Up to 4 channels can be logged simultanuously. + The temperature can be logged using channel 1. + + + + + + log stop + + + + stops logging the data. + + + + + + +
+
+ Counter handling + + + + + + counter SetPreset <val> + + + + sets the preset to <val>. + + + + + + + counter GetPreset + + + + prints the current preset value. + + + + + + + counter SetExponent <val> + + + + sets exponent for Monitor mode. + + + + + + + counter GetExponent + + + + prints current exponent used in Monitor mode. + + + + + + + counter SetMode <val> + + + + sets counting mode. Allowed modes are Timer + and Monitor. + + + + + + + counter GetMode + + + + prints the current mode. + + + + + + + counter GetCounts + + + + prints counts gathered in the last run. + + + + + + + counter GetMonitor <n> + + + + prints counts gathered by monitor <n> in the last run. + + + + + + + counter Count <preset> + + + + starts counting with preset <preset>. + + + + + + + counter Status + + + + prints the counter status. + + + + + + + counter GetTime + + + + retrieves the actual time the counter counted for. + + + + + + + counter GetThreshold <n> + + + + retrieves the threshold of monitor <n>. + + + + + + + counter SetThreshold <n> <val> + + + + sets the threshold for monitor <n> to + <val> and also sets the active monitor for the threshold + to <n>. + + + + + + +
+
+ Histogram Memory + + + + + + banana configure HistMode <val> + + + + sets the mode of operation (Transparent, Normal, TOF, Stroposcopic). + + + + + + + banana configure OverFlowMode <val> + + + + determines how bin overflow is handled (Ignore, Ceil, Count). + + + + + + + banana configure Rank <val> + + + + defines number of histograms in memory. + + + + + + + banana configure Length <val> + + + + gives length of individual histogram. + + + + + + + banana configure BinWidth <val> + + + + determines size of single bin in histogram memory in bytes. + + + + + + + banana timebin + + + + prints actual time binning aray. + + + + + + + banana genbin <start> <step> <n> + + + + determines size of single bin in histogram memory in bytes. + + + + + + + banana setbin <inum> <val> + + + + configuring unequally spaced time binnings. + + + + + + + banana clearbin + + + + deletes the binning informations. + + + + + + + banana preset [<val>] + + + + prints/sets preset Timer or Monitor. + + + + + + + banana exponent [<val>] + + + + prints/sets exponent for Monitor preset. + + + + + + + banana CountMode [<mode>] + + + + prints/sets count mode (Monitor, Timer). + + + + + + + banana init + + + + transfers configuration from host to the actual histogram memory. + + + + + + + banana count + + + + starts counting. + + + + + + + banana initval <val> + + + + initialises histogram memory to value <val>. + + + + + + + banana get <i> <istart> <iend> + + + + retrieves a part of histogram memory. + + + + + + + banana sum <d0min> <d0max> <d1min> <d1max> + + + + returns the sum of counts on an area of the detector. + + + + + + +
+
+ Data acquisition + + + + + + StoreData + + + + writes current instrument status to a NeXus file. + + + + + + + count [<mode> <preset>] + + + + start count operation in mode <mode> + with preset <preset>. + + + + + + + repeat <num> [<mode> <preset>] + + + + calls <num> times count. + + + + + + +
+
+ XY table + + + + + + xydata clear + + + + clears all entries in the x-y table. + + + + + + + xydata list + + + + lists the entries in the x-y table on the screen. + + + + + + + xydata write <filename> + + + + writes the x-y list to the disk file <filename>. + This file resides on the machine running the SICS server. + + + + + + + xydata uuget + + + + sends the x-y list in an uuen-coded format. This is the command to give to the + VarWatch SICS client in order to make it display the x-y list. + + + + + + + xydata add <xval> <yval> + + + + creates a new x-y list entry with the values <xval> and <yval>. + + + + + + +
+ + + + + How to start +
+ Log in on the SANS computer + + After starting up an X-Terminal click on the XDMCP button and choose + the computer lnsa10.psi.ch. Login with your + <username> + and <password> + (case sensitive, this is a Unix machine). Wait for the Common Desktop + Environment to start up. Open a terminal window (dtterm). + You will be asked for your last name and if this is your first login a + subdirectory /data/lnsg/<lastname> + will be created. + +
+
+ Start the SINQ instrument control software SICS + + SICS is a client server system. This means there are at least two programs + necessary to run the experiment. The first is the server program, which + runs for the SANS instrument on the lnsa10.psi.ch + workstation. A user rarely needs to bother about this program as it meant to run + all the time. Secondly a client program is needed, through which the user can interact + with the instrument control server. Its main purpose is to forward commands + to the server and to display the answers. For the SANS instrument three + SICS clients are available: + + + command line control client (sics &) + + + + status display (sansstatus &) + + + + variable watcher (varwatch) + + + + + Any of the SICS clients first have to be connected to a SICS server before + it becomes active.Therefor you first have to establish a connection through + the [Connect] menu of the client. + + +
+ Command control line client + + The command line control client allows you after connecting to the + instrument server to read out instrument parameters like + motor positions, temperatures, magnetic field, etc. In order to move a motor + or to start a data aquisition you need access privileges. The SICS + server supports autorisation on different levels to protect the + instrument against unauthorized hackers or accidental change of + the instrument adjustment of less knowledgable user. Four different + levels of access to the instrument are supported. + + + Spy: you may read out any + instrument value, but may not change anything + + + + + User: you are privileged + to perform a certain amount of operations necessary + to run the instrument + + + + + Manager: you have the + permission to do almost everything + + + + + Internal: is not accessible + to the outside world and is used to circumvent + protection for internal uses + + + + + To change the privileges select [Set Rights] + from the [User Parameter] menu. + With an valid username and the corresponding password you will get + the privileges to change the instrument set-up. Please do not use this privileges + on any other terminal than the one in the SANS cabine. For more information click + on [Help] button on the top right corner of the + command line client. A list of the most needed SICS commands is given in + . If you start the sics client the first time you + should fill out this items in the menu + [New Experiment] for documentation + of your data. + +
+
+ SANS status display + + The SANS status display is an application for displaying the status of a SANS + measurement at SINQ. The application can be stated by the command + sansstatus &. First a connection to the + SICS server has to be established. You can choose between two data display areas. + The first form shows a large colour mapped image of the detector. + The second form shows a couple of selected instrument parameters. + Switching between the two displays is achieved through the buttons + [Detector] and [Parameter] + of the tool bar. + + + The displayed data window can be updated either manually or automatic. By + default manual update is enabled. Manual update happens when hitting the + red button at the bottom. Automatic update can be enabled by checking the + CheckBox labelled [Automatic Update] in + the [Update] menu. The update intervall + can be configured with a dialog which shows up when the + [Set Update Intervall] menu selection is + clicked. Automatic updates impose a high network load. Use with care and + only when necessary. For this reason, automatic updates are disabled in + the applet version of this program. An updates take approximatly 5 seconds. + Consequently update intervalls shorter than that are nonsense. Speeding + this up an [Turbo Update] button has been + introduced. In this modus the client doesn't communicate with the SICS + server to recieve the detector information, but it communicates directly + with the histograming memory. This speeds the update frequency up to a few + frames per second. [Turbo Update] will + continuously poll the histogram memory for new histogram data. This is only + limited by CPU, network and histogram memory performance. Thus + [Turbo Update] tends to overload your + system. It should only be used while adjusting the beamstop, otherwise its + use is a waste of system resources which will eventually slow down your + data reduction chores. Do NOT forget to switch this off when you are done. + The system will automatically switch to [Auto Update] + mode after 20 minutes. + + + The detector display has a lot of options. Below the colour picture there + is a line which displays the current detector coordinate and the data + value at the current mouse position. By choosing the + [Open Old File] item in the [File] + menu you can load an old data set, i.e. you + can use the SANS status display as a viewer for old SANS data files. A + double clicking on the colour display brings up a dialog which allows to + configure the colour mapping of the detector display. By + holding down the mouse button and dragging the mouse a rectangular + area of the detector display can be selected. When releasing the mouse + button, the selected region is summed and displayed as a X-Y graph + in a separate window. In the title of this plot the total + counts in the selected rectangular area on the detector is printed. + Dragging the mouse downwards in this new window allows to zoom in into + details of the histogram. Dragging the mouse upwards zooms out again. + At the bottom of the window is a dismiss button which removes the + histogram window. The histogram in the histogram window will NOT be + automatically updated when new data arrives. + +
+
+ Variable watcher <computeroutput>varwatch</computeroutput> + + + This little SICS client allows to plot the value of a variable in a + SICS server against time. This will probably be mostly used for + watching the temperature stability of a temperature controller. + But it is not restricted to temperature variables, all numeric SICS + variables can be monitored that way. + + + The configuration of the variable watcher involves two steps: + + + Select your favourite + SICS server from the choices in the + [Connect] menu. + [Custom] allows to + specify a SICS server directly by host name and port number. + + + + Configure the variable to watch using the + [Configure] item in the + [Plot] menu. Three + parameters are relevant: + + + The watch frequency, which is the + time in minutes between plot updates. + + + + The backlog, which is the number + of values which will be plotted. + + + + + The SICS variable to watch. This text + must be a valid SICS command which returns + a reply in the form + blabla = <number> + . + + + + + + + + + Further user interface elements are two buttons below the plot. + These allow to start and stop the recording of the variables value. + The yellow text field besides these buttons displays the current + operation of the variable watcher which can be one of Inactive or + Recording. Below is a line showing the current status of the SICS + server. Please note, that the most recent value is always at the + right hand side of the plot. + + + The plot can be zoomed into by dragging downwards with the left + mouse button. Zooming out is achieved by dragging outwards with + the mouse or with the [Reset] + or [Rescale Y] options in the + [Plot] menu. The plot can be + printed using the [Print] option + in the [Plot] menu. Next to + plotting a variable in a SICS server against time the variable + watcher can be used to display a XYTable + which is a class maintaining a list of x-y values. If a + XYTable object is available in + the system under the name <xydata> + the command <xydata> uuget has + to be given to the varwatch SICS + client in order to make it display the x-y list. More information + about handling a XYTable can be + found in . + +
+
+
+ Instrument preparation before the first measurement + + Before you can start with your first data aquisition be aware of a few things. + For running a measurement you need at least to run two programs: the SANS + status display (sansstatus &) and the + command line client (sics &). After + connecting both clients to the SANS server and authorizing the command line + client at the server with user privileges you are ready to change the instrument + set-up. The initial step at the beginning of your measurement are the following: + + Check if beam is closed, if not than do it now. + + + + Set the experiment informations via the dialog box + [New Experiment]. + + + + Define the directory, where you intend to store your batch + files with batchroot /data/lnsg/<username>[/<batchdir>] + resp. with + exe batchpath /data/lnsg/<username>[/<batchdir>]. + + + + Choose the needed instrument settings like sample detector + distance, collimation, wavelength, etc. + + + + Adjust the beam stop by performing the following steps: + + + Move in an attenuator with an attenuation factor + larger than 100. + + + + Put a strong forward scatterer into the beam, + e.g. teflon + + + + Center the beam stop roughly by the SICS + command bs x 0 y 0. + + + + Open the beam. + + + + Use the command banana preset 1000 + and banana count + to start an aquisition without storing + the result. + + + + Adjust the beam stop with the + bs-command. + + + + After each beam stop movement you can reset the + histograming memory of the detector by + banana initval 0. + + + + Remove the attenuator. + + + + Perform a fine adjustment of the beam stop with an + unattenuated beam if neccessary. + + + + Stop the data aquisition by pressing the + [Interrupt] button in the + lower left corner of the command line client. + + + + + + + +
+ + + + Instrument control commands +
+ Some basic SICS commands and concepts +
+ The <computeroutput>token</computeroutput> command + In SICS any client can issue commands to the SICS server. + This is a potential cause for trouble with users issuing conflicting + commands without knowing. In order to deal with this problem a token + mechanism has been developed. A connection can grab a token and then + has full control over the SICS server. Any other connection will not + be privileged to do anything useful, except for looking at things. + A token can be released manually with a special command or is automatically + released when the connection dies. Another command exists which allows + a SICS manager to force his way into the SICS server. The commands in + more detail: + + + + token grab + + + + Reserves control over the instrument to the client issuing this + command. Any other client cannot control the instrument now. + However, other clients are still able to inspect variables. + + + + + + token release + + + + Releases the control token. Now any other client can control + the instrument again. Or grab the control token. + + + + + + token force <password> + + + + This command forces an existing grab on a token to be released. + This command requires manager privilege. Furthermore a special + password must be specified as third parameter in order to do + this. This command does not grab control though. + + + + + +
+
+ How to execute Macros + + SICS has a built in macro facility. This macro facility is aimed at instrument + managers and users alike. Instrument managers may provide customised measurement + procedures in this language, users may write batch files in this language. + The macro language is John Ousterhout's + http://cseng.awl.com/authordetail.qry?AuthorID=69 + + Tool Command Language (TCL) http://www.tcltk.com + . + A set of important Tcl commands are described in section . + To execute batch files three commands are available: + + + + FileEval <batchfile> + + + + This command tries to open the file + batchfile and executes the + script in this file. If not an absolute path name is defined + the SICS server will search in the directory + /home/SANS/bin. However, you + don't have privileges to save files in this directory. For + executing batch files located in a directory of your choice + the commands BatchRoot and + BatchRun resp. + exe BatchPath and + exe are available. + + + + + + BatchRoot [<pathname>] + + + + By this command the directory name, in which SICS is searching + for a batch file, is stored in the SICS variable + BatchRoot. Calling + BatchRoot without parameters + will return the actual contents of the variable. + + + + + + BatchRun <filename> + + + + This command tries to open the file filename + located in the directory defined by + BatchRoot and executes the + script in this file. + + + + + + exe BatchPath [<pathname>] + + + + By this command the directory name, in which SICS is searching + for a batch file, is stored in the SICS variable + exe BatchPath. Calling + exe BatchPath without parameters + will return the actual contents of the variable. + + + + + + exe <filename> + + + + This command tries to open the file filename + located in the directory defined by + exe BatchPath and executes the + script in this file. Compared to BatchRun, + this command allows enhanced batch control through the + SICSBatchEditor. + + + + + If you want to print information from a macro script to a client (about the progress of + the batch job for example), a special command is available: + + + + ClientPut some text ... + + + + This command writes everything after ClientPut + to the client which started the script. + + + + + +
+
+ Logging the executed commands + + Some users wish to have all communication of the SICS server with all the clients + having user or manager privileges being collected in a file for further review. This + is implemented via the commandlog command. This log + allows to retrace each step of an experiment. It is usually switched off and must be + configured by the instrument manager. commandlog + understands the following syntax: + + + commandlog new <filename> + + + + starts a new commandlog writing to + <filename>. The log file can be found for the SANS server in + the directory /home/SANS/log. + + + + + commandlog + + + + without further parameters displays the status of the commandlog. + + + + + + + commandlog close + + + + closes the command log file. + + + + If the user wishes a transscript of the SICS session of the command line client he + is just working with, he can use the [Open Logfile] + option in the [File] menu. It will allow + you to specify a file on your local disk area, where all input/output is logged to. + You will get everything which appears in the client's I/O window. The input is + prepended with ???. In contrast to the commandlog, + which log communication of all clients connected to the server, the + [Open Logfile] option of the client only allows you + to log the communication of its own to a local file. + +
+
+ Some variables for documentation + SICS supports a couple of variables for documentation of a measurement. + Currently available are: + + user, adress, phone, fax, email, title, subtitle, environment, + sample, comment + + + Each variable can be inquired by just typing its name. It can be set by typing + the name followed by the new name, e.g. + title nanocrystalline Fe. + These variables can also be set by the [Set Experiment] + dialog box, which can be started via the [New Parameter] + option of the [User Parameter] menu item in the command + line client. The user is required + to fill this variables with utmost care, because if you want us to retrieve your data in + ten years time you will be happy that the information will be there. + +
+
+ Drive commands + Many objects in SICS are drivable. This means they can run to a new value. + Obvious examples are motors. Less obvious examples include composite adjustments + such as setting a wavelength or a temperature. This class of ob jects can be operated + by the drive, run + , success family of commands. These commands cater + for blocking and non-blocking modes of operation. + + + run <var> <newval> [<var> + <newval> ...] + + + + Can be called with one to n pairs of object new value pairs. This command will + set the variables in motion and return to the command prompt without waiting + for the requested operations to finish. This feature allows to do things to + the instrument while for example a slow device is running into position. + + + + + + + + success + + + + Waits and blocks the command connection until all pending operations have + finished (or an 'interrupt' occured). + + + + + + + + drive <var> <newval> [<var> + <newval> ...] + + + + can be called with one to n pairs of ob ject new value pairs. This command + will set the variables in motion and wait until the driving has finished. + A drive can be seen as a sequence of a run command as stated above immediatetly + followed by a Success command. + + + + + +
+
+ SICS motor handling + + In SICS each motor is an object with a name. Motors may take commands which basically + come in the form <motorname> <command>. + Most of these commands deal with the plethora of parameters which are associated with + each motor. The syntax for manipulating variables is, again, simple. + <motorname> <parametername> will print + the current value of the variable. <motorname> <parametername> + <newval> will set the parameter to the new value specified. A + list of all parameters and their meanings is given below. The general principle behind + this is that the actual (hardware) motor is kept as stupid as possible and all the + intracacies of motor control are dealt with in software. Besides the parameter commands + any motor understands these basic commands: + + + <motorname> list + + + + + gives a listing of all motor parameters + + + + + <motorname> reset + + + + + resets the motor parameters to default values. + + + + + <motorname> position + + + + + prints the current position of the motor. + + + + + <motorname> interest + + + + + initiates automatic printing of any position change of the motor. This + command is mainly interesting for implementors of status display clients. + + + + Please note that the actual driving of the motor is done via the + drive or run command + described in the last + + + + The motor parameters: + + + HardLowerLim + + + + + is the hardware lower limit. This is read from the motor controller and is + identical to the limit switch welded to the instrument. Can usually not be + changed. + + + + + HardUpperLim + + + + + is the hardware upper limit. This is read from the motor controller and is + identical to the limit switch welded to the instrument. Can usually not be + changed. + + + + + SoftLowerLim + + + + + is the software lower limit. This can be defined by the user in order to + restrict instrument movement in special cases. + + + + + SoftUpperLim + + + + + is the software upper limit. This can be defined by the user in order to + restrict instrument movement in special cases. + + + + + SoftZero + + + + + defines a software zero point for the motor. All further movements will + be in respect to this zeropoint. + + + + + Fixed + + + + + can be greater 0 for the motor being fixed and less than zero for the motor + being movable. + + + + + InterruptMode + + + + + defines the interrupt to issue when the motor fails. Some motors are so + critical for the operation of the instrument that all operations shall be + stopped when there is a problem. Others are less critical. This criticallity + is expressed in terms of interrupts, denoted by integers in the range 0 - 4 + translating into the interrupts: continue, AbortOperation, AbortScan, + AbortBatch and Halt. This parameter can usually only be set by managers. + + + + + Precision + + + + + denotes the precision to expect from the motor in positioning. Can usually + only be set by managers. + + + + + AccessCode + + + + + specifies the level of user privilege necessary to operate the motor. Some + motors are for adjustment only and can be harmful to move once the adjustment + has been done. Others must be moved for the experiment. Values are 0 - 3 for + internal, manager + , user, and spy. + This parameter can only be changed by managers. + + + + + Speed + + + + + defunct. + + + + + Sign + + + + + allows to reverse the operating sense of the motor. For cases where electricians + and not physicists have defined the operating sense of the motor. Usually a + parameter not to be changed by ordinary users. + + + + +
+
+ Special SANS commands + + This section describes some commands special to SANS. One feature of SANS is that + components are used as a whole rather than refering to single motors. For SANS the + beamstop, the detector and the sample table is managed like this. Within a component + each axis can be adressed specifically by using an axis + = value pair. Axis defined for each component will + be listed below. Additionally these components support common commands as well. These + mainly deal with named positions. A named position is a set of values which can be + driven to by just specifying its name. For instance: bs PositionA + drives the BeamStop bs to the + position defined as PositionA. All component drive + commands do not block, i.e. you can type further commands. If it is needed to wait + for a component to arrive, use the Success command + right after your command. + + + Commands supported by all components (in the following, the name of the component + will be represented by <COP>): + + + <COP> + + + The name of the component alone will yield a listing of the + current position of the component. This is also a way how to find out which + axis the component supports. + + + + + + <COP> back + + + drives the component back to the position before the last + command. Please note, that back does not operate on itself, i.e. two times + <COP> back will not do a trick. + + + + + + <COP> pos <name> + + + This command promotes the current position of the component + to a named position <name>. Afterwards + this position can be reached by typing: <COP> <name> + . + + + + + + <COP> drop <name> + + + deletes the named position specified as second parameter. + + + + + + <COP> find + + + returns the name <name> + of the actual position of the component if the position was named before by + <COP> pos <name>. + + + + + + <COP> <axis 1> [=] <val 1> + [<axis 2> [=] <val 2> ...] + + + drives the component to the new position specified by 1-n + sets of <axis n> = <val n> + pairs. The equal sign is not mandatory and can be left out. The axis refers + to the internal axis of the component which is seen in a listing as created + by typing <COP>. A relative movement + of an axis can be performed if an ++ + or -- precedes the value for + <val n>. A value + ++10, for example would mean an increase of + the actual axis position by 10. + + + + + The components which follow the component syntax described above are bs + (beam stop), dt (detector), + st (sample table), and msh + (magnet sample holder). They are described in more detail in later sections. + +
+
+ Sample Environment Devices +
+ SICS Concepts for Sample Environment Devices + SICS can support any type of sample environment control device if there is a + driver for it. This includes temperature controllers, magnetic field controllers + etc. The SICS server is meant to be left running continuously. Therefore there exists + a facility for dynamically configuring and deconfiguring environment devices into + the system. This is done via the EVFactory command. + It is expected that instrument scientists will provide command procedures for + configuring environment devices and setting reasonable default parameters. + + In the SICS model a sample environment device has in principle two modes + of operation. The first is the drive modus. The device is monitored in this modus when a + new value for it has been requested. The second modus is the monitor modus. This modus + is entered when the device has reached its target value. After that, the device must be + continously monitored throughout any measurement. This is done through the environment + monitor or emon. The emon + command understands a few commands of its own. + + Within SICS all sample environment devices share some common behaviour concerning + parameters and abilities. Thus any given environment device accepts all of a set of + general commands plus some additional commands special to the device. + + In the next paragraphs the EVFactory, + emon and the general commands understood by any sample + environment device will be discussed. Reading this is mandatory for understanding SICS + environment device handling. Then there will be another section later on in this + manual discussing the special devices known to the system. + +
+
+ Sample Environment Error Handling + A sample environment device may fail to stay at its preset value during a + measurement. This condition will usually be detected by the + emon. The question is how to deal with this problem. + The requirements + for this kind of error handling are quite differentiated. The SICS model therefore + implements several strategies for handling sample environment device failure handling. + The strategy to use is selected via a variable which can be set by the user for any + sample environment device separatetly. Additional error handling strategies can be + added with a modest amount of programming. The error handling strategies currently + implemented are: + + + Lazy + + + Just print a warning and continue. + + + + + + Pause + + + Pauses the measurement until the problem has been resolved. + + + + + + Interrupt + + + Issues a SICS interrupt to the system. + + + + + + Safe + + + Tries to run the environment device to a value considered + safe by the user. + + + + + +
+
+ General Sample Environment Commands + + + EVFactory command: + + + EVFactory + is responsible for configuring and deconfiguring sample + environment devices into SICS. The syntax is simple: + + + EVFactory new <name> <type> <par> + [<par> ...] + + + Creates a new sample environment device. It will be known to + SICS by the name specified as second parameter + <name>. The + <type> + parameter decides which driver to use for this device. The type will be + followed by additional parameters which will be evaluated by the driver + requested. + + + + + + + EVFactory del <name> + + + Deletes the environment device + <name> from the + system. + + + + + + + emon command: + + + The environment monitor emon takes for the monitoring + of an environment device during measurements. It also initiates error handling when + appropriate. The emon understands a couple of commands. + + + emon list + + + This command lists all environment devices currently + registered in the system. + + + + + + + emon register <name> + + + This is a specialist command which registers the + environment device <name> with the + environment monitor. Usually this will automatically be taken care of + by EVFactory. + + + + + + + emon unregister <name> + + + This is a specialist command which unregisters the + environment device <name> with the + environment monitor. Following this call the device will no longer be + monitored and out of tolerance errors on that device no longer be + handled. + + + + +
+
+
+ General Commands UnderStood by All Sample Environment Devices + Please note that each command discussed below MUST be prepended with the + <name> of the environment device as configured + in EVFactory! The general commands understood by any + environment controller can be subdivided further into parameter commands and real + commands. The parameter commands just print the name of the parameter if given without + an extra parameter or set if a parameter is specified. For example: + + + Temperature Tolerance prints the value of the variable + Tolerance for the environment controller + Temperature. + + + Temperature Tolerance 2.0 sets the parameter + Tolerance for Temperature + to 2.0. + + + + + Parameters known to ANY envrironment controller are: + + + Tolerance + + + Is the deviation from the preset value which can be + tolerated before an error is issued. + + + + + Access + + + Determines who may change parameters for this + controller. Possible values are: + + 0 only internal + 1 only Managers + 2 Managers and Users + 3 Everybody, including Spy + + + + + + + + LowerLimit + + + The lower limit for the controller. + + + + + UpperLimit + + + The upper limit for the controller. + + + + + Errhandler + + + The error handler to use for this controller. + Possible values: + + 0 is Lazy + 1 for Pause + 2 for Interrupt + 3 for Safe + For an explanantion of these values see the section + about error handling above. + + + + + + + + Interrupt + + + The interrupt to issue when an error is + detected and interrupt error handling is set. + Valid values are: + + 0 for continue + 1 for abort operation + 2 for for abort scan + 3 for abort batch processing + 4 halt system + 5 exit server + For an explanantion of these values see the section + about error handling above. + + + + + + + + SafeValue + + + The value to drive the controller to when an error + has been detected and safe error handling is set. + + + + + + Additionally the following commands are understood: + + + <name> send <par> + [<par> ...] + + + Sends everything after send directly to the + controller and return its response. This is a general + purpose command which allows to manipulate controllers + and controller parameters directly. The protocoll for + these commands is documented in the documentation for + each controller. Ordinary users should not tamper with + this. This facility is meant for setting up the device + with calibration tables etc. + + + + + <name> list + + + lists all the parameters for this controller. + + + + + + <name> + + + When only the name of the device is typed it + will return its current value. + + + + + <name> <val> + + + will drive the device to the new value + <val>. Please note + that the same can be achieved by using the drive command. + + + + + <name> log on + + + Switches logging on. If logging is on, at each cycle + in the <emon> the current + value of the environment variable will be recorded together with + a time stamp. Be careful about this, for each log point a bit of + memory is allocated. At some time the memory is exhausted! + <name> log clear + frees it again and log frequency + (both below) allows to set the logging time intervall. + + + + + + <name> log of + + + Switches logging off. + + + + + <name> log clear + + + Clears all recorded time stamps and values. + + + + + <name> log gettime + + + This command retrieves a list of all recorded time + stamps. + + + + + + <name> log getval + + + This command retrieves all recorded values. + + + + + <name> log getmean + + + Calculates the mean value and the standard deviation + for all logged values and prints it. + + + + + <name> log frequency [<val>] + + + With a parameter <val> sets, + without a parameter requests the logging intervall for the log created. + This parameter specifies the time intervall in seconds between log + records. The default is 5 minutes. A value of 0 means a record for each + cycle of the SICServer. + + + + + +
+
+ +
+ TCL command language interface + The macro language implemented in the SICS server is John Ousterhout's + http://cseng.awl.com/authordetail.qry?AuthorID=69 + Tool Command Language (TCL) + http://www.tcltk.com + . Tcl has control constructs, variables of its own, loop constructs, + associative arrays and procedures. Tcl is well documented by several books + http://www.cica.indiana.edu/cica/faq/tcl/tcl.html + , online tutorials and manuals + http://www.scriptics.com/man/tcl8.0/contents.htm + . For getting further + informations on Tcl have a look on the TCL WWW Infohttp://www.sco.com/Technology/tcl/Tcl.html + + of Tcl Web serverhttp://www.tcltk.com + . All SICS commands are + available in the macro language. Some potentially harmful Tcl commands have been deleted from + the standard Tcl interpreter. These are: exec, + source, puts, + vwait, exit, + gets + and socket. Below only a small subset of the most important Tcl + commands like assigning variables, evaluating expressions, control and loop constructs are + described. For complete description of Tcl command have a look on the manual + http://www.scriptics.com/man/tcl8.0/contents.htm + pages or on one of the many books about Tcl/Tk. + +
+ + <computeroutput>set</computeroutput> - Read and Write variables + + Synopsis + + set varName ?value? + + + + Description + Returns the value of variable varName. If + value is specified, then set the value of + varName to value, + creating a new variable if one doesn't already exist, and return its value. If + varName contains an open parenthesis and ends with + a close parenthesis, then it refers to an array element: the characters before the + first open parenthesis are the name of the array, and the characters between the + parentheses are the index within the array. Otherwise + varName refers to a scalar variable. + +
+
+ + <computeroutput>expr</computeroutput> - Evaluate an expression + + Synopsis + + expr arg ?arg arg ...? + + + + Description + Concatenates arg's (adding separator spaces + between them), evaluates the result as a Tcl expression, and returns the value. The + operators permitted in Tcl expressions are a subset of the operators permitted in C + expressions, and they have the same meaning and precedence as the corresponding C + operators. Expressions almost always yield numeric results (integer or floating-point + values). For example, the expression + + + + + expr 8.2 + 6 + + evaluates to 14.2. Tcl expressions differ from C expressions in the way that + operands are specified. Also, Tcl expressions support non-numeric operands and string + comparisons. For some examples of simple expressions, suppose the variable + a has the value 3 and the variable + b has the value 6. Then the command on the left side of each of the + lines below will produce the value on the right side of the line: + + + + + expr 3.1 + $a + + + 6.1 + + + + + expr 2 + "$a.$b" + + + 5.6 + + + + + expr 4*[llength "6 2"] + + + 8 + + + + + expr {{word one} < "word $a"} + + + 0 + + + + + + + + + Math functions + Tcl supports the following mathematical functions in expressions: + + + + + + + acos + + + cos + + + hypot + + + sinh + + + + + asin + + + cosh + + + log + + + sqrt + + + + + atan + + + exp + + + log10 + + + tan + + + + + atan2 + + + floor + + + pow + + + tanh + + + + + ceil + + + fmod + + + sin + + + + + + + + + + Each of these functions invokes the math library function of the same name; see the + manual entries for the library functions for details on what they do. Tcl also + implements the following functions for conversion between integers and floating-point + numbers and the generation of random numbers: + + + abs(arg), double(arg), int(arg), rand(), round(arg), srand(arg). + + +
+
+ + <computeroutput>if</computeroutput> - Execute scripts conditionally + + Synopsis + + if expr1 ?then? body1 elseif expr2 ?then? body2 elseif ... + ?else? ?bodyN? + + + + Description + The if command evaluates + expr1 + as an expression (in the same way that expr + evaluates its argument). The value of the expression must be a boolean (a numeric value, + where 0 is false and anything is true, or a string value such as "true" or "yes" for true + and "false" or "no" for false); if it is true then body1 + is executed by passing it to the Tcl interpreter. Otherwise expr2 + is evaluated as an expression and if it is true then body2 + is executed, and so on. If none of the expressions evaluates to true then + bodyN is executed. The then + and else arguments are optional "noise words" to make the + command easier to read. There may be any number of elseif + clauses, including zero. BodyN may also be omitted as long + as else is omitted too. The return value from the command + is the result of the body script that was executed, or an empty string if none of the + expressions was non-zero and there was no bodyN. + + +
+
+ + <computeroutput>for</computeroutput> - "For" loop + + Synopsis + + for start test next body + + + + Description + + For is a looping command, similar in structure to + the C for statement. The start, next, + and body arguments must be Tcl command strings, and + test is an expression string. If a + continue command is invoked within + body then any + remaining commands in the current execution of body are + skipped; processing continues by invoking the Tcl interpreter on next, + then evaluating test, and so on. If a + break command is invoked within + body or next, then the + for command will return immediately. The operation of + break and continue are + similar to the corresponding statements in C. For + returns an empty string. + + + + + +for {set x 0} {$x<10} {incr x} { + puts "x is $x" +} + + + + +
+
+ + <computeroutput>while</computeroutput> - Execute script repeatedly + as long as a condition is met + + Synopsis + + while test body + + + + Description + The while command evaluates + test as an expression (in the same way that + expr + evaluates its argument). The value of the expression must be a proper boolean value; if + it is a true value then body is executed by passing it + to the Tcl interpreter. Once body has been executed then + test is evaluated again, and the process repeats until + eventually test evaluates to a false boolean value. + Continue commands may be executed inside + body to terminate the current iteration of the loop, and + break commands may be executed inside body + to cause immediate termination of the while command. The + while command always returns an empty string. + + + + + +set x 0 +while {$x<10} { + puts "x is $x" + incr x +} + + + + +
+
+ +
+ Instrument settings +
+ Beam shutter + Every instrument area in the SINQ neutron guide hall is controlled by the Local Beam + Controlsystem (LBC). It uses fixed installed barriers to prevent entry to the area around + the active beam during experimental work. If the user carries out his work in accordance + with the operating instructions, he will be protected from direct beam radiation. A danger + zone which is subject to the LBC interlocking system has two beam shutters + + the neutron guide main shutter which only can be opended by the radiation safety + officer + + + and a secondary shutter to close the beam at the instrument separately from the + others if more then one instrument is build up at the same neutron guide. + + + The secondary shutter for the instrument is the one the user can handle. Normally the + secondary shutter can only be operated if the experimental area (yellow fence) of the + instrument is locked. The shutter can then be opened and closed by a button on the key + box at the entrance door of the instrument area and also by the SICS command + shutter which has the following syntax: + + + shutter + + + without parameter yields the actual status of the shutter which can be + shutter is open, shutter is closed, or + Enclosure is broken. The last status message is returned + if the LBC system wouldn't allow to open the beam. If this message is returned the shutter + is closed. + + + + + + shutter close + + + closes the secondary beam shutter. + + + + + + shutter open + + + opens the secondary beam shutter. + + + + + +
+
+ Neutron velocity selector + + The neutron velocity selector is a high-speed rotor. Blades inserted in the rotor + are only transparent for neutrons which manage pass the rotor in a time intervall + defined by the rotation speed of the selector. Thus neutrons in a certain speed + range (wavelength range) are selected. The wavelength distribution of neutrons is + also dependent of the tilt angle between the rotation axis and the neutron beam. + Extensive time-of-flight measurements have been done to determine the wavelength + λ and resolution Δλ/λ as a function of selector speed and + tilting angle. The dependency of the wavelength λ [nm] on the rotation + speed ν [RPM] can well be described by + + + λ(ν,ξ)= A(ξ)/ν+B(ξ) + + + where A(ξ) ans B(ξ) are parameters depending on the tilting angle ξ. The + experimentally determined relationships A(ξ) and B(ξ) are + + + B(ξ)= 0.0122+3.61x10-4ξ+3.14 + x10-4ξ2 + +3.05x10-5ξ3 + +9.32x10-7ξ4 + + + The wavelength resolution Δλ/λ of the selector should be independent + of the rotation speed and only be dependent of the tilting angle ξ. However, this is + only true for long collimations. For short collimation lengths a slight dependency of + the resolution on the rotaion speed could be measured. Also the shape of the resolution + function is than not necessarily triangular. If the wavelength resolution of the selector + is not so important for the refinement of your data analysis you can use the values given + in the following table for the dependency of the wavelength resolution Δλ/ + λ on the tilting angle ξ. + + + + + ξ + Δλ/λ + A(ξ) + B(ξ) + + + + + -15 + 0.12 + 19812 + 0.0218 + + + -10 + 0.115 + 17774 + 0.0182 + + + -5 + 0.095 + 15493 + 0.0163 + + + 0 + 0.1 + 12716 + 0.01097 + + + 5 + 0.155 + 9342 + 0.0269 + + + 10 + 0.3 + 5293 + 0.0869 + + + + + A high speed-device like a velocity selector has to account for gyroscopic forces when + moving the device. In praxis this means that the selector must be stopped before the tilt + angle can be changed. Furthermore there are forbidden areas of rotation speeds. In these + areas the velocity selector is in destructive resonance with itself. For controlling the + neutron velocity selector three command are available: nvs + , nvswatch, and lambda + which are described below. + + + lambda + + + The name of the variable alone prints the current wavelength in nm. + + + + + lambda rot <value> + + + calculates the rotation speed for the wavelength given by + <value>. + + + + + lambda wl <value> + + + calculates the wavelength for the rotation speed given as parameter + <value>. + + + + + drive lambda <newval>, run lambda <newval> + + + The lambda variable can be driven + using the normal drive and + run commands. + + + + + nvs status + + + Prints a status summary of the velocity selector. + + + + + nvs list + + + Displays rotation speed and tilt angle of the velocity selctor. + + + + + nvs [rot=<newval>] [tilt=<newval>] + + + This command sets a new tilt angle and/or rotation speed for + the velocity selector. Either one or both of the keywords + tilt or rot + may be given, followed by a number. + + + + + nvs rotinterest + + + Enables printing of status messages about the current state of the + selector when it is driven. + + + + + nvs loss + + + Starts a loss current measurement on the velocity selector and + prints the result. + + + + + + + The commands described so far cover the actual handling of the velocity selector. During a + measurement users might want to use further functions such as: + + Monitor the rotation speed of the velocity selector. + + Log the rotation speeds of the velocity selector. + + Initiate error handling when the velocity selector + fails to stay within a predefined tolerance of rotation speeds. + + + Now, these are tasks usually connected with sample environment devices. Now, the + SICS programmers have been lazy. Moreover they wanted to avoid duplicating code + (and bugs). Consequently, they tricked the velocity selector to be a sample + environment device as well. + + This means besides the actual velocity selector object (in this case + called nvs) there exists another object for + monitoring the velocity selector. The name of this device is the name of the + velocity selector object with the string watch appended. For example if the + velocity selector has the SICS name nvs, the + monitor object will be nvswatch. The commands + understood by the watch object are fully decribed in the section about sample + environment devices. Please note, that all driving commands for the + watch object have been disabled. Driving + can only be achieved through the velocity selector object or the + lambda command. + +
+
+ Positioning an attenuator + + + + att + + + prints the current positioned attenuator. + + + + + att <val> + + + positions attenuator <val>. + Allowed attenuator numbers are 0, 1, 2, 3, 4 and 5. + + 0 : square 50 mm x 50 mm slit, attenuation = 1 + + 1 : circular 41 x diameter 0.4 mm slit, attenuation = 1/485 + + 2 : circular 9 x diameter 2 mm slit, attenuation = 1/88 + + 3 : circular 20 mm diameter slit, attenuation = 1/8 + + 4 : circular 30 mm diameter slit, attenuation = 1/3.5 + + 5 : circular 15 mm diameter slit, attenuation = 1/?? + + + + + + + +
+
+ Change the collimation + + + + coll + + + prints the current collimation length. + + + + + coll <val> + + + sets the collimation <val>. + Allowed collimation lengths are 1, 1.4, 2, 3, 4.5, 6, 8, + 11, 15 and 18. + + + + + +
+
+ Positioning the detector + + The detector can be moved via three motors named detectorx + , detectory, and detectorrotation. + These motors can be driven by the run or + drive commands described in . + The commands how to change motor parameters like Precision, + SoftZero etc. are described in . + The axes of the detector motors are defined as: + + + detectorx + + + An increasing value moves the detector away and a decreasing + value towards the sample position. + + + + + detectory + + + moves the detector laterally by a maximum of 480 mm in order to increase + the accessible q-range at any detector position. + + + + detectorrotation + + + rotates the detector around its vertical axis to reduce + parallaxes effects. + WarningThe BerSANS software package for the primary data + reduction does not handle the detector rotation. + + + + Instead of driving the motors individually one can refer to all motors as a whole by the + dt command. The command dt + without other parameters will yield a listing of the current position of the detector: + + +dt +Status listing for dt +dt.x = 18800.048828 +dt.y = 0.004000 +dt.phi = 0.414000 + + + To move the detector you can call dt with parameters + defining the new position of the motors, e.g. + + +dt x = 800 y = ++100 phi 0 + + + The = sign is not mandatory and can be left out. The + command above drives the motor detectorx to the + position 800, the motor + detectory to a position 100 mm further into + y-direction, the motor + detectorrotation to position + 0. All the three movements are done parallel. + Relative movements can be performed by preceding an + -- or ++ to the + motor position. The whole set of parameters valid for the + dt command is described in the + about special SANS commands. + +
+
+ Positioning the beam stop + The beam stop can be adjusted by two motors named + beamstopx and beamstopy. + They can be driven by the run or + drive commands which are described in + . The commands how to change motor parameters + like Precision, SoftZero + etc. are described in . The axes of the beam stop + motors are defined as: + + + beamstopx + + + moves the beam stop horizontally. + + + + + beamstopy + + + moves the beam stop vertically. + + + + + Instead of driving the motors individually one can refer to both motors as a + whole by the bs command. The command + bs without other parameters will yield a + listing of the current position of the beam stop: + + +bs +Status listing for bs +bs.x = 0.300000 +bs.y = 2.500000 + + + To move the beam stop you can call bs with + parameters defining the new position of the motors, e.g. + + +bs x = 2 y ++10 + + + The = sign is not mandatory and can be left + out. The command above drives the motor beamstopx + to the position 2 and the motor + beamstopy to a position 10 mm further into + y-direction. Both movements are done parallely. Relative movements can be + performed by preceding an -- or + ++ to the motor position. The whole + set of parameters valid for the bs command + is described in the about special + SANS commands. + + + Additionally to the commands for the movement of the two beam stop axes a few + other commands have been established: + + + bsout + + + moves the beam stop out of the detection area, so that + there is nowhere a shadow of the beam stop on the detector. This + position is outside the software limits of the motors in the area + of the beam stop magazines. In this area an uncontrolled movement + could lead to a collisioni with the magazines. Therefore one can + not move the beam stop anymore with the + bs command after calling + bsout, because the motors are + fixed automatically. + + + + + bsin + + + releases the beam stop motors and moves them back to the + previous position. After calling + bsout you have to call first + bsin to continue with the + movement of the beam stop with the + bs command. + + + + + bsfree + + + is a manager command, which releases the beam stop motors, + if they are still in the + bsout-position. This command should + only be used when something went wrong with the SICS server during + the time the beam stop was in + bsout-position. + + + + + bschange [<val>] + + + allows the user to change the size of the beam stop. Four + different sizes are available and can be selected by the parameter + <val>. Valid values for + <val> are: + + 1 for beam stop size of 40 mm x 40 mm + + 2 for beam stop size of 70 mm x 70 mm + + 3 for beam stop size of 85 mm x 85 mm + + 4 for beam stop size of 100 mm x 100 mm + + + + + The bschange command automatically recognizes the + actually used beam stop size, puts it into the empty magazine and picks up the new beam + stop. bschange automatically closes the instrument + beam shutter, if it was open, but it doesn't reopen it again afterwards. Calling + bschange without a parameter returns the number + of the actually used beam stop size. + + + + + +
+
+ +
+ Sample environments +
+ Sample table + + One standard sample set-up is the sample table with a vertical translator, a xy-table and a + rotation table. Optionally, another linear translator stage or a double goniometer can be + mounted on the rotation table. The available motor axes for the sample table are defined + as follows: + + + saz + + + vertical translation of the sample table + + + + + say + + + horizontal translation parallel to the neutron beam direction + + + + + sax + + + horizontal translation perpendicular to the neutron beam + + + + + som + + + rotation around the vertical axis ω + + + + + gphi + + + rotation around the horizontal axis Φ + + + + + gtheta + + + rotation around the horizontal axis Θ, + Θ ⊥ Φ ⊥ ω + + + + + sposi + + + horizontal translation. Linear translation stage can be + mounted on the rotation table and is used for the movement of + the temperature controlled (Haake temperature controler, + ) + sample holder. + + + + + The motors can be driven by the drive or + run commands described in + . Instead of driving the motors individually + one can refer to all motors as a whole by the + st command. The command + st without parameters will yield a listing + of the current positions of the sample table motors: + + +st +Status listing for st +st.omega = 0.504000 +st.x = 12.965000 +st.y = -18.992001 +st.z = 106.121002 +st.posi = 173.875000 + + + The axes are named x, + y, z, + posi, omega, + phi and theta + which move the motors sax, + say, saz, + spos, som, + gphi and gtheta, + respectively. In the above example the optional linear translator stage was mounted + on the rotation table so that the position of the motor + spos is listed but not those of the motors + gphi and gtheta. + The whole set of parameters valid for the st + command are described in about special SANS + commands. A frequently used parameter for st is + the pos parameter. The command + + +st pos P1 + + + reads out the actual positions of all the motors of the sample table and defines + for it the name P1. Afterwards this position can + be reached by typing simply st P1. Instead of + remembering the positions of all the motors one only has to remember the name + P1 to bring the sample in position. + +
+
+ Haake temperature controller + + This is sort of a buck full of water equipped with a temperature control system. + The RS-232 interface of this device can only be operated at 4800 baud max. This is + why it has to be connected to the serial printer port of the Macintosh serial port + server computer. This makes the channel number to use for initialisation a 1 always. + The driver for this device has been realised in the Tcl extension language of the + SICS server. A prerequisite for the usage of this device is that the file + hakle.tcl is sourced in the SICS initialisation + file and the command inihaakearray has been + published. Installing the Haake into SICS requires two steps: first create an + array with initialisation parameters, second install the device with + evfactory. A command procedure is supplied for + the first step. Thus the initialisation sequence becomes: + + +inihaakearray <name-of-array> <macintosh-computer> <name> <port> <channel> +evfactory new temperature tcl <name-of-array> + + + An example for the SANS: + + +inihaakearray eimer lnsa10.psi.ch 4000 1 +evfactory new temperature tcl eimer + + + Following this, the thermostat can be controlled with the other environment + control commands. + + + The Haake Thermostat understands a single special subcommand: + sensor. The thermostat may be equipped with an + external sensor for controlling and reading. The subcommand + sensor allows to switch between the two. The + exact syntax is: + + +temperature sensor <val> + + + <val> can be either + intern or + extern. + +
+
+ Bruker electromagnet + + This is the controller for the large magnet at SANS. The controller is a box the + size of a chest of drawers. This controller can be operated in one out of two modes: + in field mode the current for the magnet is controlled via an external hall sensor + at the magnet. In current mode, the output current of the device is controlled. + This magnet can be configured into SICS with a command syntax like this: + + +evfactory new <name> bruker <Mac-PC> <Mac-port> <Mac-channel> + + + <name> is a placeholder for the name of the + device within SICS. A good suggestion (which will be used throughout the rest of the + text) is magnet. bruker + is the keyword for selecting the bruker driver. <Mac-PC> + is the name of the Macintosh PC to which the controller has been connected, + <Mac-Port> is the port number at which the + Macintosh-PC's serial port server listens. <Mac-channel> + is the RS-232 channel to which the controller has been connected. For example (at SANS): + + +evfactory new magnet bruker lnsa10.psi.ch 4000 9 + + + creates a new command magnet for a Bruker magnet Controller connected to serial port + 9 at lnsa10. + + + In addition to the standard environment controller commands this magnet controller + understands the following special commands: + + + magnet polarity + + + Prints the current polarity setting of the controller. Possible answers + are plus, minus + and busy. The latter indicates that the controller + is in the process of switching polarity after a command had been given to switch it. + + + + + magnet polarity <val> + + + sets a new polarity for the controller. Possible values for + <val> are + minus or plus. + The meaning is self explaining. + + + + + magnet mode + + + Prints the current control mode of the controller. Possible answers are + field for control via hall sensor or + current for current control. + + + + + + magnet mode <val> + + + sets a new control mode for the controller. Possible values for + <val> are + field or + current. The meaning is explained above. + + + + + magnet field + + + + reads the magnets hall sensor independent of the control mode. + + + + + magnet current + + + reads the magnets output current independent of the control mode. + Warning + There is a gotcha with this. If you type only + magnet a value will be returned. The meaning of + this value is dependent on the selected control mode. In + current mode it is a current, in + field mode it is a magnetic field. This is so + in order to support SICS control logic. You can read values at all times explicitly + using magnet current or + magnet field. + + + + +
+
+ Sample holder for electro magnet + + Another standard sample seup is a vacuum chamber, which is directly connected to the + collimator and detector tubes, so that the SANS can be operated at about + 10-2 mbar in a single vacuum without windows or with thin + aluminium or sapphire windows to work at ambient pressure or at vacuum conditions + down to 10-6 mbar. The chamber is large enough to carry + an electromagnet. For this setup a sample changer with an optional heated sample + position is available. This sample changer can be moved vertically by 245 mm and can + also be rotated by ±10 degree. The two available motors are defined as follows: + + + mz + + + moves the electromagnet sample holder in vertical direction. + + + + + mom + + + rotates the sample around the vertical axis + ω by ±10 degree. + + + + + The motors can be driven by the run or + drive command described in + . Instead of driving the motors individually one can refer + to both motors as a whole by the msh command. The + command msh without parameters will yield a listing of + the current position of the electromagnet sample holder: + + +msh +Status listing for msh +msh.z = 0.000000 +msh.omega = 0.000000 + + + The axes of the sample holder mz and + mom are named in the + msh command + z and omega. + The whole set of parameters valid for the + msh command are described in + about special SANS commands. + +
+
+ Eurotherm temperature controller + + At SANS there is a Eurotherm temperature controller for the sample heater available. + This and probably other Eurotherm controllers can be configured into SICS with the + following command. The Eurotherm needs to be connected with a nullmodem adapter. + + +EVFactory new <name> euro <computer> <port> <channel> + + + <name> is a placeholder for the name of the + device within SICS. A good suggestion is temperature. + euro is the keyword for selecting the Eurotherm driver. + computer is the name of the Macintosh PC to which + the controller has been connected, <port> is the + port number at which the Macintosh-PC's serial port server listens. + <channel> is the RS-232 channel to which the + controller has been connected. + WarningThe Eurotherm needs a RS-232 port with an unusual + configuration: 7bits, even parity, 1 stop bit. Currently only the SANS Macintosh port 13 + (the last in the upper serial port connection box) is configured like this! Thus, an + example for SANS and the name temperature looks like: + + +EVFactory new temperature euro lnsa10.psi.ch 4000 13 + + + + There are two further gotchas with this thing: + + The Eurotherm needs to operate in the EI-bisynch protocoll mode. This + has to be configured manually. For details see the manual coming with the controller. + + The weird protocol spoken by the Eurotherm requires very special control + characters. Therefore the send functionality usually supported by a SICS environment + controller could not be implemented. + + + +
+
+ ITC-4 and ITC-503 temperature controller + *outdated controllers, will be replaced* + +
+
+ +
+ Data handling and acquisition +
+ File naming conventions and storing data + + Data files are stored by the SICS server on the lnsa10.psi.ch + workstation in the directory defined by the SICS variable + SICSDataPath. By default this directory is + /home/SANS/data/. The file name of a data file is + composed of four parts: + + + + the prefix stored in the variable SICSDataPrefix, + by default sans + + + + + the run number stored in the variable SICSDataNumber, + which is incremented before each storing process and has 5 digits (leading 0) + + + + + the actual year (4 digits) + + + + + and the post-fix stored in the variable SICSDataPostfix, + by default .hdf + + + + A typical data file name would be + /home/SANS/data/sans123452006.hdf. + All data files are written in NeXus format. + +
+
+ Data acquisition + + SICS counter handling + + The SICS counter concept may include several monitors per counter. At the SANS + instrument two monitors are installed: one between beam shutter and neutron + velocity selector, which is used for normalizing the SANS measurement on the + incident neutron flux, and a second one after the selector just in front of the + attenuator. For the SANS instrument only one counter is handled which is named + counter. A few words have to be lost about the + SICS handling of preset values for counters. Two modes of operation have to be + distinguished: counting until a timer has passed, for example counting for 20 + seconds. This mode is called Timer mode. In + the other mode, counting is continued until a control monitor has reached a + certain preset value. This mode is called Monitor + mode. At the SANS instrument the first monitor between beam shutter and neutron + selector is used in this mode. The preset values in + Monitor mode are usually very large. Therefore + the counter has an exponent data variable. Values given as preset are + effectively 10 to the power of this exponent. For instance if the preset is 25 + and the exponent is 6, then counting will be continued until the monitor has + reached 25 million. Note, that this scheme with the exponent is only in operation + in Monitor mode. The commands understood are: + + + counter SetPreset <val> + + + sets the counting preset to <val>. + + + + + counter GetPreset + + + prints the current preset value. + + + + + counter SetExponent <val> + + + sets the exponent for the counting preset in monitor mode to + <val>. + + + + + counter GetExponent + + + prints the current exponent used in monitor mode. + + + + + counter SetMode <val> + + + sets the counting mode to <val>. + Possible values are Timer for timer mode + operation and Monitor for waiting for a + monitor to reach a certain value. + + + + + counter GetMode + + + prints the current mode. + + + + + counter GetCounts + + + prints the counts gathered in the last run. + + + + + counter GetMonitor <n> + + + prints the counts gathered in the monitor number + <n> in the last run. + + + + + counter Count <preset> + + + starts counting in the current mode and the preset + <preset>. + + + + + counter status + + + prints a message containing the preset and the current monitor + or time value. Can be used to monitor the progress of the counting + operation.. + + + + + counter GetTime + + + retrieves the actual time the counter counted for. This + excludes time where there was no beam or counting was paused. + + + + + + + + Histogram memory + + The histogram memory is used in order to control the large area sensitive detector. It + takes care of putting counts detected in the detector into the proper bin in memory. + Next to a conventional mode of a SANS measurement where all detected neutrons are + accumulated for a given time or monitor count, also a time of flight mode and a + stroboscopic mode are available, where there is for each detector pixel a row of + memory locations mapping the time bins. As usual in SICS the syntax is the name of the + histogram memory followed by qualifiers and parameters. For the SANS the name of + the histogram memory is banana. + + + + The histogram memory has a plethora of configuration options coming with it which + define memory layout, modes of operation, handling of bin overflow and the like. + Additionally there are histogram memory model specific parameters which are needed + internally in order to communicate with the histogram memory. In most cases the + histogram memory will already have been configured at SICS server startup time. + However, there are occasion where these configuration options need to be enquired + or modified at run time. The command to enquire the current value of a configuration + option is: banana configure <option>, the + command to set it is: + banana configure <option> <newvalue>. + A list of common configuration options and their meaning is given below: + + + + HistMode + + + describes the modes of operation of the histogram memory. + Possible values are: + + + Transparent + + + counter data will be written as is to memory. For + debugging purposes only. + + + + + Normal + + + neutrons detected at a given detector will be added + to the apropriate memory bin. + + + + + TOF + + + time of flight mode, neutrons found in a given detector + will be put added to a memory location determined by the detector + and the time stamp. + + + + + Stroboscopic + + + This mode serves to analyse changes in a sample due to an + varying external force, such as a magnetic field, mechanical stress + or the like. Neutrons will be stored in memory according to detector + position and phase of the external force. + + + + + + + + + OverFlowMode + + + This parameter determines how bin overflow is handled. This happens when + more neutrons get detected for a particular memory location then are allowed + for the number type of the histogram memory bin. Possible values are: + + + Ignore + + + overflow will be ignored, the memory location will wrap + around and start at 0 again. + + + + + Ceil + + + the memory location will be kept at the highest posssible + value for its number type. + + + + + Count + + + as Ceil, but a list of + overflowed bins will be maintained. + + + + + + + + + Rank + + + defines the number of histograms in memory. + + + + + Length + + + gives the length of an individual histogram. + + + + + BinWidth + + + determines the size of a single bin in histogram memory in bytes. + + + + + + + For time of flight mode the time binnings can be retrieved and modified with the following + commands. Note that these commands do not follow the configure syntax given above. Please + note, that the usage of the commands for modifying time bins is restricted to instrument + managers. + + + banana timebin + + + prints the currently active time binning array. + + + + + banana genbin <start> <step> <n> + + + generates a new equally spaced time binning array. + Number <n> time bins will be generated + starting from <start> with a stepwidth of + <step>. + + + + + banana setbin <inum> <value> + + + Sometimes unequally spaced time binnings are needed. These can be configured + with this command. The time bin <iNum> is + set to the value <value>. + + + + + banana clearbin + + + Deletes the currently active time binning information. + + + + + banana preset [<val>] + + + with a new value <val> sets the preset + time or monitor for counting. Without <val> + prints the current value. + + + + + banana exponent [<val>] + + + with a new value <val> sets the exponent + to use for the preset time in Monitor mode. Without <val> + prints the current value. + + + + + banana CountMode [<mode>] + + + with a new value <mode> sets the + count mode. Possible values are Timer for a fixed + counting time and Monitor for a fixed monitor count + which has to be reached before counting finishes. Without a value for + <mode> the command prints the currently + active value. + + + + + banana init + + + after giving the configuration commands this needs to be called in order to + transfer the configuration from the host computer to the actual histogram memory. + + + + + banana count + + + starts counting using the currently active values for + CountMode and preset. + This command does not block, i.e. in order to inhibit further commands from the console, + you have to give Success afterwards. + + + + + banana Initval <val> + + + initialises the whole histogram memory to the value + <val>. Usually 0 in order to clear the histogram + memory. + + + + + banana get <i> <iStart> <iEnd> + + + retrieves the histogram number + <i>. A value of -1 for + <i> denotes retrieval of the whole histogram memory. + <iStart> and <iEnd> + are optional and allow to retrieve a subset of a histogram between + <iStart> and <iEnd>. + + + + + banana sum <d0min> <d0max> <d1min> <d1max> ...<dnmin> <dnmax> + + + calculates the sum of an area on the detector. For each dimension a minimum and + maximum boundary for summing must be given. + + + + + + + Storing Data and starting a SANS measurement + + Instead of initializing and starting a measurement by the banana + command a few other commands have been introduced to take care for those things: + + + StoreData + + + This command does what it says. It writes the current state of the instrument + including counts to a NeXus data file. + + + + + count [<mode> <preset>] + + + starts a count operation in mode <mode> + with a preset <preset>. + <mode> can have the values + Timer or Monitor. + The parameters are optional. If they are not given, the count operation will be started + with the current setting in the histogram memory object + banana. Before the count operation is started, the + count command waits until all other commands executed + earlier are finished. During the count operation no other commands can be executed. + After the count, StoreData will be automatically called. + + + + + repeat <num> [<mode> <preset>] + + + calls num times count. + num is a required parameter. The other two are optional and + are handled as described above for count. + + + + + + +
+
+ XY table + XYTable is a class which maintains a list of X-Y values. These can be plotted in the + VarWatch SICS client by configuring it with a special command. Before you may use an XYTable + object it had to be installed into the system by the SICS administrator. This can be done by + the command MakeXYTable <xydata> in the SANS initialization + file. For this documentation it is assumed that this has happened already and a XYTable object is + available in the system under the name <xydata>. + + + Interaction with the XYTable object happens through the following commands: + + + <xydata> clear + + + clears all entries in the x-y table. + + + + + <xydata> list + + + lists the entries in the x-y table on the screen. + + + + + <xydata> write <filename> + + + writes the x-y list to the disk file filename. This file resides on + the machine running the SICS server. + + + + + <xydata> uuget + + + sends the x-y list in an uuencoded format. This is the command to + give to the VarWatch SICS client in order to make it display the x-y list. + + + + + <xydata> add <xval> <yval> + + + creates a new x-y list entry with the values + <xval> and + <yval>. + + + + + +
+
+ Status of the actual acquisition process + empty +
+
+ + + + Other programs +
+ PSI2HMI + empty +
+
+ BerSANS software package + The Manual of the BerSANS Software Package is available in pdf format as well as a zipped pdf file. +
+
+ sasfit program + empty +
+ + + diff --git a/doc/user/tasub.htm b/doc/user/tasub.htm index 0e2f618e..9d506f5e 100644 --- a/doc/user/tasub.htm +++ b/doc/user/tasub.htm @@ -81,6 +81,12 @@ In order to calculate a UB matrix a list of reflections must be maintained. This
Add a new reflection to the list. Besides the indices all angles are given: a3, the sample rotation, a4, sample two theta, sgu, upper tilt cradle, sgl, lower tilt cradle and incoming energey ei and outgoing energy ef. +
tasub addauxref qh qk ql +
Adds an auxiliary reflection with indices qh, qk, ql to the list. A4 is + calculated from cell constants. A3 is either left alone or is calculated to + have the correct angular difference to a previous reflection. This is a help + for setting up the instrument or running powder mode. When a UB has been + generated from auxiliary reflections, a3, sgu and sgl angles will be incorrect.

Calculations

diff --git a/evcontroller.c b/evcontroller.c index 69aea67a..50d2ab1c 100644 --- a/evcontroller.c +++ b/evcontroller.c @@ -971,12 +971,15 @@ static void ErrReport(pEVControl self) { ObPar *pPar = NULL; char pBueffel[512]; - int iRet; + int iRet, savedStatus; assert(self); assert(pCon); + savedStatus = GetStatus(); /* fool status check in ObParSet (avoid "Cannot change parameter while running" message */ + SetStatus(eBatch); iRet = ObParSet(self->pParam,self->pName,name,fVal,pCon); + SetStatus(savedStatus); if(!iRet) { return iRet; @@ -1102,8 +1105,11 @@ static void ErrReport(pEVControl self) iRet = EVCGetPos(self,pCon,&fPos); if(iRet) { +/* sprintf(pBueffel,"%s.%s = %g",self->pName,"CurrentValue", fPos); SCWrite(pCon,pBueffel,eValue); +*/ + SCPrintf(pCon, eValue, "%s = %g", self->pName, fPos); return 1; } return 0; diff --git a/event.c b/event.c index de2fa970..98ab43be 100644 --- a/event.c +++ b/event.c @@ -64,6 +64,11 @@ "BATCHAREA", "BATCHEND", "DRIVSTAT", + "STATUS", + "POSITION", + "HDBVAL", + "STATESTART", + "STATEEND", NULL }; diff --git a/event.h b/event.h index a990d827..eb8f9f18 100644 --- a/event.h +++ b/event.h @@ -1,5 +1,5 @@ -#line 89 "event.w" +#line 103 "event.w" /*---------------------------------------------------------------------------- E V E N T @@ -14,15 +14,15 @@ #ifndef SICSEVENT #define SICSEVENT -#line 13 "event.w" +#line 14 "event.w" int Text2Event(char *pText); -#line 102 "event.w" +#line 116 "event.w" -#line 20 "event.w" +#line 21 "event.w" #define VALUECHANGE 0 #define MOTDRIVE 1 @@ -42,14 +42,18 @@ #define BATCHAREA 15 #define BATCHEND 16 #define DRIVSTAT 17 -#define STATUS 18 -#define POSITION 19 /* Position event for motors - ffr */ -#line 104 "event.w" +#define STATUS 18 +#define POSITION 19 +#define HDBVAL 20 +#define STSTART 21 +#define STEND 22 + +#line 118 "event.w" /*--------------- Signals for the Signalfunction of each task ------------*/ -#line 73 "event.w" +#line 87 "event.w" #define SICSINT 300 #define SICSBROADCAST 301 @@ -57,6 +61,6 @@ #define TOKENRELEASE 303 #define COMLOG 304 -#line 107 "event.w" +#line 121 "event.w" #endif diff --git a/event.tex b/event.tex index b19694ee..5e0b5264 100644 --- a/event.tex +++ b/event.tex @@ -53,6 +53,9 @@ $\langle$VE {\footnotesize ?}$\rangle\equiv$ \mbox{}\verb@#define BATCHAREA 15@\\ \mbox{}\verb@#define BATCHEND 16@\\ \mbox{}\verb@#define DRIVSTAT 17@\\ +\mbox{}\verb@#define STATUS 18@\\ +\mbox{}\verb@#define POSITION 19@\\ +\mbox{}\verb@#define HDBVAL 20@\\ \mbox{}\verb@@$\diamond$ \end{list} \vspace{-1ex} @@ -87,6 +90,10 @@ operation. \item[BATCHEND] signals the end of the batch buffers processing. \item[DRIVSTAT] signals a change in the status of a driving operation (start, finished, fault) +\item[STATUS] ANSTO defined code. +\item[POSITION] ANSTO defined code +\item[HDBVAL] The Hdb is notified of a value change. The eventData will be + the object on which the data changed. \end{description} Furthermore event contains system wide signal codes which are interpreted in diff --git a/event.w b/event.w index b165cf6a..de1946b9 100644 --- a/event.w +++ b/event.w @@ -36,6 +36,9 @@ if the event code is not known, else the apropriate event code. #define BATCHAREA 15 #define BATCHEND 16 #define DRIVSTAT 17 +#define STATUS 18 +#define POSITION 19 +#define HDBVAL 20 @} \begin{description} \item[VALUECHANGE] This is a variable changing its value. As event data a pointer to the @@ -62,6 +65,10 @@ operation. \item[BATCHEND] signals the end of the batch buffers processing. \item[DRIVSTAT] signals a change in the status of a driving operation (start, finished, fault) +\item[STATUS] ANSTO defined code. +\item[POSITION] ANSTO defined code +\item[HDBVAL] The Hdb is notified of a value change. The eventData will be + the object on which the data changed. \end{description} Furthermore event contains system wide signal codes which are interpreted in diff --git a/exe.w b/exe.w index 859ce1f8..58c62057 100644 --- a/exe.w +++ b/exe.w @@ -173,6 +173,7 @@ int ExeManagerWrapper(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); int runExeBatchBuffer(void *pData, SConnection *pCon, SicsInterp *pSics, char *name); +pDynString findBatchFile(SicsInterp *pSics, char *name); @} @o exeman.i -d @{ diff --git a/exebuf.h b/exebuf.h index d32c05f3..026a9730 100644 --- a/exebuf.h +++ b/exebuf.h @@ -1,5 +1,5 @@ -#line 209 "exe.w" +#line 210 "exe.w" /** * Buffer handling code for the Exe Buffer batch file processing @@ -89,7 +89,7 @@ */ char *exeBufName(pExeBuf self); -#line 222 "exe.w" +#line 223 "exe.w" #endif diff --git a/exebuf.i b/exebuf.i index ffa5f5ee..62a15a24 100644 --- a/exebuf.i +++ b/exebuf.i @@ -1,5 +1,5 @@ -#line 200 "exe.w" +#line 201 "exe.w" /*-------------------------------------------------------------------- Internal header file for the exe buffer module. Do not edit. This is @@ -16,6 +16,6 @@ typedef struct __EXEBUF{ int lineno; } ExeBuf; -#line 205 "exe.w" +#line 206 "exe.w" diff --git a/exeman.c b/exeman.c index e0f01712..177c8c2f 100644 --- a/exeman.c +++ b/exeman.c @@ -175,6 +175,43 @@ static pDynString locateBatchBuffer(pExeMan self, char *name){ DeleteDynString(result); return NULL; } +/*------------------------------------------------------------------- + * Generate a full path name for the argument in the first + * directory of batch path + * -------------------------------------------------------------------*/ +static int makeExePath(pExeMan self, SConnection *pCon, int argc, char *argv[]){ + char buffer[512], *pPtr = NULL, pPath[132]; + + if(argc < 3) { + SCWrite(pCon,"ERROR: require a file name for makepath",eError); + return 0; + } + strcpy(buffer,"exe.makepath = "); + /* + * do nothing to absolute path + */ + if(argv[2][0] == '/'){ + strncat(buffer,argv[2],511-strlen(buffer)); + SCWrite(pCon,buffer,eValue); + return 1; + } + pPtr = self->batchPath; + pPtr = stptok(pPtr,pPath,131,":"); + strncat(buffer,pPath,511-strlen(buffer)); + strncat(buffer,"/",511-strlen(buffer)); + strncat(buffer,argv[2],511-strlen(buffer)); + SCWrite(pCon,buffer,eValue); + + return 1; +} +/*--------------------------------------------------------------------*/ +pDynString findBatchFile(SicsInterp *pSics, char *name){ + pExeMan self = (pExeMan)FindCommandData(pSics,"exe","ExeManager"); + if(self == NULL){ + return NULL; + } + return locateBatchBuffer(self,name); +} /*--------------------------------------------------------------------*/ static int runBatchBuffer(pExeMan self, SConnection *pCon, SicsInterp *pSics, char *name){ @@ -937,6 +974,7 @@ int ExeManagerWrapper(SConnection *pCon, SicsInterp *pSics, void *pData, char pBufferName[256]; int status; pDynString dirList = NULL; + pDynString fullPath = NULL; self = (pExeMan)pData; assert(self != NULL); @@ -1012,6 +1050,24 @@ int ExeManagerWrapper(SConnection *pCon, SicsInterp *pSics, void *pData, SCWrite(pCon,"Nothing found",eValue); } return 1; + }else if(strcmp(argv[1],"fullpath") == 0){ + if(argc < 2){ + SCWrite(pCon,"ERROR: not enough arguments to exe fullpath",eError); + return 0; + } + fullPath = locateBatchBuffer(self,argv[2]); + if(fullPath == NULL){ + SCWrite(pCon,"ERROR: buffer NOT found",eError); + return 0; + } else { + DynStringInsert(fullPath,"exe.fullpath=",0); + SCWrite(pCon,GetCharArray(fullPath),eValue); + DeleteDynString(fullPath); + return 1; + } + return 1; + }else if(strcmp(argv[1],"makepath") == 0){ + return makeExePath(self,pCon,argc,argv); }else if(strcmp(argv[1],"clear") == 0){ clearQueue(self); SCSendOK(pCon); diff --git a/exeman.h b/exeman.h index 0d5a08be..479c5087 100644 --- a/exeman.h +++ b/exeman.h @@ -15,5 +15,6 @@ int ExeManagerWrapper(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); int runExeBatchBuffer(void *pData, SConnection *pCon, SicsInterp *pSics, char *name); +pDynString findBatchFile(SicsInterp *pSics, char *name); #endif diff --git a/exeman.i b/exeman.i index 2b441c74..c5436d01 100644 --- a/exeman.i +++ b/exeman.i @@ -1,5 +1,5 @@ -#line 178 "exe.w" +#line 179 "exe.w" /*------------------------------------------------------------------- Internal header file for the exe manager module. Do not edit. This @@ -20,5 +20,5 @@ typedef struct __EXEMAN{ int echo; }ExeMan, *pExeMan; -#line 183 "exe.w" +#line 184 "exe.w" diff --git a/fitcenter.c b/fitcenter.c index ceb37452..c39bfff0 100644 --- a/fitcenter.c +++ b/fitcenter.c @@ -421,6 +421,7 @@ pFit self = NULL; int iRet; char pBueffel[256]; + pDynString buf = NULL; self = (pFit)pData; assert(self); @@ -466,10 +467,18 @@ sprintf(pBueffel,"%f", self->fCenter); SCWrite(pCon,pBueffel,eValue); return 1; + } + if(strcmp(argv[1],"data") == 0) + { + snprintf(pBueffel,255,"%f,%f,%ld", + self->fCenter, self->FWHM, self->lPeak); + SCWrite(pCon,pBueffel,eValue); + return 1; } } /* print results */ + SCStartBuffering(pCon); sprintf(pBueffel,"Estimated Peak Center: %f, StdDev: %f \n", self->fCenter,self->fStddev); SCWrite(pCon,pBueffel,eValue); @@ -477,6 +486,10 @@ SCWrite(pCon,pBueffel,eValue); sprintf(pBueffel,"Approximate FWHM: %f\n",self->FWHM); SCWrite(pCon,pBueffel,eValue); + buf = SCEndBuffering(pCon); + if(buf != NULL){ + SCWrite(pCon,GetCharArray(buf),eValue); + } return 1; } diff --git a/fourlib.c b/fourlib.c index 96bffda1..f954f322 100644 --- a/fourlib.c +++ b/fourlib.c @@ -625,6 +625,10 @@ int findAllowedBisecting(double lambda, MATRIX z1, float fSet[4], return 0; } + if(testFunc(userData, fSet, mask) == 1){ + return 1; + } + for(psi = .0; psi < 360.; psi += .5){ rotatePsi(om,chi,phi,psi,&ompsi,&chipsi,&phipsi); fTest[0] = stt; @@ -638,6 +642,26 @@ int findAllowedBisecting(double lambda, MATRIX z1, float fSet[4], } return 1; } + /* + * if chi close to 0, or 180, try to wrap phi onto om + */ + if(ABS(fTest[2] - .0) < .1 || ABS(fTest[2] - 180.) < .1){ + fTest[1] -= fTest[3]; + fTest[3] = .0; + if(fTest[1] < 0.){ + fTest[1] += 360.; + } + if(fTest[1] > 360.0){ + fTest[1] -= 360.; + } + status = testFunc(userData,fTest,mask); + if(status == 1){ + for(i = 0; i < 4; i++){ + fSet[i] = fTest[i]; + } + return 1; + } + } if(mask[0] == 0) { /* * useless: when two theta problem there is no solution diff --git a/hdbcommand.c b/hdbcommand.c new file mode 100644 index 00000000..5308322c --- /dev/null +++ b/hdbcommand.c @@ -0,0 +1,291 @@ +/** + * This module implements a generalized scheme for executing functions. + * Functions are described by a special data structure containing the + * parameters as a Hipadaba list and and an execute function which implements + * the actual operation. This is augmented by list mechanisms in order to + * allow for a list of functions. This shall facilitate a couple of things: + * - when functions are defined in such a structured form, general invocation + * functions can be devised for handling the interpreter interface. + * - The set of functions of an object can be configured and extended at + * runtime. + * - A common usage case: execute a function with the same arguments, can be + * easily catered for. + * All this is not new and was pioneered in the language self or other + * dynamic object systems. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, September 2006 + */ +#include +#include +#include +#include +#include +/*-------------------------------------------------------------------------*/ +static int debug = 1; +/* ============================= live and death ============================*/ +pHdbCommand CreateHdbCommand(char *name, int (*execute)(pHdb parameters)){ + pHdbCommand result = NULL; + + assert(name != NULL); + assert(execute != NULL); + + result = malloc(sizeof(hdbCommand)); + if(result == NULL){ + return NULL; + } + memset(result,0,sizeof(hdbCommand)); + result->name = strdup(name); + if(result->name == NULL){ + free(result); + return NULL; + } + result->execute = execute; + return result; +} +/*--------------------------------------------------------------------------*/ +void AppendHdbCommandToList(pHdbCommand commandList, pHdbCommand command){ + pHdbCommand current = NULL; + + assert(commandList != NULL); + assert(command != NULL); + + current = commandList; + while(current->next != NULL){ + current = (pHdbCommand)current->next; + } + command->previous = (struct __hdbCommand *)current; + current->next = (struct __hdbCommand *)command; + command->next = NULL; +} +/*--------------------------------------------------------------------------*/ +void AppendCommandParameter(pHdbCommand command, pHdb par){ + assert(command != NULL); + assert(par != NULL); + + AddHipadabaChild(command->parameters,par,NULL); +} +/*--------------------------------------------------------------------------*/ +void KillHdbCommandList(pHdbCommand commandList){ + pHdbCommand next = NULL, current = NULL; + + assert(commandList != NULL); + + current = commandList; + next = (pHdbCommand)current->next; + while(current != NULL){ + if(current->name != NULL){ + free(current->name); + } + if(current->parameters != NULL){ + DeleteHipadabaNode(current->parameters,NULL); + } + free(current); + current = next; + if(current != NULL){ + next = (pHdbCommand)current->next; + } else { + next = NULL; + } + } +} +/*======================= Invocation =======================================*/ +static pHdbCommand locateCommand(pHdbCommand commandList, char *name){ + pHdbCommand current = NULL; + + current = commandList; + while(current != NULL){ + if(strcmp(current->name,name) == 0) { + return current; + } + current = (pHdbCommand)current->next; + } + return NULL; +} +/*---------------------------------------------------------------------------*/ +int HdbCommandInvoke(pHdbCommand commandList, char *name, ...){ + va_list ap; + pHdbCommand toInvoke = NULL; + pHdb currentPar = NULL; + char *txt = NULL; + hdbValue *v = NULL; + + va_start(ap,name); + toInvoke = locateCommand(commandList,name); + if(toInvoke == NULL){ + return HDBCOMNOCOM; + } + + currentPar = toInvoke->parameters; + while(currentPar != NULL){ + /* + * I cannot call a function for this as ap would be undefined after + * a call to a function here + */ + switch(currentPar->value.dataType){ + case HIPNONE: + break; + case HIPINT: + currentPar->value.v.intValue = va_arg(ap,int); + if(debug == 1){ + printf("Read %d for parameter %s\n", + currentPar->value.v.intValue, currentPar->name); + } + break; + case HIPFLOAT: + currentPar->value.v.doubleValue = va_arg(ap,double); + if(debug == 1){ + printf("Read %lf for parameter %s\n", + currentPar->value.v.doubleValue, currentPar->name); + } + break; + case HIPTEXT: + txt = va_arg(ap,char *); + if(currentPar->value.v.text != NULL){ + free(currentPar->value.v.text); + } + currentPar->value.v.text = strdup(txt); + if(debug == 1){ + printf("Read %s for parameter %s\n", + currentPar->value.v.text, currentPar->name); + } + break; + case HIPOBJ: + currentPar->value.v.obj = va_arg(ap,void *); + break; + case HIPINTAR: + case HIPINTVARAR: + case HIPFLOATAR: + case HIPFLOATVARAR: + v = (hdbValue *)va_arg(ap,void *); + copyHdbValue(v,¤tPar->value); + break; + default: + assert(0); + break; + + } + currentPar = currentPar->next; + } + va_end(ap); + return toInvoke->execute(toInvoke->parameters); +} +/*-------------------------------------------------------------------------*/ +static void *(*objMap)(char *name) = NULL; +/*-------------------------------------------------------------------------*/ +void SetHdbComObjMapper(void *(*mapObj)(char *name)){ + objMap = mapObj; +} +/*-------------------------------------------------------------------------*/ +static int readParArguments(pHdb parNode, int argc, char *argv[]){ + int i, intVal; + double doVal; + + switch(parNode->value.dataType){ + case HIPNONE: + return 0; + break; + case HIPINT: + if(argc < 1){ + return HDBCOMNOARGS; + } + if(sscanf(argv[0],"%d",&parNode->value.v.intValue) != 1){ + return HDBCOMBADARG; + } + return 1; + break; + case HIPFLOAT: + if(argc < 1){ + return HDBCOMNOARGS; + } + if(sscanf(argv[0],"%lf",&parNode->value.v.doubleValue) != 1){ + return HDBCOMBADARG; + } + return 1; + break; + case HIPOBJ: + if(objMap != NULL){ + parNode->value.v.obj = objMap(argv[0]); + if(parNode->value.v.obj == NULL){ + return HDBCOMBADOBJ; + } else { + return 1; + } + } + return 0; + break; + case HIPTEXT: + if(argc < 1){ + return HDBCOMNOARGS; + } + if(parNode->value.v.text != NULL){ + free(parNode->value.v.text); + } + parNode->value.v.text = strdup(argv[0]); + return 1; + break; + case HIPINTAR: + if(parNode->value.arrayLength > argc){ + return HDBCOMNOARGS; + } + for(i = 0; i < parNode->value.arrayLength; i++){ + if(sscanf(argv[i],"%d",&intVal) != 1){ + return HDBCOMBADARG; + } + parNode->value.v.intArray[i] = intVal; + } + return parNode->value.arrayLength; + break; + case HIPFLOATAR: + if(parNode->value.arrayLength > argc){ + return HDBCOMNOARGS; + } + for(i = 0; i < parNode->value.arrayLength; i++){ + if(sscanf(argv[i],"%lf",&doVal) != 1){ + return HDBCOMBADARG; + } + parNode->value.v.floatArray[i] = doVal; + } + return parNode->value.arrayLength; + break; + default: + /* + * I cannot process such variables + */ + return HDBCOMINVARG; + break; + } + return 0; +} +/*--------------------------------------------------------------------------*/ +int HdbCommandTextInvoke(pHdbCommand commandList, int argc, char *argv[]){ + pHdbCommand toInvoke = NULL; + pHdb currentPar = NULL; + int argPointer, status; + + assert(commandList != NULL); + + if(argc < 1){ + return HDBCOMNOARGS; + } + + toInvoke = locateCommand(commandList,argv[0]); + if(toInvoke == NULL){ + return HDBCOMNOCOM; + } + + currentPar = toInvoke->parameters; + argPointer = 1; + while(currentPar != NULL){ + status = readParArguments(currentPar,argc-argPointer, + &argv[argPointer]); + if(status < 0){ + return status; + } else { + argPointer += status; + } + currentPar = currentPar->next; + } + return toInvoke->execute(toInvoke->parameters); +} diff --git a/hdbcommand.h b/hdbcommand.h new file mode 100644 index 00000000..b1b8285f --- /dev/null +++ b/hdbcommand.h @@ -0,0 +1,96 @@ +/** + * This module implements a generalized scheme for executing functions. + * Functions are described by a special data structure containing the + * parameters as a Hipadaba list and and an execute function which implements + * the actual operation. This is augmented by list mechanisms in order to + * allow for a list of functions. This shall facilitate a couple of things: + * - when functions are defined in such a structured form, general invocation + * functions can be devised for handling the interpreter interface. + * - The set of functions of an object can be configured and extended at + * runtime. + * - A common usage case: execute a function with the same arguments, can be + * easily catered for. + * All this is not new and was pioneered in the language self or other + * dynamic object systems. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, September 2006 + */ +#ifndef HDBCOMMAND_H_ +#define HDBCOMMAND_H_ +#include +#include +/*--------------- error codes ----------------------------------------------*/ +#define HDCOMNOMEM -7801 +#define HDBCOMNOCOM -7802 +#define HDBCOMNOARGS -7803 +#define HDBCOMBADARG -7804 +#define HDBCOMINVARG -7805 +#define HDBCOMBADOBJ -7806 +/*---------------------------------------------------------------------------*/ +typedef struct __hdbCommmand { + char *name; + pHdb parameters; + int (*execute)(pHdb parameters); + struct __hdbCommand *next; + struct __hdbCommand *previous; +}hdbCommand, *pHdbCommand; +/*======================= live and death ===================================*/ +/** + * create a hdbCommand with an empty parameter list + * @param name The name of teh command + * @param execute The execute function for this command + * @return a fresh hdbCommand or NULL when out of memory + * */ +pHdbCommand CreateHdbCommand(char *name, int (*execute)(pHdb parameters)); +/** + * append a hdbCommand to a command list + * @param commandList The list to append the command to + * @param command The command to append + * @return 1 on success, a negative error code else. + */ +void AppendHdbCommandToList(pHdbCommand commandList, pHdbCommand command); +/** + * append a parameter to the parameter list + * @param command The command to append the parameter too + * @param par The parameter to append + */ +void AppendCommandParameter(pHdbCommand command, pHdb par); +/** + * delete a command list recursively + * @param commandList The command list to delete + */ +void KillHdbCommandList(pHdbCommand commandList); +/*===================== invocation ========================================*/ +/** + * invoke a hdbCommand name. This does a lot: it locates the command, + * it assigne the parameter values and finally calls the execute function. + * @param commandList The command list in which to search for the command + * @param name The name of the command + * @param ... arguments to the command. ints, double, text and objects (pointers) + * are accepted as is.Arrays have to be passed in a pointers to a + * hdbValue structure. Otherwise there is not eonough information to safely + * copy array data. + * @return Negative error codes on invocation error, else the return + * value of the execute function. + */ +int HdbCommandInvoke(pHdbCommand commandList, char *name, ...); +/** + * invoke a hdbCommand name. This does a lot: it locates the command, + * it assigne the parameter values and finally calls the execute function. + * The name of the command must be in argv[0] + * @param commandList The command list in which to search for the command + * @param argc The number of arguments + * @param argv[] An array of strings holding the argument data + * @return Negative error codes on invocation error, else the return + * value of the execute function. + */ +int HdbCommandTextInvoke(pHdbCommand commandList, int argc, char *argv[]); +/** + * set a mapper which returns a void pointer for a name in order to resolve + * object references + * @param mapfunc + */ +void SetHdbComObjMapper(void *(*mapObj)(char *name)); +#endif /*HDBCOMMAND_H_*/ diff --git a/hipadaba.c b/hipadaba.c index 3ec67b0f..7ca1cf87 100644 --- a/hipadaba.c +++ b/hipadaba.c @@ -38,6 +38,10 @@ static void DeleteNodeData(pHdb node){ DeleteCallbackChain(node->writeCallbacks); DeleteCallbackChain(node->updateCallbacks); DeleteCallbackChain(node->readCallbacks); + DeleteCallbackChain(node->treeChangeCallbacks); + if(node->properties != NULL){ + DeleteStringDict(node->properties); + } if(node->name != NULL){ free(node->name); @@ -52,8 +56,24 @@ static void DeleteNodeData(pHdb node){ } free(node); } +/*-------------------------------------------------------------------------*/ +static int InvokeCallbackChain(pHdbCallback root, pHdb node, + void *callData, hdbValue v){ + pHdbCallback current = root; + int status; + + while(current != NULL){ + status = current->userCallback(current->userData,callData, + node,v); + if(status != 1){ + return status; + } + current = current->next; + } + return 1; +} /*------------------------------------------------------------------------*/ -void RemoveHdbNodeFromParent(pHdb node){ +void RemoveHdbNodeFromParent(pHdb node, void *callData){ pHdb parent = NULL; pHdb current = NULL; @@ -68,6 +88,8 @@ void RemoveHdbNodeFromParent(pHdb node){ current = current->next; } current->next = current->next->next; + InvokeCallbackChain(parent->treeChangeCallbacks, + parent,callData,parent->value); } } /*-----------------------------------------------------------------------*/ @@ -174,22 +196,6 @@ static pHdbCallback DeleteForInternalID(pHdbCallback root, int id){ } return result; } -/*-------------------------------------------------------------------------*/ -static int InvokeCallbackChain(pHdbCallback root, pHdb node, - void *callData, hdbValue v){ - pHdbCallback current = root; - int status; - - while(current != NULL){ - status = current->userCallback(current->userData,callData, - node,v); - if(status != 1){ - return status; - } - current = current->next; - } - return 1; -} /*----------------------------------------------------------------------*/ char *hdbTrim(char *str) { @@ -270,9 +276,9 @@ hdbValue makeHdbValue(int datatype, int length){ case HIPINTAR: case HIPINTVARAR: val.arrayLength = length; - val.v.intArray = malloc(length*sizeof(long)); + val.v.intArray = malloc(length*sizeof(int)); if(val.v.intArray != NULL){ - memset(val.v.intArray,0,length*sizeof(long)); + memset(val.v.intArray,0,length*sizeof(int)); } break; case HIPFLOATAR: @@ -285,15 +291,71 @@ hdbValue makeHdbValue(int datatype, int length){ break; case HIPTEXT: val.v.text = strdup("UNKNOWN"); + val.arrayLength = length; break; } return val; } +/*------------------------------------------------------------------------*/ +hdbValue makeHdbData(int datatype, int length, void *data){ + hdbValue val; + + memset(&val,0,sizeof(hdbValue)); + val.dataType = datatype; + + switch(datatype){ + case HIPINT: + if(data != NULL){ + memcpy(&val.v.intValue,data,sizeof(int)); + } + break; + case HIPFLOAT: + if(data != NULL){ + memcpy(&val.v.doubleValue,data,sizeof(double)); + } + break; + case HIPINTAR: + case HIPINTVARAR: + val.arrayLength = length; + val.v.intArray = malloc(length*sizeof(int)); + if(val.v.intArray != NULL){ + memset(val.v.intArray,0,length*sizeof(int)); + } + if(data != NULL){ + memcpy(val.v.intArray,data,length*sizeof(int)); + } + break; + case HIPFLOATAR: + case HIPFLOATVARAR: + val.arrayLength = length; + val.v.floatArray = malloc(length*sizeof(double)); + if(val.v.floatArray != NULL){ + memset(val.v.floatArray,0,length*sizeof(double)); + } + if(data != NULL){ + memcpy(val.v.floatArray,data,length*sizeof(double)); + } + break; + case HIPTEXT: + if(data != NULL){ + val.v.text = strdup((char *)data); + } else { + val.v.text = strdup("UNKNOWN"); + } + val.arrayLength = strlen(val.v.text); + break; + case HIPOBJ: + val.v.obj = data; + break; + } + return val; +} /*-------------------------------------------------------------------------*/ hdbValue MakeHdbInt(int initValue){ hdbValue result; result.dataType = HIPINT; + result.arrayLength = 1; result.v.intValue = initValue; return result; } @@ -302,6 +364,7 @@ hdbValue MakeHdbFloat(double initValue){ hdbValue result; result.dataType = HIPFLOAT; + result.arrayLength = 1; result.v.doubleValue = initValue; return result; } @@ -311,10 +374,11 @@ hdbValue MakeHdbText(char *initText){ result.dataType = HIPTEXT; result.v.text = initText; + result.arrayLength = strlen(initText); return result; } /*-------------------------------------------------------------------------*/ -hdbValue MakeHdbIntArray(int length, long *data){ +hdbValue MakeHdbIntArray(int length, int *data){ hdbValue result; result.dataType = HIPINTAR; @@ -409,6 +473,13 @@ int compareHdbValue(hdbValue v1, hdbValue v2){ } return 1; break; + case HIPOBJ: + if(v2.v.obj == v1.v.obj) { + return 1; + } else { + return 0; + } + break; default: assert(0); break; @@ -422,6 +493,35 @@ int cloneHdbValue(hdbValue *source, hdbValue *clone){ clone->dataType = source->dataType; return copyHdbValue(source, clone); } +/*-------------------------------------------------------------------------*/ +int getHdbValueLength(hdbValue v){ + int length = 0; + switch(v.dataType){ + case HIPNONE: + break; + case HIPINT: + length = sizeof(int); + break; + case HIPFLOAT: + length = sizeof(double); + break; + case HIPINTAR: + case HIPINTVARAR: + length = v.arrayLength * sizeof(int); + break; + case HIPFLOATAR: + case HIPFLOATVARAR: + length = v.arrayLength * sizeof(double); + break; + case HIPTEXT: + length = strlen(v.v.text); + break; + case HIPOBJ: + length = sizeof(void *); + break; + } + return length; +} /*================= node functions ========================================*/ pHdb MakeHipadabaNode(char *name, int datatype, int length){ pHdb pNew = NULL; @@ -434,15 +534,19 @@ pHdb MakeHipadabaNode(char *name, int datatype, int length){ pNew->magic = HDBMAGICK; pNew->name = strdup(name); pNew->value.dataType = datatype; + pNew->properties = CreateStringDict(); + if(pNew->properties == NULL || pNew->name == NULL){ + return NULL; + } switch(datatype){ case HIPINTAR: case HIPINTVARAR: pNew->value.arrayLength = length; - pNew->value.v.intArray = malloc(length*sizeof(long)); + pNew->value.v.intArray = malloc(length*sizeof(int)); if(pNew->value.v.intArray == NULL){ return NULL; } - memset(pNew->value.v.intArray,0,length*sizeof(long)); + memset(pNew->value.v.intArray,0,length*sizeof(int)); break; case HIPFLOATAR: case HIPFLOATVARAR: @@ -454,16 +558,20 @@ pHdb MakeHipadabaNode(char *name, int datatype, int length){ memset(pNew->value.v.floatArray,0,length*sizeof(double)); break; case HIPTEXT: + pNew->value.arrayLength = length; pNew->value.v.text = strdup("UNKNOWN"); break; } return pNew; } /*-------------------------------------------------------------------------*/ -void AddHipadabaChild(pHdb parent, pHdb child){ +void AddHipadabaChild(pHdb parent, pHdb child, void *callData){ pHdb current = NULL, prev = NULL; - assert(parent != NULL && child != NULL); + assert(parent != NULL); + if(child == NULL){ + return; + } current = parent->child; child->mama = parent; @@ -481,16 +589,18 @@ void AddHipadabaChild(pHdb parent, pHdb child){ child->next = NULL; prev->next = child; } + InvokeCallbackChain(parent->treeChangeCallbacks, + parent,callData,parent->value); } /*--------------------------------------------------------------------------*/ -void DeleteHipadabaNode(pHdb node){ +void DeleteHipadabaNode(pHdb node, void *callData){ pHdb current = NULL, tmp = NULL; if(node == NULL){ return; } - RemoveHdbNodeFromParent(node); + RemoveHdbNodeFromParent(node, callData); DeleteNodeData(node); } @@ -637,6 +747,14 @@ void AppendHipadabaCallback(pHdb node, int type, pHdbCallback newCB){ current = node->readCallbacks; } break; + case HCBTREE: + if(node->treeChangeCallbacks == NULL){ + node->treeChangeCallbacks = newCB; + return; + } else { + current = node->treeChangeCallbacks; + } + break; default: assert(0); break; @@ -649,7 +767,6 @@ void AppendHipadabaCallback(pHdb node, int type, pHdbCallback newCB){ newCB->previous = current; } } -/*-------------------------------------------------------------------------*/ /*---------------------------------------------------------------------------*/ void PrependHipadabaCallback(pHdb node, int type, pHdbCallback newCB){ switch(type){ @@ -683,6 +800,16 @@ void PrependHipadabaCallback(pHdb node, int type, pHdbCallback newCB){ node->readCallbacks = newCB; } break; + case HCBTREE: + if(node->treeChangeCallbacks == NULL){ + node->treeChangeCallbacks = newCB; + return; + } else { + newCB->next = node->treeChangeCallbacks; + node->treeChangeCallbacks->previous = newCB; + node->treeChangeCallbacks = newCB; + } + break; default: assert(0); break; @@ -695,6 +822,7 @@ void RemoveHipadabaCallback(pHdb root, int id){ root->writeCallbacks = DeleteForID(root->writeCallbacks,id); root->updateCallbacks = DeleteForID(root->updateCallbacks,id); root->readCallbacks = DeleteForID(root->readCallbacks,id); + root->treeChangeCallbacks = DeleteForID(root->treeChangeCallbacks,id); current = root->child; while(current != NULL){ @@ -709,6 +837,7 @@ void InternalRemoveHipadabaCallback(pHdb root, int internalID){ root->writeCallbacks = DeleteForInternalID(root->writeCallbacks,internalID); root->updateCallbacks = DeleteForInternalID(root->updateCallbacks,internalID); root->readCallbacks = DeleteForInternalID(root->readCallbacks,internalID); + root->treeChangeCallbacks = DeleteForInternalID(root->treeChangeCallbacks,internalID); current = root->child; while(current != NULL){ @@ -741,24 +870,26 @@ int copyHdbValue(hdbValue *source, hdbValue *target){ break; case HIPINTAR: case HIPINTVARAR: - if(target->arrayLength != source->arrayLength){ + if(target->arrayLength != source->arrayLength || target->v.intArray == NULL){ if(target->v.intArray != NULL){ free(target->v.intArray); } - target->v.intArray = malloc(source->arrayLength * sizeof(long)); + target->v.intArray = malloc(source->arrayLength * sizeof(int)); if(target->v.intArray == NULL){ return 0; } - memset(target->v.intArray,0,source->arrayLength * sizeof(long)); + memset(target->v.intArray,0,source->arrayLength * sizeof(int)); target->arrayLength = source->arrayLength; } - for(i = 0; i < source->arrayLength; i++){ - target->v.intArray[i] = source->v.intArray[i]; + if(source->v.intArray != NULL){ + for(i = 0; i < source->arrayLength; i++){ + target->v.intArray[i] = source->v.intArray[i]; + } } break; case HIPFLOATAR: case HIPFLOATVARAR: - if(target->arrayLength != source->arrayLength){ + if(target->arrayLength != source->arrayLength || target->v.floatArray == NULL){ if(target->v.floatArray != NULL){ free(target->v.floatArray); } @@ -768,10 +899,15 @@ int copyHdbValue(hdbValue *source, hdbValue *target){ } memset(target->v.floatArray,0,source->arrayLength * sizeof(double)); target->arrayLength = source->arrayLength; + } + if(source->v.floatArray != NULL){ + for(i = 0; i < source->arrayLength; i++){ + target->v.floatArray[i] = source->v.floatArray[i]; + } } - for(i = 0; i < source->arrayLength; i++){ - target->v.floatArray[i] = source->v.floatArray[i]; - } + break; + case HIPOBJ: + target->v.obj = source->v.obj; break; default: /* @@ -812,4 +948,149 @@ int GetHipadabaPar(pHdb node, hdbValue *v, void *callData){ copyHdbValue(&node->value,v); return 1; } +/*----------------------------------------------------------------------------*/ +static int calcDataLength(pHdb node, int testLength){ + int length = 0; + length = getHdbValueLength(node->value); + if(node->value.dataType == HIPFLOATVARAR || + node->value.dataType == HIPINTVARAR || + node->value.dataType == HIPTEXT){ + length = testLength; + } + return length; +} +/*--------------------------------------------------------------------------*/ +int SetHdbPar(pHdb node, int dataType, void *data, int length, + void *callData){ + int status; + hdbValue v; + + if(node->value.dataType == HIPNONE){ + return 1; + } + + if(dataType != node->value.dataType){ + return HDBTYPEMISMATCH; + } + if(length != calcDataLength(node,length)){ + return HDBLENGTHMISMATCH; + } + + v = makeHdbData(dataType, length, data); + status = InvokeCallbackChain(node->writeCallbacks, node, callData, v); + if(status == 1) { + copyHdbValue(&v,&node->value); + } + return status; +} +/*--------------------------------------------------------------------------*/ +int UpdateHdbPar(pHdb node, int dataType, void *data, int length, + void *callData){ + int status; + hdbValue v; + + if(node->value.dataType == HIPNONE){ + return 1; + } + + if(dataType != node->value.dataType){ + return HDBTYPEMISMATCH; + } + if(length != calcDataLength(node,length)){ + return HDBLENGTHMISMATCH; + } + + v = makeHdbData(dataType,length,data); + + status = InvokeCallbackChain(node->updateCallbacks, node, callData, v); + if(status == 1) { + copyHdbValue(&v,&node->value); + } + return status; +} +/*-----------------------------------------------------------------------------*/ +int GetHdbPar(pHdb node, int dataType, void *data, int length, + void *callData){ + int status, toCopy; + hdbValue v; + + if(dataType != node->value.dataType){ + return HDBTYPEMISMATCH; + } + + if(length != calcDataLength(node,length)){ + return HDBLENGTHMISMATCH; + } + + status = InvokeCallbackChain(node->readCallbacks, node, callData, v); + if(status != 1 ){ + return status; + } + switch(dataType){ + case HIPNONE: + break; + case HIPINT: + memcpy(data,&node->value.v.intValue,sizeof(int)); + break; + case HIPFLOAT: + memcpy(data,&node->value.v.doubleValue,sizeof(double)); + break; + case HIPINTAR: + case HIPINTVARAR: + memcpy(data,node->value.v.intArray, + node->value.arrayLength*sizeof(int)); + break; + case HIPTEXT: + toCopy = strlen(node->value.v.text); + if(toCopy > length){ + toCopy = length; + } + memcpy(data,&node->value.v.text, toCopy); + break; + case HIPFLOATAR: + case HIPFLOATVARAR: + memcpy(data,node->value.v.floatArray, + node->value.arrayLength*sizeof(double)); + break; + case HIPOBJ: + memcpy(data,&node->value.v.obj,sizeof(void *)); + break; + default: + assert(0); + break; + } + return 1; +} +/*============================= Property Functions ==========================*/ + void SetHdbProperty(pHdb node, char *key, char *value){ + if(node != NULL && key != NULL && node->properties != NULL){ + if(StringDictExists(node->properties, key)){ + StringDictUpdate(node->properties,key,value); + } else { + StringDictAddPair(node->properties,key,value); + } + } + } +/*---------------------------------------------------------------------------*/ +int GetHdbProperty(pHdb node, char *key, char *value, int len){ + if(node != NULL && node->properties != NULL){ + return StringDictGet(node->properties,key,value,len); + } else { + return 0; + } +} +/*---------------------------------------------------------------------------*/ +void InitHdbPropertySearch(pHdb node){ + if(node != NULL && node->properties != NULL){ + StringDictKillScan(node->properties); + } +} +/*--------------------------------------------------------------------------*/ +const char *GetNextHdbProperty(pHdb node, char *value ,int len){ + if(node != NULL && node->properties != NULL) { + return StringDictGetNext(node->properties, value, len); + } else { + return NULL; + } +} diff --git a/hipadaba.h b/hipadaba.h index bc0f4e99..885d4280 100644 --- a/hipadaba.h +++ b/hipadaba.h @@ -20,9 +20,14 @@ * copyright: GPL * * Mark Koennecke, June 2006 + * + * Added treeChange callback, Mark Koennecke, November 2006 + * + * Added support for properties, Mark Koennecke, January 2007 */ #ifndef HIPADABA #define HIPADABA +#include /*------- datatypes */ #define HIPNONE -1 @@ -33,20 +38,26 @@ #define HIPFLOATAR 4 #define HIPINTVARAR 5 #define HIPFLOATVARAR 6 +#define HIPOBJ 7 /* -------- callback types */ #define HCBSET 0 #define HCBUPDATE 1 #define HCBREAD 2 +#define HCBTREE 3 +/*--------- error codes */ +#define HDBTYPEMISMATCH -7701 +#define HDBLENGTHMISMATCH -7702 /*===================== structure definitions ===================================*/ typedef struct __hdbValue { int dataType; int arrayLength; union __value { - long intValue; + int intValue; double doubleValue; char *text; - long *intArray; + int *intArray; double *floatArray; + void *obj; }v; }hdbValue; /*------------------------------------------------------------------------------*/ @@ -58,12 +69,15 @@ typedef struct __hipadaba { struct __hdbcallback *writeCallbacks; struct __hdbcallback *updateCallbacks; struct __hdbcallback *readCallbacks; + struct __hdbcallback *treeChangeCallbacks; char *name; hdbValue value; + int protected; + pStringDict properties; }Hdb, *pHdb; /*-------------------------------------------------------------------------------*/ typedef int (*hdbCallbackFunction)(void *userData, void *callData, - pHdb currentNode, hdbValue v ); + pHdb currentNode, hdbValue v); typedef void (*killUserData)(void *data); /*-------------------------------------------------------------------------------*/ typedef struct __hdbcallback { @@ -77,6 +91,15 @@ typedef struct __hdbcallback { }hdbCallback, *pHdbCallback; /*======================== Function protoypes: hdbData ========================*/ hdbValue makeHdbValue(int datatype, int length); +/** + * make a hdbValue and initailize it with the data in the void + * pointer. Do not initialise when data = NULL. + * @param dataType The datatype of the hdbValue + * @param The array length of the hdbValue + * @param data Initialisation data for hdbValue + * @return a suitably defined hdbValue + */ +hdbValue makeHdbData(int datatype, int length, void *data); /** * wrap an integer as an hdbValue * @param initValue the initial value of the int @@ -107,7 +130,7 @@ hdbValue MakeHdbText(char *initText); * data points to dynamically allocated memory. * @return: A properly initialized hdbValue structure */ -hdbValue MakeHdbIntArray(int length, long *data); +hdbValue MakeHdbIntArray(int length, int *data); /** * wrap a float array as an hdbValue * @param length The length of the int array @@ -147,6 +170,12 @@ int compareHdbValue(hdbValue v1, hdbValue v2); * @return 1 on success, 0 on when out of memory */ int cloneHdbValue(hdbValue *source, hdbValue *clone); +/** + * get the length of the hdbValue in bytes. + * @param v The hdbValue to calculate the length for + * @return the number of data bytes + */ +int getHdbValueLength(hdbValue v); /*========================== function protoypes: Nodes =======================*/ /** * make a new hipadaba node @@ -156,16 +185,18 @@ int cloneHdbValue(hdbValue *source, hdbValue *clone); */ pHdb MakeHipadabaNode(char *name, int datatype, int length); /** - * add a child to a node + * add a child to a node at the end of the child list. * @param parent The node to which to add the child * @param child The node to add + * @param callData User data for the tree chnage callback. Can be NULL. */ -void AddHipadabaChild(pHdb parent, pHdb child); +void AddHipadabaChild(pHdb parent, pHdb child, void *callData); /** * delete a hipadaba node and all its children * @parma node The node to delete + * @param callData User data for the tree change callback */ -void DeleteHipadabaNode(pHdb node); +void DeleteHipadabaNode(pHdb node, void *callData); /* * checks if a Hdb node is valid * @param node The node to check @@ -189,8 +220,9 @@ char *GetHipadabaPath(pHdb node); /** * removes a node from the parents child list. * @node the node to remove + * @param callData User data for the tree change callback */ -void RemoveHdbNodeFromParent(pHdb node); +void RemoveHdbNodeFromParent(pHdb node, void *callData); /** * delete a callback chain * @param root The callback chain to delete @@ -250,8 +282,8 @@ void InternalRemoveHipadabaCallback(pHdb root, int internalID); */ int SetHipadabaPar(pHdb node, hdbValue v, void *callData); /** - * Update a hipadaba parameter. This is an internal update of a parameter, during - * driving etc. + * Update a hipadaba parameter. This is an internal update of a parameter, + * during driving etc. * @param node The node for which to update the parameter * @param v The new value for the node * @param callData Additonal context data to be passed to the callback functions @@ -266,5 +298,70 @@ int UpdateHipadabaPar(pHdb node, hdbValue v, void *callData); * @return 0 on failure, 1 on success */ int GetHipadabaPar(pHdb node, hdbValue *v, void *callData); - +/** + * Set a hipadaba parameter. This is an external set for a parameter. It may cause + * motors to start driving etc. + * @param node The node for which to set the parameter + * param dataType The datatype the value ought to have + * @param data A pointer to the data to set. + * @param length The length of data + * @param callData Additonal context data to be passed to the callback functions + * @return 0 on failure, a negative error code on failure + */ +int SetHdbPar(pHdb node, int dataType, void *data, int length, + void *callData); +/** + * Updates a hipadaba parameter. This does not cause an active parameter to + * start driving but invokes all notifications which may be registered on + * this parameter. + * @param node The node for which to set the parameter + * param dataType The datatype the value ought to have + * @param data A pointer to the data to set. + * @param length The length of data + * @param callData Additonal context data to be passed to the callback functions + * @return 0 on failure, a negative error code on failure + */ +int UpdateHdbPar(pHdb node, int dataType, void *data, int length, + void *callData); +/** + * Read a hipadaba parameter + * @param node The node for which to read the parameter + * @param dataType The expected type of the data + * @param data A pointer to which data will be copied + * @param length The length of data. + * @param callData Additonal context data to be passed to the callback functions + * @return 0 on failure, a negative error code on failures. + */ +int GetHdbPar(pHdb node, int dataType, void *data, int length, + void *callData); +/*================================ Property Interface ==============================================*/ +/** + * set a property + * @param node The node to set the property for + * @param key The key for the property + * @param value The value of the property + */ + void SetHdbProperty(pHdb node, char *key, char *value); + /** + * get the value of a property + * @param node The node to get the property from + * @param key The properties key + * @param value The area to which to copy the property + * @param len The length of value + * @return 0 on failure, 1 on success + */ + int GetHdbProperty(pHdb node, char *key, char *value, int len); + /** + * initialize a property scan on this node + * @param node The node for which to scan properties + */ +void InitHdbPropertySearch(pHdb node); +/** + * get the next property in a search + * @param node The node for which to search properties + * @param value An area where to copy the value of the property + * @param len The length of value + * @return The key of the property or NULL when the property list is exhausted + */ +const char *GetNextHdbProperty(pHdb node, char *value ,int len); #endif diff --git a/histmem.c b/histmem.c index 8650584b..4021c6df 100644 --- a/histmem.c +++ b/histmem.c @@ -68,6 +68,10 @@ /* #define LOADDEBUG 1 */ +/* + * from histregress.c + */ +extern pHistDriver CreateRegressHM(pStringDict pOpt); /*------------------------------------------------------------------------*/ static int HistHalt(void *pData) { @@ -171,7 +175,9 @@ iRet = self->pDriv->Start(self->pDriv, pCon); if(iRet == OKOK) { - updateHMData(self->pDriv->data); + /* send a COUNTSTART event */ + InvokeCallBack(self->pCall,COUNTSTART,pCon); + updateHMData(self->pDriv->data); return iRet; } else @@ -450,8 +456,12 @@ } else if(strcmp(driver,"mcstas") == 0) { - pNew->pDriv = NewMcStasHM(pOption); - } + pNew->pDriv = NewMcStasHM(pOption); + } + else if(strcmp(driver,"regress") == 0) + { + pNew->pDriv = CreateRegressHM(pOption); + } else { site = getSite(); @@ -721,8 +731,6 @@ void HistDirty(pHistMem self) { assert(self); - /* send a COUNTSTART event */ - InvokeCallBack(self->pCall,COUNTSTART,pCon); /* start */ return StartDevice(GetExecutor(),"HistogramMemory", self->pDes, self, @@ -744,9 +752,6 @@ void HistDirty(pHistMem self) return 0; } - /* send a COUNTSTART event */ - InvokeCallBack(self->pCall,COUNTSTART,pCon); - /* wait till end */ iRet = Wait4Success(GetExecutor()); if(iRet == DEVINT) @@ -1233,13 +1238,19 @@ static int checkHMEnd(pHistMem self, char *text){ } else if(strcmp(argv[1],"init") == 0) { + if(GetStatus() != eEager) + { + SCWrite(pCon,"ERROR: cannot initialize HM while running", + eError); + return 0; + } if(SCMatchRights(pCon,usMugger)) { iRet = HistConfigure(self,pCon,pSics); if(iRet) { self->iInit = 1; - SCSendOK(pCon); + SCSendOK(pCon); } else { @@ -1357,6 +1368,31 @@ static int checkHMEnd(pHistMem self, char *text){ } return iRet; } + else if(strcmp(argv[1],"initfile") == 0) /* initialize from a file */ + { + /* check user rights */ + if(!SCMatchRights(pCon,self->iAccess)) + { + return 0; + } + + /* enough arguments */ + if(argc < 3) + { + sprintf(pBueffel,"ERROR: insufficient number of arguments to %s %s", + argv[0], argv[1]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + iRet = loadHMData(self->pDriv->data,pCon,argv[2]); + self->pDriv->SetHistogram(self->pDriv,pCon,0,0,GetHistLength(self), + self->pDriv->data->localBuffer); + if(iRet) + { + SCSendOK(pCon); + } + return iRet; + } else if(strcmp(argv[1],"get") == 0) /* get a histogram */ { /* check parameters, first required: no of Hist */ @@ -1383,11 +1419,16 @@ static int checkHMEnd(pHistMem self, char *text){ iStart = 0; } - if(argc > 4){ - iEnd = checkHMEnd(self,argv[4]); - } else { - iEnd = checkHMEnd(self,NULL); - } + if(argc > 4){ + iEnd = checkHMEnd(self,argv[4]); + } else { + iEnd = checkHMEnd(self,NULL); + } + + if(iNum != 0 && argc > 4) + { + iEnd = atoi(argv[4]); + } /* allocate data storage and get it */ lData = (HistInt *)malloc(iEnd*sizeof(HistInt)); @@ -1397,8 +1438,14 @@ static int checkHMEnd(pHistMem self, char *text){ return 0; } memset(lData,0,iEnd*sizeof(HistInt)); - iRet = GetHistogram(self,pCon,iNum,iStart,iEnd, - lData,iEnd*sizeof(long)); + if(iNum == 0) + { + iRet = GetHistogram(self,pCon,iNum,iStart,iEnd, + lData,iEnd*sizeof(long)); + } else { + iRet = GetHistogramDirect(self,pCon,iNum,iStart, iEnd, + lData, iEnd*sizeof(long)); + } if(!iRet) { sprintf(pBueffel,"ERROR: cannot retrieve histogram %d",iNum); @@ -1565,10 +1612,10 @@ static int checkHMEnd(pHistMem self, char *text){ else if(strcmp(argv[1],"timebin") == 0) { Tcl_DStringInit(&tResult); - Tcl_DStringAppend(&tResult,"histogram.timebins = ",-1); + Tcl_DStringAppend(&tResult,"histogram.timebins =",-1); for(i = 0; i < self->pDriv->data->nTimeChan; i++) { - sprintf(pBueffel," %8.2f", self->pDriv->data->timeBinning[i]); + sprintf(pBueffel,"%.2f ", self->pDriv->data->timeBinning[i]); Tcl_DStringAppend(&tResult,pBueffel,-1); } /* Write it */ @@ -1586,8 +1633,8 @@ static int checkHMEnd(pHistMem self, char *text){ return 0; } if(GetStatus() == eCounting) - { - SCWrite(pCon,"ERROR: cannot modify timebinning while counting", + { + SCWrite(pCon,"ERROR: cannot modify timebinning while counting", eError); return 0; } diff --git a/histogram.tex b/histogram.tex index e5911e74..ce8e30ab 100644 --- a/histogram.tex +++ b/histogram.tex @@ -163,6 +163,9 @@ $\langle$HistType {\footnotesize ?}$\rangle\equiv$ \mbox{}\verb@ SConnection *pCon);@\\ \mbox{}\verb@ float (*GetTime)(pHistDriver self,@\\ \mbox{}\verb@ SConnection *pCon);@\\ +\mbox{}\verb@ HistInt *(*SubSample)(pHistDriver self, @\\ +\mbox{}\verb@ SConnection *pCon,int bank,@\\ +\mbox{}\verb@ char *command); @\\ \mbox{}\verb@ int (*Preset)(pHistDriver self,@\\ \mbox{}\verb@ SConnection *pCon,@\\ \mbox{}\verb@ HistInt iVal);@\\ diff --git a/histogram.w b/histogram.w index f529081f..d59edabf 100644 --- a/histogram.w +++ b/histogram.w @@ -130,6 +130,9 @@ definition: SConnection *pCon); float (*GetTime)(pHistDriver self, SConnection *pCon); + HistInt *(*SubSample)(pHistDriver self, + SConnection *pCon,int bank, + char *command); int (*Preset)(pHistDriver self, SConnection *pCon, HistInt iVal); diff --git a/histregress.c b/histregress.c new file mode 100644 index 00000000..8003e27f --- /dev/null +++ b/histregress.c @@ -0,0 +1,273 @@ +/*---------------------------------------------------------------------------- + + H I S T S I M + + A simulated histogram memory for regression tests. + + All the counting error stuff is redirected to a regression counter; see + documentation there. This just adds data handling. + + copyright: see file COPYRIGHT + + Mark Koennecke, October 2006 + ----------------------------------------------------------------------------*/ +#include +#include +#include +#include +#include "fortify.h" +#include "sics.h" +#include "countdriv.h" +#include "counter.h" +#include "stringdict.h" +#include "HistMem.h" +#include "HistDriv.i" +#include "histsim.h" + +static int iSet = 0; +static HistInt iSetVal = 0; +static HistMode eHistMode; +/*--------------------------------------------------------------------------*/ +static int RegressConfig(pHistDriver self, SConnection *pCon, + pStringDict pOption, SicsInterp *pSics) +{ + int i, iLength = 1, status; + char pData[132]; + float fFail; + pCounterDriver count; + + count = (pCounterDriver)self->pPriv; + + if(eHistMode == eHTOF) + { + for(i = 0; i < self->data->rank; i++) + { + iLength *= self->data->iDim[i]; + } + iLength *= self->data->nTimeChan; + } + + /* + deal with error settings + */ + status = StringDictGet(pOption,"errortype",pData,131); + if(status) + { + + fFail = atof(pData); + count->Set(count,"errortype",1,fFail); + } + status = StringDictGet(pOption,"recover",pData,131); + if(status) + { + + fFail = atof(pData); + count->Set(count,"recover",1,fFail); + } + status = StringDictGet(pOption,"finish",pData,131); + if(status) + { + + fFail = atof(pData); + count->Set(count,"finish",1,fFail); + } + + /* + configured test value + */ + status = StringDictGet(pOption,"testval",pData,131); + if(status) + { + iSet = 1; + iSetVal = atoi(pData); + } + + return 1; + } +/*-------------------------------------------------------------------------*/ + static int RegressStart(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + pDriv->fPreset = self->fCountPreset; + pDriv->eMode = self->eCount; + return pDriv->Start(pDriv); + } +/*-------------------------------------------------------------------------*/ + static int RegressPause(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + pDriv->fPreset = self->fCountPreset; + pDriv->eMode = self->eCount; + return pDriv->Pause(pDriv); + } +/*------------------------------------------------------------------------*/ + static int RegressContinue(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + pDriv->fPreset = self->fCountPreset; + pDriv->eMode = self->eCount; + return pDriv->Continue(pDriv); + } +/*-------------------------------------------------------------------------*/ + static int RegressHalt(pHistDriver self) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->Halt(pDriv); + } +/*-------------------------------------------------------------------------*/ + static int RegressGetCountStatus(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + float fControl; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->GetStatus(pDriv,&fControl); + } +/*-------------------------------------------------------------------------*/ + static int RegressGetError(pHistDriver self, int *iCode, char *pError, int iLen) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->GetError(pDriv, iCode,pError,iLen); + } +/*-------------------------------------------------------------------------*/ + static int RegressTryAndFixIt(pHistDriver self, int iCode) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->TryAndFixIt(pDriv, iCode); + } +/*--------------------------------------------------------------------------*/ + static int RegressGetData(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + + return pDriv->ReadValues(pDriv); + } +/*--------------------------------------------------------------------------*/ + static int RegressGetHistogram(pHistDriver self, SConnection *pCon, + int i, int iStart, int iEnd, HistInt *lData) + { + int ii; + + if(i < 0) + { + SCWrite(pCon,"ERROR: histogram out of range",eError); + return 0; + } + + if(iSet == 1) + { + for(ii = iStart; ii < iEnd; ii++) + { + lData[ii-iStart] = iSetVal; + } + } + else + { + for(ii = iStart; ii < iEnd; ii++) + { + lData[ii-iStart] = random(); + } + } + return 1; + } +/*------------------------------------------------------------------------*/ + static int RegressSetHistogram(pHistDriver self, SConnection *pCon, + int i, int iStart, int iEnd, HistInt *lData) + { + iSet = 1; + iSetVal = lData[0]; + return 1; + } + +/*-------------------------------------------------------------------------*/ + static int RegressPreset(pHistDriver self, SConnection *pCon, HistInt iVal) + { + iSet = 1; + iSetVal = iVal; + return 1; + } +/*------------------------------------------------------------------------*/ + static int RegressFreePrivate(pHistDriver self) + { + pCounterDriver pDriv; + + pDriv = (pCounterDriver)self->pPriv; + DeleteCounterDriver(pDriv); + return 1; + } +/*------------------------------------------------------------------------*/ + static long RegressGetMonitor(pHistDriver self, int i, SConnection *pCon) + { + pCounterDriver pDriv; + long lVal; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->lCounts[i]; + + } +/*------------------------------------------------------------------------*/ + static float RegressGetTime(pHistDriver self, SConnection *pCon) + { + pCounterDriver pDriv; + long lVal; + + pDriv = (pCounterDriver)self->pPriv; + return pDriv->fTime; + + } +/*-------------------------------------------------------------------------*/ + pHistDriver CreateRegressHM(pStringDict pOpt) + { + pHistDriver pNew = NULL; + + /* create the general driver */ + pNew = CreateHistDriver(pOpt); + if(!pNew) + { + return NULL; + } + + /* put a Regresscounter in */ + pNew->pPriv = (void *)NewRegressCounter("HistoRegress"); + if(!pNew->pPriv) + { + DeleteHistDriver(pNew); + return NULL; + } + + /* configure all those functions */ + pNew->Configure = RegressConfig; + pNew->Start = RegressStart; + pNew->Halt = RegressHalt; + pNew->GetCountStatus = RegressGetCountStatus; + pNew->GetError = RegressGetError; + pNew->TryAndFixIt = RegressTryAndFixIt; + pNew->GetData = RegressGetData; + pNew->GetHistogram = RegressGetHistogram; + pNew->SetHistogram = RegressSetHistogram; + pNew->GetMonitor = RegressGetMonitor; + pNew->GetTime = RegressGetTime; + pNew->Preset = RegressPreset; + pNew->FreePrivate = RegressFreePrivate; + pNew->Pause = RegressPause; + pNew->Continue = RegressContinue; + StringDictAddPair(pOpt,"errortype","0"); + StringDictAddPair(pOpt,"recover","1"); + StringDictAddPair(pOpt,"testval","0"); + + return pNew; + } diff --git a/histsim.c b/histsim.c index 0d085a1e..5ddc574f 100644 --- a/histsim.c +++ b/histsim.c @@ -183,6 +183,13 @@ lData[ii-iStart] = iSetVal; } } + else if(iSet == 2) + { + for(ii = iStart; ii < iEnd; ii++) + { + lData[ii-iStart] = self->data->localBuffer[ii]; + } + } else { for(ii = iStart; ii < iEnd; ii++) @@ -196,7 +203,7 @@ static int SimSetHistogram(pHistDriver self, SConnection *pCon, int i, int iStart, int iEnd, HistInt *lData) { - iSet = 1; + iSet = 2; iSetVal = lData[0]; return 1; } diff --git a/hkl.c b/hkl.c index 8d50deab..d40176d9 100644 --- a/hkl.c +++ b/hkl.c @@ -61,7 +61,6 @@ fprintf(fd,"%s hm %d\n",name, self->iHM); fprintf(fd,"%s scantolerance %f\n", name,self->scanTolerance); fprintf(fd,"%s nb %d\n", name, self->iNOR); - fprintf(fd,"%s phiom %d\n", name, self->iOMPHI); return 1; } @@ -689,7 +688,7 @@ int hklInRange(void *data, float fSet[4], int mask[4]) fSet[0] = dTheta; /* for omega check against the limits +- SCANBORDER in order to allow for - a omega scan + a omega scan. */ MotorGetPar(self->pOmega,"softlowerlim",&fLimit); if((float)fSet[1] < fLimit + self->scanTolerance){ @@ -721,7 +720,7 @@ static int calculateBisecting(MATRIX z1, pHKL self, SConnection *pCon, float fSet[4], double myPsi, int iRetry) { double stt, om, chi, phi, psi, ompsi, chipsi, phipsi; - int i, test; + int i, test, mask[4]; /* just the plain angle calculation @@ -731,16 +730,31 @@ static int calculateBisecting(MATRIX z1, pHKL self, SConnection *pCon, return 0; } + fSet[0] = stt; + fSet[1] = om; + fSet[2] = chi; + fSet[3] = phi; if(iRetry == 1) { - rotatePsi(om,chi,phi,psi,&ompsi,&chipsi,&phipsi); + rotatePsi(om,chi,phi,myPsi,&ompsi,&chipsi,&phipsi); fSet[1] = ompsi; fSet[2] = circlify(chipsi); fSet[3] = circlify(phipsi); return 1; } else { - return findAllowedBisecting(self->fLambda, z1, fSet, hklInRange,self); + if(hklInRange(self,fSet, mask) == 1){ + return 1; + } else { + if(tryOmegaTweak(self,z1, &stt, &om, &chi, &phi) == 1){ + fSet[0] = stt; + fSet[1] = om; + fSet[2] = chi; + fSet[3] = phi; + return 1; + } else { + return findAllowedBisecting(self->fLambda, z1, fSet, hklInRange,self); + } + } } - } /*-----------------------------------------------------------------------*/ static int calculateNormalBeam(MATRIX z1, pHKL self, SConnection *pCon, @@ -780,7 +794,7 @@ static int calculateNormalBeam(MATRIX z1, pHKL self, SConnection *pCon, status = z1mToNormalBeam(self->fLambda, z3, &gamma, &omnb, &nu); - omnb += 180.; + /* omnb += 180.; */ mat_free(z3); if(status != 1) { @@ -789,7 +803,11 @@ static int calculateNormalBeam(MATRIX z1, pHKL self, SConnection *pCon, if(checkNormalBeam(omnb, &gamma, nu,fSet,pCon,self)){ return 1; } else { - return 0; + if(checkNormalBeam(omnb + 360., &gamma, nu, fSet,pCon,self)){ + return 1; + } else { + return 0; + } } } /*---------------------------------------------------------------------*/ @@ -850,7 +868,7 @@ static int calculateNormalBeamOmega(MATRIX z1, pHKL self, { if(checkNormalBeam(om, &gamma, nu,fSet,pCon,self)) { - return 1; + return 1; } } return 0; @@ -903,31 +921,7 @@ static int calculateNormalBeamOmega(MATRIX z1, pHKL self, if(self->iNOR == 0) { status = calculateBisecting(z1,self,pCon,fSet, myPsi, iRetry); - /* - * Betrand mode: wrap phi rotation into omega - */ - if(self->iOMPHI > 0) { - if(ABS(fSet[2] - .0) < .1 || ABS(fSet[2] - 180.) < .1){ - fSet[1] -= fSet[3]; - /* - fSet[1] = 360. - fSet[3]; - */ - fSet[3] = .0; - if(fSet[1] < 0.){ - fSet[1] += 360.; - } - if(fSet[1] > 360.0){ - fSet[1] -= 360.; - } - } else { - snprintf(pBueffel,511, - "ERROR: for omphi mode chi must be 0 or 180, is %f", - fSet[2]); - SCWrite(pCon,pBueffel,eError); - return 0; - } - } - } + } else if(self->iNOR == 1) { status = calculateNormalBeam(z1,self,pCon,fSet, myPsi, iRetry); @@ -1414,8 +1408,8 @@ ente: if(strcmp(argv[1],"list") == 0 ) { sprintf(pBueffel, - "lambda = %f Normal Beam = %d PHIOM = %d Quadrant = %d HM = %d", - self->fLambda, self->iNOR, self->iOMPHI, + "lambda = %f Normal Beam = %d Quadrant = %d HM = %d", + self->fLambda, self->iNOR, self->iQuad,self->iHM); SCWrite(pCon,pBueffel,eValue); sprintf(pBueffel,"UB = { %f %f %f", @@ -1654,29 +1648,6 @@ ente: SCSendOK(pCon); return 1; } -/*------------- phi omega mode (to be removed) */ - else if(strcmp(argv[1],"phiom") == 0) - { - if(argc < 3) - { - snprintf(pBueffel,511,"%s.phiom = %d",argv[0],self->iOMPHI); - SCWrite(pCon,pBueffel,eValue); - return 1; - } - if(!SCMatchRights(pCon,usUser)) - { - return 0; - } - if(!isNumeric(argv[2])) - { - sprintf(pBueffel,"ERROR: %s was not recognized as a number", argv[2]); - SCWrite(pCon,pBueffel,eError); - return 0; - } - self->iOMPHI = atoi(argv[2]); - SCSendOK(pCon); - return 1; - } /*------------- quadrant */ else if(strcmp(argv[1],"quadrant") == 0) { diff --git a/hkl.i b/hkl.i index 9665a544..14cbaed0 100644 --- a/hkl.i +++ b/hkl.i @@ -15,7 +15,6 @@ int iManual; double fLastHKL[5]; int iNOR; - int iOMPHI; int iQuad; int iHM; pMotor pTheta; diff --git a/hkl.tex b/hkl.tex index e62e69e1..bed73427 100644 --- a/hkl.tex +++ b/hkl.tex @@ -26,7 +26,6 @@ $\langle$hkldat {\footnotesize ?}$\rangle\equiv$ \mbox{}\verb@ int iManual;@\\ \mbox{}\verb@ double fLastHKL[5];@\\ \mbox{}\verb@ int iNOR;@\\ -\mbox{}\verb@ int iOMPHI;@\\ \mbox{}\verb@ int iQuad;@\\ \mbox{}\verb@ int iHM;@\\ \mbox{}\verb@ pMotor pTheta;@\\ diff --git a/hkl.w b/hkl.w index e22bb92c..a1b510d3 100644 --- a/hkl.w +++ b/hkl.w @@ -21,7 +21,6 @@ The object uses the following object data structure: int iManual; double fLastHKL[5]; int iNOR; - int iOMPHI; int iQuad; int iHM; pMotor pTheta; diff --git a/hmcontrol.c b/hmcontrol.c index d2d195b6..758ed638 100644 --- a/hmcontrol.c +++ b/hmcontrol.c @@ -310,7 +310,7 @@ int HMControlAction(SConnection *pCon, SicsInterp *pSics, assert(self); if(argc < 4) { - sprintf(pBueffel,"ERROR: Usage %s start preset mode", argv[0]); + snprintf(pBueffel,131,"ERROR: Usage %s start preset mode", argv[0]); SCWrite(pCon,pBueffel,eError); return 0; } diff --git a/hmdata.c b/hmdata.c index b9201f66..d81a673e 100644 --- a/hmdata.c +++ b/hmdata.c @@ -5,11 +5,15 @@ copyright: see file COPYRIGHT Mark Koennecke, January 2003 + + Added loading HM data from file, Mark Koennecke, November 2006 -------------------------------------------------------------------------*/ #include +#include #include #include #include +#include "splitter.h" #include "fortify.h" #include "hmdata.h" #include "HistMem.h" @@ -46,7 +50,7 @@ void clearHMData(pHMdata self){ size *= self->iDim[i]; } if(self->tofMode){ - size *= self->nTimeChan; + size *= getNoOfTimebins(self); } memset(self->localBuffer,0,size*sizeof(HistInt)); } @@ -60,7 +64,7 @@ static int resizeBuffer(pHMdata self){ size *= self->iDim[i]; } if(self->tofMode){ - size *= self->nTimeChan; + size *= getNoOfTimebins(self); } if(self->localBuffer != NULL){ free(self->localBuffer); @@ -80,6 +84,7 @@ int configureHMdata(pHMdata self, pStringDict pOpt, int status, i; float fVal; char pValue[80]; + pHistMem master = NULL; if(self->nTimeChan > 2) { self->tofMode = 1; @@ -111,6 +116,18 @@ int configureHMdata(pHMdata self, pStringDict pOpt, self->updateIntervall = (int)rint(fVal); } + status = StringDictGet(pOpt,"timeslave",pValue, 79); + if(status == 1) { + master = (pHistMem)FindCommandData(pServ->pSics,pValue,"HistMem"); + if(master == NULL){ + SCWrite(pCon,"ERROR: timeslave requested, but master HM not found", + eError); + } else { + self->timeslave = master->pDriv->data; + self->tofMode = 1; + } + } + /* invalidate buffer */ @@ -138,7 +155,7 @@ int configureHMdata(pHMdata self, pStringDict pOpt, int genTimeBinning(pHMdata self, float start, float step, int noSteps){ int i; - if(noSteps >= MAXCHAN){ + if(noSteps >= MAXCHAN || self->timeslave != NULL){ return 0; } for(i = 0; i < noSteps; i++){ @@ -150,6 +167,10 @@ int genTimeBinning(pHMdata self, float start, float step, int noSteps){ } /*----------------------------------------------------------------------*/ int setTimeBin(pHMdata self, int index, float value){ + if(self->timeslave != NULL){ + return 0; + } + if(index >= 0 && index < MAXCHAN){ self->timeBinning[index] = value; } else { @@ -157,7 +178,7 @@ int setTimeBin(pHMdata self, int index, float value){ } self->tofMode = 1; if(index > self->nTimeChan){ - self->nTimeChan = index; + self->nTimeChan = index+1; return resizeBuffer(self); } return 1; @@ -168,17 +189,27 @@ int isInTOFMode(pHMdata self){ } /*---------------------------------------------------------------------*/ int getNoOfTimebins(pHMdata self){ - return self->nTimeChan; + if(self->timeslave != NULL){ + return getNoOfTimebins(self->timeslave); + } else { + return self->nTimeChan; + } } /*---------------------------------------------------------------------*/ float *getTimeBinning(pHMdata self){ - return self->timeBinning; + if(self->timeslave != NULL){ + return getTimeBinning(self->timeslave); + } else { + return self->timeBinning; + } } /*-------------------------------------------------------------------*/ void clearTimeBinning(pHMdata self){ - self->nTimeChan = 1; - self->tofMode = 0; - resizeBuffer(self); + if(self->timeslave == NULL){ + self->nTimeChan = 1; + self->tofMode = 0; + resizeBuffer(self); + } } /*--------------------------------------------------------------------*/ void getHMDataDim(pHMdata self, int iDim[MAXDIM], int *rank){ @@ -193,7 +224,7 @@ long getHMDataLength(pHMdata self){ length *= self->iDim[i]; } if(self->tofMode){ - length *= self->nTimeChan; + length *= getNoOfTimebins(self); } return length; } @@ -227,6 +258,10 @@ static int updateHMbuffer(pHistMem hist, int bank, SConnection *pCon){ assert(self); + if(self->timeslave != NULL){ + resizeBuffer(self); + } + for(i = 0; i < 3; i++){ status = hist->pDriv->GetHistogram(hist->pDriv,pCon, bank,0,getHMDataLength(self), @@ -292,7 +327,7 @@ HistInt *getHMDataBufferPointer(pHistMem hist,SConnection *pCon){ assert(self); - if(self->localBuffer == NULL){ + if(self->localBuffer == NULL || self->timeslave != NULL){ resizeBuffer(self); } /* @@ -327,7 +362,7 @@ long sumHMDataRectangle(pHistMem hist, SConnection *pCon, int iStart[MAXDIM], int iEnd[MAXDIM]) { HistInt *iData; pHMdata self = hist->pDriv->data; - int i, iHistLength, status, iIndex; + int i, iHistLength, status, iIndex, myrank; char pBueffel[256]; unsigned long lSum, lRowSum; @@ -336,7 +371,12 @@ long sumHMDataRectangle(pHistMem hist, SConnection *pCon, /* error checking */ - for(i = 0; i < self->rank; i++){ + myrank = self->rank; + if(isInTOFMode(self)){ + self->iDim[self->rank] = getNoOfTimebins(self); + myrank++; + } + for(i = 0; i < myrank; i++){ if( (iStart[i] < 0) || (iStart[i] > self->iDim[i]) ) { sprintf(pBueffel,"ERROR: %d is out of data dimension range", iStart[i]); @@ -367,25 +407,35 @@ long sumHMDataRectangle(pHistMem hist, SConnection *pCon, iHistLength = getHMDataLength(self); /* actually sum */ - switch(self->rank) + switch(myrank) { case 1: lSum = SumRow(self->localBuffer, iHistLength, iStart[0], iEnd[0]); break; case 2: - lSum = 0; - for(i = iStart[0]; i < iEnd[0]; i++){ - iIndex = i*self->iDim[1]; - lRowSum = SumRow(self->localBuffer,iHistLength, + if(isInTOFMode(self)){ + lSum = 0; + for(i = iStart[0]; i < iEnd[0]; i++){ + iIndex = i*self->iDim[1]; + lRowSum = SumRow(self->localBuffer,iHistLength, iIndex+iStart[1], iIndex+iEnd[1]); - lSum += lRowSum; + lSum += lRowSum; + } + } else { + lSum = 0; + for(i = iStart[1]; i < iEnd[1]; i++){ + iIndex = i*self->iDim[0]; + lRowSum = SumRow(self->localBuffer,iHistLength, + iIndex+iStart[0], iIndex+iEnd[0]); + lSum += lRowSum; + } } break; default: sprintf(pBueffel, "ERROR: summing in %d dimensions not yet implemented", - self->rank); + myrank); SCWrite(pCon,pBueffel,eError); return -1; break; @@ -395,3 +445,43 @@ long sumHMDataRectangle(pHistMem hist, SConnection *pCon, } return lSum; } +/*--------------------------------------------------------------------------*/ +int loadHMData(pHMdata self, SConnection *pCon, char *filename){ + FILE *fd = NULL; + char buffer[1024], pNumber[80], *pPtr; + long i = 0, length; + HistInt *data = NULL; + + fd = fopen(filename,"r"); + if(fd == NULL){ + snprintf(buffer,1023,"ERROR: failed to open file %s", filename); + SCWrite(pCon,buffer,eError); + return 0; + } + length = getHMDataLength(self); + if(self->localBuffer == NULL || self->timeslave != NULL){ + resizeBuffer(self); + } + data = self->localBuffer; + if(data == NULL){ + SCWrite(pCon,"ERROR: failed to allocate HM", eError); + fclose(fd); + return 0; + } + while(i < length && fgets(buffer,1024,fd) != NULL){ + pPtr = buffer; + while(pPtr != NULL){ + pPtr = sicsNextNumber(pPtr,pNumber); + if(pPtr != NULL){ + data[i] = atoi(pNumber); + i++; + } + } + } + if(i < length-1){ + SCWrite(pCon,"WARNING: not enough data in file to fill HM",eWarning); + } + fclose(fd); + return 1; +} + diff --git a/hmdata.h b/hmdata.h index c7f9f097..5a5d8ca5 100644 --- a/hmdata.h +++ b/hmdata.h @@ -16,7 +16,7 @@ #define MAXDIM 3 - typedef struct { + typedef struct __hmdata{ int rank; int iDim[MAXDIM]; int nTimeChan; @@ -26,6 +26,7 @@ int updateIntervall; int updateFlag; HistInt *localBuffer; + struct __hmdata *timeslave; } HMdata, *pHMdata; @@ -56,6 +57,7 @@ long sumHMDataRectangle(pHistMem self, SConnection *pCon, int start[MAXDIM], int end[MAXDIM]); + int loadHMData(pHMdata self, SConnection *pCon, char *filename); #endif diff --git a/hmdata.w b/hmdata.w index bdce46fe..e5cc58d4 100644 --- a/hmdata.w +++ b/hmdata.w @@ -11,7 +11,7 @@ display clients gone mad. This task is also handled through this class. In order to do this, the following data structure is needed: @d hmdatadat @{ - typedef struct { + typedef struct __hmdata{ int rank; int iDim[MAXDIM]; int nTimeChan; @@ -21,6 +21,7 @@ In order to do this, the following data structure is needed: int updateIntervall; int updateFlag; HistInt *localBuffer; + struct __hmdata *timeslave; } HMdata, *pHMdata; @} @@ -52,6 +53,7 @@ The following functions work on this data structure: long sumHMDataRectangle(pHistMem self, SConnection *pCon, int start[MAXDIM], int end[MAXDIM]); + int loadHMData(pHMdata self, SConnection *pCon, char *filename); @} \begin{description} @@ -83,6 +85,8 @@ the histogram memory and not from the buffer the next time round. pointer of HMdata. Use with extra care! \item[sumHMDataRectangle] sums a rectangular box delimted by start and end from the histogram memory. +\item[loadHMData] loads histogram memory data from a file. This is for + debugging purposes. The file must contain enough numbers to fill the HM. \end{description} diff --git a/initializer.c b/initializer.c index 397e0d4d..813b884b 100644 --- a/initializer.c +++ b/initializer.c @@ -12,8 +12,9 @@ Markus Zolliker, March 2005 typedef struct Item { struct Item *next; - const char *type; - const char *name; + char *type; + char *name; + char *desc; Initializer maker; int startupOnly; } Item; @@ -21,15 +22,17 @@ typedef struct Item { static Item *list = NULL; static int startup = 1; -void MakeInitializer(const char *type, const char *name, Initializer maker, int startupOnly) { +void MakeInitializer(const char *type, const char *name, Initializer maker, + int startupOnly, const char *desc) { Item *item; item = calloc(1, sizeof *item); assert(item); item->maker = maker; item->next = list; - item->type = type; - item->name = name; + item->type = strdup(type); + item->name = strdup(name); + item->desc = strdup(desc); item->startupOnly = startupOnly; list = item; } @@ -84,6 +87,40 @@ static int MakeObject(SConnection *con, SicsInterp *sics, } } +static int DriverList(SConnection *con, SicsInterp *sics, + void *data, int argc, char *argv[]) { + Item *p; + char *name, *type; + + if (argc < 2 || strcasecmp(argv[1], "list") == 0) { + for (p = list; p != NULL; p = p->next) { + if (argc < 3) { + SCPrintf(con, eStatus, "%s %s %s", p->type, p->name, p->desc); + } else if (strcasecmp(argv[2], p->type) == 0) { + SCPrintf(con, eStatus, "%s %s", p->name, p->desc); + } + } + } else { + if (argc == 2) { + name = argv[1]; + type = "Object"; + } else { + name = argv[2]; + type = argv[1]; + } + p = list; + while (p != NULL && (strcasecmp(p->type, type) != 0 || strcasecmp(p->name, name) != 0)) { + p = p->next; + } + if (p) { + SCPrintf(con, eValue, "%s", p->desc); + } else { + SCPrintf(con, eValue, "notfound"); + } + } + return 1; +} + static int RemoveObject(SConnection *con, SicsInterp *sics, void *data, int argc, char *argv[]) { CmdInitializer cmdin; @@ -91,7 +128,7 @@ static int RemoveObject(SConnection *con, SicsInterp *sics, char *className; if (argc != 2) { - SCPrintf(con, eError, "%s has 1 argument", argv[0]); + SCPrintf(con, eError, "%s needs 1 argument", argv[0]); return 0; } @@ -124,16 +161,20 @@ static void KillInitializers(void *data) { item = list; while (item) { next = item->next; + if (item->name) free(item->name); + if (item->type) free(item->type); + if (item->desc) free(item->desc); free(item); item = next; } list = NULL; } -void MakeDriver(const char *driver, CmdInitializer maker, int startupOnly) { +void MakeDriver(const char *driver, CmdInitializer maker, int startupOnly, const char *desc) { if (! FindCommand(pServ->pSics, "MakeObject")) { AddCommandWithFlag(pServ->pSics, "MakeObject", MakeObject, KillInitializers, NULL, 0); AddCommandWithFlag(pServ->pSics, "RemoveObject", RemoveObject, NULL, NULL, 0); + AddCommandWithFlag(pServ->pSics, "DriverList", DriverList, NULL, NULL, 0); } - MakeInitializer("Object", driver, (Initializer)maker, startupOnly); + MakeInitializer("Object", driver, (Initializer)maker, startupOnly, desc); } diff --git a/initializer.h b/initializer.h index dcd3820c..593f0d24 100644 --- a/initializer.h +++ b/initializer.h @@ -12,7 +12,8 @@ Markus Zolliker, March 2005 typedef void (*Initializer)(void); -void MakeInitializer(const char *type, const char *name, Initializer maker, int startupOnly); +void MakeInitializer(const char *type, const char *name, Initializer maker, int startupOnly, + const char *desc); /* install an initializer @@ -54,7 +55,8 @@ typedef int (*CmdInitializer) (SConnection *pCon, int argc, char *argv[], int dy - dynamic: the initializer was called _after_ startup */ -void MakeDriver(const char *driver, CmdInitializer maker, int startupOnly); +void MakeDriver(const char *driver, CmdInitializer maker, int startupOnly, + const char *desc); /* Install a driver of type "Object" with the initializer function maker. - startupOnly: the driver creation should only be possible at startup diff --git a/lin2ang.c b/lin2ang.c index 5e5e6063..0c6de052 100644 --- a/lin2ang.c +++ b/lin2ang.c @@ -34,7 +34,7 @@ /*-------------------------- conversion routines -------------------------*/ static float ang2x(pLin2Ang self, float fAngle) { - return self->length*sin((fAngle+self->zero)/RD); + return self->length*tan((fAngle+self->zero)/RD); } /*-----------------------------------------------------------------------*/ static float x2ang(pLin2Ang self, float fX) @@ -44,7 +44,7 @@ assert(self->length > 0.); dt = fX/self->length; - return RD*asin(dt) - self->zero; + return RD*atan(dt) - self->zero; } /*============== functions in the interface ============================*/ static void *Lin2AngGetInterface(void *pData, int iID) diff --git a/linux_def b/linux_def index ea98bcdb..4feb8a3b 100644 --- a/linux_def +++ b/linux_def @@ -9,4 +9,4 @@ MFLAGS=-f makefile_linux$(DUMMY) -HDFROOT=/afs/psi.ch/project/sinq/sl-linux +HDFROOT=/usr/local diff --git a/macro.c b/macro.c index e98b50f1..ced502fe 100644 --- a/macro.c +++ b/macro.c @@ -2,7 +2,7 @@ All you need to evaluate macros with SICS - The implmentation for the macro stuff is complex and non intuitive. + The implementation for the macro stuff is complex and non intuitive. This is the price to pay for adding the extremly powerful and strong Tcl-interpreter to SICS. The problem is that Tcl does not know anything about connections and our error handling. We have @@ -770,6 +770,127 @@ static int ProtectedExec(ClientData clientData, Tcl_Interp *interp, } return 1; } +/*-----------------------------------------------------------------------*/ + int GumPut(SConnection *pCon, SicsInterp *pInter, void *pData, + int argc, char *argv[]) + { + OutCode eOut = eWarning; + int i = 0, iCode, iLen; + int iMacro; + char *ppCode; + char *pMessage = NULL; + commandContext cc; + + assert(pCon); + assert(pInter); + + if(argc < 2) + { + SCWrite(pCon,"Insufficient arguments to ClientPut",eError); + return 0; + } + + /* handle optional I/O codes */ + if(argc > 2) + { + /* the last one must be the code */ + iCode = argc - 1; + ppCode = strdup(argv[iCode]); + strtolower(ppCode); + while(pCode[i] != NULL) + { + if(strcmp(pCode[i],ppCode) == 0) + { + break; + } + i++; + } + if(ppCode) + { + free(ppCode); + } + } + else + { + i = 10; + iCode = argc; + } + + switch(i) + { + case 0: + eOut = eInternal; + break; + case 1: + eOut = eCommand; + break; + case 2: + eOut = eHWError; + break; + case 3: + eOut = eInError; + break; + case 4: + eOut = eStatus; + break; + case 5: + eOut = eValue; + break; + case 6: + eOut = eWarning; + break; + case 7: + eOut = eFinish; + break; + case 8: + eOut = eEvent; + break; + case 9: + eOut = eWarning; + break; + case 10: + eOut = eError; + break; + default: + eOut = eWarning; + iCode = argc; + break; + } + + /* recombine the message */ + /* find length */ + iLen = 0; + for(i = 1; i < iCode; i++) + { + iLen += strlen(argv[i]); + } + pMessage = (char *)malloc((iLen+100)*sizeof(char)); + if(!pMessage) + { + SCWrite(pCon,"ERROR: out of memory in clientput",eError); + return 0; + } + memset(pMessage,0,(iLen+100)*sizeof(char)); + Arg2Text(iCode-1,&argv[1],pMessage,(iLen+100)*sizeof(char)); + + /* now write, thereby tunneling macro flag in order to get proper + write to client and not into interpreter. We also make sure that the device + is gumput + */ + iMacro = SCinMacro(pCon); + SCsetMacro(pCon,0); + cc = SCGetContext(pCon); + strcpy(cc.deviceID,"gumput"); + SCPushContext2(pCon,cc); + SCWrite(pCon,pMessage,eOut); + SCPopContext(pCon); + SCsetMacro(pCon,iMacro); + if(pMessage) + { + free(pMessage); + } + return 1; + } /*----------------------------------------------------------------------*/ int Broadcast(SConnection *pCon, SicsInterp *pInter, void *pData, int argc, char *argv[]) @@ -891,14 +1012,9 @@ static int ProtectedExec(ClientData clientData, Tcl_Interp *interp, if (pCommand != pBueffel) free(pCommand); if(iRet == TCL_OK) { - /* we do not now why, but at some time it was found that - we need a copy, and can not use pTcl->result directly - - SCWrite(pCon,pTcl->result,eStatus); - - let us use SCPrintf, which maked always a copy - */ - SCPrintf(pCon, eStatus, "%s", pTcl->result); + if(strlen(pTcl->result) > 0){ + SCPrintf(pCon, eStatus, "%s", pTcl->result); + } return 1; } else diff --git a/macro.h b/macro.h index a3b1d535..2bd8fa78 100644 --- a/macro.h +++ b/macro.h @@ -14,6 +14,7 @@ #ifndef SICSMACRO #define SICSMACRO #include +#include "sics.h" #include "SCinter.h" Tcl_Interp *MacroInit(SicsInterp *pInter); @@ -30,6 +31,8 @@ int argc, char *argv[]); int ClientPut(SConnection *pCon, SicsInterp *pInter, void *pData, int argc, char *argv[]); + int GumPut(SConnection *pCon, SicsInterp *pInter, void *pData, + int argc, char *argv[]); int Broadcast(SConnection *pCon, SicsInterp *pInter, void *pData, int argc, char *argv[]); int TransactAction(SConnection *pCon, SicsInterp *pSics, void *pData, diff --git a/make_gen b/make_gen index 5bcbf35a..32c80b63 100644 --- a/make_gen +++ b/make_gen @@ -30,14 +30,22 @@ SOBJ = network.o ifile.o conman.o SCinter.o splitter.o passwd.o \ s_rnge.o sig_die.o gpibcontroller.o $(NIOBJ) mcreader.o mccontrol.o\ hmdata.o nxscript.o tclintimpl.o sicsdata.o mcstascounter.o \ mcstashm.o initializer.o remob.o tclmotdriv.o protocol.o \ - sinfox.o sicslist.o cone.o hipadaba.o sicshipadaba.o statistics.o + sinfox.o sicslist.o cone.o hipadaba.o sicshipadaba.o statistics.o \ + moregress.o hdbcommand.o multicounter.o regresscter.o histregress.o \ + sicshdbadapter.o polldriv.o sicspoll.o statemon.o MOTOROBJ = motor.o simdriv.o COUNTEROBJ = countdriv.o simcter.o counter.o VELOOBJ = velo.o velosim.o .SUFFIXES: -.SUFFIXES: .tcl .htm .c .o +.SUFFIXES: .tcl .htm .c .o .tc + +.tc.c: + tjxp $*.tc $*.c + +#--- This .SECONDARY. target is necessary to preserve generated .c files for debugging +.SECONDARY.: sicspoll.c polldriv.c all: libmat libhlib libtecsl libpsi SICServer diff --git a/makefile_linux b/makefile_linux index 660eef3a..33944cd7 100644 --- a/makefile_linux +++ b/makefile_linux @@ -6,11 +6,11 @@ # Markus Zolliker, March 2003 #========================================================================== # assign if the National Instrument GPIB driver is available -SINQDIR=/afs/psi.ch/project/sinq -NI= -#NI= -DHAVENI -#NIOBJ= nigpib.o -#NILIB=$(SINQDIR)/linux/lib/cib.o +SINQDIR=/usr/local +#NI= +NI= -DHAVENI +NIOBJ= nigpib.o +NILIB=$(SINQDIR)/lib/cib.o include linux_def @@ -26,7 +26,7 @@ SUBLIBS = psi/libpsi.a psi/hardsup/libhlib.a matrix/libmatrix.a \ LIBS = -L$(HDFROOT)/lib $(SUBLIBS) $(NILIB)\ -ltcl8.4 -lmxml $(HDFROOT)/lib/libhdf5.a \ $(HDFROOT)/lib/libmfhdf.a $(HDFROOT)/lib/libdf.a \ - -ljpeg -ldl -lz -lm -lc + -lmxml -lghttp -ljpeg -ljson -ldl -lz -lsz -lm -lc include make_gen diff --git a/makefile_slinux b/makefile_slinux index 5b813277..e7ee262d 100644 --- a/makefile_slinux +++ b/makefile_slinux @@ -26,7 +26,7 @@ SUBLIBS = psi/libpsi.a psi/hardsup/libhlib.a matrix/libmatrix.a \ LIBS = -L$(HDFROOT)/lib $(SUBLIBS) $(NILIB)\ -ltcl8.3 $(HDFROOT)/lib/libhdf5.a \ $(HDFROOT)/lib/libmfhdf.a $(HDFROOT)/lib/libdf.a \ - $(HDFROOT)/lib/libjpeg.a -lsz -ldl -lz -lmxml -lghttp -lm -lc + $(HDFROOT)/lib/libjpeg.a -lsz -ljson -ldl -lz -lmxml -lghttp -lm -lc include make_gen diff --git a/maximize.c b/maximize.c index 4857e45f..0afafcc3 100644 --- a/maximize.c +++ b/maximize.c @@ -47,6 +47,7 @@ #include "counter.h" #include "drive.h" #include "maximize.h" +#include "motor.h" #define MAXPTS 100 #define DEBUG 1 @@ -55,6 +56,7 @@ pObjectDescriptor pDes; pCounter pCount; int i360; + int maxpts; }Maxxii; /*----------------------------------------------------------------------- @@ -134,7 +136,25 @@ } return 1; } - + /*----------------------------------------------------------------------*/ + static float readMPDrivable(void *pVar, SConnection *pCon) + { + float value = -999.99; + pIDrivable pDriv = NULL; + pDummy pDum = (pDummy)pVar; + + pDriv = GetDrivableInterface(pVar); + assert(pDriv != NULL); + if(strcmp(pDum->pDescriptor->name,"Motor") == 0) + { + MotorGetSoftPosition((pMotor)pVar,pCon,&value); + } + else + { + value = pDriv->GetValue(pVar,pCon); + } + return value; + } /*-----------------------------------------------------------------------*/ int MaximizePeak(pMax self, void *pVar, char *pVarName, float fStep, CounterMode eMode, @@ -159,27 +179,27 @@ start: lMax = 0; lMin = 0x7fffffff; - fStart = pDriv->GetValue(pVar,pCon); + fStart = readMPDrivable(pVar,pCon); if(fStart < -999999.) - { + { return 0; } /* search to the left until out of space or lCts < lMax/2. */ SCWrite(pCon,"Searching for low angle boundary..",eWarning); - for(i = MAXPTS/2; i >= 0; i--) + for(i = self->maxpts/2; i >= 0; i--) { /* drive motor */ - fPos = fStart - (MAXPTS/2 - i)*fStep; + fPos = fStart - (self->maxpts/2 - i)*fStep; fPos = in360(self,fPos); if(maxDrive(pVar,pVarName,fPos,pCon) != 1) - { + { return 0; } - x[i] = pDriv->GetValue(pVar,pCon); + x[i] = readMPDrivable(pVar,pCon); /* count */ if(maxCount(self->pCount,eMode,fPreset, &lCts,pCon) != 1) - { + { return 0; } /* print a message */ @@ -218,7 +238,7 @@ goto start; } /* no peak found or normal peak: continue at other side */ - if( (i < 1) || (y[MAXPTS/2] > lMax/2) ) + if( (i < 1) || (y[self->maxpts/2] > lMax/2) ) { iSkip = 0; } @@ -227,7 +247,7 @@ /* next case: all of the peak in measured half: find max value and skip the right half */ - for(i = MAXPTS/2; i > 0; i--) + for(i = self->maxpts/2; i > 0; i--) { if(y[i] > lMax/2) { @@ -246,16 +266,16 @@ lMin = 100000; lMax = -100000; SCWrite(pCon,"Searching for high angle boundary..",eWarning); - for(i = MAXPTS/2; i < MAXPTS; i++) + for(i = self->maxpts/2; i < self->maxpts; i++) { /* drive motor */ - fPos = fStart + (i - MAXPTS/2) * fStep; + fPos = fStart + (i - self->maxpts/2) * fStep; fPos = in360(self,fPos); if(maxDrive(pVar,pVarName,fPos,pCon) != 1) { return 0; } - x[i] = pDriv->GetValue(pVar,pCon); + x[i] = readMPDrivable(pVar,pCon); /* count */ if(maxCount(self->pCount,eMode,fPreset, &lCts,pCon) != 1) { @@ -292,18 +312,18 @@ iTop = i; iTop++; /* first case: peak is at high angle side */ - if( (i > MAXPTS-2) && (lMax*0.5 > lMin) ) + if( (i > self->maxpts-2) && (lMax*0.5 > lMin) ) { goto start; } /* second case: no peak */ - if( (iTop > MAXPTS-2) ) + if( (iTop > self->maxpts-2) ) { SCWrite(pCon,"ERROR: no peak found!",eError); return 0; } /* third case: normal peak */ - if(y[MAXPTS/2] >= 0.5*lMax) + if(y[self->maxpts/2] >= 0.5*lMax) { iTop--; } @@ -313,7 +333,7 @@ */ else { - for(i = MAXPTS/2; i < MAXPTS; i++) + for(i = self->maxpts/2; i < self->maxpts; i++) { if(y[i] > lMax/2) { @@ -325,7 +345,7 @@ } } /* end of iSkip */ - if( (iBot < 2) || (iTop > MAXPTS-2) || (lMax < lMin*2) ) + if( (iBot < 2) || (iTop > self->maxpts-2) || (lMax < lMin*2) ) { SCWrite(pCon,"ERROR: no peak found!",eError); return 0; @@ -420,11 +440,14 @@ pNew->pDes = CreateDescriptor("Maximizer"); pNew->pCount = pCom->pData; pNew->i360 = 0; + pNew->maxpts = 100; AddCommand(pSics,"max",MaximizeAction,MaxKill,pNew); return 1; } -/*------------------------------------------------------------------*/ +/*------------------------------------------------------------------ + * max motor step preset mode + * ---------------------------------------------------------------------*/ int MaximizeAction(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]) { @@ -434,7 +457,7 @@ double dVal; float fStep, fPreset; CounterMode eCount; - int iRet; + int iRet, iVal; self = (pMax)pData; assert(self); @@ -446,9 +469,56 @@ return 1; } + /* enough arguments ?*/ if(argc < 5) { + if(argc > 1) + { + strtolower(argv[1]); + if(strcmp(argv[1],"in360") == 0) + { + if(argc > 2) + { + iVal = atoi(argv[2]); + if(iVal != 0 && iVal != 1) { + SCWrite(pCon,"ERROR: only 0, 1 allowed for in360",eError); + return 0; + } + self->i360 = iVal; + SCSendOK(pCon); + return 1; + } + else + { + snprintf(pBueffel,255,"max.in360 = %d", self->i360); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + } + if(strcmp(argv[1],"maxpts") == 0) + { + if(argc > 2) + { + iVal = atoi(argv[2]); + if(iVal < 10 || iVal > 100) { + SCWrite(pCon,"ERROR: maxpst must be between 10 and 100", + eError); + return 0; + } + self->maxpts = iVal; + SCSendOK(pCon); + return 1; + } + else + { + snprintf(pBueffel,255,"max.maxpts = %d", self->maxpts); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + } + + } SCWrite(pCon,"ERROR: Insufficient number of arguments to max", eError); return 0; diff --git a/mcstas/dmc/README b/mcstas/dmc/README new file mode 100644 index 00000000..8f60f950 --- /dev/null +++ b/mcstas/dmc/README @@ -0,0 +1,36 @@ + + VIRTUAL DMC + + This is the SICS-McStas virtual instrument DMC modelled after the real + powder diffcractometer DMC at SINQ: + + http://sinq.web.psi.ch/sinq/instr/dmc/dmc.html + + The McStas simulation used for this system has been verified against + the real instrument. The basic usage is to start the SICServer with: + + ./SICServer vdmc.tcl + + in this directory. Then you can connect to SICS at localhost/2911 + with any SICS client and start issuing commands. + + In order to save simulation time, the simulation works with + neutron data files presimulated for four wavelength up to the sample. + This is why you get your wavelength coerced to the nearest + precalculated value. + + If you desire to "measure" your own sample on virtual DMC, you first + have to create a LazyPulverix output file. You then can proceed to + load the sample into SICS with the SICS command: + + sample load path-to-lazy-pulverix-outputfile + + The command: + + sample list + + tells you which samples virtual DMC already knows about. + + Questions and comments to: Mark.Koennecke@psi.ch + + diff --git a/mcstas/dmc/dmcafter.c b/mcstas/dmc/dmcafter.c new file mode 100644 index 00000000..cbfbd1ee --- /dev/null +++ b/mcstas/dmc/dmcafter.c @@ -0,0 +1,8454 @@ +/* Automatically generated file. Do not edit. + * Format: ANSI C source code + * Creator: McStas + * Instrument: dmcafter.instr (DMC_diff) + * Date: Tue Aug 2 16:09:43 2005 + */ + + +#define MCSTAS_VERSION "1.8 - Mar. 05, 2004" +#define MC_USE_DEFAULT_MAIN +#define MC_EMBEDDED_RUNTIME + +#line 1 "mcstas-r.h" +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Runtime: share/mcstas-r.h +* +* %Identification +* Written by: KN +* Date: Aug 29, 1997 +* Release: McStas 1.6 +* Version: 1.5 +* +* Runtime system header for McStas. +* +* Usage: Automatically embbeded in the c code. +* +* $Id: dmcafter.c,v 1.2 2007-02-12 01:19:07 ffr Exp $ +* +* $Log: not supported by cvs2svn $ +* Revision 1.1.2.1 2007/02/06 04:03:21 ffr +* PSI Update +* +* Revision 1.1 2007/01/30 03:19:43 koennecke +* - Fixed state monitor eclipse commit problems. Siiiiiiiggggghhhhhh! +* +* Revision 1.55 2003/10/21 14:08:12 pkwi +* Rectangular focusing improved: Renamed randvec_target_rect to randvec_target_rect_angular. Wrote new randvec_target_rect routine, w/h in metres. Both routines use use component orientation (ROT_A_CURRENT_COMP) as input. +* +* Modifications to Res_sample and V_sample to match new features of the runtime. +* +* Revision 1.54 2003/09/05 08:59:18 farhi +* added INSTRUMENT parameter default value grammar +* mcinputtable now has also default values +* mcreadpar now uses default values if parameter not given +* extended instr_formal parameter struct +* extended mcinputtable structure type +* +* Revision 1.53 2003/04/07 11:50:51 farhi +* Extended the way mcplot:plotter is assigned. Set --portable ok +* Handle Scilab:Tk and ~GTk menu (shifted) +* Updated help in mcrun and mcstas-r.c +* +* Revision 1.52 2003/04/04 18:20:21 farhi +* remove some warnings (duplicated decl) for --no-runtime on Dec OSF +* +* Revision 1.51 2003/04/04 14:27:19 farhi +* Moved format definitions to mcstas-r.c for --no-runtime to work +* +* Revision 1.50 2003/02/11 12:28:46 farhi +* Variouxs bug fixes after tests in the lib directory +* mcstas_r : disable output with --no-out.. flag. Fix 1D McStas output +* read_table:corrected MC_SYS_DIR -> MCSTAS define +* monitor_nd-lib: fix Log(signal) log(coord) +* HOPG.trm: reduce 4000 points -> 400 which is enough and faster to resample +* Progress_bar: precent -> percent parameter +* CS: ---------------------------------------------------------------------- +* +* Revision 1.5 2002/10/19 22:46:21 ef +* gravitation for all with -g. Various output formats. +* +* Revision 1.4 2002/09/17 12:01:21 ef +* removed unused macros (PROP_Y0, X0), changed randvec_target_sphere to circle +* added randvec_target_rect +* +* Revision 1.3 2002/08/28 11:36:37 ef +* Changed to lib/share/c code +* +* Revision 1.2 2001/10/10 11:36:37 ef +* added signal handler +* +* Revision 1.1 1998/08/29 11:36:37 kn +* Initial revision +* +*******************************************************************************/ + +#ifndef MCSTAS_R_H +#define MCSTAS_R_H "$Revision: 1.2 $" + +#include +#include +#include +#include + +/* If the runtime is embedded in the simulation program, some definitions can + be made static. */ + +#ifdef MC_EMBEDDED_RUNTIME +#define mcstatic static +#else +#define mcstatic +#endif + +#ifdef __dest_os +#if (__dest_os == __mac_os) +#define MAC +#endif +#endif + +#ifdef WIN32 +#define MC_PATHSEP_C '\\' +#define MC_PATHSEP_S "\\" +#else /* !WIN32 */ +#ifdef MAC +#define MC_PATHSEP_C ':' +#define MC_PATHSEP_S ":" +#else /* !MAC */ +#define MC_PATHSEP_C '/' +#define MC_PATHSEP_S "/" +#endif /* !MAC */ +#endif /* !WIN32 */ + +#ifndef MC_PORTABLE +#ifndef MAC +#ifndef WIN32 +#include +#endif /* !MAC */ +#endif /* !WIN32 */ +#endif /* MC_PORTABLE */ + +typedef double MCNUM; +typedef struct {MCNUM x, y, z;} Coords; +typedef MCNUM Rotation[3][3]; + +/* Note: the enum instr_formal_types definition MUST be kept + synchronized with the one in mcstas.h and with the + instr_formal_type_names array in cogen.c. */ +enum instr_formal_types + { + instr_type_double, instr_type_int, instr_type_string + }; +struct mcinputtable_struct { + char *name; + void *par; + enum instr_formal_types type; + char *val; +}; +extern struct mcinputtable_struct mcinputtable[]; +extern int mcnumipar; +extern char mcinstrument_name[], mcinstrument_source[]; +extern int mctraceenabled, mcdefaultmain; +#ifndef MC_EMBEDDED_RUNTIME +extern FILE *mcsiminfo_file; +extern char mcsig_message[]; +extern int mcgravitation; +extern int mcdotrace; +extern struct mcformats_struct mcformats[]; +extern struct mcformats_struct mcformat; +#endif +void mcinit(void); +void mcraytrace(void); +void mcsave(FILE *); +void mcfinally(void); +void mcdisplay(void); + +/* MOD: E. Farhi, Sep 25th 2001 set Scattered flag (for groups) */ +#define SCATTER do {mcDEBUG_SCATTER(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz, \ + mcnlt,mcnlsx,mcnlsy, mcnlp); mcScattered++;} while(0) +#define ABSORB do {mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz, \ + mcnlt,mcnlsx,mcnlsy, mcnlp); mcDEBUG_ABSORB(); goto mcabsorb;} while(0) +/* Note: The two-stage approach to MC_GETPAR is NOT redundant; without it, +* after #define C sample, MC_GETPAR(C,x) would refer to component C, not to +* component sample. Such are the joys of ANSI C. + +* Anyway the usage of MCGETPAR requires that we use sometimes bare names... +*/ +#define MC_GETPAR2(comp, par) (mcc ## comp ## _ ## par) +#define MC_GETPAR(comp, par) MC_GETPAR2(comp,par) +#define DETECTOR_OUT(p0,p1,p2) mcdetector_out(NAME_CURRENT_COMP,p0,p1,p2,NULL) +#define DETECTOR_OUT_0D(t,p0,p1,p2) mcdetector_out_0D(t,p0,p1,p2,NAME_CURRENT_COMP) +#define DETECTOR_OUT_1D(t,xl,yl,xvar,x1,x2,n,p0,p1,p2,f) \ + mcdetector_out_1D(t,xl,yl,xvar,x1,x2,n,p0,p1,p2,f,NAME_CURRENT_COMP) +#define DETECTOR_OUT_2D(t,xl,yl,x1,x2,y1,y2,m,n,p0,p1,p2,f) \ + mcdetector_out_2D(t,xl,yl,x1,x2,y1,y2,m,n,p0,p1,p2,f,NAME_CURRENT_COMP) +#define DETECTOR_OUT_3D(t,xl,yl,zl,xv,yv,zv,x1,x2,y1,y2,z1,z2,m,n,p,p0,p1,p2,f) \ + mcdetector_out_3D(t,xl,yl,zl,xv,yv,zv,x1,x2,y1,y2,z1,z2,m,n,p,p0,p1,p2,f,NAME_CURRENT_COMP) +/* ADD: E. Farhi, Sep 20th 2001 save neutron state (in local coords) */ +#define STORE_NEUTRON(index, x, y, z, vx, vy, vz, t, sx, sy, sz, p) \ + mcstore_neutron(mccomp_storein,index, x, y, z, vx, vy, vz, t, sx, sy, sz, p); +/* ADD: E. Farhi, Sep 20th 2001 restore neutron state (in local coords) */ +#define RESTORE_NEUTRON(index, x, y, z, vx, vy, vz, t, sx, sy, sz, p) \ + mcrestore_neutron(mccomp_storein,index, &x, &y, &z, &vx, &vy, &vz, &t, &sx, &sy, &sz, &p); +#define POS_A_COMP_INDEX(index) \ + (mccomp_posa[index]) +#define POS_R_COMP_INDEX(index) \ + (mccomp_posr[index]) \ + +#ifdef MC_TRACE_ENABLED +#define DEBUG +#endif + +#ifdef DEBUG +#define mcDEBUG_INSTR() if(!mcdotrace); else printf("INSTRUMENT:\n"); +#define mcDEBUG_COMPONENT(name,c,t) if(!mcdotrace); else \ + printf("COMPONENT: \"%s\"\n" \ + "POS: %g, %g, %g, %g, %g, %g, %g, %g, %g, %g, %g, %g\n", \ + name, c.x, c.y, c.z, t[0][0], t[0][1], t[0][2], \ + t[1][0], t[1][1], t[1][2], t[2][0], t[2][1], t[2][2]); +#define mcDEBUG_INSTR_END() if(!mcdotrace); else printf("INSTRUMENT END:\n"); +#define mcDEBUG_ENTER() if(!mcdotrace); else printf("ENTER:\n"); +#define mcDEBUG_COMP(c) if(!mcdotrace); else printf("COMP: \"%s\"\n", c); +#define mcDEBUG_STATE(x,y,z,vx,vy,vz,t,s1,s2,p) if(!mcdotrace); else \ + printf("STATE: %g, %g, %g, %g, %g, %g, %g, %g, %g, %g\n", \ + x,y,z,vx,vy,vz,t,s1,s2,p); +#define mcDEBUG_SCATTER(x,y,z,vx,vy,vz,t,s1,s2,p) if(!mcdotrace); else \ + printf("SCATTER: %g, %g, %g, %g, %g, %g, %g, %g, %g, %g\n", \ + x,y,z,vx,vy,vz,t,s1,s2,p); +#define mcDEBUG_LEAVE() if(!mcdotrace); else printf("LEAVE:\n"); +#define mcDEBUG_ABSORB() if(!mcdotrace); else printf("ABSORB:\n"); +#else +#define mcDEBUG_INSTR() +#define mcDEBUG_COMPONENT(name,c,t) +#define mcDEBUG_INSTR_END() +#define mcDEBUG_ENTER() +#define mcDEBUG_COMP(c) +#define mcDEBUG_STATE(x,y,z,vx,vy,vz,t,s1,s2,p) +#define mcDEBUG_SCATTER(x,y,z,vx,vy,vz,t,s1,s2,p) +#define mcDEBUG_LEAVE() +#define mcDEBUG_ABSORB() +#endif + +#ifdef TEST +#define test_printf printf +#else +#define test_printf while(0) printf +#endif + +void mcdis_magnify(char *); +void mcdis_line(double, double, double, double, double, double); +void mcdis_multiline(int, ...); +void mcdis_circle(char *, double, double, double, double); + +#define RAD2MIN ((180*60)/PI) +#define MIN2RAD (PI/(180*60)) +#define DEG2RAD (PI/180) +#define RAD2DEG (180/PI) +#define AA2MS 629.719 /* Convert k[1/AA] to v[m/s] */ +#define MS2AA 1.58801E-3 /* Convert v[m/s] to k[1/AA] */ +#define K2V AA2MS +#define V2K MS2AA +#define Q2V AA2MS +#define V2Q MS2AA +#define SE2V 437.3949 /* Convert sqrt(E)[meV] to v[m/s] */ +#define VS2E 5.227e-6 /* Convert (v[m/s])**2 to E[meV] */ +#define FWHM2RMS 0.424660900144 /* Convert between full-width-half-max and */ +#define RMS2FWHM 2.35482004503 /* root-mean-square (standard deviation) */ +#define HBAR 1.05459E-34 +#define MNEUTRON 1.67492E-27 + +#ifndef PI +# ifdef M_PI +# define PI M_PI +# else +# define PI 3.14159265358979323846 +# endif +#endif + +typedef int mc_int32_t; +mc_int32_t mc_random(void); +void mc_srandom (unsigned int x); +unsigned long mt_random(void); +void mt_srandom (unsigned long x); + +#ifndef MC_RAND_ALG +#define MC_RAND_ALG 1 +#endif + +#if MC_RAND_ALG == 0 + /* Use system random() (not recommended). */ +# define MC_RAND_MAX RAND_MAX +#elif MC_RAND_ALG == 1 + /* "Mersenne Twister", by Makoto Matsumoto and Takuji Nishimura. */ +# define MC_RAND_MAX ((unsigned long)0xffffffff) +# define random mt_random +# define srandom mt_srandom +#elif MC_RAND_ALG == 2 + /* Algorithm used in McStas 1.1 and earlier (not recommended). */ +# define MC_RAND_MAX 0x7fffffff +# define random mc_random +# define srandom mc_srandom +#else +# error "Bad value for random number generator choice." +#endif + +#define rand01() ( ((double)random())/((double)MC_RAND_MAX+1) ) +#define randpm1() ( ((double)random()) / (((double)MC_RAND_MAX+1)/2) - 1 ) +#define rand0max(max) ( ((double)random()) / (((double)MC_RAND_MAX+1)/(max)) ) +#define randminmax(min,max) ( rand0max((max)-(min)) + (min) ) + +#define mcPROP_DT(dt) \ + do { \ + mcnlx += mcnlvx*(dt); \ + mcnly += mcnlvy*(dt); \ + mcnlz += mcnlvz*(dt); \ + mcnlt += (dt); \ + } while(0) + +/* ADD: E. Farhi, Aug 6th, 2001 PROP_GRAV_DT propagation with gravitation */ +#define PROP_GRAV_DT(dt, Ax, Ay, Az) \ + do { \ + mcnlx += mcnlvx*dt + Ax*dt*dt/2; \ + mcnly += mcnlvy*dt + Ay*dt*dt/2; \ + mcnlz += mcnlvz*dt + Az*dt*dt/2; \ + mcnlvx += Ax*dt; \ + mcnlvy += Ay*dt; \ + mcnlvz += Az*dt; \ + mcnlt += dt; \ + } while(0) + +#define PROP_DT(dt) \ + do { \ + if(dt < 0) ABSORB; \ + if (mcgravitation) { Coords mcLocG; double mc_gx, mc_gy, mc_gz; \ + mcLocG = rot_apply(ROT_A_CURRENT_COMP, coords_set(0,-9.8,0)); \ + coords_get(mcLocG, &mc_gx, &mc_gy, &mc_gz); \ + PROP_GRAV_DT(dt, mc_gx, mc_gy, mc_gz); } \ + else mcPROP_DT(dt); \ + } while(0) + +#define PROP_Z0 \ + do { \ + if (mcgravitation) { Coords mcLocG; int mc_ret; \ + double mc_dt, mc_gx, mc_gy, mc_gz; \ + mcLocG = rot_apply(ROT_A_CURRENT_COMP, coords_set(0,-9.8,0)); \ + coords_get(mcLocG, &mc_gx, &mc_gy, &mc_gz); \ + mc_ret = plane_intersect_Gfast(&mc_dt, -mc_gz/2, -mcnlvz, -mcnlz); \ + if (mc_ret && mc_dt>0) PROP_GRAV_DT(mc_dt, mc_gx, mc_gy, mc_gz); \ + else ABSORB; }\ + else mcPROP_Z0; \ + } while(0) + + +#define mcPROP_Z0 \ + do { \ + double mc_dt; \ + if(mcnlvz == 0) ABSORB; \ + mc_dt = -mcnlz/mcnlvz; \ + if(mc_dt < 0) ABSORB; \ + mcnlx += mcnlvx*mc_dt; \ + mcnly += mcnlvy*mc_dt; \ + mcnlt += mc_dt; \ + mcnlz = 0; \ + } while(0) + +#define vec_prod(x, y, z, x1, y1, z1, x2, y2, z2) \ + do { \ + double mcvp_tmpx, mcvp_tmpy, mcvp_tmpz; \ + mcvp_tmpx = (y1)*(z2) - (y2)*(z1); \ + mcvp_tmpy = (z1)*(x2) - (z2)*(x1); \ + mcvp_tmpz = (x1)*(y2) - (x2)*(y1); \ + (x) = mcvp_tmpx; (y) = mcvp_tmpy; (z) = mcvp_tmpz; \ + } while(0) + +#define scalar_prod(x1, y1, z1, x2, y2, z2) \ + ((x1)*(x2) + (y1)*(y2) + (z1)*(z2)) + +#define NORM(x,y,z) \ + do { \ + double mcnm_tmp = sqrt((x)*(x) + (y)*(y) + (z)*(z)); \ + if(mcnm_tmp != 0.0) \ + { \ + (x) /= mcnm_tmp; \ + (y) /= mcnm_tmp; \ + (z) /= mcnm_tmp; \ + } \ + } while(0) + +#define rotate(x, y, z, vx, vy, vz, phi, ax, ay, az) \ + do { \ + double mcrt_tmpx = (ax), mcrt_tmpy = (ay), mcrt_tmpz = (az); \ + double mcrt_vp, mcrt_vpx, mcrt_vpy, mcrt_vpz; \ + double mcrt_vnx, mcrt_vny, mcrt_vnz, mcrt_vn1x, mcrt_vn1y, mcrt_vn1z; \ + double mcrt_bx, mcrt_by, mcrt_bz; \ + double mcrt_cos, mcrt_sin; \ + NORM(mcrt_tmpx, mcrt_tmpy, mcrt_tmpz); \ + mcrt_vp = scalar_prod((vx), (vy), (vz), mcrt_tmpx, mcrt_tmpy, mcrt_tmpz); \ + mcrt_vpx = mcrt_vp*mcrt_tmpx; \ + mcrt_vpy = mcrt_vp*mcrt_tmpy; \ + mcrt_vpz = mcrt_vp*mcrt_tmpz; \ + mcrt_vnx = (vx) - mcrt_vpx; \ + mcrt_vny = (vy) - mcrt_vpy; \ + mcrt_vnz = (vz) - mcrt_vpz; \ + vec_prod(mcrt_bx, mcrt_by, mcrt_bz, \ + mcrt_tmpx, mcrt_tmpy, mcrt_tmpz, mcrt_vnx, mcrt_vny, mcrt_vnz); \ + mcrt_cos = cos((phi)); mcrt_sin = sin((phi)); \ + mcrt_vn1x = mcrt_vnx*mcrt_cos + mcrt_bx*mcrt_sin; \ + mcrt_vn1y = mcrt_vny*mcrt_cos + mcrt_by*mcrt_sin; \ + mcrt_vn1z = mcrt_vnz*mcrt_cos + mcrt_bz*mcrt_sin; \ + (x) = mcrt_vpx + mcrt_vn1x; \ + (y) = mcrt_vpy + mcrt_vn1y; \ + (z) = mcrt_vpz + mcrt_vn1z; \ + } while(0) + +Coords coords_set(MCNUM x, MCNUM y, MCNUM z); +Coords coords_get(Coords a, MCNUM *x, MCNUM *y, MCNUM *z); +Coords coords_add(Coords a, Coords b); +Coords coords_sub(Coords a, Coords b); +Coords coords_neg(Coords a); + +void rot_set_rotation(Rotation t, double phx, double phy, double phz); +void rot_mul(Rotation t1, Rotation t2, Rotation t3); +void rot_copy(Rotation dest, Rotation src); +void rot_transpose(Rotation src, Rotation dst); +Coords rot_apply(Rotation t, Coords a); +void mccoordschange(Coords a, Rotation t, double *x, double *y, double *z, + double *vx, double *vy, double *vz, double *time, + double *s1, double *s2); +void mccoordschange_polarisation(Rotation t, + double *sx, double *sy, double *sz); +double mcestimate_error(double N, double p1, double p2); +void mcreadparams(void); + +void mcsetstate(double x, double y, double z, double vx, double vy, double vz, + double t, double sx, double sy, double sz, double p); +void mcgenstate(void); +double randnorm(void); +void normal_vec(double *nx, double *ny, double *nz, + double x, double y, double z); +int box_intersect(double *dt_in, double *dt_out, double x, double y, double z, + double vx, double vy, double vz, double dx, double dy, double dz); +int cylinder_intersect(double *t0, double *t1, double x, double y, double z, + double vx, double vy, double vz, double r, double h); +int sphere_intersect(double *t0, double *t1, double x, double y, double z, + double vx, double vy, double vz, double r); +/* ADD: E. Farhi, Aug 6th, 2001 plane_intersect_Gfast */ +int plane_intersect_Gfast(double *Idt, + double A, double B, double C); +void randvec_target_circle(double *xo, double *yo, double *zo, + double *solid_angle, double xi, double yi, double zi, double radius); +#define randvec_target_sphere randvec_target_circle +void randvec_target_rect_angular(double *xo, double *yo, double *zo, + double *solid_angle, + double xi, double yi, double zi, double height, double width, Rotation A); +void randvec_target_rect(double *xo, double *yo, double *zo, + double *solid_angle, + double xi, double yi, double zi, double height, double width, Rotation A); +void extend_list(int count, void **list, int *size, size_t elemsize); + +void mcset_ncount(double count); +double mcget_ncount(void); +double mcget_run_num(void); +int mcstas_main(int argc, char *argv[]); + +/* file i/o definitions and function prototypes */ + +struct mcformats_struct { + char *Name; /* may also specify: append, partial(hidden), binary */ + char *Extension; + char *Header; + char *Footer; + char *BeginSection; + char *EndSection; + char *AssignTag; + char *BeginData; + char *BeginErrors; + char *BeginNcount; + char *EndData; + char *EndErrors; + char *EndNcount; + }; + +/* in order to be fully portable, the format specifiers must mention each + * fprintf parameters. In case we do not want to use some of them, we must + * set the precision to 0. + * ex: fprintf(f, "printed:%1$s %3$s not printed: %2$.0s\n", "1", "2", "3"); + * such are the joys of ANSI C99 and Single Unix Specification ! + * This 0-precision for unused data is automatically checked in mccheck_format + * Maximum number of positional arguments is NL_RGMAX, which is 9 on System V + * machines (Dec/Compaq/HP). Some more enjoyable stuff !! -> we use pfprintf + */ +/* The mcformat.Name may contain additional keywords: + * partial: will not show the monitor in mcstas.sim, omit the format footer + * (usually the end data), and not print the monitor sum in stdout + */ + +#ifndef MCSTAS_VERSION +#define MCSTAS_VERSION "External Run-time" +#endif + +/* function prototypes */ +void mcuse_format(char *format); +double mcdetector_out(char *cname, double p0, double p1, double p2, char *filename); +double mcdetector_out_0D(char *t, double p0, double p1, double p2, char *c); +double mcdetector_out_1D(char *t, char *xl, char *yl, + char *xvar, double x1, double x2, int n, + double *p0, double *p1, double *p2, char *f, char *c); +double mcdetector_out_2D(char *t, char *xl, char *yl, + double x1, double x2, double y1, double y2, int m, + int n, double *p0, double *p1, double *p2, char *f, char *c); +double mcdetector_out_3D(char *t, char *xl, char *yl, char *zl, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, int m, + int n, int p, double *p0, double *p1, double *p2, char *f, char *c); +void mcheader_out(FILE *f,char *parent, + int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, char *title, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename); /* output header for user data file */ +void mcinfo_simulation(FILE *f, struct mcformats_struct format, + char *pre, char *name); /* used to add sim parameters (e.g. in Res_monitor) */ +void mcsiminfo_init(FILE *f); +void mcsiminfo_close(void); + + +#ifndef FLT_MAX +#define FLT_MAX 3.40282347E+38F /* max decimal value of a "float" */ +#endif + +/* Retrieve component information from the kernel */ +/* Name, position and orientation (both absolute and relative) */ +/* Any component: For "redundancy", see comment by KN */ +#define tmp_name_comp(comp) #comp +#define NAME_COMP(comp) tmp_name_comp(comp) +#define tmp_pos_a_comp(comp) (mcposa ## comp) +#define POS_A_COMP(comp) tmp_pos_a_comp(comp) +#define tmp_pos_r_comp(comp) (mcposr ## comp) +#define POS_R_COMP(comp) tmp_pos_r_comp(comp) +#define tmp_rot_a_comp(comp) (mcrota ## comp) +#define ROT_A_COMP(comp) tmp_rot_a_comp(comp) +#define tmp_rot_r_comp(comp) (mcrotr ## comp) +#define ROT_R_COMP(comp) tmp_rot_r_comp(comp) + +/* Current component */ +#define NAME_CURRENT_COMP NAME_COMP(mccompcurname) +#define INDEX_CURRENT_COMP mccompcurindex +#define POS_A_CURRENT_COMP POS_A_COMP(mccompcurname) +#define POS_R_CURRENT_COMP POS_R_COMP(mccompcurname) +#define ROT_A_CURRENT_COMP ROT_A_COMP(mccompcurname) +#define ROT_R_CURRENT_COMP ROT_R_COMP(mccompcurname) + +#define SCATTERED mcScattered + +#endif /* MCSTAS_R_H */ +/* End of file "mcstas-r.h". */ + +#line 546 "dmcafter.c" + +#line 1 "mcstas-r.c" +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Runtime: share/mcstas-r.c +* +* %Identification +* Written by: KN +* Date: Aug 29, 1997 +* Release: McStas 1.6 +* Version: 1.7 +* +* Runtime system for McStas. +* Embedded within instrument in runtime mode. +* +* Usage: Automatically embbeded in the c code whenever required. +* +* $Id: dmcafter.c,v 1.2 2007-02-12 01:19:07 ffr Exp $ +* +* $Log: not supported by cvs2svn $ +* Revision 1.1.2.1 2007/02/06 04:03:21 ffr +* PSI Update +* +* Revision 1.1 2007/01/30 03:19:43 koennecke +* - Fixed state monitor eclipse commit problems. Siiiiiiiggggghhhhhh! +* +* Revision 1.85 2004/03/05 17:43:47 farhi +* Default instr parameters are now correctly handled in all instrument usage cases. +* +* Revision 1.84 2004/03/03 13:41:23 pkwi +* Corrected error in relation to instrument default values: 0's were used in all cases. +* +* Revision 1.83 2004/02/26 12:53:27 farhi +* Scilab format now enables more than one monitor file for a single component +* (e.g. Monitor_nD with multiple detectors). +* +* Revision 1.82 2004/02/23 12:48:42 farhi +* Additional check for default value and unset parameters +* +* Revision 1.81 2004/02/19 14:42:52 farhi +* Experimental Octave/OpenGENIE output format (for ISIS) +* +* Revision 1.80 2004/01/23 16:14:12 pkwi +* Updated version of Mersenne Twister algorithm. make test'ed ok on my machine. +* +* Revision 1.79 2003/11/28 18:08:32 farhi +* Corrected error for IDL import +* +* Revision 1.77 2003/10/22 15:51:26 farhi +* -i also displays default parameter values (if any), which may be +* read by mcgui for init of Run Simulation dialog +* +* Revision 1.76 2003/10/22 09:18:00 farhi +* Solved name conflict problem for Matlab/Scilab by adding 'mc_' prefix +* to all component/file field names. Works ok for both, and also in binary. +* +* Revision 1.75 2003/10/21 14:08:12 pkwi +* Rectangular focusing improved: Renamed randvec_target_rect to randvec_target_rect_angular. Wrote new randvec_target_rect routine, w/h in metres. Both routines use use component orientation (ROT_A_CURRENT_COMP) as input. +* +* Modifications to Res_sample and V_sample to match new features of the runtime. +* +* Revision 1.74 2003/10/21 11:54:48 farhi +* instrument default parameter value handling now works better +* either from args or from mcreadparam (prompt) +* +* Revision 1.73 2003/09/05 08:59:17 farhi +* added INSTRUMENT parameter default value grammar +* mcinputtable now has also default values +* mcreadpar now uses default values if parameter not given +* extended instr_formal parameter struct +* extended mcinputtable structure type +* +* Revision 1.72 2003/08/26 12:32:43 farhi +* Corrected 4PI random vector generation to retain initial vector length +* +* Revision 1.71 2003/08/20 09:25:00 farhi +* Add the instrument Source tag in scan files (origin of data !) +* +* Revision 1.70 2003/08/12 13:35:52 farhi +* displays known signals list in instrument help (-h) +* +* Revision 1.68 2003/06/17 14:21:54 farhi +* removed 'clear %4$s' in Scilab/Matlab 'end of section' format which +* caused pb when comp_name == file_name +* +* Revision 1.67 2003/06/12 10:22:00 farhi +* -i show info as McStas format, --info use MCSTAS_FORMAT or --format setting +* +* Revision 1.66 2003/06/10 11:29:58 pkwi +* Corrected multiple parse errors: Added two missing sets of curly brackets { } in parameter parsing function. +* +* Revision 1.65 2003/06/05 09:25:59 farhi +* restore header support in data files when --format option found +* +* Revision 1.64 2003/05/26 10:21:00 farhi +* Correct core dump for instrument STRING parameters in 'string printer' +* +* Revision 1.63 2003/05/20 11:54:38 farhi +* make sighandler not restart SAVE when already saving (USR2) +* +* Revision 1.62 2003/05/16 12:13:03 farhi +* added path rehash for Matlab mcload_inline +* +* Revision 1.61 2003/04/25 16:24:44 farhi +* corrected 4PI scattering from randvec_* functions causing mcdisplay to crash +* when using (0,0,0) vector for coordinate transformations +* +* Revision 1.60 2003/04/16 14:55:47 farhi +* Major change in saving data so that it's shown just like PGPLOT +* and axes+labels should follow data orientation (if transposed) +* when in binary mode, sets -a as default. Use +a to force text header +* +* Revision 1.59 2003/04/09 15:51:33 farhi +* Moved MCSTAS_FORMAT define +* +* Revision 1.58 2003/04/08 18:55:56 farhi +* Made XML format more NeXus compliant +* +* Revision 1.57 2003/04/07 11:50:50 farhi +* Extended the way mcplot:plotter is assigned. Set --portable ok +* Handle Scilab:Tk and ~GTk menu (shifted) +* Updated help in mcrun and mcstas-r.c +* +* Revision 1.56 2003/04/04 18:36:12 farhi +* Corrected $ and % chars for IDL format, conflicting with pfprintf (Dec/SGI) +* +* Revision 1.55 2003/04/04 15:11:08 farhi +* Use MCSTAS_FORMAT env var for default plotter, or use mcstas_config +* Corrected strlen(NULL pointer) for getenv(MCSTAS_FORMAT)==NULL +* +* Revision 1.54 2003/04/04 14:26:25 farhi +* Managed --no-runtime to work. Use MCSTAS_FORMAT env/define for default format +* Make --no-output-files still print out the integrated counts +* +* Revision 1.53 2003/02/18 09:10:52 farhi +* Just changed a message (warning for -a flag binary) +* +* Revision 1.51 2003/02/11 12:28:46 farhi +* Variouxs bug fixes after tests in the lib directory +* mcstas_r : disable output with --no-out.. flag. Fix 1D McStas output +* read_table:corrected MC_SYS_DIR -> MCSTAS define +* monitor_nd-lib: fix Log(signal) log(coord) +* HOPG.trm: reduce 4000 points -> 400 which is enough and faster to resample +* Progress_bar: precent -> percent parameter +* CS: ---------------------------------------------------------------------- +* +* Revision 1.50 2003/02/06 14:25:05 farhi +* Made --no-output-files work again and 1D McStas data 4 columns again +* +* : ---------------------------------------------------------------------- +* +* Revision 1.7 2002/10/19 22:46:21 ef +* gravitation for all with -g. Various output formats. +* +* Revision 1.6 2002/09/17 12:01:21 ef +* changed randvec_target_sphere to circle +* added randvec_target_rect +* +* Revision 1.5 2002/09/03 19:48:01 ef +* corrected randvec_target_sphere. created target_rect. +* +* Revision 1.4 2002/09/02 18:59:05 ef +* moved adapt_tree functions to independent lib. Updated sighandler. +* +* Revision 1.3 2002/08/28 11:36:37 ef +* Changed to lib/share/c code +* +* Revision 1.2 2001/10/10 11:36:37 ef +* added signal handler +* +* Revision 1.1 1998/08/29 11:36:37 kn +* Initial revision +* +*******************************************************************************/ + +#include +#include +#include +#include + +#ifndef MCSTAS_R_H +#include "mcstas-r.h" +#endif + + +#ifdef MC_ANCIENT_COMPATIBILITY +int mctraceenabled = 0; +int mcdefaultmain = 0; +#endif + +static long mcseed = 0; +mcstatic int mcdotrace = 0; +static int mcascii_only = 0; +static int mcdisable_output_files = 0; +static int mcsingle_file= 0; +mcstatic int mcgravitation = 0; +static long mcstartdate = 0; + +mcstatic FILE *mcsiminfo_file = NULL; +static char *mcdirname = NULL; +static char *mcsiminfo_name= "mcstas"; +mcstatic char mcsig_message[256]; /* ADD: E. Farhi, Sep 20th 2001 */ + +/* Multiple output format support. ========================================== */ + +#define mcNUMFORMATS 8 +#ifndef MCSTAS_FORMAT +#define MCSTAS_FORMAT "McStas" /* default format */ +#endif + +mcstatic struct mcformats_struct mcformat; + +mcstatic struct mcformats_struct mcformats[mcNUMFORMATS] = { + { "McStas", "sim", + "%1$sFormat: %4$s file\n" + "%1$sURL: http://neutron.risoe.dk/\n" + "%1$sEditor: %6$s\n" + "%1$sCreator:%2$s simulation (McStas " MCSTAS_VERSION ")\n" + "%1$sDate: Simulation started (%8$li) %5$s\n" + "%1$sFile: %3$s\n", + "%1$sEndDate:%5$s\n", + "%1$sbegin %2$s\n", + "%1$send %2$s\n", + "%1$s%3$s: %4$s\n", + "", + "%1$sErrors [%2$s/%4$s]: \n", + "%1$sEvents [%2$s/%4$s]: \n", + "", "", "" }, + { "Scilab", "sci", + "function mc_%7$s = get_%7$s(p)\n" + "// %4$s function issued from McStas on %5$s\n" + "// McStas simulation %2$s: %3$s" MC_PATHSEP_S "%4$s\n" + "// import data using exec('%7$s.sci',-1); s=get_%7$s('plot');\nmode(-1); //silent execution\n" + "if argn(2) > 0, p=1; else p=0; end\n" + "mc_%7$s = struct();\n" + "mc_%7$s.Format ='%4$s';\n" + "mc_%7$s.URL ='http://neutron.risoe.dk';\n" + "mc_%7$s.Editor ='%6$s';\n" + "mc_%7$s.Creator='%2$s McStas " MCSTAS_VERSION " simulation';\n" + "mc_%7$s.Date =%8$li; // for getdate\n" + "mc_%7$s.File ='%3$s';\n", + "mc_%7$s.EndDate=%8$li; // for getdate\nendfunction\n" + "function d=mcload_inline(d)\n" + "// local inline func to load data\n" + "execstr(['S=['+part(d.type,10:(length(d.type)-1))+'];']);\n" + "if ~length(d.data)\n" + " if ~length(strindex(d.format, 'binary'))\n" + " exec(d.filename,-1);p=d.parent;\n" + " if ~execstr('d2='+d.func+'();','errcatch'),d=d2; d.parent=p;end\n" + " else\n" + " if length(strindex(d.format, 'float')), t='f';\n" + " elseif length(strindex(d.format, 'double')), t='d';\n" + " else return; end\n" + " fid=mopen(d.filename, 'rb');\n" + " pS = prod(S);\n" + " x = mget(3*pS, t, fid);\n" + " d.data =matrix(x(1:pS), S);\n" + " if length(x) >= 3*pS,\n" + " d.errors=matrix(x((pS+1):(2*pS)), S);\n" + " d.events=matrix(x((2*pS+1):(3*pS)), S);end\n" + " mclose(fid);\n" + " return\n" + " end\n" + "end\n" + "endfunction\n" + "function d=mcplot_inline(d,p)\n" + "// local inline func to plot data\n" + "if ~length(strindex(d.type,'0d')), d=mcload_inline(d); end\n" + "if ~p, return; end;\n" + "execstr(['l=[',d.xylimits,'];']); S=size(d.data);\n" + "t1=['['+d.parent+'] '+d.filename+': '+d.title];t = [t1;[' '+d.variables+'=['+d.values+']'];[' '+d.signal];[' '+d.statistics]];\n" + "mprintf('%%s\\n',t(:));\n" + "if length(strindex(d.type,'0d')),return;\n" + "else\nw=winsid();if length(w),w=w($)+1; else w=0; end\n" + "xbasr(w); xset('window',w);\n" + "if length(strindex(d.type,'2d'))\n" + " d.x=linspace(l(1),l(2),S(2)); d.y=linspace(l(3),l(4),S(1)); z=d.data;\n" + " xlab=d.xlabel; ylab=d.ylabel; x=d.x; y=d.y;\n" + " fz=max(abs(z));fx=max(abs(d.x));fy=max(abs(d.y));\n" + " if fx>0,fx=round(log10(fx)); x=x/10^fx; xlab=xlab+' [*10^'+string(fx)+']'; end\n" + " if fy>0,fy=round(log10(fy)); y=y/10^fy; ylab=ylab+' [*10^'+string(fy)+']'; end\n" + " if fz>0,fz=round(log10(fz)); z=z/10^fz; t1=t1+' [*10^'+string(fz)+']'; end\n" + " xset('colormap',hotcolormap(64));\n" + " plot3d1(x,y,z',90,0,xlab+'@'+ylab+'@'+d.zlabel); xtitle(t);\n" + "else\nd.x=linspace(l(1),l(2),max(S));\n" + " plot2d(d.x,d.data);xtitle(t,d.xlabel,d.ylabel);end\nend\n" + "xname(t1);\nendfunction\n" + "mc_%7$s=get_%7$s();\n", + "// Section %2$s [%3$s] (level %7$d)\n" + "%1$st=[]; execstr('t=mc_%4$s.class','errcatch'); if ~length(t), mc_%4$s = struct(); end; mc_%4$s.class = '%2$s';", + "%1$smc_%6$s.mc_%4$s = 0; mc_%6$s.mc_%4$s = mc_%4$s;\n", + "%1$smc_%2$s.%3$s = '%4$s';\n", + "%1$smc_%2$s.func='get_%2$s';\n%1$smc_%2$s.data = [ ", + "%1$serrors = [ ", + "%1$sevents = [ ", + " ]; // end of data\n%1$sif length(mc_%2$s.data) == 0, single_file=0; else single_file=1; end\n%1$smc_%2$s=mcplot_inline(mc_%2$s,p);\n", + " ]; // end of errors\n%1$sif single_file == 1, mc_%2$s.errors=errors; end\n", + " ]; // end of events\n%1$sif single_file == 1, mc_%2$s.events=events; end\n"}, + { "Matlab", "m", + "function mc_%7$s = get_%7$s(p)\n" + "%% %4$s function issued from McStas on %5$s\n" + "%% McStas simulation %2$s: %3$s\n" + "%% import data using s=%7$s('plot');\n" + "if nargout == 0 | nargin > 0, p=1; else p=0; end\n" + "mc_%7$s.Format ='%4$s';\n" + "mc_%7$s.URL ='http://neutron.risoe.dk';\n" + "mc_%7$s.Editor ='%6$s';\n" + "mc_%7$s.Creator='%2$s McStas " MCSTAS_VERSION " simulation';\n" + "mc_%7$s.Date =%8$li; %% for datestr\n" + "mc_%7$s.File ='%3$s';\n", + "mc_%7$s.EndDate=%8$li; %% for datestr\n" + "function d=mcload_inline(d)\n" + "%% local inline function to load data\n" + "S=d.type; eval(['S=[ ' S(10:(length(S)-1)) ' ];']);\n" + "if isempty(d.data)\n" + " if ~length(findstr(d.format, 'binary'))\n" + " copyfile(d.filename,[d.func,'.m']);p=d.parent;path(path);\n" + " eval(['d=',d.func,';']);d.parent=p;delete([d.func,'.m']);\n" + " else\n" + " if length(findstr(d.format, 'float')), t='single';\n" + " elseif length(findstr(d.format, 'double')), t='double';\n" + " else return; end\n" + " if length(S) == 1, S=[S 1]; end\n" + " fid=fopen(d.filename, 'r');\n" + " pS = prod(S);\n" + " x = fread(fid, 3*pS, t);\n" + " d.data =reshape(x(1:pS), S);\n" + " if prod(size(x)) >= 3*pS,\n" + " d.errors=reshape(x((pS+1):(2*pS)), S);\n" + " d.events=reshape(x((2*pS+1):(3*pS)), S);end\n" + " fclose(fid);\n" + " return\n" + " end\n" + "end\n" + "return;\n" + "function d=mcplot_inline(d,p)\n" + "%% local inline function to plot data\n" + "if isempty(findstr(d.type,'0d')), d=mcload_inline(d); end\nif ~p, return; end;\n" + "eval(['l=[',d.xylimits,'];']); S=size(d.data);\n" + "t1=['[',d.parent,'] ',d.filename,': ',d.title];t = strvcat(t1,[' ',d.variables,'=[',d.values,']'],[' ',d.signal],[' ',d.statistics]);\n" + "disp(t);\n" + "if ~isempty(findstr(d.type,'0d')), return; end\n" + "figure; if ~isempty(findstr(d.type,'2d'))\n" + "d.x=linspace(l(1),l(2),S(2)); d.y=linspace(l(3),l(4),S(1));\n" + "surface(d.x,d.y,d.data);\n" + "else\nd.x=linspace(l(1),l(2),max(S));\nplot(d.x,d.data);end\n" + "xlabel(d.xlabel); ylabel(d.ylabel); title(t); axis tight;" + "set(gca,'position',[.18,.18,.7,.65]); set(gcf,'name',t1);grid on;\n" + "if ~isempty(findstr(d.type,'2d')), colorbar; end\n", + "%% Section %2$s [%3$s] (level %7$d)\n" + "mc_%4$s.class = '%2$s';", + "mc_%6$s.mc_%4$s = mc_%4$s;\n", + "%1$smc_%2$s.%3$s = '%4$s';\n", + "%1$smc_%2$s.func='%2$s';\n%1$smc_%2$s.data = [ ", + "%1$serrors = [ ", + "%1$sevents = [ ", + " ]; %% end of data\nif length(mc_%2$s.data) == 0, single_file=0; else single_file=1; end\nmc_%2$s=mcplot_inline(mc_%2$s,p);\n", + " ]; %% end of errors\nif single_file, mc_%2$s.errors=errors; end\n", + " ]; %% end of events\nif single_file, mc_%2$s.events=events; end\n"}, + { "IDL", "pro", + "function mcload_inline,d\n" + "; local inline function to load external data\n" + "S=d.type & a=execute('S=long(['+strmid(S,9,strlen(S)-10)+'])')\n" + "if strpos(d.format, 'binary') lt 0 then begin\n" + " p=d.parent\n" + " x=read_binary(d.filename)\n" + " get_lun, lun\n" + " openw,lun,d.func+'.pro'\n" + " writeu, lun,x\n" + " free_lun,lun\n" + " resolve_routine, d.func, /is_func, /no\n" + " d=call_function(d.func)\n" + "endif else begin\n" + " if strpos(d.format, 'float') ge 0 then t=4 $\n" + " else if strpos(d.format, 'double') ge 0 then t=5 $\n" + " else return,d\n" + " x=read_binary(d.filename, data_type=t)\n" + " pS=n_elements(S)\nif pS eq 1 then pS=long(S) $\n" + " else if pS eq 2 then pS=long(S(0)*S(1)) $\n" + " else pS=long(S(0)*S(1)*S(2))\n" + " pS=pS(0)\nstv,d,'data',reform(x(0:(pS-1)),S)\n" + " d.data=transpose(d.data)\n" + " if n_elements(x) ge long(3*pS) then begin\n" + " stv,d,'errors',reform(x(pS:(2*pS-1)),S)\n" + " stv,d,'events',reform(x((2*pS):(3*pS-1)),S)\n" + " d.errors=transpose(d.errors)\n" + " d.events=transpose(d.events)\n" + " endif\n" + "endelse\n" + "return,d\nend ; FUN load\n" + "function mcplot_inline,d,p\n" + "; local inline function to plot data\n" + "if size(d.data,/typ) eq 7 and strpos(d.type,'0d') lt 0 then d=mcload_inline(d)\n" + "if p eq 0 or strpos(d.type,'0d') ge 0 then return, d\n" + "S=d.type & a=execute('S=long(['+strmid(S,9,strlen(S)-10)+'])')\n" + "stv,d,'data',reform(d.data,S,/over)\n" + "if total(strpos(tag_names(d),'ERRORS')+1) gt 0 then begin\n" + " stv,d,'errors',reform(d.errors,S,/over)\n" + " stv,d,'events',reform(d.events,S,/over)\n" + "endif\n" + "d.xylimits=strjoin(strsplit(d.xylimits,' ',/extract),',') & a=execute('l=['+d.xylimits+']')\n" + "t1='['+d.parent+'] '+d.filename+': '+d.title\n" + "t=[t1,' '+d.variables+'=['+d.values+']',' '+d.signal,' '+d.statistics]\n" + "print,t\n" + "if strpos(d.type,'0d') ge 0 then return,d\n" + "d.xlabel=strjoin(strsplit(d.xlabel,'`!\"£^&*()-+=|\\,.<>/?@''~#{[}]',/extract),'_')\n" + "d.ylabel=strjoin(strsplit(d.ylabel,'`!\"£^&*()-+=|\\,.<>/?@''~#{[}]',/extract),'_')\n" + "stv,d,'x',l(0)+indgen(S(0))*(l(1)-l(0))/S(0)\n" + "if strpos(d.type,'2d') ge 0 then begin\n" + " name={DATA:d.func,IX:d.xlabel,IY:d.ylabel}\n" + " stv,d,'y',l(2)+indgen(S(1))*(l(3)-l(2))/S(1)\n" + " live_surface,d.data,xindependent=d.x,yindependent=d.y,name=name,reference_out=Win\n" + "endif else begin\n" + " name={DATA:d.func,I:d.xlabel}\n" + " live_plot,d.data,independent=d.x,name=name,reference_out=Win\n" + "endelse\n" + "live_text,t,Window_In=Win.Win,location=[0.3,0.9]\n" + "return,d\nend ; FUN plot\n" + "pro stv,S,T,V\n" + "; procedure set-tag-value that does S.T=V\n" + "sv=size(V)\n" + "T=strupcase(T)\n" + "TL=strupcase(tag_names(S))\n" + "id=where(TL eq T)\n" + "sz=[0,0,0]\n" + "vd=n_elements(sv)-2\n" + "type=sv[vd]\n" + "if id(0) ge 0 then d=execute('sz=SIZE(S.'+T+')')\n" + "if (sz(sz(0)+1) ne sv(sv(0)+1)) or (sz(0) ne sv(0)) $\n" + " or (sz(sz(0)+2) ne sv(sv(0)+2)) $\n" + " or type eq 8 then begin\n" + " ES = ''\n" + " for k=0,n_elements(TL)-1 do begin\n" + " case TL(k) of\n" + " T:\n" + " else: ES=ES+','+TL(k)+':S.'+TL(k)\n" + " endcase\n" + " endfor\n" + " d=execute('S={'+T+':V'+ES+'}')\n" + "endif else d=execute('S.'+T+'=V')\n" + "end ; PRO stv\n" + "function %7$s,plot=plot\n" + "; %4$s function issued from McStas on %5$s\n" + "; McStas simulation %2$s: %3$s\n" + "; import using s=%7$s(/plot)\n" + "if keyword_set(plot) then p=1 else p=0\n" + "%7$s={Format:'%4$s',URL:'http://neutron.risoe.dk'," + "Editor:'%6$s',$\n" + "Creator:'%2$s McStas " MCSTAS_VERSION " simulation',$\n" + "Date:%8$li," + "File:'%3$s'}\n", + "stv,%7$s,'EndDate',%8$li ; for systime\nreturn, %7$s\nend\n", + "; Section %2$s [%3$s] (level %7$d)\n" + "%1$s%4$s={class:'%2$s'}\n", + "%1$sstv,%6$s,'%4$s',%4$s\n", + "%1$sstv,%2$s,'%3$s','%4$s'\n", + "%1$sstv,%2$s,'func','%2$s' & data=[ ", + "%1$sif single_file ne 0 then begin errors=[ ", + "%1$sif single_file ne 0 then begin events=[ ", + " ]\n%1$sif size(data,/type) eq 7 then single_file=0 else single_file=1\n" + "%1$sstv,%2$s,'data',data & data=0 & %2$s=mcplot_inline(%2$s,p)\n", + " ]\n%1$sstv,%2$s,'errors',reform(errors,%14$d,%15$d,/over) & errors=0\n%1$sendif\n", + " ]\n%1$sstv,%2$s,'events',reform(events,%14$d,%15$d,/over) & events=0\n%1$sendif\n\n"}, + { "XML", "xml", + "\n\n" + "\n" + "%5$s\n", + "%5$s\n\n", + "%1$s\n", + "%1$s\n", + "%1$s<%3$s>%4$s\n", + "%1$s<%6$s long_name=\"%5$s\" axis=\"1\" primary=\"1\" min=\"%17$g\"" + " max=\"%18$g\" dims=\"%14$d\" range=\"1\">\n" + "%1$s<%8$s long_name=\"%7$s\" axis=\"2\" primary=\"1\" min=\"%19$g\"" + " max=\"%20$g\" dims=\"%15$d\" range=\"1\">\n" + "%1$s<%10$s long_name=\"%9$s\" axis=\"3\" primary=\"1\" min=\"%21$g\"" + " max=\"%22$g\" dims=\"%16$d\" range=\"1\">\n" + "%1$s", + "%1$s", "%1$s", + "%1$s\n", "%1$s\n", "%1$s\n"}, + { "HTML", "html", + "\n" + "\n" + "\n" + "\n" + "[McStas %2$s]%3$s\n" + "

" + "McStas simulation %2$s: %3$s


\n" + "This simulation report was automatically created by" + " McStas " MCSTAS_VERSION "
\n" + "
User:   %6$s
\n"
+        "%1$sCreator: %2$s McStas simulation
\n"
+        "%1$sDate:    (%8$li) %5$s
\n", + "EndDate: (%8$li) %5$s
\n", + "%1$s%2$s %3$s " + "[child of %5$s]
\n" + "%1$sAssociated data file %3$s
\n" + "%1$sAssociated %2$s image %3$s.png
(when available)\n" + "%1$s\"%2$s
\n", + "[end of %2$s %3$s]
\n", + "%1$s%3$s: %4$s
\n", + "%1$sDATA
\n", + "%1$sERRORS
\n","%1$sEVENTS
\n", + "%1$sEnd of DATA
\n", "%1$sEnd of ERRORS
\n", "%1$sEnd of EVENTS
\n"}, + { "OpenGENIE", "gcl", + "PROCEDURE get_%7$s\n" + "RESULT %7$s\n" + "# %4$s procedure issued from McStas on %5$s\n" + "# McStas simulation %2$s: %3$s" MC_PATHSEP_S "%4$s\n" + "# import data using s=get_%7$s();\n" + "%7$s = fields();\n" + "%7$s.Format =\"%4$s\";\n" + "%7$s.URL =\"http://neutron.risoe.dk\";\n" + "%7$s.Editor =\"%6$s\";\n" + "%7$s.Creator=\"%2$s McStas " MCSTAS_VERSION " simulation\";\n" + "%7$s.Date =%8$li;\n" + "%7$s.File =\"%3$s\";\n", + "%7$s.EndDate=%8$li;\nENDPROCEDURE\n", + "# Section %2$s [%3$s] (level %7$d)\n" + "%1$s%4$s = fields(); %4$s.class = \"%2$s\";", + "%1$s%6$s.%4$s = %4$s; free \"%4$s\";\n", + "%1$s%2$s.%3$s = \"%4$s\";\n", + "%1$s%2$s.func=\"get_%2$s\";\n%1$s%2$s.data = [ ", + "%1$sIF (single_file = 1); %2$s.errors = [ ", + "%1$sIF (single_file = 1); %2$s.ncount = [ ", + " ] array(%14$d,%15$d); # end of data\nIF (length(%2$s.data) = 0); single_file=0; ELSE single_file=1; ENDIF\n%2$s=mcplot_inline(%2$s,p);\n", + " ] array(%14$d,%15$d); # end of errors\nENDIF\n", + " ] array(%14$d,%15$d); # end of ncount\nENDIF\n"}, + { "Octave", "m", + "function mc_%7$s = get_%7$s(p)\n" + "%% %4$s function issued from McStas on %5$s\n" + "%% McStas simulation %2$s: %3$s\n" + "%% import data using s=%7$s('plot');\n" + "if nargin > 0, p=1; else p=0; end\n" + "mc_%7$s.Format ='%4$s';\n" + "mc_%7$s.URL ='http://neutron.risoe.dk';\n" + "mc_%7$s.Editor ='%6$s';\n" + "mc_%7$s.Creator='%2$s McStas " MCSTAS_VERSION " simulation';\n" + "mc_%7$s.Date =%8$li; %% for datestr\n" + "mc_%7$s.File ='%3$s';\n", + "mc_%7$s.EndDate=%8$li; %% for datestr\nendfunction\n" + "if exist('mcload_inline'), return; end\n" + "function d=mcload_inline(d)\n" + "%% local inline function to load data\n" + "S=d.type; eval(['S=[ ' S(10:(length(S)-1)) ' ];']);\n" + "if isempty(d.data)\n" + " if ~length(findstr(d.format, 'binary'))\n" + " source(d.filename);p=d.parent;\n" + " eval(['d=get_',d.func,';']);d.parent=p;\n" + " else\n" + " if length(findstr(d.format, 'float')), t='float';\n" + " elseif length(findstr(d.format, 'double')), t='double';\n" + " else return; end\n" + " if length(S) == 1, S=[S 1]; end\n" + " fid=fopen(d.filename, 'r');\n" + " pS = prod(S);\n" + " x = fread(fid, 3*pS, t);\n" + " d.data =reshape(x(1:pS), S);\n" + " if prod(size(x)) >= 3*pS,\n" + " d.errors=reshape(x((pS+1):(2*pS)), S);\n" + " d.events=reshape(x((2*pS+1):(3*pS)), S);end\n" + " fclose(fid);\n" + " return\n" + " end\n" + "end\n" + "return;\nendfunction\n\n" + "function d=mcplot_inline(d,p)\n" + "%% local inline function to plot data\n" + "if isempty(findstr(d.type,'0d')), d=mcload_inline(d); end\nif ~p, return; end;\n" + "eval(['l=[',d.xylimits,'];']); S=size(d.data);\n" + "t1=['[',d.parent,'] ',d.filename,': ',d.title];t = strcat(t1,[' ',d.variables,'=[',d.values,']'],[' ',d.signal],[' ',d.statistics]);\n" + "disp(t);\n" + "if ~isempty(findstr(d.type,'0d')), return; end\n" + "xlabel(d.xlabel); ylabel(d.ylabel); title(t);" + "figure; if ~isempty(findstr(d.type,'2d'))\n" + "d.x=linspace(l(1),l(2),S(2)); d.y=linspace(l(3),l(4),S(1));\n" + "mesh(d.x,d.y,d.data);\n" + "else\nd.x=linspace(l(1),l(2),max(S));\nplot(d.x,d.data);end\nendfunction\n", + "%% Section %2$s [%3$s] (level %7$d)\n" + "mc_%4$s.class = '%2$s';", + "mc_%6$s.mc_%4$s = mc_%4$s;\n", + "%1$smc_%2$s.%3$s = '%4$s';\n", + "%1$smc_%2$s.func='%2$s';\n%1$smc_%2$s.data = [ ", + "%1$serrors = [ ", + "%1$sevents = [ ", + " ]; %% end of data\nif length(mc_%2$s.data) == 0, single_file=0; else single_file=1; end\nmc_%2$s=mcplot_inline(mc_%2$s,p);\n", + " ]; %% end of errors\nif single_file, mc_%2$s.errors=errors; end\n", + " ]; %% end of events\nif single_file, mc_%2$s.events=events; end\n"} + }; + +/* MCDISPLAY support. ======================================================= */ + +void mcdis_magnify(char *what){ + printf("MCDISPLAY: magnify('%s')\n", what); +} + +void mcdis_line(double x1, double y1, double z1, + double x2, double y2, double z2){ + printf("MCDISPLAY: multiline(2,%g,%g,%g,%g,%g,%g)\n", + x1,y1,z1,x2,y2,z2); +} + +void mcdis_multiline(int count, ...){ + va_list ap; + double x,y,z; + + printf("MCDISPLAY: multiline(%d", count); + va_start(ap, count); + while(count--) + { + x = va_arg(ap, double); + y = va_arg(ap, double); + z = va_arg(ap, double); + printf(",%g,%g,%g", x, y, z); + } + va_end(ap); + printf(")\n"); +} + +void mcdis_circle(char *plane, double x, double y, double z, double r){ + printf("MCDISPLAY: circle('%s',%g,%g,%g,%g)\n", plane, x, y, z, r); +} + +/* coordinates handling ===================================================== */ + +/******************************************************************************* +* Since we use a lot of geometric calculations using Cartesian coordinates, +* we collect some useful routines here. However, it is also permissible to +* work directly on the underlying struct coords whenever that is most +* convenient (that is, the type Coords is not abstract). +* +* Coordinates are also used to store rotation angles around x/y/z axis. +* +* Since coordinates are used much like a basic type (such as double), the +* structure itself is passed and returned, rather than a pointer. +* +* At compile-time, the values of the coordinates may be unknown (for example +* a motor position). Hence coordinates are general expressions and not simple +* numbers. For this we used the type Coords_exp which has three CExp +* fields. For runtime (or calculations possible at compile time), we use +* Coords which contains three double fields. +*******************************************************************************/ + +/* Assign coordinates. */ +Coords +coords_set(MCNUM x, MCNUM y, MCNUM z) +{ + Coords a; + + a.x = x; + a.y = y; + a.z = z; + return a; +} + +Coords +coords_get(Coords a, MCNUM *x, MCNUM *y, MCNUM *z) +{ + *x = a.x; + *y = a.y; + *z = a.z; + return a; +} + +/* Add two coordinates. */ +Coords +coords_add(Coords a, Coords b) +{ + Coords c; + + c.x = a.x + b.x; + c.y = a.y + b.y; + c.z = a.z + b.z; + return c; +} + +/* Subtract two coordinates. */ +Coords +coords_sub(Coords a, Coords b) +{ + Coords c; + + c.x = a.x - b.x; + c.y = a.y - b.y; + c.z = a.z - b.z; + return c; +} + +/* Negate coordinates. */ +Coords +coords_neg(Coords a) +{ + Coords b; + + b.x = -a.x; + b.y = -a.y; + b.z = -a.z; + return b; +} + +/******************************************************************************* +* The Rotation type implements a rotation transformation of a coordinate +* system in the form of a double[3][3] matrix. +* +* Contrary to the Coords type in coords.c, rotations are passed by +* reference. Functions that yield new rotations do so by writing to an +* explicit result parameter; rotations are not returned from functions. The +* reason for this is that arrays cannot by returned from functions (though +* structures can; thus an alternative would have been to wrap the +* double[3][3] array up in a struct). Such are the ways of C programming. +* +* A rotation represents the tranformation of the coordinates of a vector when +* changing between coordinate systems that are rotated with respect to each +* other. For example, suppose that coordinate system Q is rotated 45 degrees +* around the Z axis with respect to coordinate system P. Let T be the +* rotation transformation representing a 45 degree rotation around Z. Then to +* get the coordinates of a vector r in system Q, apply T to the coordinates +* of r in P. If r=(1,0,0) in P, it will be (sqrt(1/2),-sqrt(1/2),0) in +* Q. Thus we should be careful when interpreting the sign of rotation angles: +* they represent the rotation of the coordinate systems, not of the +* coordinates (which has opposite sign). +*******************************************************************************/ + +/******************************************************************************* +* Get transformation for rotation first phx around x axis, then phy around y, +* then phz around z. +*******************************************************************************/ +void +rot_set_rotation(Rotation t, double phx, double phy, double phz) +{ + double cx = cos(phx); + double sx = sin(phx); + double cy = cos(phy); + double sy = sin(phy); + double cz = cos(phz); + double sz = sin(phz); + + t[0][0] = cy*cz; + t[0][1] = sx*sy*cz + cx*sz; + t[0][2] = sx*sz - cx*sy*cz; + t[1][0] = -cy*sz; + t[1][1] = cx*cz - sx*sy*sz; + t[1][2] = sx*cz + cx*sy*sz; + t[2][0] = sy; + t[2][1] = -sx*cy; + t[2][2] = cx*cy; +} + +/******************************************************************************* +* Matrix multiplication of transformations (this corresponds to combining +* transformations). After rot_mul(T1, T2, T3), doing T3 is equal to doing +* first T2, then T1. +* Note that T3 must not alias (use the same array as) T1 or T2. +*******************************************************************************/ +void +rot_mul(Rotation t1, Rotation t2, Rotation t3) +{ + int i,j; + + for(i = 0; i < 3; i++) + for(j = 0; j < 3; j++) + t3[i][j] = t1[i][0]*t2[0][j] + t1[i][1]*t2[1][j] + t1[i][2]*t2[2][j]; +} + +/******************************************************************************* +* Copy a rotation transformation (needed since arrays cannot be assigned in C). +*******************************************************************************/ +void +rot_copy(Rotation dest, Rotation src) +{ + dest[0][0] = src[0][0]; + dest[0][1] = src[0][1]; + dest[0][2] = src[0][2]; + dest[1][0] = src[1][0]; + dest[1][1] = src[1][1]; + dest[1][2] = src[1][2]; + dest[2][0] = src[2][0]; + dest[2][1] = src[2][1]; + dest[2][2] = src[2][2]; +} + +void +rot_transpose(Rotation src, Rotation dst) +{ + dst[0][0] = src[0][0]; + dst[0][1] = src[1][0]; + dst[0][2] = src[2][0]; + dst[1][0] = src[0][1]; + dst[1][1] = src[1][1]; + dst[1][2] = src[2][1]; + dst[2][0] = src[0][2]; + dst[2][1] = src[1][2]; + dst[2][2] = src[2][2]; +} + +Coords +rot_apply(Rotation t, Coords a) +{ + Coords b; + + b.x = t[0][0]*a.x + t[0][1]*a.y + t[0][2]*a.z; + b.y = t[1][0]*a.x + t[1][1]*a.y + t[1][2]*a.z; + b.z = t[2][0]*a.x + t[2][1]*a.y + t[2][2]*a.z; + return b; +} + +void +mccoordschange(Coords a, Rotation t, double *x, double *y, double *z, + double *vx, double *vy, double *vz, double *time, + double *s1, double *s2) +{ + Coords b, c; + + b.x = *x; + b.y = *y; + b.z = *z; + c = rot_apply(t, b); + b = coords_add(c, a); + *x = b.x; + *y = b.y; + *z = b.z; + + b.x = *vx; + b.y = *vy; + b.z = *vz; + c = rot_apply(t, b); + *vx = c.x; + *vy = c.y; + *vz = c.z; + /* ToDo: What to do about the spin? */ +} + + +void +mccoordschange_polarisation(Rotation t, double *sx, double *sy, double *sz) +{ + Coords b, c; + + b.x = *sx; + b.y = *sy; + b.z = *sz; + c = rot_apply(t, b); + *sx = c.x; + *sy = c.y; + *sz = c.z; +} + +void +mcstore_neutron(MCNUM *s, int index, double x, double y, double z, + double vx, double vy, double vz, double t, + double sx, double sy, double sz, double p) +{ + s[11*index+1] = x ; + s[11*index+2] = y ; + s[11*index+3] = z ; + s[11*index+4] = vx; + s[11*index+5] = vy; + s[11*index+6] = vz; + s[11*index+7] = t ; + s[11*index+8] = sx; + s[11*index+9] = sy; + s[11*index+10] = sz; + s[11*index+0] = p ; +} + +void +mcrestore_neutron(MCNUM *s, int index, double *x, double *y, double *z, + double *vx, double *vy, double *vz, double *t, + double *sx, double *sy, double *sz, double *p) +{ + *x = s[11*index+1] ; + *y = s[11*index+2] ; + *z = s[11*index+3] ; + *vx = s[11*index+4] ; + *vy = s[11*index+5] ; + *vz = s[11*index+6] ; + *t = s[11*index+7] ; + *sx = s[11*index+8] ; + *sy = s[11*index+9] ; + *sz = s[11*index+10] ; + *p = s[11*index+0]; +} + + +double +mcestimate_error(double N, double p1, double p2) +{ + double pmean, n1; + if(N <= 1) + return p1; + pmean = p1 / N; + n1 = N - 1; + /* Note: underflow may cause p2 to become zero; the fabs() below guards + against this. */ + return sqrt((N/n1)*fabs(p2 - pmean*pmean)); +} + +/* parameters handling ====================================================== */ + +/* Instrument input parameter type handling. */ +static int +mcparm_double(char *s, void *vptr) +{ + char *p; + double *v = (double *)vptr; + + if (!s) { *v = 0; return(1); } + *v = strtod(s, &p); + if(*s == '\0' || (p != NULL && *p != '\0') || errno == ERANGE) + return 0; /* Failed */ + else + return 1; /* Success */ +} + + +static char * +mcparminfo_double(char *parmname) +{ + return "double"; +} + + +static void +mcparmerror_double(char *parm, char *val) +{ + fprintf(stderr, "Error: Invalid value '%s' for floating point parameter %s\n", + val, parm); +} + + +static void +mcparmprinter_double(char *f, void *vptr) +{ + double *v = (double *)vptr; + sprintf(f, "%g", *v); +} + + +static int +mcparm_int(char *s, void *vptr) +{ + char *p; + int *v = (int *)vptr; + long x; + + if (!s) { *v = 0; return(1); } + *v = 0; + x = strtol(s, &p, 10); + if(x < INT_MIN || x > INT_MAX) + return 0; /* Under/overflow */ + *v = x; + if(*s == '\0' || (p != NULL && *p != '\0') || errno == ERANGE) + return 0; /* Failed */ + else + return 1; /* Success */ +} + + +static char * +mcparminfo_int(char *parmname) +{ + return "int"; +} + + +static void +mcparmerror_int(char *parm, char *val) +{ + fprintf(stderr, "Error: Invalid value '%s' for integer parameter %s\n", + val, parm); +} + + +static void +mcparmprinter_int(char *f, void *vptr) +{ + int *v = (int *)vptr; + sprintf(f, "%d", *v); +} + + +static int +mcparm_string(char *s, void *vptr) +{ + char **v = (char **)vptr; + if (!s) { *v = NULL; return(1); } + *v = (char *)malloc(strlen(s) + 1); + if(*v == NULL) + { + fprintf(stderr, "Error: Out of memory (mcparm_string).\n"); + exit(1); + } + strcpy(*v, s); + return 1; /* Success */ +} + + +static char * +mcparminfo_string(char *parmname) +{ + return "string"; +} + + +static void +mcparmerror_string(char *parm, char *val) +{ + fprintf(stderr, "Error: Invalid value '%s' for string parameter %s\n", + val, parm); +} + + +static void +mcparmprinter_string(char *f, void *vptr) +{ + char **v = (char **)vptr; + char *p; + + if (!*v) { *f='\0'; return; } + strcpy(f, ""); + for(p = *v; *p != '\0'; p++) + { + switch(*p) + { + case '\n': + strcat(f, "\\n"); + break; + case '\r': + strcat(f, "\\r"); + break; + case '"': + strcat(f, "\\\""); + break; + case '\\': + strcat(f, "\\\\"); + break; + default: + strncat(f, p, 1); + } + } + /* strcat(f, "\""); */ +} + + +static struct + { + int (*getparm)(char *, void *); + char * (*parminfo)(char *); + void (*error)(char *, char *); + void (*printer)(char *, void *); + } mcinputtypes[] = + { + mcparm_double, mcparminfo_double, mcparmerror_double, + mcparmprinter_double, + mcparm_int, mcparminfo_int, mcparmerror_int, + mcparmprinter_int, + mcparm_string, mcparminfo_string, mcparmerror_string, + mcparmprinter_string + }; + +/* init/run/rand handling =================================================== */ + +void +mcreadparams(void) +{ + int i,j,status; + char buf[1024]; + char *p; + int len; + + printf("Instrument parameters for %s (%s)\n", mcinstrument_name, mcinstrument_source); + for(i = 0; mcinputtable[i].name != 0; i++) + { + do + { + if (mcinputtable[i].val && strlen(mcinputtable[i].val)) + printf("Set value of instrument parameter %s (%s) [default='%s']:\n", + mcinputtable[i].name, + (*mcinputtypes[mcinputtable[i].type].parminfo) + (mcinputtable[i].name), mcinputtable[i].val); + else + printf("Set value of instrument parameter %s (%s):\n", + mcinputtable[i].name, + (*mcinputtypes[mcinputtable[i].type].parminfo) + (mcinputtable[i].name)); + + fflush(stdout); + p = fgets(buf, 1024, stdin); + if(p == NULL) + { + fprintf(stderr, "Error: empty input for paramater %s\n", mcinputtable[i].name); + exit(1); + } + len = strlen(buf); + if (!len || (len == 1 && (buf[0] == '\n' || buf[0] == '\r'))) + { + if (mcinputtable[i].val && strlen(mcinputtable[i].val)) { + strncpy(buf, mcinputtable[i].val, 1024); /* use default value */ + len = strlen(buf); + } + } + for(j = 0; j < 2; j++) + { + if(len > 0 && (buf[len - 1] == '\n' || buf[len - 1] == '\r')) + { + len--; + buf[len] = '\0'; + } + } + + status = (*mcinputtypes[mcinputtable[i].type].getparm) + (buf, mcinputtable[i].par); + if(!status) + { + (*mcinputtypes[mcinputtable[i].type].error)(mcinputtable[i].name, buf); + if (!mcinputtable[i].val || strlen(mcinputtable[i].val)) { + fprintf(stderr, " Change %s default value in instrument definition.\n", mcinputtable[i].name); + exit(1); + } + } + } while(!status); + } +} + + + +void +mcsetstate(double x, double y, double z, double vx, double vy, double vz, + double t, double sx, double sy, double sz, double p) +{ + extern double mcnx, mcny, mcnz, mcnvx, mcnvy, mcnvz; + extern double mcnt, mcnsx, mcnsy, mcnsz, mcnp; + + mcnx = x; + mcny = y; + mcnz = z; + mcnvx = vx; + mcnvy = vy; + mcnvz = vz; + mcnt = t; + mcnsx = sx; + mcnsy = sy; + mcnsz = sz; + mcnp = p; +} + +void +mcgenstate(void) +{ + mcsetstate(0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1); +} + +/* McStas random number routine. */ + +/* + * Copyright (c) 1983 Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms are permitted + * provided that the above copyright notice and this paragraph are + * duplicated in all such forms and that any documentation, + * advertising materials, and other materials related to such + * distribution and use acknowledge that the software was developed + * by the University of California, Berkeley. The name of the + * University may not be used to endorse or promote products derived + * from this software without specific prior written permission. + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +/* + * This is derived from the Berkeley source: + * @(#)random.c 5.5 (Berkeley) 7/6/88 + * It was reworked for the GNU C Library by Roland McGrath. + * Rewritten to use reentrant functions by Ulrich Drepper, 1995. + */ + +/******************************************************************************* +* Modified for McStas from glibc 2.0.7pre1 stdlib/random.c and +* stdlib/random_r.c. +* +* This way random() is more than four times faster compared to calling +* standard glibc random() on ix86 Linux, probably due to multithread support, +* ELF shared library overhead, etc. It also makes McStas generated +* simulations more portable (more likely to behave identically across +* platforms, important for parrallel computations). +*******************************************************************************/ + + +#define TYPE_3 3 +#define BREAK_3 128 +#define DEG_3 31 +#define SEP_3 3 + +static mc_int32_t randtbl[DEG_3 + 1] = + { + TYPE_3, + + -1726662223, 379960547, 1735697613, 1040273694, 1313901226, + 1627687941, -179304937, -2073333483, 1780058412, -1989503057, + -615974602, 344556628, 939512070, -1249116260, 1507946756, + -812545463, 154635395, 1388815473, -1926676823, 525320961, + -1009028674, 968117788, -123449607, 1284210865, 435012392, + -2017506339, -911064859, -370259173, 1132637927, 1398500161, + -205601318, + }; + +static mc_int32_t *fptr = &randtbl[SEP_3 + 1]; +static mc_int32_t *rptr = &randtbl[1]; +static mc_int32_t *state = &randtbl[1]; +#define rand_deg DEG_3 +#define rand_sep SEP_3 +static mc_int32_t *end_ptr = &randtbl[sizeof (randtbl) / sizeof (randtbl[0])]; + +mc_int32_t +mc_random (void) +{ + mc_int32_t result; + + *fptr += *rptr; + /* Chucking least random bit. */ + result = (*fptr >> 1) & 0x7fffffff; + ++fptr; + if (fptr >= end_ptr) + { + fptr = state; + ++rptr; + } + else + { + ++rptr; + if (rptr >= end_ptr) + rptr = state; + } + return result; +} + +void +mc_srandom (unsigned int x) +{ + /* We must make sure the seed is not 0. Take arbitrarily 1 in this case. */ + state[0] = x ? x : 1; + { + long int i; + for (i = 1; i < rand_deg; ++i) + { + /* This does: + state[i] = (16807 * state[i - 1]) % 2147483647; + but avoids overflowing 31 bits. */ + long int hi = state[i - 1] / 127773; + long int lo = state[i - 1] % 127773; + long int test = 16807 * lo - 2836 * hi; + state[i] = test + (test < 0 ? 2147483647 : 0); + } + fptr = &state[rand_sep]; + rptr = &state[0]; + for (i = 0; i < 10 * rand_deg; ++i) + random (); + } +} + +/* "Mersenne Twister", by Makoto Matsumoto and Takuji Nishimura. */ +/* See http://www.math.keio.ac.jp/~matumoto/emt.html for original source. */ + + +/* + A C-program for MT19937, with initialization improved 2002/1/26. + Coded by Takuji Nishimura and Makoto Matsumoto. + + Before using, initialize the state by using mt_srandom(seed) + or init_by_array(init_key, key_length). + + Copyright (C) 1997 - 2002, Makoto Matsumoto and Takuji Nishimura, + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + 3. The names of its contributors may not be used to endorse or promote + products derived from this software without specific prior written + permission. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR + A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR + CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, + EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR + PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS + SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + + + Any feedback is very welcome. + http://www.math.keio.ac.jp/matumoto/emt.html + email: matumoto@math.keio.ac.jp +*/ + +#include + +/* Period parameters */ +#define N 624 +#define M 397 +#define MATRIX_A 0x9908b0dfUL /* constant vector a */ +#define UPPER_MASK 0x80000000UL /* most significant w-r bits */ +#define LOWER_MASK 0x7fffffffUL /* least significant r bits */ + +static unsigned long mt[N]; /* the array for the state vector */ +static int mti=N+1; /* mti==N+1 means mt[N] is not initialized */ + +/* initializes mt[N] with a seed */ +void mt_srandom(unsigned long s) +{ + mt[0]= s & 0xffffffffUL; + for (mti=1; mti> 30)) + mti); + /* See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier. */ + /* In the previous versions, MSBs of the seed affect */ + /* only MSBs of the array mt[]. */ + /* 2002/01/09 modified by Makoto Matsumoto */ + mt[mti] &= 0xffffffffUL; + /* for >32 bit machines */ + } +} + +/* initialize by an array with array-length */ +/* init_key is the array for initializing keys */ +/* key_length is its length */ +void init_by_array(init_key, key_length) +unsigned long init_key[], key_length; +{ + int i, j, k; + mt_srandom(19650218UL); + i=1; j=0; + k = (N>key_length ? N : key_length); + for (; k; k--) { + mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1664525UL)) + + init_key[j] + j; /* non linear */ + mt[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ + i++; j++; + if (i>=N) { mt[0] = mt[N-1]; i=1; } + if (j>=key_length) j=0; + } + for (k=N-1; k; k--) { + mt[i] = (mt[i] ^ ((mt[i-1] ^ (mt[i-1] >> 30)) * 1566083941UL)) + - i; /* non linear */ + mt[i] &= 0xffffffffUL; /* for WORDSIZE > 32 machines */ + i++; + if (i>=N) { mt[0] = mt[N-1]; i=1; } + } + + mt[0] = 0x80000000UL; /* MSB is 1; assuring non-zero initial array */ +} + +/* generates a random number on [0,0xffffffff]-interval */ +unsigned long mt_random(void) +{ + unsigned long y; + static unsigned long mag01[2]={0x0UL, MATRIX_A}; + /* mag01[x] = x * MATRIX_A for x=0,1 */ + + if (mti >= N) { /* generate N words at one time */ + int kk; + + if (mti == N+1) /* if mt_srandom() has not been called, */ + mt_srandom(5489UL); /* a default initial seed is used */ + + for (kk=0;kk> 1) ^ mag01[y & 0x1UL]; + } + for (;kk> 1) ^ mag01[y & 0x1UL]; + } + y = (mt[N-1]&UPPER_MASK)|(mt[0]&LOWER_MASK); + mt[N-1] = mt[M-1] ^ (y >> 1) ^ mag01[y & 0x1UL]; + + mti = 0; + } + + y = mt[mti++]; + + /* Tempering */ + y ^= (y >> 11); + y ^= (y << 7) & 0x9d2c5680UL; + y ^= (y << 15) & 0xefc60000UL; + y ^= (y >> 18); + + return y; +} + +#undef N +#undef M +#undef MATRIX_A +#undef UPPER_MASK +#undef LOWER_MASK + +/* End of "Mersenne Twister". */ + +/* End of McStas random number routine. */ + +double +randnorm(void) +{ + static double v1, v2, s; + static int phase = 0; + double X, u1, u2; + + if(phase == 0) + { + do + { + u1 = rand01(); + u2 = rand01(); + v1 = 2*u1 - 1; + v2 = 2*u2 - 1; + s = v1*v1 + v2*v2; + } while(s >= 1 || s == 0); + + X = v1*sqrt(-2*log(s)/s); + } + else + { + X = v2*sqrt(-2*log(s)/s); + } + + phase = 1 - phase; + return X; +} + +/* intersect handling ======================================================= */ + +/* Compute normal vector to (x,y,z). */ +void normal_vec(double *nx, double *ny, double *nz, + double x, double y, double z) +{ + double ax = fabs(x); + double ay = fabs(y); + double az = fabs(z); + double l; + if(x == 0 && y == 0 && z == 0) + { + *nx = 0; + *ny = 0; + *nz = 0; + return; + } + if(ax < ay) + { + if(ax < az) + { /* Use X axis */ + l = sqrt(z*z + y*y); + *nx = 0; + *ny = z/l; + *nz = -y/l; + return; + } + } + else + { + if(ay < az) + { /* Use Y axis */ + l = sqrt(z*z + x*x); + *nx = z/l; + *ny = 0; + *nz = -x/l; + return; + } + } + /* Use Z axis */ + l = sqrt(y*y + x*x); + *nx = y/l; + *ny = -x/l; + *nz = 0; +} + +/* If intersection with box dt_in and dt_out is returned */ +/* This function written by Stine Nyborg, 1999. */ +int box_intersect(double *dt_in, double *dt_out, + double x, double y, double z, + double vx, double vy, double vz, + double dx, double dy, double dz) +{ + double x_in, y_in, z_in, tt, t[6], a, b; + int i, count, s; + + /* Calculate intersection time for each of the six box surface planes + * If the box surface plane is not hit, the result is zero.*/ + + if(vx != 0) + { + tt = -(dx/2 + x)/vx; + y_in = y + tt*vy; + z_in = z + tt*vz; + if( y_in > -dy/2 && y_in < dy/2 && z_in > -dz/2 && z_in < dz/2) + t[0] = tt; + else + t[0] = 0; + + tt = (dx/2 - x)/vx; + y_in = y + tt*vy; + z_in = z + tt*vz; + if( y_in > -dy/2 && y_in < dy/2 && z_in > -dz/2 && z_in < dz/2) + t[1] = tt; + else + t[1] = 0; + } + else + t[0] = t[1] = 0; + + if(vy != 0) + { + tt = -(dy/2 + y)/vy; + x_in = x + tt*vx; + z_in = z + tt*vz; + if( x_in > -dx/2 && x_in < dx/2 && z_in > -dz/2 && z_in < dz/2) + t[2] = tt; + else + t[2] = 0; + + tt = (dy/2 - y)/vy; + x_in = x + tt*vx; + z_in = z + tt*vz; + if( x_in > -dx/2 && x_in < dx/2 && z_in > -dz/2 && z_in < dz/2) + t[3] = tt; + else + t[3] = 0; + } + else + t[2] = t[3] = 0; + + if(vz != 0) + { + tt = -(dz/2 + z)/vz; + x_in = x + tt*vx; + y_in = y + tt*vy; + if( x_in > -dx/2 && x_in < dx/2 && y_in > -dy/2 && y_in < dy/2) + t[4] = tt; + else + t[4] = 0; + + tt = (dz/2 - z)/vz; + x_in = x + tt*vx; + y_in = y + tt*vy; + if( x_in > -dx/2 && x_in < dx/2 && y_in > -dy/2 && y_in < dy/2) + t[5] = tt; + else + t[5] = 0; + } + else + t[4] = t[5] = 0; + + /* The intersection is evaluated and *dt_in and *dt_out are assigned */ + + a = b = s = 0; + count = 0; + + for( i = 0; i < 6; i = i + 1 ) + if( t[i] == 0 ) + s = s+1; + else if( count == 0 ) + { + a = t[i]; + count = 1; + } + else + { + b = t[i]; + count = 2; + } + + if ( a == 0 && b == 0 ) + return 0; + else if( a < b ) + { + *dt_in = a; + *dt_out = b; + return 1; + } + else + { + *dt_in = b; + *dt_out = a; + return 1; + } + +} + +/* Written by: EM,NB,ABA 4.2.98 */ +int +cylinder_intersect(double *t0, double *t1, double x, double y, double z, + double vx, double vy, double vz, double r, double h) +{ + double D, t_in, t_out, y_in, y_out; + int ret=1; + + D = (2*vx*x + 2*vz*z)*(2*vx*x + 2*vz*z) + - 4*(vx*vx + vz*vz)*(x*x + z*z - r*r); + + if (D>=0) + { + t_in = (-(2*vz*z + 2*vx*x) - sqrt(D))/(2*(vz*vz + vx*vx)); + t_out = (-(2*vz*z + 2*vx*x) + sqrt(D))/(2*(vz*vz + vx*vx)); + y_in = vy*t_in + y; + y_out =vy*t_out + y; + + if ( (y_in > h/2 && y_out > h/2) || (y_in < -h/2 && y_out < -h/2) ) + return 0; + else + { + if (y_in > h/2) + { t_in = ((h/2)-y)/vy; ret += 2; } + else if (y_in < -h/2) + { t_in = ((-h/2)-y)/vy; ret += 4; } + if (y_out > h/2) + { t_out = ((h/2)-y)/vy; ret += 8; } + else if (y_out < -h/2) + { t_out = ((-h/2)-y)/vy; ret += 16; } + } + *t0 = t_in; + *t1 = t_out; + return ret; + } + else + { + *t0 = *t1 = 0; + return 0; + } +} + + +/* Calculate intersection between line and sphere. */ +int +sphere_intersect(double *t0, double *t1, double x, double y, double z, + double vx, double vy, double vz, double r) +{ + double A, B, C, D, v; + + v = sqrt(vx*vx + vy*vy + vz*vz); + A = v*v; + B = 2*(x*vx + y*vy + z*vz); + C = x*x + y*y + z*z - r*r; + D = B*B - 4*A*C; + if(D < 0) + return 0; + D = sqrt(D); + *t0 = (-B - D) / (2*A); + *t1 = (-B + D) / (2*A); + return 1; +} + + +/* ADD: E. Farhi, Aug 6th, 2001 plane_intersect_Gfast + * intersection of a plane and a trajectory with gravitation + * this function calculates the intersection between a neutron trajectory + * and a plane with acceleration gx,gy,gz. The neutron starts at point x,y,z + * with velocity vx, vy, vz. The plane has a normal vector nx,ny,nz and + * contains the point wx,wy,wz + * The function returns 0 if no intersection occured after the neutron started + * and non 0 if there is an intersection. Then *Idt is the time until + * the neutron hits the roof. + * Let n=(nx,ny,nz) be the normal plane vector (one of the six sides) + * Let W=(wx,wy,wz) be Any point on this plane (for instance at z=0) + * The problem consists in solving the 2nd order equation: + * 1/2.n.g.t^2 + n.v.t + n.(r-W) = 0 (1) + * Without acceleration, t=-n.(r-W)/n.v + */ + +int plane_intersect_Gfast(double *Idt, + double A, double B, double C) +{ + /* plane_intersect_Gfast(&dt, A, B, C) + * A = 0.5 n.g; B = n.v; C = n.(r-W); + * no acceleration when A=0 + */ + int ret=0; + double dt0; + + *Idt = 0; + + if (B) dt0 = -C/B; + if (fabs(A) < 1E-10) /* this plane is parallel to the acceleration */ + { + if (B) + { *Idt = dt0; ret=3; } + /* else the speed is parallel to the plane, no intersection */ + } + else + { + double D, sD, dt1, dt2; + D = B*B - 4*A*C; + if (D >= 0) /* Delta > 0: neutron trajectory hits the mirror */ + { + sD = sqrt(D); + dt1 = (-B + sD)/2/A; + dt2 = (-B - sD)/2/A; + if (B) + { + if (fabs(dt0-dt1) < fabs(dt0-dt2)) ret=1; else ret=2; + } + else + { + if (dt1 <= dt2) ret=1; else ret=2; + } + if (ret==1) *Idt = dt1; + else if (ret==2) *Idt = dt2; + } /* else Delta <0: no intersection */ + } + return(ret); +} + + +/* Choose random direction towards target at (x,y,z) with given radius. */ +/* If radius is zero, choose random direction in full 4PI, no target. */ +void +randvec_target_circle(double *xo, double *yo, double *zo, double *solid_angle, + double xi, double yi, double zi, double radius) +{ + double l2, phi, theta, nx, ny, nz, xt, yt, zt, xu, yu, zu; + + if(radius == 0.0) + { + /* No target, choose uniformly a direction in full 4PI solid angle. */ + theta = acos (1 - rand0max(2)); + phi = rand0max(2 * PI); + if(solid_angle) + *solid_angle = 4*PI; + nx = 1; + ny = 0; + nz = 0; + yi = sqrt(xi*xi+yi*yi+zi*zi); + zi = 0; + xi = 0; + } + else + { + double costheta0; + l2 = xi*xi + yi*yi + zi*zi; /* sqr Distance to target. */ + costheta0 = sqrt(l2/(radius*radius+l2)); + if (radius < 0) costheta0 *= -1; + if(solid_angle) + { + /* Compute solid angle of target as seen from origin. */ + *solid_angle = 2*PI*(1 - costheta0); + } + + /* Now choose point uniformly on sphere surface within angle theta0 */ + theta = acos (1 - rand0max(1 - costheta0)); /* radius on circle */ + phi = rand0max(2 * PI); /* rotation on circle at given radius */ + /* Now, to obtain the desired vector rotate (xi,yi,zi) angle theta around a + perpendicular axis u=i x n and then angle phi around i. */ + if(xi == 0 && zi == 0) + { + nx = 1; + ny = 0; + nz = 0; + } + else + { + nx = -zi; + nz = xi; + ny = 0; + } + } + + /* [xyz]u = [xyz]i x n[xyz] (usually vertical) */ + vec_prod(xu, yu, zu, xi, yi, zi, nx, ny, nz); + /* [xyz]t = [xyz]i rotated theta around [xyz]u */ + rotate (xt, yt, zt, xi, yi, zi, theta, xu, yu, zu); + /* [xyz]o = [xyz]t rotated phi around n[xyz] */ + rotate (*xo, *yo, *zo, xt, yt, zt, phi, xi, yi, zi); +} + + +/* Choose random direction towards target at (xi,yi,zi) with given */ +/* ANGULAR dimension height x width. height=phi_x, width=phi_y (radians)*/ +/* If height or width is zero, choose random direction in full 4PI, no target. */ +void +randvec_target_rect_angular(double *xo, double *yo, double *zo, double *solid_angle, + double xi, double yi, double zi, double width, double height, Rotation A) +{ + double theta, phi, nx, ny, nz, xt, yt, zt, xu, yu, zu; + Coords tmp; + Rotation Ainverse; + + rot_transpose(A, Ainverse); + + if(height == 0.0 || width == 0.0) + { + randvec_target_circle(xo, yo, zo, solid_angle, + xi, yi, zi, 0); + } + else + { + if(solid_angle) + { + /* Compute solid angle of target as seen from origin. */ + *solid_angle = 2*fabs(width*sin(height/2)); + } + + /* Go to global coordinate system */ + + tmp = coords_set(xi, yi, zi); + tmp = rot_apply(Ainverse, tmp); + coords_get(tmp, &xi, &yi, &zi); + + /* Now choose point uniformly on quadrant within angle theta0/phi0 */ + theta = width*randpm1()/2.0; + phi = height*randpm1()/2.0; + /* Now, to obtain the desired vector rotate (xi,yi,zi) angle phi around + n, and then theta around u. */ + if(xi == 0 && zi == 0) + { + nx = 1; + ny = 0; + nz = 0; + } + else + { + nx = -zi; + nz = xi; + ny = 0; + } + } + + /* [xyz]u = [xyz]i x n[xyz] (usually vertical) */ + vec_prod(xu, yu, zu, xi, yi, zi, nx, ny, nz); + /* [xyz]t = [xyz]i rotated theta around [xyz]u */ + rotate (xt, yt, zt, xi, yi, zi, phi, nx, ny, nz); + /* [xyz]o = [xyz]t rotated phi around n[xyz] */ + rotate (*xo, *yo, *zo, xt, yt, zt, theta, xu, yu, zu); + + /* Go back to local coordinate system */ + tmp = coords_set(*xo, *yo, *zo); + tmp = rot_apply(A, tmp); + coords_get(tmp, &*xo, &*yo, &*zo); + +} + +/* Choose random direction towards target at (xi,yi,zi) with given */ +/* dimension height x width (in meters!). */ +/* If height or width is zero, choose random direction in full 4PI, no target. */ +void +randvec_target_rect(double *xo, double *yo, double *zo, double *solid_angle, + double xi, double yi, double zi, double width, double height, Rotation A) +{ + double dx, dy, dist, dist_p, nx, ny, nz, mx, my, mz, xt, yt, zt, xu, yu, zu, theta, phi, n_norm, m_norm; + Coords tmp; + Rotation Ainverse; + + rot_transpose(A, Ainverse); + + if(height == 0.0 || width == 0.0) + { + randvec_target_circle(xo, yo, zo, solid_angle, + xi, yi, zi, 0); + } + else + { + + /* Now choose point uniformly on quadrant within width x height */ + dx = width*randpm1()/2.0; + dy = height*randpm1()/2.0; + + /* Determine distance to target */ + dist = sqrt(xi*xi + yi*yi + zi*zi); + /* Go to global coordinate system */ + + tmp = coords_set(xi, yi, zi); + tmp = rot_apply(Ainverse, tmp); + coords_get(tmp, &xi, &yi, &zi); + + /* Determine vector normal to neutron axis (z) and gravity [0 1 0] */ + vec_prod(nx, ny, nz, xi, yi, zi, 0, 1, 0); + + /* This now defines the x-axis, normalize: */ + n_norm=sqrt(nx*nx + ny*ny + nz*nz); + nx = nx/n_norm; + ny = ny/n_norm; + nz = nz/n_norm; + + /* Now, determine our y-axis (vertical in many cases...) */ + vec_prod(mx, my, mz, xi, yi, zi, nx, ny, nz); + m_norm=sqrt(mx*mx + my*my + mz*mz); + mx = mx/m_norm; + my = my/m_norm; + mz = mz/m_norm; + + /* Our output, random vector can now be defined by linear combination: */ + + *xo = xi + dx * nx + dy * mx; + *yo = yi + dx * ny + dy * my; + *zo = zi + dx * nz + dy * mz; + + /* Go back to local coordinate system */ + tmp = coords_set(*xo, *yo, *zo); + tmp = rot_apply(A, tmp); + coords_get(tmp, &*xo, &*yo, &*zo); + + /* Determine distance to random point */ + dist_p = sqrt(dx*dx + dy*dy + dist*dist); + + /* Adjust the 'solid angle' (here more thought of as a normalization constant) */ + /* Works since we are in the relative coordinate system, origin is where we are at */ + *solid_angle = (width*height*dist)/(dist_p*dist_p*dist_p); + + } +} + + +/* Make sure a list is big enough to hold element COUNT. +* +* The list is an array, and the argument 'list' is a pointer to a pointer to +* the array start. The argument 'size' is a pointer to the number of elements +* in the array. The argument 'elemsize' is the sizeof() an element. The +* argument 'count' is the minimum number of elements needed in the list. +* +* If the old array is to small (or if *list is NULL or *size is 0), a +* sufficuently big new array is allocated, and *list and *size are updated. +*/ +void extend_list(int count, void **list, int *size, size_t elemsize) +{ + if(count >= *size) + { + void *oldlist = *list; + if(*size > 0) + *size *= 2; + else + *size = 32; + *list = malloc(*size*elemsize); + if(!*list) + { + fprintf(stderr, "\nError: Out of memory (extend_list).\n"); + exit(1); + } + if(oldlist) + { + memcpy(*list, oldlist, count*elemsize); + free(oldlist); + } + } +} + +/* Number of neutron histories to simulate. */ +static double mcncount = 1e6; +double mcrun_num = 0; + +void +mcset_ncount(double count) +{ + mcncount = count; +} + +double +mcget_ncount(void) +{ + return mcncount; +} + +double +mcget_run_num(void) +{ + return mcrun_num; +} + +static void +mcsetn_arg(char *arg) +{ + mcset_ncount(strtod(arg, NULL)); +} + +static void +mcsetseed(char *arg) +{ + mcseed = atol(arg); + if(mcseed) + srandom(mcseed); + else + { + fprintf(stderr, "Error: seed most not be zero.\n"); + exit(1); + } +} + +static void +mchelp(char *pgmname) +{ + int i; + + fprintf(stderr, "Usage: %s [options] [parm=value ...]\n", pgmname); + fprintf(stderr, +"Options are:\n" +" -s SEED --seed=SEED Set random seed (must be != 0)\n" +" -n COUNT --ncount=COUNT Set number of neutrons to simulate.\n" +" -d DIR --dir=DIR Put all data files in directory DIR.\n" +" -f FILE --file=FILE Put all data in a single file.\n" +" -t --trace Enable trace of neutron through instrument.\n" +" -g --gravitation Enable gravitation for all trajectories.\n" +" -a --data-only Do not put any headers in the data files.\n" +" --no-output-files Do not write any data files.\n" +" -h --help Show this help message.\n" +" -i --info Detailed instrument information.\n" +" --format=FORMAT Output data files using format FORMAT\n" +" (use option +a to include text header in files\n" +); + if(mcnumipar > 0) + { + fprintf(stderr, "Instrument parameters are:\n"); + for(i = 0; i < mcnumipar; i++) + if (mcinputtable[i].val && strlen(mcinputtable[i].val)) + fprintf(stderr, " %-16s(%s) [default='%s']\n", mcinputtable[i].name, + (*mcinputtypes[mcinputtable[i].type].parminfo)(mcinputtable[i].name), + mcinputtable[i].val); + else + fprintf(stderr, " %-16s(%s)\n", mcinputtable[i].name, + (*mcinputtypes[mcinputtable[i].type].parminfo)(mcinputtable[i].name)); + } + fprintf(stderr, "Available output formats are (default is %s):\n ", mcformat.Name); + for (i=0; i < mcNUMFORMATS; fprintf(stderr,"\"%s\" " , mcformats[i++].Name) ); + fprintf(stderr, "\n Format modifiers: FORMAT may be followed by 'binary float' or \n"); + fprintf(stderr, " 'binary double' to save data blocks as binary. This removes text headers.\n"); + fprintf(stderr, " The MCSTAS_FORMAT environment variable may set the default FORMAT to use.\n"); +#ifndef MC_PORTABLE +#ifndef MAC +#ifndef WIN32 + fprintf(stderr, "Known signals are: USR1 (status) USR2(save) TERM (save and exit)\n"); +#endif /* !MAC */ +#endif /* !WIN32 */ +#endif /* !MC_PORTABLE */ +} + +static void +mcshowhelp(char *pgmname) +{ + mchelp(pgmname); + exit(0); +} + +static void +mcusage(char *pgmname) +{ + fprintf(stderr, "Error: incorrect command line arguments\n"); + mchelp(pgmname); + exit(1); +} + +static void +mcenabletrace(void) +{ + if(mctraceenabled) + mcdotrace = 1; + else + { + fprintf(stderr, + "Error: trace not enabled.\n" + "Please re-run the McStas compiler " + "with the --trace option, or rerun the\n" + "C compiler with the MC_TRACE_ENABLED macro defined.\n"); + exit(1); + } +} + +/* file i/o handling ======================================================== */ +/* opens a new file within mcdirname if non NULL */ +/* if mode is non 0, then mode is used, else mode is 'w' */ + +FILE * +mcnew_file(char *name, char *mode) +{ + int dirlen; + char *mem; + FILE *file; + + if (!name || strlen(name) == 0) return(NULL); + + dirlen = mcdirname ? strlen(mcdirname) : 0; + mem = malloc(dirlen + 1 + strlen(name) + 1); + if(!mem) + { + fprintf(stderr, "Error: Out of memory (mcnew_file)\n"); + exit(1); + } + strcpy(mem, ""); + if(dirlen) + { + strcat(mem, mcdirname); + if(mcdirname[dirlen - 1] != MC_PATHSEP_C && + name[0] != MC_PATHSEP_C) + strcat(mem, MC_PATHSEP_S); + } + strcat(mem, name); + file = fopen(mem, (mode ? mode : "w")); + if(!file) + fprintf(stderr, "Warning: could not open output file '%s'\n", mem); + free(mem); + return file; +} /* mcnew_file */ + +/* mcvalid_name: makes a valid string for variable names. + * copy 'original' into 'valid', replacing invalid characters by '_' + * char arrays must be pre-allocated. n can be 0, or the maximum number of + * chars to be copied/checked + */ +static char *mcvalid_name(char *valid, char *original, int n) +{ + long i; + + + if (original == NULL || strlen(original) == 0) + { strcpy(valid, "noname"); return(valid); } + if (n <= 0) n = strlen(valid); + + if (n > strlen(original)) n = strlen(original); + strncpy(valid, original, n); + + for (i=0; i < n; i++) + { + if ( (valid[i] > 122) + || (valid[i] < 32) + || (strchr("!\"#$%&'()*+,-.:;<=>?@[\\]^`/ ", valid[i]) != NULL) ) + { + if (i) valid[i] = '_'; else valid[i] = 'm'; + } + } + valid[i] = '\0'; + + return(valid); +} /* mcvalid_name */ + +#if defined(NL_ARGMAX) || defined(WIN32) +static int pfprintf(FILE *f, char *fmt, char *fmt_args, ...) +{ +/* this function +1- look for the maximum %d$ field in fmt +2- looks for all %d$ fields up to max in fmt and set their type (next alpha) +3- retrieve va_arg up to max, and save pointer to arg in local arg array +4- use strchr to split around '%' chars, until all pieces are written + +usage: just as fprintf, but with (char *)fmt_args being the list of arg type + */ + + #define MyNL_ARGMAX 50 + char *fmt_pos; + + char *arg_char[MyNL_ARGMAX]; + int arg_int[MyNL_ARGMAX]; + long arg_long[MyNL_ARGMAX]; + double arg_double[MyNL_ARGMAX]; + + char *arg_posB[MyNL_ARGMAX]; /* position of '%' */ + char *arg_posE[MyNL_ARGMAX]; /* position of '$' */ + char *arg_posT[MyNL_ARGMAX]; /* position of type */ + + int arg_num[MyNL_ARGMAX]; /* number of argument (between % and $) */ + int this_arg=0; + int arg_max=0; + va_list ap; + + if (!f || !fmt_args || !fmt) return(-1); + for (this_arg=0; this_arg= MyNL_ARGMAX) + return(-fprintf(stderr,"pfprintf: invalid positional argument number (<=0 or >=%i) %s.\n", MyNL_ARGMAX, arg_posB[this_arg])); + /* get type of positional argument: follows '%' -> arg_posE[this_arg]+1 */ + fmt_pos = arg_posE[this_arg]+1; + if (!strchr(printf_formats, fmt_pos[0])) + return(-fprintf(stderr,"pfprintf: invalid positional argument type (%c != expected %c).\n", fmt_pos[0], fmt_args[arg_num[this_arg]-1])); + if (fmt_pos[0] == 'l' && fmt_pos[1] == 'i') fmt_pos++; + arg_posT[this_arg] = fmt_pos; + /* get next argument... */ + this_arg++; + } + else + { + if (tmp[1] != '%') + return(-fprintf(stderr,"pfprintf: must use only positional arguments (%s).\n", arg_posB[this_arg])); + else fmt_pos = arg_posB[this_arg]+2; /* found %% */ + } + } else + break; /* no more % argument */ + } + arg_max = this_arg; + /* get arguments from va_arg list, according to their type */ + va_start(ap, fmt_args); + for (this_arg=0; this_arg0) + { + fmt_bit = (char*)malloc(arg_posB[this_arg]-fmt_pos+10); + if (!fmt_bit) return(-fprintf(stderr,"pfprintf: not enough memory.\n")); + strncpy(fmt_bit, fmt_pos, arg_posB[this_arg]-fmt_pos); + fmt_bit[arg_posB[this_arg]-fmt_pos] = '\0'; + fprintf(f, fmt_bit); /* fmt part without argument */ + } else + { + fmt_bit = (char*)malloc(10); + if (!fmt_bit) return(-fprintf(stderr,"pfprintf: not enough memory.\n")); + } + arg_n = arg_num[this_arg]-1; /* must be >= 0 */ + strcpy(fmt_bit, "%"); + strncat(fmt_bit, arg_posE[this_arg]+1, arg_posT[this_arg]-arg_posE[this_arg]); + fmt_bit[arg_posT[this_arg]-arg_posE[this_arg]+1] = '\0'; + + switch(fmt_args[arg_n]) + { + case 's': fprintf(f, fmt_bit, arg_char[arg_n]); + break; + case 'd': + case 'i': + case 'c': /* int */ + fprintf(f, fmt_bit, arg_int[arg_n]); + break; + case 'l': /* long */ + fprintf(f, fmt_bit, arg_long[arg_n]); + break; + case 'f': + case 'g': + case 'G': /* double */ + fprintf(f, fmt_bit, arg_double[arg_n]); + break; + } + fmt_pos = arg_posT[this_arg]+1; + if (this_arg == arg_max-1) + { /* add eventual leading characters for last parameter */ + if (fmt_pos < fmt+strlen(fmt)) + fprintf(f, "%s", fmt_pos); + } + if (fmt_bit) free(fmt_bit); + + } + return(this_arg); +} +#else +static int pfprintf(FILE *f, char *fmt, char *fmt_args, ...) +{ /* wrapper to standard fprintf */ + va_list ap; + int tmp; + + va_start(ap, fmt_args); + tmp=vfprintf(f, fmt, ap); + va_end(ap); + return(tmp); +} +#endif + +/* mcfile_header: output header/footer using specific file format. + * outputs, in file 'name' having preallocated 'f' handle, the format Header + * 'part' may be 'header' or 'footer' depending on part to write + * if name == NULL, ignore function (no header/footer output) + */ +static int mcfile_header(FILE *f, struct mcformats_struct format, char *part, char *pre, char *name, char *parent) +{ + char user[64]; + char date[64]; + char *HeadFoot; + long date_l; /* date as a long number */ + time_t t; + char valid_parent[256]; + char instrname[256]; + char file[256]; + + if(!f) + return (-1); + + time(&t); + + if (part && !strcmp(part,"footer")) + { + HeadFoot = format.Footer; + date_l = (long)t;; + } + else + { + HeadFoot = format.Header; + date_l = mcstartdate; + } + t = (time_t)date_l; + + if (!strlen(HeadFoot) || (!name)) return (-1); + + sprintf(file,"%s",name); + sprintf(user,"%s on %s", getenv("USER"), getenv("HOST")); + sprintf(instrname,"%s (%s)", mcinstrument_name, mcinstrument_source); + strncpy(date, ctime(&t), 64); + if (strlen(date)) date[strlen(date)-1] = '\0'; + + if (parent && strlen(parent)) mcvalid_name(valid_parent, parent, 256); + else strcpy(valid_parent, "root"); + + return(pfprintf(f, HeadFoot, "sssssssl", + pre, /* %1$s */ + instrname, /* %2$s */ + file, /* %3$s */ + format.Name, /* %4$s */ + date, /* %5$s */ + user, /* %6$s */ + valid_parent, /* %7$s*/ + date_l)); /* %8$li */ +} /* mcfile_header */ + +/* mcfile_tag: output tag/value using specific file format. + * outputs, in file with 'f' handle, a tag/value pair. + * if name == NULL, ignore function (no section definition) + */ +static int mcfile_tag(FILE *f, struct mcformats_struct format, char *pre, char *section, char *name, char *value) +{ + char valid_section[256]; + int i; + + if (!strlen(format.AssignTag) || (!name) || (!f)) return(-1); + + mcvalid_name(valid_section, section, 256); + + /* remove quote chars in values */ + if (strstr(format.Name, "Scilab") || strstr(format.Name, "Matlab") || strstr(format.Name, "IDL")) + for(i = 0; i < strlen(value); i++) + if (value[i] == '"' || value[i] == '\'') value[i] = ' '; + + return(pfprintf(f, format.AssignTag, "ssss", + pre, /* %1$s */ + valid_section,/* %2$s */ + name, /* %3$s */ + value)); /* %4$s */ +} /* mcfile_tag */ + +/* mcfile_section: output section start/end using specific file format. + * outputs, in file 'name' having preallocated 'f' handle, the format Section. + * 'part' may be 'begin' or 'end' depending on section part to write + * 'type' may be e.g. 'instrument','simulation','component','data' + * if name == NULL, ignore function (no section definition) + * the prefix 'pre' is automatically idented/un-indented (pre-allocated !) + */ + +static int mcfile_section(FILE *f, struct mcformats_struct format, char *part, char *pre, char *name, char *type, char *parent, int level) +{ + char *Section; + char valid_name[256]; + char valid_parent[256]; + int ret; + + if(!f) + return (-1); + + if (part && !strcmp(part,"end")) Section = format.EndSection; + else Section = format.BeginSection; + + if (!strlen(Section) || (!name)) return (-1); + + mcvalid_name(valid_name, name, 256); + if (parent && strlen(parent)) mcvalid_name(valid_parent, parent, 256); + else strcpy(valid_parent, "root"); + + if (!strcmp(part,"end") && pre) + { + if (strlen(pre) <= 2) strcpy(pre,""); + else pre[strlen(pre)-2]='\0'; + } + + ret = pfprintf(f, Section, "ssssssl", + pre, /* %1$s */ + type, /* %2$s */ + name, /* %3$s */ + valid_name, /* %4$s */ + parent, /* %5$s */ + valid_parent, /* %6$s */ + level); /* %7$li */ + + if (!strcmp(part,"begin")) + { + strcat(pre," "); + if (name && strlen(name)) + mcfile_tag(f, format, pre, name, "name", name); + if (parent && strlen(parent)) + mcfile_tag(f, format, pre, name, "parent", parent); + } + + + return(ret); +} /* mcfile_section */ + +static void mcinfo_instrument(FILE *f, struct mcformats_struct format, + char *pre, char *name) +{ + char Value[1300] = ""; + int i; + + if (!f) return; + + for(i = 0; i < mcnumipar; i++) + { + char ThisParam[256]; + if (strlen(mcinputtable[i].name) > 200) break; + sprintf(ThisParam, " %s(%s)", mcinputtable[i].name, + (*mcinputtypes[mcinputtable[i].type].parminfo) + (mcinputtable[i].name)); + strcat(Value, ThisParam); + if (strlen(Value) > 1024) break; + } + mcfile_tag(f, format, pre, name, "Parameters", Value); + mcfile_tag(f, format, pre, name, "Source", mcinstrument_source); + mcfile_tag(f, format, pre, name, "Trace_enabled", mctraceenabled ? "yes" : "no"); + mcfile_tag(f, format, pre, name, "Default_main", mcdefaultmain ? "yes" : "no"); + mcfile_tag(f, format, pre, name, "Embedded_runtime", +#ifdef MC_EMBEDDED_RUNTIME + "yes" +#else + "no" +#endif + ); +} /* mcinfo_instrument */ + +void mcinfo_simulation(FILE *f, struct mcformats_struct format, + char *pre, char *name) +{ + int i; + double run_num, ncount; + time_t t; + char Value[256]; + + if (!f) return; + + run_num = mcget_run_num(); + ncount = mcget_ncount(); + time(&t); + strncpy(Value, ctime(&t), 256); if (strlen(Value)) Value[strlen(Value)-1] = '\0'; + mcfile_tag(f, format, pre, name, "Date", Value); + if (run_num == 0 || run_num == ncount) sprintf(Value, "%g", ncount); + else sprintf(Value, "%g/%g", run_num, ncount); + mcfile_tag(f, format, pre, name, "Ncount", Value); + mcfile_tag(f, format, pre, name, "Trace", mcdotrace ? "yes" : "no"); + mcfile_tag(f, format, pre, name, "Gravitation", mcgravitation ? "yes" : "no"); + if(mcseed) + { + sprintf(Value, "%ld", mcseed); + mcfile_tag(f, format, pre, name, "Seed", Value); + } + if (strstr(format.Name, "McStas")) + { + for(i = 0; i < mcnumipar; i++) + { + if (mcrun_num || (mcinputtable[i].val && strlen(mcinputtable[i].val))) { + (*mcinputtypes[mcinputtable[i].type].printer)(Value, mcinputtable[i].par); + fprintf(f, "%sParam: %s=%s", pre, mcinputtable[i].name, Value); + fprintf(f, "\n"); + } + } + } + else + { + mcfile_section(f, format, "begin", pre, "parameters", "parameters", name, 3); + for(i = 0; i < mcnumipar; i++) + { + (*mcinputtypes[mcinputtable[i].type].printer)(Value, mcinputtable[i].par); + mcfile_tag(f, format, pre, "parameters", mcinputtable[i].name, Value); + } + mcfile_section(f, format, "end", pre, "parameters", "parameters", name, 3); + } +} /* mcinfo_simulation */ + +static void mcinfo_data(FILE *f, struct mcformats_struct format, + char *pre, char *parent, char *title, + int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename, + double *p0, double *p1, double *p2, char istransposed) +{ + char type[256]; + char stats[256]; + char vars[256]; + char signal[256]; + char values[256]; + char limits[256]; + char lim_field[10]; + char c[32]; + double run_num, ncount; + char ratio[256]; + + double sum_xz = 0; + double sum_yz = 0; + double sum_z = 0; + double sum_y = 0; + double sum_x = 0; + double sum_x2z = 0; + double sum_y2z = 0; + double min_z = 0; + double max_z = 0; + double fmon_x=0, smon_x=0, fmon_y=0, smon_y=0, mean_z=0; + double Nsum=0; + double P2sum=0; + + int i,j; + + if (!f || m*n*p == 0) return; + + if (p1) + { + min_z = p1[0]; + max_z = min_z; + for(j = 0; j < n*p; j++) + { + for(i = 0; i < m; i++) + { + double x,y,z; + double N, E; + long index; + + if (!istransposed) index = i*n*p + j; + else index = i+j*m; + if (p0) N = p0[index]; + if (p2) E = p2[index]; + + if (m) x = x1 + (i + 0.5)/m*(x2 - x1); else x = 0; + if (n) y = y1 + (j + 0.5)/n/p*(y2 - y1); else y = 0; + z = p1[index]; + sum_xz += x*z; + sum_yz += y*z; + sum_x += x; + sum_y += y; + sum_z += z; + sum_x2z += x*x*z; + sum_y2z += y*y*z; + if (z > max_z) max_z = z; + if (z < min_z) min_z = z; + + Nsum += p0 ? N : 1; + P2sum += p2 ? E : z*z; + } + } + if (sum_z && n*m*p) + { + fmon_x = sum_xz/sum_z; + fmon_y = sum_yz/sum_z; + smon_x = sqrt(sum_x2z/sum_z-fmon_x*fmon_x); + smon_y = sqrt(sum_y2z/sum_z-fmon_y*fmon_y); + mean_z = sum_z/n/m/p; + } + } + + if (m*n*p == 1) + { strcpy(type, "array_0d"); strcpy(stats, ""); } + else if (n == 1 || m == 1) + { if (m == 1) {m = n; n = 1; } + sprintf(type, "array_1d(%d)", m); + sprintf(stats, "X0=%g; dX=%g;", fmon_x, smon_x); } + else + { if (p == 1) sprintf(type, "array_2d(%d, %d)", m, n); + else sprintf(type, "array_3d(%d, %d, %d)", m, n, p); + sprintf(stats, "X0=%g; dX=%g; Y0=%g; dY=%g;", fmon_x, smon_x, fmon_y, smon_y); } + strcpy(c, "I "); + if (zvar && strlen(zvar)) strncpy(c, zvar,32); + else if (yvar && strlen(yvar)) strncpy(c, yvar,32); + else if (xvar && strlen(xvar)) strncpy(c, xvar,32); + else strncpy(c, xvar,32); + if (m == 1 || n == 1) sprintf(vars, "%s %s %s_err N", xvar, c, c); + else sprintf(vars, "%s %s_err N", c, c); + + run_num = mcget_run_num(); + ncount = mcget_ncount(); + sprintf(ratio, "%g/%g", run_num, ncount); + + mcfile_tag(f, format, pre, parent, "type", type); + mcfile_tag(f, format, pre, parent, "Source", mcinstrument_source); + if (parent) mcfile_tag(f, format, pre, parent, (strstr(format.Name,"McStas") ? "component" : "parent"), parent); + if (title) mcfile_tag(f, format, pre, parent, "title", title); + mcfile_tag(f, format, pre, parent, "ratio", ratio); + if (filename) { + mcfile_tag(f, format, pre, parent, "filename", filename); + mcfile_tag(f, format, pre, parent, "format", format.Name); + } else mcfile_tag(f, format, pre, parent, "filename", ""); + + if (p1) + { + if (n*m*p > 1) + { + sprintf(signal, "Min=%g; Max=%g; Mean= %g;", min_z, max_z, mean_z); + if (y1 == 0 && y2 == 0) { y1 = min_z; y2 = max_z;} + else if (z1 == 0 && z2 == 0) { z1 = min_z; z2 = max_z;} + } else strcpy(signal, ""); + + mcfile_tag(f, format, pre, parent, "statistics", stats); + mcfile_tag(f, format, pre, parent, "signal", signal); + + sprintf(values, "%g %g %g", sum_z, mcestimate_error(Nsum, sum_z, P2sum), Nsum); + mcfile_tag(f, format, pre, parent, "values", values); + } + strcpy(lim_field, "xylimits"); + if (n*m > 1) + { + mcfile_tag(f, format, pre, parent, "xvar", xvar); + mcfile_tag(f, format, pre, parent, "yvar", yvar); + mcfile_tag(f, format, pre, parent, "xlabel", xlabel); + mcfile_tag(f, format, pre, parent, "ylabel", ylabel); + if ((n == 1 || m == 1) && strstr(format.Name, "McStas")) + { + sprintf(limits, "%g %g", x1, x2); + strcpy(lim_field, "xlimits"); + } + else + { + mcfile_tag(f, format, pre, parent, "zvar", zvar); + mcfile_tag(f, format, pre, parent, "zlabel", zlabel); + sprintf(limits, "%g %g %g %g %g %g", x1, x2, y1, y2, z1, z2); + } + } else strcpy(limits, "0 0 0 0 0 0"); + mcfile_tag(f, format, pre, parent, lim_field, limits); + mcfile_tag(f, format, pre, parent, "variables", vars); +} /* mcinfo_data */ + +/* main output function, works for 0d, 1d, 2d data */ + +void +mcsiminfo_init(FILE *f) +{ + char info_name[256]; + + if (mcdisable_output_files) return; + if (!f && (!mcsiminfo_name || !strlen(mcsiminfo_name))) return; + if (!strchr(mcsiminfo_name,'.')) sprintf(info_name, "%s.%s", mcsiminfo_name, mcformat.Extension); else strcpy(info_name, mcsiminfo_name); + if (!f) mcsiminfo_file = mcnew_file(info_name, "w"); + else mcsiminfo_file = f; + if(!mcsiminfo_file) + fprintf(stderr, + "Warning: could not open simulation description file '%s'\n", + info_name); + else + { + char pre[20]; + int ismcstas; + char simname[1024]; + char root[10]; + + strcpy(pre, ""); + ismcstas = (strstr(mcformat.Name, "McStas") != NULL); + if (strstr(mcformat.Name, "XML") == NULL && strstr(mcformat.Name, "NeXus") == NULL) strcpy(root, "mcstas"); + else strcpy(root, "root"); + if (mcdirname) sprintf(simname, "%s%s%s", mcdirname, MC_PATHSEP_S, mcsiminfo_name); else sprintf(simname, "%s%s%s", ".", MC_PATHSEP_S, mcsiminfo_name); + + mcfile_header(mcsiminfo_file, mcformat, "header", pre, simname, root); + mcfile_section(mcsiminfo_file, mcformat, "begin", pre, mcinstrument_name, "instrument", root, 1); + mcinfo_instrument(mcsiminfo_file, mcformat, pre, mcinstrument_name); + if (ismcstas) mcfile_section(mcsiminfo_file, mcformat, "end", pre, mcinstrument_name, "instrument", root, 1); + mcfile_section(mcsiminfo_file, mcformat, "begin", pre, simname, "simulation", mcinstrument_name, 2); + mcinfo_simulation(mcsiminfo_file, mcformat, pre, simname); + if (ismcstas) mcfile_section(mcsiminfo_file, mcformat, "end", pre, simname, "simulation", mcinstrument_name, 2); + } +} /* mcsiminfo_init */ + +void +mcsiminfo_close(void) +{ + if (mcdisable_output_files) return; + if(mcsiminfo_file) + { + int ismcstas; + char simname[1024]; + char root[10]; + char pre[10]; + + strcpy(pre, " "); + ismcstas = (strstr(mcformat.Name, "McStas") != NULL); + if (mcdirname) sprintf(simname, "%s%s%s", mcdirname, MC_PATHSEP_S, mcsiminfo_name); else sprintf(simname, "%s%s%s", ".", MC_PATHSEP_S, mcsiminfo_name); + if (strstr(mcformat.Name, "XML") == NULL && strstr(mcformat.Name, "NeXus") == NULL) strcpy(root, "mcstas"); else strcpy(root, "root"); + + if (!ismcstas) + { + mcfile_section(mcsiminfo_file, mcformat, "end", pre, simname, "simulation", mcinstrument_name, 2); + mcfile_section(mcsiminfo_file, mcformat, "end", pre, mcinstrument_name, "instrument", root, 1); + } + mcfile_header(mcsiminfo_file, mcformat, "footer", pre, simname, root); + + if (mcsiminfo_file != stdout) fclose(mcsiminfo_file); + mcsiminfo_file = NULL; + } +} /* mcsiminfo_close */ + +/* mcfile_datablock: output a single data block using specific file format. + * 'part' can be 'data','errors','ncount' + * if y1 == y2 == 0 and McStas format, then stores as a 1D array with [I,E,N] + * return value: 0=0d/2d, 1=1d + * when !single_file, create independent data files, with header and data tags + * if one of the dimensions m,n,p is negative, the data matrix will be written + * after transposition of m/x and n/y dimensions + */ + +static int mcfile_datablock(FILE *f, struct mcformats_struct format, + char *pre, char *parent, char *part, + double *p0, double *p1, double *p2, int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, char *title, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename, char istransposed) +{ + char *Begin; + char *End; + char valid_xlabel[64]; + char valid_ylabel[64]; + char valid_zlabel[64]; + char valid_parent[64]; + FILE *datafile= NULL; + int isdata=0; + int just_header=0; + int i,j, is1d; + double Nsum=0, Psum=0, P2sum=0; + char sec[256]; + char isdata_present; + + if (strstr(part,"data")) + { isdata = 1; Begin = format.BeginData; End = format.EndData; } + if (strstr(part,"errors")) + { isdata = 2; Begin = format.BeginErrors; End = format.EndErrors; } + if (strstr(part,"ncount")) + { isdata = 0; Begin = format.BeginNcount; End = format.EndNcount; } + if (strstr(part, "begin")) just_header = 1; + if (strstr(part, "end")) just_header = 2; + + isdata_present=((isdata==1 && p1) || (isdata==2 && p2) || (isdata==0 && p0)); + + is1d = ((m==1 || n==1) && strstr(format.Name,"McStas")); + mcvalid_name(valid_xlabel, xlabel, 64); + mcvalid_name(valid_ylabel, ylabel, 64); + mcvalid_name(valid_zlabel, zlabel, 64); + + if (strstr(format.Name, "McStas") || !filename || strlen(filename) == 0) + mcvalid_name(valid_parent, parent, 64); + else mcvalid_name(valid_parent, filename, 64); + + /* if normal or begin and part == data: output info_data (sim/data_file) */ + if (isdata == 1 && just_header != 2 && f) + { + mcinfo_data(f, format, pre, valid_parent, title, m, n, p, + xlabel, ylabel, zlabel, xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, p0, p1, p2, istransposed); + } + + /* if normal or begin: begin part (sim/data file) */ + if (strlen(Begin) && just_header != 2 && f) + pfprintf(f, Begin, "ssssssssssssslllgggggg", + pre, /* %1$s */ + valid_parent, /* %2$s */ + title, /* %3$s */ + filename, /* %4$s */ + xlabel, /* %5$s */ + valid_xlabel, /* %6$s*/ + ylabel, /* %7$s */ + valid_ylabel, /* %8$s */ + zlabel, /* %9$s*/ + valid_zlabel, /* %10$s*/ + xvar, /* %11$s */ + yvar, /* %12$s */ + zvar, /* %13$s */ + m, /* %14$li */ + n, /* %15$li */ + p, /* %16$li */ + x1, /* %17$g */ + x2, /* %18$g */ + y1, /* %19$g*/ + y2, /* %20$g */ + z1, /* %21$g */ + z2); /* %22$g */ + + /* if normal, and !single: + * open datafile, + * if !ascii_only + * if data: write file header, + * call datablock part+header(begin) + * else data file = f + */ + if (!mcsingle_file && just_header == 0) + { + /* if data: open new file for data else append for error/ncount */ + if (filename) datafile = mcnew_file(filename, + (isdata != 1 || strstr(format.Name, "append") ? "a" : "w")); + else datafile = NULL; + /* special case of IDL: can not have empty vectors. Init to 'empty' */ + if (strstr(format.Name, "IDL") && f) fprintf(f, "'external'"); + /* if data, start with root header plus tags of parent data */ + if (datafile && !mcascii_only) + { + char mode[32]; + if (isdata == 1) mcfile_header(datafile, format, "header", + (strstr(format.Name, "McStas") ? "# " : ""), + filename, valid_parent); + sprintf(mode, "%s begin", part); + /* write header+data block begin tags into datafile */ + mcfile_datablock(datafile, format, + (strstr(format.Name, "McStas") ? "# " : ""), + valid_parent, mode, + p0, p1, p2, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, istransposed); + + + } + } + else if (just_header == 0) + { + if (strstr(format.Name, "McStas") && m*n*p>1 && f) + { + if (is1d) sprintf(sec,"array_1d(%d)", m); + else if (p==1) sprintf(sec,"array_2d(%d,%d)", m,n); + else sprintf(sec,"array_3d(%d,%d,%d)", m,n,p); + fprintf(f,"%sbegin %s\n", pre, sec); + datafile = f; + } + if (mcsingle_file) datafile = f; + } + + /* if normal: [data] in data file */ + /* do loops: 2 loops on m,n. */ + if (just_header == 0) + { + char eol_char[3]; + int isIDL, isPython; + int isBinary=0; + + if (strstr(format.Name, "binary float")) isBinary=1; + else if (strstr(format.Name, "binary double")) isBinary=2; + isIDL = (strstr(format.Name, "IDL") != NULL); + isPython = (strstr(format.Name, "Python") != NULL); + if (isIDL) strcpy(eol_char,"$\n"); else strcpy(eol_char,"\n"); + + for(j = 0; j < n*p; j++) /* loop on rows(y) */ + { + if(datafile && !isBinary) + fprintf(datafile,"%s", pre); + for(i = 0; i < m; i++) /* write all columns (x) */ + { + double I=0, E=0, N=0; + double value=0; + long index; + + if (!istransposed) index = i*n*p + j; + else index = i+j*m; + if (p0) N = p0[index]; + if (p1) I = p1[index]; + if (p2) E = p2[index]; + + Nsum += p0 ? N : 1; + Psum += I; + P2sum += p2 ? E : I*I; + + if (p0 && p1 && p2) E = mcestimate_error(N,I,E); + if(datafile && !isBinary && isdata_present) + { + if (isdata == 1) value = I; + else if (isdata == 0) value = N; + else if (isdata == 2) value = E; + if (is1d) + { + double x; + + x = x1+(x2-x1)*(index)/(m*n*p); + if (m*n*p > 1) fprintf(datafile, "%g %g %g %g\n", x, I, E, N); + } + else + { + fprintf(datafile, "%g", value); + if ((isIDL || isPython) && ((i+1)*(j+1) < m*n*p)) fprintf(datafile, ","); + else fprintf(datafile, " "); + } + } + } + if (datafile && !isBinary && isdata_present) fprintf(datafile, eol_char); + } /* end 2 loops if not Binary */ + if (datafile && isBinary) + { + double *d=NULL; + if (isdata==1) d=p1; + else if (isdata==2) d=p2; + else if (isdata==0) d=p0; + + if (d && isBinary == 1) /* float */ + { + float *s; + s = (float*)malloc(m*n*p*sizeof(float)); + if (s) + { + long i, count; + for (i=0; i 1) + fprintf(f,"%send %s\n", pre, sec); + } + + /* set return value */ + return(is1d); +} /* mcfile_datablock */ + +/* mcfile_data: output data/errors/ncounts using specific file format. + * if McStas 1D then data is stored + * as a long 1D array [p0, p1, p2] to reorder -> don't output err/ncount again. + * if p1 or p2 is NULL then skip that part. + */ +static int mcfile_data(FILE *f, struct mcformats_struct format, + char *pre, char *parent, + double *p0, double *p1, double *p2, int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, char *title, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename, char istransposed) +{ + int is1d; + + /* return if f,n,m,p1 NULL */ + if ((m*n*p == 0) || !p1) return (-1); + + /* output data block */ + is1d = mcfile_datablock(f, format, pre, parent, "data", + p0, p1, p2, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, istransposed); + /* return if 1D data */ + if (is1d) return(is1d); + /* output error block and p2 non NULL */ + if (p0 && p2) mcfile_datablock(f, format, pre, parent, "errors", + p0, p1, p2, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, istransposed); + /* output ncount block and p0 non NULL */ + if (p0 && p2) mcfile_datablock(f, format, pre, parent, "ncount", + p0, p1, p2, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, istransposed); + + return(is1d); +} /* mcfile_data */ + +double +mcdetector_out(char *cname, double p0, double p1, double p2, char *filename) +{ + printf("Detector: %s_I=%g %s_ERR=%g %s_N=%g", + cname, p1, cname, mcestimate_error(p0,p1,p2), cname, p0); + if(filename && strlen(filename)) + printf(" \"%s\"", filename); + printf("\n"); + return(p0); +} + +/* parent is the component name */ + +static double mcdetector_out_012D(struct mcformats_struct format, + char *pre, char *parent, char *title, + int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename, + double *p0, double *p1, double *p2) +{ + char simname[512]; + int i,j; + double Nsum=0, Psum=0, P2sum=0; + FILE *local_f=NULL; + char istransposed=0; + + if (m<0 || n<0 || p<0 || strstr(format.Name, "binary")) /* do the swap once for all */ + { + double tmp1, tmp2; + char *lab; + istransposed = 1; + + i=m; m=abs(n); n=abs(i); p=abs(p); + } + + if (!strstr(format.Name,"partial")) local_f = mcsiminfo_file; + if (mcdirname) sprintf(simname, "%s%s%s", mcdirname, MC_PATHSEP_S, mcsiminfo_name); else sprintf(simname, "%s%s%s", ".", MC_PATHSEP_S, mcsiminfo_name); + + if (!mcdisable_output_files) + { + + mcfile_section(local_f, format, "begin", pre, parent, "component", simname, 3); + mcfile_section(local_f, format, "begin", pre, filename, "data", parent, 4); + mcfile_data(local_f, format, + pre, parent, + p0, p1, p2, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, filename, istransposed); + + mcfile_section(local_f, format, "end", pre, filename, "data", parent, 4); + mcfile_section(local_f, format, "end", pre, parent, "component", simname, 3); + } + + if (local_f || mcdisable_output_files) + { + for(j = 0; j < n*p; j++) + { + for(i = 0; i < m; i++) + { + double N,I,E; + int index; + if (!istransposed) index = i*n*p + j; + else index = i+j*m; + if (p0) N = p0[index]; + if (p1) I = p1[index]; + if (p2) E = p2[index]; + + Nsum += p0 ? N : 1; + Psum += I; + P2sum += p2 ? E : I*I; + } + } + /* give 0D detector output. */ + mcdetector_out(parent, Nsum, Psum, P2sum, filename); + } + return(Psum); +} /* mcdetector_out_012D */ + +void mcheader_out(FILE *f,char *parent, + int m, int n, int p, + char *xlabel, char *ylabel, char *zlabel, char *title, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, + char *filename) +{ + int loc_single_file; + char pre[3]; + char simname[512]; + loc_single_file = mcsingle_file; mcsingle_file = 1; + + if (!strstr(mcformat.Name, "McStas")) strcpy(pre,""); else strcpy(pre,"# "); + + mcfile_header(f, mcformat, "header", pre, mcinstrument_name, "mcstas"); + mcinfo_instrument(f, mcformat, pre, mcinstrument_name); + if (mcdirname) sprintf(simname, "%s%s%s", mcdirname, MC_PATHSEP_S, mcsiminfo_name); else sprintf(simname, "%s%s%s", ".", MC_PATHSEP_S, mcsiminfo_name); + + mcfile_datablock(f, mcformat, + pre, parent, "data", + NULL,NULL,NULL, m, n, p, + xlabel, ylabel, zlabel, title, + xvar, yvar, zvar, x1, x2, y1, y2, z1, z2, + filename, 0); + + mcsingle_file = loc_single_file; + mcfile_header(f, mcformat, "footer", pre, mcinstrument_name, "mcstas"); +} + + +double mcdetector_out_0D(char *t, double p0, double p1, double p2, char *c) +{ + char pre[20]; + + strcpy(pre, ""); + return(mcdetector_out_012D(mcformat, + pre, c, t, + 1, 1, 1, + "I", "", "", + "I", "", "", + 0, 0, 0, 0, 0, 0, NULL, + &p0, &p1, &p2)); +} + +double mcdetector_out_1D(char *t, char *xl, char *yl, + char *xvar, double x1, double x2, int n, + double *p0, double *p1, double *p2, char *f, char *c) +{ + char pre[20]; + + strcpy(pre, ""); + return(mcdetector_out_012D(mcformat, + pre, c, t, + n, 1, 1, + xl, yl, "Intensity", + xvar, "(I,I_err)", "I", + x1, x2, x1, x2, 0, 0, f, + p0, p1, p2)); +} + +double mcdetector_out_2D(char *t, char *xl, char *yl, + double x1, double x2, double y1, double y2, int m, + int n, double *p0, double *p1, double *p2, char *f, char *c) +{ + char xvar[3]; + char yvar[3]; + char pre[20]; + + strcpy(pre, ""); strcpy(xvar, "x "); strcpy(yvar, "y "); + if (xl && strlen(xl)) strncpy(xvar, xl, 2); + if (yl && strlen(yl)) strncpy(yvar, yl, 2); + + return(mcdetector_out_012D(mcformat, + pre, c, t, + m, n, 1, + xl, yl, "Intensity", + xvar, yvar, "I", + x1, x2, y1, y2, 0, 0, f, + p0, p1, p2)); +} + +double mcdetector_out_3D(char *t, char *xl, char *yl, char *zl, + char *xvar, char *yvar, char *zvar, + double x1, double x2, double y1, double y2, double z1, double z2, int m, + int n, int p, double *p0, double *p1, double *p2, char *f, char *c) +{ + char pre[20]; + + strcpy(pre, ""); + return(mcdetector_out_012D(mcformat, + pre, c, t, + m, n, p, + xl, yl, zl, + xvar, yvar, zvar, + x1, x2, y1, y2, z1, z2, f, + p0, p1, p2)); +} + +/* end of file i/o functions */ + + + +static void +mcuse_dir(char *dir) +{ +#ifdef MC_PORTABLE + fprintf(stderr, "Error: " + "Directory output cannot be used with portable simulation.\n"); + exit(1); +#else /* !MC_PORTABLE */ + if(mkdir(dir, 0777)) + { + fprintf(stderr, "Error: unable to create directory '%s'.\n", dir); + fprintf(stderr, "(Maybe the directory already exists?)\n"); + exit(1); + } + mcdirname = dir; +#endif /* !MC_PORTABLE */ +} + +static void +mcuse_file(char *file) +{ + mcsiminfo_name = file; + mcsingle_file = 1; +} + +void mcuse_format(char *format) +{ + int i,j; + int i_format=-1; + char *tmp; + char low_format[256]; + + /* get the format to lower case */ + if (!format) return; + strcpy(low_format, format); + for (i=0; i MCSTAS define +* monitor_nd-lib: fix Log(signal) log(coord) +* HOPG.trm: reduce 4000 points -> 400 which is enough and faster to resample +* Progress_bar: precent -> percent parameter +* CS: ---------------------------------------------------------------------- +* +* Revision 1.1 2002/08/29 11:39:00 ef +* Initial revision extracted from lib/optics/Monochromators... +*******************************************************************************/ + +#ifndef READ_TABLE_LIB_H +#define READ_TABLE_LIB_H "1.1.0" + +#include + + typedef struct struct_table + { + char filename[128]; + char *header; + double *data; /* vector { x[0], y[0], ... x[n-1], y[n-1]... } */ + double min_x; + double max_x; + double step_x; + long rows; + long columns; + long block_number; + } t_Table; + +/* read_table-lib function prototypes */ +/* ========================================================================= */ +void Table_Init(t_Table *Table); +void Table_Free(t_Table *Table); +long Table_Read(t_Table *Table, char *File, long block_number); +long Table_Read_Offset(t_Table *mc_rt_Table, char *mc_rt_File, long mc_rt_block_number, long *offset, long max_lines); +long Table_Read_Offset_Binary(t_Table *mc_rt_Table, char *mc_rt_File, char *mc_rt_type, long *mc_rt_offset, long mc_rt_rows, long mc_rt_columns); +long Table_Read_Handle(t_Table *Table, FILE *fid, long block_number, long max_lines); +long Table_Rebin(t_Table *Table); +double Table_Index(t_Table Table, long i, long j); +double Table_Value(t_Table Table, double X, long j); +void Table_Info(t_Table Table); +static void Table_Stat(t_Table *mc_rt_Table); + +#endif + +/* end of read_table-lib.h */ +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Library: share/read_table-lib.c +* +* %Identification +* Written by: EF +* Date: Aug 28, 2002 +* Origin: ILL +* Release: McStas 1.6 +* Version: 1.2 +* +* This file is to be imported by components that may read data from table files +* It handles some shared functions. Embedded within instrument in runtime mode. +* Variable names have prefix 'mc_rt_' for 'McStas Read Table' to avoid conflicts +* +* Usage: within SHARE +* %include "read_table-lib" +* +* $Id: dmcafter.c,v 1.2 2007-02-12 01:19:07 ffr Exp $ +* +* $Log: not supported by cvs2svn $ +* Revision 1.1.2.1 2007/02/06 04:03:21 ffr +* PSI Update +* +* Revision 1.1 2007/01/30 03:19:43 koennecke +* - Fixed state monitor eclipse commit problems. Siiiiiiiggggghhhhhh! +* +* Revision 1.9 2003/05/20 15:12:33 farhi +* malloc size for read table binary now needs less memory +* +* Revision 1.8 2003/02/11 12:28:46 farhi +* Variouxs bug fixes after tests in the lib directory +* mcstas_r : disable output with --no-out.. flag. Fix 1D McStas output +* read_table:corrected MC_SYS_DIR -> MCSTAS define +* monitor_nd-lib: fix Log(signal) log(coord) +* HOPG.trm: reduce 4000 points -> 400 which is enough and faster to resample +* Progress_bar: precent -> percent parameter +* CS: ---------------------------------------------------------------------- +* +* Revision 1.8 2003/02/06 14:14:41 farhi +* Corrected MC_SYS_DIR into MCSTAS definition of default lib location +* +* Revision 1.2 2002/12/19 12:48:07 ef +* Added binary import. Fixed Rebin. Added Stat. +* +* Revision 1.1 2002/08/29 11:39:00 ef +* Initial revision extracted from lib/optics/Monochromators... +*******************************************************************************/ + +#ifndef READ_TABLE_LIB_H +#error McStas : please import this library with %include "read_table-lib" +#endif + +/******************************************************************************* +* long Read_Table(t_Table *Table, char *name, int block_number) +* input Table: pointer to a t_Table structure +* name: file name from which table should be extracted +* block_number: if the file does contain more than one +* data block, then indicates which one to get (from index 1) +* a 0 value means append/catenate all +* return modified Table t_Table structure containing data, header, ... +* number of read elements (-1: error, 0:header only) +* The routine stores any line starting with '#', '%' and ';' into the header +* File is opened, read and closed +* Other lines are interpreted as numerical data, and stored. +* Data block should be a rectangular matrix or vector. +* Data block may be rebined with Table_Rebin (also sort in ascending order) +*******************************************************************************/ + long Table_Read(t_Table *mc_rt_Table, char *mc_rt_File, long mc_rt_block_number) + { /* reads all/a data block in 'file' and returns a Table structure */ + long mc_rt_offset=0; + return(Table_Read_Offset(mc_rt_Table, mc_rt_File, mc_rt_block_number, &mc_rt_offset, 0)); + + } /* end Table_Read */ + +/******************************************************************************* +* long Table_Read_Offset(t_Table *Table, char *name, int block_number, long *mc_rt_offset +* long mc_rt_max_lines) +* Same as Table_Read(..) except: +* input mc_rt_offset: pointer to an mc_rt_offset (*mc_rt_offset should be 0 at start) +* mc_rt_max_lines: max number of data rows to read from file (0 means all) +* return also updated *mc_rt_offset position (where end of reading occured) +*******************************************************************************/ + long Table_Read_Offset(t_Table *mc_rt_Table, char *mc_rt_File, long mc_rt_block_number, long *mc_rt_offset, long mc_rt_max_lines) + { /* reads all/a data block in 'file' and returns a Table structure */ + FILE *mc_rt_hfile; + long mc_rt_nelements; + + if (!mc_rt_File) return (-1); + if (strlen(mc_rt_File) == 0) return (-1); + mc_rt_hfile = fopen(mc_rt_File, "r"); + if(!mc_rt_hfile) + { + char mc_rt_path[256]; + char mc_rt_dir[256]; + + if (!strchr(mc_rt_File, MC_PATHSEP_C)) + { + if (getenv("MCSTAS")) strcpy(mc_rt_dir, getenv("MCSTAS")); + else strcpy(mc_rt_dir, MCSTAS); + sprintf(mc_rt_path, "%s%c%s%c%s", mc_rt_dir, MC_PATHSEP_C, "data", MC_PATHSEP_C, mc_rt_File); + mc_rt_hfile = fopen(mc_rt_path, "r"); + } + if(!mc_rt_hfile) + { + fprintf(stderr, "Error: Could not open input file '%s' (Table_Read)\n", mc_rt_File); + return (-1); + } + } + if (mc_rt_offset && *mc_rt_offset) fseek(mc_rt_hfile, *mc_rt_offset, SEEK_SET); + mc_rt_nelements = Table_Read_Handle(mc_rt_Table, mc_rt_hfile, mc_rt_block_number, mc_rt_max_lines); + strncpy(mc_rt_Table->filename, mc_rt_File, 128); + if (mc_rt_offset) *mc_rt_offset=ftell(mc_rt_hfile); + fclose(mc_rt_hfile); + return(mc_rt_nelements); + + } /* end Table_Read_Offset */ + +/******************************************************************************* +* long Table_Read_Offset_Binary(t_Table *mc_rt_Table, char *mc_rt_File, char *mc_rt_type, +* long +mc_rt_offset, long mc_rt_max_lines) +* Same as Table_Read_Offset(..) except that it handles binary files. +* input mc_rt_type: may be "float" or "double" +* mc_rt_offset: pointer to an mc_rt_offset (*mc_rt_offset should be 0 at start) +* mc_rt_columns: number of columns +* mc_rt_rows : max number of data rows to read from file (0 means all) +* return also updated *mc_rt_offset position (where end of reading occured) +*******************************************************************************/ + long Table_Read_Offset_Binary(t_Table *mc_rt_Table, char *mc_rt_File, char *mc_rt_type, long *mc_rt_offset, long mc_rt_rows, long mc_rt_columns) + { + long mc_rt_nelements, mc_rt_sizeofelement; + long mc_rt_filesize; + FILE *mc_rt_hfile; + struct stat mc_rt_stfile; + double *mc_rt_data; + long mc_rt_i; + + Table_Init(mc_rt_Table); + + stat(mc_rt_File,&mc_rt_stfile); + mc_rt_filesize = mc_rt_stfile.st_size; + mc_rt_hfile = fopen(mc_rt_File, "r"); + if(!mc_rt_hfile) + { + char mc_rt_path[256]; + char mc_rt_dir[256]; + + if (!strchr(mc_rt_File, MC_PATHSEP_C)) + { + if (getenv("MCSTAS")) strcpy(mc_rt_dir, getenv("MCSTAS")); + else strcpy(mc_rt_dir, MCSTAS); + sprintf(mc_rt_path, "%s%c%s%c%s", mc_rt_dir, MC_PATHSEP_C, "data", MC_PATHSEP_C, mc_rt_File); + mc_rt_hfile = fopen(mc_rt_path, "r"); + } + if(!mc_rt_hfile) + { + fprintf(stderr, "Error: Could not open input file '%s' (Table_Read_Binary)\n", mc_rt_File); + return (-1); + } + } + if (mc_rt_type && !strcmp(mc_rt_type,"double")) mc_rt_sizeofelement = sizeof(double); + else mc_rt_sizeofelement = sizeof(float); + if (mc_rt_offset && *mc_rt_offset) fseek(mc_rt_hfile, *mc_rt_offset, SEEK_SET); + if (mc_rt_rows && mc_rt_filesize > mc_rt_sizeofelement*mc_rt_columns*mc_rt_rows) + mc_rt_nelements = mc_rt_columns*mc_rt_rows; + else mc_rt_nelements = (long)(mc_rt_filesize/mc_rt_sizeofelement); + if (!mc_rt_nelements || mc_rt_filesize <= *mc_rt_offset) return(0); + mc_rt_data = (double*)malloc(mc_rt_nelements*mc_rt_sizeofelement); + if (!mc_rt_data) { + fprintf(stderr,"Error: allocating %d elements for %s file '%s'. Too big (Table_Read_Offset_Binary).\n", mc_rt_nelements, mc_rt_type, mc_rt_File); + exit(-1); + } + mc_rt_nelements = fread(mc_rt_data, mc_rt_sizeofelement, mc_rt_nelements, mc_rt_hfile); + + if (!mc_rt_data || !mc_rt_nelements) + { + fprintf(stderr,"Error: reading %d elements from %s file '%s' (Table_Read_Offset_Binary)\n", mc_rt_nelements, mc_rt_type, mc_rt_File); + exit(-1); + } + if (mc_rt_offset) *mc_rt_offset=ftell(mc_rt_hfile); + fclose(mc_rt_hfile); + mc_rt_data = (double*)realloc(mc_rt_data, (double)mc_rt_nelements*mc_rt_sizeofelement); + /* copy file data into Table */ + if (mc_rt_type && !strcmp(mc_rt_type,"double")) mc_rt_Table->data = mc_rt_data; + else { + float *mc_rt_s; + double *mc_rt_dataf; + mc_rt_s = (float*)mc_rt_data; + mc_rt_dataf = (double*)malloc(sizeof(double)*mc_rt_nelements); + for (mc_rt_i=0; mc_rt_idata = mc_rt_dataf; + } + strcpy(mc_rt_Table->filename, mc_rt_File); + mc_rt_Table->rows = mc_rt_nelements/mc_rt_columns; + mc_rt_Table->columns = mc_rt_columns; + Table_Stat(mc_rt_Table); + + return(mc_rt_nelements); + } /* end Table_Read_Offset_Binary */ + +/******************************************************************************* +* long Read_Table_Handle(t_Table *Table, FILE *fid, int block_number) +* input Table:pointer to a t_Table structure +* fid: pointer to FILE handle +* block_number: if the file does contain more than one +* data block, then indicates which one to get (from index 1) +* a 0 value means append/catenate all +* mc_rt_max_lines: if non 0, only reads that number of lines +* return modified Table t_Table structure containing data, header, ... +* number of read elements (-1: error, 0:header only) +* The routine stores any line starting with '#', '%' and ';' into the header +* Other lines are interpreted as numerical data, and stored. +* Data block should be a rectangular matrix or vector. +* Data block may be rebined with Table_Rebin (also sort in ascending order) +*******************************************************************************/ + long Table_Read_Handle(t_Table *mc_rt_Table, FILE *mc_rt_hfile, long mc_rt_block_number, long mc_rt_max_lines) + { /* reads all/a data block in 'file' and returns a Table structure */ + double *mc_rt_Data; + char *mc_rt_Header; + long mc_rt_malloc_size = 1024; + long mc_rt_malloc_size_h = 4096; + char mc_rt_flag_exit_loop = 0; + long mc_rt_Rows = 0, mc_rt_Columns = 0; + long mc_rt_count_in_array = 0; + long mc_rt_count_in_header = 0; + long mc_rt_cur_block_number = 0; + char mc_rt_flag_in_array = 0; + + Table_Init(mc_rt_Table); + + if(!mc_rt_hfile) + { + fprintf(stderr, "Error: File handle is NULL (Table_Read_Handle).\n"); + return (-1); + } + mc_rt_Header = (char*) malloc(mc_rt_malloc_size_h*sizeof(char)); + mc_rt_Data = (double*)malloc(mc_rt_malloc_size *sizeof(double)); + if ((mc_rt_Header == NULL) || (mc_rt_Data == NULL)) + { + fprintf(stderr, "Error: Could not allocate Table and Header (Table_Read_Handle).\n"); + return (-1); + } + mc_rt_Header[0] = '\0'; + + while (!mc_rt_flag_exit_loop) + { + char mc_rt_line[4096]; + long mc_rt_back_pos=0; + + mc_rt_back_pos = ftell(mc_rt_hfile); + if (fgets(mc_rt_line, 4096, mc_rt_hfile) != NULL) + { /* tries to read some informations from the file */ + int mc_rt_i=0; + /* first skip blank and tabulation characters */ + while (mc_rt_line[mc_rt_i] == ' ' || mc_rt_line[mc_rt_i] == '\t') mc_rt_i++; + if ((mc_rt_line[mc_rt_i] == '#') || (mc_rt_line[mc_rt_i] == '%') + || (mc_rt_line[mc_rt_i] == ';') || (mc_rt_line[mc_rt_i] == '/')) + { + if (mc_rt_flag_in_array && mc_rt_block_number) + mc_rt_count_in_header = 0; /* comment comes after a data block */ + mc_rt_count_in_header += strlen(mc_rt_line); + if (mc_rt_count_in_header+4096 > mc_rt_malloc_size_h) + { /* if succeed and in array : add (and realloc if necessary) */ + mc_rt_malloc_size_h = mc_rt_count_in_header+4096; + mc_rt_Header = (char*)realloc(mc_rt_Header, mc_rt_malloc_size_h*sizeof(char)); + } + strncat(mc_rt_Header, mc_rt_line, 4096); + mc_rt_flag_in_array = 0; /* will start a new data block */ + } /* line is a comment */ + else + { + double mc_rt_X; + + /* get the number of columns splitting mc_rt_line with strtok */ + if (sscanf(mc_rt_line,"%lg ",&mc_rt_X) == 1) /* mc_rt_line begins at least with one num */ + { + char *mc_rt_InputTokens, *mc_rt_lexeme; + char mc_rt_End_Line_Scanning_Flag= 0; + long mc_rt_This_Line_Columns = 0; + + mc_rt_InputTokens = mc_rt_line; + + while (!mc_rt_End_Line_Scanning_Flag) + { + mc_rt_lexeme = (char *)strtok(mc_rt_InputTokens, " ,;\t\n\r"); + mc_rt_InputTokens = NULL; + if ((mc_rt_lexeme != NULL) && (strlen(mc_rt_lexeme) != 0)) + { + if (sscanf(mc_rt_lexeme,"%lg ",&mc_rt_X) == 1) /* found a number */ + { + if (mc_rt_flag_in_array == 0 + && (((mc_rt_block_number == 0) || (mc_rt_block_number > mc_rt_cur_block_number)))) /* not already in a block -> start */ + { /* starts a new data block */ + if (mc_rt_block_number) + { /* initialise a new data block */ + mc_rt_Rows = 0; + mc_rt_count_in_array = 0; + } /* else append */ + mc_rt_cur_block_number++; + mc_rt_flag_in_array = 1; + mc_rt_This_Line_Columns= 0; /* starts the first data row of this block */ + + } + if (mc_rt_flag_in_array && ((mc_rt_block_number == 0) || (mc_rt_block_number == mc_rt_cur_block_number))) + { /* append all, or within requested block -> store data in row */ + if (mc_rt_count_in_array >= mc_rt_malloc_size) + { /* if succeed and in array : add (and realloc if necessary) */ + mc_rt_malloc_size = mc_rt_count_in_array+1024; + mc_rt_Data = (double*)realloc(mc_rt_Data, mc_rt_malloc_size*sizeof(double)); + if (mc_rt_Data == NULL) + { + fprintf(stderr, "Error: Can not re-allocate memory %i (Table_Read_Handle).\n", mc_rt_malloc_size*sizeof(double)); + return (-1); + } + } + /* test if we've read already the desired number of data lines */ + if (mc_rt_This_Line_Columns == 0 + && mc_rt_max_lines && mc_rt_Rows >= mc_rt_max_lines) { + mc_rt_End_Line_Scanning_Flag = 1; + mc_rt_flag_exit_loop = 1; + mc_rt_flag_in_array = 0; + /* reposition to begining of line */ + fseek(mc_rt_hfile, mc_rt_back_pos, SEEK_SET); + } else { /* store into data array */ + if (mc_rt_This_Line_Columns == 0) mc_rt_Rows++; + mc_rt_Data[mc_rt_count_in_array] = mc_rt_X; + mc_rt_count_in_array++; + mc_rt_This_Line_Columns++; + } + } + else + { /* not in a block to store */ + if ((mc_rt_block_number) && (mc_rt_cur_block_number > mc_rt_block_number)) + { /* we finished to extract block -> force end of file reading */ + mc_rt_End_Line_Scanning_Flag = 1; + mc_rt_flag_exit_loop = 1; + mc_rt_flag_in_array = 0; + } + } + } /* end if sscanf mc_rt_lexeme -> numerical */ + else + { /* token is not numerical in that line */ + mc_rt_End_Line_Scanning_Flag = 1; mc_rt_flag_in_array = 0; + } + } + else + { /* no more tokens in mc_rt_line */ + mc_rt_End_Line_Scanning_Flag = 1; + if (mc_rt_This_Line_Columns) mc_rt_Columns = mc_rt_This_Line_Columns; + } + } /* end while mc_rt_End_Line_Scanning_Flag */ + } + else + { /* non-comment line does not begin with a number: ignore line */ + mc_rt_flag_in_array = 0; + } + } /* end: if not mc_rt_line comment else numerical */ + } /* end: if fgets */ + else mc_rt_flag_exit_loop = 1; /* else fgets : end of file */ + } /* end while mc_rt_flag_exit_loop */ + + mc_rt_Table->block_number = mc_rt_block_number; + if (mc_rt_count_in_header) mc_rt_Header = (char*)realloc(mc_rt_Header, mc_rt_count_in_header*sizeof(char)); + mc_rt_Table->header = mc_rt_Header; + if (mc_rt_count_in_array*mc_rt_Rows*mc_rt_Columns == 0) + { + mc_rt_Table->rows = 0; + mc_rt_Table->columns = 0; + free(mc_rt_Data); + return (0); + } + if (mc_rt_Rows * mc_rt_Columns != mc_rt_count_in_array) + { + fprintf(stderr, "Warning: Read_Table : Data has %li values that should be %li x %li\n", mc_rt_count_in_array, mc_rt_Rows, mc_rt_Columns); + mc_rt_Columns = mc_rt_count_in_array; mc_rt_Rows = 1; + } + mc_rt_Data = (double*)realloc(mc_rt_Data, mc_rt_count_in_array*sizeof(double)); + mc_rt_Table->data = mc_rt_Data; + mc_rt_Table->rows = mc_rt_Rows; + mc_rt_Table->columns = mc_rt_Columns; + Table_Stat(mc_rt_Table); + return (mc_rt_count_in_array); + + } /* end Table_Read_Handle */ + +/******************************************************************************* +* long Rebin_Table(t_Table *Table) +* input Table: table containing data +* return new Table with increasing, evenly spaced first column (index 0) +* number of data elements (-1: error, 0:header only) +*******************************************************************************/ + long Table_Rebin(t_Table *mc_rt_Table) + { + double mc_rt_new_step=0; + long mc_rt_i; + long mc_rt_tmp; + char mc_rt_monotonic = 1; + /* performs linear interpolation on X axis (0-th column) */ + + if (!mc_rt_Table->data + || mc_rt_Table->rows*mc_rt_Table->columns == 0 || !mc_rt_Table->step_x) + return(0); + mc_rt_tmp = mc_rt_Table->rows; + mc_rt_new_step = mc_rt_Table->step_x; + for (mc_rt_i=0; mc_rt_i < mc_rt_Table->rows - 1; mc_rt_i++) + { + double mc_rt_current_step; + double mc_rt_X, mc_rt_diff; + mc_rt_X = Table_Index(*mc_rt_Table,mc_rt_i ,0); + mc_rt_diff = Table_Index(*mc_rt_Table,mc_rt_i+1,0) - mc_rt_X; + mc_rt_current_step = fabs(mc_rt_diff); + if ((mc_rt_Table->max_x - mc_rt_Table->min_x)*mc_rt_diff < 0 && mc_rt_monotonic && mc_rt_Table->columns > 1) + { + fprintf(stderr, "Warning: Rebin_Table : Data from file '%s' (%li x %li) is not monotonic (at row %li)\n", mc_rt_Table->filename, mc_rt_Table->rows, mc_rt_Table->columns, mc_rt_i); + mc_rt_monotonic = 0; + } + if (mc_rt_current_step > 0 && mc_rt_current_step < mc_rt_new_step) mc_rt_new_step = mc_rt_current_step; + else mc_rt_tmp--; + } /* for */ + if (fabs(mc_rt_new_step/mc_rt_Table->step_x) >= 0.98) + return (mc_rt_Table->rows*mc_rt_Table->columns); + if (mc_rt_tmp > 0 && mc_rt_new_step > 0 && mc_rt_Table->columns > 1) /* table was not already evenly sampled */ + { + long mc_rt_Length_Table; + double *mc_rt_New_Table; + /* modify step if leads to too many points */ + if (mc_rt_Table->rows > 2000) + if (mc_rt_new_step < mc_rt_Table->step_x) + mc_rt_new_step = mc_rt_Table->step_x; + if (mc_rt_new_step*10 < mc_rt_Table->step_x) + mc_rt_new_step = mc_rt_Table->step_x/10; + mc_rt_Length_Table = ceil(fabs(mc_rt_Table->max_x - mc_rt_Table->min_x)/mc_rt_new_step); + mc_rt_New_Table = (double*)malloc(mc_rt_Length_Table*mc_rt_Table->columns*sizeof(double)); + + for (mc_rt_i=0; mc_rt_i < mc_rt_Length_Table; mc_rt_i++) + { + long mc_rt_j; + long mc_rt_old_i; + double mc_rt_X; + double mc_rt_X1, mc_rt_X2, mc_rt_Y1, mc_rt_Y2; + char mc_rt_test=0; + mc_rt_X = mc_rt_Table->min_x + mc_rt_i*mc_rt_new_step; + mc_rt_New_Table[mc_rt_i*mc_rt_Table->columns] = mc_rt_X; + /* look for index surrounding X in the old table -> index old_i, old-1 */ + for (mc_rt_old_i=1; mc_rt_old_i < mc_rt_Table->rows-1; mc_rt_old_i++) + { + mc_rt_X2 = Table_Index(*mc_rt_Table,mc_rt_old_i ,0); + mc_rt_X1 = Table_Index(*mc_rt_Table,mc_rt_old_i-1,0); + if (mc_rt_Table->min_x < mc_rt_Table->max_x) + mc_rt_test = ((mc_rt_X1 <= mc_rt_X) && (mc_rt_X < mc_rt_X2)); + else + mc_rt_test = ((mc_rt_X2 <= mc_rt_X) && (mc_rt_X < mc_rt_X1)); + if (mc_rt_test) break; + } + + for (mc_rt_j=1; mc_rt_j < mc_rt_Table->columns; mc_rt_j++) + { + mc_rt_Y2 = Table_Index(*mc_rt_Table,mc_rt_old_i ,mc_rt_j); + mc_rt_Y1 = Table_Index(*mc_rt_Table,mc_rt_old_i-1,mc_rt_j); + if (mc_rt_X2-mc_rt_X1) + { + /* linear interpolation */ + double mc_rt_slope = (mc_rt_Y2-mc_rt_Y1)/(mc_rt_X2-mc_rt_X1); + mc_rt_New_Table[mc_rt_i*mc_rt_Table->columns+mc_rt_j] = mc_rt_Y1+mc_rt_slope*(mc_rt_X-mc_rt_X1); + } + else + mc_rt_New_Table[mc_rt_i*mc_rt_Table->columns+mc_rt_j] = mc_rt_Y2; + } + + } /* end for i */ + mc_rt_Table->rows = mc_rt_Length_Table; + mc_rt_Table->step_x = mc_rt_new_step; + free(mc_rt_Table->data); + mc_rt_Table->data = mc_rt_New_Table; + } /* end if tmp */ + return (mc_rt_Table->rows*mc_rt_Table->columns); + } /* end Rebin_Table */ + +/******************************************************************************* +* double Table_Index(t_Table Table, long i, long j) +* input Table: table containing data +* i : index of row (0:mc_rt_Rows-1) +* j : index of column (0:Columns-1) +* return Value = data[i][j] +* Returns Value from the i-th row, j-th column of Table +* Tests are performed on indexes i,j to avoid errors +*******************************************************************************/ + double Table_Index(t_Table mc_rt_Table, long mc_rt_i, long mc_rt_j) + { + long mc_rt_AbsIndex; + + if (mc_rt_i < 0) mc_rt_i = 0; + if (mc_rt_i >= mc_rt_Table.rows) mc_rt_i = mc_rt_Table.rows-1; + if (mc_rt_j < 0) mc_rt_j = 0; + if (mc_rt_j >= mc_rt_Table.columns) mc_rt_j = mc_rt_Table.columns-1; + mc_rt_AbsIndex = mc_rt_i*(mc_rt_Table.columns)+mc_rt_j; + if (mc_rt_Table.data != NULL) + return(mc_rt_Table.data[mc_rt_AbsIndex]); + else + return(0); + } + +/******************************************************************************* +* double Table_Value(t_Table Table, double X, long j) +* input Table: table containing data +* X : data value in the first column (index 0) +* j : index of column from which is extracted the Value (0:Columns-1) +* return Value = data[index for X][j] +* Returns Value from the j-th column of Table corresponding to the +* X value for the 1st column (index 0) +* Tests are performed (within Table_Index) on indexes i,j to avoid errors +* NOTE: data should rather be monotonic, and evenly sampled. +*******************************************************************************/ + double Table_Value(t_Table mc_rt_Table, double X, long j) + { + long mc_rt_Index; + double mc_rt_Value; + + if (mc_rt_Table.step_x != 0) + mc_rt_Index = floor((X - mc_rt_Table.min_x)/mc_rt_Table.step_x); + else mc_rt_Index=0; + mc_rt_Value = Table_Index(mc_rt_Table, mc_rt_Index, j); + + return(mc_rt_Value); + } +/******************************************************************************* +* void Table_Free(t_Table *Table) +*******************************************************************************/ + void Table_Free(t_Table *mc_rt_Table) + { + if (mc_rt_Table->data != NULL) free(mc_rt_Table->data); + if (mc_rt_Table->header != NULL) free(mc_rt_Table->header); + mc_rt_Table->data = NULL; + mc_rt_Table->header = NULL; + } +/****************************************************************************** +* void Table_Info(t_Table Table) +* prints informations about a Table +*******************************************************************************/ + void Table_Info(t_Table mc_rt_Table) + { + printf("Table from file '%s'", mc_rt_Table.filename); + if (mc_rt_Table.block_number) printf(" (block %li)", mc_rt_Table.block_number); + if ((mc_rt_Table.data != NULL) && (mc_rt_Table.rows*mc_rt_Table.columns)) + { + printf(" is %li x %li.\n", mc_rt_Table.rows, mc_rt_Table.columns); + /* printf("Data axis range %f-%f, step=%f\n", mc_rt_Table.min_x, mc_rt_Table.max_x, mc_rt_Table.step_x); */ + } + else printf(" is empty.\n"); + } + +/****************************************************************************** +* void Table_Init(t_Table *Table) +* initialise a Table to empty +*******************************************************************************/ + void Table_Init(t_Table *mc_rt_Table) + { + mc_rt_Table->data = NULL; + mc_rt_Table->header = NULL; + mc_rt_Table->filename[0]= '\0'; + mc_rt_Table->rows = 0; + mc_rt_Table->columns = 0; + mc_rt_Table->min_x = 0; + mc_rt_Table->max_x = 0; + mc_rt_Table->step_x = 0; + mc_rt_Table->block_number = 0; + } + +/****************************************************************************** +* void Table_Star(t_Table *Table) +* computes min/max/mean step of 1st column +*******************************************************************************/ + static void Table_Stat(t_Table *mc_rt_Table) + { + long mc_rt_i; + double mc_rt_max_x, mc_rt_min_x; + + if (!mc_rt_Table->rows || !mc_rt_Table->columns) return; + mc_rt_max_x = mc_rt_Table->data[0]; + mc_rt_min_x = mc_rt_Table->data[(mc_rt_Table->rows-1)*mc_rt_Table->columns]; + + for (mc_rt_i=0; mc_rt_i < mc_rt_Table->rows - 1; mc_rt_i++) + { + double mc_rt_X; + mc_rt_X = Table_Index(*mc_rt_Table,mc_rt_i ,0); + if (mc_rt_X < mc_rt_min_x) mc_rt_min_x = mc_rt_X; + if (mc_rt_X > mc_rt_max_x) mc_rt_max_x = mc_rt_X; + } /* for */ + mc_rt_Table->max_x = mc_rt_max_x; + mc_rt_Table->min_x = mc_rt_min_x; + mc_rt_Table->step_x = (mc_rt_Table->max_x - mc_rt_Table->min_x)/mc_rt_Table->rows; + } + +/* end of read_table-lib.c */ + + +long Virtual_input_Read_Input(char *aFile, char *aType, t_Table *aTable, long *aOffset) + { + long max_lines = 50000; + long length=0; + char bType[32]; + + if (!aFile) return (-1); + if (aType) strcpy(bType, aType); + else strcpy(bType, "???"); + + Table_Free(aTable); + + /* Try to Open neutron input text file. */ + if((aFile && aType == NULL) || !strcmp(bType,"text")) { + Table_Read_Offset(aTable, aFile, 0, aOffset, max_lines); /* read data from file into rTable */ + strcpy(bType, "text"); + } + if (!aTable->data && aType && aType[0] != 't') + Table_Read_Offset_Binary(aTable, aFile, aType, aOffset, max_lines, 11); + + return(aTable->rows); + } +#line 5023 "dmcafter.c" +#line 103 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/sources/Virtual_input.comp" + int rep=0; /* Neutron repeat count */ + long pos=0; + long nrows=0; + long nread=0; + long Offset=0; + t_Table rTable; +#line 5031 "dmcafter.c" +#undef bufsize +#undef repeat_count +#undef Virtual_input_Read_Input +#undef rTable +#undef Offset +#undef nread +#undef nrows +#undef pos +#undef rep +#undef type +#undef file +#undef mccompcurname +#undef mccompcurindex + +/* User declarations for component 'out2_slit' [7]. */ +#define mccompcurname out2_slit +#define mccompcurindex 3 +#define xmin mccout2_slit_xmin +#define xmax mccout2_slit_xmax +#define ymin mccout2_slit_ymin +#define ymax mccout2_slit_ymax +#define radius mccout2_slit_radius +/* Shared user declarations for all components 'Slit'. */ +#undef radius +#undef ymax +#undef ymin +#undef xmax +#undef xmin +#undef mccompcurname +#undef mccompcurindex + +/* User declarations for component 'PSD_sample' [7]. */ +#define mccompcurname PSD_sample +#define mccompcurindex 4 +#define Nsum mccPSD_sample_Nsum +#define psum mccPSD_sample_psum +#define p2sum mccPSD_sample_p2sum +#define currentCount mccPSD_sample_currentCount +#define xmin mccPSD_sample_xmin +#define xmax mccPSD_sample_xmax +#define ymin mccPSD_sample_ymin +#define ymax mccPSD_sample_ymax +#define controlfile mccPSD_sample_controlfile +#define dumpCount mccPSD_sample_dumpCount +/* Shared user declarations for all components 'MKMonitor'. */ +#line 50 "MKMonitor.comp" + void dumpTotal(char *ffilename, long totalCounts){ + FILE *fd = NULL; + char tmp[1024]; + + strncpy(tmp,ffilename, 1000); + strcat(tmp,"tmp"); + fd = fopen(tmp,"w"); + if(fd != NULL){ + fprintf(fd,"%ld\n",totalCounts); + fclose(fd); + rename(tmp,ffilename); + unlink(tmp); + } + } +#line 5092 "dmcafter.c" +#line 67 "MKMonitor.comp" + long currentCount; + double Nsum; + double psum, p2sum; +#line 5097 "dmcafter.c" +#undef dumpCount +#undef controlfile +#undef ymax +#undef ymin +#undef xmax +#undef xmin +#undef currentCount +#undef p2sum +#undef psum +#undef Nsum +#undef mccompcurname +#undef mccompcurindex + +/* User declarations for component 'sample' [7]. */ +#define mccompcurname sample +#define mccompcurindex 6 +#define reflections mccsample_reflections +#define my_s_v2 mccsample_my_s_v2 +#define my_a_v mccsample_my_a_v +#define q_v mccsample_q_v +#define d_phi0 mccsample_d_phi0 +#define radius mccsample_radius +#define focus_r mccsample_focus_r +#define h mccsample_h +#define pack mccsample_pack +#define Vc mccsample_Vc +#define sigma_a mccsample_sigma_a +#define sigma_inc mccsample_sigma_inc +#define frac mccsample_frac +#define focus_xw mccsample_focus_xw +#define focus_yh mccsample_focus_yh +#define focus_aw mccsample_focus_aw +#define focus_ah mccsample_focus_ah +#define target_x mccsample_target_x +#define target_y mccsample_target_y +#define target_z mccsample_target_z +#define target_index mccsample_target_index +/* Shared user declarations for all components 'PowderN'. */ +#line 70 "PowderN.comp" + /* used for reading data table from file */ + +/* Declare structures and functions only once in each instrument. */ +#ifndef POWDERN_DECL +#define POWDERN_DECL + + struct line_data + { + double F2; /* Value of structure factor */ + double q; /* Qvector */ + int j; /* Multiplicity */ + double DW; /* Debye-Waller factor */ + double w; /* Intrinsic line width */ + }; + + struct line_info_struct + { + struct line_data *list; /* Reflection array */ + int count; /* Number of reflections */ + }; + + void + read_line_data(char *SC_file, struct line_info_struct *info) + { + struct line_data *list = NULL; + int size = 0; + t_Table sTable; /* sample data table structure from SC_file */ + int i=0; + + Table_Read(&sTable, SC_file, 1); /* read 1st block data from SC_file into sTable*/ + if (sTable.columns < 5) + exit(fprintf(stderr, "PowderN: Error: The number of columns in %s should be at least %d for [j,q,F2,DW,w]\n", SC_file, 5)); + if (!sTable.rows) + exit(fprintf(stderr, "PowderN: Error: The number of rows in %s should be at least %d\n", SC_file, 1)); + else size = sTable.rows; + printf("PowderN: Reading in %d rows from %s... ",size, SC_file); + /* allocate line_data array */ + list = (struct line_data*)malloc(size*sizeof(struct line_data)); + for (i=0; ilist = list; + info->count = i; + } +#endif /* !POWDERN_DECL */ + +#line 5203 "dmcafter.c" +#line 141 "PowderN.comp" + struct line_info_struct line_info; + int Nq; + double *my_s_v2, my_s_v2_sum; + double my_a_v, my_inc, *q_v; + double *w_v, v, solid_angle; +#line 5210 "dmcafter.c" +#undef target_index +#undef target_z +#undef target_y +#undef target_x +#undef focus_ah +#undef focus_aw +#undef focus_yh +#undef focus_xw +#undef frac +#undef sigma_inc +#undef sigma_a +#undef Vc +#undef pack +#undef h +#undef focus_r +#undef radius +#undef d_phi0 +#undef q_v +#undef my_a_v +#undef my_s_v2 +#undef reflections +#undef mccompcurname +#undef mccompcurindex + +/* User declarations for component 'Det9' [7]. */ +#define mccompcurname Det9 +#define mccompcurindex 7 +#define options mccDet9_options +#define filename mccDet9_filename +#define DEFS mccDet9_DEFS +#define Vars mccDet9_Vars +#define xwidth mccDet9_xwidth +#define yheight mccDet9_yheight +#define zthick mccDet9_zthick +#define xmin mccDet9_xmin +#define xmax mccDet9_xmax +#define ymin mccDet9_ymin +#define ymax mccDet9_ymax +#define zmin mccDet9_zmin +#define zmax mccDet9_zmax +/* Shared user declarations for all components 'Monitor_nD'. */ +#line 208 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Library: share/monitor_nd-lib.h +* +* %Identification +* Written by: EF +* Date: Aug 28, 2002 +* Origin: ILL +* Release: McStas 1.6 +* Version: 1.1 +* +* This file is to be imported by the monitor_nd related components +* It handles some shared functions. +* +* Usage: within SHARE +* %include "monitor_nd-lib" +* +* $Id: dmcafter.c,v 1.2 2007-02-12 01:19:07 ffr Exp $ +* +* $Log: not supported by cvs2svn $ +* Revision 1.1.2.1 2007/02/06 04:03:21 ffr +* PSI Update +* +* Revision 1.1 2007/01/30 03:19:43 koennecke +* - Fixed state monitor eclipse commit problems. Siiiiiiiggggghhhhhh! +* +* Revision 1.8 2003/02/11 12:28:46 farhi +* Variouxs bug fixes after tests in the lib directory +* mcstas_r : disable output with --no-out.. flag. Fix 1D McStas output +* read_table:corrected MC_SYS_DIR -> MCSTAS define +* monitor_nd-lib: fix Log(signal) log(coord) +* HOPG.trm: reduce 4000 points -> 400 which is enough and faster to resample +* Progress_bar: precent -> percent parameter +* CS: ---------------------------------------------------------------------- +* +* Revision 1.1 2002/08/28 11:39:00 ef +* Initial revision extracted from lib/monitors/Monitor_nD.comp +*******************************************************************************/ + +#ifndef MONITOR_ND_LIB_H + +#define MONITOR_ND_LIB_H "1.1.1" +#define MONnD_COORD_NMAX 30 /* max number of variables to record */ + + typedef struct MonitornD_Defines + { + char COORD_NONE ; + char COORD_X ; + char COORD_Y ; + char COORD_Z ; + char COORD_VX ; + char COORD_VY ; + char COORD_VZ ; + char COORD_T ; + char COORD_P ; + char COORD_SX ; + char COORD_SY ; + char COORD_SZ ; + char COORD_KX ; + char COORD_KY ; + char COORD_KZ ; + char COORD_K ; + char COORD_V ; + char COORD_ENERGY; + char COORD_LAMBDA; + char COORD_RADIUS; + char COORD_HDIV ; + char COORD_VDIV ; + char COORD_ANGLE ; + char COORD_NCOUNT; + char COORD_THETA ; + char COORD_PHI ; + char COORD_USER1 ; + char COORD_USER2 ; + + /* token modifiers */ + char COORD_VAR ; /* next token should be a variable or normal option */ + char COORD_MIN ; /* next token is a min value */ + char COORD_MAX ; /* next token is a max value */ + char COORD_DIM ; /* next token is a bin value */ + char COORD_FIL ; /* next token is a filename */ + char COORD_EVNT ; /* next token is a buffer size value */ + char COORD_3HE ; /* next token is a 3He pressure value */ + char COORD_INTERM; /* next token is an intermediate save value (percent) */ + char COORD_LOG ; /* next variable will be in log scale */ + char COORD_ABS ; /* next variable will be in abs scale */ + char COORD_SIGNAL; /* next variable will be the signal var */ + int COORD_AUTO ; /* set auto limits */ + + char TOKEN_DEL[32]; /* token separators */ + + char SHAPE_SQUARE; /* shape of the monitor */ + char SHAPE_DISK ; + char SHAPE_SPHERE; + char SHAPE_CYLIND; + char SHAPE_BANANA; /* cylinder without top/bottom, on restricted angular area */ + char SHAPE_BOX ; + + } MonitornD_Defines_type; + + typedef struct MonitornD_Variables + { + double area; + double Sphere_Radius ; + double Cylinder_Height ; + char Flag_With_Borders ; /* 2 means xy borders too */ + char Flag_List ; /* 1 store 1 buffer, 2 is list all, 3 list all+append */ + char Flag_Multiple ; /* 1 when n1D, 0 for 2D */ + char Flag_Verbose ; + int Flag_Shape ; + char Flag_Auto_Limits ; /* get limits from first Buffer */ + char Flag_Absorb ; /* monitor is also a slit */ + char Flag_per_cm2 ; /* flux is per cm2 */ + char Flag_log ; /* log10 of the flux */ + char Flag_parallel ; /* set neutron state back after detection (parallel components) */ + char Flag_Binary_List ; + char Flag_capture ; /* lambda monitor with lambda/lambda(2200m/s = 1.7985 Angs) weightening */ + int Flag_signal ; /* 0:monitor p, else monitor a mean value */ + + long Coord_Number ; /* total number of variables to monitor, plus intensity (0) */ + long Buffer_Block ; /* Buffer size for list or auto limits */ + long Neutron_Counter ; /* event counter, simulation total counts is mcget_ncount() */ + long Buffer_Counter ; /* index in Buffer size (for realloc) */ + long Buffer_Size ; + int Coord_Type[MONnD_COORD_NMAX]; /* type of variable */ + char Coord_Label[MONnD_COORD_NMAX][30]; /* label of variable */ + char Coord_Var[MONnD_COORD_NMAX][30]; /* short id of variable */ + long Coord_Bin[MONnD_COORD_NMAX]; /* bins of variable array */ + double Coord_Min[MONnD_COORD_NMAX]; + double Coord_Max[MONnD_COORD_NMAX]; + char Monitor_Label[MONnD_COORD_NMAX*30]; /* Label for monitor */ + char Mon_File[128]; /* output file name */ + + double cx,cy,cz; + double cvx, cvy, cvz; + double csx, csy, csz; + double cs1, cs2, ct, cp; + double He3_pressure; + char Flag_UsePreMonitor ; /* use a previously stored neutron parameter set */ + char UserName1[128]; + char UserName2[128]; + double UserVariable1; + double UserVariable2; + double Intermediate; + double IntermediateCnts; + char option[1024]; + + double Nsum; + double psum, p2sum; + double **Mon2D_N; + double **Mon2D_p; + double **Mon2D_p2; + double *Mon2D_Buffer; + + double mxmin,mxmax,mymin,mymax,mzmin,mzmax; + + char compcurname[128]; + + } MonitornD_Variables_type; + +/* monitor_nd-lib function prototypes */ +/* ========================================================================= */ + +void Monitor_nD_Init(MonitornD_Defines_type *, MonitornD_Variables_type *, MCNUM, MCNUM, MCNUM, MCNUM, MCNUM, MCNUM, MCNUM, MCNUM, MCNUM); +double Monitor_nD_Trace(MonitornD_Defines_type *, MonitornD_Variables_type *); +void Monitor_nD_Save(MonitornD_Defines_type *, MonitornD_Variables_type *); +void Monitor_nD_Finally(MonitornD_Defines_type *, MonitornD_Variables_type *); +void Monitor_nD_McDisplay(MonitornD_Defines_type *, + MonitornD_Variables_type *); + +#endif + +/* end of monitor_nd-lib.h */ +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Library: share/monitor_nd-lib.c +* +* %Identification +* Written by: EF +* Date: Aug 28, 2002 +* Origin: ILL +* Release: McStas 1.6 +* Version: 1.1 +* +* This file is to be imported by the monitor_nd related components +* It handles some shared functions. Embedded within instrument in runtime mode. +* Variable names have prefix 'mc_mn_' for 'McStas Monitor' to avoid conflicts +* +* Usage: within SHARE +* %include "monitor_nd-lib" +* +* $Id: dmcafter.c,v 1.2 2007-02-12 01:19:07 ffr Exp $ +* +* $Log: not supported by cvs2svn $ +* Revision 1.1.2.1 2007/02/06 04:03:21 ffr +* PSI Update +* +* Revision 1.1 2007/01/30 03:19:43 koennecke +* - Fixed state monitor eclipse commit problems. Siiiiiiiggggghhhhhh! +* +* Revision 1.15 2004/02/26 12:55:41 farhi +* Handles 0d monitor outputs for bins=0, and limits are restrictive (i.e. neutron must be within all limits to be stored in monitor) +* +* Revision 1.14 2004/02/04 18:01:12 farhi +* Use hdiv=theta and vdiv=phi for banana. +* +* Revision 1.13 2003/08/26 12:33:27 farhi +* Corrected computation of angle PHI (was projected on vertical plane) +* +* Revision 1.12 2003/04/15 16:01:28 farhi +* incoming/outgoing syntax mismatch correction +* +* Revision 1.11 2003/04/15 15:45:56 farhi +* outgoing time is default (vs. incoming) +* +* Revision 1.10 2003/04/09 15:49:25 farhi +* corrected bug when no signal and auto limits requested +* +* Revision 1.9 2003/02/18 09:11:36 farhi +* Corrected binary format for lists +* +* Revision 1.1 2002/08/28 11:39:00 ef +* Initial revision extracted from lib/monitors/Monitor_nD.comp +*******************************************************************************/ + +#ifndef MONITOR_ND_LIB_H +#error McStas : please import this library with %include "monitor_nd-lib" +#endif + +/* ========================================================================= */ +/* ADD: E.Farhi, Aug 6th, 2001: Monitor_nD section */ +/* this routine is used to parse options */ +/* ========================================================================= */ + +void Monitor_nD_Init(MonitornD_Defines_type *mc_mn_DEFS, + MonitornD_Variables_type *mc_mn_Vars, + MCNUM mc_mn_xwidth, + MCNUM mc_mn_yheight, + MCNUM mc_mn_zthick, + MCNUM mc_mn_xmin, + MCNUM mc_mn_xmax, + MCNUM mc_mn_ymin, + MCNUM mc_mn_ymax, + MCNUM mc_mn_zmin, + MCNUM mc_mn_zmax) + { + long mc_mn_carg = 1; + char *mc_mn_option_copy, *mc_mn_token; + char mc_mn_Flag_New_token = 1; + char mc_mn_Flag_End = 1; + char mc_mn_Flag_All = 0; + char mc_mn_Flag_No = 0; + char mc_mn_Flag_abs = 0; + int mc_mn_Flag_auto = 0; /* -1: all, 1: the current variable */ + int mc_mn_Set_Vars_Coord_Type; + char mc_mn_Set_Vars_Coord_Label[30]; + char mc_mn_Set_Vars_Coord_Var[30]; + char mc_mn_Short_Label[MONnD_COORD_NMAX][30]; + int mc_mn_Set_Coord_Mode; + long mc_mn_i=0, mc_mn_j=0; + double mc_mn_lmin, mc_mn_lmax, mc_mn_XY; + long mc_mn_t; + + + mc_mn_t = (long)time(NULL); + + mc_mn_DEFS->COORD_NONE =0; + mc_mn_DEFS->COORD_X =1; + mc_mn_DEFS->COORD_Y =2; + mc_mn_DEFS->COORD_Z =3; + mc_mn_DEFS->COORD_VX =4; + mc_mn_DEFS->COORD_VY =5; + mc_mn_DEFS->COORD_VZ =6; + mc_mn_DEFS->COORD_T =7; + mc_mn_DEFS->COORD_P =8; + mc_mn_DEFS->COORD_SX =9; + mc_mn_DEFS->COORD_SY =10; + mc_mn_DEFS->COORD_SZ =11; + mc_mn_DEFS->COORD_KX =12; + mc_mn_DEFS->COORD_KY =13; + mc_mn_DEFS->COORD_KZ =14; + mc_mn_DEFS->COORD_K =15; + mc_mn_DEFS->COORD_V =16; + mc_mn_DEFS->COORD_ENERGY =17; + mc_mn_DEFS->COORD_LAMBDA =18; + mc_mn_DEFS->COORD_RADIUS =19; + mc_mn_DEFS->COORD_HDIV =20; + mc_mn_DEFS->COORD_VDIV =21; + mc_mn_DEFS->COORD_ANGLE =22; + mc_mn_DEFS->COORD_NCOUNT =23; + mc_mn_DEFS->COORD_THETA =24; + mc_mn_DEFS->COORD_PHI =25; + mc_mn_DEFS->COORD_USER1 =26; + mc_mn_DEFS->COORD_USER2 =27; + +/* mc_mn_token modifiers */ + mc_mn_DEFS->COORD_VAR =0; /* next mc_mn_token should be a variable or normal option */ + mc_mn_DEFS->COORD_MIN =1; /* next mc_mn_token is a min value */ + mc_mn_DEFS->COORD_MAX =2; /* next mc_mn_token is a max value */ + mc_mn_DEFS->COORD_DIM =3; /* next mc_mn_token is a bin value */ + mc_mn_DEFS->COORD_FIL =4; /* next mc_mn_token is a filename */ + mc_mn_DEFS->COORD_EVNT =5; /* next mc_mn_token is a buffer size value */ + mc_mn_DEFS->COORD_3HE =6; /* next mc_mn_token is a 3He pressure value */ + mc_mn_DEFS->COORD_INTERM =7; /* next mc_mn_token is an intermediate save value (%) */ + mc_mn_DEFS->COORD_LOG =32; /* next variable will be in log scale */ + mc_mn_DEFS->COORD_ABS =64; /* next variable will be in abs scale */ + mc_mn_DEFS->COORD_SIGNAL =128; /* next variable will be the signal var */ + mc_mn_DEFS->COORD_AUTO =256; /* set auto limits */ + + strcpy(mc_mn_DEFS->TOKEN_DEL, " =,;[](){}:"); /* mc_mn_token separators */ + + mc_mn_DEFS->SHAPE_SQUARE =0; /* shape of the monitor */ + mc_mn_DEFS->SHAPE_DISK =1; + mc_mn_DEFS->SHAPE_SPHERE =2; + mc_mn_DEFS->SHAPE_CYLIND =3; + mc_mn_DEFS->SHAPE_BANANA =4; + mc_mn_DEFS->SHAPE_BOX =5; + + mc_mn_Vars->Sphere_Radius = 0; + mc_mn_Vars->Cylinder_Height = 0; + mc_mn_Vars->Flag_With_Borders = 0; /* 2 means xy borders too */ + mc_mn_Vars->Flag_List = 0; /* 1 store 1 buffer, 2 is list all */ + mc_mn_Vars->Flag_Multiple = 0; /* 1 when n1D, 0 for 2D */ + mc_mn_Vars->Flag_Verbose = 0; + mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_SQUARE; + mc_mn_Vars->Flag_Auto_Limits = 0; /* get limits from first Buffer */ + mc_mn_Vars->Flag_Absorb = 0; /* monitor is also a slit */ + mc_mn_Vars->Flag_per_cm2 = 0; /* flux is per cm2 */ + mc_mn_Vars->Flag_log = 0; /* log10 of the flux */ + mc_mn_Vars->Flag_parallel = 0; /* set neutron state back after detection (parallel components) */ + mc_mn_Vars->Flag_Binary_List = 0; /* save list as a binary file (smaller) */ + mc_mn_Vars->Coord_Number = 0; /* total number of variables to monitor, plus intensity (0) */ + mc_mn_Vars->Buffer_Block = 10000; /* Buffer size for list or auto limits */ + mc_mn_Vars->Neutron_Counter = 0; /* event counter, simulation total counts is mcget_ncount() */ + mc_mn_Vars->Buffer_Counter = 0; /* mc_mn_index in Buffer size (for realloc) */ + mc_mn_Vars->Buffer_Size = 0; + mc_mn_Vars->UserVariable1 = 0; + mc_mn_Vars->UserVariable2 = 0; + mc_mn_Vars->He3_pressure = 0; + mc_mn_Vars->IntermediateCnts = 0; + mc_mn_Vars->Flag_capture = 0; + mc_mn_Vars->Flag_signal = mc_mn_DEFS->COORD_P; + + mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_NONE; + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; + + /* handle size parameters */ + /* normal use is with xwidth, yheight, zthick */ + /* if xmin,xmax,ymin,ymax,zmin,zmax are non 0, use them */ + if (fabs(mc_mn_xmin-mc_mn_xmax) == 0) + { mc_mn_Vars->mxmin = -fabs(mc_mn_xwidth)/2; mc_mn_Vars->mxmax = fabs(mc_mn_xwidth)/2; } + else + { if (mc_mn_xmin < mc_mn_xmax) {mc_mn_Vars->mxmin = mc_mn_xmin; mc_mn_Vars->mxmax = mc_mn_xmax;} + else {mc_mn_Vars->mxmin = mc_mn_xmax; mc_mn_Vars->mxmax = mc_mn_xmin;} + } + if (fabs(mc_mn_ymin-mc_mn_ymax) == 0) + { mc_mn_Vars->mymin = -fabs(mc_mn_yheight)/2; mc_mn_Vars->mymax = fabs(mc_mn_yheight)/2; } + else + { if (mc_mn_ymin < mc_mn_ymax) {mc_mn_Vars->mymin = mc_mn_ymin; mc_mn_Vars->mymax = mc_mn_ymax;} + else {mc_mn_Vars->mymin = mc_mn_ymax; mc_mn_Vars->mymax = mc_mn_ymin;} + } + if (fabs(mc_mn_zmin-mc_mn_zmax) == 0) + { mc_mn_Vars->mzmin = -fabs(mc_mn_zthick)/2; mc_mn_Vars->mzmax = fabs(mc_mn_zthick)/2; } + else + { if (mc_mn_zmin < mc_mn_zmax) {mc_mn_Vars->mzmin = mc_mn_zmin; mc_mn_Vars->mzmax = mc_mn_zmax; } + else {mc_mn_Vars->mzmin = mc_mn_zmax; mc_mn_Vars->mzmax = mc_mn_zmin; } + } + + if (fabs(mc_mn_Vars->mzmax-mc_mn_Vars->mzmin) == 0) + mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_SQUARE; + else + mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_BOX; + + /* parse option string */ + + mc_mn_option_copy = (char*)malloc(strlen(mc_mn_Vars->option)+1); + if (mc_mn_option_copy == NULL) + { + fprintf(stderr,"Monitor_nD: %s cannot allocate mc_mn_option_copy (%li). Fatal.\n", mc_mn_Vars->compcurname, strlen(mc_mn_Vars->option)); + exit(-1); + } + + if (strlen(mc_mn_Vars->option)) + { + mc_mn_Flag_End = 0; + strcpy(mc_mn_option_copy, mc_mn_Vars->option); + } + + if (strstr(mc_mn_Vars->option, "cm2") || strstr(mc_mn_Vars->option, "cm^2")) mc_mn_Vars->Flag_per_cm2 = 1; + + if (strstr(mc_mn_Vars->option, "binary") || strstr(mc_mn_Vars->option, "float")) + mc_mn_Vars->Flag_Binary_List = 1; + if (strstr(mc_mn_Vars->option, "double")) + mc_mn_Vars->Flag_Binary_List = 2; + + if (mc_mn_Vars->Flag_per_cm2) strncpy(mc_mn_Vars->Coord_Label[0],"Intensity [n/cm^2/s]",30); + else strncpy(mc_mn_Vars->Coord_Label[0],"Intensity [n/s]",30); + strncpy(mc_mn_Vars->Coord_Var[0],"p",30); + mc_mn_Vars->Coord_Type[0] = mc_mn_DEFS->COORD_P; + mc_mn_Vars->Coord_Bin[0] = 1; + mc_mn_Vars->Coord_Min[0] = 0; + mc_mn_Vars->Coord_Max[0] = FLT_MAX; + + /* default file name is comp name+dateID */ + sprintf(mc_mn_Vars->Mon_File, "%s_%li", mc_mn_Vars->compcurname, mc_mn_t); + + mc_mn_carg = 1; + while((mc_mn_Flag_End == 0) && (mc_mn_carg < 128)) + { + if (mc_mn_Flag_New_token) /* to get the previous mc_mn_token sometimes */ + { + if (mc_mn_carg == 1) mc_mn_token=(char *)strtok(mc_mn_option_copy,mc_mn_DEFS->TOKEN_DEL); + else mc_mn_token=(char *)strtok(NULL,mc_mn_DEFS->TOKEN_DEL); + if (mc_mn_token == NULL) mc_mn_Flag_End=1; + } + mc_mn_Flag_New_token = 1; + if ((mc_mn_token != NULL) && (strlen(mc_mn_token) != 0)) + { + /* first handle option values from preceeding keyword mc_mn_token detected */ + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_MAX) + { + if (!mc_mn_Flag_All) + mc_mn_Vars->Coord_Max[mc_mn_Vars->Coord_Number] = atof(mc_mn_token); + else + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_Vars->Coord_Max[mc_mn_i++] = atof(mc_mn_token)); + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; mc_mn_Flag_All = 0; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_MIN) + { + if (!mc_mn_Flag_All) + mc_mn_Vars->Coord_Min[mc_mn_Vars->Coord_Number] = atof(mc_mn_token); + else + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_Vars->Coord_Min[mc_mn_i++] = atof(mc_mn_token)); + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_MAX; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_DIM) + { + if (!mc_mn_Flag_All) + mc_mn_Vars->Coord_Bin[mc_mn_Vars->Coord_Number] = atoi(mc_mn_token); + else + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_Vars->Coord_Bin[mc_mn_i++] = atoi(mc_mn_token)); + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; mc_mn_Flag_All = 0; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_FIL) + { + if (!mc_mn_Flag_No) strncpy(mc_mn_Vars->Mon_File,mc_mn_token,128); + else { strcpy(mc_mn_Vars->Mon_File,""); mc_mn_Vars->Coord_Number = 0; mc_mn_Flag_End = 1;} + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_EVNT) + { + if (!strcmp(mc_mn_token, "all") || mc_mn_Flag_All) mc_mn_Vars->Flag_List = 2; + else { mc_mn_i = atoi(mc_mn_token); if (mc_mn_i) mc_mn_Vars->Buffer_Block = mc_mn_i; + mc_mn_Vars->Flag_List = 1; } + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; mc_mn_Flag_All = 0; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_3HE) + { + mc_mn_Vars->He3_pressure = atof(mc_mn_token); + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; mc_mn_Flag_All = 0; + } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_INTERM) + { + mc_mn_Vars->Intermediate = atof(mc_mn_token); + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; mc_mn_Flag_All = 0; + } + + /* now look for general option keywords */ + if (!strcmp(mc_mn_token, "borders")) mc_mn_Vars->Flag_With_Borders = 1; + if (!strcmp(mc_mn_token, "verbose")) mc_mn_Vars->Flag_Verbose = 1; + if (!strcmp(mc_mn_token, "log")) mc_mn_Vars->Flag_log = 1; + if (!strcmp(mc_mn_token, "abs")) mc_mn_Flag_abs = 1; + if (!strcmp(mc_mn_token, "multiple")) mc_mn_Vars->Flag_Multiple = 1; + if (!strcmp(mc_mn_token, "list")) + { mc_mn_Vars->Flag_List = 1; + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_EVNT; } + + if (!strcmp(mc_mn_token, "limits") || !strcmp(mc_mn_token, "min")) mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_MIN; + if (!strcmp(mc_mn_token, "slit") || !strcmp(mc_mn_token, "absorb")) + { mc_mn_Vars->Flag_Absorb = 1; } + if (!strcmp(mc_mn_token, "max")) mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_MAX; + if (!strcmp(mc_mn_token, "bins")) mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_DIM; + if (!strcmp(mc_mn_token, "file")) + { mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_FIL; + if (mc_mn_Flag_No) { strcpy(mc_mn_Vars->Mon_File,""); mc_mn_Vars->Coord_Number = 0; mc_mn_Flag_End = 1;}} + if (!strcmp(mc_mn_token, "unactivate")) { mc_mn_Flag_End = 1; mc_mn_Vars->Coord_Number = 0; } + if (!strcmp(mc_mn_token, "all")) mc_mn_Flag_All = 1; + if (!strcmp(mc_mn_token, "sphere")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_SPHERE; + if (!strcmp(mc_mn_token, "cylinder")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_CYLIND; + if (!strcmp(mc_mn_token, "banana")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_BANANA; + if (!strcmp(mc_mn_token, "square")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_SQUARE; + if (!strcmp(mc_mn_token, "disk")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_DISK; + if (!strcmp(mc_mn_token, "box")) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_BOX; + if (!strcmp(mc_mn_token, "parallel")) mc_mn_Vars->Flag_parallel = 1; + if (!strcmp(mc_mn_token, "capture")) mc_mn_Vars->Flag_capture = 1; + if (!strcmp(mc_mn_token, "auto") && (mc_mn_Flag_auto != -1)) + { mc_mn_Vars->Flag_Auto_Limits = 1; + if (mc_mn_Flag_All) mc_mn_Flag_auto = -1; + else mc_mn_Flag_auto = 1; + } + if (!strcmp(mc_mn_token, "premonitor")) + mc_mn_Vars->Flag_UsePreMonitor = 1; + if (!strcmp(mc_mn_token, "3He_pressure")) + mc_mn_Vars->He3_pressure = 3; + if (!strcmp(mc_mn_token, "intermediate")) + { mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_INTERM; + mc_mn_Vars->Intermediate = 5; } + if (!strcmp(mc_mn_token, "no") || !strcmp(mc_mn_token, "not")) mc_mn_Flag_No = 1; + if (!strcmp(mc_mn_token, "signal")) mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_SIGNAL; + + /* now look for variable names to monitor */ + mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_NONE; mc_mn_lmin = 0; mc_mn_lmax = 0; + + if (!strcmp(mc_mn_token, "x")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_X; strcpy(mc_mn_Set_Vars_Coord_Label,"x [m]"); strcpy(mc_mn_Set_Vars_Coord_Var,"x"); mc_mn_lmin = mc_mn_Vars->mxmin; mc_mn_lmax = mc_mn_Vars->mxmax; } + if (!strcmp(mc_mn_token, "y")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_Y; strcpy(mc_mn_Set_Vars_Coord_Label,"y [m]"); strcpy(mc_mn_Set_Vars_Coord_Var,"y"); mc_mn_lmin = mc_mn_Vars->mymin; mc_mn_lmax = mc_mn_Vars->mymax; } + if (!strcmp(mc_mn_token, "z")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_Z; strcpy(mc_mn_Set_Vars_Coord_Label,"z [m]"); strcpy(mc_mn_Set_Vars_Coord_Var,"z"); mc_mn_lmin = mc_mn_Vars->mzmin; mc_mn_lmax = mc_mn_Vars->mzmax; } + if (!strcmp(mc_mn_token, "k") || !strcmp(mc_mn_token, "wavevector")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_K; strcpy(mc_mn_Set_Vars_Coord_Label,"|k| [Angs-1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"k"); mc_mn_lmin = 0; mc_mn_lmax = 10; } + if (!strcmp(mc_mn_token, "v")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_V; strcpy(mc_mn_Set_Vars_Coord_Label,"Velocity [m/s]"); strcpy(mc_mn_Set_Vars_Coord_Var,"v"); mc_mn_lmin = 0; mc_mn_lmax = 10000; } + if (!strcmp(mc_mn_token, "t") || !strcmp(mc_mn_token, "time")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_T; strcpy(mc_mn_Set_Vars_Coord_Label,"TOF [s]"); strcpy(mc_mn_Set_Vars_Coord_Var,"t"); mc_mn_lmin = 0; mc_mn_lmax = .1; } + if ((!strcmp(mc_mn_token, "p") || !strcmp(mc_mn_token, "intensity") || !strcmp(mc_mn_token, "flux"))) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_P; + if (mc_mn_Vars->Flag_per_cm2) strcpy(mc_mn_Set_Vars_Coord_Label,"Intensity [n/cm^2/s]"); + else strcpy(mc_mn_Set_Vars_Coord_Label,"Intensity [n/s]"); + strcpy(mc_mn_Set_Vars_Coord_Var,"I"); + mc_mn_lmin = 0; mc_mn_lmax = FLT_MAX; } + + if (!strcmp(mc_mn_token, "vx")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_VX; strcpy(mc_mn_Set_Vars_Coord_Label,"vx [m/s]"); strcpy(mc_mn_Set_Vars_Coord_Var,"vx"); mc_mn_lmin = -1000; mc_mn_lmax = 1000; } + if (!strcmp(mc_mn_token, "vy")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_VY; strcpy(mc_mn_Set_Vars_Coord_Label,"vy [m/s]"); strcpy(mc_mn_Set_Vars_Coord_Var,"vy"); mc_mn_lmin = -1000; mc_mn_lmax = 1000; } + if (!strcmp(mc_mn_token, "vz")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_VZ; strcpy(mc_mn_Set_Vars_Coord_Label,"vz [m/s]"); strcpy(mc_mn_Set_Vars_Coord_Var,"vz"); mc_mn_lmin = -10000; mc_mn_lmax = 10000; } + if (!strcmp(mc_mn_token, "kx")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_KX; strcpy(mc_mn_Set_Vars_Coord_Label,"kx [Angs-1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"kx"); mc_mn_lmin = -1; mc_mn_lmax = 1; } + if (!strcmp(mc_mn_token, "ky")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_KY; strcpy(mc_mn_Set_Vars_Coord_Label,"ky [Angs-1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"ky"); mc_mn_lmin = -1; mc_mn_lmax = 1; } + if (!strcmp(mc_mn_token, "kz")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_KZ; strcpy(mc_mn_Set_Vars_Coord_Label,"kz [Angs-1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"kz"); mc_mn_lmin = -10; mc_mn_lmax = 10; } + if (!strcmp(mc_mn_token, "sx")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_SX; strcpy(mc_mn_Set_Vars_Coord_Label,"sx [1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"sx"); mc_mn_lmin = -1; mc_mn_lmax = 1; } + if (!strcmp(mc_mn_token, "sy")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_SY; strcpy(mc_mn_Set_Vars_Coord_Label,"sy [1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"sy"); mc_mn_lmin = -1; mc_mn_lmax = 1; } + if (!strcmp(mc_mn_token, "sz")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_SZ; strcpy(mc_mn_Set_Vars_Coord_Label,"sz [1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"sz"); mc_mn_lmin = -1; mc_mn_lmax = 1; } + + if (!strcmp(mc_mn_token, "energy") || !strcmp(mc_mn_token, "omega")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_ENERGY; strcpy(mc_mn_Set_Vars_Coord_Label,"Energy [meV]"); strcpy(mc_mn_Set_Vars_Coord_Var,"E"); mc_mn_lmin = 0; mc_mn_lmax = 100; } + if (!strcmp(mc_mn_token, "lambda") || !strcmp(mc_mn_token, "wavelength")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_LAMBDA; strcpy(mc_mn_Set_Vars_Coord_Label,"Wavelength [Angs]"); strcpy(mc_mn_Set_Vars_Coord_Var,"L"); mc_mn_lmin = 0; mc_mn_lmax = 100; } + if (!strcmp(mc_mn_token, "radius")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_RADIUS; strcpy(mc_mn_Set_Vars_Coord_Label,"Radius [m]"); strcpy(mc_mn_Set_Vars_Coord_Var,"R"); mc_mn_lmin = 0; mc_mn_lmax = mc_mn_xmax; } + if (!strcmp(mc_mn_token, "angle")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_ANGLE; strcpy(mc_mn_Set_Vars_Coord_Label,"Angle [deg]"); strcpy(mc_mn_Set_Vars_Coord_Var,"A"); mc_mn_lmin = -5; mc_mn_lmax = 5; } + if (!strcmp(mc_mn_token, "hdiv")|| !strcmp(mc_mn_token, "divergence") || !strcmp(mc_mn_token, "xdiv") || !strcmp(mc_mn_token, "dx")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_HDIV; strcpy(mc_mn_Set_Vars_Coord_Label,"Hor. Divergence [deg]"); strcpy(mc_mn_Set_Vars_Coord_Var,"HD"); mc_mn_lmin = -5; mc_mn_lmax = 5; } + if (!strcmp(mc_mn_token, "vdiv") || !strcmp(mc_mn_token, "ydiv") || !strcmp(mc_mn_token, "dy")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_VDIV; strcpy(mc_mn_Set_Vars_Coord_Label,"Vert. Divergence [deg]"); strcpy(mc_mn_Set_Vars_Coord_Var,"VD"); mc_mn_lmin = -5; mc_mn_lmax = 5; } + if (!strcmp(mc_mn_token, "theta") || !strcmp(mc_mn_token, "longitude")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_THETA; strcpy(mc_mn_Set_Vars_Coord_Label,"Longitude [deg]"); strcpy(mc_mn_Set_Vars_Coord_Var,"th"); mc_mn_lmin = -180; mc_mn_lmax = 180; } + if (!strcmp(mc_mn_token, "phi") || !strcmp(mc_mn_token, "lattitude")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_PHI; strcpy(mc_mn_Set_Vars_Coord_Label,"Lattitude [deg]"); strcpy(mc_mn_Set_Vars_Coord_Var,"ph"); mc_mn_lmin = -180; mc_mn_lmax = 180; } + if (!strcmp(mc_mn_token, "ncounts")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_NCOUNT; strcpy(mc_mn_Set_Vars_Coord_Label,"Neutrons [1]"); strcpy(mc_mn_Set_Vars_Coord_Var,"N"); mc_mn_lmin = 0; mc_mn_lmax = 1e10; } + if (!strcmp(mc_mn_token, "user") || !strcmp(mc_mn_token, "user1")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_USER1; strncpy(mc_mn_Set_Vars_Coord_Label,mc_mn_Vars->UserName1,32); strcpy(mc_mn_Set_Vars_Coord_Var,"U1"); mc_mn_lmin = -1e10; mc_mn_lmax = 1e10; } + if (!strcmp(mc_mn_token, "user2")) + { mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_USER2; strncpy(mc_mn_Set_Vars_Coord_Label,mc_mn_Vars->UserName2,32); strcpy(mc_mn_Set_Vars_Coord_Var,"U2"); mc_mn_lmin = -1e10; mc_mn_lmax = 1e10; } + + /* now stores variable keywords detected, if any */ + if (mc_mn_Set_Vars_Coord_Type != mc_mn_DEFS->COORD_NONE) + { + int mc_mn_Coord_Number = mc_mn_Vars->Coord_Number; + if (mc_mn_Vars->Flag_log) { mc_mn_Set_Vars_Coord_Type |= mc_mn_DEFS->COORD_LOG; mc_mn_Vars->Flag_log = 0; } + if (mc_mn_Flag_abs) { mc_mn_Set_Vars_Coord_Type |= mc_mn_DEFS->COORD_ABS; mc_mn_Flag_abs = 0; } + if (mc_mn_Flag_auto != 0) { mc_mn_Set_Vars_Coord_Type |= mc_mn_DEFS->COORD_AUTO; mc_mn_Flag_auto = 0; } + if (mc_mn_Set_Coord_Mode == mc_mn_DEFS->COORD_SIGNAL) + { + mc_mn_Coord_Number = 0; + mc_mn_Vars->Flag_signal = mc_mn_Set_Vars_Coord_Type; + } + else + { + if (mc_mn_Coord_Number < MONnD_COORD_NMAX) + { mc_mn_Coord_Number++; + mc_mn_Vars->Coord_Number = mc_mn_Coord_Number; } + else if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s reached max number of variables (%i).\n", mc_mn_Vars->compcurname, MONnD_COORD_NMAX); + } + mc_mn_Vars->Coord_Type[mc_mn_Coord_Number] = mc_mn_Set_Vars_Coord_Type; + strncpy(mc_mn_Vars->Coord_Label[mc_mn_Coord_Number], mc_mn_Set_Vars_Coord_Label,30); + strncpy(mc_mn_Vars->Coord_Var[mc_mn_Coord_Number], mc_mn_Set_Vars_Coord_Var,30); + if (mc_mn_lmin > mc_mn_lmax) { mc_mn_XY = mc_mn_lmin; mc_mn_lmin=mc_mn_lmax; mc_mn_lmax = mc_mn_XY; } + mc_mn_Vars->Coord_Min[mc_mn_Coord_Number] = mc_mn_lmin; + mc_mn_Vars->Coord_Max[mc_mn_Coord_Number] = mc_mn_lmax; + if (mc_mn_Set_Coord_Mode != mc_mn_DEFS->COORD_SIGNAL) mc_mn_Vars->Coord_Bin[mc_mn_Coord_Number] = 20; + mc_mn_Set_Coord_Mode = mc_mn_DEFS->COORD_VAR; + mc_mn_Flag_All = 0; + mc_mn_Flag_No = 0; + } + mc_mn_carg++; + } /* end if mc_mn_token */ + } /* end while mc_mn_carg */ + free(mc_mn_option_copy); + if (mc_mn_carg == 128) printf("Monitor_nD: %s reached max number of mc_mn_tokens (%i). Skipping.\n", mc_mn_Vars->compcurname, 128); + + if ((mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_BOX) && (fabs(mc_mn_Vars->mzmax - mc_mn_Vars->mzmin) == 0)) mc_mn_Vars->Flag_Shape = mc_mn_DEFS->SHAPE_SQUARE; + + if (mc_mn_Vars->Flag_log == 1) mc_mn_Vars->Coord_Type[0] |= mc_mn_DEFS->COORD_LOG; + if (mc_mn_Vars->Coord_Number == 0) + { mc_mn_Vars->Flag_Auto_Limits=0; mc_mn_Vars->Flag_Multiple=0; mc_mn_Vars->Flag_List=0; } + + /* now setting Monitor Name from variable mc_mn_labels */ + strcpy(mc_mn_Vars->Monitor_Label,""); + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + if (mc_mn_Flag_auto != 0) mc_mn_Vars->Coord_Type[mc_mn_i] |= mc_mn_DEFS->COORD_AUTO; + mc_mn_Set_Vars_Coord_Type = (mc_mn_Vars->Coord_Type[mc_mn_i] & 31); + if ((mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_THETA) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_PHI) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_X) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_Y) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_Z) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_RADIUS)) + strcpy(mc_mn_Short_Label[mc_mn_i],"Position"); + else + if ((mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VX) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VY) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VZ) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_V)) + strcpy(mc_mn_Short_Label[mc_mn_i],"Velocity"); + else + if ((mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KX) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KY) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KZ) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_K)) + strcpy(mc_mn_Short_Label[mc_mn_i],"Wavevector"); + else + if ((mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SX) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SY) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SZ)) + strcpy(mc_mn_Short_Label[mc_mn_i],"Spin"); + else + if ((mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_HDIV) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VDIV) + || (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_ANGLE)) + strcpy(mc_mn_Short_Label[mc_mn_i],"Divergence"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_ENERGY) + strcpy(mc_mn_Short_Label[mc_mn_i],"Energy"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_LAMBDA) + strcpy(mc_mn_Short_Label[mc_mn_i],"Wavelength"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_NCOUNT) + strcpy(mc_mn_Short_Label[mc_mn_i],"Neutron counts"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_T) + strcpy(mc_mn_Short_Label[mc_mn_i],"Time Of Flight"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_P) + strcpy(mc_mn_Short_Label[mc_mn_i],"Intensity"); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_USER1) + strncpy(mc_mn_Short_Label[mc_mn_i],mc_mn_Vars->UserName1,32); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_USER2) + strncpy(mc_mn_Short_Label[mc_mn_i],mc_mn_Vars->UserName2,32); + else + strcpy(mc_mn_Short_Label[mc_mn_i],"Unknown"); + + if (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_ABS) + { strcat(mc_mn_Vars->Coord_Label[mc_mn_i]," (abs)"); } + + if (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_LOG) + { strcat(mc_mn_Vars->Coord_Label[mc_mn_i]," (log)"); } + + strcat(mc_mn_Vars->Monitor_Label, " "); + strcat(mc_mn_Vars->Monitor_Label, mc_mn_Short_Label[mc_mn_i]); + } /* end for mc_mn_Short_Label */ + + strcat(mc_mn_Vars->Monitor_Label, " Monitor"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_SQUARE) strcat(mc_mn_Vars->Monitor_Label, " (Square)"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_DISK) strcat(mc_mn_Vars->Monitor_Label, " (Disk)"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_SPHERE) strcat(mc_mn_Vars->Monitor_Label, " (Sphere)"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_CYLIND) strcat(mc_mn_Vars->Monitor_Label, " (Cylinder)"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_BANANA) strcat(mc_mn_Vars->Monitor_Label, " (Banana)"); + if (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_BOX) strcat(mc_mn_Vars->Monitor_Label, " (Box)"); + if ((mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_CYLIND) || (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_BANANA) || (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_SPHERE) || (mc_mn_Vars->Flag_Shape == mc_mn_DEFS->SHAPE_BOX)) + { + if (strstr(mc_mn_Vars->option, "incoming")) + { + mc_mn_Vars->Flag_Shape = abs(mc_mn_Vars->Flag_Shape); + strcat(mc_mn_Vars->Monitor_Label, " [in]"); + } + else /* if strstr(mc_mn_Vars->option, "outgoing")) */ + { + mc_mn_Vars->Flag_Shape = -abs(mc_mn_Vars->Flag_Shape); + strcat(mc_mn_Vars->Monitor_Label, " [out]"); + } + } + if (mc_mn_Vars->Flag_UsePreMonitor == 1) + { + strcat(mc_mn_Vars->Monitor_Label, " at "); + strncat(mc_mn_Vars->Monitor_Label, mc_mn_Vars->UserName1,32); + } + if (mc_mn_Vars->Flag_log == 1) strcat(mc_mn_Vars->Monitor_Label, " [log] "); + + /* mc_mn_Vars->Coord_Number 0 : intensity or signal + * mc_mn_Vars->Coord_Number 1:n : detector variables */ + + /* now allocate memory to store variables in TRACE */ + if ((mc_mn_Vars->Coord_Number != 2) && !mc_mn_Vars->Flag_Multiple && !mc_mn_Vars->Flag_List) + { mc_mn_Vars->Flag_Multiple = 1; mc_mn_Vars->Flag_List = 0; } /* default is n1D */ + + /* list and auto limits case : mc_mn_Vars->Flag_List or mc_mn_Vars->Flag_Auto_Limits + * -> Buffer to flush and suppress after mc_mn_Vars->Flag_Auto_Limits + */ + if ((mc_mn_Vars->Flag_Auto_Limits || mc_mn_Vars->Flag_List) && mc_mn_Vars->Coord_Number) + { /* Dim : (mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block matrix (for p, dp) */ + mc_mn_Vars->Mon2D_Buffer = (double *)malloc((mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block*sizeof(double)); + if (mc_mn_Vars->Mon2D_Buffer == NULL) + { printf("Monitor_nD: %s cannot allocate mc_mn_Vars->Mon2D_Buffer (%li). No list and auto limits.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Buffer_Block*(mc_mn_Vars->Coord_Number+1)*sizeof(double)); mc_mn_Vars->Flag_List = 0; mc_mn_Vars->Flag_Auto_Limits = 0; } + else + { + for (mc_mn_i=0; mc_mn_i < (mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block; mc_mn_Vars->Mon2D_Buffer[mc_mn_i++] = (double)0); + } + mc_mn_Vars->Buffer_Size = mc_mn_Vars->Buffer_Block; + } + + /* 1D and n1D case : mc_mn_Vars->Flag_Multiple */ + if (mc_mn_Vars->Flag_Multiple && mc_mn_Vars->Coord_Number) + { /* Dim : mc_mn_Vars->Coord_Number*mc_mn_Vars->Coord_Bin[mc_mn_i] vectors */ + mc_mn_Vars->Mon2D_N = (double **)malloc((mc_mn_Vars->Coord_Number)*sizeof(double *)); + mc_mn_Vars->Mon2D_p = (double **)malloc((mc_mn_Vars->Coord_Number)*sizeof(double *)); + mc_mn_Vars->Mon2D_p2 = (double **)malloc((mc_mn_Vars->Coord_Number)*sizeof(double *)); + if ((mc_mn_Vars->Mon2D_N == NULL) || (mc_mn_Vars->Mon2D_p == NULL) || (mc_mn_Vars->Mon2D_p2 == NULL)) + { fprintf(stderr,"Monitor_nD: %s n1D cannot allocate mc_mn_Vars->Mon2D_N/p/2p (%li). Fatal.\n", mc_mn_Vars->compcurname, (mc_mn_Vars->Coord_Number)*sizeof(double *)); exit(-1); } + for (mc_mn_i= 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + mc_mn_Vars->Mon2D_N[mc_mn_i-1] = (double *)malloc(mc_mn_Vars->Coord_Bin[mc_mn_i]*sizeof(double)); + mc_mn_Vars->Mon2D_p[mc_mn_i-1] = (double *)malloc(mc_mn_Vars->Coord_Bin[mc_mn_i]*sizeof(double)); + mc_mn_Vars->Mon2D_p2[mc_mn_i-1] = (double *)malloc(mc_mn_Vars->Coord_Bin[mc_mn_i]*sizeof(double)); + if ((mc_mn_Vars->Mon2D_N == NULL) || (mc_mn_Vars->Mon2D_p == NULL) || (mc_mn_Vars->Mon2D_p2 == NULL)) + { fprintf(stderr,"Monitor_nD: %s n1D cannot allocate %s mc_mn_Vars->Mon2D_N/p/2p[%li] (%li). Fatal.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Coord_Var[mc_mn_i], mc_mn_i, (mc_mn_Vars->Coord_Bin[mc_mn_i])*sizeof(double *)); exit(-1); } + else + { + for (mc_mn_j=0; mc_mn_j < mc_mn_Vars->Coord_Bin[mc_mn_i]; mc_mn_j++ ) + { mc_mn_Vars->Mon2D_N[mc_mn_i-1][mc_mn_j] = (double)0; mc_mn_Vars->Mon2D_p[mc_mn_i-1][mc_mn_j] = (double)0; mc_mn_Vars->Mon2D_p2[mc_mn_i-1][mc_mn_j] = (double)0; } + } + } + } + else /* 2D case : mc_mn_Vars->Coord_Number==2 and !mc_mn_Vars->Flag_Multiple and !mc_mn_Vars->Flag_List */ + if ((mc_mn_Vars->Coord_Number == 2) && !mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2] matrix */ + mc_mn_Vars->Mon2D_N = (double **)malloc((mc_mn_Vars->Coord_Bin[1])*sizeof(double *)); + mc_mn_Vars->Mon2D_p = (double **)malloc((mc_mn_Vars->Coord_Bin[1])*sizeof(double *)); + mc_mn_Vars->Mon2D_p2 = (double **)malloc((mc_mn_Vars->Coord_Bin[1])*sizeof(double *)); + if ((mc_mn_Vars->Mon2D_N == NULL) || (mc_mn_Vars->Mon2D_p == NULL) || (mc_mn_Vars->Mon2D_p2 == NULL)) + { fprintf(stderr,"Monitor_nD: %s 2D cannot allocate %s mc_mn_Vars->Mon2D_N/p/2p (%li). Fatal.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Coord_Var[1], (mc_mn_Vars->Coord_Bin[1])*sizeof(double *)); exit(-1); } + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Bin[1]; mc_mn_i++) + { + mc_mn_Vars->Mon2D_N[mc_mn_i] = (double *)malloc(mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + mc_mn_Vars->Mon2D_p[mc_mn_i] = (double *)malloc(mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + mc_mn_Vars->Mon2D_p2[mc_mn_i] = (double *)malloc(mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + if ((mc_mn_Vars->Mon2D_N == NULL) || (mc_mn_Vars->Mon2D_p == NULL) || (mc_mn_Vars->Mon2D_p2 == NULL)) + { fprintf(stderr,"Monitor_nD: %s 2D cannot allocate %s mc_mn_Vars->Mon2D_N/p/2p[%li] (%li). Fatal.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Coord_Var[1], mc_mn_i, (mc_mn_Vars->Coord_Bin[2])*sizeof(double *)); exit(-1); } + else + { + for (mc_mn_j=0; mc_mn_j < mc_mn_Vars->Coord_Bin[2]; mc_mn_j++ ) + { mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j] = (double)0; mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j] = (double)0; mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j] = (double)0; } + } + } + } + /* no Mon2D allocated for + * (mc_mn_Vars->Coord_Number != 2) && !mc_mn_Vars->Flag_Multiple && mc_mn_Vars->Flag_List */ + + mc_mn_Vars->psum = 0; + mc_mn_Vars->p2sum = 0; + mc_mn_Vars->Nsum = 0; + + mc_mn_Vars->area = fabs(mc_mn_Vars->mxmax - mc_mn_Vars->mxmin)*fabs(mc_mn_Vars->mymax - mc_mn_Vars->mymin)*1E4; /* in cm**2 for square and box shapes */ + mc_mn_Vars->Sphere_Radius = fabs(mc_mn_Vars->mxmax - mc_mn_Vars->mxmin)/2; + if ((abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_DISK) || (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_SPHERE)) + { + mc_mn_Vars->area = PI*mc_mn_Vars->Sphere_Radius*mc_mn_Vars->Sphere_Radius; /* disk shapes */ + } + if (mc_mn_Vars->area == 0) mc_mn_Vars->Coord_Number = 0; + if (mc_mn_Vars->Coord_Number == 0 && mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s is unactivated (0D)\n", mc_mn_Vars->compcurname); + mc_mn_Vars->Cylinder_Height = fabs(mc_mn_Vars->mymax - mc_mn_Vars->mymin); + + if (mc_mn_Vars->Intermediate < 0) mc_mn_Vars->Intermediate = 0; + if (mc_mn_Vars->Intermediate > 1) mc_mn_Vars->Intermediate /= 100; + mc_mn_Vars->IntermediateCnts = mc_mn_Vars->Intermediate*mcget_ncount(); + + if (mc_mn_Vars->Flag_Verbose) + { + printf("Monitor_nD: %s is a %s.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Monitor_Label); + printf("Monitor_nD: version %s with options=%s\n", MONITOR_ND_LIB_H, mc_mn_Vars->option); + } + } /* end Monitor_nD_Init */ + +/* ========================================================================= */ +/* ADD: E.Farhi, Aug 6th, 2001: Monitor_nD section */ +/* this routine is used to monitor one propagating neutron */ +/* ========================================================================= */ + +double Monitor_nD_Trace(MonitornD_Defines_type *mc_mn_DEFS, MonitornD_Variables_type *mc_mn_Vars) +{ + + double mc_mn_XY=0; + long mc_mn_i,mc_mn_j; + double mc_mn_pp; + double mc_mn_Coord[MONnD_COORD_NMAX]; + long mc_mn_Coord_Index[MONnD_COORD_NMAX]; + char mc_mn_While_End =0; + long mc_mn_While_Buffer=0; + char mc_mn_Set_Vars_Coord_Type = mc_mn_DEFS->COORD_NONE; + + /* mc_mn_Vars->Flag_Auto_Limits */ + if ((mc_mn_Vars->Buffer_Counter >= mc_mn_Vars->Buffer_Block) && (mc_mn_Vars->Flag_Auto_Limits == 1) && (mc_mn_Vars->Coord_Number > 0)) + { + /* auto limits case : get limits in Buffer for each variable */ + /* Dim : (mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block matrix (for p, dp) */ + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s getting %li Auto Limits from List (%li).\n", mc_mn_Vars->compcurname, mc_mn_Vars->Coord_Number, mc_mn_Vars->Buffer_Counter); + for (mc_mn_i = 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + if (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_AUTO) + { + mc_mn_Vars->Coord_Min[mc_mn_i] = FLT_MAX; + mc_mn_Vars->Coord_Max[mc_mn_i] = -FLT_MAX; + for (mc_mn_j = 0; mc_mn_j < mc_mn_Vars->Buffer_Block; mc_mn_j++) + { + mc_mn_XY = mc_mn_Vars->Mon2D_Buffer[mc_mn_i+mc_mn_j*(mc_mn_Vars->Coord_Number+1)]; /* scanning variables in Buffer */ + if (mc_mn_XY < mc_mn_Vars->Coord_Min[mc_mn_i]) mc_mn_Vars->Coord_Min[mc_mn_i] = mc_mn_XY; + if (mc_mn_XY > mc_mn_Vars->Coord_Max[mc_mn_i]) mc_mn_Vars->Coord_Max[mc_mn_i] = mc_mn_XY; + } + } + } + mc_mn_Vars->Flag_Auto_Limits = 2; /* pass to 2nd auto limits step */ + } + + /* manage realloc for list all if Buffer size exceeded */ + if ((mc_mn_Vars->Buffer_Counter >= mc_mn_Vars->Buffer_Block) && (mc_mn_Vars->Flag_List >= 2)) + { + if (mc_mn_Vars->Buffer_Size >= 20000 || mc_mn_Vars->Flag_List == 3) + { /* save current (possibly append) and re-use Buffer */ + Monitor_nD_Save(mc_mn_DEFS, mc_mn_Vars); + mc_mn_Vars->Flag_List = 3; + mc_mn_Vars->Buffer_Block = mc_mn_Vars->Buffer_Size; + mc_mn_Vars->Buffer_Counter = 0; + mc_mn_Vars->Neutron_Counter = 0; + } + else + { + mc_mn_Vars->Mon2D_Buffer = (double *)realloc(mc_mn_Vars->Mon2D_Buffer, (mc_mn_Vars->Coord_Number+1)*(mc_mn_Vars->Neutron_Counter+mc_mn_Vars->Buffer_Block)*sizeof(double)); + if (mc_mn_Vars->Mon2D_Buffer == NULL) + { printf("Monitor_nD: %s cannot reallocate mc_mn_Vars->Mon2D_Buffer[%li] (%li). Skipping.\n", mc_mn_Vars->compcurname, mc_mn_i, (mc_mn_Vars->Neutron_Counter+mc_mn_Vars->Buffer_Block)*sizeof(double)); mc_mn_Vars->Flag_List = 1; } + else { mc_mn_Vars->Buffer_Counter = 0; mc_mn_Vars->Buffer_Size = mc_mn_Vars->Neutron_Counter+mc_mn_Vars->Buffer_Block; } + } + } + + while (!mc_mn_While_End) + { /* we generate mc_mn_Coord[] and Coord_mc_mn_index[] from Buffer (auto limits) or passing neutron */ + if ((mc_mn_Vars->Flag_Auto_Limits == 2) && (mc_mn_Vars->Coord_Number > 0)) + { + if (mc_mn_While_Buffer < mc_mn_Vars->Buffer_Block) + { + /* first while loops (mc_mn_While_Buffer) */ + /* auto limits case : scan Buffer within limits and store in Mon2D */ + mc_mn_pp = mc_mn_Vars->Mon2D_Buffer[mc_mn_While_Buffer*(mc_mn_Vars->Coord_Number+1)]; + mc_mn_Coord[0] = mc_mn_pp; + + for (mc_mn_i = 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + /* scanning variables in Buffer */ + mc_mn_XY = (mc_mn_Vars->Coord_Max[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i]); + + mc_mn_Coord[mc_mn_i] = mc_mn_Vars->Mon2D_Buffer[mc_mn_i+mc_mn_While_Buffer*(mc_mn_Vars->Coord_Number+1)]; + if (mc_mn_XY > 0) mc_mn_Coord_Index[mc_mn_i] = floor((mc_mn_Coord[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i])*mc_mn_Vars->Coord_Bin[mc_mn_i]/mc_mn_XY); + else mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Vars->Flag_With_Borders) + { + if (mc_mn_Coord_Index[mc_mn_i] < 0) mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Coord_Index[mc_mn_i] >= mc_mn_Vars->Coord_Bin[mc_mn_i]) mc_mn_Coord_Index[mc_mn_i] = mc_mn_Vars->Coord_Bin[mc_mn_i] - 1; + } + } /* end for */ + mc_mn_While_Buffer++; + } /* end if in Buffer */ + else /* (mc_mn_While_Buffer >= mc_mn_Vars->Buffer_Block) && (mc_mn_Vars->Flag_Auto_Limits == 2) */ + { + mc_mn_Vars->Flag_Auto_Limits = 0; + if (!mc_mn_Vars->Flag_List) /* free Buffer not needed (no list to output) */ + { /* Dim : (mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block matrix (for p, dp) */ + free(mc_mn_Vars->Mon2D_Buffer); mc_mn_Vars->Mon2D_Buffer = NULL; + } + } + } + else /* mc_mn_Vars->Flag_Auto_Limits == 0 or 1 */ + { + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { /* handle current neutron : last while */ + + mc_mn_XY = 0; + mc_mn_Set_Vars_Coord_Type = (mc_mn_Vars->Coord_Type[mc_mn_i] & 31); + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_X) mc_mn_XY = mc_mn_Vars->cx; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_Y) mc_mn_XY = mc_mn_Vars->cy; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_Z) mc_mn_XY = mc_mn_Vars->cz; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VX) mc_mn_XY = mc_mn_Vars->cvx; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VY) mc_mn_XY = mc_mn_Vars->cvy; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VZ) mc_mn_XY = mc_mn_Vars->cvz; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KX) mc_mn_XY = V2K*mc_mn_Vars->cvx; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KY) mc_mn_XY = V2K*mc_mn_Vars->cvy; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_KZ) mc_mn_XY = V2K*mc_mn_Vars->cvz; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SX) mc_mn_XY = mc_mn_Vars->csx; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SY) mc_mn_XY = mc_mn_Vars->csy; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_SZ) mc_mn_XY = mc_mn_Vars->csz; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_T) mc_mn_XY = mc_mn_Vars->ct; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_P) mc_mn_XY = mc_mn_Vars->cp; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_HDIV) mc_mn_XY = RAD2DEG*atan2(mc_mn_Vars->cvx,mc_mn_Vars->cvz); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VDIV) mc_mn_XY = RAD2DEG*atan2(mc_mn_Vars->cvy,mc_mn_Vars->cvz); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_V) mc_mn_XY = sqrt(mc_mn_Vars->cvx*mc_mn_Vars->cvx+mc_mn_Vars->cvy*mc_mn_Vars->cvy+mc_mn_Vars->cvz*mc_mn_Vars->cvz); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_RADIUS) mc_mn_XY = sqrt(mc_mn_Vars->cx*mc_mn_Vars->cx+mc_mn_Vars->cy*mc_mn_Vars->cy); + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_K) { mc_mn_XY = sqrt(mc_mn_Vars->cvx*mc_mn_Vars->cvx+mc_mn_Vars->cvy*mc_mn_Vars->cvy+mc_mn_Vars->cvz*mc_mn_Vars->cvz); mc_mn_XY *= V2K; } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_ENERGY) { mc_mn_XY = mc_mn_Vars->cvx*mc_mn_Vars->cvx+mc_mn_Vars->cvy*mc_mn_Vars->cvy+mc_mn_Vars->cvz*mc_mn_Vars->cvz; mc_mn_XY *= VS2E; } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_LAMBDA) { mc_mn_XY = sqrt(mc_mn_Vars->cvx*mc_mn_Vars->cvx+mc_mn_Vars->cvy*mc_mn_Vars->cvy+mc_mn_Vars->cvz*mc_mn_Vars->cvz); mc_mn_XY *= V2K; if (mc_mn_XY != 0) mc_mn_XY = 2*PI/mc_mn_XY; } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_NCOUNT) mc_mn_XY = mc_mn_Coord[mc_mn_i]+1; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_ANGLE) + { mc_mn_XY = sqrt(mc_mn_Vars->cvx*mc_mn_Vars->cvx+mc_mn_Vars->cvy*mc_mn_Vars->cvy+mc_mn_Vars->cvz*mc_mn_Vars->cvz); + if (mc_mn_Vars->cvz != 0) + { + mc_mn_XY= RAD2DEG*atan2(mc_mn_XY,mc_mn_Vars->cvz); + } else mc_mn_XY = 0; + } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_THETA) { if (mc_mn_Vars->cz != 0) mc_mn_XY = RAD2DEG*atan2(mc_mn_Vars->cx,mc_mn_Vars->cz); } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_PHI) { if (mc_mn_Vars->cz != 0) mc_mn_XY = RAD2DEG*atan2(sqrt(mc_mn_Vars->cx*mc_mn_Vars->cx+mc_mn_Vars->cy*mc_mn_Vars->cy),mc_mn_Vars->cz); } + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_USER1) mc_mn_XY = mc_mn_Vars->UserVariable1; + else + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_USER2) mc_mn_XY = mc_mn_Vars->UserVariable2; + else + mc_mn_XY = 0; + + if (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_ABS) mc_mn_XY=fabs(mc_mn_XY); + + if (mc_mn_i && (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_LOG)) /* not for the flux */ + { if (mc_mn_XY > 0) mc_mn_XY = log(mc_mn_XY)/log(10); + else mc_mn_XY = -100; } + + mc_mn_Coord[mc_mn_i] = mc_mn_XY; + if (mc_mn_i == 0) { mc_mn_pp = mc_mn_XY; mc_mn_Coord_Index[mc_mn_i] = 0; } + else if (!mc_mn_Vars->Flag_Auto_Limits) + { + mc_mn_XY = (mc_mn_Vars->Coord_Max[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i]); + if (mc_mn_XY > 0) mc_mn_Coord_Index[mc_mn_i] = floor((mc_mn_Coord[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i])*mc_mn_Vars->Coord_Bin[mc_mn_i]/mc_mn_XY); + else mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Vars->Flag_With_Borders) + { + if (mc_mn_Coord_Index[mc_mn_i] < 0) mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Coord_Index[mc_mn_i] >= mc_mn_Vars->Coord_Bin[mc_mn_i]) mc_mn_Coord_Index[mc_mn_i] = mc_mn_Vars->Coord_Bin[mc_mn_i] - 1; + } + } /* else Auto_Limits will get Index later from Buffer */ + } /* end for mc_mn_i */ + mc_mn_While_End = 1; + } /* end else if mc_mn_Vars->Flag_Auto_Limits == 2 */ + + if (mc_mn_Vars->Flag_Auto_Limits != 2) /* not when reading auto limits Buffer */ + { /* now store Coord into Buffer (no mc_mn_index needed) if necessary */ + if ((mc_mn_Vars->Buffer_Counter < mc_mn_Vars->Buffer_Block) && ((mc_mn_Vars->Flag_List) || (mc_mn_Vars->Flag_Auto_Limits == 1))) + { + for (mc_mn_i = 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + mc_mn_Vars->Mon2D_Buffer[mc_mn_i + mc_mn_Vars->Neutron_Counter*(mc_mn_Vars->Coord_Number+1)] = mc_mn_Coord[mc_mn_i]; + } + mc_mn_Vars->Buffer_Counter++; + if (mc_mn_Vars->Flag_Verbose && (mc_mn_Vars->Buffer_Counter >= mc_mn_Vars->Buffer_Block) && (mc_mn_Vars->Flag_List == 1)) printf("Monitor_nD: %s %li neutrons stored in List.\n", mc_mn_Vars->compcurname, mc_mn_Vars->Buffer_Counter); + } + mc_mn_Vars->Neutron_Counter++; + } /* end (mc_mn_Vars->Flag_Auto_Limits != 2) */ + + /* store n1d/2d section for Buffer or current neutron in while */ + if (mc_mn_Vars->Flag_Auto_Limits != 1) /* not when storing auto limits Buffer */ + { + /* 1D and n1D case : mc_mn_Vars->Flag_Multiple */ + if (mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Number*mc_mn_Vars->Coord_Bin[mc_mn_i] vectors (intensity is not included) */ + /* check limits: monitors define a phase space to record */ + char within_limits=1; + for (mc_mn_i= 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + mc_mn_j = mc_mn_Coord_Index[mc_mn_i]; + if (mc_mn_j < 0 || mc_mn_j >= mc_mn_Vars->Coord_Bin[mc_mn_i]) + within_limits=0; + } + if (within_limits) + for (mc_mn_i= 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + mc_mn_j = mc_mn_Coord_Index[mc_mn_i]; + if (mc_mn_j >= 0 && mc_mn_j < mc_mn_Vars->Coord_Bin[mc_mn_i]) + { + mc_mn_Vars->Mon2D_N[mc_mn_i-1][mc_mn_j]++; + mc_mn_Vars->Mon2D_p[mc_mn_i-1][mc_mn_j] += mc_mn_pp; + mc_mn_Vars->Mon2D_p2[mc_mn_i-1][mc_mn_j] += mc_mn_pp*mc_mn_pp; + } + } + } + else /* 2D case : mc_mn_Vars->Coord_Number==2 and !mc_mn_Vars->Flag_Multiple and !mc_mn_Vars->Flag_List */ + if ((mc_mn_Vars->Coord_Number == 2) && !mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2] matrix */ + mc_mn_i = mc_mn_Coord_Index[1]; + mc_mn_j = mc_mn_Coord_Index[2]; + if (mc_mn_i >= 0 && mc_mn_i < mc_mn_Vars->Coord_Bin[1] && mc_mn_j >= 0 && mc_mn_j < mc_mn_Vars->Coord_Bin[2]) + { + mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]++; + mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j] += mc_mn_pp; + mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j] += mc_mn_pp*mc_mn_pp; + } + } + } /* end (mc_mn_Vars->Flag_Auto_Limits != 1) */ + } /* end while */ + return mc_mn_pp; +} /* end Monitor_nD_Trace */ + +/* ========================================================================= */ +/* ADD: E.Farhi, Aug 6th, 2001: Monitor_nD section */ +/* this routine is used to save data files */ +/* ========================================================================= */ + +void Monitor_nD_Save(MonitornD_Defines_type *mc_mn_DEFS, MonitornD_Variables_type *mc_mn_Vars) + { + char *mc_mn_fname; + long mc_mn_i,mc_mn_j; + double *mc_mn_p0m = NULL; + double *mc_mn_p1m = NULL; + double *mc_mn_p2m = NULL; + char mc_mn_Coord_X_Label[1024]; + double mc_mn_min1d, mc_mn_max1d; + double mc_mn_min2d, mc_mn_max2d; + long mc_mn_bin1d, mc_mn_bin2d; + char mc_mn_While_End = 0; + long mc_mn_While_Buffer = 0; + double mc_mn_XY, mc_mn_pp; + double mc_mn_Coord[MONnD_COORD_NMAX]; + long mc_mn_Coord_Index[MONnD_COORD_NMAX]; + char mc_mn_label[1024]; + double mc_mn_ratio; + + mc_mn_ratio = 100*mcget_run_num()/mcget_ncount(); + + if (mc_mn_ratio < 99) + { + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s save intermediate results (%.2f %%).\n", mc_mn_Vars->compcurname, mc_mn_ratio); + } + /* check Buffer flush when end of simulation reached */ + if ((mc_mn_Vars->Buffer_Counter <= mc_mn_Vars->Buffer_Block) && mc_mn_Vars->Flag_Auto_Limits && mc_mn_Vars->Mon2D_Buffer && mc_mn_Vars->Buffer_Counter) + { + /* Get Auto Limits */ + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s getting %li Auto Limits from List (%li).\n", mc_mn_Vars->compcurname, mc_mn_Vars->Coord_Number, mc_mn_Vars->Buffer_Counter); + for (mc_mn_i = 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + if (mc_mn_Vars->Coord_Type[mc_mn_i] & mc_mn_DEFS->COORD_AUTO) + { + mc_mn_Vars->Coord_Min[mc_mn_i] = FLT_MAX; + mc_mn_Vars->Coord_Max[mc_mn_i] = -FLT_MAX; + + for (mc_mn_j = 0; mc_mn_j < mc_mn_Vars->Buffer_Counter; mc_mn_j++) + { + mc_mn_XY = mc_mn_Vars->Mon2D_Buffer[mc_mn_i+mc_mn_j*(mc_mn_Vars->Coord_Number+1)]; /* scanning variables in Buffer */ + if (mc_mn_XY < mc_mn_Vars->Coord_Min[mc_mn_i]) mc_mn_Vars->Coord_Min[mc_mn_i] = mc_mn_XY; + if (mc_mn_XY > mc_mn_Vars->Coord_Max[mc_mn_i]) mc_mn_Vars->Coord_Max[mc_mn_i] = mc_mn_XY; + + } + } + } + mc_mn_Vars->Flag_Auto_Limits = 2; /* pass to 2nd auto limits step */ + mc_mn_Vars->Buffer_Block = mc_mn_Vars->Buffer_Counter; + + while (!mc_mn_While_End) + { /* we generate mc_mn_Coord[] and Coord_mc_mn_index[] from Buffer (auto limits) or passing neutron */ + if (mc_mn_While_Buffer < mc_mn_Vars->Buffer_Block) + { + /* first while loops (mc_mn_While_Buffer) */ + mc_mn_Coord[0] = mc_mn_Vars->Mon2D_Buffer[mc_mn_While_Buffer*(mc_mn_Vars->Coord_Number+1)]; + + /* auto limits case : scan Buffer within limits and store in Mon2D */ + for (mc_mn_i = 1; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + /* scanning variables in Buffer */ + mc_mn_XY = (mc_mn_Vars->Coord_Max[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i]); + mc_mn_Coord[mc_mn_i] = mc_mn_Vars->Mon2D_Buffer[mc_mn_i+mc_mn_While_Buffer*(mc_mn_Vars->Coord_Number+1)]; + if (mc_mn_XY > 0) mc_mn_Coord_Index[mc_mn_i] = floor((mc_mn_Coord[mc_mn_i]-mc_mn_Vars->Coord_Min[mc_mn_i])*mc_mn_Vars->Coord_Bin[mc_mn_i]/mc_mn_XY); + else mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Vars->Flag_With_Borders) + { + if (mc_mn_Coord_Index[mc_mn_i] < 0) mc_mn_Coord_Index[mc_mn_i] = 0; + if (mc_mn_Coord_Index[mc_mn_i] >= mc_mn_Vars->Coord_Bin[mc_mn_i]) mc_mn_Coord_Index[mc_mn_i] = mc_mn_Vars->Coord_Bin[mc_mn_i] - 1; + } + } /* end for */ + mc_mn_While_Buffer++; + } /* end if in Buffer */ + else /* (mc_mn_While_Buffer >= mc_mn_Vars->Buffer_Block) && (mc_mn_Vars->Flag_Auto_Limits == 2) */ + { + mc_mn_Vars->Flag_Auto_Limits = 0; + mc_mn_While_End = 1; + } + + /* store n1d/2d section from Buffer */ + + mc_mn_pp = mc_mn_Coord[0]; + /* 1D and n1D case : mc_mn_Vars->Flag_Multiple */ + if (mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Number*mc_mn_Vars->Coord_Bin[mc_mn_i] vectors (intensity is not included) */ + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Number; mc_mn_i++) + { + mc_mn_j = mc_mn_Coord_Index[mc_mn_i+1]; + if (mc_mn_j >= 0 && mc_mn_j < mc_mn_Vars->Coord_Bin[mc_mn_i+1]) + { + mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]++; + mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j] += mc_mn_pp; + mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j] += mc_mn_pp*mc_mn_pp; + } + } + } + else /* 2D case : mc_mn_Vars->Coord_Number==2 and !mc_mn_Vars->Flag_Multiple and !mc_mn_Vars->Flag_List */ + if ((mc_mn_Vars->Coord_Number == 2) && !mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2] matrix */ + mc_mn_i = mc_mn_Coord_Index[1]; + mc_mn_j = mc_mn_Coord_Index[2]; + if (mc_mn_i >= 0 && mc_mn_i < mc_mn_Vars->Coord_Bin[1] && mc_mn_j >= 0 && mc_mn_j < mc_mn_Vars->Coord_Bin[2]) + { + mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]++; + mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j] += mc_mn_pp; + mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j] += mc_mn_pp*mc_mn_pp; + } + } /* end store 2D/1D */ + } /* end while */ + } /* end Force Get Limits */ + + /* write output files (sent to file as p[i*n + j] vectors) */ + if (mc_mn_Vars->Coord_Number == 0) + { + double mc_mn_Nsum; + double mc_mn_psum, mc_mn_p2sum; + mc_mn_Nsum = mc_mn_Vars->Nsum; + mc_mn_psum = mc_mn_Vars->psum; + mc_mn_p2sum= mc_mn_Vars->p2sum; + if (mc_mn_Vars->Flag_signal != mc_mn_DEFS->COORD_P && mc_mn_Nsum > 0) + { mc_mn_psum /=mc_mn_Nsum; mc_mn_p2sum /= mc_mn_Nsum*mc_mn_Nsum; } + /* DETECTOR_OUT_0D(mc_mn_Vars->Monitor_Label, mc_mn_Vars->Nsum, mc_mn_Vars->psum, mc_mn_Vars->p2sum); */ + mcdetector_out_0D(mc_mn_Vars->Monitor_Label, mc_mn_Nsum, mc_mn_psum, mc_mn_p2sum, mc_mn_Vars->compcurname); + } + else + if (strlen(mc_mn_Vars->Mon_File) > 0) + { + mc_mn_fname = (char*)malloc(strlen(mc_mn_Vars->Mon_File)+10*mc_mn_Vars->Coord_Number); + if (mc_mn_Vars->Flag_List && mc_mn_Vars->Mon2D_Buffer) /* List: DETECTOR_OUT_2D */ + { + int loc_ascii_only; + char formatName[64]; + char *formatName_orig; + + if (mc_mn_Vars->Flag_List >= 2) mc_mn_Vars->Buffer_Size = mc_mn_Vars->Neutron_Counter; + if (mc_mn_Vars->Buffer_Size >= mc_mn_Vars->Neutron_Counter) + mc_mn_Vars->Buffer_Size = mc_mn_Vars->Neutron_Counter; + strcpy(mc_mn_fname,mc_mn_Vars->Mon_File); + if (strchr(mc_mn_Vars->Mon_File,'.') == NULL) strcat(mc_mn_fname, "_list"); + + mc_mn_min1d = 1; mc_mn_max1d = mc_mn_Vars->Coord_Number+1; + mc_mn_min2d = 0; mc_mn_max2d = mc_mn_Vars->Buffer_Size; + mc_mn_bin1d = mc_mn_Vars->Coord_Number+1; mc_mn_bin2d = mc_mn_Vars->Buffer_Size; + strcpy(mc_mn_Coord_X_Label,""); + for (mc_mn_i= 0; mc_mn_i <= mc_mn_Vars->Coord_Number; mc_mn_i++) + { + if (mc_mn_min2d < mc_mn_Vars->Coord_Min[mc_mn_i]) mc_mn_min2d = mc_mn_Vars->Coord_Min[mc_mn_i]; + if (mc_mn_max2d < mc_mn_Vars->Coord_Max[mc_mn_i]) mc_mn_max2d = mc_mn_Vars->Coord_Max[mc_mn_i]; + strcat(mc_mn_Coord_X_Label, mc_mn_Vars->Coord_Var[mc_mn_i]); + strcat(mc_mn_Coord_X_Label, " "); + if (strchr(mc_mn_Vars->Mon_File,'.') == NULL) + { strcat(mc_mn_fname, "."); strcat(mc_mn_fname, mc_mn_Vars->Coord_Var[mc_mn_i]); } + } + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s write monitor file %s List (%lix%li).\n", mc_mn_Vars->compcurname, mc_mn_fname,mc_mn_bin2d,mc_mn_bin1d); + + /* handle the type of list output */ + loc_ascii_only = mcascii_only; + formatName_orig = mcformat.Name; /* copy the pointer position */ + strcpy(formatName, mcformat.Name); + if (mc_mn_Vars->Flag_List >= 1) + { + strcat(formatName, " partial "); + if (mc_mn_Vars->Flag_List > 2) + { strcat(formatName, " append "); mcascii_only = 1; } + if (mc_mn_Vars->Flag_Binary_List) mcascii_only = 1; + if (mc_mn_Vars->Flag_Binary_List == 1) + strcat(formatName, " binary float "); + else if (mc_mn_Vars->Flag_Binary_List == 2) + strcat(formatName, " binary double "); + } + if (mc_mn_min2d == mc_mn_max2d) mc_mn_max2d = mc_mn_min2d+1e-6; + if (mc_mn_min1d == mc_mn_max1d) mc_mn_max1d = mc_mn_min1d+1e-6; + strcpy(mc_mn_label, mc_mn_Vars->Monitor_Label); + if (!mc_mn_Vars->Flag_Binary_List) + { mc_mn_bin2d=-mc_mn_bin2d; } + mcformat.Name = formatName; + mcdetector_out_2D( + mc_mn_label, + "List of neutron events", + mc_mn_Coord_X_Label, + mc_mn_min2d, mc_mn_max2d, + mc_mn_min1d, mc_mn_max1d, + mc_mn_bin2d, + mc_mn_bin1d, + NULL,mc_mn_Vars->Mon2D_Buffer,NULL, + mc_mn_fname, mc_mn_Vars->compcurname); + + /* reset the original type of output */ + mcascii_only = loc_ascii_only; + mcformat.Name= formatName_orig; + } + if (mc_mn_Vars->Flag_Multiple) /* n1D: DETECTOR_OUT_1D */ + { + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Number; mc_mn_i++) + { + + strcpy(mc_mn_fname,mc_mn_Vars->Mon_File); + if (strchr(mc_mn_Vars->Mon_File,'.') == NULL) + { strcat(mc_mn_fname, "."); strcat(mc_mn_fname, mc_mn_Vars->Coord_Var[mc_mn_i+1]); } + sprintf(mc_mn_Coord_X_Label, "%s monitor", mc_mn_Vars->Coord_Label[mc_mn_i+1]); + strcpy(mc_mn_label, mc_mn_Coord_X_Label); + if (mc_mn_Vars->Coord_Bin[mc_mn_i+1] > 0) { /* 1D monitor */ + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s write monitor file %s 1D (%li).\n", mc_mn_Vars->compcurname, mc_mn_fname, mc_mn_Vars->Coord_Bin[mc_mn_i+1]); + mc_mn_min1d = mc_mn_Vars->Coord_Min[mc_mn_i+1]; + mc_mn_max1d = mc_mn_Vars->Coord_Max[mc_mn_i+1]; + if (mc_mn_min1d == mc_mn_max1d) mc_mn_max1d = mc_mn_min1d+1e-6; + mc_mn_p1m = (double *)malloc(mc_mn_Vars->Coord_Bin[mc_mn_i+1]*sizeof(double)); + mc_mn_p2m = (double *)malloc(mc_mn_Vars->Coord_Bin[mc_mn_i+1]*sizeof(double)); + if (mc_mn_p2m == NULL) /* use Raw Buffer line output */ + { + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s cannot allocate memory for output. Using raw data.\n", mc_mn_Vars->compcurname); + if (mc_mn_p1m != NULL) free(mc_mn_p1m); + mcdetector_out_1D( + mc_mn_label, + mc_mn_Vars->Coord_Label[mc_mn_i+1], + mc_mn_Vars->Coord_Label[0], + mc_mn_Vars->Coord_Var[mc_mn_i+1], + mc_mn_min1d, mc_mn_max1d, + mc_mn_Vars->Coord_Bin[mc_mn_i+1], + mc_mn_Vars->Mon2D_N[mc_mn_i],mc_mn_Vars->Mon2D_p[mc_mn_i],mc_mn_Vars->Mon2D_p2[mc_mn_i], + mc_mn_fname, mc_mn_Vars->compcurname); + } /* if (mc_mn_p2m == NULL) */ + else + { + if (mc_mn_Vars->Flag_log != 0) + { + mc_mn_XY = FLT_MAX; + for (mc_mn_j=0; mc_mn_j < mc_mn_Vars->Coord_Bin[mc_mn_i+1]; mc_mn_j++) /* search min of signal */ + if ((mc_mn_XY > mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]) && (mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j] > 0)) mc_mn_XY = mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]; + if (mc_mn_XY <= 0) mc_mn_XY = -log(FLT_MAX)/log(10); else mc_mn_XY = log(mc_mn_XY)/log(10)-1; + } /* if */ + + for (mc_mn_j=0; mc_mn_j < mc_mn_Vars->Coord_Bin[mc_mn_i+1]; mc_mn_j++) + { + mc_mn_p1m[mc_mn_j] = mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]; + mc_mn_p2m[mc_mn_j] = mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j]; + if (mc_mn_Vars->Flag_signal != mc_mn_DEFS->COORD_P && mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j] > 0) + { /* normalize mean signal to the number of events */ + mc_mn_p1m[mc_mn_j] /= mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]; + mc_mn_p2m[mc_mn_j] /= mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]*mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]; + } + if (mc_mn_Vars->Flag_log != 0) + { + if ((mc_mn_p1m[mc_mn_j] > 0) && (mc_mn_p2m[mc_mn_j] > 0)) + { + mc_mn_p2m[mc_mn_j] /= mc_mn_p1m[mc_mn_j]*mc_mn_p1m[mc_mn_j]; + mc_mn_p1m[mc_mn_j] = log(mc_mn_p1m[mc_mn_j])/log(10); + } + else + { + mc_mn_p1m[mc_mn_j] = mc_mn_XY; + mc_mn_p2m[mc_mn_j] = 0; + } + } + } /* for */ + mcdetector_out_1D( + mc_mn_label, + mc_mn_Vars->Coord_Label[mc_mn_i+1], + mc_mn_Vars->Coord_Label[0], + mc_mn_Vars->Coord_Var[mc_mn_i+1], + mc_mn_min1d, mc_mn_max1d, + mc_mn_Vars->Coord_Bin[mc_mn_i+1], + mc_mn_Vars->Mon2D_N[mc_mn_i],mc_mn_p1m,mc_mn_p2m, + mc_mn_fname, mc_mn_Vars->compcurname); + + } /* else */ + if (mc_mn_p1m != NULL) free(mc_mn_p1m); mc_mn_p1m=NULL; + if (mc_mn_p2m != NULL) free(mc_mn_p2m); mc_mn_p2m=NULL; + } else { /* 0d monitor */ + mcdetector_out_0D(mc_mn_label, mc_mn_Vars->Mon2D_p[mc_mn_i][0], mc_mn_Vars->Mon2D_p2[mc_mn_i][0], mc_mn_Vars->Mon2D_N[mc_mn_i][0], mc_mn_Vars->compcurname); + } + + + } /* for */ + } /* if 1D */ + else + if (mc_mn_Vars->Coord_Number == 2) /* 2D: DETECTOR_OUT_2D */ + { + strcpy(mc_mn_fname,mc_mn_Vars->Mon_File); + + mc_mn_p0m = (double *)malloc(mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + mc_mn_p1m = (double *)malloc(mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + mc_mn_p2m = (double *)malloc(mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + if (mc_mn_p2m == NULL) + { + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s cannot allocate memory for 2D array (%li). Skipping.\n", mc_mn_Vars->compcurname, 3*mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2]*sizeof(double)); + if (mc_mn_p0m != NULL) free(mc_mn_p0m); + if (mc_mn_p1m != NULL) free(mc_mn_p1m); + } + else + { + if (mc_mn_Vars->Flag_log != 0) + { + mc_mn_XY = FLT_MAX; + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Bin[1]; mc_mn_i++) + for (mc_mn_j= 0; mc_mn_j < mc_mn_Vars->Coord_Bin[2]; mc_mn_j++) /* search min of signal */ + if ((mc_mn_XY > mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]) && (mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]>0)) mc_mn_XY = mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]; + if (mc_mn_XY <= 0) mc_mn_XY = -log(FLT_MAX)/log(10); else mc_mn_XY = log(mc_mn_XY)/log(10)-1; + } + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Bin[1]; mc_mn_i++) + { + for (mc_mn_j= 0; mc_mn_j < mc_mn_Vars->Coord_Bin[2]; mc_mn_j++) + { + long mc_mn_index; + mc_mn_index = mc_mn_j + mc_mn_i*mc_mn_Vars->Coord_Bin[2]; + mc_mn_p0m[mc_mn_index] = mc_mn_Vars->Mon2D_N[mc_mn_i][mc_mn_j]; + mc_mn_p1m[mc_mn_index] = mc_mn_Vars->Mon2D_p[mc_mn_i][mc_mn_j]; + mc_mn_p2m[mc_mn_index] = mc_mn_Vars->Mon2D_p2[mc_mn_i][mc_mn_j]; + if (mc_mn_Vars->Flag_signal != mc_mn_DEFS->COORD_P && mc_mn_p0m[mc_mn_index] > 0) + { + mc_mn_p1m[mc_mn_index] /= mc_mn_p0m[mc_mn_index]; + mc_mn_p2m[mc_mn_index] /= mc_mn_p0m[mc_mn_index]*mc_mn_p0m[mc_mn_index]; + } + + if (mc_mn_Vars->Flag_log != 0) + { + if ((mc_mn_p1m[mc_mn_index] > 0) && (mc_mn_p2m[mc_mn_index] > 0)) + { + mc_mn_p2m[mc_mn_index] /= (mc_mn_p1m[mc_mn_index]*mc_mn_p1m[mc_mn_index]); + mc_mn_p1m[mc_mn_index] = log(mc_mn_p1m[mc_mn_index])/log(10); + + } + else + { + mc_mn_p1m[mc_mn_index] = mc_mn_XY; + mc_mn_p2m[mc_mn_index] = 0; + } + } + } + } + if (strchr(mc_mn_Vars->Mon_File,'.') == NULL) + { strcat(mc_mn_fname, "."); strcat(mc_mn_fname, mc_mn_Vars->Coord_Var[1]); + strcat(mc_mn_fname, "_"); strcat(mc_mn_fname, mc_mn_Vars->Coord_Var[2]); } + if (mc_mn_Vars->Flag_Verbose) printf("Monitor_nD: %s write monitor file %s 2D (%lix%li).\n", mc_mn_Vars->compcurname, mc_mn_fname, mc_mn_Vars->Coord_Bin[1], mc_mn_Vars->Coord_Bin[2]); + + mc_mn_min1d = mc_mn_Vars->Coord_Min[1]; + mc_mn_max1d = mc_mn_Vars->Coord_Max[1]; + if (mc_mn_min1d == mc_mn_max1d) mc_mn_max1d = mc_mn_min1d+1e-6; + mc_mn_min2d = mc_mn_Vars->Coord_Min[2]; + mc_mn_max2d = mc_mn_Vars->Coord_Max[2]; + if (mc_mn_min2d == mc_mn_max2d) mc_mn_max2d = mc_mn_min2d+1e-6; + strcpy(mc_mn_label, mc_mn_Vars->Monitor_Label); + + mcdetector_out_2D( + mc_mn_label, + mc_mn_Vars->Coord_Label[1], + mc_mn_Vars->Coord_Label[2], + mc_mn_min1d, mc_mn_max1d, + mc_mn_min2d, mc_mn_max2d, + mc_mn_Vars->Coord_Bin[1], + mc_mn_Vars->Coord_Bin[2], + mc_mn_p0m,mc_mn_p1m,mc_mn_p2m, + mc_mn_fname, mc_mn_Vars->compcurname); + + if (mc_mn_p0m != NULL) free(mc_mn_p0m); + if (mc_mn_p1m != NULL) free(mc_mn_p1m); + if (mc_mn_p2m != NULL) free(mc_mn_p2m); + } + } + free(mc_mn_fname); + } + } /* end Monitor_nD_Save */ + +/* ========================================================================= */ +/* ADD: E.Farhi, Aug 6th, 2001: Monitor_nD section */ +/* this routine is used to free memory */ +/* ========================================================================= */ + +void Monitor_nD_Finally(MonitornD_Defines_type *mc_mn_DEFS, + MonitornD_Variables_type *mc_mn_Vars) + { + int mc_mn_i; + + /* Now Free memory Mon2D.. */ + if ((mc_mn_Vars->Flag_Auto_Limits || mc_mn_Vars->Flag_List) && mc_mn_Vars->Coord_Number) + { /* Dim : (mc_mn_Vars->Coord_Number+1)*mc_mn_Vars->Buffer_Block matrix (for p, dp) */ + if (mc_mn_Vars->Mon2D_Buffer != NULL) free(mc_mn_Vars->Mon2D_Buffer); + } + + /* 1D and n1D case : mc_mn_Vars->Flag_Multiple */ + if (mc_mn_Vars->Flag_Multiple && mc_mn_Vars->Coord_Number) + { /* Dim : mc_mn_Vars->Coord_Number*mc_mn_Vars->Coord_Bin[mc_mn_i] vectors */ + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Number; mc_mn_i++) + { + free(mc_mn_Vars->Mon2D_N[mc_mn_i]); + free(mc_mn_Vars->Mon2D_p[mc_mn_i]); + free(mc_mn_Vars->Mon2D_p2[mc_mn_i]); + } + free(mc_mn_Vars->Mon2D_N); + free(mc_mn_Vars->Mon2D_p); + free(mc_mn_Vars->Mon2D_p2); + } + + + /* 2D case : mc_mn_Vars->Coord_Number==2 and !mc_mn_Vars->Flag_Multiple and !mc_mn_Vars->Flag_List */ + if ((mc_mn_Vars->Coord_Number == 2) && !mc_mn_Vars->Flag_Multiple) + { /* Dim : mc_mn_Vars->Coord_Bin[1]*mc_mn_Vars->Coord_Bin[2] matrix */ + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Bin[1]; mc_mn_i++) + { + free(mc_mn_Vars->Mon2D_N[mc_mn_i]); + free(mc_mn_Vars->Mon2D_p[mc_mn_i]); + free(mc_mn_Vars->Mon2D_p2[mc_mn_i]); + } + free(mc_mn_Vars->Mon2D_N); + free(mc_mn_Vars->Mon2D_p); + free(mc_mn_Vars->Mon2D_p2); + } + } /* end Monitor_nD_Finally */ + +/* ========================================================================= */ +/* ADD: E.Farhi, Aug 6th, 2001: Monitor_nD section */ +/* this routine is used to display component */ +/* ========================================================================= */ + +void Monitor_nD_McDisplay(MonitornD_Defines_type *mc_mn_DEFS, + MonitornD_Variables_type *mc_mn_Vars) + { + double mc_mn_radius, mc_mn_h; + double mc_mn_xmin; + double mc_mn_xmax; + double mc_mn_ymin; + double mc_mn_ymax; + double mc_mn_zmin; + double mc_mn_zmax; + int mc_mn_i; + double mc_mn_hdiv_min=-180, mc_mn_hdiv_max=180, mc_mn_vdiv_min=-180, mc_mn_vdiv_max=180; + char mc_mn_restricted = 0; + + mc_mn_radius = mc_mn_Vars->Sphere_Radius; + mc_mn_h = mc_mn_Vars->Cylinder_Height; + mc_mn_xmin = mc_mn_Vars->mxmin; + mc_mn_xmax = mc_mn_Vars->mxmax; + mc_mn_ymin = mc_mn_Vars->mymin; + mc_mn_ymax = mc_mn_Vars->mymax; + mc_mn_zmin = mc_mn_Vars->mzmin; + mc_mn_zmax = mc_mn_Vars->mzmax; + + /* determine if there are angular limits set at start (no auto) in coord_types + * cylinder/banana: look for hdiv + * sphere: look for angle, radius (->atan2(val,mc_mn_radius)), hdiv, vdiv + * this activates a 'restricted' flag, to draw a region as blades on cylinder/sphere + */ + for (mc_mn_i= 0; mc_mn_i < mc_mn_Vars->Coord_Number; mc_mn_i++) + { + int mc_mn_Set_Vars_Coord_Type; + mc_mn_Set_Vars_Coord_Type = (mc_mn_Vars->Coord_Type[mc_mn_i] & 31); + if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_HDIV || mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_THETA) + { mc_mn_hdiv_min = mc_mn_Vars->Coord_Min[mc_mn_i]; mc_mn_hdiv_max = mc_mn_Vars->Coord_Max[mc_mn_i]; mc_mn_restricted = 1; } + else if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_VDIV || mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_PHI) + { mc_mn_vdiv_min = mc_mn_Vars->Coord_Min[mc_mn_i]; mc_mn_vdiv_max = mc_mn_Vars->Coord_Max[mc_mn_i];mc_mn_restricted = 1; } + else if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_ANGLE) + { mc_mn_hdiv_min = mc_mn_vdiv_min = mc_mn_Vars->Coord_Min[mc_mn_i]; + mc_mn_hdiv_max = mc_mn_vdiv_max = mc_mn_Vars->Coord_Max[mc_mn_i]; + mc_mn_restricted = 1; } + else if (mc_mn_Set_Vars_Coord_Type == mc_mn_DEFS->COORD_RADIUS) + { double angle; + angle = RAD2DEG*atan2(mc_mn_Vars->Coord_Max[mc_mn_i], mc_mn_radius); + mc_mn_hdiv_min = mc_mn_vdiv_min = angle; + mc_mn_hdiv_max = mc_mn_vdiv_max = angle; + mc_mn_restricted = 1; } + } + + if (!mc_mn_restricted && (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_SPHERE)) + { + mcdis_magnify(""); + mcdis_circle("xy",0,0,0,mc_mn_radius); + mcdis_circle("xz",0,0,0,mc_mn_radius); + mcdis_circle("yz",0,0,0,mc_mn_radius); + } + else if (mc_mn_restricted && ((abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_CYLIND) || (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_BANANA) || (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_SPHERE))) + { + int NH=24, NV=24; + int ih, iv; + double width, height; + int issphere; + issphere = (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_SPHERE); + width = (mc_mn_hdiv_max-mc_mn_hdiv_min)/NH; + height= (mc_mn_vdiv_max-mc_mn_vdiv_min)/NV; + mcdis_magnify("xyz"); + for(ih = 0; ih < NH; ih++) + for(iv = 0; iv < NV; iv++) + { + double theta0, phi0, theta1, phi1; + double x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3; + double ymin, ymax; + phi0 = (mc_mn_hdiv_min+ width*ih)*DEG2RAD; /* in xz plane */ + phi1 = (mc_mn_hdiv_min+ width*(ih+1))*DEG2RAD; + if (issphere) + { + theta0= (90-mc_mn_vdiv_min+height*iv)*DEG2RAD; + theta1= (90-mc_mn_vdiv_min+height*(iv+1))*DEG2RAD; + } else + { + theta0= theta1 = PI/2; + ymin = mc_mn_ymin+(mc_mn_ymax-mc_mn_ymin)*(iv/NV); + ymax = mc_mn_ymin+(mc_mn_ymax-mc_mn_ymin)*((iv+1)/NV); + } + z0 = mc_mn_radius*sin(theta0)*cos(phi0); + x0 = mc_mn_radius*sin(theta0)*sin(phi0); + if (issphere) y0 = mc_mn_radius*cos(theta0); else y0 = ymin; + z1 = mc_mn_radius*sin(theta1)*cos(phi0); + x1 = mc_mn_radius*sin(theta1)*sin(phi0); + if (issphere) y1 = mc_mn_radius*cos(theta1); else y1 = ymax; + z2 = mc_mn_radius*sin(theta1)*cos(phi1); + x2 = mc_mn_radius*sin(theta1)*sin(phi1); + y2 = y1; + z3 = mc_mn_radius*sin(theta0)*cos(phi1); + x3 = mc_mn_radius*sin(theta0)*sin(phi1); + y3 = y0; + mcdis_multiline(5, + x0,y0,z0, + x1,y1,z1, + x2,y2,z2, + x3,y3,z3, + x0,y0,z0); + } + } + else + if (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_DISK) + { + mcdis_magnify(""); + mcdis_circle("xy",0,0,0,mc_mn_radius); + } + else + if (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_SQUARE) + { + mcdis_magnify("xy"); + mcdis_multiline(5, (double)mc_mn_xmin, (double)mc_mn_ymin, 0.0, + (double)mc_mn_xmax, (double)mc_mn_ymin, 0.0, + (double)mc_mn_xmax, (double)mc_mn_ymax, 0.0, + (double)mc_mn_xmin, (double)mc_mn_ymax, 0.0, + (double)mc_mn_xmin, (double)mc_mn_ymin, 0.0); + } + else + if (!mc_mn_restricted && ((abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_CYLIND) || (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_BANANA))) + { + mcdis_magnify("xyz"); + mcdis_circle("xz", 0, mc_mn_h/2.0, 0, mc_mn_radius); + mcdis_circle("xz", 0, -mc_mn_h/2.0, 0, mc_mn_radius); + mcdis_line(-mc_mn_radius, -mc_mn_h/2.0, 0, -mc_mn_radius, +mc_mn_h/2.0, 0); + mcdis_line(+mc_mn_radius, -mc_mn_h/2.0, 0, +mc_mn_radius, +mc_mn_h/2.0, 0); + mcdis_line(0, -mc_mn_h/2.0, -mc_mn_radius, 0, +mc_mn_h/2.0, -mc_mn_radius); + mcdis_line(0, -mc_mn_h/2.0, +mc_mn_radius, 0, +mc_mn_h/2.0, +mc_mn_radius); + } + else + if (abs(mc_mn_Vars->Flag_Shape) == mc_mn_DEFS->SHAPE_BOX) + { + mcdis_magnify("xyz"); + mcdis_multiline(5, mc_mn_xmin, mc_mn_ymin, mc_mn_zmin, + mc_mn_xmax, mc_mn_ymin, mc_mn_zmin, + mc_mn_xmax, mc_mn_ymax, mc_mn_zmin, + mc_mn_xmin, mc_mn_ymax, mc_mn_zmin, + mc_mn_xmin, mc_mn_ymin, mc_mn_zmin); + mcdis_multiline(5, mc_mn_xmin, mc_mn_ymin, mc_mn_zmax, + mc_mn_xmax, mc_mn_ymin, mc_mn_zmax, + mc_mn_xmax, mc_mn_ymax, mc_mn_zmax, + mc_mn_xmin, mc_mn_ymax, mc_mn_zmax, + mc_mn_xmin, mc_mn_ymin, mc_mn_zmax); + mcdis_line(mc_mn_xmin, mc_mn_ymin, mc_mn_zmin, mc_mn_xmin, mc_mn_ymin, mc_mn_zmax); + mcdis_line(mc_mn_xmax, mc_mn_ymin, mc_mn_zmin, mc_mn_xmax, mc_mn_ymin, mc_mn_zmax); + mcdis_line(mc_mn_xmin, mc_mn_ymax, mc_mn_zmin, mc_mn_xmin, mc_mn_ymax, mc_mn_zmax); + mcdis_line(mc_mn_xmax, mc_mn_ymax, mc_mn_zmin, mc_mn_xmax, mc_mn_ymax, mc_mn_zmax); + } + } /* end Monitor_nD_McDisplay */ + +/* end of monitor_nd-lib.c */ + +#line 6873 "dmcafter.c" +#line 213 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" + MonitornD_Defines_type DEFS; + MonitornD_Variables_type Vars; +#line 6877 "dmcafter.c" +#undef zmax +#undef zmin +#undef ymax +#undef ymin +#undef xmax +#undef xmin +#undef zthick +#undef yheight +#undef xwidth +#undef Vars +#undef DEFS +#undef filename +#undef options +#undef mccompcurname +#undef mccompcurindex + +Coords mcposamsa, mcposrmsa; +Rotation mcrotamsa, mcrotrmsa; +Coords mcposain, mcposrin; +Rotation mcrotain, mcrotrin; +Coords mcposaout2_slit, mcposrout2_slit; +Rotation mcrotaout2_slit, mcrotrout2_slit; +Coords mcposaPSD_sample, mcposrPSD_sample; +Rotation mcrotaPSD_sample, mcrotrPSD_sample; +Coords mcposasa_arm, mcposrsa_arm; +Rotation mcrotasa_arm, mcrotrsa_arm; +Coords mcposasample, mcposrsample; +Rotation mcrotasample, mcrotrsample; +Coords mcposaDet9, mcposrDet9; +Rotation mcrotaDet9, mcrotrDet9; + +MCNUM mcnx, mcny, mcnz, mcnvx, mcnvy, mcnvz, mcnt, mcnsx, mcnsy, mcnsz, mcnp; + +void mcinit(void) { +#define Det_start mcipDet_start +#define samplefile mcipsamplefile +#define monfile mcipmonfile +#define lambdafile mciplambdafile +#define repeat mciprepeat +#line 13 "dmcafter.instr" +{ +Det_end= Det_start + 80; +sprintf(option_list,"banana theta limits [%f %f] bins=400, file=det9.dat",Det_start,Det_end); +printf("%s \n",option_list); +} +#line 6923 "dmcafter.c" +#undef repeat +#undef lambdafile +#undef monfile +#undef samplefile +#undef Det_start + /* Computation of coordinate transformations. */ + { + Coords mctc1, mctc2; + Rotation mctr1; + + mcDEBUG_INSTR() + /* Component msa. */ + strcpy(mcsig_message, "msa (Init:Place/Rotate)"); + rot_set_rotation(mcrotamsa, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD); +#line 6941 "dmcafter.c" + rot_copy(mcrotrmsa, mcrotamsa); + mcposamsa = coords_set( +#line 23 "dmcafter.instr" + 0, +#line 23 "dmcafter.instr" + 0, +#line 23 "dmcafter.instr" + 0); +#line 6950 "dmcafter.c" + mctc1 = coords_neg(mcposamsa); + mcposrmsa = rot_apply(mcrotamsa, mctc1); + mcDEBUG_COMPONENT("msa", mcposamsa, mcrotamsa) + mccomp_posa[1] = mcposamsa; + mccomp_posr[1] = mcposrmsa; + /* Component in. */ + strcpy(mcsig_message, "in (Init:Place/Rotate)"); + rot_set_rotation(mctr1, +#line 31 "dmcafter.instr" + (0)*DEG2RAD, +#line 31 "dmcafter.instr" + (0)*DEG2RAD, +#line 31 "dmcafter.instr" + (0)*DEG2RAD); +#line 6965 "dmcafter.c" + rot_mul(mctr1, mcrotamsa, mcrotain); + rot_transpose(mcrotamsa, mctr1); + rot_mul(mcrotain, mctr1, mcrotrin); + mctc1 = coords_set( +#line 31 "dmcafter.instr" + 0, +#line 31 "dmcafter.instr" + 0, +#line 31 "dmcafter.instr" + 0.64); +#line 6976 "dmcafter.c" + rot_transpose(mcrotamsa, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposain = coords_add(mcposamsa, mctc2); + mctc1 = coords_sub(mcposamsa, mcposain); + mcposrin = rot_apply(mcrotain, mctc1); + mcDEBUG_COMPONENT("in", mcposain, mcrotain) + mccomp_posa[2] = mcposain; + mccomp_posr[2] = mcposrin; + /* Component out2_slit. */ + strcpy(mcsig_message, "out2_slit (Init:Place/Rotate)"); + rot_set_rotation(mctr1, +#line 35 "dmcafter.instr" + (0)*DEG2RAD, +#line 35 "dmcafter.instr" + (0)*DEG2RAD, +#line 35 "dmcafter.instr" + (0)*DEG2RAD); +#line 6994 "dmcafter.c" + rot_mul(mctr1, mcrotamsa, mcrotaout2_slit); + rot_transpose(mcrotain, mctr1); + rot_mul(mcrotaout2_slit, mctr1, mcrotrout2_slit); + mctc1 = coords_set( +#line 35 "dmcafter.instr" + 0, +#line 35 "dmcafter.instr" + 0, +#line 35 "dmcafter.instr" + 0.65); +#line 7005 "dmcafter.c" + rot_transpose(mcrotamsa, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposaout2_slit = coords_add(mcposamsa, mctc2); + mctc1 = coords_sub(mcposain, mcposaout2_slit); + mcposrout2_slit = rot_apply(mcrotaout2_slit, mctc1); + mcDEBUG_COMPONENT("out2_slit", mcposaout2_slit, mcrotaout2_slit) + mccomp_posa[3] = mcposaout2_slit; + mccomp_posr[3] = mcposrout2_slit; + /* Component PSD_sample. */ + strcpy(mcsig_message, "PSD_sample (Init:Place/Rotate)"); + rot_set_rotation(mctr1, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD); +#line 7020 "dmcafter.c" + rot_mul(mctr1, mcrotamsa, mcrotaPSD_sample); + rot_transpose(mcrotaout2_slit, mctr1); + rot_mul(mcrotaPSD_sample, mctr1, mcrotrPSD_sample); + mctc1 = coords_set( +#line 39 "dmcafter.instr" + 0, +#line 39 "dmcafter.instr" + 0, +#line 39 "dmcafter.instr" + 1.5); +#line 7031 "dmcafter.c" + rot_transpose(mcrotamsa, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposaPSD_sample = coords_add(mcposamsa, mctc2); + mctc1 = coords_sub(mcposaout2_slit, mcposaPSD_sample); + mcposrPSD_sample = rot_apply(mcrotaPSD_sample, mctc1); + mcDEBUG_COMPONENT("PSD_sample", mcposaPSD_sample, mcrotaPSD_sample) + mccomp_posa[4] = mcposaPSD_sample; + mccomp_posr[4] = mcposrPSD_sample; + /* Component sa_arm. */ + strcpy(mcsig_message, "sa_arm (Init:Place/Rotate)"); + rot_set_rotation(mctr1, +#line 53 "dmcafter.instr" + (0)*DEG2RAD, +#line 53 "dmcafter.instr" + (0)*DEG2RAD, +#line 53 "dmcafter.instr" + (0)*DEG2RAD); +#line 7049 "dmcafter.c" + rot_mul(mctr1, mcrotamsa, mcrotasa_arm); + rot_transpose(mcrotaPSD_sample, mctr1); + rot_mul(mcrotasa_arm, mctr1, mcrotrsa_arm); + mctc1 = coords_set( +#line 52 "dmcafter.instr" + 0, +#line 52 "dmcafter.instr" + 0, +#line 52 "dmcafter.instr" + 2.82); +#line 7060 "dmcafter.c" + rot_transpose(mcrotamsa, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposasa_arm = coords_add(mcposamsa, mctc2); + mctc1 = coords_sub(mcposaPSD_sample, mcposasa_arm); + mcposrsa_arm = rot_apply(mcrotasa_arm, mctc1); + mcDEBUG_COMPONENT("sa_arm", mcposasa_arm, mcrotasa_arm) + mccomp_posa[5] = mcposasa_arm; + mccomp_posr[5] = mcposrsa_arm; + /* Component sample. */ + strcpy(mcsig_message, "sample (Init:Place/Rotate)"); + rot_set_rotation(mctr1, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD, + (0.0)*DEG2RAD); +#line 7075 "dmcafter.c" + rot_mul(mctr1, mcrotasa_arm, mcrotasample); + rot_transpose(mcrotasa_arm, mctr1); + rot_mul(mcrotasample, mctr1, mcrotrsample); + mctc1 = coords_set( +#line 59 "dmcafter.instr" + 0, +#line 59 "dmcafter.instr" + 0, +#line 59 "dmcafter.instr" + 0); +#line 7086 "dmcafter.c" + rot_transpose(mcrotasa_arm, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposasample = coords_add(mcposasa_arm, mctc2); + mctc1 = coords_sub(mcposasa_arm, mcposasample); + mcposrsample = rot_apply(mcrotasample, mctc1); + mcDEBUG_COMPONENT("sample", mcposasample, mcrotasample) + mccomp_posa[6] = mcposasample; + mccomp_posr[6] = mcposrsample; + /* Component Det9. */ + strcpy(mcsig_message, "Det9 (Init:Place/Rotate)"); + rot_set_rotation(mctr1, +#line 65 "dmcafter.instr" + (0)*DEG2RAD, +#line 65 "dmcafter.instr" + (0)*DEG2RAD, +#line 65 "dmcafter.instr" + (180)*DEG2RAD); +#line 7104 "dmcafter.c" + rot_mul(mctr1, mcrotasa_arm, mcrotaDet9); + rot_transpose(mcrotasample, mctr1); + rot_mul(mcrotaDet9, mctr1, mcrotrDet9); + mctc1 = coords_set( +#line 64 "dmcafter.instr" + 0, +#line 64 "dmcafter.instr" + 0, +#line 64 "dmcafter.instr" + 0.000001); +#line 7115 "dmcafter.c" + rot_transpose(mcrotasa_arm, mctr1); + mctc2 = rot_apply(mctr1, mctc1); + mcposaDet9 = coords_add(mcposasa_arm, mctc2); + mctc1 = coords_sub(mcposasample, mcposaDet9); + mcposrDet9 = rot_apply(mcrotaDet9, mctc1); + mcDEBUG_COMPONENT("Det9", mcposaDet9, mcrotaDet9) + mccomp_posa[7] = mcposaDet9; + mccomp_posr[7] = mcposrDet9; + /* Component initializations. */ + /* Initializations for component msa. */ + strcpy(mcsig_message, "msa (Init)"); + + + /* Initializations for component in. */ + strcpy(mcsig_message, "in (Init)"); +#line 30 "dmcafter.instr" + mccin_repeat_count = mciprepeat; +#line 68 "dmcafter.instr" + mccin_bufsize = 0; +#line 7135 "dmcafter.c" + +#define mccompcurname in +#define mccompcurindex 2 +#define file mccin_file +#define type mccin_type +#define rep mccin_rep +#define pos mccin_pos +#define nrows mccin_nrows +#define nread mccin_nread +#define Offset mccin_Offset +#define rTable mccin_rTable +#define Virtual_input_Read_Input mccin_Virtual_input_Read_Input +{ /* Declarations of SETTING parameters. */ +MCNUM repeat_count = mccin_repeat_count; +MCNUM bufsize = mccin_bufsize; +#line 112 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/sources/Virtual_input.comp" +{ + Table_Init(&rTable); + rep = repeat_count+1; + + if (!file || !repeat_count) + { + fprintf(stderr,"Virtual_input: %s: please give me a file name (file) to read (repeat_count>0).\n", NAME_CURRENT_COMP); + exit(-1); + } + if (type && strstr(type, "Vitess")) + { fprintf(stderr, "Virtual_input: %s: Vitess files may be read using the Vitess_input component\n", NAME_CURRENT_COMP); exit(-1); } + + if (bufsize) mcset_ncount(bufsize*repeat_count); + + printf("Virtual_input: %s: Reading neutron events from file '%s'. Repeat %g time(s)\n", NAME_CURRENT_COMP, file, repeat_count); +} +#line 7168 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Virtual_input_Read_Input +#undef rTable +#undef Offset +#undef nread +#undef nrows +#undef pos +#undef rep +#undef type +#undef file +#undef mccompcurname +#undef mccompcurindex + + /* Initializations for component out2_slit. */ + strcpy(mcsig_message, "out2_slit (Init)"); +#line 34 "dmcafter.instr" + mccout2_slit_xmin = -0.01; +#line 34 "dmcafter.instr" + mccout2_slit_xmax = 0.01; +#line 34 "dmcafter.instr" + mccout2_slit_ymin = -0.06; +#line 34 "dmcafter.instr" + mccout2_slit_ymax = 0.06; +#line 42 "dmcafter.instr" + mccout2_slit_radius = 0; +#line 7194 "dmcafter.c" + +#define mccompcurname out2_slit +#define mccompcurindex 3 +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccout2_slit_xmin; +MCNUM xmax = mccout2_slit_xmax; +MCNUM ymin = mccout2_slit_ymin; +MCNUM ymax = mccout2_slit_ymax; +MCNUM radius = mccout2_slit_radius; +#line 46 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/optics/Slit.comp" +{ + if (xmin == 0 && xmax == 0 && ymin == 0 & ymax == 0 && radius == 0) + { fprintf(stderr,"Slit: %s: Error: give geometry\n", NAME_CURRENT_COMP); exit(-1); } + +} +#line 7210 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef mccompcurname +#undef mccompcurindex + + /* Initializations for component PSD_sample. */ + strcpy(mcsig_message, "PSD_sample (Init)"); +#line 38 "dmcafter.instr" + mccPSD_sample_xmin = -0.05; +#line 38 "dmcafter.instr" + mccPSD_sample_xmax = 0.05; +#line 38 "dmcafter.instr" + mccPSD_sample_ymin = -0.07; +#line 38 "dmcafter.instr" + mccPSD_sample_ymax = 0.07; +#line 38 "dmcafter.instr" + if(mcipmonfile) strncpy(mccPSD_sample_controlfile,mcipmonfile, 1024); else mccPSD_sample_controlfile[0]='\0'; +#line 45 "dmcafter.instr" + mccPSD_sample_dumpCount = 1000; +#line 7229 "dmcafter.c" + +#define mccompcurname PSD_sample +#define mccompcurindex 4 +#define Nsum mccPSD_sample_Nsum +#define psum mccPSD_sample_psum +#define p2sum mccPSD_sample_p2sum +#define currentCount mccPSD_sample_currentCount +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccPSD_sample_xmin; +MCNUM xmax = mccPSD_sample_xmax; +MCNUM ymin = mccPSD_sample_ymin; +MCNUM ymax = mccPSD_sample_ymax; +char* controlfile = mccPSD_sample_controlfile; +int dumpCount = mccPSD_sample_dumpCount; +#line 72 "MKMonitor.comp" +{ + psum = 0; + p2sum = 0; + Nsum = 0; + currentCount = 0; +} +#line 7251 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef currentCount +#undef p2sum +#undef psum +#undef Nsum +#undef mccompcurname +#undef mccompcurindex + + /* Initializations for component sa_arm. */ + strcpy(mcsig_message, "sa_arm (Init)"); + + + /* Initializations for component sample. */ + strcpy(mcsig_message, "sample (Init)"); +#line 56 "dmcafter.instr" + mccsample_d_phi0 = 0; +#line 56 "dmcafter.instr" + mccsample_radius = sample_radius; +#line 61 "dmcafter.instr" + mccsample_focus_r = 0; +#line 56 "dmcafter.instr" + mccsample_h = sample_height; +#line 57 "dmcafter.instr" + mccsample_pack = 1; +#line 57 "dmcafter.instr" + mccsample_Vc = 1076.98; +#line 58 "dmcafter.instr" + mccsample_sigma_a = 0.2; +#line 62 "dmcafter.instr" + mccsample_sigma_inc = 0; +#line 63 "dmcafter.instr" + mccsample_frac = 0; +#line 63 "dmcafter.instr" + mccsample_focus_xw = 0; +#line 63 "dmcafter.instr" + mccsample_focus_yh = 0; +#line 58 "dmcafter.instr" + mccsample_focus_aw = 80; +#line 58 "dmcafter.instr" + mccsample_focus_ah = 3.5; +#line 64 "dmcafter.instr" + mccsample_target_x = 0; +#line 64 "dmcafter.instr" + mccsample_target_y = 0; +#line 64 "dmcafter.instr" + mccsample_target_z = 0; +#line 58 "dmcafter.instr" + mccsample_target_index = + 1; +#line 7300 "dmcafter.c" + +#define mccompcurname sample +#define mccompcurindex 6 +#define reflections mccsample_reflections +#define my_s_v2 mccsample_my_s_v2 +#define my_a_v mccsample_my_a_v +#define q_v mccsample_q_v +{ /* Declarations of SETTING parameters. */ +MCNUM d_phi0 = mccsample_d_phi0; +MCNUM radius = mccsample_radius; +MCNUM focus_r = mccsample_focus_r; +MCNUM h = mccsample_h; +MCNUM pack = mccsample_pack; +MCNUM Vc = mccsample_Vc; +MCNUM sigma_a = mccsample_sigma_a; +MCNUM sigma_inc = mccsample_sigma_inc; +MCNUM frac = mccsample_frac; +MCNUM focus_xw = mccsample_focus_xw; +MCNUM focus_yh = mccsample_focus_yh; +MCNUM focus_aw = mccsample_focus_aw; +MCNUM focus_ah = mccsample_focus_ah; +MCNUM target_x = mccsample_target_x; +MCNUM target_y = mccsample_target_y; +MCNUM target_z = mccsample_target_z; +int target_index = mccsample_target_index; +#line 148 "PowderN.comp" +{ + struct line_data *L; + read_line_data(reflections, &line_info); + L = line_info.list; + + Nq = line_info.count; + my_s_v2 = malloc(Nq*sizeof(double)); + q_v = malloc(Nq*sizeof(double)); + w_v = malloc(Nq*sizeof(double)); + int i; + my_a_v = pack*sigma_a/Vc*2200; /* Is not yet divided by v */ + my_inc = pack*sigma_inc/Vc; + my_s_v2_sum=0; + + for(i=0; i= repeat_count) { + nrows = Virtual_input_Read_Input(file, type, &rTable, &Offset); + if (nrows) { rep = 0; pos = 0; nread++; } + } + + if (!nrows) + { mcset_ncount(mcget_run_num()); ABSORB; } + /* for each buffer, loop: repeat counts */ + /* for each repeat count: loop: generate neutrons */ + if (pos >= nrows) + { rep++; pos = 0; } /* Reposition at start of buffer */ + + /* &p, &x, &y, &z, &vx, &vy, &vz, &t, &sx, &sy, &sz */ + mcrestore_neutron(rTable.data,pos, &x, &y, &z, &vx, &vy, &vz, &t, &sx, &sy, &sz, &p); + + pos++; + p /= repeat_count; + SCATTER; +} +#line 7523 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Virtual_input_Read_Input +#undef rTable +#undef Offset +#undef nread +#undef nrows +#undef pos +#undef rep +#undef type +#undef file +#undef mccompcurname +#undef mccompcurindex +#undef sz +#undef sy +#undef sx +#undef p +#undef s2 +#undef s1 +#undef t +#undef vz +#undef vy +#undef vx +#undef z +#undef y +#undef x + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + /* Component out2_slit. */ + strcpy(mcsig_message, "out2_slit (Trace)"); + mcDEBUG_COMP("out2_slit") + mccoordschange(mcposrout2_slit, mcrotrout2_slit, + &mcnlx, &mcnly, &mcnlz, + &mcnlvx, &mcnlvy, &mcnlvz, + &mcnlt, &mcnlsx, &mcnlsy); + mccoordschange_polarisation(mcrotrout2_slit, &mcnlsx, &mcnlsy, &mcnlsz); + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) +#define x mcnlx +#define y mcnly +#define z mcnlz +#define vx mcnlvx +#define vy mcnlvy +#define vz mcnlvz +#define t mcnlt +#define s1 mcnlsx +#define s2 mcnlsy +#define p mcnlp + STORE_NEUTRON(3,mcnlx, mcnly, mcnlz, mcnlvx,mcnlvy,mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlsz, mcnlp); + mcScattered=0; +#define mccompcurname out2_slit +#define mccompcurindex 3 +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccout2_slit_xmin; +MCNUM xmax = mccout2_slit_xmax; +MCNUM ymin = mccout2_slit_ymin; +MCNUM ymax = mccout2_slit_ymax; +MCNUM radius = mccout2_slit_radius; +#line 53 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/optics/Slit.comp" +{ + PROP_Z0; + if (((radius == 0) && (xxmax || yymax)) + || ((radius != 0) && (x*x + y*y > radius*radius))) + ABSORB; + else + SCATTER; +} +#line 7589 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef mccompcurname +#undef mccompcurindex +#undef p +#undef s2 +#undef s1 +#undef t +#undef vz +#undef vy +#undef vx +#undef z +#undef y +#undef x + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + /* Component PSD_sample. */ + strcpy(mcsig_message, "PSD_sample (Trace)"); + mcDEBUG_COMP("PSD_sample") + mccoordschange(mcposrPSD_sample, mcrotrPSD_sample, + &mcnlx, &mcnly, &mcnlz, + &mcnlvx, &mcnlvy, &mcnlvz, + &mcnlt, &mcnlsx, &mcnlsy); + mccoordschange_polarisation(mcrotrPSD_sample, &mcnlsx, &mcnlsy, &mcnlsz); + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) +#define x mcnlx +#define y mcnly +#define z mcnlz +#define vx mcnlvx +#define vy mcnlvy +#define vz mcnlvz +#define t mcnlt +#define s1 mcnlsx +#define s2 mcnlsy +#define p mcnlp + STORE_NEUTRON(4,mcnlx, mcnly, mcnlz, mcnlvx,mcnlvy,mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlsz, mcnlp); + mcScattered=0; +#define mccompcurname PSD_sample +#define mccompcurindex 4 +#define Nsum mccPSD_sample_Nsum +#define psum mccPSD_sample_psum +#define p2sum mccPSD_sample_p2sum +#define currentCount mccPSD_sample_currentCount +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccPSD_sample_xmin; +MCNUM xmax = mccPSD_sample_xmax; +MCNUM ymin = mccPSD_sample_ymin; +MCNUM ymax = mccPSD_sample_ymax; +char* controlfile = mccPSD_sample_controlfile; +int dumpCount = mccPSD_sample_dumpCount; +#line 79 "MKMonitor.comp" +{ + PROP_Z0; + if (x>xmin && xymin && y 0 && currentCount > dumpCount){ + dumpTotal(controlfile,(long)Nsum); + currentCount = 0; + } + SCATTER; + } +} +#line 7655 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef currentCount +#undef p2sum +#undef psum +#undef Nsum +#undef mccompcurname +#undef mccompcurindex +#undef p +#undef s2 +#undef s1 +#undef t +#undef vz +#undef vy +#undef vx +#undef z +#undef y +#undef x + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + /* Component sa_arm. */ + strcpy(mcsig_message, "sa_arm (Trace)"); + mcDEBUG_COMP("sa_arm") + mccoordschange(mcposrsa_arm, mcrotrsa_arm, + &mcnlx, &mcnly, &mcnlz, + &mcnlvx, &mcnlvy, &mcnlvz, + &mcnlt, &mcnlsx, &mcnlsy); + mccoordschange_polarisation(mcrotrsa_arm, &mcnlsx, &mcnlsy, &mcnlsz); + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + STORE_NEUTRON(5,mcnlx, mcnly, mcnlz, mcnlvx,mcnlvy,mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlsz, mcnlp); + mcScattered=0; +#define mccompcurname sa_arm +#define mccompcurindex 5 +#undef mccompcurname +#undef mccompcurindex + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + /* Component sample. */ + strcpy(mcsig_message, "sample (Trace)"); + mcDEBUG_COMP("sample") + mccoordschange(mcposrsample, mcrotrsample, + &mcnlx, &mcnly, &mcnlz, + &mcnlvx, &mcnlvy, &mcnlvz, + &mcnlt, &mcnlsx, &mcnlsy); + mccoordschange_polarisation(mcrotrsample, &mcnlsx, &mcnlsy, &mcnlsz); + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) +#define x mcnlx +#define y mcnly +#define z mcnlz +#define vx mcnlvx +#define vy mcnlvy +#define vz mcnlvz +#define t mcnlt +#define s1 mcnlsx +#define s2 mcnlsy +#define p mcnlp + STORE_NEUTRON(6,mcnlx, mcnly, mcnlz, mcnlvx,mcnlvy,mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlsz, mcnlp); + mcScattered=0; +#define mccompcurname sample +#define mccompcurindex 6 +#define reflections mccsample_reflections +#define my_s_v2 mccsample_my_s_v2 +#define my_a_v mccsample_my_a_v +#define q_v mccsample_q_v +{ /* Declarations of SETTING parameters. */ +MCNUM d_phi0 = mccsample_d_phi0; +MCNUM radius = mccsample_radius; +MCNUM focus_r = mccsample_focus_r; +MCNUM h = mccsample_h; +MCNUM pack = mccsample_pack; +MCNUM Vc = mccsample_Vc; +MCNUM sigma_a = mccsample_sigma_a; +MCNUM sigma_inc = mccsample_sigma_inc; +MCNUM frac = mccsample_frac; +MCNUM focus_xw = mccsample_focus_xw; +MCNUM focus_yh = mccsample_focus_yh; +MCNUM focus_aw = mccsample_focus_aw; +MCNUM focus_ah = mccsample_focus_ah; +MCNUM target_x = mccsample_target_x; +MCNUM target_y = mccsample_target_y; +MCNUM target_z = mccsample_target_z; +int target_index = mccsample_target_index; +#line 172 "PowderN.comp" +{ + double t0, t1, v, v1,l_full, l, l_1, dt, d_phi, theta, my_s, my_s_n; + double aim_x, aim_y, aim_z, axis_x, axis_y, axis_z; + double arg, tmp_vx, tmp_vy, tmp_vz, p_in, vout_x, vout_y, vout_z; + int line; + + if(cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, h)) + { + if(t0 < 0) + ABSORB; + /* Neutron enters at t=t0. */ + v = sqrt(vx*vx + vy*vy + vz*vz); + l_full = v * (t1 - t0); /* Length of full path through sample */ + dt = rand01()*(t1 - t0); /* Time of scattering */ + PROP_DT(dt+t0); /* Point of scattering */ + l = v*dt; /* Penetration in sample */ + if (target_index){ + Coords ToTarget; + ToTarget = coords_sub(POS_A_COMP_INDEX(INDEX_CURRENT_COMP+target_index),POS_A_CURRENT_COMP); + ToTarget = rot_apply(ROT_A_CURRENT_COMP, ToTarget); + coords_get(ToTarget, &target_x, &target_y, &target_z); + } + aim_x = target_x-x; /* Vector pointing at target (anal./det.) */ + aim_y = target_y-y; + aim_z = target_z-z; + my_s = my_s_v2_sum/(v*v)+my_inc; + /* Total attenuation from scattering */ + + if (rand01() >= frac) + { /* Make coherent scattering event */ + /* Choose point on Debye-Scherrer cone */ + if (d_phi>0) + { + d_phi = d_phi0*DEG2RAD/2.0*randpm1(); + p *= d_phi0/360.0; + } + else + d_phi = 180*DEG2RAD*randpm1(); + line=floor(Nq*rand01()); /* Select between Nq powder lines */ + arg = (q_v[line]+w_v[line]*randnorm())/(2.0*v); + my_s_n = my_s_v2[line]/(v*v); + if(arg > 1) + ABSORB; /* No bragg scattering possible*/ + theta = asin(arg); /* Bragg scattering law */ + + vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, aim_x, aim_y, aim_z); + rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2*theta, axis_x, axis_y, axis_z); + rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + vx = vout_x; + vy = vout_y; + vz = vout_z; + + if(!cylinder_intersect(&t0, &t1, x, y, z, + vx, vy, vz, radius, h)) + { + /* Strange error: did not hit cylinder */ + printf("FATAL ERROR: Did not hit cylinder from inside.\n"); + exit(1); + } + l_1 = v*t1; + + p *= Nq*l_full*my_s_n*exp(-(my_a_v/v+my_s)*(l+l_1))/(1-frac); + /* printf("Powder p: %g , exp: %g\n",p,exp(-(my_a_v/v+my_s)*(l+l_1)));*/ + } /* Coherent scattering event */ + else + { /* Make incoherent scattering event */ + v = sqrt(vx*vx+vy*vy+vz*vz); + if(focus_aw && focus_ah) { + randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, + aim_x, aim_y, aim_z, focus_aw*DEG2RAD, focus_ah*DEG2RAD, ROT_A_CURRENT_COMP); + } else if(focus_xw && focus_yh) { + randvec_target_rect(&vx, &vy, &vz, &solid_angle, + aim_x, aim_y, aim_z, focus_xw, focus_yh, ROT_A_CURRENT_COMP); + } else { + randvec_target_sphere(&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); + } + v1 = sqrt(vx*vx+vy*vy+vz*vz); + vx *= v/v1; + vy *= v/v1; + vz *= v/v1; + if(!cylinder_intersect(&t0, &t1, x, y, z, + vx, vy, vz, radius, h)) + { + /* Strange error: did not hit cylinder */ + printf("FATAL ERROR: Did not hit cylinder from inside.\n"); + exit(1); + } + l_1 = v*t1; + + p_in=p; + p *= l_full*my_inc*exp(-(my_a_v/v+my_s)*(l+l_1))/(frac); + p *= solid_angle/(4*PI); + /* printf("Incoherent p_in: %g arg: %g l_1: %g t0: %g t1: %g p: %g \n", + p_in,(my_a_v/v+my_s)*(l+l_1),l_1,t0,t1,p); */ + } /* Incoherent scattering event */ + } + else + ABSORB; +} +#line 7837 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef q_v +#undef my_a_v +#undef my_s_v2 +#undef reflections +#undef mccompcurname +#undef mccompcurindex +#undef p +#undef s2 +#undef s1 +#undef t +#undef vz +#undef vy +#undef vx +#undef z +#undef y +#undef x + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + /* Component Det9. */ + strcpy(mcsig_message, "Det9 (Trace)"); + mcDEBUG_COMP("Det9") + mccoordschange(mcposrDet9, mcrotrDet9, + &mcnlx, &mcnly, &mcnlz, + &mcnlvx, &mcnlvy, &mcnlvz, + &mcnlt, &mcnlsx, &mcnlsy); + mccoordschange_polarisation(mcrotrDet9, &mcnlsx, &mcnlsy, &mcnlsz); + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) +#define x mcnlx +#define y mcnly +#define z mcnlz +#define vx mcnlvx +#define vy mcnlvy +#define vz mcnlvz +#define t mcnlt +#define s1 mcnlsx +#define s2 mcnlsy +#define p mcnlp +#define sx mcnlsx +#define sy mcnlsy +#define sz mcnlsz + STORE_NEUTRON(7,mcnlx, mcnly, mcnlz, mcnlvx,mcnlvy,mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlsz, mcnlp); + mcScattered=0; +#define mccompcurname Det9 +#define mccompcurindex 7 +#define options mccDet9_options +#define filename mccDet9_filename +#define DEFS mccDet9_DEFS +#define Vars mccDet9_Vars +{ /* Declarations of SETTING parameters. */ +MCNUM xwidth = mccDet9_xwidth; +MCNUM yheight = mccDet9_yheight; +MCNUM zthick = mccDet9_zthick; +MCNUM xmin = mccDet9_xmin; +MCNUM xmax = mccDet9_xmax; +MCNUM ymin = mccDet9_ymin; +MCNUM ymax = mccDet9_ymax; +MCNUM zmin = mccDet9_zmin; +MCNUM zmax = mccDet9_zmax; +#line 235 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" +{ + double XY=0; + double t0 = 0; + double t1 = 0; + double pp; + int intersect = 0; + char Flag_Restore = 0; + + if (abs(Vars.Flag_Shape) == DEFS.SHAPE_SQUARE) /* square xy */ + { + PROP_Z0; + intersect = (x>=Vars.mxmin && x<=Vars.mxmax && y>=Vars.mymin && y<=Vars.mymax); + } + else if (abs(Vars.Flag_Shape) == DEFS.SHAPE_DISK) /* disk xy */ + { + PROP_Z0; + intersect = ((x*x + y*y) <= Vars.Sphere_Radius*Vars.Sphere_Radius); + } + else if (abs(Vars.Flag_Shape) == DEFS.SHAPE_SPHERE) /* sphere */ + { + intersect = sphere_intersect(&t0, &t1, x, y, z, vx, vy, vz, Vars.Sphere_Radius); + /* intersect = (intersect && t0 > 0); */ + } + else if ((abs(Vars.Flag_Shape) == DEFS.SHAPE_CYLIND) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_BANANA)) /* cylinder */ + { + intersect = cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, Vars.Sphere_Radius, Vars.Cylinder_Height); + if ((abs(Vars.Flag_Shape) == DEFS.SHAPE_BANANA) && (intersect != 1)) intersect = 0; /* remove top/bottom for banana */ + } + else if (abs(Vars.Flag_Shape) == DEFS.SHAPE_BOX) /* box */ + { + intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, fabs(Vars.mxmax-Vars.mxmin), fabs(Vars.mymax-Vars.mymin), fabs(Vars.mzmax-Vars.mzmin)); + } + + if (intersect) + { + if ((abs(Vars.Flag_Shape) == DEFS.SHAPE_SPHERE) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_CYLIND) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_BOX) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_BANANA)) + { + if (t0 < 0 && t1 > 0) + t0 = t; /* neutron was already inside ! */ + if (t1 < 0 && t0 > 0) /* neutron exit before entering !! */ + t1 = t; + /* t0 is now time of incoming intersection with the sphere. */ + if ((Vars.Flag_Shape < 0) && (t1 > 0)) + PROP_DT(t1); /* t1 outgoing beam */ + else + PROP_DT(t0); /* t0 incoming beam */ + } + + /* Now get the data to monitor: current or keep from PreMonitor */ + if (Vars.Flag_UsePreMonitor != 1) + { + Vars.cp = p; + Vars.cx = x; + Vars.cvx = vx; + Vars.csx = sx; + Vars.cy = y; + Vars.cvy = vy; + Vars.csy = sy; + Vars.cz = z; + Vars.cvz = vz; + Vars.csz = sz; + Vars.ct = t; + } + + if ((Vars.He3_pressure > 0) && (t1 != t0) && ((abs(Vars.Flag_Shape) == DEFS.SHAPE_SPHERE) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_CYLIND) || (abs(Vars.Flag_Shape) == DEFS.SHAPE_BOX))) + { + XY = exp(-7.417*Vars.He3_pressure*fabs(t1-t0)*2*PI*K2V); + /* will monitor the absorbed part */ + Vars.cp *= 1-XY; + /* and modify the neutron weight after monitor, only remains 1-p_detect */ + p *= XY; + } + + if (Vars.Flag_per_cm2 && Vars.area != 0) Vars.cp /= Vars.area; + if (Vars.Flag_capture) + { + XY = sqrt(Vars.cvx*Vars.cvx+Vars.cvy*Vars.cvy+Vars.cvz*Vars.cvz); + XY *= V2K; + if (XY != 0) XY = 2*PI/XY; /* lambda. lambda(2200 m/2) = 1.7985 Angs */ + Vars.cp *= XY/1.7985; + } + + pp = Monitor_nD_Trace(&DEFS, &Vars); + Vars.Nsum++; + Vars.psum += pp; + Vars.p2sum += pp*pp; + SCATTER; + + /* now handles intermediate results saving */ + if ((Vars.Intermediate > 0) && (mcget_run_num() > Vars.IntermediateCnts)) + { + Vars.IntermediateCnts += Vars.Intermediate*mcget_ncount(); + /* save results for all monitors in the simulation */ + mcsave(NULL); + } + if (Vars.Flag_parallel) /* back to neutron state before detection */ + Flag_Restore = 1; + } /* end if intersection */ + else { + if (Vars.Flag_Absorb && !Vars.Flag_parallel) ABSORB; + else Flag_Restore = 1; /* no intersection, back to previous state */ + } + + if (Flag_Restore) + { + RESTORE_NEUTRON(mccompcurindex, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } +} +#line 8006 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Vars +#undef DEFS +#undef filename +#undef options +#undef mccompcurname +#undef mccompcurindex +#undef sz +#undef sy +#undef sx +#undef p +#undef s2 +#undef s1 +#undef t +#undef vz +#undef vy +#undef vx +#undef z +#undef y +#undef x + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + + mcabsorbAll: + mcDEBUG_LEAVE() + mcDEBUG_STATE(mcnlx, mcnly, mcnlz, mcnlvx, mcnlvy, mcnlvz,mcnlt,mcnlsx,mcnlsy, mcnlp) + /* Copy neutron state to global variables. */ + mcnx = mcnlx; + mcny = mcnly; + mcnz = mcnlz; + mcnvx = mcnlvx; + mcnvy = mcnlvy; + mcnvz = mcnlvz; + mcnt = mcnlt; + mcnsx = mcnlsx; + mcnsy = mcnlsy; + mcnsz = mcnlsz; + mcnp = mcnlp; +} + +void mcsave(FILE *handle) { + if (!handle) mcsiminfo_init(NULL); + /* User component SAVE code. */ + + /* User SAVE code for component 'PSD_sample'. */ + strcpy(mcsig_message, "PSD_sample (Save)"); +#define mccompcurname PSD_sample +#define mccompcurindex 4 +#define Nsum mccPSD_sample_Nsum +#define psum mccPSD_sample_psum +#define p2sum mccPSD_sample_p2sum +#define currentCount mccPSD_sample_currentCount +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccPSD_sample_xmin; +MCNUM xmax = mccPSD_sample_xmax; +MCNUM ymin = mccPSD_sample_ymin; +MCNUM ymax = mccPSD_sample_ymax; +char* controlfile = mccPSD_sample_controlfile; +int dumpCount = mccPSD_sample_dumpCount; +#line 95 "MKMonitor.comp" +{ + DETECTOR_OUT_0D("Single monitor", Nsum, psum, p2sum); +} +#line 8069 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef currentCount +#undef p2sum +#undef psum +#undef Nsum +#undef mccompcurname +#undef mccompcurindex + + /* User SAVE code for component 'Det9'. */ + strcpy(mcsig_message, "Det9 (Save)"); +#define mccompcurname Det9 +#define mccompcurindex 7 +#define options mccDet9_options +#define filename mccDet9_filename +#define DEFS mccDet9_DEFS +#define Vars mccDet9_Vars +{ /* Declarations of SETTING parameters. */ +MCNUM xwidth = mccDet9_xwidth; +MCNUM yheight = mccDet9_yheight; +MCNUM zthick = mccDet9_zthick; +MCNUM xmin = mccDet9_xmin; +MCNUM xmax = mccDet9_xmax; +MCNUM ymin = mccDet9_ymin; +MCNUM ymax = mccDet9_ymax; +MCNUM zmin = mccDet9_zmin; +MCNUM zmax = mccDet9_zmax; +#line 345 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" +{ + /* save results, but do not free pointers */ + Monitor_nD_Save(&DEFS, &Vars); +} +#line 8101 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Vars +#undef DEFS +#undef filename +#undef options +#undef mccompcurname +#undef mccompcurindex + + if (!handle) mcsiminfo_close(); +} +void mcfinally(void) { + /* User component FINALLY code. */ + mcsiminfo_init(NULL); + mcsave(mcsiminfo_file); /* save data when simulation ends */ + + /* User FINALLY code for component 'in'. */ + strcpy(mcsig_message, "in (Finally)"); +#define mccompcurname in +#define mccompcurindex 2 +#define file mccin_file +#define type mccin_type +#define rep mccin_rep +#define pos mccin_pos +#define nrows mccin_nrows +#define nread mccin_nread +#define Offset mccin_Offset +#define rTable mccin_rTable +#define Virtual_input_Read_Input mccin_Virtual_input_Read_Input +{ /* Declarations of SETTING parameters. */ +MCNUM repeat_count = mccin_repeat_count; +MCNUM bufsize = mccin_bufsize; +#line 154 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/sources/Virtual_input.comp" +{ + Table_Free(&rTable); +} +#line 8137 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Virtual_input_Read_Input +#undef rTable +#undef Offset +#undef nread +#undef nrows +#undef pos +#undef rep +#undef type +#undef file +#undef mccompcurname +#undef mccompcurindex + + /* User FINALLY code for component 'Det9'. */ + strcpy(mcsig_message, "Det9 (Finally)"); +#define mccompcurname Det9 +#define mccompcurindex 7 +#define options mccDet9_options +#define filename mccDet9_filename +#define DEFS mccDet9_DEFS +#define Vars mccDet9_Vars +{ /* Declarations of SETTING parameters. */ +MCNUM xwidth = mccDet9_xwidth; +MCNUM yheight = mccDet9_yheight; +MCNUM zthick = mccDet9_zthick; +MCNUM xmin = mccDet9_xmin; +MCNUM xmax = mccDet9_xmax; +MCNUM ymin = mccDet9_ymin; +MCNUM ymax = mccDet9_ymax; +MCNUM zmin = mccDet9_zmin; +MCNUM zmax = mccDet9_zmax; +#line 351 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" +{ + /* free pointers */ + Monitor_nD_Finally(&DEFS, &Vars); +} +#line 8174 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Vars +#undef DEFS +#undef filename +#undef options +#undef mccompcurname +#undef mccompcurindex + + mcsiminfo_close(); +} +#define magnify mcdis_magnify +#define line mcdis_line +#define multiline mcdis_multiline +#define circle mcdis_circle +void mcdisplay(void) { + printf("MCDISPLAY: start\n"); + /* Component MCDISPLAY code. */ + + /* MCDISPLAY code for component 'msa'. */ + strcpy(mcsig_message, "msa (McDisplay)"); + printf("MCDISPLAY: component %s\n", "msa"); +#define mccompcurname msa +#define mccompcurindex 1 +#line 42 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/optics/Arm.comp" +{ + /* A bit ugly; hard-coded dimensions. */ + magnify(""); + line(0,0,0,0.2,0,0); + line(0,0,0,0,0.2,0); + line(0,0,0,0,0,0.2); +} +#line 8206 "dmcafter.c" +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'in'. */ + strcpy(mcsig_message, "in (McDisplay)"); + printf("MCDISPLAY: component %s\n", "in"); +#define mccompcurname in +#define mccompcurindex 2 +#define file mccin_file +#define type mccin_type +#define rep mccin_rep +#define pos mccin_pos +#define nrows mccin_nrows +#define nread mccin_nread +#define Offset mccin_Offset +#define rTable mccin_rTable +#define Virtual_input_Read_Input mccin_Virtual_input_Read_Input +{ /* Declarations of SETTING parameters. */ +MCNUM repeat_count = mccin_repeat_count; +MCNUM bufsize = mccin_bufsize; +#line 159 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/sources/Virtual_input.comp" +{ + /* A bit ugly; hard-coded dimensions. */ + magnify(""); + line(0,0,0,0.1,0,0); + line(0,0,0,0,0.1,0); + line(0,0,0,0,0,0.1); +} +#line 8235 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Virtual_input_Read_Input +#undef rTable +#undef Offset +#undef nread +#undef nrows +#undef pos +#undef rep +#undef type +#undef file +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'out2_slit'. */ + strcpy(mcsig_message, "out2_slit (McDisplay)"); + printf("MCDISPLAY: component %s\n", "out2_slit"); +#define mccompcurname out2_slit +#define mccompcurindex 3 +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccout2_slit_xmin; +MCNUM xmax = mccout2_slit_xmax; +MCNUM ymin = mccout2_slit_ymin; +MCNUM ymax = mccout2_slit_ymax; +MCNUM radius = mccout2_slit_radius; +#line 63 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/optics/Slit.comp" +{ + double xw, yh; + magnify("xy"); + xw = (xmax - xmin)/2.0; + yh = (ymax - ymin)/2.0; + multiline(3, xmin-xw, (double)ymax, 0.0, + (double)xmin, (double)ymax, 0.0, + (double)xmin, ymax+yh, 0.0); + multiline(3, xmax+xw, (double)ymax, 0.0, + (double)xmax, (double)ymax, 0.0, + (double)xmax, ymax+yh, 0.0); + multiline(3, xmin-xw, (double)ymin, 0.0, + (double)xmin, (double)ymin, 0.0, + (double)xmin, ymin-yh, 0.0); + multiline(3, xmax+xw, (double)ymin, 0.0, + (double)xmax, (double)ymin, 0.0, + (double)xmax, ymin-yh, 0.0); +} +#line 8279 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'PSD_sample'. */ + strcpy(mcsig_message, "PSD_sample (McDisplay)"); + printf("MCDISPLAY: component %s\n", "PSD_sample"); +#define mccompcurname PSD_sample +#define mccompcurindex 4 +#define Nsum mccPSD_sample_Nsum +#define psum mccPSD_sample_psum +#define p2sum mccPSD_sample_p2sum +#define currentCount mccPSD_sample_currentCount +{ /* Declarations of SETTING parameters. */ +MCNUM xmin = mccPSD_sample_xmin; +MCNUM xmax = mccPSD_sample_xmax; +MCNUM ymin = mccPSD_sample_ymin; +MCNUM ymax = mccPSD_sample_ymax; +char* controlfile = mccPSD_sample_controlfile; +int dumpCount = mccPSD_sample_dumpCount; +#line 100 "MKMonitor.comp" +{ + magnify("xy"); + multiline(5, (double)xmin, (double)ymin, 0.0, + (double)xmax, (double)ymin, 0.0, + (double)xmax, (double)ymax, 0.0, + (double)xmin, (double)ymax, 0.0, + (double)xmin, (double)ymin, 0.0); +} +#line 8309 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef currentCount +#undef p2sum +#undef psum +#undef Nsum +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'sa_arm'. */ + strcpy(mcsig_message, "sa_arm (McDisplay)"); + printf("MCDISPLAY: component %s\n", "sa_arm"); +#define mccompcurname sa_arm +#define mccompcurindex 5 +#line 42 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/optics/Arm.comp" +{ + /* A bit ugly; hard-coded dimensions. */ + magnify(""); + line(0,0,0,0.2,0,0); + line(0,0,0,0,0.2,0); + line(0,0,0,0,0,0.2); +} +#line 8331 "dmcafter.c" +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'sample'. */ + strcpy(mcsig_message, "sample (McDisplay)"); + printf("MCDISPLAY: component %s\n", "sample"); +#define mccompcurname sample +#define mccompcurindex 6 +#define reflections mccsample_reflections +#define my_s_v2 mccsample_my_s_v2 +#define my_a_v mccsample_my_a_v +#define q_v mccsample_q_v +{ /* Declarations of SETTING parameters. */ +MCNUM d_phi0 = mccsample_d_phi0; +MCNUM radius = mccsample_radius; +MCNUM focus_r = mccsample_focus_r; +MCNUM h = mccsample_h; +MCNUM pack = mccsample_pack; +MCNUM Vc = mccsample_Vc; +MCNUM sigma_a = mccsample_sigma_a; +MCNUM sigma_inc = mccsample_sigma_inc; +MCNUM frac = mccsample_frac; +MCNUM focus_xw = mccsample_focus_xw; +MCNUM focus_yh = mccsample_focus_yh; +MCNUM focus_aw = mccsample_focus_aw; +MCNUM focus_ah = mccsample_focus_ah; +MCNUM target_x = mccsample_target_x; +MCNUM target_y = mccsample_target_y; +MCNUM target_z = mccsample_target_z; +int target_index = mccsample_target_index; +#line 273 "PowderN.comp" +{ + magnify("xyz"); + circle("xz", 0, h/2.0, 0, radius); + circle("xz", 0, -h/2.0, 0, radius); + line(-radius, -h/2.0, 0, -radius, +h/2.0, 0); + line(+radius, -h/2.0, 0, +radius, +h/2.0, 0); + line(0, -h/2.0, -radius, 0, +h/2.0, -radius); + line(0, -h/2.0, +radius, 0, +h/2.0, +radius); +} +#line 8372 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef q_v +#undef my_a_v +#undef my_s_v2 +#undef reflections +#undef mccompcurname +#undef mccompcurindex + + /* MCDISPLAY code for component 'Det9'. */ + strcpy(mcsig_message, "Det9 (McDisplay)"); + printf("MCDISPLAY: component %s\n", "Det9"); +#define mccompcurname Det9 +#define mccompcurindex 7 +#define options mccDet9_options +#define filename mccDet9_filename +#define DEFS mccDet9_DEFS +#define Vars mccDet9_Vars +{ /* Declarations of SETTING parameters. */ +MCNUM xwidth = mccDet9_xwidth; +MCNUM yheight = mccDet9_yheight; +MCNUM zthick = mccDet9_zthick; +MCNUM xmin = mccDet9_xmin; +MCNUM xmax = mccDet9_xmax; +MCNUM ymin = mccDet9_ymin; +MCNUM ymax = mccDet9_ymax; +MCNUM zmin = mccDet9_zmin; +MCNUM zmax = mccDet9_zmax; +#line 357 "/afs/psi.ch/project/sinq/sl-linux/lib/mcstas/monitors/Monitor_nD.comp" +{ + Monitor_nD_McDisplay(&DEFS, &Vars); +} +#line 8404 "dmcafter.c" +} /* End of SETTING parameter declarations. */ +#undef Vars +#undef DEFS +#undef filename +#undef options +#undef mccompcurname +#undef mccompcurindex + + printf("MCDISPLAY: end\n"); +} +#undef magnify +#undef line +#undef multiline +#undef circle diff --git a/mcstas/dmc/nxdmc.tcl b/mcstas/dmc/nxdmc.tcl index 272fa0a9..2453deeb 100644 --- a/mcstas/dmc/nxdmc.tcl +++ b/mcstas/dmc/nxdmc.tcl @@ -4,6 +4,7 @@ # This is the scripted version using nxscript # # Mark Koennecke, May 2004 +# This is a special version for virtual DMC on lns00 #--------------------------------------------------------------------------- proc storeMonochromator {} { @@ -75,14 +76,34 @@ proc makeLinks {} { nxscript makelink dana dtnstep nxscript makelink dana mlambda } +#------------------------------------------------------------------------ +proc makeSimFileName args { + global datahome + sicsdatanumber incr + set num [SplitReply [sicsdatanumber]] + return [makeSimForNum $num] +} +#------------------------------------------------------------------------ +proc makeSimForNum {num} { + global datahome + set pre [string trim [SplitReply [sicsdataprefix]]] + set po [string trim [SplitReply [sicsdatapostfix]]] + return [format "%s/%s2006n%6.6d%s" $datahome $pre $num $po] +} #------------------------------------------------------------------------- # store DMC data #------------------------------------------------------------------------- proc storedata {} { - global home - set fil [newFileName] + global home wwwMode + + if {$wwwMode == 1} { + set fil [makeSimFileName] + } else { + set fil [newFileName] + } + lastdatafile $fil clientput "Opening $fil for writing" - nxscript create4 $fil $home/dmc.dic + nxscript createxml $fil $home/dmc.dic writeStandardAttributes $fil writeTextVar etitle title diff --git a/mcstas/dmc/vdmc.tcl b/mcstas/dmc/vdmc.tcl index dd96b67f..8eebf1cb 100644 --- a/mcstas/dmc/vdmc.tcl +++ b/mcstas/dmc/vdmc.tcl @@ -1,13 +1,19 @@ - # -------------------------------------------------------------------------- +#-------------------------------------------------------------------------- # Initialization script for a virtual DMC instrument using a McStas # simulationas a data source # # Dr. Mark Koennecke, June 2005 #--------------------------------------------------------------------------- # O P T I O N S +# wwwMode = 1 when running for the WWW-VDMC application +set wwwMode 0 -set home $env(HOME)/src/workspace/sics/mcstas/dmc - +if {$wwwMode == 1} { + set home /home/lnswww/vinstrument/mcstas/dmc + set datahome /home/lnswww/www/vinstrument +} else { + set home $env(HOME)/psi/workspace/sics/mcstas/dmc +} #--------------------------------- first all the server options are set #ServerOption RedirectFile $home/stdcdmc ServerOption ReadTimeOut 10 @@ -120,18 +126,20 @@ SicsDataPrefix vdmc #--------- make data number MakeDataNumber SicsDataNumber $home/DataNumber VarMake SicsDataPostFix Text Internal -SicsDataPostFix ".hdf" +SicsDataPostFix ".xml" VarMake Adress Text User VarMake phone Text User VarMake fax Text User VarMake email Text User VarMake sample_mur Float User +VarMake lastdatafile Text User #-------------------------------------------------------------------------- # P R O C E D U R E S #-------------------------------------------------------------------------- MakeDrive MakeBatchManager MakeNXScript +MakeRuenBuffer #-------------------- initialize scripted commands source $home/vdmccom.tcl #-------------------- configure commandlog @@ -139,7 +147,6 @@ commandlog auto commandlog intervall 5 #----------- enable sycamore -#InstallProtocolHandler #InstallSinfox #source sycFormat.tcl #source /usr/lib/tcllib1.6.1/stooop/stooop.tcl @@ -147,3 +154,95 @@ commandlog intervall 5 #source sinfo.tcl #source sycamore.tcl #Publish sinfo Spy + +#==================== install Hipadaba +proc hdbReadOnly {} { + error "Parameter is READ ONLY" +} +#------------------------------------ +proc maketwotheta {} { + set txt [TwoThetaD] + set l [split $txt =] + set start [string trim [lindex $l 1]] + for {set i 0} {$i < 400} {incr i } { + append result [expr $start + $i * .2] " " + } + return $result +} +#------------------------------------- +InstallProtocolHandler +InstallHdb +MakeStateMon +hmake /dmc spy none +hsetprop /dmc type instrument +#-------- experiment +hmake /dmc/experiment spy none +hattach /dmc/experiment title title +hattach /dmc/experiment user user +hattach /dmc/experiment starttime starttime +hattach /dmc/experiment user user +hattach /dmc/experiment/user adress address +hattach /dmc/experiment/user phone phone +hattach /dmc/experiment/user email email +hattach /dmc/experiment comment1 comment1 +hattach /dmc/experiment comment2 comment2 +hattach /dmc/experiment comment3 comment3 +#------- SINQ +hmake /dmc/sinq spy none +hmakescript /dmc/sinq/proton_monitor "counter getmonitor 4" hdbReadOnly int +sicspoll /dmc/sinq/proton_monitor hdb 10 +#-------- monochromator +hmake /dmc/monochromator spy none +hattach /dmc/monochromator lambda wavelength +hattach /dmc/monochromator OmegaM theta +hattach /dmc/monochromator TwoThetaM two_theta +hattach /dmc/monochromator MonoX x_translation +hattach /dmc/monochromator MonoY y_translation +hattach /dmc/monochromator MonoChi chi +hattach /dmc/monochromator MonoPhi phi +hattach /dmc/monochromator CurveM vertical_focusing +hmakescript /dmc/monochromator/d_value "mono dd" "mono dd" float +hsetprop /dmc/monochromator/d_value priv manager +hmakescript /dmc/monochromator/scattering_sense "mono ss" "mono ss" int +hsetprop /dmc/monochromator/scattering_sense priv manager + +#----------- sample +hmake /dmc/sample spy none +hmakescript /dmc/sample/name sample sample Text +hattach /dmc/sample Table rotation +hmakescript /dmc/sample/monitor "counter getmonitor 1" hdbReadOnly int +hsetprop /dmc/sample/monitor priv internal +#---------- detector +hmake /dmc/detector spy none +hattach /dmc/detector TwoThetaD two_theta +hmakescript /dmc/detector/preset "counter getpreset" hdbReadOnly float +hsetprop /dmc/detector/preset priv internal +hmakescript /dmc/detector/countmode "counter getmode" hdbReadOnly text +hsetprop /dmc/detector/countmode priv internal +sicspoll add /dmc/detector/preset hdb 30 +sicspoll add /dmc/detector/countmode hdb 30 +#------------ commands +hmake /commands spy none +hcommand /commands/count count +hsetprop /commands/count type command +hmake /commands/count/mode user text +hmake /commands/count/preset user float +hset /commands/count/preset 5 +hset /commands/count/mode timer +#---------------- graphics +hmake /Graphics spy none +hmake /Graphics/powder_diagram spy none +hsetprop /Graphics/powder_diagram type graphdata +hsetprop /Graphics/powder_diagram viewer default +hmake /Graphics/powder_diagram/rank internal int +hset /Graphics/powder_diagram/rank 1 +hmake /Graphics/powder_diagram/dim internal intar 1 +hset /Graphics/powder_diagram/dim 400 +hmakescript /Graphics/powder_diagram/two_theta maketwotheta hdbReadOnly floatar 400 +sicspoll add /Graphics/powder_diagram/two_theta hdb 30 +hsetprop /Graphics/powder_diagram/two_theta type axis +hsetprop /Graphics/powder_diagram/two_theta dim 0 +hattach /Graphics/powder_diagram banana counts +hsetprop /Graphics/powder_diagram/counts type data +hsetprop /Graphics/powder_diagram/counts priv internal +sicspoll add /Graphics/powder_diagram/counts hdb 60 diff --git a/mcstas/dmc/vdmccom.tcl b/mcstas/dmc/vdmccom.tcl index 4500cfa0..a78a78f1 100644 --- a/mcstas/dmc/vdmccom.tcl +++ b/mcstas/dmc/vdmccom.tcl @@ -15,7 +15,9 @@ if { [info exists vdmcinit] == 0 } { Publish copydmcdata User Publish sample User Publish wwwsics Spy + Publish wwwfilefornumber Spy mcinstall + Publish gethm Spy } source $home/log.tcl source $home/nxsupport.tcl @@ -38,12 +40,19 @@ proc washlazy {name} { if { [string first "H K L THETA 2THETA D VALUE" $line] > 0} { break } +#-------- A second version to treat the messed up lazy pulverix files +# uploaded through the WWW-interface + if { [string first "H K L THETA" $line] >= 0} { + break + } } #------- process data lines puts $out "// mult Q(hkl) F2 DW w" + clientput "HKL found at: $line" while { [gets $in line] >= 0} { set num [scan $line "%d %d %d %f %f %f %f %f %d %d %d %f %f %f %f %f %d"\ h k l th th2 d di sin h2 k2 l2 I F A B ang mul] + clientput "Line = $num, $line" if { $num == 17} { set q [expr (2.*3.14159265358979323846)/$d] set f2 [expr $F * $F] @@ -155,6 +164,7 @@ proc rundmcoptsim {mode preset } { } else { return $msg } + wait 5 } #------------------------------------------------------------------------ proc copydmcdataold { } { @@ -363,7 +373,7 @@ proc wwwpar {type mot} { } #------------- wwwuser formats user information into a html table proc wwwuser {} { - lappend list title sample user email phone adress + lappend list title user email phone adress append txt "" foreach e $list { set ret [catch {$e} msg] @@ -376,6 +386,14 @@ proc wwwuser {} { } return $txt } - +#------------- wwwfilefornumber returns the path to a data file for a +# number +proc wwwfilefornumber {num} { + return [makeSimForNum $num] +} +#------------------------------------------------------------------- +proc gethm {} { + banana uuget 0 +} diff --git a/mesure.c b/mesure.c index 851e5b17..7b436743 100644 --- a/mesure.c +++ b/mesure.c @@ -33,6 +33,7 @@ #include "fourtable.h" #include "lld.h" #include "stdscan.h" +#include "exeman.h" extern void SNXFormatTime(char *pBueffel, int iLen); extern float nintf(float f); @@ -445,7 +446,9 @@ static int MesureCalculateSettings(pMesure self, float fHKL[3], float fSet[4], float fPsi, SConnection *pCon) { int status, np; - float step, tolerance; + float step, tolerance, fHard; + char *scanvar = NULL; + char buffer[256]; SetHKLScanTolerance(self->pCryst,.0); status = CalculateSettings(self->pCryst,fHKL,fPsi,0,fSet,pCon); @@ -460,7 +463,26 @@ static int MesureCalculateSettings(pMesure self, float fHKL[3], float fSet[4], np = getMesureNP(self,(double)fSet[0]); tolerance = (step * (float)np)/2. + .2; SetHKLScanTolerance(self->pCryst,tolerance); - return CalculateSettings(self->pCryst,fHKL,fPsi,0,fSet,pCon); + status = CalculateSettings(self->pCryst,fHKL,fPsi,0,fSet,pCon); + if(status != 1){ + return status; + } + scanvar = GetFourCircleScanVar(self->stepTable,fSet[0]); + if(scanvar != NULL && strcmp(scanvar,"om") != 0){ + tolerance *= 2.; + strcpy(buffer,"ERROR: 2theta limit problem:"); + if(!MotorCheckBoundary(self->p2Theta,fSet[0]-tolerance,&fHard, + buffer,256-strlen(buffer))){ + SCWrite(pCon,buffer,eWarning); + return 0; + } + if(!MotorCheckBoundary(self->p2Theta,fSet[0]+tolerance,&fHard, + buffer,256-strlen(buffer))){ + SCWrite(pCon,buffer,eWarning); + return 0; + } + } + return status; } /*--------------------------------------------------------------------------*/ int MesureReflection(pMesure self, float fHKL[3], float fPsi, @@ -972,7 +994,9 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) static float fMax = 10.; int iRet, i,ii, iLF, iNP; char pBueffel[512], pNum[10], pTime[132]; - pEVControl pEva = NULL; + pEVControl pEva = NULL; + pDummy pPtr = NULL; + pIDrivable pDriv = NULL; assert(self); assert(pCon); @@ -1058,7 +1082,20 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) fTemp = -777.77; pEva = (pEVControl)FindCommandData(pServ->pSics,"temperature", "Environment Controller"); - if(pEva) + if(pEva == NULL) + { + pPtr = (pDummy)FindCommandData(pServ->pSics,"temperature", + "RemObject"); + if(pPtr != NULL) + { + pDriv = pPtr->pDescriptor->GetInterface(pPtr,DRIVEID); + if(pDriv != NULL) + { + fTemp = pDriv->GetValue(pPtr,pCon); + } + } + } + else { iRet = EVCGetPos(pEva, pCon,&fTemp); } @@ -1120,6 +1157,19 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) } return 1; } + /*---------------------------------------------------------------------*/ + static FILE *openListFile(char *pName){ + FILE *fd = NULL; + pDynString filename = NULL; + filename = findBatchFile(pServ->pSics,pName); + if(filename != NULL){ + fd = fopen(GetCharArray(filename),"r"); + DeleteDynString(filename); + } else { + fd = fopen(pName,"r"); + } + return fd; + } /*------------------------------------------------------------------------*/ int MesureFile(pMesure self, char *pFile, int iSkip, SConnection *pCon) { @@ -1132,7 +1182,7 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) assert(pCon); /* well before doing a thing, open the list file */ - fd = fopen(pFile,"r"); + fd = openListFile(pFile); if(!fd) { sprintf(pBueffel,"ERROR: reflection file %s NOT found!",pFile); @@ -1221,7 +1271,7 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) assert(pCon); /* well before doing a thing, open the list file */ - fd = fopen(pFile,"r"); + fd = openListFile(pFile); if(!fd) { sprintf(pBueffel,"ERROR: reflection file %s NOT found!",pFile); @@ -1280,7 +1330,7 @@ static int ScanReflection(pMesure self, float twoTheta, SConnection *pCon) assert(pCon); /* well before doing a thing, open the list file */ - fd = fopen(pFile,"r"); + fd = openListFile(pFile); if(!fd) { sprintf(pBueffel,"ERROR: reflection file %s NOT found!",pFile); diff --git a/modriv.h b/modriv.h index 536243bd..2b7cd1b9 100644 --- a/modriv.h +++ b/modriv.h @@ -73,5 +73,6 @@ /* ----------------------- Simulation -----------------------------------*/ MotorDriver *CreateSIM(SConnection *pCon, int argc, char *argv[]); void KillSIM(void *pData); + MotorDriver *RGMakeMotorDriver(void); #endif diff --git a/moregress.c b/moregress.c new file mode 100644 index 00000000..de86e59b --- /dev/null +++ b/moregress.c @@ -0,0 +1,258 @@ +/** + * This is a regression testing motor driver for SICS. + * A parameter can be set which makes this driver cause + * various error conditions. This can then be used to + * verify and debug the working of upper level code + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, July 2007 + */ +#include +#include +#include + +/*===================== supported errors ======================*/ +#define NONE 0 +#define STARTFAIL 1 +#define BADPOS 2 /* positioning problem */ +#define FAIL 3 /* failure */ +#define OFFPOS 4 /* off pos by .2 */ +#define READFAIL 5 +#define RUN 6 /* keep running; for interrupt testing */ +/*=============================================================*/ +typedef struct __RGMoDriv{ + /* general motor driver interface + fields. REQUIRED! + */ + float fUpper; /* upper limit */ + float fLower; /* lower limit */ + char *name; + int (*GetPosition)(void *self, float *fPos); + int (*RunTo)(void *self,float fNewVal); + int (*GetStatus)(void *self); + void (*GetError)(void *self, int *iCode, char *buffer, int iBufLen); + int (*TryAndFixIt)(void *self, int iError,float fNew); + int (*Halt)(void *self); + int (*GetDriverPar)(void *self, char *name, + float *value); + int (*SetDriverPar)(void *self,SConnection *pCon, + char *name, float newValue); + void (*ListDriverPar)(void *self, char *motorName, + SConnection *pCon); + void (*KillPrivate)(void *self); + /* your drivers private fields follow below */ + float target; + int errorType; + int recover; + int counter; + } RGMotorDriver; + +/*================================================================ + GetPos returns OKOK on success, HWFault on failure +------------------------------------------------------------------*/ +static int RGGetPos(void *data, float *fPos){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + if(self->errorType == READFAIL){ + return HWFault; + } + if(self->errorType > 1 && self->errorType < 6){ + *fPos = self->target - .2; + } else { + *fPos = self->target; + } + return OKOK; +} +/*---------------------------------------------------------------- + RunTo starts the motor running. Returns OKOK on success, HWfault + on Errors +------------------------------------------------------------------*/ +static int RGRunTo(void *data, float newValue){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + self->target = newValue; + if(self->errorType == STARTFAIL){ + return HWFault; + } + return OKOK; +} +/*----------------------------------------------------------------- + CheckStatus queries the sattus of a running motor. Possible return + values can be: + HWBusy : motor still running + HWFault : motor error detected + HWPosFault : motor finished, but position not reached + HWIdle : motor finished OK + HWWarn : motor issued warning +--------------------------------------------------------------------*/ +static int RGCheckStatus(void *data){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + switch(self->errorType){ + case BADPOS: + return HWPosFault; + break; + case FAIL: + return HWFault; + break; + case RUN: + return HWBusy; + break; + } + return HWIdle; +} +/*------------------------------------------------------------------ + GetError gets more information about error which occurred + *iCode is an integer error code to be used in TryFixIt as indicator + buffer is a buffer for a text description of the problem + iBufLen is the length of buffer +--------------------------------------------------------------------*/ +static void RGGetError(void *data, int *iCode, char *buffer, + int iBufLen){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + *iCode = self->errorType; + switch(self->errorType){ + case NONE: + strncpy(buffer,"No error found",iBufLen); + break; + case BADPOS: + strncpy(buffer,"Position not reached",iBufLen); + break; + case FAIL: + strncpy(buffer,"Hardware is mad",iBufLen); + break; + case STARTFAIL: + strncpy(buffer,"Failed to start motor",iBufLen); + break; + case READFAIL: + strncpy(buffer,"Failed to read motor",iBufLen); + break; + + } +} +/*------------------------------------------------------------------ + TryAndFixIt tries everything which is possible in software to fix + a problem. iError is the error code from GetError, newValue is + the target value for the motor + Possible retrun values are: + MOTOK : everything fixed + MOTREDO : try again + MOTFAIL : cannot fix this +--------------------------------------------------------------------*/ +static int RGFixIt(void *data, int iError, float newValue){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + if(self->recover == 1){ + self->errorType = NONE; + return MOTREDO; + } + return MOTFAIL; +} +/*------------------------------------------------------------------- + Halt tries to stop the motor. Halt errors are ignored +---------------------------------------------------------------------*/ +static int RGHalt(void *data){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + self->errorType = NONE; + return 1; +} +/*-------------------------------------------------------------------- + GetDriverPar retrieves the value of a driver parameter. + Name is the name of the parameter, fValue the value when found. + Returns 0 on success, 0 else +-----------------------------------------------------------------------*/ +static int RGGetDriverPar(void *data, char *name, float *value){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + if(strcmp(name,"errortype") == 0){ + *value = (float)self->errorType; + return 1; + } else if (strcmp(name,"recover") == 0){ + *value = self->recover; + return 1; + } + + return 0; +} +/*---------------------------------------------------------------------- + SetDriverPar sets a driver parameter. Returns 0 on failure, 1 on + success. Name is the parameter name, pCon the connection to report + errors too, value the new value +------------------------------------------------------------------------*/ +static int RGSetDriverPar(void *data, SConnection *pCon, + char *name, float value){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; + if(strcmp(name,"errortype") == 0){ + self->errorType = (int)value; + return 1; + } else if (strcmp(name,"recover") == 0){ + self->recover = (int)value; + return 1; + } + return 0; +} +/*----------------------------------------------------------------------- + ListDriverPar lists the names and values of driver parameters to + pCon. Motorname is the name of the motor ro prefix to the listing. +-------------------------------------------------------------------------*/ +static void RGListDriverPar(void *data, char *motorname, + SConnection *pCon){ + RGMotorDriver *self = NULL; + char buffer[256]; + + self = (RGMotorDriver *)data; + snprintf(buffer,255,"%s errortype = %d", motorname, + self->errorType); + SCWrite(pCon,buffer,eValue); + + snprintf(buffer,255,"%s recover = %d", motorname, + self->recover); + SCWrite(pCon,buffer,eValue); +} +/*----------------------------------------------------------------------- + KillPrivate has the task to delete possibly dynamically allocated + memory in the private part of the driver structure +------------------------------------------------------------------------*/ +static void RGKillPrivate(void *data){ + RGMotorDriver *self = NULL; + + self = (RGMotorDriver *)data; +} +/*=======================================================================*/ +MotorDriver *RGMakeMotorDriver(void) { + RGMotorDriver *pNew = NULL; + + pNew = malloc(sizeof(RGMotorDriver)); + if(pNew == NULL){ + return NULL; + } + memset(pNew,0,sizeof(RGMotorDriver)); + + pNew->GetPosition = RGGetPos; + pNew->RunTo = RGRunTo; + pNew->GetStatus = RGCheckStatus; + pNew->GetError = RGGetError; + pNew->TryAndFixIt = RGFixIt; + pNew->Halt = RGHalt; + pNew->GetDriverPar = RGGetDriverPar; + pNew->SetDriverPar = RGSetDriverPar; + pNew->ListDriverPar = RGListDriverPar; + pNew->KillPrivate = RGKillPrivate; + pNew->fLower = -180.; + pNew->fUpper = 180.; + + return (MotorDriver *)pNew; +} + diff --git a/motor.c b/motor.c index e23181fc..5f20f8f5 100644 --- a/motor.c +++ b/motor.c @@ -76,13 +76,6 @@ #define IGNOREFAULT 10 #define MOVECOUNT 11 -/*------------------------------------------------------------------------ - a tiny structure used in CallBack work -*/ - typedef struct { - float fVal; - char *pName; - } MotCallback; /*-------------------------------------------------------------------------*/ static void *MotorGetInterface(void *pData, int iID) @@ -416,7 +409,7 @@ static void handleMoveCallback(pMotor self, SConnection *pCon) /* create and initialize parameters */ - pM->ParArray = ObParCreate(12); + pM->ParArray = ObParCreate(MOTOBPARLENGTH); if(!pM->ParArray) { free(pM); @@ -606,6 +599,7 @@ extern void KillPiPiezo(void *pData); if(iRet == 1) { SCparChange(pCon); + InvokeCallBack(self->pCall,HDBVAL,self); return iRet; } } @@ -631,6 +625,7 @@ extern void KillPiPiezo(void *pData); fLimit -= fChange; ObParSet(self->ParArray,self->name,"softlowerlim",fLimit,pCon); SCparChange(pCon); + InvokeCallBack(self->pCall,HDBVAL,self); return 1; } @@ -652,6 +647,7 @@ extern void KillPiPiezo(void *pData); ObParInit(self->ParArray,SZERO,"softzero",ZEROINACTIVE,usUser); } } + InvokeCallBack(self->pCall,HDBVAL,self); SCparChange(pCon); return iRet; @@ -747,10 +743,11 @@ extern void KillPiPiezo(void *pData); } /* check boundaries first */ - iRet = MotorCheckBoundary(self,fNew,&fHard,pBueffel,511); + iRet = MotorCheckBoundary(self,fNew,&fHard,pError,131); if(!iRet) { - SCWrite(pCon,pBueffel,eStatus); + snprintf(pBueffel,511,"ERROR: %s",pError); + SCWrite(pCon,pBueffel,eError); SCSetInterrupt(pCon,eAbortOperation); return 0; } @@ -784,6 +781,7 @@ extern void KillPiPiezo(void *pData); self->retryCount = 0; self->stopped = 0; self->fTarget = fHard; + InvokeCallBack(self->pCall,HDBVAL,self); self->posCount = 0; iRet = self->pDriver->RunTo(self->pDriver,fHard); if(iRet != OKOK) @@ -1024,7 +1022,22 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray); SCWrite(pCon,pBueffel,eError); return 0; } - } + } else if(strcmp(argv[2],"regress") == 0) + { + pDriver = RGMakeMotorDriver(); + if(!pDriver) + { + return 0; + } + /* create the motor */ + pNew = MotorInit("regress",argv[1],pDriver); + if(!pNew) + { + sprintf(pBueffel,"Failure to create motor %s",argv[1]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + } else { site = getSite(); @@ -1085,7 +1098,6 @@ extern MotorDriver *MakePiPiezo(Tcl_Interp *pTcl, char *pArray); { self->pDriver->ListDriverPar(self->pDriver,self->name, pCon); } - SCWrite(pCon,"ENDLIST",eFinish); } /*--------------------------------------------------------------------------*/ void MotorReset(pMotor pM) diff --git a/motor.h b/motor.h index 67d61d74..277afb1c 100644 --- a/motor.h +++ b/motor.h @@ -14,6 +14,7 @@ #include "obdes.h" #include "interface.h" +#define MOTOBPARLENGTH 12 typedef struct __Motor { pObjectDescriptor pDescriptor; ObPar *ParArray; @@ -32,6 +33,13 @@ int stopped; } Motor; typedef Motor *pMotor; +/*------------------------------------------------------------------------ + a tiny structure used in CallBack work +--------------------------------------------------------------------------*/ +typedef struct { + float fVal; + char *pName; + } MotCallback; /*-------------------------------------------------------------------------*/ /* parameter management */ diff --git a/multicounter.c b/multicounter.c new file mode 100644 index 00000000..8ab9a351 --- /dev/null +++ b/multicounter.c @@ -0,0 +1,429 @@ +/** + * The MultiCounter is another counter which coordinates multiple + * counting objects, counters and histogram memories. It also calls a + * script function after TransferData which collects counters and monitors. + * The purpose is to have a flexible counter abstraction for upper level + * code such as maximizers and scan functions. The script can deal with + * counting on monitors or on sums of histogram memories. + * + * This is a bit unclean. The counter driver is of no use, therefore its + * private data structure is used to hold the other counters and the name + * of the script. It would have been better to inherit from counter but + * that would have required lost of type casts. I am to lazy for this. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, September 2006 + */ +#include +#include +#include +#include +#include "multicounter.h" +#include "counter.h" +#include "HistMem.h" +#include "macro.h" +#include "splitter.h" + +#define MAXSLAVE 16 +#define NOCOUNTERS -2727 +/*=============== code for the driver ======================================*/ +typedef struct { + void *slaveData[MAXSLAVE]; + pICountable slaves[MAXSLAVE]; + char *transferScript; + int nSlaves; +}MultiCounter, *pMultiCounter; +/*--------------------------------------------------------------------------*/ +static void KillMultiDriver(struct __COUNTER *data){ + pMultiCounter self = (pMultiCounter)data->pData; + if(self == NULL){ + return; + } + if(self->transferScript != NULL){ + free(self->transferScript); + } + free(self); +} +/*============== countable interface functions ============================*/ +static int MMCCHalt(void *pData){ + int i, retVal = OKOK, status; + pCounter pCount = NULL; + pMultiCounter self = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + status = self->slaves[i]->Halt(self->slaveData[i]); + if(status != OKOK) + retVal = status; + } + return retVal; +} +/*-------------------------------------------------------------------------*/ +static int MMCCStart(void *pData, SConnection *pCon) +{ + int i, status; + pCounter pCount = NULL; + pMultiCounter self = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + self->slaves[i]->SetCountParameters(self->slaveData[i], + pCount->pDriv->fPreset, pCount->pDriv->eMode); + status = self->slaves[i]->StartCount(self->slaveData[i],pCon); + if(status != OKOK){ + MMCCHalt(pData); + return status; + } + } + pCount->isUpToDate = 0; + pCount->tStart = time(NULL); + InvokeCallBack(pCount->pCall,COUNTSTART,pCon); + return OKOK; +} +/*-------------------------------------------------------------------------*/ +static int MMCCStatus(void *pData, SConnection *pCon){ + int status,i; + pCounter pCount = NULL; + pMultiCounter self = NULL; + pDummy pDum = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + if(self->nSlaves == 0) { + pCount->pDriv->iErrorCode = NOCOUNTERS; + return HWFault; + } + + status = self->slaves[0]->CheckCountStatus(self->slaveData[0],pCon); + if(status == HWIdle || status == HWFault){ + /* + stop counting on slaves when finished or when an error + occurred. + */ + InvokeCallBack(pCount->pCall,COUNTEND,pCon); + MMCCHalt(pCount); + } + for(i = 1; i < MAXSLAVE; i++){ + if(self->slaves[i] != NULL){ + pDum = (pDummy)self->slaveData[i]; + if(strcmp(pDum->pDescriptor->name,"HistMem") == 0){ + HistDirty((pHistMem)self->slaveData[i]); + } + } + } + return status; +} +/*-------------------------------------------------------------------------*/ +static int MMCCPause(void *pData, SConnection *pCon){ + int i, status; + pCounter pCount = NULL; + pMultiCounter self = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + status = self->slaves[i]->Pause(self->slaveData[i],pCon); + if(status != OKOK){ + MMCCHalt(pCount); + return status; + } + } + return OKOK; +} +/*--------------------------------------------------------------------------*/ +static int MMCCContinue(void *pData, SConnection *pCon){ + int i, status; + pCounter pCount = NULL; + pMultiCounter self = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + status = self->slaves[i]->Continue(self->slaveData[i],pCon); + if(status != OKOK){ + MMCCHalt(pCount); + return status; + } + } + return OKOK; +} +/*------------------------------------------------------------------------*/ +static char *getNextMMCCNumber(char *pStart, char pNumber[80]){ + int charCount = 0; + pNumber[0] = '\0'; + + /* advance to first digit */ + while(isspace(*pStart) && *pStart != '\0'){ + pStart++; + } + if(*pStart == '\0'){ + return NULL; + } + + /* copy */ + while(!isspace(*pStart) && *pStart != '\0' && charCount < 78){ + pNumber[charCount] = *pStart; + pStart++; + charCount++; + } + pNumber[charCount] = '\0'; + return pStart; +} +/*-------------------------------------------------------------------------*/ +static void loadCountData(pCounter pCount, const char *data){ + char *pPtr = NULL; + char pNumber[80]; + int i = 0; + + pPtr = (char *)data; + pPtr = getNextMMCCNumber(pPtr,pNumber); + pCount->pDriv->fTime = atof(pNumber); + while(pPtr != NULL && i < MAXCOUNT){ + pPtr = getNextMMCCNumber(pPtr,pNumber); + pCount->pDriv->lCounts[i] = atoi(pNumber); + i++; + } +} +/*--------------------------------------------------------------------------*/ +static int MMCCTransfer(void *pData, SConnection *pCon){ + int i, retVal = OKOK, status; + char pBueffel[132]; + pCounter pCount = NULL; + pMultiCounter self = NULL; + int tclStatus; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + status = self->slaves[i]->TransferData(self->slaveData[i], pCon); + if(status != OKOK){ + retVal = status; + sprintf(pBueffel,"WARNING: slave histogram %d failed to transfer data", + i); + SCWrite(pCon,pBueffel,eWarning); + } + } + if(self->transferScript != NULL){ + MacroPush(pCon); + tclStatus = Tcl_Eval(InterpGetTcl(pServ->pSics), self->transferScript); + if(tclStatus != TCL_OK){ + snprintf(pBueffel,131,"ERROR: TransferScript returned: %s", + Tcl_GetStringResult(InterpGetTcl(pServ->pSics))); + SCWrite(pCon,pBueffel,eError); + MacroPop(); + return HWFault; + } + MacroPop(); + loadCountData(pCount,Tcl_GetStringResult(InterpGetTcl(pServ->pSics))); + } + return retVal; +} +/*-------------------------------------------------------------------------*/ +static void MMCCParameter(void *pData, float fPreset, CounterMode eMode ){ + int i; + pCounter pCount = NULL; + pMultiCounter self = NULL; + + pCount = (pCounter)pData; + if(pCount != NULL){ + self = (pMultiCounter)pCount->pDriv->pData; + } + assert(self); + + for(i = 0; i < self->nSlaves; i++){ + self->slaves[i]->SetCountParameters(self->slaveData[i], fPreset, + eMode); + } +} +/*======================= Driver Interface ==============================*/ +static int MultiCounterSet(struct __COUNTER *self, char *name, + int iCter, float fVal){ + + return 0; +} +/*-----------------------------------------------------------------------*/ +static int MultiCounterGet(struct __COUNTER *self, char *name, + int iCter, float *fVal){ + + return 0; +} +/*-----------------------------------------------------------------------*/ +static int MultiCounterSend(struct __COUNTER *self, char *pText, + char *reply, int replylen){ + + strncpy(reply,"NOT Implemented",replylen); + return 0; +} +/*---------------------------------------------------------------------*/ +static int MultiCounterError(struct __COUNTER *pData, int *iCode, + char *error, int errlen){ + pCounter pCount = NULL; + + pCount = (pCounter)pData; + + if(pCount->pDriv->iErrorCode == NOCOUNTERS){ + strncpy(error,"NO counters configured!",errlen); + } else { + strncpy(error,"Not Implemented", errlen); + } + return COTERM; +} +/*----------------------------------------------------------------------*/ +static int MultiCounterFix(struct __COUNTER *self, int iCode){ + return COTERM; +} +/*=============== Interpreter Interface ================================ */ +int MultiCounterAction(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]){ + pMultiCounter self = NULL; + pCounter pCount = NULL; + char buffer[256]; + + if(argc > 1){ + strtolower(argv[1]); + if(strcmp(argv[1],"transferscript") == 0){ + pCount = (pCounter)pData; + self = (pMultiCounter)pCount->pDriv->pData; + if(argc < 3){ + SCPrintf(pCon,eValue,"%s.transferscript = %s", + argv[0],self->transferScript); + return 1; + } else { + if(!SCMatchRights(pCon,usUser)){ + return 0; + } + if(self->transferScript != NULL){ + free(self->transferScript); + } + Arg2Text(argc-2,&argv[2],buffer,255); + self->transferScript = strdup(buffer); + SCSendOK(pCon); + return 1; + } + } + } + return CountAction(pCon,pSics,pData,argc,argv); +} +/*------------------------------------------------------------------------*/ +int MakeMultiCounter(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]){ + int i, status; + pCounter pNew = NULL; + char pBueffel[132]; + CommandList *pCom; + pICountable pCount; + pMultiCounter self = NULL; + pCounterDriver pDriv = NULL; + + /* + need at least two parameters + */ + if(argc < 3){ + SCWrite(pCon,"ERROR: insufficient number of arguments to MakeMultiCounter", + eError); + return 0; + } + + /* + allocate our data structure + */ + self = malloc(sizeof(MultiCounter)); + pDriv = malloc(sizeof(CounterDriver)); + if(self == NULL || pDriv == NULL){ + SCWrite(pCon,"ERROR: out of memory in MakeMultiCounter",eError); + return 0; + } + memset(self,0,sizeof(MultiCounter)); + memset(pDriv,0,sizeof(CounterDriver)); + pDriv->pData = self; + pDriv->KillPrivate = KillMultiDriver; + pDriv->iNoOfMonitors = MAXCOUNT; + pNew = CreateCounter(argv[1],pDriv); + if(pNew == NULL){ + SCWrite(pCon,"ERROR: out of memory in MakeMultiCounter",eError); + return 0; + } + pDriv->Get = MultiCounterGet; + pDriv->GetError = MultiCounterError; + pDriv->TryAndFixIt = MultiCounterFix; + pDriv->Set = MultiCounterSet; + pDriv->Send += MultiCounterSend; + + /* + assign interface functions + */ + pNew->pCountInt->Halt = MMCCHalt; + pNew->pCountInt->StartCount = MMCCStart; + pNew->pCountInt->CheckCountStatus = MMCCStatus; + pNew->pCountInt->Pause = MMCCPause; + pNew->pCountInt->Continue = MMCCContinue; + pNew->pCountInt->TransferData = MMCCTransfer; + pNew->pCountInt->SetCountParameters = MMCCParameter; + + /* + now loop through the remaining arguments, thereby entering them into + the slave list. + */ + for(i = 2; i < argc; i++){ + pCom = FindCommand(pSics,argv[i]); + if(!pCom){ + sprintf(pBueffel,"ERROR: object %s not found in MakeMultiCounter", + argv[i]); + SCWrite(pCon,pBueffel,eError); + continue; + } + pCount = GetCountableInterface(pCom->pData); + if(!pCount){ + sprintf(pBueffel,"ERROR: object %s is NOT countable", + argv[i]); + SCWrite(pCon,pBueffel,eError); + continue; + } + self->slaves[self->nSlaves] = pCount; + self->slaveData[self->nSlaves] = pCom->pData; + self->nSlaves++; + } + + /* + now install our action command and we are done + */ + status = AddCommand(pSics,argv[1],MultiCounterAction,DeleteCounter, + pNew); + if(!status){ + sprintf(pBueffel,"ERROR: duplicate command %s not created",argv[1]); + SCWrite(pCon,pBueffel,eError); + DeleteCounter(pNew); + return 0; + } + + return 1; +} + diff --git a/multicounter.h b/multicounter.h new file mode 100644 index 00000000..400e36f6 --- /dev/null +++ b/multicounter.h @@ -0,0 +1,19 @@ +/** + * The MultiCounter is another counter which coordinates multiple + * counting objects, counters and histogram memories. It also calls a + * script function after TransferData which collects counters and monitors. + * The purpose is to have a flexible counter abstraction for upper level + * code such as maximizers and scan functions. The script can deal with + * counting on monitors or on sums of histogram memories. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, September 2006 + */ +#ifndef MULTICOUNTER_H_ +#define MULTICOUNTER_H_ +#include + +int MakeMultiCounter(SConnection *pCon, SicsInterp *pSics, + void *pData, int argc, char *argv[]); +#endif /*MULTICOUNTER_H_*/ diff --git a/mumoconf.c b/mumoconf.c index 00293496..305a7417 100644 --- a/mumoconf.c +++ b/mumoconf.c @@ -315,6 +315,7 @@ char pError[132]; int i, iToken, iRet; sParser PP; + CommandList *pCom = NULL; assert(pCon); assert(pSics); @@ -345,9 +346,10 @@ break; case ENDCONFIG: /* reconfigure command to final state */ - RemoveCommand(pSics,argv[0]); - AddCommand(pSics,argv[0],MultiWrapper,KillMultiMotor, - self); + pCom = FindCommand(pSics,argv[0]); + assert(pCom != NULL); + pCom->OFunc = MultiWrapper; + pCom->KFunc = KillMultiMotor; return 1; break; case ALIAS: diff --git a/network.c b/network.c index 4f3c37b3..3639cae9 100644 --- a/network.c +++ b/network.c @@ -424,9 +424,14 @@ CreateSocketAdress( return 0; } -#ifndef CYGNUS - /* setup for select first */ - tmo.tv_usec = 100; + /* + * Check if the we can write to the socket first.... + * Well, this how it should be. However, on linux I observe that + * there is a problem with Java clients not reliably receiving data when + * this is active. + */ +#ifndef CYGNUS + tmo.tv_usec = 10; FD_ZERO(&lMask); FD_SET(self->sockid,&lMask); if((self->sockid >= FD_SETSIZE) || (self->sockid < 0) ) @@ -445,7 +450,8 @@ CreateSocketAdress( { return -2; } -#endif +#endif + iRet = send(self->sockid,buffer,lLen,0); if(iRet != lLen) { diff --git a/nread.c b/nread.c index c6e17795..28c23669 100644 --- a/nread.c +++ b/nread.c @@ -686,6 +686,9 @@ extern int VerifyChannel(mkChannel *self); /* defined in network.c */ int iRet, iStatus; int iCount; NetItem NItem; + int conCount = 0; + char num[50]; + IPair *options = NULL; self = (pNetRead)pData; assert(self); @@ -716,9 +719,13 @@ extern int VerifyChannel(mkChannel *self); /* defined in network.c */ { iCount = NItem.pSock->sockid; } + conCount++; iRet = LLDnodePtr2Next(self->iList); } + snprintf(num,50,"%d", conCount); + IFSetOption(pSICSOptions,"ConnectionCount",num); + /* the select itself */ tmo.tv_usec = self->iReadTimeout; iCount++; diff --git a/nserver.c b/nserver.c index 47556084..f5114fe8 100644 --- a/nserver.c +++ b/nserver.c @@ -109,6 +109,8 @@ /* initialise tasker */ assert(TaskerInit(&self->pTasker)); + pSICSOptions = IFAddOption(pSICSOptions, "ConnectionCount","0"); + /* initialise the server from script */ if(file == NULL) { @@ -397,13 +399,13 @@ */ killTclDrivable(); - /* close the List system */ - LLDsystemClose(); - KillFreeConnections(); killSICSHipadaba(); + /* close the List system */ + LLDsystemClose(); + /* make fortify print his findings */ Fortify_DumpAllMemory(iFortifyScope); Fortify_LeaveScope(); diff --git a/nxscript.c b/nxscript.c index 06146906..ddec8be1 100644 --- a/nxscript.c +++ b/nxscript.c @@ -373,6 +373,31 @@ static void putSicsData(SConnection *pCon, SicsInterp *pSics, } } /*----------------------------------------------------------------------*/ +static void putAttribute(SConnection *pCon, SicsInterp *pSics, + pNXScript self, int argc, char *argv[]){ + int status, type = NX_CHAR; + char buffer[256]; + + if(argc < 5){ + SCWrite(pCon,"ERROR: insufficient number of arguments to putAttribute", + eError); + return; + } + + status = NXDopenalias(self->fileHandle,self->dictHandle,argv[2]); + if(status != NX_OK){ + sprintf(buffer,"ERROR: failed to open alias %s", argv[2]); + SCWrite(pCon,buffer,eError); + return; + } + status = NXputattr(self->fileHandle,argv[3],(void *)argv[4], + strlen(argv[4])+1, type); + if(status != NX_OK){ + sprintf(buffer,"ERROR: failed to write attribute %s", argv[3]); + SCWrite(pCon,buffer,eError); + } +} +/*----------------------------------------------------------------------*/ static void updateHMDim(NXScript *self, pHistMem mem){ int iDim[MAXDIM]; int i, rank, timeLength, status; @@ -412,7 +437,7 @@ static void putHistogramMemory(SConnection *pCon, SicsInterp *pSics, pNXScript self, int argc, char *argv[]){ pHistMem mem = NULL; - int status, start, length, i, subset = 0; + int status, start, length, i, subset = 0, bank = 0; HistInt *iData = NULL; char buffer[256]; @@ -460,6 +485,19 @@ static void putHistogramMemory(SConnection *pCon, SicsInterp *pSics, return; } } + + /* + * check for additional bank number + */ + if(argc > 6){ + status = Tcl_GetInt(InterpGetTcl(pSics),argv[6],&bank); + if(status != TCL_OK){ + sprintf(buffer,"ERROR: failed to convert %s to integer", + argv[6]); + SCWrite(pCon,buffer,eError); + return; + } + } /* read HM @@ -472,7 +510,7 @@ static void putHistogramMemory(SConnection *pCon, SicsInterp *pSics, return; } memset(iData,0,length*sizeof(HistInt)); - status = GetHistogramDirect(mem,pCon,0,start,start+length,iData, + status = GetHistogramDirect(mem,pCon,bank,start,start+length,iData, length*sizeof(HistInt)); }else{ /* @@ -712,7 +750,10 @@ static void putArray(SConnection *pCon, SicsInterp *pSics, data = (float *)malloc(length*sizeof(float)); } if(data == NULL){ - SCWrite(pCon,"ERROR: out of memory or invalid length",eError); + snprintf(buffer,255, + "ERROR: out of memory or invalid length at %s, length = %s", + argv[2],argv[4]); + SCWrite(pCon,buffer,eError); return; } memset(data,0,length*sizeof(float)); @@ -980,6 +1021,9 @@ static int handlePut(SConnection *pCon, SicsInterp *pSics, pNXScript self, }else if(strcmp(argv[1],"putsicsdata") == 0){ /*===============*/ putSicsData(pCon,pSics,self,argc,argv); + }else if(strcmp(argv[1],"putattribute") == 0){ + /*===============*/ + putAttribute(pCon,pSics,self,argc,argv); } else { SCWrite(pCon,"ERROR: put command not recognised",eError); } @@ -1032,6 +1076,7 @@ int NXScriptAction(SConnection *pCon, SicsInterp *pSics, void *pData, pNXScript self = (pNXScript)pData; char *pFile = NULL; int status; + char buffer[132]; /* preliminary checks @@ -1095,6 +1140,20 @@ int NXScriptAction(SConnection *pCon, SicsInterp *pSics, void *pData, return 1; } + if(strcmp(argv[1],"isalias") == 0) { + if(argc < 3) { + SCWrite(pCon,"ERROR: need alias to test",eError); + return 1; + } + if(NXDget(self->dictHandle,argv[2],buffer,131) == NX_OK){ + snprintf(buffer,131,"%s = 1", argv[2]); + } else { + snprintf(buffer,131,"%s = 0", argv[2]); + } + SCWrite(pCon,buffer,eValue); + return 1; + } + if(strcmp(argv[1],"makelink") == 0){ makeLink(pCon,pSics,self,argc,argv); return 1; diff --git a/nxutil.c b/nxutil.c index 6ad7596f..82a4edc4 100644 --- a/nxutil.c +++ b/nxutil.c @@ -28,8 +28,9 @@ int iRet; /* Find the motor */ - strtolower(pName); - pMot = FindMotor(pSics,pName); + strncpy(pBueffel,pName,511); + strtolower(pBueffel); + pMot = FindMotor(pSics,pBueffel); if(!pMot) { sprintf(pBueffel,"WARNING: cannot find motor %s",pName); @@ -58,8 +59,9 @@ int iRet; /* Find the motor */ - strtolower(pName); - pMot = FindMotor(pSics,pName); + strncpy(pBueffel,pName,511); + strtolower(pBueffel); + pMot = FindMotor(pSics,pBueffel); if(!pMot) { sprintf(pBueffel,"WARNING: cannot find motor %s",pName); @@ -95,8 +97,9 @@ char *pText = NULL; /* find it */ - strtolower(pName); - pVar = FindVariable(pSics,pName); + strncpy(pBueffel,pName,511); + strtolower(pBueffel); + pVar = FindVariable(pSics,pBueffel); if(!pVar) { sprintf(pBueffel,"WARNING: cannot find variable %s",pName); diff --git a/obdes.c b/obdes.c index 7fac44e5..b94c717e 100644 --- a/obdes.c +++ b/obdes.c @@ -84,7 +84,7 @@ */ if(self->parNode != NULL){ if(self->parNode->mama == NULL){ - DeleteHipadabaNode(self->parNode); + DeleteHipadabaNode(self->parNode,NULL); } } free(self); diff --git a/ofac.c b/ofac.c index 996f7f98..6e7ba8d6 100644 --- a/ofac.c +++ b/ofac.c @@ -6,7 +6,7 @@ - Mark Koennecke, November 1996 -- ???? + Mark Koennecke, November 1996 -- ???? heavy modifications to separate PSI specific commands into a separate library. Mark Koennecke, June 2003 @@ -119,6 +119,9 @@ #include "sicslist.h" #include "cone.h" #include "sicshipadaba.h" +#include "multicounter.h" +#include "sicspoll.h" +#include "statemon.h" /*----------------------- Server options creation -------------------------*/ static int IFServerOption(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]) @@ -214,6 +217,7 @@ AddCommand(pInter,"FileWhere",MacroWhere,WhereKill,NULL); */ AddCommand(pInter,"ClientPut",ClientPut,NULL,NULL); + AddCommand(pInter,"GumPut",GumPut,NULL,NULL); AddCommand(pInter,"broadcast",Broadcast,NULL,NULL); AddCommand(pInter,"transact",TransactAction,NULL,NULL); AddCommand(pInter,"fulltransact",TransactAction,NULL,NULL); @@ -273,7 +277,8 @@ AddCommand(pInter,"MakeEnergy",MakeEnergyVar,NULL,NULL); AddCommand(pInter,"MakeCounter",MakeCounter,NULL,NULL); AddCommand(pInter,"MakeO2T",CreateO2T,NULL,NULL); - AddCommand(pInter,"SicsAlias",SicsAlias,NULL,NULL); + AddCommand(pInter,"SicsAlias",SicsAlias,NULL,NULL); + AddCommand(pInter,"SicsAlias",DefineAlias,NULL,NULL); AddCommand(pInter,"DefineAlias",DefineAlias,NULL,NULL); /* M.Z. */ AddCommand(pInter,"MakeHM",MakeHistMemory,NULL,NULL); AddCommand(pInter,"VelocitySelector",VelSelFactory,NULL,NULL); @@ -328,6 +333,12 @@ InstallSinfox,NULL,NULL); AddCommand(pInter,"MakeCone", MakeCone,NULL,NULL); + AddCommand(pInter,"MakeMultiCounter", + MakeMultiCounter,NULL,NULL); + AddCommand(pInter,"MakeSicsPoll", + InstallSICSPoll,NULL,NULL); + AddCommand(pInter,"MakeStateMon", + StateMonFactory,NULL,NULL); /* install site specific commands @@ -396,6 +407,8 @@ RemoveCommand(pSics,"InstallProtocolHandler"); RemoveCommand(pSics,"InstallSinfox"); RemoveCommand(pSics,"MakeCone"); + RemoveCommand(pSics,"MakeMultiCounter"); + RemoveCommand(pSics,"MakeStateMon"); /* remove site specific installation commands */ diff --git a/optimise.c b/optimise.c index 7b507cf7..89a3ad89 100644 --- a/optimise.c +++ b/optimise.c @@ -519,38 +519,13 @@ static int ClimbDrive(SConnection *pCon,char *name, float value) } return 1; } -/*-------------------------------------------------------------------------*/ - static int ClimbVariable(pOptimise self, SConnection *pCon, int i) - { - pOVarEntry pOvar; - void *pData; - int status, direction = 1; - long oneCount, twoCount, lastCount, currentCount; - float varValue, startValue; - char buffer[256]; - int (*CollectFunc)(pScanData self, int iPoint) = NULL; - - assert(self); - assert( (i >= 0) && (i < self->iVar)); - assert(pCon); - - /* get variable data */ - DynarGet(self->pVariables,i,&pData); - pOvar = (pOVarEntry)pData; - startValue = pOvar->fCenter; - - /* - * prepare scan object - */ - self->pScanner->pCon = pCon; - self->pScanner->pSics = pServ->pSics; - self->pScanner->iNP = 1; - self->pScanner->iMode = self->eCount; - self->pScanner->fPreset = self->fPreset; - - /* - * test for upwards direction - */ +/*------------------------------------------------------------------------*/ +static int findDirection(pOptimise self, pOVarEntry pOvar, SConnection *pCon) +{ + int status, direction; + float varValue; + long oneCount, twoCount; + varValue = pOvar->fCenter + pOvar->fStep; status = ClimbDrive(pCon,pOvar->pName,varValue); if(!status) @@ -584,14 +559,46 @@ static int ClimbDrive(SConnection *pCon,char *name, float value) if(oneCount > twoCount) { direction = 1; - lastCount = oneCount; } else { direction = -1; - lastCount = twoCount; } - + return direction; +} +/*-------------------------------------------------------------------------*/ + static int ClimbVariable(pOptimise self, SConnection *pCon, int i) + { + pOVarEntry pOvar; + void *pData; + int status, direction = 1; + long oneCount, twoCount, lastCount, currentCount; + float varValue, startValue; + char buffer[256]; + int (*CollectFunc)(pScanData self, int iPoint) = NULL; + + assert(self); + assert( (i >= 0) && (i < self->iVar)); + assert(pCon); + + /* get variable data */ + DynarGet(self->pVariables,i,&pData); + pOvar = (pOVarEntry)pData; + startValue = pOvar->fCenter; + + /* + * prepare scan object + */ + self->pScanner->pCon = pCon; + self->pScanner->pSics = pServ->pSics; + self->pScanner->iNP = 1; + self->pScanner->iMode = self->eCount; + self->pScanner->fPreset = self->fPreset; + + direction = findDirection(self,pOvar, pCon); + if(direction < -1){ + return direction; + } /* * drive to the last best position */ @@ -600,7 +607,12 @@ static int ClimbDrive(SConnection *pCon,char *name, float value) if(!status) { return DRIVEERROR; - } + } + lastCount = ClimbCount(self,pCon); + if(lastCount < 0) + { + return SCANERROR; + } currentCount = lastCount; /* diff --git a/outcode.c b/outcode.c index 7d3810e5..6fd84b9b 100644 --- a/outcode.c +++ b/outcode.c @@ -21,6 +21,7 @@ "warning", "error", "hdb", + "hdbEvent", NULL }; - static int iNoCodes = 11; + static int iNoCodes = 13; #endif diff --git a/polldriv.c b/polldriv.c new file mode 100644 index 00000000..36959c26 --- /dev/null +++ b/polldriv.c @@ -0,0 +1,97 @@ +/** + * This is the sister module to sicspoll which defines the drivers for the + * various modes of polling SICS objects. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ + +#include +#include +#include +#include + +#include "polldriv.h" +#include "splitter.h" +#include "sicshipadaba.h" +/*================ actual driver implementation =========================*/ +static int timeDue(struct __POLLDRIV *self, time_t now, SConnection *pCon){ + if(now > self->nextPoll){ + return 1; + } else { + return 0; + } +} +/*------------------ HDB Driver -----------------------------------------*/ +static int pollHdb(struct __POLLDRIV *self, SConnection *pCon){ + hdbValue old, newVal; + pHdb node = NULL; + + memset(&old,0,sizeof(hdbValue)); + memset(&newVal,0,sizeof(hdbValue)); + node = (pHdb)self->objPointer; + assert(node != NULL); + old = node->value; + self->nextPoll = time(NULL) + self->pollIntervall; + if(GetHipadabaPar(node, &newVal, pCon) == 1){ + if(!compareHdbValue(old,newVal)){ + UpdateHipadabaPar(node,newVal,pCon); + } + return 1; + } else { + return 0; + } +} +/*-----------------------------------------------------------------------*/ +static pPollDriv makeHdbDriver(SConnection *pCon, char *objectIdentifier, + int argc, char *argv[]){ + pHdb root = NULL, node = NULL; + pPollDriv pNew = NULL; + + root = GetHipadabaRoot(); + assert(root != NULL); + node = GetHipadabaNode(root,objectIdentifier); + if(node == NULL){ + SCWrite(pCon,"ERROR: object to poll not found",eError); + return 0; + } + pNew = malloc(sizeof(PollDriv)); + if(pNew == NULL){ + return NULL; + } + memset(pNew,0,sizeof(PollDriv)); + + + pNew->objectIdentifier = strdup(objectIdentifier); + pNew->objPointer = node; + pNew->isDue = timeDue; + pNew->poll = pollHdb; + + if(argc > 0){ + pNew->pollIntervall = atoi(argv[0]); + } else { + pNew->pollIntervall = 10; + } + + return pNew; +} +/*================ external interface ====================================*/ +pPollDriv makePollDriver(SConnection *pCon, char *driver, + char *objectIdentifier, int argc, char *argv[]){ + + strtolower(driver); + if(strcmp(driver,"hdb") == 0) { + return makeHdbDriver(pCon,objectIdentifier, argc, argv); + } else { + SCWrite(pCon,"ERROR: polling driver type unknown",eError); + return NULL; + } +} +/*------------------------------------------------------------------------*/ +void deletePollDriv(pPollDriv self){ + if(self->objectIdentifier != NULL){ + free(self->objectIdentifier); + } + free(self); +} diff --git a/polldriv.h b/polldriv.h new file mode 100644 index 00000000..c5a22f13 --- /dev/null +++ b/polldriv.h @@ -0,0 +1,42 @@ +/** + * This is the sister module to sicspoll which defines the drivers for the + * various modes of polling SICS objects. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ +#ifndef POLLDRIV_H_ +#define POLLDRIV_H_ +#include +#include +/*==================== a data structure ===================================*/ +typedef struct __POLLDRIV{ + char *objectIdentifier; /* the object identifier */ + void *objPointer; /* a pointer to the object */ + time_t nextPoll; /* next polling time */ + int pollIntervall; /* poll intervall */ + int (*isDue)(struct __POLLDRIV *self, time_t now, SConnection *pCon); + /* function called to determine if this object must be polled */ + int (*poll)(struct __POLLDRIV *self, SConnection *pCon); + /* the actual polling function */ +}PollDriv, *pPollDriv; +/*==================== the interface =====================================*/ +/* + * make a poll driver + * @param pCon A connection to report errors too + * @param driver the driver type to generate + * @param objectIdentifier An identifer for the object to poll + * @param argc number of additional parameter + * @param *argv[] Additional parameters. + * @return NULL on failure or a PollDriv strucure else. + */ +pPollDriv makePollDriver(SConnection *pCon, char *driver, + char *objectIdentifier, int argc, char *argv[]); +/** + * free all memory associated with this poll driver + * @param self The structure to delete + */ +void deletePollDriv(pPollDriv self); + +#endif /*POLLDRIV_H_*/ diff --git a/polldriv.tc b/polldriv.tc new file mode 100644 index 00000000..c0e88ceb --- /dev/null +++ b/polldriv.tc @@ -0,0 +1,88 @@ +/** + * This is the sister module to sicspoll which defines the drivers for the + * various modes of polling SICS objects. + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ +<%! source sicstemplates.tcl %> +<% stdIncludes %> +#include "polldriv.h" +#include "splitter.h" +#include "sicshipadaba.h" +/*================ actual driver implementation =========================*/ +static int timeDue(struct __POLLDRIV *self, time_t now, SConnection *pCon){ + if(now > self->nextPoll){ + return 1; + } else { + return 0; + } +} +/*------------------ HDB Driver -----------------------------------------*/ +static int pollHdb(struct __POLLDRIV *self, SConnection *pCon){ + hdbValue old, newVal; + pHdb node = NULL; + + memset(&old,0,sizeof(hdbValue)); + memset(&newVal,0,sizeof(hdbValue)); + node = (pHdb)self->objPointer; + assert(node != NULL); + old = node->value; + self->nextPoll = time(NULL) + self->pollIntervall; + if(GetHipadabaPar(node, &newVal, pCon) == 1){ + if(!compareHdbValue(old,newVal)){ + UpdateHipadabaPar(node,newVal,pCon); + } + return 1; + } else { + return 0; + } +} +/*-----------------------------------------------------------------------*/ +static pPollDriv makeHdbDriver(SConnection *pCon, char *objectIdentifier, + int argc, char *argv[]){ + pHdb root = NULL, node = NULL; + pPollDriv pNew = NULL; + + root = GetHipadabaRoot(); + assert(root != NULL); + node = GetHipadabaNode(root,objectIdentifier); + if(node == NULL){ + SCWrite(pCon,"ERROR: object to poll not found",eError); + return 0; + } + <%newStruc PollDriv 5 %> + + pNew->objectIdentifier = strdup(objectIdentifier); + pNew->objPointer = node; + pNew->isDue = timeDue; + pNew->poll = pollHdb; + + if(argc > 0){ + pNew->pollIntervall = atoi(argv[0]); + } else { + pNew->pollIntervall = 10; + } + + return pNew; +} +/*================ external interface ====================================*/ +pPollDriv makePollDriver(SConnection *pCon, char *driver, + char *objectIdentifier, int argc, char *argv[]){ + + strtolower(driver); + if(strcmp(driver,"hdb") == 0) { + return makeHdbDriver(pCon,objectIdentifier, argc, argv); + } else { + SCWrite(pCon,"ERROR: polling driver type unknown",eError); + return NULL; + } +} +/*------------------------------------------------------------------------*/ +void deletePollDriv(pPollDriv self){ + if(self->objectIdentifier != NULL){ + free(self->objectIdentifier); + } + free(self); +} diff --git a/protocol.c b/protocol.c index b6693769..8c006ac4 100644 --- a/protocol.c +++ b/protocol.c @@ -16,7 +16,7 @@ #include #include "commandlog.h" #include "protocol.h" -#include "json.h" +#include #define MAXMSG 1024 #define INIT_STR_SIZE 256 @@ -87,8 +87,6 @@ pProtocol CreateProtocol(void); static int ProtocolOptions(SConnection* pCon, pProtocol pPro); static int ProtocolHelp(SConnection* pCon, Protocol* pPro); static int ProtocolSet(SConnection* pCon, Protocol* pPro, char *pProName); -static int ProtocolGet(SConnection* pCon, Protocol* pPro, char *pProName, - int *pIndex); static int ProtocolList(SConnection* pCon, Protocol* pPro); int ProtocolAction(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); @@ -294,9 +292,10 @@ static int ProtocolSet(SConnection* pCon, Protocol* pPro, char *pProName) } /*------------------------------------------------------------------------*/ -static int ProtocolGet(SConnection* pCon, Protocol* pPro, char *pProName, - int *pIndex) +int ProtocolGet(SConnection* pCon, void* pData, char *pProName, int len) { + int Index; + Protocol *pPro = (Protocol *)pData; if(!SCVerifyConnection(pCon)) { return 0; @@ -309,24 +308,27 @@ static int ProtocolGet(SConnection* pCon, Protocol* pPro, char *pProName, pPro->isDefaultSet = 1; pCon->iProtocolID = 0; } - - *pIndex = (int)malloc(sizeof(int)); - *pIndex = pCon->iProtocolID; + strncpy(pProName, pPro->pProList[pCon->iProtocolID], len); + return 1; +#if 0 + Index = pCon->iProtocolID; /* check list of protocols for valid name */ - switch(*pIndex) + switch(Index) { case 0: /* default = psi_sics */ case 1: /* normal (connection start default) */ case 2: /* outcodes */ case 3: /* sycamore */ - pProName = strdup(pPro->pProList[*pIndex]); + case 4: /* json */ + pProName = pPro->pProList[Index]; return 1; break; default: return 0; break; } +#endif } /*------------------------------------------------------------------------*/ @@ -632,42 +634,43 @@ struct json_object *mkJSON_Object(SConnection *pCon, char *pBuffer, int iOut) json_object_object_add(msg_json, "flag", json_object_new_string(pCode[iOut])); break; } - if (iOut == eHdb) { + if (iOut == eHdbValue || iOut == eHdbEvent) { tmp_json = json_tokener_parse(pBuffer); - if (is_error(msg_json)) { linenum = __LINE__; goto reporterr; } + if (is_error(tmp_json)) { linenum = __LINE__; goto reporterr; } } else { /* Strip \r and \n */ for (pBufferFrom=pBufferTo=pBuffer; ; pBufferFrom++) { if (*pBufferFrom == '\r' || *pBufferFrom == '\n') continue; - *pBufferTo = *pBufferFrom; + pBufferTo = pBufferFrom; if (*pBufferTo == '\0') break; pBufferTo++; } tmp_json = json_object_new_string(pBuffer); - if (is_error(msg_json)) { linenum = __LINE__; goto reporterr; } + if (is_error(tmp_json)) { linenum = __LINE__; goto reporterr; } } json_object_object_add(msg_json, "data", tmp_json); return msg_json; reporterr: SCSetWriteFunc(pCon,SCNormalWrite); - snprintf(pError, 256,"%s:%d Error making json object", __FILE__, linenum); + snprintf(pError, 256,"{\"ERROR\": \"%s:%d Error making json object\"}", __FILE__, linenum); SCWrite(pCon,pError,eError); + SCSetWriteFunc(pCon,SCWriteJSON_String); cleanup: - if (tmp_json != NULL) + if (tmp_json != NULL && !is_error(tmp_json)) json_object_put(tmp_json); - if (msg_json != NULL) + if (msg_json != NULL && !is_error(msg_json)) json_object_put(msg_json); return NULL; } int SCWriteJSON_String(SConnection *pCon, char *pBuffer, int iOut) { - struct json_object *my_object=NULL; - char pBueffel[MAXMSG]; - int iRet; + struct json_object *my_object=NULL, *tmp_json=NULL; + char pBueffel[MAXMSG], errBuff[MAXMSG]; + int iRet, errLen = MAXMSG; if (strlen(pBuffer) == 0) return 1; @@ -688,21 +691,48 @@ int SCWriteJSON_String(SConnection *pCon, char *pBuffer, int iOut) /* write to commandlog if user or manager privilege */ if(SCGetRights(pCon) <= usUser) { + if(pCon->iMacro != 1) + { + sprintf(pBueffel,"To sock %d :",iRet); + WriteToCommandLog(pBueffel,pBuffer); + } + else + { + if(iOut == eError || iOut == eWarning) + { sprintf(pBueffel,"To sock %d :",iRet); WriteToCommandLog(pBueffel,pBuffer); - } + } + } + } if(SCinMacro(pCon)) { InterpWrite(pServ->pSics,pBuffer); + /* print it to client if error message */ + if((iOut== eError) || (iOut == eWarning) ) + { + tmp_json = json_object_new_string(pBuffer); + iRet = SCDoSockWrite(pCon,json_object_to_json_string(tmp_json)); + } } else { - my_object = mkJSON_Object(pCon, pBuffer, iOut); - iRet = SCDoSockWrite(pCon,json_object_to_json_string(my_object)); - SCWriteToLogFiles(pCon,pBuffer); + if ((my_object = mkJSON_Object(pCon, pBuffer, iOut)) == NULL) { + snprintf(errBuff, errLen, "failed to make JSON object from, %s", pBuffer); + tmp_json = json_object_new_string(errBuff); + my_object = json_object_new_object(); + json_object_object_add(my_object, "ERROR", tmp_json); + SCDoSockWrite(pCon,json_object_to_json_string(my_object)); + iRet = 0; + } else { + iRet = SCDoSockWrite(pCon,json_object_to_json_string(my_object)); + SCWriteToLogFiles(pCon,pBuffer); + } } - if (my_object != NULL) + if (tmp_json != NULL && !is_error(tmp_json)) + json_object_put(tmp_json); + if (my_object != NULL && !is_error(my_object)) json_object_put(my_object); - return 1; + return iRet; } /*------------------------------------------------------------------------*/ /* Protocol API */ @@ -731,6 +761,7 @@ char * GetProtocolName(SConnection* pCon) case 1: /* normal (connection start default) */ case 2: /* outcodes */ case 3: /* sycamore */ + case 4: /* json */ return strdup(pPro->pProList[pCon->iProtocolID]); break; default: diff --git a/protocol.h b/protocol.h index c3b8c585..ff00e813 100644 --- a/protocol.h +++ b/protocol.h @@ -30,5 +30,6 @@ int SCWriteSycamore(SConnection *pCon, char *pBuffer, int iOut); /*--------------------- implement protocol API -----------------------*/ char * GetProtocolName(SConnection *pCon); int GetProtocolID(SConnection *pCon); +int ProtocolGet(SConnection* pCon, void* pData, char *pProName, int len); /*-----------------------------------------------------------------------*/ #endif diff --git a/regresscter.c b/regresscter.c new file mode 100644 index 00000000..a0701b50 --- /dev/null +++ b/regresscter.c @@ -0,0 +1,262 @@ +/*-------------------------------------------------------------------------- + This is a counter for use in automated regression tests. + + copyright: see file COPYRIGHT + + Mark Koennecke, September 2006 +----------------------------------------------------------------------------*/ +#include +#include +#include +#include +#include "fortify.h" +#include +#include "sics.h" +#include "countdriv.h" +/*---------------------------------- possible error types ------------------*/ +#define NONE 0 +#define STARTFAIL 1 +#define STATUSFAIL 2 +#define PAUSEFAIL 3 +#define CONTFAIL 4 +#define READFAIL 5 + +#define STATEIDLE 0 +#define STATERUN 1 +#define STATEPAU 2 +/*--------------------------------------------------------------------------*/ +typedef struct { + int errType; + int recover; + int state; + time_t endTime; +} RegressSt; +/*---------------------------------------------------------------------------*/ +static int RegressGetStatus(struct __COUNTER *self, float *fControl){ + RegressSt *pSim = NULL; + time_t tD, tDe; + int iRun; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->errType == STATUSFAIL){ + return HWFault; + } + if(time(NULL) > pSim->endTime){ + pSim->state = STATEIDLE; + } + switch(pSim->state){ + case STATEIDLE: + return HWIdle; + break; + case STATERUN: + return HWBusy; + break; + case STATEPAU: + return HWPause; + break; + } + assert(0); + return HWFault; +} +/*---------------------------------------------------------------------------*/ +static int RegressStart(struct __COUNTER *self){ + RegressSt *pSim = NULL; + time_t tD; + int iRun; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->errType == STARTFAIL){ + return HWFault; + } + pSim->state = STATERUN; + if(self->eMode == eTimer){ + pSim->endTime = time(NULL) + (int)self->fPreset; + } else { + pSim->endTime = time(NULL) + 7; + } + + return OKOK; +} +/*---------------------------------------------------------------------------*/ +static int RegressPause(struct __COUNTER *self){ + RegressSt *pSim = NULL; + time_t tD; + int iRun; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->errType == PAUSEFAIL){ + return HWFault; + } + + pSim->state = STATEPAU; + + return OKOK; +} +/*---------------------------------------------------------------------------*/ +static int RegressContinue(struct __COUNTER *self){ + RegressSt *pSim = NULL; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->errType == CONTFAIL){ + return HWFault; + } + + pSim->state = STATERUN; + + return OKOK; +} +/*--------------------------------------------------------------------------*/ +static int RegressHalt(struct __COUNTER *self){ + RegressSt *pSim = NULL; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + pSim->state = STATEIDLE; + + return OKOK; +} + +/*-------------------------------------------------------------------------*/ +static int RegressReadValues(struct __COUNTER *self){ + RegressSt *pSim = NULL; + int i; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->errType == READFAIL){ + return HWFault; + } + + for (i = 0; i < MAXCOUNT; i++) { + self->lCounts[i] = i*10+5; + } + self->lCounts[1] = self->fPreset; + self->fTime = self->fPreset; + return OKOK; +} +/*-------------------------------------------------------------------------*/ +static int RegressGetError(struct __COUNTER *self, int *iCode, char *error, + int iErrLen){ + strncpy(error, "Regression counter error", iErrLen); + *iCode = 1; + return 1; +} +/*--------------------------------------------------------------------------*/ +static int RegressTryAndFixIt(struct __COUNTER *self, int iCode){ + RegressSt *pSim = NULL; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(pSim->recover == 1){ + pSim->errType = NONE; + return COREDO; + } else { + return COTERM; + } +} +/*--------------------------------------------------------------------------*/ +static int RegressSet(struct __COUNTER *self, char *name, int iCter, float FVal){ + RegressSt *pSim = NULL; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(strcmp(name,"errortype") == 0){ + pSim->errType = (int)FVal; + return 1; + } + if(strcmp(name,"recover") == 0){ + pSim->recover = (int)FVal; + return 1; + } + if(strcmp(name,"finish") == 0){ + pSim->state = STATEIDLE; + return 1; + } + return 0; +} +/*--------------------------------------------------------------------------*/ +static int RegressGet(struct __COUNTER *self, char *name, + int iCter, float *fVal){ + RegressSt *pSim = NULL; + + assert(self); + pSim = (RegressSt *) self->pData; + assert(pSim); + + if(strcmp(name,"errortype") == 0){ + *fVal = pSim->errType; + return 1; + } + if(strcmp(name,"recover") == 0){ + *fVal = pSim->recover; + return 1; + } + return 0; +} +/*---------------------------------------------------------------------------*/ +static int RegressSend(struct __COUNTER *self, char *pText, + char *pReply, int iReplyLen){ + strncpy(pReply, "Simulated response", iReplyLen); + return 1; +} +/*---------------------------------------------------------------------------*/ +pCounterDriver NewRegressCounter(char *name){ + pCounterDriver pRes = NULL; + RegressSt *pData = NULL; + int iRet; + int iC1, iC2, iC3; + char *pErr; + char pBueffel[132]; + + pRes = CreateCounterDriver(name, "Regress"); + if (!pRes) { + return NULL; + } + + pData = (RegressSt *) malloc(sizeof(RegressSt)); + if (!pData) { + DeleteCounterDriver(pRes); + return NULL; + } + memset(pData,0,sizeof(RegressSt)); + pRes->pData = pData; + + /* + * assign functions + */ + pRes->GetStatus = RegressGetStatus; + pRes->Start = RegressStart; + pRes->Halt = RegressHalt; + pRes->ReadValues = RegressReadValues; + pRes->GetError = RegressGetError; + pRes->TryAndFixIt = RegressTryAndFixIt; + pRes->Pause = RegressPause; + pRes->Continue = RegressContinue; + pRes->Set = RegressSet; + pRes->Get = RegressGet; + pRes->Send = RegressSend; + pRes->KillPrivate = NULL; + pRes->iNoOfMonitors = 8; + + return pRes; +} diff --git a/remob.c b/remob.c index 12dc5187..b565e0e6 100644 --- a/remob.c +++ b/remob.c @@ -19,6 +19,7 @@ M. Zolliker July 04 #include "status.h" #include "servlog.h" #include "site.h" +#include "commandlog.h" /*-------------------------------------------------------------------------*/ #define INTERRUPTMODE 0 #define ACCESSCODE 1 @@ -242,8 +243,10 @@ static int RemServerTask(void *data) { rc = &remserver->rc[isUser]; if (RemRead(rc, 0) <= 0) continue; - /* printf("< %s\n", buf); */ - + if (strstr(rc->line, " ") == rc->line) { + WriteToCommandLog("REMOB>", "infinite echo loop detected"); + continue; + } if (isUser == 0) { if (RemHandle(remserver)) { /* handle drivstat messages */ continue; diff --git a/rs232controller.c b/rs232controller.c index 17fe6509..7b717502 100644 --- a/rs232controller.c +++ b/rs232controller.c @@ -434,6 +434,42 @@ void getRS232Error(int iCode, char *errorBuffer, } } /*--------------------------------------------------------------------*/ +int fixRS232Error(prs232 self, int iCode){ + int i, status, read; + char buffer[8192]; + + switch(iCode){ + case BADMEMORY: + case FAILEDCONNECT: + return 0; + break; + case INCOMPLETE: + case TIMEOUT: + /* + * try to clear possibly pending stuff + */ + for(i = 0; i < 3; i++){ + if(availableRS232(self)){ + read = 8192; + readRS232(self,buffer,&read); + } + } + return 1; + break; + case NOTCONNECTED: + case BADSEND: + closeRS232(self); + status = initRS232(self); + if(status){ + return 1; + } else { + return 0; + } + break; + } + return 0; +} +/*--------------------------------------------------------------------*/ int getRS232Timeout(prs232 self){ return self->timeout; } diff --git a/rs232controller.h b/rs232controller.h index beddb2d2..1628930c 100644 --- a/rs232controller.h +++ b/rs232controller.h @@ -65,6 +65,7 @@ void getRS232Error(int iCode, char *errorBuffer, int errorBufferLen); + int fixRS232Error(prs232 self, int iCode); int getRS232Timeout(prs232 self); int initRS232(prs232 self); int initRS232WithFlags(prs232 self, int flags); diff --git a/scan.c b/scan.c index 4ed66ad9..359e9ba6 100644 --- a/scan.c +++ b/scan.c @@ -385,6 +385,7 @@ int AppendScanLine(pScanData self, char *line) } /*-------------------------------------------------------------------------*/ extern char *stptok(const char *s, char *t, int len, char *brk); +extern char *trim(char *txt); int StoreScanCounts(pScanData self, char *data) { @@ -402,7 +403,7 @@ int StoreScanCounts(pScanData self, char *data) InitCountEntry(&sCount); /* parse the data */ - pPtr = data; + pPtr = trim(data); pPtr = stptok(pPtr,pNumber,29," \t"); if(pPtr != NULL) { @@ -1584,7 +1585,7 @@ static int PrintTimes(pScanData self, SConnection *pCon, snprintf(pBueffel,59,"%s.scantimes = { ",name); DynStringCopy(data,pBueffel); - for(i = 0; i < self->iNP; i++) + for(i = 0; i < self->iCounts; i++) { DynarGet(self->pCounts,i,&pPtr); pData = (pCountEntry)pPtr; @@ -2127,8 +2128,8 @@ static int DumpScan(pScanData self, SConnection *pCon) } /*------------ functions */ else if(strcmp(argv[1],"function") == 0) - { - return InterpretScanFunctions(self, pCon, argc, argv); + { + return InterpretScanFunctions(self, pCon, argc, argv); } /*---------- scan */ else if(strcmp(argv[1],"run") == 0) @@ -2414,6 +2415,20 @@ static int DumpScan(pScanData self, SConnection *pCon) } return AppendVarPos(pCon,self,i,(float)fStep); } + else if(strcmp(argv[1],"softpos") == 0){ + if(argc > 2) { + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + self->posSoft = atoi(argv[2]); + SCSendOK(pCon); + return 1; + } else { + sprintf(pBueffel,"%s.softpos = %d", argv[0],self->posSoft); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + } /*------- savecounter */ else if(strcmp(argv[1],"savecounter") == 0) { diff --git a/sics.h b/sics.h index a2dc465f..d32d24b8 100644 --- a/sics.h +++ b/sics.h @@ -17,7 +17,7 @@ /* the following line suppresses const declarations in tcl.h. -> makes the compiler happy M.Z. */ -#define NO_CONST +/* #define NO_CONST */ #include #include diff --git a/sicscron.c b/sicscron.c index ce49d5d2..2621d945 100644 --- a/sicscron.c +++ b/sicscron.c @@ -11,7 +11,7 @@ #include #include #include -#include +#include "macro.h" #include "fortify.h" #include "sics.h" #include "splitter.h" @@ -24,6 +24,7 @@ char *pCommand; SConnection *pCon; int iEnd; + Statistics *stat; } Cron, *pCron; /*------------------------------------------------------------------------*/ @@ -43,12 +44,19 @@ { SCDeleteConnection(self->pCon); } + if (self->stat) { + StatisticsKill(self->stat); + } free(self); } /*-----------------------------------------------------------------------*/ static int CronTask(void *pData) { + Statistics *old; + pCron self = (pCron)pData; + int iRet; + Tcl_Interp *pTcl = pServ->pSics->pTcl; if(!self) { @@ -57,7 +65,17 @@ if(time(NULL) > self->tNext) { - SCInvoke(self->pCon,pServ->pSics,self->pCommand); + MacroPush(self->pCon); + old=StatisticsBegin(self->stat); + iRet = Tcl_Eval(pTcl,self->pCommand); + StatisticsEnd(old); + MacroPop(); + if (iRet != TCL_OK) { + SCPrintf(self->pCon, eStatus, + "ERROR in sicscron script: %s", pTcl->result); + self->iEnd = 0; + return 0; + } self->tNext = time(NULL) + self->iIntervall; } return self->iEnd; @@ -82,11 +100,11 @@ int argc, char *argv[]) { pCron pNew = NULL; - int iVal, iRet; + int iVal, iRet, rights; char *cmd; - /* only managers may do this */ - if(!SCMatchRights(pCon,usMugger)) + /* need user priv. */ + if(!SCMatchRights(pCon,usUser)) { return 0; } @@ -123,10 +141,16 @@ SCWrite(pCon,"ERROR: out of memory in sicscron",eError); return 0; } + rights = SCGetRights(pCon); + if (rights > usMugger) { + /* transfer the rights to the dummy connection */ + SCSetRights(pNew->pCon, rights); + } pNew->iIntervall = iVal; pNew->pCommand = cmd; pNew->tNext = 0; pNew->iEnd = 1; + pNew->stat = StatisticsNew(cmd); TaskRegister(pServ->pTasker, CronTask, diff --git a/sicsdata.c b/sicsdata.c index 417415e5..bd01b91d 100644 --- a/sicsdata.c +++ b/sicsdata.c @@ -4,6 +4,8 @@ An attempt to a generic interface to SICS data for all sorts of SICS clients. + WARNING: this code only works when ints and floats are of the same size! + copyright: see file COPYRIGHT Mark Koennecke, June 2003 @@ -17,7 +19,7 @@ #include "scan.h" #include "HistMem.h" #include "sicsdata.h" - +#define ABS(x) (x < 0 ? -(x) : (x)) /*--------------------------------------------------------------------*/ static void KillSICSData(void *pData){ pSICSData self = NULL; @@ -60,6 +62,47 @@ pSICSData createSICSData(void){ pNew->dataUsed = 0; return pNew; } +/*---------------------------------------------------------------------------*/ +int getSICSDataInt(pSICSData self, int pos, int *value){ + + if(pos >= self->dataUsed || self->dataType[pos] != INTTYPE){ + return 0; + } + *value = self->data[pos]; + return 1; +} +/*---------------------------------------------------------------------------*/ +int getSICSDataFloat(pSICSData self, int pos, float *value){ + if(pos >= self->dataUsed || self->dataType[pos] != FLOATTYPE){ + return 0; + } + memcpy(value,&self->data[pos],sizeof(float)); + return 1; +} +/*---------------------------------------------------------------------------*/ +int setSICSDataInt(pSICSData self, int pos, int value){ + int *idata = NULL; + + idata = getSICSDataPointer(self,0,pos+1); + if(idata == NULL){ + return 0; + } + idata[pos] = value; + self->dataType[pos] = INTTYPE; + return 1; +} +/*----------------------------------------------------------------------------*/ +int setSICSDataFloat(pSICSData self, int pos, float value){ + int *idata = NULL; + + idata = getSICSDataPointer(self,0,pos+1); + if(idata == NULL){ + return 0; + } + memcpy(&idata[pos],&value,sizeof(float)); + self->dataType[pos] = FLOATTYPE; + return 1; +} /*-------------------------------------------------------------------*/ int *getSICSDataPointer(pSICSData self, int start, int end){ int newSize; @@ -134,7 +177,7 @@ static void netEncode(pSICSData self){ } } /*---------------------------------------------------------------------*/ -static void clearSICSData(pSICSData self){ +void clearSICSData(pSICSData self){ assert(self); self->dataUsed = 0; @@ -236,6 +279,74 @@ static int putFloat(pSICSData self, int argc, char *argv[], SCSendOK(pCon); return 1; } +/*------------------------------------------------------------------*/ +static int getPos(pSICSData self, char *name, + SConnection *pCon, int pos){ + char pBueffel[512]; + float value; + + if(pos >= self->dataUsed){ + SCWrite(pCon,"ERROR: requested position out of range",eError); + return 0; + } + if(self->dataType[pos] == FLOATTYPE){ + memcpy(&value,&self->data[pos],sizeof(float)); + snprintf(pBueffel,511,"%s = %f", name, value); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + if(self->dataType[pos] == INTTYPE){ + snprintf(pBueffel,511,"%s = %d", name, self->data[pos]); + SCWrite(pCon,pBueffel,eValue); + return 1; + } + return 0; +} +/*------------------------------------------------------------------*/ +static float getDataPos(pSICSData self, int pos){ + float value; + + assert(pos < self->dataUsed); + if(self->dataType[pos] == FLOATTYPE){ + memcpy(&value,&self->data[pos],sizeof(float)); + } else { + value = (float)self->data[pos]; + } + return value; +} +/*------------------------------------------------------------------*/ +static int divideSicsData(pSICSData self, SicsInterp *pSics, + SConnection *pCon, char *name){ + int i; + pSICSData other = NULL; + float val, div; + + other = (pSICSData)FindCommandData(pSics,name,"SICSData"); + if(other == NULL){ + SCWrite(pCon,"ERROR: requested SICSData object to divide not found", + eError); + return 0; + } + if(other->dataUsed < self->dataUsed){ + SCWrite(pCon,"ERROR: not enough data in SICSData for division", + eError); + return 0; + } + for(i = 0; i < self->dataUsed; i++){ + div = getDataPos(other,i); + if(ABS(div) > .00001){ + val = getDataPos(self,i)/div; + } else { + val = .0; + } + if(self->dataType[i] == INTTYPE){ + self->data[i] = (int)val; + } else { + memcpy(&self->data[i],&val,sizeof(float)); + } + } + return 1; +} /*-------------------------------------------------------------------*/ static int copyScanCounts(pSICSData self, int argc, char *argv[], SConnection *pCon, SicsInterp *pSics){ @@ -475,6 +586,35 @@ static int copyHM(pSICSData self, int argc, char *argv[], SCSendOK(pCon); return 1; } +/*----------------------------------------------------------------------*/ +static int copyData(pSICSData self,SicsInterp *pSics, + SConnection *pCon,int argc, char *argv[]){ + pSICSData other = NULL; + int pos, start, end, i; + + if(argc < 6){ + SCWrite(pCon,"ERROR: Insufficient number of arguments to copydata", + eError); + return 0; + } + pos = atoi(argv[2]); + start = atoi(argv[4]); + end = atoi(argv[5]); + if((other = FindCommandData(pSics,argv[3],"SICSData")) == NULL){ + SCWrite(pCon,"ERROR: invalid SICSData requested",eError); + return 0; + } + if(start > end || end > other->dataUsed){ + SCWrite(pCon,"ERROR: invalid copy range specified",eError); + return 0; + } + getSICSDataPointer(self,pos, pos + (end -start)); + memcpy(&self->data[pos],&other->data[start],(end-start)*sizeof(int)); + memcpy(&self->dataType[pos],&other->dataType[start], + (end-start)*sizeof(char)); + + return 1; +} /*---------------------------------------------------------------------- Look here in order to find out about commands understood ----------------------------------------------------------------------*/ @@ -482,6 +622,7 @@ int SICSDataAction(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ pSICSData self = NULL; char pBueffel[132]; + int pos; self = (pSICSData)pData; assert(self); @@ -509,6 +650,21 @@ int SICSDataAction(SConnection *pCon, SicsInterp *pSics, void *pData, return 0; } return dumpSICSData(self,argv[2],pCon); + } else if(strcmp(argv[1],"get") == 0){ + if(argc < 3){ + SCWrite(pCon,"ERROR: need a position to read",eError); + return 0; + } + pos = atoi(argv[2]); + return getPos(self,argv[0],pCon,pos); + } else if(strcmp(argv[1],"divideby") == 0){ + if(argc < 3){ + SCWrite(pCon,"ERROR: need a SICSdata to divide by",eError); + return 0; + } + return divideSicsData(self,pSics,pCon,argv[2]); + } else if(strcmp(argv[1],"copydata") == 0){ + return copyData(self,pSics,pCon,argc, argv); } else if(strcmp(argv[1],"putint") == 0){ /*---------- putint */ return putInt(self,argc-2,&argv[2],pCon, pSics); diff --git a/sicsdata.h b/sicsdata.h index 6c6eaa03..9d3bf8d3 100644 --- a/sicsdata.h +++ b/sicsdata.h @@ -39,5 +39,12 @@ int SICSDataAction(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); + + void clearSICSData(pSICSData self); + int getSICSDataInt(pSICSData self, int pos, int *value); + int getSICSDataFloat(pSICSData self, int pos, float *value); + int setSICSDataInt(pSICSData self, int pos, int value); + int setSICSDataFloat(pSICSData self, int pos, float value); + #endif diff --git a/sicsdata.w b/sicsdata.w index 7832e9a3..9d5e19f0 100644 --- a/sicsdata.w +++ b/sicsdata.w @@ -6,6 +6,8 @@ sources such as histogram memories or scans. Data assembled in this way, for instance through scripts, can then be forwarded to clients either in UUencoded form or as a zipped array. +WARNING: this code only works right when integers and floats are of the same size! + In a later stage this may be extended to support selected mathematical operations as well. In another stage this may supersede the uuget and zipget methods in the scan, histogram memory and specialized status @@ -48,6 +50,13 @@ This object exports the following functions: int SICSDataAction(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]); + + void clearSICSData(pSICSData self); + int getSICSDataInt(pSICSData self, int pos, int *value); + int getSICSDataFloat(pSICSData self, int pos, float *value); + int setSICSDataInt(pSICSData self, int pos, int value); + int setSICSDataFloat(pSICSData self, int pos, float value); + @} \begin{description} \item[getSICSDataPointer] returns a pointer to the first element of diff --git a/sicshdbadapter.c b/sicshdbadapter.c new file mode 100644 index 00000000..44470917 --- /dev/null +++ b/sicshdbadapter.c @@ -0,0 +1,513 @@ +/* + * Experience has shown that integrating existing SICS objects into the + * Hierarchical Parameter Database (Hdb) is a difficult task without reworking + * the complete SICS object model. Rather, it seems easier to adapt some + * critical objects to the Hdb with some glue code. Following the facade or + * adapter design pattern. This is the purpose of this module. For the moment + * the external interface is only an interpreter function which will be used to + * install suitable SICS objects into the Hdb tree and generates the necessary + * adapters internally. This code can be used to adapt to: + * - motors + * - the data segment of histogram memories + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, November 2006 + */ +#include +#include +#include +#include "stptok.h" +#include "motor.h" +#include "HistMem.h" +#include "sicsvar.h" +#include "sicshipadaba.h" +#include "sicshdbadapter.h" + +#define PRIVNAM "priv" +/*==================== support code ====================================*/ +static void AddPrivProperty(pHdb node, int priv){ + char pPriv[80]; + switch(priv){ + case usInternal: + strcpy(pPriv,"internal"); + break; + case usMugger: + strcpy(pPriv,"manager"); + break; + case usUser: + strcpy(pPriv,"user"); + break; + case usSpy: + strcpy(pPriv,"spy"); + break; + default: + assert(0); + break; + } + SetHdbProperty(node,PRIVNAM,pPriv); +} +/*=================== motor code =======================================*/ +static int MoveCallback(int iEvent, void *eventData, void *userData, + commandContext cc){ + MotCallback *motData = (MotCallback *)eventData; + pHdb motor = (pHdb)userData; + pHdb pos = NULL; + + if(iEvent == MOTDRIVE && motData != NULL && motor != NULL){ + UpdateHipadabaPar(motor,MakeHdbFloat((double)motData->fVal) + ,NULL); + pos = GetHipadabaNode(motor,"position"); + if(pos != NULL){ + UpdateHipadabaPar(pos,MakeHdbFloat((double)motData->fVal) + ,NULL); + } + } + return 1; +} +/*---------------------------------------------------------------------*/ +static int MotorValueCallback(int iEvent, void *eventData, void *userData, + commandContext cc){ + pHdb motor = (pHdb)userData; + pMotor pMot = (pMotor)eventData; + pHdb current = NULL; + float fVal; + + /* + * as setting some motor parameters might cause other motor + * parametes to change too, I opt for the cheap solution to check + * them all. + */ + if(iEvent == HDBVAL && motor != NULL && pMot != NULL){ + current = motor->child; + while(current != NULL){ + MotorGetPar(pMot,current->name,&fVal); + if(fVal != current->value.v.doubleValue) { + UpdateHipadabaPar(current,MakeHdbFloat((double)fVal),NULL); + } + current = current->next; + } + } + return 1; +} +/*---------------------------------------------------------------------*/ +static int MotorParSetCallback(void *userData, void *callData, + pHdb currentNode, hdbValue v){ + pMotor pMot = (pMotor)userData; + SConnection *pCon = (SConnection *)callData; + int status; + + assert(pMot != NULL && pCon != NULL); + status = MotorSetPar(pMot,pCon,currentNode->name, (float)v.v.doubleValue); + return status; +} +/*----------------------------------------------------------------------*/ +static int MotorParGetCallback(void *userData, void *callData, + pHdb currentNode, hdbValue v){ + pMotor pMot = (pMotor)userData; + float fVal; + int status; + + assert(pMot != NULL); + status = MotorGetPar(pMot,currentNode->name,&fVal); + currentNode->value.v.doubleValue = fVal; + return status; +} +/*---------------------------------------------------------------------*/ +static pHdb MakeMotParNode(char *name, pMotor pMot){ + pHdb node = NULL; + pHdbCallback pCall = NULL; + + node = MakeHipadabaNode(name, HIPFLOAT, 1); + if(node != NULL) { + pCall = MakeHipadabaCallback(MotorParSetCallback,pMot,NULL,-1,-1); + if(pCall == NULL){ + return NULL; + } + AppendHipadabaCallback(node,HCBSET,pCall); + pCall = MakeHipadabaCallback(MotorParGetCallback,pMot,NULL,-1,-1); + if(pCall == NULL){ + return NULL; + } + AppendHipadabaCallback(node,HCBREAD,pCall); + } + return node; +} +/*---------------------------------------------------------------------*/ +static int AddStdMotorPar(pHdb motorNode, pMotor pMot){ + int i; + pHdb parNode = NULL; + char *addPar[] = {"target", + "hardlowerlim", + "hardupperlim", + NULL}; + + i = 0; + while(addPar[i] != NULL){ + parNode = MakeMotParNode(addPar[i],pMot); + SetHdbProperty(parNode,PRIVNAM,"internal"); + if(parNode == NULL){ + return 0; + } + AddHipadabaChild(motorNode,parNode, NULL); + i++; + } + + /* + * Add the parameters in the obpar array + */ + for(i = 0; i < MOTOBPARLENGTH; i++){ + parNode = MakeMotParNode(pMot->ParArray[i].name,pMot); + if(parNode == NULL){ + return 0; + } + AddHipadabaChild(motorNode,parNode, NULL); + AddPrivProperty(parNode,pMot->ParArray[i].iCode); + } + return 1; +} +/*--------------------------------------------------------------------------*/ +static char *getDriverParList(MotorDriver *pDriv){ + SConnection *pCon = NULL; + pDynString list = NULL; + char *listData = NULL; + + if(pDriv->ListDriverPar != NULL){ + pCon = SCCreateDummyConnection(pServ->pSics); + if(pCon == NULL){ + return NULL; + } + SCStartBuffering(pCon); + pDriv->ListDriverPar(pDriv,"test.", pCon); + list = SCEndBuffering(pCon); + if(list != NULL){ + listData = strdup(GetCharArray(list)); + SCDeleteConnection(pCon); + } else { + listData = NULL; + } + return listData; + } + return NULL; +} +/*--------------------------------------------------------------------------*/ +extern char *trim(char *str); +/*--------------------------------------------------------------------------*/ +static char *extractName(char *line){ + char *name = NULL, *pEnd = NULL; + + name = strchr(line,'.'); + assert(name != NULL); + while(*name == '.'){ + name++; + } + pEnd = strchr(name,'='); + assert(pEnd != NULL); + *pEnd = '\0'; + return trim(name); +} +/*------------------------------------------------------------------------*/ +static int CreateDriverParameters(pMotor pM, pHdb parent){ + char *listPtr = NULL, line[80], *pPtr, *name; + pHdb node = NULL; + + listPtr = getDriverParList(pM->pDriver); + if(listPtr == NULL){ + /* + * no driver parameters + */ + return 1; + } + pPtr = listPtr; + while((pPtr = stptok(pPtr,line,79,"\n")) != NULL){ + name = extractName(line); + node = MakeMotParNode(name,pM); + SetHdbProperty(node,PRIVNAM,"manager"); + if(node != NULL){ + AddHipadabaChild(parent,node,NULL); + } + } + free(listPtr); + return 1; +} +/*----------------------------------------------------------------------*/ +static pHdb CreateMotorAdapter(char *name, pMotor pMot){ + pHdb result = NULL; + commandContext comCom; + float access; + + assert(pMot != NULL); + + result = MakeSICSHdbDriv(name,usUser,pMot,HIPFLOAT); + if(result == NULL){ + return NULL; + } + MotorGetPar(pMot,"accesscode",&access); + AddPrivProperty(result,(int)access); + SetHdbProperty(result,"type","drivable"); + SetHdbProperty(result,"sicsdev",pMot->name); + /* + * We want to be notified when this motor drives around. Or + * its parameters change. + */ + strncpy(comCom.deviceID,name,255); + comCom.transID = -77; + RegisterCallback(pMot->pCall,comCom, MOTDRIVE, MoveCallback, + result,NULL); + RegisterCallback(pMot->pCall,comCom, HDBVAL, MotorValueCallback, + result,NULL); + + if(!AddStdMotorPar(result,pMot)){ + DeleteHipadabaNode(result,NULL); + return NULL; + } + + if(!CreateDriverParameters(pMot,result)){ + DeleteHipadabaNode(result,NULL); + return NULL; + } + result->protected = 1; + + return result; +} +/*============== histogram memory ======================================*/ +static long totalSum(int *data, int length){ + long result = 0l; + int i; + + if(data == NULL){ + return 0; + } + for(i = 0; i < length; i++){ + result += data[i]; + } + return result; +} +/*----------------------------------------------------------------------*/ +static int HMDataGetCallback(void *userData, void *callData, + pHdb currentNode, hdbValue v){ + pHistMem pHM = (pHistMem)userData; + SConnection *pCon = (SConnection *)callData; + long sum1, sum2; + + assert(pHM != NULL); + if(pCon == NULL){ + return 0; + } + sum1 = totalSum(currentNode->value.v.intArray, currentNode->value.arrayLength); + currentNode->value.arrayLength = GetHistLength(pHM); + currentNode->value.v.intArray = (int *)GetHistogramPointer(pHM,pCon); + sum2 = totalSum(currentNode->value.v.intArray, currentNode->value.arrayLength); + if(sum1 != sum2){ + UpdateHipadabaPar(currentNode,currentNode->value,NULL); + } + return 1; +} +/*----------------------------------------------------------------------*/ +static pHdb MakeHMDataNode(pHistMem pHM, char *name){ + pHdb node = NULL; + pHdbCallback pCall = NULL; + + + node = MakeHipadabaNode(name,HIPINTVARAR,2); + if(node == NULL){ + return NULL; + } + pCall = MakeHipadabaCallback(HMDataGetCallback,pHM,NULL,-1,-1); + if(pCall == NULL){ + return NULL; + } + AppendHipadabaCallback(node,HCBREAD,pCall); + AppendHipadabaCallback(node,HCBSET,MakeReadOnlyCallback()); + + return node; +} +/*================ SICS Variable ======================================*/ +static int SicsVarSetCallback(void *userData, void *callData, + pHdb currentNode, hdbValue v){ + pSicsVariable pVar = (pSicsVariable)userData; + SConnection *pCon = (SConnection *)callData; + int userRights = usMugger; + + assert(pVar != NULL); + + if(pCon != NULL){ + userRights = SCGetRights(pCon); + } + switch(currentNode->value.dataType){ + case HIPINT: + VarSetInt(pVar, v.v.intValue, userRights); + break; + case HIPFLOAT: + VarSetFloat(pVar, (float)v.v.doubleValue, userRights); + break; + case HIPTEXT: + VarSetText(pVar, v.v.text, userRights); + break; + } + return 1; +} +/*----------------------------------------------------------------------*/ +static int ValueCallback(int iEvent, void *eventData, void *userData, + commandContext cc){ + pSicsVariable pVar = (pSicsVariable)eventData; + pHdb node = (pHdb)userData; + hdbValue v; + + if(iEvent == VALUECHANGE && pVar != NULL && node != NULL){ + switch(pVar->eType){ + case veInt: + v = MakeHdbInt(pVar->iVal); + break; + case veFloat: + v = MakeHdbFloat((double)pVar->fVal); + break; + case veText: + v = MakeHdbText(pVar->text); + break; + } + UpdateHipadabaPar(node,v,NULL); + } + + return 1; +} +/*----------------------------------------------------------------------*/ +static pHdb MakeSicsVarNode(pSicsVariable pVar, char *name){ + pHdb node = NULL; + pHdbCallback pCall = NULL; + commandContext comCom; + int type; + + switch(pVar->eType){ + case veInt: + type = HIPINT; + break; + case veFloat: + type = HIPFLOAT; + break; + case veText: + type = HIPTEXT; + break; + } + node = MakeHipadabaNode(name,type,1); + if(node == NULL){ + return NULL; + } + if(pVar->iLock == 1) { + AddPrivProperty(node,usInternal); + } else { + AddPrivProperty(node,pVar->iAccessCode); + } + pCall = MakeHipadabaCallback(SicsVarSetCallback,pVar,NULL,-1,-1); + if(pCall == NULL){ + return NULL; + } + strncpy(comCom.deviceID,name,255); + comCom.transID = -77; + AppendHipadabaCallback(node,HCBSET,pCall); + RegisterCallback(pVar->pCall,comCom, VALUECHANGE, ValueCallback, + node,NULL); + + node->protected = 1; + return node; +} +/*============== interpreter function ==================================*/ +int SICSHdbAdapter(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb root = NULL; + pHdb path = NULL; + pHdb node = NULL; + pMotor pMot = NULL; + pHistMem pHM = NULL; + CommandList *pCom = NULL; + pIDrivable pDriv = NULL; + pSicsVariable pVar = NULL; + char buffer[512]; + + root = GetHipadabaRoot(); + assert(root != NULL); + + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + if(argc < 4) { + SCWrite(pCon,"ERROR: Insufficient number of arguments",eError); + return 0; + } + + path = GetHipadabaNode(root,argv[1]); + if(path == NULL){ + SCWrite(pCon,"ERROR: path to attach object too not found",eError); + return 0; + } + + /* + * look for motors + */ + pMot = (pMotor)FindCommandData(pSics,argv[2],"Motor"); + if(pMot != NULL){ + node = CreateMotorAdapter(argv[3],pMot); + if(node == NULL){ + SCWrite(pCon,"ERROR: out of memory creating motor node",eError); + return 0; + } + AddHipadabaChild(path,node,pCon); + SCSendOK(pCon); + return 1; + } + /* + * look for drivables + */ + pDriv = FindDrivable(pSics,argv[2]); + pCom = FindCommand(pSics,argv[2]); + if(pDriv != NULL && pCom != NULL && pCom->pData != NULL){ + node = MakeSICSHdbDriv(argv[3],usUser,pCom->pData,HIPFLOAT); + if(node == NULL){ + SCWrite(pCon,"ERROR: out of memory creating drivable node",eError); + return 0; + } + SetHdbProperty(node,PRIVNAM,"user"); + SetHdbProperty(node,"type","drivable"); + SetHdbProperty(node,"sicsdev",argv[2]); + AddHipadabaChild(path,node,pCon); + SCSendOK(pCon); + return 1; + } + + /** + * look for SICS Variables + */ + pVar = (pSicsVariable)FindCommandData(pSics,argv[2],"SicsVariable"); + if(pVar != NULL){ + node = MakeSicsVarNode(pVar,argv[3]); + if(node == NULL){ + SCWrite(pCon,"ERROR: out of memory creating SICS variable node", + eError); + return 0; + } + AddHipadabaChild(path,node,pCon); + SCSendOK(pCon); + return 1; + } + + /* + * look for histogram memories + */ + pHM = (pHistMem)FindCommandData(pSics,argv[2],"HistMem"); + if(pHM != NULL){ + node = MakeHMDataNode(pHM,argv[3]); + if(node == NULL){ + SCWrite(pCon,"ERROR: out of memory creating HM node",eError); + return 0; + } + AddHipadabaChild(path,node,pCon); + SCSendOK(pCon); + return 1; + } + + snprintf(buffer,511, + "ERROR: attaching this type of object: %s at %s not implemented", + argv[2], argv[1]); + SCWrite(pCon,buffer,eError); + return 0; +} diff --git a/sicshdbadapter.h b/sicshdbadapter.h new file mode 100644 index 00000000..9b8e54d2 --- /dev/null +++ b/sicshdbadapter.h @@ -0,0 +1,23 @@ +/* + * Experience has shown that integrating existing SICS objects into the + * Hierarchical Parameter Database (Hdb) is a difficult task without reworking + * the complete SICS object model. Rather, it seems easier to adapt some + * critical objects to the Hdb with some glue code. Following the facade or + * adapter design pattern. This is the purpose of this module. For the moment + * the external interface is only an interpreter function which will be used to + * install suitable SICS objects into the Hdb tree and generates the necessary + * adapters internally. This code can be used to adapt to: + * - motors + * - the data segment of histogram memories + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, November 2006 + */ +#ifndef SICSHDBADAPTER_H_ +#define SICSHDBADAPTER_H_ + +int SICSHdbAdapter(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); + +#endif /*SICSHDBADAPTER_H_*/ diff --git a/sicshipadaba.c b/sicshipadaba.c index fb40227e..e4609add 100644 --- a/sicshipadaba.c +++ b/sicshipadaba.c @@ -6,26 +6,34 @@ * copyright: GPL * * Mark Koennecke, June 2006 + * + * Introduced notification on tree changes, Mark Koennecke, November 2006 + * + * Added property functions, Mark Koennecke, January 2007 + * + * TODO: separate this into two modules: sicshipadaba proper and sicshipadabaint for the + * interpreter interface. */ #include #include #include #include #include +#include +#include "sicspoll.h" #include #include +#include "protocol.h" +#include /*== there can be only hipadaba in SICS, some globals to care for that == */ static pHdb root = NULL; -static int scriptUpdate = -1; -static hdbUpdateTask taskData; -enum formatStyle {plain, cli, json}; -char *formatName[] = {"plain", "cli", "json"}; -static enum formatStyle currFmtStyle=json; - - -pDynString formatClientValue(char *name, hdbValue hVal, int children); -pDynString formatJSONValue(char *name, hdbValue hVal, int children); +static pSicsPoll poller = NULL; +typedef enum { + normal_protocol, + json_protocol, +} Protocol; +char *trim(char *str); /*=============== common callback functions used for SICS ===========================*/ static int SICSCheckPermissionCallback(void *userData, void *callData, pHdb node, hdbValue v){ @@ -61,6 +69,7 @@ pHdbCallback MakeCheckPermissionCallback(int priv){ if(testPriv == NULL){ return NULL; } + *testPriv = priv; return MakeHipadabaCallback(SICSCheckPermissionCallback, testPriv,free,-1,-1); } /*-------------------------------------------------------------------------------------*/ @@ -85,7 +94,7 @@ static int SICSReadOnlyCallback(void *userData, void *callData, pHdb node, return SICSCBRO; } /*-------------------------------------------------------------------------------------*/ -static pHdbCallback MakeReadOnlyCallback(){ +pHdbCallback MakeReadOnlyCallback(){ return MakeHipadabaCallback(SICSReadOnlyCallback, NULL,NULL,-1,-1); } /*-------------------------------------------------------------------------------------*/ @@ -107,6 +116,7 @@ pHdbCallback MakeSICSDriveCallback(void *sicsObject){ /*---------------------------------------------------------------------------------------*/ static int SICSReadDriveCallback(void *userData, void *callData, pHdb node, hdbValue v){ + static SConnection *defCon = NULL; SConnection *pCon = NULL; pDummy dum = NULL; pIDrivable pDriv = NULL; @@ -114,7 +124,11 @@ static int SICSReadDriveCallback(void *userData, void *callData, pHdb node, pCon = (SConnection *)callData; dum = (pDummy)userData; - assert(pCon != NULL && dum != NULL); + assert(dum != NULL); + + if(defCon == NULL){ + defCon = SCCreateDummyConnection(pServ->pSics); + } pDriv = dum->pDescriptor->GetInterface(dum,DRIVEID); assert(pDriv != NULL); @@ -122,6 +136,12 @@ static int SICSReadDriveCallback(void *userData, void *callData, pHdb node, value = pDriv->GetValue(dum,pCon); node->value.v.doubleValue = (double)value; v.v.doubleValue = (double)value; + } else { + if(defCon != NULL){ + value = pDriv->GetValue(dum,defCon); + node->value.v.doubleValue = (double)value; + v.v.doubleValue = (double)value; + } } return 1; } @@ -134,6 +154,73 @@ typedef struct { SConnection *pCon; commandContext context; }HdbCBInfo; + +static Protocol isJSON(SConnection *pCon) { + char proName[128]; + void *pData; + + if(SCinMacro(pCon)){ + return normal_protocol; + } + pData = FindCommandData(pServ->pSics, "protocol","Protocol"); + ProtocolGet(pCon, pData, proName, 128); + if (strcmp(proName, "json") == 0) + return json_protocol; + else + return normal_protocol; +} + +/* Format a name,value pair according to the given protocol */ +int formatNameValue(Protocol protocol, char *name, char *value, pDynString result, int hdtype) { + char *char_arr, *ptr; + + switch(protocol) { + case normal_protocol: + DynStringCopy(result,name); + DynStringConcat(result," = "); + DynStringConcat(result,value); + break; + case json_protocol: + switch(hdtype){ + case HIPNONE: + break; + case HIPINT: + case HIPFLOAT: + DynStringCopy(result,"{\""); + DynStringConcat(result,name); + DynStringConcat(result,"\": "); + DynStringConcat(result,value); + DynStringConcat(result,"}"); + break; + case HIPTEXT: + DynStringCopy(result,"{\""); + DynStringConcat(result,name); + DynStringConcat(result,"\": \""); + DynStringConcat(result,value); + DynStringConcat(result,"\"}"); + break; + case HIPINTAR: + case HIPINTVARAR: + case HIPFLOATAR: + case HIPFLOATVARAR: + char_arr = ptr = strdup(trim(value)); + while(*ptr != '\0') { + if (isspace(*ptr)) + *ptr=','; + ptr++; + } + DynStringCopy(result,"{\""); + DynStringConcat(result,name); + DynStringConcat(result,"\": [ "); + DynStringConcat(result,char_arr); + DynStringConcat(result," ]}"); + if (char_arr != NULL ) free(char_arr); + break; + } + } + return protocol; +} + /*----------------------------------------------------------------------------------------*/ static int SICSNotifyCallback(void *userData, void *callData, pHdb node, hdbValue v){ @@ -141,51 +228,39 @@ static int SICSNotifyCallback(void *userData, void *callData, pHdb node, pDynString printedData = NULL; pDynString result = NULL; char *pPath = NULL; + Protocol protocol = normal_protocol; + int outCode; cbInfo = (HdbCBInfo *)userData; pPath = GetHipadabaPath(node); - switch (currFmtStyle) { - case cli: - printedData = formatClientValue(pPath,v,0); - break; - case json: - printedData = formatJSONValue(pPath,v,0); - break; - case plain: - default: - printedData = formatValue(v); - } result = CreateDynString(128,128); - if(pPath == NULL || printedData == NULL || result == NULL){ - SCWriteInContext(cbInfo->pCon,"ERROR: out of memory formatting data" , - eError,cbInfo->context); - /* - * no need to interrupt something because writing data to a client does - * not work - */ - return 1; - } - switch (currFmtStyle) { - case cli: - DynStringConcat(result,GetCharArray(printedData)); - break; - case json: - DynStringConcat(result,"{"); - DynStringConcat(result,GetCharArray(printedData)); - DynStringConcat(result,"}"); - break; - case plain: - default: - DynStringCopy(result,pPath); - DynStringConcat(result," = "); - DynStringConcat(result,GetCharArray(printedData)); - } + if ((protocol = isJSON(cbInfo->pCon)) == 1) + outCode = eHdbEvent; + else + outCode = eEvent; - SCWriteInContext(cbInfo->pCon,GetCharArray(result), - eHdb,cbInfo->context); + if(v.arrayLength < 100){ + printedData = formatValue(v); + if(pPath == NULL || printedData == NULL || result == NULL){ + SCWriteInContext(cbInfo->pCon,"ERROR: out of memory formatting data" , + eEvent,cbInfo->context); + /* + * no need to interrupt something because writing data to a client does + * not work + */ + return 1; + } + formatNameValue(protocol, pPath, GetCharArray(printedData), result, v.dataType); + SCWriteInContext(cbInfo->pCon,GetCharArray(result), + outCode,cbInfo->context); + DeleteDynString(printedData); + } else { + formatNameValue(protocol, pPath,"!!datachange!!", result, HIPTEXT); + SCWriteInContext(cbInfo->pCon,GetCharArray(result), + outCode,cbInfo->context); + } free(pPath); DeleteDynString(result); - DeleteDynString(printedData); return 1; } @@ -201,6 +276,43 @@ pHdbCallback MakeNotifyCallback(SConnection *pCon, int id){ cbInfo->context = SCGetContext(pCon); return MakeHipadabaCallback(SICSNotifyCallback, cbInfo,free,id,pCon->ident); } +/*-------------------------------------------------------------------------*/ +static int TreeChangeCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + char *path = NULL; + char buffer[1024]; + pDynString result = NULL; + Protocol protocol = normal_protocol; + int outCode; + + result = CreateDynString(128,128); + HdbCBInfo *cbInfo = (HdbCBInfo *)userData; + + if(cbInfo != NULL && cbInfo->pCon != NULL){ + path = GetHipadabaPath(node); + if ((protocol = isJSON(cbInfo->pCon)) == 1) + outCode = eHdbEvent; + else + outCode = eEvent; + formatNameValue(protocol, "treechange", path, result, v.dataType); + SCWriteInContext(cbInfo->pCon,GetCharArray(result),outCode,cbInfo->context); + DeleteDynString(result); + free(path); + } + return 1; +} +/*-------------------------------------------------------------------------*/ +pHdbCallback MakeTreeChangeCallback(SConnection *pCon, int id){ + HdbCBInfo *cbInfo = NULL; + + cbInfo = malloc(sizeof(HdbCBInfo)); + if(cbInfo == NULL){ + return NULL; + } + cbInfo->pCon = pCon; + cbInfo->context = SCGetContext(pCon); + return MakeHipadabaCallback(TreeChangeCallback, cbInfo,free,id,pCon->ident); +} /*----------------------------------------------------------------------------------------*/ static int SICSScriptWriteCallback(void *userData, void *callData, pHdb node, hdbValue v){ @@ -278,7 +390,7 @@ static int SICSScriptReadCallback(void *userData, void *callData, pHdb node, * something = anything * as well as a plain value alone */ - data = Tcl_GetStringResult(InterpGetTcl(pServ->pSics)); + data = (char *)Tcl_GetStringResult(InterpGetTcl(pServ->pSics)); if(data == NULL){ SCWrite(pCon,"ERROR: no result returned from script",eError); return 0; @@ -382,6 +494,117 @@ pHdbCallback MakeFloatRangeCallback(double min, double max){ return MakeHipadabaCallback(SICSFloatRangeCallback, range, free,-1,-1); } +/*-------------------------------------------------------------------------*/ +static int MemReadCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + float *value = NULL; + + value = (float *)userData; + if(value != NULL){ + v.dataType = HIPFLOAT; + v.v.doubleValue = (float) *value; + node->value.v.doubleValue = (double)*value; + } + return 1; +} +/*------------------------------------------------------------------------*/ +static int MemGenReadCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + switch(node->value.dataType){ + case HIPINT: + node->value.v.intValue = *(int *)userData; + break; + case HIPFLOAT: + node->value.v.doubleValue = *(double *)userData; + break; + case HIPTEXT: + if(node->value.v.text != NULL){ + free(node->value.v.text); + } + node->value.v.text = strdup((char *)userData); + break; + case HIPINTAR: + memcpy(&node->value.v.intArray,userData, + node->value.arrayLength *sizeof(int)); + break; + case HIPFLOATAR: + memcpy(&node->value.v.floatArray,userData, + node->value.arrayLength *sizeof(double)); + break; + default: + assert(0); + break; + } + return 1; +} +/*-------------------------------------------------------------------------*/ +pHdbCallback MakeMemGenReadCallback(void *address){ + return MakeHipadabaCallback(MemReadCallback, address, + NULL,-1,-1); +} +/*-------------------------------------------------------------------------*/ +pHdbCallback MakeMemReadCallback(float *address){ + return MakeHipadabaCallback(MemReadCallback, address, + NULL,-1,-1); +} +/*-------------------------------------------------------------------------*/ +static int MemSetCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + float *value = NULL; + + value = (float *)userData; + if(value != NULL){ + *value = (float)v.v.doubleValue; + } + UpdateHipadabaPar(node,v,callData); + return 1; +} +/*-------------------------------------------------------------------------*/ +static int MemGenSetCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + const char *pPtr = NULL; + + if(v.dataType != node->value.dataType){ + assert(0); + return 0; + } + + switch(node->value.dataType){ + case HIPINT: + memcpy(userData,&v.v.intValue,sizeof(int)); + break; + case HIPFLOAT: + memcpy(userData,&v.v.doubleValue,sizeof(double)); + break; + case HIPTEXT: + strncpy((char *)userData,(const char *)v.v.text, + node->value.arrayLength); + break; + case HIPINTAR: + memcpy(userData,&v.v.intArray,node->value.arrayLength*sizeof(int)); + break; + case HIPFLOATAR: + memcpy(userData,&v.v.floatArray, + node->value.arrayLength*sizeof(double)); + break; + default: + assert(0); + return 0; + break; + } + UpdateHipadabaPar(node,v,callData); + return 1; +} +/*-------------------------------------------------------------------------*/ +pHdbCallback MakeMemSetCallback(float *address){ + return MakeHipadabaCallback(MemSetCallback, address, + NULL,-1,-1); +} +/*-------------------------------------------------------------------------*/ +pHdbCallback MakeMemGenSetCallback(void *address){ + return MakeHipadabaCallback(MemSetCallback, address, + NULL,-1,-1); +} /*--------------------------------------------------------------------------*/ static void killHdbValue(void *pData){ hdbValue *v = NULL; @@ -414,7 +637,7 @@ static int SICSIntFixedCallback(void *userData, void *callData, pHdb node, return SICSCBBADFIXED; } /*---------------------------------------------------------------------------*/ -pHdbCallback MakeIntFixedCallback(long *data, int length){ +pHdbCallback MakeIntFixedCallback(int *data, int length){ pHdbCallback result = NULL; hdbValue *v = NULL; @@ -424,11 +647,11 @@ pHdbCallback MakeIntFixedCallback(long *data, int length){ } v->dataType = HIPINTAR; v->arrayLength = length; - v->v.intArray = malloc(length*sizeof(long)); + v->v.intArray = malloc(length*sizeof(int)); if(v->v.intArray == NULL){ return NULL; } - memcpy(v->v.intArray,data,length*sizeof(long)); + memcpy(v->v.intArray,data,length*sizeof(int)); return MakeHipadabaCallback(SICSIntFixedCallback, v, killHdbValue,-1,-1); } @@ -436,6 +659,7 @@ pHdbCallback MakeIntFixedCallback(long *data, int length){ pHdb MakeSICSHdbPar(char *name, int priv, hdbValue v){ pHdb result = NULL; pHdbCallback pHcb = NULL; + char pPriv[20]; result = MakeHipadabaNode(name,v.dataType,v.arrayLength); if(result == NULL){ @@ -445,20 +669,41 @@ pHdb MakeSICSHdbPar(char *name, int priv, hdbValue v){ pHcb = MakeCheckPermissionCallback(priv); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); pHcb = MakeSetUpdateCallback(); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); + switch(priv){ + case 0: + strcpy(pPriv,"internal"); + break; + case 1: + strcpy(pPriv,"manager"); + break; + case 2: + strcpy(pPriv,"user"); + break; + case 3: + strcpy(pPriv,"spy"); + break; + } + SetHdbProperty(result,"priv",pPriv); return result; } +/*---------------------------------------------------------------------------*/ +pHdb CreateSICSHdbPar(char *name, int priv, int dataType, + int length, void *data){ + return MakeSICSHdbPar(name,priv,makeHdbData(dataType, + length,data)); +} /*----------------------------------------------------------------------------*/ pHdb MakeSICSHdbDriv(char *name, int priv, void *sicsObject, int dataType){ pHdb result = NULL; @@ -471,21 +716,54 @@ pHdb MakeSICSHdbDriv(char *name, int priv, void *sicsObject, int dataType){ pHcb = MakeCheckPermissionCallback(priv); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); pHcb = MakeSICSDriveCallback(sicsObject); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); pHcb = MakeSICSReadDriveCallback(sicsObject); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); + return NULL; + } + AppendHipadabaCallback(result,HCBREAD,pHcb); + + return result; +} +/*---------------------------------------------------------------------------*/ +pHdb MakeSICSMemPar(char *name, int priv, float *address){ + pHdb result = NULL; + pHdbCallback pHcb = NULL; + + result = MakeHipadabaNode(name,HIPFLOAT,1); + if(result == NULL){ + return NULL; + } + + pHcb = MakeCheckPermissionCallback(priv); + if(pHcb == NULL){ + DeleteHipadabaNode(result,NULL); + return NULL; + } + AppendHipadabaCallback(result,HCBSET,pHcb); + + pHcb = MakeMemSetCallback(address); + if(pHcb == NULL){ + DeleteHipadabaNode(result,NULL); + return NULL; + } + AppendHipadabaCallback(result,HCBSET,pHcb); + + pHcb = MakeMemReadCallback(address); + if(pHcb == NULL){ + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBREAD,pHcb); @@ -505,7 +783,7 @@ pHdb MakeSICSROPar(char *name, hdbValue v){ pHcb = MakeReadOnlyCallback(); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); @@ -526,46 +804,59 @@ pHdb MakeSICSScriptPar(char *name, char *setScript, char *readScript, pHcb = MakeSICSWriteScriptCallback(setScript); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBSET,pHcb); pHcb = MakeSICSReadScriptCallback(readScript); if(pHcb == NULL){ - DeleteHipadabaNode(result); + DeleteHipadabaNode(result,NULL); return NULL; } AppendHipadabaCallback(result,HCBREAD,pHcb); /** * put into the list of nodes to check with the update task */ - LLDnodeAppend(scriptUpdate,&result); - + /* LLDnodeAppend(scriptUpdate,&result); */ + return result; } +/*-------------------------------------------------------------------------*/ +pHdb CreateSICSScriptPar(char *name, char *setScript, char *readScript, + int dataType, int length, void *data){ + return MakeSICSScriptPar(name,setScript,readScript, + makeHdbData(dataType, length,data)); +} /*--------------------------------------------------------------------------*/ static void removeNodeFromUpdateList(pHdb node){ pHdb current = NULL; int status; + char *objName = NULL; - status = LLDnodePtr2First(scriptUpdate); - while(status != 0){ - current = LLDnodePtr(scriptUpdate); - if(current == node){ - LLDnodeDelete(scriptUpdate); - return; - } - status = LLDnodePtr2Next(scriptUpdate); + objName = GetHipadabaPath(node); + if(objName != NULL){ + removePollObject(poller, objName); + free(objName); } } /*-----------------------------------------------------------------------*/ static void SICSDeleteNodeData(pHdb node){ pHdb tmp = NULL; - + if(node == NULL){ return; } + + removeNodeFromUpdateList(node); + while(node->child != NULL){ + tmp = node->child; + node->child = node->child->next; + SICSDeleteNodeData(tmp); + } + if(node->properties != NULL){ + DeleteStringDict(node->properties); + } DeleteCallbackChain(node->writeCallbacks); DeleteCallbackChain(node->updateCallbacks); DeleteCallbackChain(node->readCallbacks); @@ -576,35 +867,100 @@ static void SICSDeleteNodeData(pHdb node){ ReleaseHdbValue(&node->value); node->magic = 000000; - while(node->child != NULL){ - tmp = node->child; - node->child = node->child->next; - SICSDeleteNodeData(tmp); - } - removeNodeFromUpdateList(node); free(node); } /*--------------------------------------------------------------------------*/ -void RemoveSICSPar(pHdb node){ +void RemoveSICSPar(pHdb node, void *callData){ pHdb current = NULL, tmp = NULL; if(node == NULL){ return; } - RemoveHdbNodeFromParent(node); + RemoveHdbNodeFromParent(node,NULL); SICSDeleteNodeData(node); } +/*===================== add functions =======================================*/ +int AddSICSHdbPar(pHdb node, char *name, int priv, hdbValue v){ + pHdb child = NULL; + + child = MakeSICSHdbPar(name,priv,v); + if(child == NULL){ + return 0; + } + AddHipadabaChild(node,child,NULL); + return 1; +} +/*---------------------------------------------------------------------------*/ +int AddSICSHdbROPar(pHdb node, char *name, hdbValue v){ + pHdb child = NULL; + + child = MakeSICSROPar(name,v); + if(child == NULL){ + return 0; + } + AddHipadabaChild(node,child,NULL); + return 1; +} +/*--------------------------------------------------------------------------*/ +int AddSICSHdbMemPar(pHdb node, char *name, int priv, + void *data, int datalength, int type, int length){ + pHdb child = NULL; + pHdbCallback pHcb = NULL; + + if(type == HIPINTVARAR || type == HIPFLOATVARAR){ + assert(0); + return 0; + } + + child = MakeHipadabaNode(name,type,length); + if(child == NULL){ + return 0; + } + + pHcb = MakeCheckPermissionCallback(priv); + if(pHcb == NULL){ + DeleteHipadabaNode(child,NULL); + return 0; + } + AppendHipadabaCallback(child,HCBSET,pHcb); + + pHcb = MakeMemGenSetCallback(data); + if(pHcb == NULL){ + DeleteHipadabaNode(child,NULL); + return 0; + } + AppendHipadabaCallback(child,HCBSET,pHcb); + + pHcb = MakeMemGenReadCallback(data); + if(pHcb == NULL){ + DeleteHipadabaNode(child,NULL); + return 0; + } + AppendHipadabaCallback(child,HCBREAD,pHcb); + AddHipadabaChild(node,child,NULL); + + return 1; +} /*==================== access suport functions ==============================*/ -int SICSHdbGetFloat(pHdb parent, SConnection *pCon, - char *path, float *value){ - hdbValue v; +int SICSHdbGetPar(void *obj, SConnection *pCon, + char *path, int dataType, void *data, int length){ pHdb par = NULL; int status; char buffer[256]; + pDummy pDum; - par = GetHipadabaNode(parent,path); + pDum = (pDummy)obj; + if(pDum == NULL || pDum->pDescriptor->parNode == NULL){ + if(pCon != NULL){ + snprintf(buffer,255,"ERROR: parameter %s not found", path); + SCWrite(pCon,buffer,eError); + } + return SICSNOPAR; + } + + par = GetHipadabaNode(pDum->pDescriptor->parNode,path); if(par == NULL){ if(pCon != NULL){ snprintf(buffer,255,"ERROR: parameter %s not found", path); @@ -613,31 +969,31 @@ int SICSHdbGetFloat(pHdb parent, SConnection *pCon, return SICSNOPAR; } - status = GetHipadabaPar(par,&v,pCon); + status = GetHdbPar(par,dataType,data,length,pCon); if(status < 0){ return status; } - if(v.dataType == HIPFLOAT){ - *value = (float)v.v.doubleValue; - } else if(v.dataType == HIPINT){ - *value = (float)v.v.intValue; - } else { - /* - * it is an error to call this for array dada types - */ - assert(0); - } return 1; } /*--------------------------------------------------------------------------*/ -int SICSHdbSetFloat(pHdb parent, SConnection *pCon, - char *path, float value){ +int SICSHdbUpdatePar(void *obj, SConnection *pCon, + char *path, int dataType,void *data, int dataLength ){ hdbValue v; pHdb par = NULL; int status; char buffer[256]; + pDummy pDum; - par = GetHipadabaNode(parent,path); + pDum = (pDummy)obj; + if(pDum == NULL || pDum->pDescriptor->parNode == NULL){ + if(pCon != NULL){ + snprintf(buffer,255,"ERROR: parameter %s not found", path); + SCWrite(pCon,buffer,eError); + } + return SICSNOPAR; + } + + par = GetHipadabaNode(pDum->pDescriptor->parNode,path); if(par == NULL){ if(pCon != NULL){ snprintf(buffer,255,"ERROR: parameter %s not found", path); @@ -645,37 +1001,60 @@ int SICSHdbSetFloat(pHdb parent, SConnection *pCon, } return SICSNOPAR; } - - v.dataType = par->value.dataType; - if(v.dataType == HIPFLOAT){ - v.v.doubleValue = (double)value; - } else if(v.dataType == HIPINT){ - v.v.intValue = (long)value; - } else { - /* - * it is an error to call this for array dada types - */ - assert(0); - } - status = SetHipadabaPar(par,v,pCon); + status = UpdateHdbPar(par,dataType,data,dataLength,pCon); + if(status < 0){ + return status; + } + return 1; +} +/*--------------------------------------------------------------------------*/ +int SICSHdbSetPar(void *obj, SConnection *pCon, + char *path, int dataType,void *data, int dataLength ){ + hdbValue v; + pHdb par = NULL; + int status; + char buffer[256]; + pDummy pDum; + + pDum = (pDummy)obj; + if(pDum == NULL || pDum->pDescriptor->parNode == NULL){ + if(pCon != NULL){ + snprintf(buffer,255,"ERROR: parameter %s not found", path); + SCWrite(pCon,buffer,eError); + } + return SICSNOPAR; + } + + par = GetHipadabaNode(pDum->pDescriptor->parNode,path); + if(par == NULL){ + if(pCon != NULL){ + snprintf(buffer,255,"ERROR: parameter %s not found", path); + SCWrite(pCon,buffer,eError); + } + return SICSNOPAR; + } + + status = SetHdbPar(par,dataType,data,dataLength,pCon); if(status < 0){ return status; } return 1; } - /*---------------------------------------------------------------------------*/ int InstallSICSNotify(pHdb node, SConnection *pCon, int id, int recurse){ pHdb currentChild = NULL; pHdbCallback noty = NULL; + pHdbCallback treeChange = NULL; + treeChange = MakeTreeChangeCallback(pCon,id); noty = MakeNotifyCallback(pCon,id); - if(noty == NULL){ + if(noty == NULL || treeChange == NULL){ SCWrite(pCon,"ERROR: out of memory installing callback", eError); return 0; } AppendHipadabaCallback(node, HCBUPDATE, noty); + AppendHipadabaCallback(node, HCBTREE, treeChange); if(recurse == 1){ currentChild = node->child; @@ -698,7 +1077,7 @@ int ProcessSICSHdbPar(pHdb root, SConnection *pCon, assert(root != NULL && pCon != NULL); if(argc < 1){ - SCWrite(pCon,"ERROR: nor parameter to treat specified",eError); + SCWrite(pCon,"ERROR: no parameter to treat specified",eError); return -1; } @@ -735,6 +1114,10 @@ int ProcessSICSHdbPar(pHdb root, SConnection *pCon, DeleteDynString(parData); status = SetHipadabaPar(parNode,input,pCon); ReleaseHdbValue(&input); + if(status == 1){ + SCSendOK(pCon); + SCparChange(pCon); + } return status; } else { /* @@ -754,64 +1137,68 @@ int ProcessSICSHdbPar(pHdb root, SConnection *pCon, if(printPrefix != NULL){ DynStringInsert(parData,printPrefix,0); } - SCWrite(pCon,GetCharArray(parData),eHdb); + SCWrite(pCon,GetCharArray(parData),eValue); DeleteDynString(parData); ReleaseHdbValue(&input); return 1; } } -/*---------------------------------------------------------------------------*/ -int SICSHipadabaTask(void *pData){ - pHdbUpdateTask self = NULL; - hdbValue old, newValue; - pHdb currentNode = NULL; - int status; +/*--------------------------------------------------------------------------*/ +void PrintSICSParList(pHdb node, SConnection *pCon, char *prefix){ + char childPrefix[1024]; + pHdb child = NULL; + pDynString value = NULL; + hdbValue v; - self = (pHdbUpdateTask)pData; - assert(self != NULL); - - if(self->iEnd == 1){ - return 0; - } - if(LLDcheck(self->updateList) == LIST_EMPTY){ - return 1; - } - memset(&old,0,sizeof(hdbValue)); - memset(&newValue,0,sizeof(hdbValue)); - - currentNode = (pHdb)LLDnodePtr(self->updateList); - - if(currentNode != NULL){ - old.dataType = currentNode->value.dataType; - copyHdbValue(¤tNode->value,&old); - if(GetHipadabaPar(currentNode,&newValue, self->pCon) == 1){ - if(!compareHdbValue(old,newValue)){ - UpdateHipadabaPar(currentNode,newValue,self->pCon); + child = node->child; + while(child != NULL){ + if(child->value.dataType != HIPNONE){ + GetHipadabaPar(child,&v,pCon); + value = formatValue(child->value); + if(value != NULL){ + SCPrintf(pCon,eValue,"%s%s = %s", prefix, child->name, + GetCharArray(value)); + DeleteDynString(value); } - } - ReleaseHdbValue(&old); - ReleaseHdbValue(&newValue); - - } - status = LLDnodePtr2Next(self->updateList); - if(status == 0){ - LLDnodePtr2First(self->updateList); + } + if(child->child != NULL){ + strncpy(childPrefix,prefix,1024); + strncat(childPrefix,child->name, 1024); + strncat(childPrefix,"/",1024); + PrintSICSParList(child, pCon,prefix); + } + child = child->next; } - - return 1; } /*---------------------------------------------------------------------------*/ -void SICSHipadabaSignal(void *pData, int iSignal, void *pSigData){ - pHdbUpdateTask self = NULL; - int *iInt; +void SaveSICSHipadaba(FILE *fd, pHdb node, char *prefix){ + pHdb currentChild = NULL; + pDynString data = NULL; + hdbValue v; - self = (pHdbUpdateTask)pData; - - if(iSignal == SICSINT){ - iInt = (int *)pSigData; - if(*iInt == eEndServer){ - self->iEnd = 1; - } + currentChild = node->child; + while(currentChild != NULL){ + if(currentChild->value.dataType != HIPNONE && !isSICSHdbRO(currentChild)){ + data = formatValue(currentChild->value); + if(data != NULL){ + fprintf(fd,"%s%s %s\n", prefix, currentChild->name, GetCharArray(data)); + DeleteDynString(data); + } + } + if(currentChild->child != NULL){ + /* + * build a new prefix string and recurse + */ + data = CreateDynString(64,64); + if(data != NULL){ + DynStringCopy(data,prefix); + DynStringConcat(data,currentChild->name); + DynStringConcat(data,"/"); + SaveSICSHipadaba(fd,currentChild,GetCharArray(data)); + DeleteDynString(data); + } + } + currentChild = currentChild->next; } } /*================ value helpers ============================================*/ @@ -828,7 +1215,7 @@ pDynString formatValue(hdbValue v){ case HIPNONE: break; case HIPINT: - snprintf(number,30,"%ld", v.v.intValue); + snprintf(number,30,"%d", v.v.intValue); DynStringCopy(result,number); break; case HIPFLOAT: @@ -841,7 +1228,7 @@ pDynString formatValue(hdbValue v){ case HIPINTAR: case HIPINTVARAR: for(i = 0; i < v.arrayLength; i++){ - snprintf(number,30," %ld", v.v.intArray[i]); + snprintf(number,30," %d", v.v.intArray[i]); DynStringConcat(result,number); } break; @@ -881,8 +1268,10 @@ static char *getNextHdbNumber(char *pStart, char pNumber[80]){ static int adjustDataLength(hdbValue *v, char *data){ char number[80]; int count = 0; + char *pPtr = NULL; - while(getNextHdbNumber(data,number) != NULL){ + pPtr = data; + while((pPtr = getNextHdbNumber(pPtr,number)) != NULL){ count++; } if(count != v->arrayLength){ @@ -891,11 +1280,11 @@ static int adjustDataLength(hdbValue *v, char *data){ if(v->v.intArray != NULL){ free(v->v.intArray); } - v->v.intArray = malloc(count*sizeof(long)); + v->v.intArray = malloc(count*sizeof(int)); if(v->v.intArray == NULL){ return 0; } - memset(v->v.intArray,0,count*sizeof(long)); + memset(v->v.intArray,0,count*sizeof(int)); } if(v->dataType == HIPFLOATVARAR){ if(v->v.floatArray != NULL){ @@ -913,7 +1302,7 @@ static int adjustDataLength(hdbValue *v, char *data){ /*---------------------------------------------------------------------------------*/ int readHdbValue(hdbValue *v, char *data, char *error, int errlen){ int i, status; - long lValue; + int lValue; double dValue; char number[80]; char *pPtr = NULL; @@ -923,7 +1312,7 @@ int readHdbValue(hdbValue *v, char *data, char *error, int errlen){ break; case HIPINT: getNextHdbNumber(data,number); - status = sscanf(number,"%ld", &v->v.intValue); + status = sscanf(number,"%d", &v->v.intValue); if(status != 1){ snprintf(error,errlen,"Failed to convert %s to integer", data); @@ -958,7 +1347,7 @@ int readHdbValue(hdbValue *v, char *data, char *error, int errlen){ i); return 0; } - status = sscanf(number,"%ld", &lValue); + status = sscanf(number,"%d", &lValue); if(status != 1){ snprintf(error,errlen,"Failed to convert %s to integer", data); @@ -1027,125 +1416,6 @@ static int convertHdbType(char *text){ static char *hdbTypeToText(int type){ return hdbTypes[type+1]; } -/*-------------------------------------------------------------------------*/ -pDynString formatJSONValue(char *name, hdbValue hVal, int children) { - pDynString result = NULL; - int i,length; - char number[50]; - - result = CreateDynString(128,128); - if(result == NULL){ - return NULL; - } - - DynStringConcat(result,"\""); - DynStringConcat(result,name); - DynStringConcat(result,"\""); - if (hVal.dataType != HIPNONE) - DynStringConcat(result,":"); - switch(hVal.dataType){ - case HIPNONE: - break; - case HIPINT: - snprintf(number,50,"%ld",hVal.v.intValue); - DynStringConcat(result,number); - break; - case HIPFLOAT: - snprintf(number,50,"%lf",hVal.v.doubleValue); - DynStringConcat(result,number); - break; - case HIPTEXT: - DynStringConcat(result,hVal.v.text); - break; - case HIPINTAR: - case HIPINTVARAR: - for(i = 0; i < length; i++){ - snprintf(number,50,"%ld",hVal.v.intArray[i]); - DynStringConcat(result,number); - if(i > length -1){ - DynStringConcat(result,","); - } - } - break; - case HIPFLOATAR: - case HIPFLOATVARAR: - DynStringConcat(result,"["); - for(i = 0; i < length; i++){ - snprintf(number,50,"%lf",hVal.v.floatArray[i]); - DynStringConcat(result,number); - if(i > length -1){ - DynStringConcat(result,","); - } - DynStringConcat(result,"]"); - } - break; - } - return result; -} -/*-------------------------------------------------------------------------*/ -pDynString formatClientValue(char *name, hdbValue hVal, int children) { - pDynString result = NULL; - int i,length; - char number[50]; - - result = CreateDynString(128,128); - if(result == NULL){ - return NULL; - } - - DynStringConcat(result,name); - DynStringConcat(result,","); - DynStringConcat(result,hdbTypeToText(hVal.dataType)); - DynStringConcat(result,","); - snprintf(number,50,"%d",children); - DynStringConcat(result,number); - DynStringConcat(result,","); - if(hVal.dataType >= 3){ - length = hVal.arrayLength; - } else { - length = 1; - } - snprintf(number,50,"%d",length); - DynStringConcat(result,number); - DynStringConcat(result,","); - switch(hVal.dataType){ - case HIPNONE: - break; - case HIPINT: - snprintf(number,50,"%ld",hVal.v.intValue); - DynStringConcat(result,number); - break; - case HIPFLOAT: - snprintf(number,50,"%lf",hVal.v.doubleValue); - DynStringConcat(result,number); - break; - case HIPTEXT: - DynStringConcat(result,hVal.v.text); - break; - case HIPINTAR: - case HIPINTVARAR: - for(i = 0; i < length; i++){ - snprintf(number,50,"%ld",hVal.v.intArray[i]); - DynStringConcat(result,number); - if(i > length -1){ - DynStringConcat(result,","); - } - } - break; - case HIPFLOATAR: - case HIPFLOATVARAR: - for(i = 0; i < length; i++){ - snprintf(number,50,"%lf",hVal.v.floatArray[i]); - DynStringConcat(result,number); - if(i > length -1){ - DynStringConcat(result,","); - } - } - break; - } - DynStringConcat(result,"\n"); - return result; -} /*--------------------------------------------------------------------------*/ static int MakeHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ @@ -1153,6 +1423,7 @@ static int MakeHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, char *pPtr = NULL; pHdb parent = NULL; pHdb child = NULL; + char buffer[512], buffer2[512]; if(!SCMatchRights(pCon,usMugger)){ return 0; @@ -1189,7 +1460,8 @@ static int MakeHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, } /* split off last path element */ - pPtr = strrchr(argv[1],'/'); + strncpy(buffer,argv[1],511); + pPtr = strrchr(buffer,'/'); if(pPtr == NULL){ SCWrite(pCon,"ERROR: invalid path specification", eError); @@ -1200,10 +1472,12 @@ static int MakeHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, if(strlen(pPtr) < 1) { parent = root; } else { - parent = GetHipadabaNode(root,argv[1]); + parent = GetHipadabaNode(root,buffer); } if(parent == NULL){ - SCWrite(pCon,"ERROR: parent for new node does not exist",eError); + snprintf(buffer2,512,"ERROR: parent %s for new node does not exist", + buffer); + SCWrite(pCon,buffer2,eError); return 0; } if(type != HIPNONE){ @@ -1216,7 +1490,7 @@ static int MakeHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, return 0; } - AddHipadabaChild(parent,child); + AddHipadabaChild(parent,child,pCon); SCSendOK(pCon); return 1; } @@ -1228,6 +1502,10 @@ static int MakeHdbScriptNode(SConnection *pCon, SicsInterp *pSics, void *pData, pHdb parent = NULL; pHdb child = NULL; pHdb current = NULL; + char *urgv[] = {"5", NULL}; + char driver[] = {"hdb"}; + char buffer[512], buffer2[512]; + if(!SCMatchRights(pCon,usMugger)){ return 0; @@ -1260,7 +1538,8 @@ static int MakeHdbScriptNode(SConnection *pCon, SicsInterp *pSics, void *pData, } /* split off last path element */ - pPtr = strrchr(argv[1],'/'); + strncpy(buffer,argv[1],511); + pPtr = strrchr(buffer,'/'); if(pPtr == NULL){ SCWrite(pCon,"ERROR: invalid path specification", eError); @@ -1271,10 +1550,12 @@ static int MakeHdbScriptNode(SConnection *pCon, SicsInterp *pSics, void *pData, if(strlen(pPtr) < 1) { parent = root; } else { - parent = GetHipadabaNode(root,argv[1]); + parent = GetHipadabaNode(root,buffer); } if(parent == NULL){ - SCWrite(pCon,"ERROR: parent for new node does not exist",eError); + snprintf(buffer2,512,"ERROR: parent %s for new node does not exist", + buffer); + SCWrite(pCon,buffer2,eError); return 0; } child = MakeSICSScriptPar(pPtr, argv[3], argv[2], @@ -1284,11 +1565,32 @@ static int MakeHdbScriptNode(SConnection *pCon, SicsInterp *pSics, void *pData, return 0; } - AddHipadabaChild(parent,child); + AddHipadabaChild(parent,child,pCon); + /* + * have it polled automatically + */ + addPollObject(poller,pCon, GetHipadabaPath(child),driver,1,urgv); + SCSendOK(pCon); return 1; } - +/*------------------------------------------------------------------------------*/ +static int isNodeProtected(pHdb node){ + pHdb current = NULL; + + if(node->protected == 1){ + return 1; + } + current = node->child; + while(current != NULL){ + if(isNodeProtected(current)){ + return 1; + } + current = current->next; + } + + return 0; +} /*-----------------------------------------------------------------------------------------*/ static int DeleteHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ @@ -1307,7 +1609,13 @@ static int DeleteHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, SCWrite(pCon,"ERROR: node to delete not found",eError); return 0; } - RemoveSICSPar(killNode); + if(isNodeProtected(killNode)){ + SCWrite(pCon,"ERROR: this node or one of its children is protected", + eError); + return 0; + } + + RemoveSICSPar(killNode, pCon); SCSendOK(pCon); return 1; } @@ -1401,49 +1709,239 @@ static int SetHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, } return status; } +/*---------------------------------------------------------------------------*/ +static int UpdateHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + hdbValue newValue; + pDynString parData = NULL; + char error[512]; + int i, status; + + if(!SCMatchRights(pCon,usUser)){ + return 0; + } + + if(argc < 2) { + SCWrite(pCon,"ERROR: insufficient number of arguments to UpdateHdbNode", + eError); + return 0; + } + + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + return 0; + } + if(argc > 2){ + if(!cloneHdbValue(&targetNode->value,&newValue)){ + SCWrite(pCon,"ERROR: out of mmeory cloning node", + eError); + return 0; + } + parData = CreateDynString(64,64); + if(parData == NULL){ + SCWrite(pCon,"ERROR: out of memory reading parameter",eError); + return 0; + } + for(i = 2; i < argc; i++){ + DynStringConcat(parData," "); + DynStringConcat(parData, argv[i]); + } + strcpy(error,"ERROR: "); + if(!readHdbValue(&newValue, GetCharArray(parData), + error+7,512-7)){ + SCWrite(pCon,error, eError); + return 0; + } + } else { + GetHipadabaPar(targetNode,&newValue,pCon); + } + status = UpdateHipadabaPar(targetNode,newValue,pCon); + ReleaseHdbValue(&newValue); + if(status == 1){ + SCSendOK(pCon); + } + return status; +} /*-----------------------------------------------------------------------------*/ static int GetHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ pHdb targetNode = NULL; hdbValue newValue; - pDynString parData = NULL; + pDynString parData = NULL, result = NULL; char error[512], oriPath[512];; int i, status; - int pathArg = 1; - char *usage ="ERROR: Requires argument"; + Protocol protocol = normal_protocol; + int outCode; - switch (argc) { - case 2: - pathArg = 1; - break; - default: - SCWrite(pCon,usage,eError); + if(argc < 2) { + SCWrite(pCon,"ERROR: need path to node to print",eError); return 0; - break; } - strncpy(oriPath,argv[pathArg], 511); - targetNode = locateSICSNode(pSics,pCon,argv[pathArg]); + strncpy(oriPath,argv[1], 511); + targetNode = locateSICSNode(pSics,pCon,argv[1]); if(targetNode == NULL){ return 0; } memset(&newValue,0,sizeof(hdbValue)); GetHipadabaPar(targetNode, &newValue, pCon); - parData = formatJSONValue(oriPath,newValue,0); - + parData = formatValue(newValue); if(parData == NULL){ SCWrite(pCon,"ERROR: out of memory formatting data",eError); return 0; } + if ((protocol = isJSON(pCon)) == 1) + outCode = eHdbEvent; + else + outCode = eEvent; - DynStringInsert(parData,"{", 0); - DynStringConcat(parData,"}"); - SCWrite(pCon,GetCharArray(parData),eHdb); + result = CreateDynString(128,128); + formatNameValue(protocol, oriPath, GetCharArray(parData), result, newValue.dataType); + SCWrite(pCon,GetCharArray(result),outCode); + DeleteDynString(parData); + DeleteDynString(result); + ReleaseHdbValue(&newValue); + + return 1; +} +/*-----------------------------------------------------------------------------*/ +static int ZipGetHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + hdbValue newValue; + char error[512], oriPath[512]; + int i, status; + int *iData = NULL; + + if(argc < 2) { + SCWrite(pCon,"ERROR: need path to node",eError); + return 0; + } + + strncpy(oriPath,argv[1], 511); + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + return 0; + } + memset(&newValue,0,sizeof(hdbValue)); + GetHipadabaPar(targetNode, &newValue, pCon); + switch(newValue.dataType){ + case HIPINTAR: + case HIPINTVARAR: + for(i = 0; i < newValue.arrayLength; i++){ + newValue.v.intArray[i] = htonl(newValue.v.intArray[i]); + } + SCWriteZipped(pCon,oriPath, newValue.v.intArray, + newValue.arrayLength*sizeof(int)); + break; + case HIPFLOATAR: + case HIPFLOATVARAR: + iData = (int *)malloc(newValue.arrayLength*sizeof(int)); + if(iData == NULL){ + SCWrite(pCon,"ERROR: out of memory in ZipGetHdbNode",eError); + return 0; + } + memset(iData,0,newValue.arrayLength*sizeof(int)); + for(i = 0; i < newValue.arrayLength; i++){ + iData[i] = htonl((int)newValue.v.floatArray[i]*65536.); + } + SCWriteZipped(pCon,oriPath, iData, + newValue.arrayLength*sizeof(int)); + free(iData); + break; + default: + SCWrite(pCon,"ERROR: zipped writing not supported for this datatype", + eError); + return 0; + } + ReleaseHdbValue(&newValue); + return 1; +} +/*--------------------------------------------------------------------------*/ +static int countChildren(pHdb node){ + pHdb current = NULL; + int count = 0; + + current = node->child; + while(current != NULL){ + count++; + current = current->next; + } + return count; +} +/*---------------------------------------------------------------------------*/ +static int HdbNodeInfo(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + char error[512], oriPath[512], info[512]; + int i, status, length; + + if(argc < 2) { + SCWrite(pCon,"ERROR: need path to node to get info",eError); + return 0; + } + + strncpy(oriPath,argv[1], 511); + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + return 0; + } + length = targetNode->value.arrayLength; + if(length == 0){ + length = 1; + } + snprintf(info,511,"%s,%d,%d",hdbTypeToText(targetNode->value.dataType), + countChildren(targetNode), length); + SCWrite(pCon,info,eValue); + + return 1; +} +/*---------------------------------------------------------------------------*/ +static int HdbNodeVal(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + hdbValue newValue; + pDynString parData = NULL; + char error[512]; + int i, status; + + if(argc < 2) { + SCWrite(pCon,"ERROR: need path to node to print",eError); + return 0; + } + + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + return 0; + } + memset(&newValue,0,sizeof(hdbValue)); + GetHipadabaPar(targetNode, &newValue, pCon); + parData = formatValue(newValue); + if(parData == NULL){ + SCWrite(pCon,"ERROR: out of memory formatting data",eError); + return 0; + } + SCWrite(pCon,GetCharArray(parData),eHdbValue); DeleteDynString(parData); ReleaseHdbValue(&newValue); return 1; } + +/*---------------------------------------------------------------------------*/ +int isSICSHdbRO(pHdb node){ + pHdbCallback current = NULL; + + current = node->writeCallbacks; + while(current != NULL){ + if(current->userCallback == SICSReadOnlyCallback) { + return 1; + } + current = current->next; + } + return 0; +} /*---------------------------------------------------------------------------*/ static pDynString formatPlainList(pHdb node){ pHdb current; @@ -1463,6 +1961,47 @@ static pDynString formatPlainList(pHdb node){ return result; } /*---------------------------------------------------------------------------*/ +static pDynString formatJSONList(pHdb node){ + pHdb current; + pDynString result = NULL; + pDynString data = NULL; + + if (node->child == NULL) return NULL; + result = CreateDynString(128,128); + if(result == NULL){ + return NULL; + } + + if(node->child->value.dataType == HIPNONE) + DynStringCopy(result,"["); + else + DynStringCopy(result,"{"); + + current = node->child; + while(current != NULL){ + DynStringConcat(result,"\""); + DynStringConcat(result,current->name); + DynStringConcat(result,"\""); + if(current->value.dataType != HIPNONE){ + data = formatValue(current->value); + if(data != NULL){ + DynStringConcat(result,": "); + DynStringConcat(result,GetCharArray(data)); + DeleteDynString(data); + } + } + if (current->next != NULL) DynStringConcat(result,", "); + current = current->next; + } + + if(node->child->value.dataType == HIPNONE) + DynStringConcat(result,"]"); + else + DynStringConcat(result,"}"); + + return result; +} +/*---------------------------------------------------------------------------*/ static pDynString formatListWithVal(pHdb node){ pHdb current; pDynString result = NULL; @@ -1475,30 +2014,20 @@ static pDynString formatListWithVal(pHdb node){ current = node->child; while(current != NULL){ - DynStringConcat(result,current->name); - data = formatValue(current->value); - if(data != NULL){ - DynStringConcat(result," = "); - DynStringConcat(result,GetCharArray(data)); - DeleteDynString(data); + if(current->value.dataType != HIPNONE){ + DynStringConcat(result,current->name); + data = formatValue(current->value); + if(data != NULL){ + DynStringConcat(result," = "); + DynStringConcat(result,GetCharArray(data)); + DeleteDynString(data); + } + DynStringConcat(result,"\n"); } - DynStringConcat(result,"\n"); current = current->next; } return result; } -/*--------------------------------------------------------------------------*/ -static int countChildren(pHdb node){ - pHdb current = NULL; - int count = 0; - - current = node->child; - while(current != NULL){ - count++; - current = current->next; - } - return count; -} /*---------------------------------------------------------------------------*/ static pDynString formatClientList(pHdb node){ pHdb current; @@ -1533,7 +2062,7 @@ static pDynString formatClientList(pHdb node){ case HIPNONE: break; case HIPINT: - snprintf(number,50,"%ld",current->value.v.intValue); + snprintf(number,50,"%d",current->value.v.intValue); DynStringConcat(result,number); break; case HIPFLOAT: @@ -1546,7 +2075,7 @@ static pDynString formatClientList(pHdb node){ case HIPINTAR: case HIPINTVARAR: for(i = 0; i < length; i++){ - snprintf(number,50,"%ld",current->value.v.intArray[i]); + snprintf(number,50,"%d",current->value.v.intArray[i]); DynStringConcat(result,number); if(i > length -1){ DynStringConcat(result,","); @@ -1570,50 +2099,25 @@ static pDynString formatClientList(pHdb node){ return result; } /*---------------------------------------------------------------------------*/ -static pDynString formatJSONList(pHdb node){ - pHdb current; - pDynString result = NULL; - int length; - int i; - char number[50]; - - result = CreateDynString(128,128); - if(result == NULL){ - return NULL; - } - - current = node->child; - while(current != NULL){ - DynStringConcat(result, GetCharArray(formatJSONValue(current->name,current->value,0))); - if (current->next != NULL) - DynStringConcat(result, ","); - current = current->next; - } - if (node->child->value.dataType == HIPNONE) { - DynStringInsert(result,"[", 0); - DynStringConcat(result,"]"); - } else { - DynStringInsert(result,"{", 0); - DynStringConcat(result,"}"); - } - return result; -} -/*---------------------------------------------------------------------------*/ static int ListHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ pHdb node = NULL; - pDynString listData = NULL; int pathArg = 1; - char *usage ="ERROR: Requires argument"; - - switch (argc) { - case 2: - pathArg = 1; - break; - default: - SCWrite(pCon,usage,eError); + pDynString listData = NULL; + Protocol protocol = normal_protocol; + int outCode; + + if(argc < 2) { + SCWrite(pCon,"ERROR: need path to node to print",eError); return 0; - break; + } + + if(strchr(argv[1],'-') != NULL){ + pathArg = 2; + if(argc < 3){ + SCWrite(pCon,"ERROR: need path to node to print",eError); + return 0; + } } node = locateSICSNode(pSics,pCon,argv[pathArg]); @@ -1621,53 +2125,53 @@ static int ListHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, return 0; } - strtolower(argv[pathArg]); - listData = formatJSONList(node); + if(pathArg == 2) { + strtolower(argv[1]); + } + if(strcmp(argv[1],"-val") == 0){ + listData = formatListWithVal(node); + } else if(strcmp(argv[1],"-cli") == 0){ + listData = formatClientList(node); + } else { + if ((protocol = isJSON(pCon)) == 1) { + listData = formatJSONList(node); + outCode = eHdbEvent; + } else { + listData = formatPlainList(node); + outCode = eEvent; + } + } if(listData == NULL){ SCWrite(pCon,"ERROR: failed to format list", eError); return 0; } - SCWrite(pCon,GetCharArray(listData),eHdb); + if( (strcmp(argv[1],"-val") == 0) || (strcmp(argv[1],"-cli") == 0) ){ + SCWrite(pCon,GetCharArray(listData),eValue); + } else { + SCWrite(pCon,GetCharArray(listData),outCode); + } DeleteDynString(listData); return 1; } /*---------------------------------------------------------------------------*/ -static int setFormatStyle(SConnection *pCon, SicsInterp *pSics, void *pData, - int argc, char *argv[]) { - if(strcmp(argv[1],formatName[json]) == 0){ - currFmtStyle = json; - } else if(strcmp(argv[1],formatName[cli]) == 0){ - currFmtStyle = cli; - } else if(strcmp(argv[1],formatName[plain]) == 0){ - currFmtStyle = plain; - } -} -/*---------------------------------------------------------------------------*/ static int AutoNotifyHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ pHdb node = NULL; int id, status; - int pathArg = 1, idArg=2; - char *usage ="ERROR:valid arguments are "; - - switch (argc) { - case 3: - pathArg = 1; - idArg = 2; - break; - default: - SCWrite(pCon,usage,eError); - return 0; - break; - } - node = locateSICSNode(pSics,pCon,argv[pathArg]); + if(argc < 3) { + SCWrite(pCon,"ERROR: need path and id in order to add notify", + eError); + return 0; + } + + node = locateSICSNode(pSics,pCon,argv[1]); if(node == NULL){ return 0; } - id = atoi(argv[idArg]); + id = atoi(argv[2]); status = InstallSICSNotify(node, pCon, id, 1); if(status == 1){ @@ -1692,47 +2196,342 @@ static int RemoveHdbCallback(SConnection *pCon, SicsInterp *pSics, void *pData, return 1; } /*---------------------------------------------------------------------------*/ +static int LinkHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb node = NULL; + char buffer[256]; + CommandList *pCom = NULL; + pDummy pDum = NULL; + + + if(argc < 3) { + SCWrite(pCon,"ERROR: need path and object name to link", + eError); + return 0; + } + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + node = GetHipadabaNode(root,argv[1]); + if(node == NULL){ + snprintf(buffer,255,"ERROR: path %s NOT found!", argv[1]); + SCWrite(pCon,buffer,eError); + return 0; + } + + pCom = FindCommand(pSics,argv[2]); + if(pCom == NULL){ + snprintf(buffer,255,"ERROR: failed to find object %s", argv[2]); + SCWrite(pCon,buffer,eError); + return 0; + } + pDum = pCom->pData; + if(pDum == NULL || pDum->pDescriptor->parNode == NULL){ + snprintf(buffer,255, + "ERROR: Object %s does not use Hipadaba natively and thus cannot be linked", + argv[2]); + SCWrite(pCon,buffer,eError); + return 0; + } + + if(pDum->pDescriptor->parNode->mama != NULL){ + snprintf(buffer,255, + "ERROR: Object %s is already linked somewhere else", + argv[2]); + SCWrite(pCon,buffer,eError); + return 0; + } + + AddHipadabaChild(node,pDum->pDescriptor->parNode,pCon); + + if(argc > 3){ + if(pDum->pDescriptor->parNode->name != NULL){ + free(pDum->pDescriptor->parNode->name); + } + pDum->pDescriptor->parNode->name = strdup(argv[3]); + } + + SCSendOK(pCon); + return 1; +} +/*-------------------------------------------------------------------------*/ +static int ChainCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + pHdb slave = (pHdb)userData; + hdbValue vv, old; + + if(slave != NULL){ + old = slave->value; + memset(&vv,0,sizeof(hdbValue)); + GetHipadabaPar(slave,&vv,callData); + if(!compareHdbValue(old,vv)){ + UpdateHipadabaPar(slave, vv, callData); + } + } + return 1; +} +/*--------------------------------------------------------------------------*/ +static int ChainHdbNode(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb master = NULL, slave = NULL; + char buffer[512]; + pHdbCallback kalle = NULL; + + if(argc < 3) { + SCWrite(pCon,"ERROR: insufficent number of arguments to hchain", + eError); + } + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + slave = GetHipadabaNode(root,argv[1]); + if(slave == NULL){ + snprintf(buffer,511,"ERROR: slave %s not found",argv[1]); + SCWrite(pCon,buffer,eError); + return 0; + } + + master = GetHipadabaNode(root,argv[2]); + if(master == NULL){ + snprintf(buffer,511,"ERROR: master %s not found",argv[1]); + SCWrite(pCon,buffer,eError); + return 0; + } + + kalle = MakeHipadabaCallback(ChainCallback,slave, NULL, -1,-1); + if(kalle == NULL){ + SCWrite(pCon,"ERROR: out of memory creating callback",eError); + return 0; + } + AppendHipadabaCallback(master,HCBUPDATE, kalle); + SCSendOK(pCon); + return 1; +} +/*---------------------------------------------------------------------------*/ +static int CommandSetCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + SConnection *pCon = (SConnection *)callData; + pDynString cmd = NULL, par = NULL; + pHdb current = NULL; + int status; + + if(pCon == NULL){ + printf("Cannot invoke command without connection\n"); + return 0; + } + + if(v.dataType == HIPTEXT){ + if(strstr(v.v.text,"start") != NULL) { + cmd = CreateDynString(64,64); + if(cmd == 0){ + SCWrite(pCon,"ERROR: out of memory in CommandSetCallback",eError); + return 0; + } + DynStringCopy(cmd, node->value.v.text); + DynStringConcat(cmd," "); + current = node->child; + while(current != NULL){ + par = formatValue(current->value); + if(par != NULL){ + DynStringConcat(cmd, GetCharArray(par)); + DynStringConcat(cmd," "); + DeleteDynString(par); + } + current = current->next; + } + status = SCInvoke(pCon, pServ->pSics,GetCharArray(cmd)); + DeleteDynString(cmd); + return status; + } else { + SCWrite(pCon,"ERROR: this node only understands start as value",eError); + return 0; + } + } + return 0; +} +/*---------------------------------------------------------------------------*/ +static int CommandGetCallback(void *userData, void *callData, pHdb node, + hdbValue v){ + hdbValue v2 = MakeHdbText("Nothing to get"); + v = v2; + return 1; +} +/*--------------------------------------------------------------------------*/ +static int SicsCommandNode(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + char buffer[512], buffer2[512], *pPtr = NULL; + pHdbCallback kalle = NULL; + pHdb parent = NULL, node = NULL; + + if(argc < 3) { + SCWrite(pCon,"ERROR: insufficent number of arguments to hcommand", + eError); + } + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + /* split off last path element */ + strncpy(buffer,argv[1],511); + pPtr = strrchr(buffer,'/'); + if(pPtr == NULL){ + SCWrite(pCon,"ERROR: invalid path specification", + eError); + return 0; + } + *pPtr = '\0'; + pPtr++; + if(strlen(pPtr) < 1) { + parent = root; + } else { + parent = GetHipadabaNode(root,buffer); + } + if(parent == NULL){ + snprintf(buffer2,512,"ERROR: parent %s for new node does not exist", + buffer); + SCWrite(pCon,buffer2,eError); + return 0; + } + node = MakeHipadabaNode(pPtr, HIPTEXT, 1); + if(node == NULL){ + SCWrite(pCon,"ERROR: out of memory in hcommand",eError); + return 0; + } + node->value.v.text = strdup(argv[2]); + node->value.arrayLength = strlen(argv[2]); + + kalle = MakeHipadabaCallback(CommandSetCallback,NULL, NULL, -1,-1); + if(kalle == NULL){ + SCWrite(pCon,"ERROR: out of memory in hcommand",eError); + return 0; + } + AppendHipadabaCallback(node,HCBSET, kalle); + + kalle = MakeHipadabaCallback(CommandGetCallback,NULL, NULL, -1,-1); + if(kalle == NULL){ + SCWrite(pCon,"ERROR: out of memory in hcommand",eError); + return 0; + } + AppendHipadabaCallback(node,HCBREAD, kalle); + + AddHipadabaChild(parent,node,pCon); + + SCSendOK(pCon); + return 1; +} +/*======================= Property Functions ================================*/ +static int SetSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + char buffer[512]; + + if(argc < 4) { + SCWrite(pCon,"ERROR: need path key value as parameters",eError); + return 0; + } + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + SCWrite(pCon,"ERROR: node not found",eError); + return 0; + } + Arg2Text(argc-3, &argv[3], buffer,512); + SetHdbProperty(targetNode,argv[2], buffer); + SCSendOK(pCon); + return 1; + } + /*--------------------------------------------------------------------------*/ +static int GetSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + char buffer[512]; + int status; + + if(argc < 3) { + SCWrite(pCon,"ERROR: need path key as parameters",eError); + return 0; + } + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + SCWrite(pCon,"ERROR: node not found",eValue); + return 0; + } + status = GetHdbProperty(targetNode,argv[2],buffer,511); + if(status != 1){ + SCWrite(pCon,"ERROR: attribute not found",eValue); + return 0; + } + SCPrintf(pCon,eValue,"%s.%s = %s", argv[1], argv[2], buffer); + return 1; + } + /*--------------------------------------------------------------------------*/ +static int ListSICSHdbProperty(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pHdb targetNode = NULL; + char buffer[512]; + const char *pKey = NULL; + pDynString data = NULL; + + if(argc < 2) { + SCWrite(pCon,"ERROR: need path as parameter",eError); + return 0; + } + targetNode = locateSICSNode(pSics,pCon,argv[1]); + if(targetNode == NULL){ + SCWrite(pCon,"ERROR: node not found",eError); + return 0; + } + data = CreateDynString(64,64); + if(data == NULL){ + SCWrite(pCon,"ERROR: out of memory in ListSICSHdbProperty",eError); + return 0; + } + InitHdbPropertySearch(targetNode); + while((pKey = GetNextHdbProperty(targetNode, buffer, 511)) != NULL){ + DynStringConcat(data,(char *)pKey); + DynStringConcat(data,"="); + DynStringConcat(data,buffer); + DynStringConcat(data,"\n"); + } + SCWrite(pCon,GetCharArray(data), eValue); + DeleteDynString(data); + return 1; + } +/*======================= Factory Functions =================================*/ void killSICSHipadaba(){ if(root != NULL){ - DeleteHipadabaNode(root); + DeleteHipadabaNode(root,NULL); } root = NULL; - /** - * children have already been removed when killing the - * main tree - */ - if(scriptUpdate > 0 && LLDcheck(scriptUpdate) != LIST_EMPTY){ - LLDdelete(scriptUpdate); - } } /*---------------------------------------------------------------------------*/ int InstallSICSHipadaba(SConnection *pCon, SicsInterp *pSics, void *pData, int argc, char *argv[]){ root = MakeHipadabaNode("/",HIPNONE,0); - scriptUpdate = LLDcreate(sizeof(void *)); - taskData.updateList = scriptUpdate; - taskData.iEnd = 0; - taskData.pCon = SCCreateDummyConnection(pSics); - if(taskData.pCon == NULL){ - SCWrite(pCon,"ERROR: out of memory creating Hipadaba",eError); - return 0; - } - TaskRegister(pServ->pTasker, - SICSHipadabaTask, - SICSHipadabaSignal, - NULL, - &taskData,1); - AddCommand(pSics,"hmake", MakeHdbNode, NULL, NULL); AddCommand(pSics,"hmakescript", MakeHdbScriptNode, NULL, NULL); + AddCommand(pSics,"hattach", SICSHdbAdapter, NULL, NULL); AddCommand(pSics,"hdel", DeleteHdbNode, NULL, NULL); AddCommand(pSics,"hset", SetHdbNode, NULL, NULL); + AddCommand(pSics,"hupdate", UpdateHdbNode, NULL, NULL); AddCommand(pSics,"hget", GetHdbNode, NULL, NULL); + AddCommand(pSics,"hzipget",ZipGetHdbNode, NULL, NULL); AddCommand(pSics,"hlist", ListHdbNode, NULL, NULL); AddCommand(pSics,"hnotify", AutoNotifyHdbNode, NULL, NULL); AddCommand(pSics,"hdelcb", RemoveHdbCallback, NULL, NULL); - AddCommand(pSics,"hstyle", setFormatStyle, NULL, NULL); + AddCommand(pSics,"hlink", LinkHdbNode, NULL, NULL); + AddCommand(pSics,"hinfo", HdbNodeInfo, NULL, NULL); + AddCommand(pSics,"hval", HdbNodeVal, NULL, NULL); + AddCommand(pSics,"hchain", ChainHdbNode, NULL, NULL); + AddCommand(pSics,"hcommand",SicsCommandNode, NULL, NULL); + AddCommand(pSics,"hsetprop",SetSICSHdbProperty, NULL, NULL); + AddCommand(pSics,"hgetprop",GetSICSHdbProperty, NULL, NULL); + AddCommand(pSics,"hlistprop",ListSICSHdbProperty, NULL, NULL); + + InstallSICSPoll(pCon,pSics,pData,argc,argv); + poller = (pSicsPoll)FindCommandData(pSics,"sicspoll","SicsPoll"); return 1; } diff --git a/sicshipadaba.h b/sicshipadaba.h index 83f0bf5f..29724ee7 100644 --- a/sicshipadaba.h +++ b/sicshipadaba.h @@ -25,6 +25,11 @@ typedef struct { int iEnd; }hdbUpdateTask, *pHdbUpdateTask; /*======================== common callbacks =====================================*/ +/** + * make a ReadOnly callback + * @return a callback which disallows setting of a parameter. + */ +pHdbCallback MakeReadOnlyCallback(); /** * make a callback which checks permissions. To be used on write * @param priv The privilege to check against @@ -81,7 +86,7 @@ pHdbCallback MakeIntRangeCallback(int min, int max); * @return a suitably configured callback or NULL * when out of memory */ -pHdbCallback MakeIntFixedCallback(long *data, int length); +pHdbCallback MakeIntFixedCallback(int *data, int length); /** * make a callback for checking if a parameter is within a given * range of floats @@ -91,6 +96,29 @@ pHdbCallback MakeIntFixedCallback(long *data, int length); * when out of memory */ pHdbCallback MakeFloatRangeCallback(double min, double max); +/** + * make a callback which reads a memory address (perhaps in a + * data structure) which is a float value + * @param address The address of the parameter + * @return a suitable callback for reading this parameter. + */ +pHdbCallback MakeMemReadCallback(float *address); +/** + * make a callback which sets a memory address (perhaps in a + * data structure) which is a float value. It is assumed that + * this is a direct parameter, i.e, UpdateHipadabaPar is + * automatically called. + * @param address The address of the parameter + * @return a suitable callback for setting this parameter. + */ +pHdbCallback MakeMemSetCallback(float *address); +/** + * make a tree chnage callback + * @param pCon The connection to notfy on tree chnages + * @id The ID of this callback + * @return a suitable callback for notififications about tree changes. + */ + pHdbCallback MakeTreeChangeCallback(SConnection *pCon, int id); /*======================== parameter creation ===================================*/ /** * make a simple SICS hdb parameter. Setting it will call update immediately. Use @@ -101,6 +129,19 @@ pHdbCallback MakeFloatRangeCallback(double min, double max); * @return A new suitably configured Hdb parameter or NULL when out of memory. */ pHdb MakeSICSHdbPar(char *name, int priv, hdbValue v); +/** + * make a simple SICS hdb parameter. Setting it will call update immediately. Use + * this for program parameters. + * @param name The name of the parameter + * @param priv The privilege required to change that parameter + * @param dataType The datatype for the new parameter. + * @param length The length of any arrays + * @param data Data to initalise the parameter with. Can be NULL, then + * no initialisation takes place. + * @return A new suitably configured Hdb parameter or NULL when out of memory. + */ +pHdb CreateSICSHdbPar(char *name, int priv, int dataType, + int length, void *data); /** * make a SICS hdb drivable parameter. Setting it will start the motor, * virtual motor or environment parameter. This will call StartDevice @@ -111,8 +152,15 @@ pHdb MakeSICSHdbPar(char *name, int priv, hdbValue v); * @param dataType The datatype of this variable * @return A new suitably configured Hdb parameter or NULL when out of memory. */ - pHdb MakeSICSHdbDriv(char *name, int priv,void *sicsObject, int datatype); +/** + * make SICS hdb variable which is connected to a memory location, perhaps in + * an objects data structure. + * @param name The name of the variable + * @param priv The privilege required to set this parameter + * @param address A pointer to the memory location of the variable. + */ +pHdb MakeSICSMemPar(char *name, int priv, float *address); /** * makes a SICS Hdb read only parameter. Setting such a parameter causes an error. * @param name The name of the parameter @@ -130,36 +178,102 @@ pHdb MakeSICSROPar(char *name, hdbValue v); * @return A new suitably configured Hdb parameter or NULL when out of memory. */ pHdb MakeSICSScriptPar(char *name, char *setScript, char *readScript, hdbValue v); +/** + * make a SICS scriptable parameter. I.e. when this parameter is set or read, + * appropriate scripts are invoked. + * @param name The name of the parameter + * @param dataType The datatype for the new parameter. + * @param length The length of any arrays + * @param data Data to initalise the parameter with. Can be NULL, then + * no initialisation takes place. + * @return A new suitably configured Hdb parameter or NULL when out of memory. + */ +pHdb CreateSICSScriptPar(char *name, char *setScript, char *readScript, + int dataType, int length, void *data); + /** * remove a SICS paramameter node and its children. In contrast to the * normal DeletHipadabaNode, this function also takes care of * clearing scipted nodes out of the update tasks watch list. * @param node The node to delete + * @param callData User data for the tree change callback */ -void RemoveSICSPar(pHdb node); +void RemoveSICSPar(pHdb node, void *callData); +/*=============== Add par functions =======================================*/ +/** + * add a new simple hdb parameter as child to node + * @param node The node to add the new node too. + * @param priv The privilege required to change that parameter + * @param v The initial value and datatype of this parameter + * @return 1 on success, 0 else + */ +int AddSICSHdbPar(pHdb node, char *name, int priv, hdbValue v); +/** + * add a new read only hdb parameter as child to node + * @param node The node to add the new node too. + * @param v The initial value and datatype of this parameter + * @return 1 on success, 0 else + */ +int AddSICSHdbROPar(pHdb node, char *name, hdbValue v); +/** + * Add a new hdb parameter as child to node. Updates are synced + * to the memory location data. This works for simple variables, fixed size + * arrays and fixed sized strings. This does not work for dynamically sized + * arrays or strings. + * @param node The node to add the new node too. + * @param priv The privilege required to change that parameter + * @param data The pointer to map this parameter too. This must be in + * dynamically allocated memory. + * @param datalength The length of the data area pointed to by data. + * @param type The data type of the parameter + * @param length The length of the type. Used for array types. + * @return 1 on success, 0 else + */ +int AddSICSHdbMemPar(pHdb node, char *name, int priv, + void *data, int datalength, int type, int length); /*============== access support functions =================================*/ /** - * SICSHdbGetFloat returns the float value of a parameter. Integers are - * automatically converted. - * @param parent The parent node where to start searching for the parameter + * SICSHdbGetPar returns the value of a parameter. + * @param obj The object for which to get a parameter. * @param pCon The optional connection object to use for reporting errors. * @param path The path to the parameter. - * @param value The value of the parameter + * @param dataType The datatype for the parameter. + * @param data Target pointer to which to copy data too. + * @param length The length of data * @return 1 on success, a negative error code else. */ -int SICSHdbGetFloat(pHdb parent, SConnection *pCon, - char *path, float *value); +int SICSHdbGetPar(void *obj, SConnection *pCon, + char *path, int dataType, void *data, int length); /** - * SICSHdbSetFloat sets the value of a parameter. Integers are - * automatically converted. - * @param parent The parent node where to start searching for the parameter + * SICSHdbUpdatePar updates the value of a parameter. + * @param obj The object for which to get a parameter. * @param pCon The optional connection object to use for reporting errors. * @param path The path to the parameter. - * @param value The new value of the parameter + * @param dataType The datatype for the parameter. + * @param data Pointer from which to copy data. + * @param length The length of data * @return 1 on success, a negative error code else. */ -int SICSHdbSetFloat(pHdb parent, SConnection *pCon, - char *path, float value); +int SICSHdbUpdatePar(void *obj, SConnection *pCon, + char *path, int dataType, void *data, int length); +/** + * SICSHdbSetPar sets the value of a parameter. + * @param obj The object for which to get a parameter. + * @param pCon The optional connection object to use for reporting errors. + * @param path The path to the parameter. + * @param dataType The datatype for the parameter. + * @param data Pointer from which to copy data. + * @param length The length of data + * @return 1 on success, a negative error code else. + */ +int SICSHdbSetPar(void *obj, SConnection *pCon, + char *path, int dataType, void *data, int length); +/** + * query function if a parameter is read only. + * @param node The ndoe to query + * @return 1 when RO, 0 else + */ +int isSICSHdbRO(pHdb node); /*============= common SICS Interactions ===================================*/ /** * Install a SICS automatic notification callback on the node. This is @@ -187,6 +301,23 @@ int InstallSICSNotify(pHdb node, SConnection *pCon, int id, int recurse); */ int ProcessSICSHdbPar(pHdb root, SConnection *pCon, char *printPrefix, int argc, char *argv[]); +/** + * print a listing of the parameters of node to pCon, using the + * specified prefix. + * @param The node to print + * @pCon The connection to print too + * @prefix The prefix to use for printing + */ +void PrintSICSParList(pHdb node, SConnection *pCon, char *prefix); +/** + * save the content of the Hipadaba starting at node into a file. This can + * be used to save the configuration of an instrument. This routine is + * recursive. + * @param fd The file to write to + * @param node The node to print from + * @param prefix A prefix to use for printing. + */ +void SaveSICSHipadaba(FILE *fd, pHdb node, char *prefix); /** * A SICS task which scans a Hipadaba and reads and updates all parameters, * one per invocation. TODO: how to distinguish between automatic pars which diff --git a/sicspoll.c b/sicspoll.c new file mode 100644 index 00000000..5c280413 --- /dev/null +++ b/sicspoll.c @@ -0,0 +1,360 @@ +/** + * This is a generalized polling module for SICS. With this module + * SICS variables can be polled regulary for updates. For different types of + * SICS variables different polling mechanisms are required. In order to cope with + * this requirement a polling interface and different drivers are defined in the + * sister module polldriv.h and polldriv.c. This module implements the interface + * to configure polling and the SICS task to run polling. + * + * Copyright: see COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ + +#include +#include +#include +#include + +#include "polldriv.h" +#include "splitter.h" +#include +#include "lld.h" + +/*================== data structure =====================================*/ +static SConnection *defCon = NULL; + +struct __SICSPOLL{ + pObjectDescriptor pDes; + int pollList; /* list with polled objects */ + int listDirty; /* a flag to set when the list has been modified. This will + cause the list polling task to go back to the start. */ + SConnection *pCon; /* connection to use for polling */ + int iEnd; /* flag ending this */ + int nPoll; /* how many to poll in one run */ + long taskID; +}; +/*-----------------------------------------------------------------------*/ +void killSicsPoll(void *data){ + pSicsPoll self = (pSicsPoll)data; + int status; + pPollDriv poll = NULL; + + self->iEnd = 1; + status = LLDnodePtr2First(self->pollList); + while(status != 0){ + poll = LLDnodePtr(self->pollList); + if(poll != NULL){ + deletePollDriv(poll); + } + status = LLDnodePtr2Next(self->pollList); + } + LLDdelete(self->pollList); + free(self); + if(defCon != NULL){ + SCDeleteConnection(defCon); + } +} +/*----------------- list access -----------------------------------------*/ +static pPollDriv locateObject(int list, char *objectIdentifier){ + int status; + pPollDriv data = NULL; + + status = LLDnodePtr2First(list); + while(status != 0){ + data = (pPollDriv)LLDnodePtr(list); + if(data != NULL){ + if(strcmp(data->objectIdentifier,objectIdentifier) == 0){ + return data; + } + } + status = LLDnodePtr2Next(list); + } + return NULL; +} +/*===================== task function ==================================*/ +static int incrList(int list){ + int status; + + if(LLDcheck(list) == LIST_EMPTY){ + return 0; + } + status = LLDnodePtr2Next(list); + if(status == 0) { + status = LLDnodePtr2First(list); + } + return status; +} +/*---------------------------------------------------------------------------*/ +void SicsPollSignal(void *pData, int iSignal, void *pSigData){ + pSicsPoll self = NULL; + int *iInt; + + self = (pSicsPoll)pData; + + if(iSignal == SICSINT){ + iInt = (int *)pSigData; + if(*iInt == eEndServer){ + self->iEnd = 1; + } + } +} +/*----------------------------------------------------------------------*/ +static int PollTask(void *data){ + pSicsPoll self = (pSicsPoll) data; + pPollDriv poll = NULL; + int status, i; + time_t now = time(NULL); + + if(self == NULL || self->iEnd == 1){ + return 0; + } + if(LLDcheck(self->pollList) == LIST_EMPTY){ + return 1; + } + + /* + * increment list + */ + if(self->listDirty == 1){ + self->listDirty = 0; + status = LLDnodePtr2First(self->pollList); + } + + /* + * actually do poll + */ + for(i = 0; i < self->nPoll; i++){ + status = incrList(self->pollList); + poll = (pPollDriv)LLDnodePtr(self->pollList); + if(status != 0 && poll != NULL){ + if(poll->isDue(poll,now,self->pCon)){ + poll->poll(poll,self->pCon); + } + } + } + return 1; +} +/*==================== interface functions ==============================*/ +int removePollObject(pSicsPoll self, char *objectIdentifier){ + pPollDriv target = NULL; + + self->listDirty = 1; + target = locateObject(self->pollList, objectIdentifier); + if(target != NULL){ + LLDnodeDelete(self->pollList); + deletePollDriv(target); + return 1; + } else{ + return 0; + } +} +/*------------------------------------------------------------------------*/ +int addPollObject(SicsPoll *self, SConnection *pCon, char *objectIdentifier, + char *driver, int argc, char *argv[]){ + int status; + pPollDriv driv = NULL; + + driv = makePollDriver(pCon, driver,objectIdentifier, + argc,argv); + if(driv == NULL){ + return 0; + } + + LLDnodeAppend(self->pollList,&driv); + return 1; +} +/*-----------------------------------------------------------------------*/ +static void printPollList(pSicsPoll self, SConnection *pCon){ + int status; + pPollDriv driv = NULL; + char buffer[512]; + + status = LLDnodePtr2First(self->pollList); + while(status != 0){ + driv = (pPollDriv)LLDnodePtr(self->pollList); + if(driv != NULL){ + snprintf(buffer,512,"%60s %3d", + driv->objectIdentifier, driv->pollIntervall); + SCWrite(pCon,buffer,eValue); + } + status = LLDnodePtr2Next(self->pollList); + } +} +/*================== interpreter interface ===============================*/ +int SICSPollWrapper(SConnection *pCon,SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pSicsPoll self = (pSicsPoll)pData; + pPollDriv driv = NULL; + int status, iVal; + char buffer[512]; + pDynString txt = NULL; + + assert(self != NULL); + if(argc < 2){ + SCWrite(pCon,"ERROR: Not enough arguments",eError); + return 0; + } + + strtolower(argv[1]); + if(strcmp(argv[1],"del") == 0) { + if(argc < 3){ + SCWrite(pCon,"ERROR: Not enough arguments",eError); + return 0; + } + + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + status = removePollObject(self,argv[2]); + if(status == 0) { + SCWrite(pCon,"ERROR: object to remove from poll list not found",eError); + return 0; + } else { + SCSendOK(pCon); + return 1; + } + } else if(strcmp(argv[1],"add") == 0) { + if(argc < 4){ + SCWrite(pCon,"ERROR: Not enough arguments",eError); + return 0; + } + + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + driv = makePollDriver(pCon,argv[3], argv[2], + argc-3, &argv[4]); + if(driv != NULL){ + LLDnodeAppend(self->pollList,&driv); + SCSendOK(pCon); + return 1; + } else { + return 0; + } + } else if (strcmp(argv[1],"npoll") == 0) { + if(argc < 3) { + snprintf(buffer,512,"%s.%s = %d", argv[0], "npoll", self->nPoll); + } else { + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + status = sscanf(argv[2],"%d",&self->nPoll); + if(status != 1) { + snprintf(buffer,512,"ERROR: failed to convert %s to int",argv[2]); + SCWrite(pCon,buffer,eError); + return 0; + } else { + SCSendOK(pCon); + return 1; + } + } + } else if (strcmp(argv[1],"listen") == 0) { + self->pCon = pCon; + SCSendOK(pCon); + return 1; + } else if (strcmp(argv[1],"unlisten") == 0) { + self->pCon = defCon; + SCSendOK(pCon); + return 1; + } else if (strcmp(argv[1],"intervall") == 0){ + if(argc < 3){ + SCWrite(pCon,"ERROR: Not enough arguments",eError); + return 0; + } + + if(!SCMatchRights(pCon,usMugger)){ + return 0; + } + + driv = locateObject(self->pollList,argv[2]); + if(driv == NULL){ + SCWrite(pCon,"ERROR: object not in polling list",eError); + return 0; + } + if(argc > 3){ + status = sscanf(argv[3],"%d", &iVal); + if(status != 1){ + snprintf(buffer,511,"ERROR: failed to convert %s to int", + argv[3]); + SCWrite(pCon,buffer,eError); + return 0; + } + if(iVal < 0) { + SCWrite(pCon,"ERROR: new value for intervall out of range",eError); + return 0; + } + driv->pollIntervall = iVal; + SCSendOK(pCon); + return 1; + } else { + snprintf(buffer,511,"%s.intervall = %d",driv->objectIdentifier, + driv->pollIntervall); + SCWrite(pCon,buffer,eValue); + return 1; + } + } else if (strcmp(argv[1],"list") == 0) { + SCStartBuffering(pCon); + printPollList(self,pCon); + txt = SCEndBuffering(pCon); + if(txt != NULL){ + SCWrite(pCon,GetCharArray(txt),eValue); + } + return 1; + } else if (strcmp(argv[1],"poll") == 0) { + if(argc < 3){ + SCWrite(pCon,"ERROR: Not enough arguments",eError); + return 0; + } + + driv = locateObject(self->pollList,argv[2]); + if(driv == NULL){ + SCWrite(pCon,"ERROR: object not in polling list",eError); + return 0; + } + status = driv->poll(driv,pCon); + if(status != 1){ + SCWrite(pCon,"ERROR: polling object",eError); + return 0; + } + SCWrite(pCon,"Object polled OK",eError); + return 1; + } + return 1; +} +/*------------------------------------------------------------------------*/ +int InstallSICSPoll(SConnection *pCon,SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pSicsPoll pNew = NULL; + + pNew = malloc(sizeof(SicsPoll)); + if(pNew == NULL){ + return 0; + } + memset(pNew,0,sizeof(SicsPoll)); + + pNew->pDes = CreateDescriptor("SicsPoll"); + pNew->pollList = LLDcreate(sizeof(void *)); + defCon = SCCreateDummyConnection(pSics); + + if(pNew->pDes == NULL|| pNew->pollList < 0 || defCon == NULL){ + SCWrite(pCon,"ERROR: out of memory creating SicsPoll",eError); + return 0; + } + pNew->pCon = defCon; + pNew->nPoll = 3; + + TaskRegister(pServ->pTasker,PollTask,SicsPollSignal,NULL,pNew, 10); + + if(argc > 1){ + AddCommand(pSics,argv[1],SICSPollWrapper, + killSicsPoll,pNew); + } else { + AddCommand(pSics,"sicspoll",SICSPollWrapper, + killSicsPoll,pNew); + } + + return 1; +} diff --git a/sicspoll.h b/sicspoll.h new file mode 100644 index 00000000..3d307223 --- /dev/null +++ b/sicspoll.h @@ -0,0 +1,53 @@ +/** + * This is a generalized polling module for SICS. With this module + * SICS variables can be polled regulary for updates. For different types of + * SICS variables different polling mechanisms are required. In order to cope with + * this requirement a polling interface and different drivers are defined in the + * sister module polldriv.h and polldriv.c. This module implements the interface + * to configure polling and the SICS task to run polling. + * + * Copyright: see COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ +#ifndef SICSPOLL_H_ +#define SICSPOLL_H_ +/*=================== interpreter interface ================================*/ +/** + * the factory function + */ +int InstallSICSPoll(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +/* + * the actual wrapper which allows to configure and query the polling + * module + */ +int SICSPollWrapper(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +/*================== Internal Interface ===================================*/ +typedef struct __SICSPOLL SicsPoll, *pSicsPoll; +/** + * add an object to the list of pollable objects. + * @param self A pointer to a sicsPoll object managing the poll loop. + * @param pCon a connection to report errors to + * @param objectidentifier A string describing the object to poll. + * This parameter will be used by the poll driver to locate the + * pollable obejct. + * @param The driver to use for polling + * @param argc The number of additional parameters to pass to the + * poll driver + * @param argv[] The parameters to pass to the poll driver. + * @return 1 on success or a negative error code when things go wrong. + */ +int addPollObject(SicsPoll *self, SConnection *pCon, char *objectIdentifier, + char *driver, int argc, char *argv[]); +/** + * remove an object from the polling loop. + * @param self A pointer to a sicsPoll object managing the poll loop. + * @param objectIdentifier The identifier of the object to remove from + * the poll loop. + * @return 1 on success, a negative error code on failure. + */ +int removePollObject(SicsPoll *self, char *objectIdentifier); + +#endif /*SICSPOLL_H_*/ diff --git a/sicspoll.tc b/sicspoll.tc new file mode 100644 index 00000000..ea2eb738 --- /dev/null +++ b/sicspoll.tc @@ -0,0 +1,306 @@ +/** + * This is a generalized polling module for SICS. With this module + * SICS variables can be polled regulary for updates. For different types of + * SICS variables different polling mechanisms are required. In order to cope with + * this requirement a polling interface and different drivers are defined in the + * sister module polldriv.h and polldriv.c. This module implements the interface + * to configure polling and the SICS task to run polling. + * + * Copyright: see COPYRIGHT + * + * Mark Koennecke, November-December 2006 + */ +<%! source sicstemplates.tcl %> +<% stdIncludes %> +#include "polldriv.h" +#include "splitter.h" +#include +#include "lld.h" + +/*================== data structure =====================================*/ +static SConnection *defCon = NULL; + +struct __SICSPOLL{ + pObjectDescriptor pDes; + int pollList; /* list with polled objects */ + int listDirty; /* a flag to set when the list has been modified. This will + cause the list polling task to go back to the start. */ + SConnection *pCon; /* connection to use for polling */ + int iEnd; /* flag ending this */ + int nPoll; /* how many to poll in one run */ + long taskID; +}; +/*-----------------------------------------------------------------------*/ +void killSicsPoll(void *data){ + pSicsPoll self = (pSicsPoll)data; + int status; + pPollDriv poll = NULL; + + self->iEnd = 1; + status = LLDnodePtr2First(self->pollList); + while(status != 0){ + poll = LLDnodePtr(self->pollList); + if(poll != NULL){ + deletePollDriv(poll); + } + status = LLDnodePtr2Next(self->pollList); + } + LLDdelete(self->pollList); + free(self); + if(defCon != NULL){ + SCDeleteConnection(defCon); + } +} +/*----------------- list access -----------------------------------------*/ +static pPollDriv locateObject(int list, char *objectIdentifier){ + int status; + pPollDriv data = NULL; + + status = LLDnodePtr2First(list); + while(status != 0){ + data = (pPollDriv)LLDnodePtr(list); + if(data != NULL){ + if(strcmp(data->objectIdentifier,objectIdentifier) == 0){ + return data; + } + } + status = LLDnodePtr2Next(list); + } + return NULL; +} +/*===================== task function ==================================*/ +static int incrList(int list){ + int status; + + if(LLDcheck(list) == LIST_EMPTY){ + return 0; + } + status = LLDnodePtr2Next(list); + if(status == 0) { + status = LLDnodePtr2First(list); + } + return status; +} +/*---------------------------------------------------------------------------*/ +void SicsPollSignal(void *pData, int iSignal, void *pSigData){ + pSicsPoll self = NULL; + int *iInt; + + self = (pSicsPoll)pData; + + if(iSignal == SICSINT){ + iInt = (int *)pSigData; + if(*iInt == eEndServer){ + self->iEnd = 1; + } + } +} +/*----------------------------------------------------------------------*/ +static int PollTask(void *data){ + pSicsPoll self = (pSicsPoll) data; + pPollDriv poll = NULL; + int status, i; + time_t now = time(NULL); + + if(self == NULL || self->iEnd == 1){ + return 0; + } + if(LLDcheck(self->pollList) == LIST_EMPTY){ + return 1; + } + + /* + * increment list + */ + if(self->listDirty == 1){ + self->listDirty = 0; + status = LLDnodePtr2First(self->pollList); + } + + /* + * actually do poll + */ + for(i = 0; i < self->nPoll; i++){ + status = incrList(self->pollList); + poll = (pPollDriv)LLDnodePtr(self->pollList); + if(status != 0 && poll != NULL){ + if(poll->isDue(poll,now,self->pCon)){ + poll->poll(poll,self->pCon); + } + } + } + return 1; +} +/*==================== interface functions ==============================*/ +int removePollObject(pSicsPoll self, char *objectIdentifier){ + pPollDriv target = NULL; + + self->listDirty = 1; + target = locateObject(self->pollList, objectIdentifier); + if(target != NULL){ + LLDnodeDelete(self->pollList); + deletePollDriv(target); + return 1; + } else{ + return 0; + } +} +/*------------------------------------------------------------------------*/ +int addPollObject(SicsPoll *self, SConnection *pCon, char *objectIdentifier, + char *driver, int argc, char *argv[]){ + int status; + pPollDriv driv = NULL; + + driv = makePollDriver(pCon, driver,objectIdentifier, + argc,argv); + if(driv == NULL){ + return 0; + } + + LLDnodeAppend(self->pollList,&driv); + return 1; +} +/*-----------------------------------------------------------------------*/ +static void printPollList(pSicsPoll self, SConnection *pCon){ + int status; + pPollDriv driv = NULL; + char buffer[512]; + + status = LLDnodePtr2First(self->pollList); + while(status != 0){ + driv = (pPollDriv)LLDnodePtr(self->pollList); + if(driv != NULL){ + snprintf(buffer,512,"%60s %3d", + driv->objectIdentifier, driv->pollIntervall); + SCWrite(pCon,buffer,eValue); + } + status = LLDnodePtr2Next(self->pollList); + } +} +/*================== interpreter interface ===============================*/ +<%makeSicsFunc SICSPollWrapper%>{ + pSicsPoll self = (pSicsPoll)pData; + pPollDriv driv = NULL; + int status, iVal; + char buffer[512]; + pDynString txt = NULL; + + assert(self != NULL); + <%testNoPar 2 5%> + strtolower(argv[1]); + if(strcmp(argv[1],"del") == 0) { + <%testNoPar 3 9%> + <%testPriv usMugger 9%> + status = removePollObject(self,argv[2]); + if(status == 0) { + SCWrite(pCon,"ERROR: object to remove from poll list not found",eError); + return 0; + } else { + SCSendOK(pCon); + return 1; + } + } else if(strcmp(argv[1],"add") == 0) { + <%testNoPar 4 9%> + <%testPriv usMugger 9%> + driv = makePollDriver(pCon,argv[3], argv[2], + argc-3, &argv[4]); + if(driv != NULL){ + LLDnodeAppend(self->pollList,&driv); + SCSendOK(pCon); + return 1; + } else { + return 0; + } + } else if (strcmp(argv[1],"npoll") == 0) { + <%# sicsPar name, c-name nargs priv type indent + sicsPar npoll self->nPoll 3 usMugger int 9%> + } else if (strcmp(argv[1],"listen") == 0) { + self->pCon = pCon; + SCSendOK(pCon); + return 1; + } else if (strcmp(argv[1],"unlisten") == 0) { + self->pCon = defCon; + SCSendOK(pCon); + return 1; + } else if (strcmp(argv[1],"intervall") == 0){ + <%testNoPar 3 9%> + <%testPriv usMugger 9%> + driv = locateObject(self->pollList,argv[2]); + if(driv == NULL){ + SCWrite(pCon,"ERROR: object not in polling list",eError); + return 0; + } + if(argc > 3){ + status = sscanf(argv[3],"%d", &iVal); + if(status != 1){ + snprintf(buffer,511,"ERROR: failed to convert %s to int", + argv[3]); + SCWrite(pCon,buffer,eError); + return 0; + } + if(iVal < 0) { + SCWrite(pCon,"ERROR: new value for intervall out of range",eError); + return 0; + } + driv->pollIntervall = iVal; + SCSendOK(pCon); + return 1; + } else { + snprintf(buffer,511,"%s.intervall = %d",driv->objectIdentifier, + driv->pollIntervall); + SCWrite(pCon,buffer,eValue); + return 1; + } + } else if (strcmp(argv[1],"list") == 0) { + SCStartBuffering(pCon); + printPollList(self,pCon); + txt = SCEndBuffering(pCon); + if(txt != NULL){ + SCWrite(pCon,GetCharArray(txt),eValue); + } + return 1; + } else if (strcmp(argv[1],"poll") == 0) { + <%testNoPar 3 9%> + driv = locateObject(self->pollList,argv[2]); + if(driv == NULL){ + SCWrite(pCon,"ERROR: object not in polling list",eError); + return 0; + } + status = driv->poll(driv,pCon); + if(status != 1){ + SCWrite(pCon,"ERROR: polling object",eError); + return 0; + } + SCWrite(pCon,"Object polled OK",eError); + return 1; + } + return 1; +} +/*------------------------------------------------------------------------*/ +<%makeSicsFunc InstallSICSPoll%>{ + pSicsPoll pNew = NULL; + + <%newStrucRet SicsPoll 5 0%> + pNew->pDes = CreateDescriptor("SicsPoll"); + pNew->pollList = LLDcreate(sizeof(void *)); + defCon = SCCreateDummyConnection(pSics); + + if(pNew->pDes == NULL|| pNew->pollList < 0 || defCon == NULL){ + SCWrite(pCon,"ERROR: out of memory creating SicsPoll",eError); + return 0; + } + pNew->pCon = defCon; + pNew->nPoll = 3; + + TaskRegister(pServ->pTasker,PollTask,SicsPollSignal,NULL,pNew, 10); + + if(argc > 1){ + AddCommand(pSics,argv[1],SICSPollWrapper, + killSicsPoll,pNew); + } else { + AddCommand(pSics,"sicspoll",SICSPollWrapper, + killSicsPoll,pNew); + } + + return 1; +} diff --git a/sicsstat.tcl b/sicsstat.tcl index 3ebfc9d2..5ce78d00 100644 --- a/sicsstat.tcl +++ b/sicsstat.tcl @@ -1,7 +1,19 @@ -# Counter counter -counter SetPreset 10.000000 -counter SetMode Timer -hm CountMode timer -hm preset 10.000000 -hm genbin 0.000000 10.000000 10000 -hm init +exe batchpath ./ +exe syspath ./ +# Motor brumm +brumm sign 1.0000 +brumm hardlowerlim -180.0000 +brumm hardupperlim 180.0000 +brumm softlowerlim -180.0000 +brumm softupperlim 180.0000 +brumm softzero 0.0000 +brumm fixed -1.0000 +brumm interruptmode 0.0000 +brumm precision 0.2000 +brumm accesscode 2.0000 +brumm failafter 3.0000 +brumm maxretry 3.0000 +brumm ignorefault 0.0000 +brumm movecount 10.0000 +brumm errortype 0.0000 +brumm recover 1.0000 diff --git a/sicstemplates.tcl b/sicstemplates.tcl new file mode 100644 index 00000000..a5159572 --- /dev/null +++ b/sicstemplates.tcl @@ -0,0 +1,107 @@ +#---------------------------------------------------------------------------- +# This file contaisn template generation code for SICS programming +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, December 2006 +#---------------------------------------------------------------------------- +proc stdIncludes {} { + append txt "#include \n" + append txt "#include \n" + append txt "#include \n" + append txt "#include \n" +} +#--------------------------------------------------------------------------- +proc makeSicsFunc {name} { + append txt "int ${name}(SConnection *pCon,SicsInterp *pSics, void *pData,\n" + append txt " int argc, char *argv\[\])" + return $txt +} +#---------------------------------------------------------------------------- +proc newStruc {name indent} { + set pre [string repeat " " $indent] + append txt "pNew = malloc(sizeof($name));\n" + append txt $pre "if(pNew == NULL){\n" + append txt $pre " return NULL;\n" + append txt $pre "}\n" + append txt $pre "memset(pNew,0,sizeof($name));\n" + return $txt +} +#---------------------------------------------------------------------------- +proc newStrucRet {name indent retval} { + set pre [string repeat " " $indent] + append txt "pNew = malloc(sizeof($name));\n" + append txt $pre "if(pNew == NULL){\n" + append txt $pre " return $retval;\n" + append txt $pre "}\n" + append txt $pre "memset(pNew,0,sizeof($name));\n" + return $txt +} +#----------------------------------------------------------------------------- +proc testNoPar {noPar indent} { + set pre [string repeat " " $indent] + append txt "if(argc < $noPar){\n" + append txt $pre " SCWrite(pCon,\"ERROR: Not enough arguments\",eError);\n" + append txt $pre " return 0;\n" + append txt $pre "}\n" + return $txt +} +#------------------------------------------------------------------------------- +proc testPriv {priv indent} { + set pre [string repeat " " $indent] + append txt "if(!SCMatchRights(pCon,$priv)){\n" + append txt $pre " return 0;\n" + append txt $pre "}\n" + return $txt +} +#-------------------------------------------------------------------------------- +proc sicsPar {parName parCName noPar priv type indent} { + set pre [string repeat " " $indent] + append txt "if(argc < $noPar) {\n" + switch $type { + int { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %d\", argv\[0\], \"$parName\", $parCName);\n" + } + float { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %f\", argv\[0\], \"$parName\", $parCName);\n" + } + text { + append txt $pre + append txt " snprintf(buffer,512,\"%s.%s = %s\", argv\[0\], \"$parName\", $parCName);\n" + } + default { + error "$type is unknown" + } + } + append txt $pre "} else {\n" + append txt $pre " " [testPriv $priv [expr $indent + 4]] + set n [expr $noPar -1] + switch $type { + int { + append txt $pre " status = sscanf(argv\[$n\],\"%d\",&$parCName);\n" + } + float { + append txt $pre " status = sscanf(argv\[$n\],\"%f\",&$parCName);\n" + } + text { + append txt $pre " if($parCName != NULL){\n" + append txt $pre " free($parCName);\n" + append txt $pre " }\n" + append txt $pre " $parCName = strdup(argv\[$n\]);\n" + append txt $pre " status = 1;\n" + } + } + append txt $pre " if(status != 1) {\n" + append txt $pre " snprintf(buffer,512," + append txt "\"ERROR: failed to convert %s to $type\",argv\[$n\]);\n" + append txt $pre " SCWrite(pCon,buffer,eError);\n" + append txt $pre " return 0;\n" + append txt $pre " } else {\n" + append txt $pre " SCSendOK(pCon);\n" + append txt $pre " return 1;\n" + append txt $pre " }\n" + append txt $pre "}" + return $txt +} diff --git a/simcter.c b/simcter.c index 1b501e67..9963c191 100644 --- a/simcter.c +++ b/simcter.c @@ -337,7 +337,7 @@ static float FAILRATE; pData->lEnd = 0; pData->iPause = 0; pRes->pData = (void *)pData; - pRes->iNoOfMonitors = 2; + pRes->iNoOfMonitors = 8; pRes->fTime = 0; /* assign functions */ diff --git a/splitter.c b/splitter.c index 13f97702..09543881 100644 --- a/splitter.c +++ b/splitter.c @@ -114,7 +114,7 @@ typedef enum _CharType {eSpace, eNum,eeText,eQuote} CharType; { TokenList *pList = NULL; TokenList *pCurrent; - char pBueffel[132]; + char pBueffel[256]; char *pChar; CharType eWhat; int i, n; @@ -141,7 +141,7 @@ typedef enum _CharType {eSpace, eNum,eeText,eQuote} CharType; { i = 0; pChar++; - while( (isEnd(*pChar) != 2) && (CheckSpecial(pChar) != eQuote)) + while( (isEnd(*pChar) != 2) && (CheckSpecial(pChar) != eQuote) && i < 250) { if (*pChar == '\\') { pBueffel[i] = Tcl_Backslash(pChar, &n); @@ -479,6 +479,29 @@ char *Arg2Tcl0(int argc, char *argv[], char *buffer, int buffersize, char *prepe char *Arg2Tcl(int argc, char *argv[], char *buffer, int buffersize) { return Arg2Tcl0(argc, argv, buffer, buffersize, NULL); } +/*----------------------------------------------------------------------------*/ +char *sicsNextNumber(char *pStart, char pNumber[80]){ + int charCount = 0; + pNumber[0] = '\0'; + + /* advance to first digit */ + while(isspace(*pStart) && *pStart != '\0'){ + pStart++; + } + if(*pStart == '\0'){ + return NULL; + } + + /* copy */ + while(!isspace(*pStart) && *pStart != '\0' && charCount < 78){ + pNumber[charCount] = *pStart; + pStart++; + charCount++; + } + pNumber[charCount] = '\0'; + return pStart; +} + /*============================================================================ Testprogram, can be activated by defining MAIN diff --git a/splitter.h b/splitter.h index 2dfb3448..84849d38 100644 --- a/splitter.h +++ b/splitter.h @@ -93,4 +93,10 @@ typedef struct _TokenEntry { If prepend is not NULL, its contents appear untreated before the args. A space is used as separator. !*/ + char *sicsNextNumber(char *pStart, char pNumber[80]); + /*! + This function reads the next number from the string in pStart. + The number is put into pNumber, a pointer to the string after + the number is returned or NULL whne the string is exhausted. + !*/ #endif diff --git a/statemon.c b/statemon.c new file mode 100644 index 00000000..eee359e6 --- /dev/null +++ b/statemon.c @@ -0,0 +1,322 @@ +/** + * This is a state monitor. It collects all the start and stop messages + * from the device executor and from scan and batch commands. Clients can + * listen to this in order to figure out what is actually going on in a + * given SICS installation. This might in the end supersede the status code + * managment in status.c + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, January 2007 + */ +#include +#include "exeman.h" +#include "scan.h" +#include "scan.i" +#include "stptok.h" +#include "statemon.h" +#include "sicshipadaba.h" +/*==========================================================================*/ +typedef struct __STATEMON { + pObjectDescriptor pDes; + pICallBack pCall; +}StateMon; +/*============================ Callbacks =================================*/ + static int DevexecCallback(int iEvent, void *text, void *pData, + commandContext cc){ + char pDevice[132]; + int eventCode; + pStateMon self = (pStateMon)pData; + + memset(pDevice,0,132); + if(iEvent == DRIVSTAT){ + stptok(text,pDevice,131," "); + if(strstr(text,"started") != NULL){ + eventCode = STSTART; + } else if(strstr(text,"finished") != NULL) { + eventCode = STEND; + } else { + printf("Unrecognized event text from devexec in statemon.c: %s\n", + text); + return 0; + } + if(self != NULL){ + InvokeCallBack(self->pCall,eventCode,pDevice); + } + } + return 1; + } +/*---------------------------------------------------------------------------*/ +static int StateMonScanInterest(int iEvent, void *pEventData, void *pUser, + commandContext cc){ + pScanData pScan = NULL; + pStateMon self = (pStateMon)pUser; + + pScan = (pScanData)pEventData; + + if(pScan == NULL || self == NULL){ + printf("Bad StateMonScanInterst in statemon\n"); + return 0; + } + + if(iEvent == SCANSTART){ + InvokeCallBack(self->pCall,STSTART,pScan->objectName); + return 1; + }else if(iEvent == SCANEND){ + InvokeCallBack(self->pCall,STEND,pScan->objectName); + return 1; + } + return 1; +} +/*--------------------------------------------------------------------------*/ +static int ExeCallback(int iEvent, void *pEvent, void *pUser, + commandContext cc){ + pStateMon self = (pStateMon)pUser; + char *name = (char *)pEvent; + char pBueffel[131]; + + if(self == NULL || name == NULL){ + printf("Bad ExeCallback in statemon\n"); + return 0; + } + + if(iEvent == BATCHSTART){ + snprintf(pBueffel,131,"exe %s",name); + InvokeCallBack(self->pCall,STSTART,pBueffel); + return 1; + } + if(iEvent == BATCHEND){ + snprintf(pBueffel,131,"exe %s",name); + InvokeCallBack(self->pCall,STEND,pBueffel); + return 1; + } + return 0; +} +/*=============== user callbacks ============================================*/ +static int StateInterest(int iEvent, void *pEvent, void *pUser, + commandContext cc){ + SConnection *pCon = (SConnection *)pUser; + char *device = (char *)pEvent; + char buffer[256]; + + if(pCon == NULL || device == NULL){ + printf("Bad StateInterest in statemon\n"); + return 0; + } + if(iEvent == STSTART){ + snprintf(buffer,255,"STARTED = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + if(iEvent == STEND){ + snprintf(buffer,255,"FINISH = %s", device); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + return 1; +} +/*--------------------------------------------------------------------------*/ +static pHdb recurseInterestNode(pHdb current, char *pDevice){ + char pSicsdev[131], pAlias[132]; + pHdb result = NULL; + char *alias = NULL, *pPtr = NULL; + + memset(pSicsdev,0,132); + memset(pAlias,0,132); + if(current != NULL){ + if(GetHdbProperty(current,"sicsdev",pSicsdev,131) != 0){ + strtolower(pSicsdev); + if(strcmp(pSicsdev,pDevice) == 0){ + return current; + } + /* + * try to look for aliases, too + */ + alias = FindAliases(pServ->pSics,pSicsdev); + pPtr = alias; + while((pPtr = stptok(pPtr,pAlias,131,",")) != NULL){ + if(strcmp(pAlias,pDevice) == 0){ + return current; + } + } + if(alias != NULL){ + free(alias); + } + } + current = current->child; + while(current != NULL){ + result = recurseInterestNode(current, pDevice); + if(result != NULL){ + return result; + } + current = current->next; + } + } + return NULL; +} +/*--------------------------------------------------------------------------*/ +static pHdb locateInterestNode(char *device){ + char pDevice[132], pSicsdev[132]; + pHdb current = NULL, result = NULL; + + memset(pDevice,0,132); + memset(pSicsdev,0,132); + + /* + * this is to strip off exes batch file name + */ + stptok(device,pDevice,131," "); + strtolower(pDevice); + + current = GetHipadabaRoot(); + return recurseInterestNode(current,pDevice); +} +/*--------------------------------------------------------------------------*/ +static int StateHdbInterest(int iEvent, void *pEvent, void *pUser, + commandContext cc){ + SConnection *pCon = (SConnection *)pUser; + char *device = (char *)pEvent, *path = NULL; + char buffer[1024]; + pHdb node = NULL; + + if(pCon == NULL || device == NULL){ + printf("Bad StateHdbInterest in statemon\n"); + return 0; + } + node = locateInterestNode(device); + if(node != NULL){ + path = GetHipadabaPath(node); + if(iEvent == STSTART){ + snprintf(buffer,1024,"%s STARTED", path); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + if(iEvent == STEND){ + snprintf(buffer,1024,"%s FINISH", path); + SCWriteInContext(pCon,buffer,eWarning,cc); + } + } + return 1; +} +/*====================== interpreter interface ==============================*/ +static void killStateMon(void *pData){ + pStateMon self = NULL; + + self = (pStateMon)pData; + if(self != NULL){ + if(self->pDes != NULL){ + DeleteDescriptor(self->pDes); + } + if(self->pCall != NULL){ + DeleteCallBackInterface(self->pCall); + } + free(self); + } +} +/*---------------------------------------------------------------------------*/ +int StateMonFactory(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + pStateMon pNew = NULL; + commandContext cc; + pICallBack target = NULL; + void *pPtr = NULL, *exe = NULL, *pDevexec = NULL; + + exe = FindCommandData(pSics,"exe", "ExeManager"); + pDevexec = FindCommandData(pSics,"stopexe","DeviceExecutor"); + if(exe == NULL || pDevexec == NULL){ + SCWrite(pCon, + "ERROR: both the device executor and the batch file module must be installed before initialising statemon", + eError); + return 0; + } + + /* + * generate data structures + */ + strcpy(cc.deviceID,"statemon"); + cc.transID = -120; + pNew = (pStateMon)malloc(sizeof(StateMon)); + if(pNew == NULL){ + SCWrite(pCon,"ERROR: out of memory creating StateMon",eError); + return 0; + } + memset(pNew,0,sizeof(StateMon)); + pNew->pDes = CreateDescriptor("statemon"); + pNew->pCall = CreateCallBackInterface(); + if(pNew->pDes == NULL || pNew->pCall == NULL){ + SCWrite(pCon,"ERROR: out of memory creating StateMon",eError); + return 0; + } + /* + * register callbacks + */ + target = GetCallbackInterface(pDevexec); + assert(target != NULL); + RegisterCallback(target,cc,DRIVSTAT,DevexecCallback,pNew,NULL); + target = GetCallbackInterface(exe); + assert(target != NULL); + RegisterCallback(target,cc,BATCHSTART,ExeCallback,pNew,NULL); + RegisterCallback(target,cc,BATCHEND,ExeCallback,pNew,NULL); + + if(argc > 1) { + pPtr = FindCommandData(pSics,argv[1],"ScanObject"); + if(pPtr == NULL){ + SCWrite(pCon,"ERROR: failked to locate scan object",eError); + } else { + target = GetCallbackInterface(pPtr); + assert(target != NULL); + RegisterCallback(target,cc,SCANSTART,StateMonScanInterest,pNew,NULL); + RegisterCallback(target,cc,SCANEND,StateMonScanInterest,pNew,NULL); + } + } + /* + * TODO: add kill functions + */ + AddCommand(pSics,"statemon",StateMonAction,killStateMon,pNew); + return 1; +} +/*---------------------------------------------------------------------------*/ +int StateMonAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]){ + long lID; + int i; + pStateMon self = NULL; + + self = (pStateMon)pData; + assert(self != NULL); + + if(argc < 2){ + SCWrite(pCon,"ERROR: not enough arguments to statemon",eError); + return 0; + } + strtolower(argv[1]); + if(strcmp(argv[1],"interest") == 0){ + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STSTART, StateInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STEND, StateInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); + SCSendOK(pCon); + return 1; + } else if(strcmp(argv[1],"uninterest") == 0) { + for(i = 0; i < 2; i++){ + lID = SCgetCallbackID(pCon,self->pCall); + if(lID >= 0){ + RemoveCallback(self->pCall,lID); + SCUnregisterID(pCon,lID); + } + } + SCSendOK(pCon); + return 1; + } else if(strcmp(argv[1],"hdbinterest") == 0){ + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STSTART, StateHdbInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); + lID = RegisterCallback(self->pCall, SCGetContext(pCon),STEND, StateHdbInterest, + pCon, NULL); + SCRegister(pCon,pSics, self->pCall,lID); + SCSendOK(pCon); + return 1; + } + + SCWrite(pCon,"ERROR: keyword not recognized",eError); + return 0; +} diff --git a/statemon.h b/statemon.h new file mode 100644 index 00000000..686cdcd9 --- /dev/null +++ b/statemon.h @@ -0,0 +1,21 @@ +/** + * This is a state monitor. It collects all the start and stop messages + * from the device executor and from scan and batch commands. Clients can + * listen to this in order to figure out what is actually going on in a + * given SICS installation. This might in the end supersede the status code + * managment in status.c + * + * copyright: see file COPYRIGHT + * + * Mark Koennecke, January 2007 + */ +#ifndef STATEMON_H_ +#define STATEMON_H_ +typedef struct __STATEMON *pStateMon; + +/*===================== The interpreter interface ===========================*/ +int StateMonFactory(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +int StateMonAction(SConnection *pCon, SicsInterp *pSics, void *pData, + int argc, char *argv[]); +#endif /*STATEMON_H_*/ diff --git a/statistics.c b/statistics.c index 504a531d..711f00d6 100644 --- a/statistics.c +++ b/statistics.c @@ -6,14 +6,16 @@ typedef struct timeval tv_t; struct Statistics { tv_t tim; + tv_t last; + tv_t total; long cnt; char *name; Statistics *next; }; -static Statistics *current; +static Statistics *current = NULL; static tv_t last, lastStat; -static Statistics *idle = NULL, *list; +static Statistics *idle = NULL, *list = NULL; static int init = 1; /*-----------------------------------------------------------------------*/ tv_t timeDif(tv_t t1, tv_t t2) { @@ -45,28 +47,31 @@ int StatisticsCommand(SConnection *con, SicsInterp *pSics, void *pData, int argc, char *argv[]) { Statistics *p; tv_t now; - double dif, percent, dt; + double dif, percent, full, dt; gettimeofday(&now, 0); dif = timeFloat(timeDif(lastStat, now)); - SCPrintf(con, eStatus, " calls time[%] mean[ms] command"); - SCPrintf(con, eStatus, "--------------------------------------"); + SCPrintf(con, eStatus, " calls time[%] full[%] mean[ms] command"); + SCPrintf(con, eStatus, "----------------------------------------------"); for (p = list; p != NULL; p = p->next) { if (dif > 0) { percent = timeFloat(p->tim) * 100 / dif; - if (percent > 0) { + full = timeFloat(p->total) * 100 / dif; + if (full > 0 || percent > 0) { if (p->cnt > 0) { - dt = timeFloat(p->tim) * 1000.0 / p->cnt; + dt = timeFloat(p->total) * 1000.0 / p->cnt; } else { dt = 0; } - SCPrintf(con, eStatus, "%7ld %7.1f %8.2f %s", p->cnt, - percent, dt, p->name); + SCPrintf(con, eStatus, "%7ld %7.1f %7.1f %8.2f %s", p->cnt, + percent, full, dt, p->name); } } p->cnt = 0; p->tim.tv_sec = 0; p->tim.tv_usec = 0; + p->total.tv_sec = 0; + p->total.tv_usec = 0; } lastStat = now; return 1; @@ -85,6 +90,9 @@ Statistics *StatisticsNew(char *name) { new->cnt = 0; new->tim.tv_sec = 0; new->tim.tv_usec = 0; + new->total.tv_sec = 0; + new->total.tv_usec = 0; + new->last.tv_sec = -1; new->next = list; new->name = strdup(name); list = new; @@ -114,28 +122,35 @@ void StatisticsKill(Statistics *stat) { free(stat); } /*-----------------------------------------------------------------------*/ -static void StatisticsSet(Statistics *stat) { - tv_t now; - - if (stat != NULL) { - gettimeofday(&now, 0); - timeAdd(¤t->tim, timeDif(last, now)); - last = now; - } - current = stat; -} -/*-----------------------------------------------------------------------*/ Statistics *StatisticsBegin(Statistics *stat) { Statistics *res; - + tv_t now; + res = current; - StatisticsSet(stat); - current->cnt ++; + gettimeofday(&now, 0); + if(current != NULL){ + timeAdd(¤t->tim, timeDif(last, now)); + } + last = now; + current = stat; + stat->last = now; + stat->cnt ++; return res; } /*-----------------------------------------------------------------------*/ void StatisticsEnd(Statistics *stat) { - StatisticsSet(stat); + tv_t now; + + gettimeofday(&now, 0); + timeAdd(¤t->tim, timeDif(last, now)); + last = now; + if(current != NULL){ + if (current->last.tv_sec >= 0) { + timeAdd(¤t->total, timeDif(current->last, now)); + } + current->last.tv_sec = -1; + } + current = stat; } /*-----------------------------------------------------------------------*/ void StatisticsInit(void) { diff --git a/stringdict.c b/stringdict.c index 10219bfe..9cbf0c0a 100644 --- a/stringdict.c +++ b/stringdict.c @@ -75,12 +75,13 @@ return pNew; } /*------------------------------------------------------------------------*/ - void DeleteStringDict(pStringDict self) + void DeleteStringDict(pStringDict self) { int iRet; SDE sVal; assert(self); + iRet = LLDnodePtr2First(self->iList); while(iRet != 0) { diff --git a/tasdrive.c b/tasdrive.c index b0211af6..de3fff85 100644 --- a/tasdrive.c +++ b/tasdrive.c @@ -34,6 +34,11 @@ static long TASSetValue(void *pData, SConnection *pCon, ptasMot self = (ptasMot)pData; assert(self); + if(self->code > 5 && self->math->tasMode == ELASTIC){ + SCWrite(pCon,"ERROR: cannot drive this motor in elastic mode", + eError); + return HWFault; + } setTasPar(&self->math->target,self->math->tasMode,self->code,value); self->math->mustDrive = 1; return OKOK; @@ -132,6 +137,10 @@ static float TASGetValue(void *pData, SConnection *pCon){ self->math->mustRecalculate = 0; } val = getTasPar(self->math->current,self->code); + if(self->code > 5 && self->math->tasMode == ELASTIC){ + SCWrite(pCon,"WARNING: value for this motor is meaningless in elastic mode", + eWarning); + } return (float)val; } /*-----------------------------------------------------------------*/ @@ -202,6 +211,13 @@ static void writeMotPos(SConnection *pCon, int silent, char *name, SCWrite(pCon,pBueffel,eWarning); } } +/*--------------------------------------------------------------------------*/ +static float getMotorValue(pMotor mot, SConnection *pCon){ + float val; + + MotorGetSoftPosition(mot,pCon,&val); + return val; +} /*---------------------------------------------------------------------------*/ static int startMotors(ptasMot self, tasAngles angles, SConnection *pCon, int driveQ, int driveTilt){ @@ -213,7 +229,7 @@ static int startMotors(ptasMot self, tasAngles angles, /* monochromator */ - val = self->math->motors[A1]->pDrivInt->GetValue(self->math->motors[A1],pCon); + val = getMotorValue(self->math->motors[A1],pCon); if(ABS(val - angles.monochromator_two_theta/2.) > MOTPREC){ status = self->math->motors[A1]->pDrivInt->SetValue(self->math->motors[A1], pCon, @@ -224,7 +240,7 @@ static int startMotors(ptasMot self, tasAngles angles, } writeMotPos(pCon,silent,"a1",val, angles.monochromator_two_theta/2.); - val = self->math->motors[A2]->pDrivInt->GetValue(self->math->motors[A2],pCon); + val = getMotorValue(self->math->motors[A2],pCon); if(ABS(val - angles.monochromator_two_theta) > MOTPREC){ status = self->math->motors[A2]->pDrivInt->SetValue(self->math->motors[A2], pCon, @@ -238,7 +254,8 @@ static int startMotors(ptasMot self, tasAngles angles, if(self->math->motors[MCV] != NULL){ curve = maCalcVerticalCurvature(self->math->machine.monochromator, angles.monochromator_two_theta); - val = self->math->motors[MCV]->pDrivInt->GetValue(self->math->motors[MCV],pCon); + + val = getMotorValue(self->math->motors[MCV],pCon); if(ABS(val - curve) > MOTPREC){ status = self->math->motors[MCV]->pDrivInt->SetValue(self->math->motors[MCV], pCon, @@ -253,7 +270,8 @@ static int startMotors(ptasMot self, tasAngles angles, if(self->math->motors[MCH] != NULL){ curve = maCalcHorizontalCurvature(self->math->machine.monochromator, angles.monochromator_two_theta); - val = self->math->motors[MCH]->pDrivInt->GetValue(self->math->motors[MCH],pCon); + + val = getMotorValue(self->math->motors[MCH],pCon); if(ABS(val - curve) > MOTPREC){ status = self->math->motors[MCH]->pDrivInt->SetValue(self->math->motors[MCH], pCon, @@ -269,8 +287,7 @@ static int startMotors(ptasMot self, tasAngles angles, analyzer */ if(self->math->tasMode != ELASTIC){ - val = self->math->motors[A5]->pDrivInt->GetValue(self->math->motors[A5], - pCon); + val = getMotorValue(self->math->motors[A5],pCon); if(ABS(val - angles.analyzer_two_theta/2.) > MOTPREC){ status = self->math->motors[A5]->pDrivInt->SetValue(self->math->motors[A5], pCon, @@ -282,7 +299,7 @@ static int startMotors(ptasMot self, tasAngles angles, writeMotPos(pCon,silent,self->math->motors[A5]->name, val, angles.analyzer_two_theta/2.); - val = self->math->motors[A6]->pDrivInt->GetValue(self->math->motors[A6],pCon); + val = getMotorValue(self->math->motors[A6],pCon); if(ABS(val - angles.analyzer_two_theta) > MOTPREC){ status = self->math->motors[A6]->pDrivInt->SetValue(self->math->motors[A6], pCon, @@ -296,7 +313,7 @@ static int startMotors(ptasMot self, tasAngles angles, if(self->math->motors[ACV] != NULL){ curve = maCalcVerticalCurvature(self->math->machine.analyzer, angles.analyzer_two_theta); - val = self->math->motors[ACV]->pDrivInt->GetValue(self->math->motors[ACV],pCon); + val = getMotorValue(self->math->motors[ACV],pCon); if(ABS(val - curve) > MOTPREC){ status = self->math->motors[ACV]->pDrivInt->SetValue(self->math->motors[ACV], pCon, @@ -310,8 +327,7 @@ static int startMotors(ptasMot self, tasAngles angles, if(self->math->motors[ACH] != NULL){ curve = maCalcHorizontalCurvature(self->math->machine.analyzer, angles.analyzer_two_theta); - val = self->math->motors[ACH]->pDrivInt->GetValue(self->math->motors[ACH], - pCon); + val = getMotorValue(self->math->motors[ACH],pCon); if(ABS(val - curve) > MOTPREC){ status = self->math->motors[ACH]->pDrivInt->SetValue(self->math->motors[ACH], pCon, @@ -320,8 +336,8 @@ static int startMotors(ptasMot self, tasAngles angles, return status; } } + writeMotPos(pCon,silent,"ach",val, curve); } - writeMotPos(pCon,silent,"ach",val, curve); } if(driveQ == 0){ @@ -331,7 +347,7 @@ static int startMotors(ptasMot self, tasAngles angles, /* crystal */ - val = self->math->motors[A3]->pDrivInt->GetValue(self->math->motors[A3],pCon); + val = getMotorValue(self->math->motors[A3],pCon); if(ABS(val - angles.a3) > MOTPREC){ status = self->math->motors[A3]->pDrivInt->SetValue(self->math->motors[A3], pCon, @@ -342,7 +358,7 @@ static int startMotors(ptasMot self, tasAngles angles, } writeMotPos(pCon,silent,"a3",val, angles.a3); - val = self->math->motors[A4]->pDrivInt->GetValue(self->math->motors[A4],pCon); + val = getMotorValue(self->math->motors[A4],pCon); if(ABS(val - angles.sample_two_theta) > MOTPREC){ status = self->math->motors[A4]->pDrivInt->SetValue(self->math->motors[A4], pCon, @@ -354,7 +370,7 @@ static int startMotors(ptasMot self, tasAngles angles, writeMotPos(pCon,silent,"a4",val, angles.sample_two_theta); if(driveTilt == 1){ - val = self->math->motors[SGL]->pDrivInt->GetValue(self->math->motors[SGL],pCon); + val = getMotorValue(self->math->motors[SGL],pCon); if(ABS(val - angles.sgl) > MOTPREC){ status = self->math->motors[SGL]->pDrivInt->SetValue(self->math->motors[SGL], pCon, @@ -365,7 +381,7 @@ static int startMotors(ptasMot self, tasAngles angles, } writeMotPos(pCon,silent,"sgl",val, angles.sgl); - val = self->math->motors[SGU]->pDrivInt->GetValue(self->math->motors[SGU],pCon); + val = getMotorValue(self->math->motors[SGU],pCon); if(ABS(val - angles.sgu) > MOTPREC){ status = self->math->motors[SGU]->pDrivInt->SetValue(self->math->motors[SGU], pCon, diff --git a/tasub.c b/tasub.c index 0db04c9f..48b0ad0f 100644 --- a/tasub.c +++ b/tasub.c @@ -9,6 +9,7 @@ #include #include "sics.h" #include "lld.h" +#include "trigd.h" #include "tasub.h" #include "tasdrive.h" /*------------------- motor indexes in motor data structure ---------*/ @@ -242,7 +243,7 @@ int TasUBFactory(SConnection *pCon,SicsInterp *pSics, void *pData, return 0; } if(argc > 2 && argc < 14){ - SCWrite(pCon,"ERROR: not enough motor names specified form MakeTasUB",eError); + SCWrite(pCon,"ERROR: not enough motor names specified for MakeTasUB",eError); return 0; } pNew = MakeTasUB(); @@ -414,7 +415,7 @@ static int getCrystalParameters(pmaCrystal crystal, SConnection *pCon, SCWrite(pCon,pBueffel,eValue); return 1; }else if(strcmp(argv[2],"vb2") == 0){ - snprintf(pBueffel,131,"%s.%s.vb2 = %f",argv[0],argv[1],crystal->VB1); + snprintf(pBueffel,131,"%s.%s.vb2 = %f",argv[0],argv[1],crystal->VB2); SCWrite(pCon,pBueffel,eValue); return 1; }else if(strcmp(argv[2],"ss") == 0){ @@ -874,9 +875,175 @@ static void listDiagnostik(ptasUB self, SConnection *pCon){ status = LLDnodePtr2Next(self->reflectionList); } } +/*-----------------------------------------------------------------*/ +static int addAuxReflection(ptasUB self, SConnection *pCon, + SicsInterp *pSics, int argc, char *argv[]){ + int status; + tasReflection r1, r2; + float value = -999.99; + char pBueffel[256]; + MATRIX UB = NULL, B = NULL; + + if(argc < 5){ + SCWrite(pCon, + "ERROR: not enough arguments auxiliary reflection, need HKL", + eError); + return 0; + } + + if(!SCMatchRights(pCon,usUser)){ + return 0; + } + + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[2],&r2.qe.qh); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[2]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[3],&r2.qe.qk); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[3]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[4],&r2.qe.ql); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[4]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + + B = mat_creat(3,3,ZERO_MATRIX); + if(B == NULL){ + SCWrite(pCon,"ERROR: out of memory creating B matrix",eError); + return 0; + } + status = calculateBMatrix(self->cell,B); + if(status < 0){ + SCWrite(pCon,"ERROR: bad cell constants, no volume",eError); + mat_free(B); + return 0; + } + + status = findReflection(self->reflectionList, 0,&r1); + if(status != 1){ + r2.qe.kf = self->current.kf; + r2.qe.ki = self->current.ki; + MotorGetSoftPosition(self->motors[A3],pCon,&value); + r2.angles.a3 = value + 180.; + r2.angles.sgu = .0; + r2.angles.sgl = .0; + calcTwoTheta(B,r2.qe,self->machine.ss_sample,&r2.angles.sample_two_theta); + r1 = r2; + } + + status = makeAuxReflection(B, r1, &r2,self->machine.ss_sample); + mat_free(B); + if(status < 0){ + SCWrite(pCon,"ERROR: out of memory in makeAuxUB or scattering angle not closed", + eError); + return 0; + } + LLDnodeAppend(self->reflectionList,&r2); + SCSendOK(pCon); + return 1; +} +/*------------------------------------------------------------------*/ +static int calcAuxUB(ptasUB self, SConnection *pCon, SicsInterp *pSics, + int argc, char *argv[]){ + int status; + tasReflection r1, r2; + char pBueffel[256]; + MATRIX UB = NULL, B = NULL; + + if(argc < 5){ + SCWrite(pCon, + "ERROR: not enough arguments for UB calculation, need HKL of second plane vector", + eError); + return 0; + } + + if(!SCMatchRights(pCon,usUser)){ + return 0; + } + + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[2],&r2.qe.qh); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[2]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[3],&r2.qe.qk); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[3]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + status = Tcl_GetDouble(InterpGetTcl(pSics),argv[4],&r2.qe.ql); + if(status != TCL_OK){ + snprintf(pBueffel,255,"ERROR: failed to convert %s to number",argv[4]); + SCWrite(pCon,pBueffel,eError); + return 0; + } + + status = findReflection(self->reflectionList, 0,&r1); + if(status != 1){ + snprintf(pBueffel,255,"ERROR: cannot find first reflection"); + SCWrite(pCon,pBueffel,eError); + return 0; + } + B = mat_creat(3,3,ZERO_MATRIX); + if(B == NULL){ + SCWrite(pCon,"ERROR: out of memory creating B matrix",eError); + return 0; + } + status = calculateBMatrix(self->cell,B); + if(status < 0){ + SCWrite(pCon,"ERROR: bad cell constants, no volume",eError); + mat_free(B); + return 0; + } + + status = makeAuxReflection(B, r1, &r2,self->machine.ss_sample); + mat_free(B); + if(status < 0){ + SCWrite(pCon,"ERROR: out of memory in makeAuxUB",eError); + return 0; + } + + UB = calcTasUBFromTwoReflections(self->cell,r1,r2,&status); + if(UB == NULL){ + switch(status){ + case UBNOMEMORY: + SCWrite(pCon,"ERROR: out of memory calculating UB matrix",eError); + break; + case REC_NO_VOLUME: + SCWrite(pCon,"ERROR: bad cell constants, no volume",eError); + break; + } + return 0; + } + if(mat_det(UB) < .000001){ + SCWrite(pCon,"ERROR: invalid UB matrix, check reflections",eError); + return 0; + } + if(self->machine.UB != NULL){ + mat_free(self->machine.UB); + } + if(self->machine.planeNormal != NULL){ + mat_free(self->machine.planeNormal); + } + self->machine.UB = UB; + self->machine.planeNormal = calcPlaneNormal(r1,r2); + self->ubValid = 1; + SCparChange(pCon); + SCSendOK(pCon); + return 1; +} /*------------------------------------------------------------------*/ static int calcUB(ptasUB self, SConnection *pCon, SicsInterp *pSics, - int argc, char *argv[]){ + int argc, char *argv[]){ int idx1, idx2, status; tasReflection r1, r2; char pBueffel[256]; @@ -884,8 +1051,8 @@ static int calcUB(ptasUB self, SConnection *pCon, SicsInterp *pSics, if(argc < 4){ SCWrite(pCon, - "ERROR: not enough arguments for UB calculation, need index of two reflections", - eError); + "ERROR: not enough arguments for UB calculation, need index of two reflections", + eError); return 0; } @@ -952,6 +1119,54 @@ static int calcUB(ptasUB self, SConnection *pCon, SicsInterp *pSics, SCparChange(pCon); return 1; } +/*-----------------------------------------------------------------*/ +static int calcUBFromCell(ptasUB self, SConnection *pCon){ + MATRIX B, U, UB; + tasReflection r1; + int status; + + B = mat_creat(3,3,UNIT_MATRIX); + U = mat_creat(3,3,UNIT_MATRIX); + status = findReflection(self->reflectionList, 0,&r1); + if(status == 1) { + /* + U[0][0] = Cosd(r1.angles.a3); + U[0][1] = -Sind(r1.angles.a3); + U[1][0] = Sind(r1.angles.a3); + U[1][1] = Cosd(r1.angles.a3); + */ + } + if(B == NULL || U == NULL){ + SCWrite(pCon,"ERROR: out of memory in calcUBFromCell",eError); + return 0; + } + status = calculateBMatrix(self->cell,B); + if(status == REC_NO_VOLUME){ + SCWrite(pCon,"ERROR: cell has no volume",eError); + return 0; + } + UB = mat_mul(U,B); + if(UB == NULL){ + SCWrite(pCon,"ERROR: matrix multiplication failed",eError); + return 0; + } + if(mat_det(UB) < .000001){ + SCWrite(pCon,"ERROR: invalid UB matrix, check reflections",eError); + return 0; + } + if(self->machine.UB != NULL){ + mat_free(self->machine.UB); + } + self->machine.UB = UB; + self->machine.planeNormal[0][0] = .0; + self->machine.planeNormal[1][0] = .0; + self->machine.planeNormal[2][0] = 1.; + self->ubValid = 1; + SCparChange(pCon); + mat_free(U); + mat_free(B); + return 1; +} /*------------------------------------------------------------------*/ static int calcRefAngles(ptasUB self, SConnection *pCon, SicsInterp *pSics, @@ -1395,9 +1610,13 @@ int TasUBWrapper(SConnection *pCon,SicsInterp *pSics, void *pData, strtolower(argv[1]); if(strcmp(argv[1],"mono") == 0){ - return handleCrystalCommands(&self->machine.monochromator,pCon,argc,argv); + status = handleCrystalCommands(&self->machine.monochromator,pCon,argc,argv); + self->mustRecalculate = 1; + return status; } else if(strcmp(argv[1],"ana") == 0){ - return handleCrystalCommands(&self->machine.analyzer,pCon,argc,argv); + status = handleCrystalCommands(&self->machine.analyzer,pCon,argc,argv); + self->mustRecalculate = 1; + return status; }else if(strcmp(argv[1],"cell") == 0){ if(argc > 2){ return tasReadCell(pCon,self,argc,argv); @@ -1421,6 +1640,12 @@ int TasUBWrapper(SConnection *pCon,SicsInterp *pSics, void *pData, return 1; } else if(strcmp(argv[1],"makeub") == 0){ return calcUB(self,pCon,pSics,argc,argv); + } else if(strcmp(argv[1],"makeauxub") == 0){ + return calcAuxUB(self,pCon,pSics,argc,argv); + } else if(strcmp(argv[1],"addauxref") == 0){ + return addAuxReflection(self,pCon,pSics,argc,argv); + } else if(strcmp(argv[1],"makeubfromcell") == 0){ + return calcUBFromCell(self,pCon); } else if(strcmp(argv[1],"calcang") == 0){ return calcRefAngles(self,pCon,pSics,argc,argv); } else if(strcmp(argv[1],"calcqe") == 0){ diff --git a/tasublib.c b/tasublib.c index 4d8a45f3..eee5a650 100644 --- a/tasublib.c +++ b/tasublib.c @@ -139,6 +139,38 @@ static double calcTheta(double ki, double kf, double two_theta){ return rtan(ABS(ki) - ABS(kf)*Cosd(two_theta), ABS(kf)*Sind(two_theta))/DEGREE_RAD; } +/*-------------------------------------------------------------------------*/ +double tasAngleBetweenReflections(MATRIX B, tasReflection r1, tasReflection r2){ + MATRIX chi1, chi2, h1, h2; + double angle; + + h1 = makeVector(); + if(h1 == NULL){ + return -9999.99; + } + h1[0][0] = r1.qe.qh; + h1[1][0] = r1.qe.qk; + h1[2][0] = r1.qe.ql; + + h2 = makeVector(); + if(h2 == NULL){ + return -999.99; + } + h2[0][0] = r2.qe.qh; + h2[1][0] = r2.qe.qk; + h2[2][0] = r2.qe.ql; + + chi1 = mat_mul(B,h1); + chi2 = mat_mul(B,h2); + if(chi1 != NULL && chi2 != NULL){ + angle = angleBetween(chi1,chi2); + killVector(chi1); + killVector(chi2); + } + killVector(h1); + killVector(h2); + return angle; +} /*--------------------------------------------------------------------*/ static MATRIX uFromAngles(double om, double sgu, double sgl){ MATRIX u; @@ -161,6 +193,82 @@ static MATRIX calcTasUVectorFromAngles(tasReflection r){ om = r.angles.a3 - theta; return uFromAngles(om,r.angles.sgu, r.angles.sgl); } +/*-----------------------------------------------------------------------------*/ +static MATRIX tasReflectionToQC(tasQEPosition r, MATRIX UB){ + MATRIX Q, QC; + + Q = makeVector(); + if(Q == NULL){ + return NULL; + } + vectorSet(Q,0,r.qh); + vectorSet(Q,1,r.qk); + vectorSet(Q,2,r.ql); + QC = mat_mul(UB,Q); + killVector(Q); + return QC; +} +/*-----------------------------------------------------------------*/ +int makeAuxReflection(MATRIX B, tasReflection r1, tasReflection *r2, + int ss){ + double theta, om, q, cos2t; + MATRIX QC; + + r2->angles = r1.angles; + r2->qe.ki = r1.qe.ki; + r2->qe.kf= r1.qe.kf; + + theta = calcTheta(r1.qe.ki,r1.qe.kf,r1.angles.sample_two_theta); + om = r1.angles.a3 - theta; + om += tasAngleBetweenReflections(B,r1,*r2); + + QC = tasReflectionToHC(r2->qe,B); + if(QC == NULL){ + return UBNOMEMORY; + } + + q = vectorLength(QC); + q = 2.*PI*vectorLength(QC); + cos2t = (r1.qe.ki*r1.qe.ki + r1.qe.kf*r1.qe.kf - q*q)/ + (2. * ABS(r1.qe.ki) * ABS(r1.qe.kf)); + if(ABS(cos2t) > 1.){ + killVector(QC); + return TRIANGLENOTCLOSED; + } + r2->angles.sample_two_theta = ss*Acosd(cos2t); + theta = calcTheta(r1.qe.ki,r1.qe.kf,r2->angles.sample_two_theta); + r2->angles.a3 = om + theta; + r2->angles.a3 -= 180.; + if(r2->angles.a3 < -180.){ + r2->angles.a3 += 360.; + } + mat_free(QC); + + return 1; +} +/*------------------------------------------------------------------*/ +int calcTwoTheta(MATRIX B, tasQEPosition ref, int ss, double *value){ + MATRIX QC; + double cos2t, q; + + QC = tasReflectionToHC(ref,B); + if(QC == NULL){ + return UBNOMEMORY; + } + + q = vectorLength(QC); + q = 2.*PI*vectorLength(QC); + killVector(QC); + + cos2t = (ref.ki*ref.ki + ref.kf*ref.kf - q*q)/ + (2. * ABS(ref.ki) * ABS(ref.kf)); + if(ABS(cos2t) > 1.){ + return TRIANGLENOTCLOSED; + } + *value = ss*Acosd(cos2t); + + return 1; +} /*-------------------------------------------------------------------*/ MATRIX calcPlaneNormal(tasReflection r1, tasReflection r2){ MATRIX u1 = NULL, u2 = NULL, planeNormal = NULL; @@ -326,21 +434,6 @@ static MATRIX buildTVMatrix(MATRIX U1V, MATRIX U2V){ killVector(T3V); return T; } -/*-----------------------------------------------------------------------------*/ -static MATRIX tasReflectionToQC(tasQEPosition r, MATRIX UB){ - MATRIX Q, QC; - - Q = makeVector(); - if(Q == NULL){ - return NULL; - } - vectorSet(Q,0,r.qh); - vectorSet(Q,1,r.qk); - vectorSet(Q,2,r.ql); - QC = mat_mul(UB,Q); - killVector(Q); - return QC; -} /*----------------------------------------------------------------------------*/ static MATRIX buildRMatrix(MATRIX UB, MATRIX planeNormal, tasQEPosition qe, int *errorCode){ diff --git a/tasublib.h b/tasublib.h index 1bbfe463..fa8ee5bf 100644 --- a/tasublib.h +++ b/tasublib.h @@ -124,6 +124,28 @@ double maCalcHorizontalCurvature(maCrystal data, double two_theta); */ double maCalcK(maCrystal data, double two_theta); /*======================= reciprocal space =============================*/ +/** + * make an auxiliary reflection which has the same sgu and sgl as r1, but + * an omega which is adjusted to the angle difference between r1 and + * the target. This is useful for generating an auxilairy UB during + * alignment. + * @param B The B matrix + * @param r1 The first reflection + * @param r2 a pointer to the second reflection, QH, QK, QL initialized + * @param ss The scattering sense at the sample + * @return 1 on success, a negative error code on failure. + */ +int makeAuxReflection(MATRIX B, tasReflection r1, + tasReflection *r2, int ss); +/** + * calculate two theta for the reflection ref + * @param B the metric matrix, or the UB + * @param ref The reflection for which to calculate two theta + * @param ss The scattering sense + * @param twoTheta The new two theta value (output) + * @return a negative error code on failure, 1 on success + */ +int calcTwoTheta(MATRIX B, tasQEPosition ref, int ss, double *twoTheta); /** * calculate a UB from two reflections and the cell. * @param cell The lattice constant of the crystal diff --git a/tcl/analyzedevexeclog b/tcl/analyzedevexeclog new file mode 100755 index 00000000..d6efdbb3 --- /dev/null +++ b/tcl/analyzedevexeclog @@ -0,0 +1,274 @@ +#!/usr/bin/tclsh +#----------------------------------------------------------------------------- +# This program analyses a devexec log as written by SICS. It should produce +# a list of devices together with the time each device was active +# in seconds. +# +# Mark Koennecke, January 2007 +#---------------------------------------------------------------------------- +# Some utility routines for processing an entry in the devexeclog. A line +# has the form: +# DEVEXEC:OP:DEVICE:SECONDS:NANOSECONDS +# This is split into a list and accessor function are provided for various +# items +#--------------------------------------------------------------------------- +proc parseLogLine {line} { + set l [split $line :] + set tst [lindex $l 0] + if {[string compare $tst DEVEXEC] != 0} { + error "Bad log line: $line" + } + return [lrange $l 1 end] +} +#-------------------------------------------------------------------------- +proc getLogOp {logList} { + return [lindex $logList 0] +} +#-------------------------------------------------------------------------- +proc getLogDevice {logList} { + return [lindex $logList 1] +} +#-------------------------------------------------------------------------- +proc getLogSeconds {logList} { + return [lindex $logList 2] +} +#-------------------------------------------------------------------------- +proc getLogNanos {logList} { + return [lindex $logList 3] +} +#------------------------------------------------------------------------- +proc getStamp {logList} { + return [lrange $logList 2 end] +} +#========================================================================== +proc calcTimeDiff {sec1 nano1 sec2 nano2} { + set secSum 0 + set nanoSum 0 + if {$sec2 > $sec1} { + set nanoSum [expr 1000000 - $nano1] + set secSum [expr $sec2 - $sec1 + 1] + set nanoSum [expr $nanoSum + $nano2] + } elseif {$sec2 == $sec1} { + set secSum 0 + set nanoSum [expr $nano2 - $nano1] + } else { + error "Bad time order: sec2 should be bigger then sec1" + } + return [list $secSum $nanoSum] +} +#========================================================================= +# There are two arrays: +# One is called devices and holds the device name and the total number +# of seconds this device has run. There are special devices: +# - nobeam for couting NOBEAM time. This has later to be subtracted from +# counting times. +# - unallocated time which can not be clearly given to some device +# This might happen if the SICServer restarts whilst something is +# running. +# +# The other one is running and holds all the devices which are currently +# being run. For each such device a list will be held with seconds +# and nanos. At each Start and stop, time differences to the previous +# event will be calculated and added to the devices running. If more then +# one device is running at a given time, the time will be distributed +# equally to all devices. +# +# There is also a counter for devices which are currently running. +# +# This section now provides helper functions for dealing with these +# arrays +#======================================================================== +set devRun 0 +set devices(nobeam) 0 +set devices(unaccounted) 0 +set sicsRestart 0 +#------------------------------------------------------------------------ +proc addToDevice {dev sec nano} { + upvar #0 devices devices + set totalSec [expr double($sec) + double($nano)/1000000.0] + if {[info exists devices($dev)] } { + set devices($dev) [expr $devices($dev) + $totalSec] + } else { + set devices($dev) $totalSec + } +} +#------------------------------------------------------------------------ +proc addToRunning {dev sec nano} { + upvar #0 running running devRun devRun + if {[info exists running($dev)] } { + set l $running($dev) + set newSec [expr double([lindex $l 0]) + double($sec)] + set newNano [expr double([lindex $l 1]) + double($nano)] + set running($dev) [list $newSec $newNano] + } else { + set running($dev) [list $sec $nano] + incr devRun + } +} +#------------------------------------------------------------------------ +proc stopRunning {dev} { + upvar #0 running running devRun devRun devices devices + set l $running($dev) + addToDevice $dev [lindex $l 0] [lindex $l 1] + incr devRun -1 + unset running($dev) +} +#----------------------------------------------------------------------- +proc isDevRunning {dev} { + upvar #0 running running + return [info exists running($dev)] +} +#------------------------------------------------------------------------ +proc cancelAll {} { + upvar #0 running running devRun devRun devices devices + upvar #0 sicsRestart sicsRestart + if {$devRun > 0} { + incr sicsRestart + } + set runlist [array names running] + foreach dev $runlist { + puts stdout "Live restart on device $dev" + set l $running($dev) + addToDevice unaccounted [lindex $l 0] [lindex $l 1] + unset running($dev) + } + set devRun 0 +} +#--------------------------------------------------------------------- +proc addRunDiff {dev stamp lastStamp} { + upvar #0 running running devRun devRun + + set diff [calcTimeDiff [lindex $lastStamp 0] \ + [lindex $lastStamp 1] \ + [lindex $stamp 0]\ + [lindex $stamp 1]] + if {![info exists running($dev)] } { + addToRunning $dev 0 0 + } + set disSec [expr double([lindex $diff 0])/double($devRun)] + set disNano [expr double([lindex $diff 1])/double($devRun)] + set devlist [array names running] + foreach d $devlist { + addToRunning $d $disSec $disNano + } +} +#--------------------------------------------------------------------- +proc clearAll {} { + upvar #0 devRun devRun __lastStamp lastStamp __nobeamStamp nobeamStamp + upvar #0 devices devices running running sicsRestart sicsRestart + set devRun 0 + catch {unset lastStamp} + catch {unset nobeamStamp} + set l [array names devices] + foreach d $l { + unset devices($d) + } + set l [array names running] + foreach d $l { + unset running($d) + } + set devices(nobeam) 0 + set devices(unaccounted) 0 + set sicsRestart 0 +} +#======================================================================= +# This section contains the code with the main interpretation and +# analysis +#======================================================================= +proc analyzeLine {line after} { + upvar #0 devRun devRun __lastStamp lastStamp __nobeamStamp nobeamStamp + set log [parseLogLine $line] + set afterSec [clock scan $after] + set op [getLogOp $log] + set t [getLogSeconds $log] + if {$t < $afterSec} { + return + } + switch $op { + START { + set dev [getLogDevice $log] + if {[string compare $dev SICS] == 0} { + cancelAll + return + } + if {$devRun > 0} { + set stamp [getStamp $log] + addRunDiff $dev $stamp $lastStamp + set lastStamp $stamp + } else { + if {![isDevRunning $dev] } { + addToRunning $dev 0 0 + set lastStamp [getStamp $log] + } + } + } + STOP { + if {![info exists lastStamp]} { + return + } + set dev [getLogDevice $log] + if {[string compare $dev SICS] == 0} { + cancelAll + return + } + set stamp [getStamp $log] + addRunDiff $dev $stamp $lastStamp + if {[isDevRunning $dev] } { + stopRunning $dev + } + if {$devRun == 0} { + unset lastStamp + } + } + NOBEAM { + set nobeamStamp [getStamp $log] + } + CONTINUE { + set stamp [getStamp $log] + set diff [calcTimeDiff [lindex $nobeamStamp 0] \ + [lindex $nobeamStamp 1] \ + [lindex $stamp 0]\ + [lindex $stamp 1]] + addToDevice nobeam [lindex $diff 0] [lindex $diff 1] + unset nobeamStamp + } + } +} +#========================================================================== +proc printResult {} { + upvar #0 devices devices sicsRestart sicsRestart + set l [array names devices] + puts stdout "DEVICE SECONDS" + foreach dev $l { + puts stdout [format "%-20s %12.2f" $dev $devices($dev)] + } + puts stdout [format "%-20s %12.2f" "Live Restarts" $sicsRestart] +} +#========================================================================= +proc analyzeFile {filename after} { + set f [open $filename r] + while {[gets $f line] >= 0} { + set status [catch {analyzeLine $line $after} msg] + if {$status != 0} { + puts stdout "ERROR: error $msg processing $line" + } + } + close $f +} +#=============== MAIN Program =========================================== +proc main {} { + global argv + if {[llength $argv] < 2} { + puts stdout "Usage:\n\tanalysedevexeclog filename after" + puts stdout "\t with after being a date in format MM/DD/YYYY" + exit 1 + } + + analyzeFile [lindex $argv 0] [lindex $argv 1] + + printResult +} + +main +exit 0 + diff --git a/tcl/gumxml.tcl b/tcl/gumxml.tcl new file mode 100644 index 00000000..c51065ef --- /dev/null +++ b/tcl/gumxml.tcl @@ -0,0 +1,51 @@ +proc getdataType {path} { + return [lindex [split [hinfo $path] ,] 0] +} + +proc make_nodes {path result indent} { +set nodename [file tail $path]; +set type [getdataType $path] +set prefix [string repeat " " $indent] +set newIndent [expr $indent + 2] + + append result "$prefix\n" + foreach p [property_elements $path $newIndent] { + append result $p + } + foreach x [hlist $path] { + set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent] + } + append result "$prefix\n" +} + +proc property_elements {path indent} { + set prefix [string repeat " " $indent] + foreach {key value} [string map {= " "} [hlistprop $path]] { + lappend proplist "$prefix\n" + foreach v [split $value ,] { + lappend proplist "$prefix$prefix$v\n" + } + lappend proplist "$prefix\n" + } + if [info exists proplist] {return $proplist} +} + +proc getgumtreexml {path} { + append result "\n" + append result "\n" + + if {[string compare $path "/" ] == 0} { + foreach n [hlist $path] { + set result [make_nodes $n $result 2] + } + } else { + set result [make_nodes $path $result 2] + } + + append result "\n" +} + +if {[info exists guminit] == 0} { + set guminit 1 + Publish getgumtreexml Spy +} diff --git a/tcl/makemodrivskel b/tcl/makemodrivskel new file mode 100755 index 00000000..b5c14321 --- /dev/null +++ b/tcl/makemodrivskel @@ -0,0 +1,177 @@ +#!/usr/bin/tclsh +#------------------------------------------------------------------------------ +# Make the skeleton for a motor driver +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, July 2006 +#------------------------------------------------------------------------------ +if { [llength $argv] < 1} { + puts stdout "Usage:\n\tmakemodrivskel prefix" + exit 1 +} + +set prefix [lindex $argv 0] +#----------------------------------------------------------------------------- +proc stdCast {} { + global prefix + puts stdout " ${prefix}MotorDriver *self = NULL;" + puts stdout " " + puts stdout " self = (${prefix}MotorDriver *)data;" +} + +#----------------- output datastructure +puts stdout "#include " +puts stdout "#include " +puts stdout "#include " +puts stdout "typedef struct __${prefix}MoDriv{" +puts stdout " /* general motor driver interface " +puts stdout " fields. REQUIRED!" +puts stdout " */" +puts stdout " float fUpper; /* upper limit */" +puts stdout " float fLower; /* lower limit */" +puts stdout " char *name;" +puts stdout " int (*GetPosition)(void *self, float *fPos);" +puts stdout " int (*RunTo)(void *self,float fNewVal);" +puts stdout " int (*GetStatus)(void *self);" +puts stdout " void (*GetError)(void *self, int *iCode, char *buffer, int iBufLen);" +puts stdout " int (*TryAndFixIt)(void *self, int iError,float fNew);" +puts stdout " int (*Halt)(void *self);" +puts stdout " int (*GetDriverPar)(void *self, char *name, " +puts stdout " float *value);" +puts stdout " int (*SetDriverPar)(void *self,SConnection *pCon," +puts stdout " char *name, float newValue);" +puts stdout " void (*ListDriverPar)(void *self, char *motorName," +puts stdout " SConnection *pCon);" +puts stdout " void (*KillPrivate)(void *self);" +puts stdout " /* your drivers private fields follow below */" +puts stdout " } ${prefix}MotorDriver;" +puts stdout " " + + +puts stdout "/*================================================================" +puts stdout " GetPos returns OKOK on success, HWFault on failure " +puts stdout "------------------------------------------------------------------*/" +puts stdout "static int ${prefix}GetPos(void *data, float *fPos){" +stdCast +puts stdout " return OKOK;" +puts stdout "}" + +puts stdout "/*----------------------------------------------------------------" +puts stdout " RunTo starts the motor running. Returns OKOK on success, HWfault" +puts stdout " on Errors" +puts stdout "------------------------------------------------------------------*/" +puts stdout "static int ${prefix}RunTo(void *data, float newValue){" +stdCast +puts stdout " return OKOK;" +puts stdout "}" + +puts stdout "/*-----------------------------------------------------------------" +puts stdout " CheckStatus queries the sattus of a running motor. Possible return" +puts stdout " values can be:" +puts stdout " HWBusy : motor still running" +puts stdout " HWFault : motor error detected" +puts stdout " HWPosFault : motor finished, but position not reached" +puts stdout " HWIdle : motor finished OK" +puts stdout " HWWarn : motor issued warning" +puts stdout "--------------------------------------------------------------------*/" +puts stdout "static int ${prefix}CheckStatus(void *data){" +stdCast +puts stdout " return HWIdle;" +puts stdout "}" + +puts stdout "/*------------------------------------------------------------------" +puts stdout " GetError gets more information about error which occurred" +puts stdout " *iCode is an integer error code to be used in TryFixIt as indicator" +puts stdout " buffer is a buffer for a text description of the problem" +puts stdout " iBufLen is the length of buffer" +puts stdout "--------------------------------------------------------------------*/" +puts stdout "static void ${prefix}GetError(void *data, int *iCode, char *buffer," +puts stdout " int iBufLen){" +stdCast +puts stdout "}" + +puts stdout "/*------------------------------------------------------------------" +puts stdout " TryAndFixIt tries everything which is possible in software to fix " +puts stdout " a problem. iError is the error code from GetError, newValue is " +puts stdout " the target value for the motor" +puts stdout " Possible retrun values are:" +puts stdout " MOTOK : everything fixed" +puts stdout " MOTREDO : try again " +puts stdout " MOTFAIL : cannot fix this" +puts stdout "--------------------------------------------------------------------*/" +puts stdout "static int ${prefix}FixIt(void *data, int iError, float newValue){" +stdCast +puts stdout " return MOTFAIL;" +puts stdout "}" + +puts stdout "/*-------------------------------------------------------------------" +puts stdout " Halt tries to stop the motor. Halt errors are ignored" +puts stdout "---------------------------------------------------------------------*/" +puts stdout "static int ${prefix}Halt(void *data){" +stdCast +puts stdout " return 1;" +puts stdout "}" + +puts stdout "/*--------------------------------------------------------------------" +puts stdout " GetDriverPar retrieves the value of a driver parameter." +puts stdout " Name is the name of the parameter, fValue the value when found." +puts stdout " Returns 0 on success, 0 else" +puts stdout "-----------------------------------------------------------------------*/" +puts stdout "static int ${prefix}GetDriverPar(void *data, char *name, float *value){" +stdCast +puts stdout " return 0;" +puts stdout "}" + +puts stdout "/*----------------------------------------------------------------------" +puts stdout " SetDriverPar sets a driver parameter. Returns 0 on failure, 1 on " +puts stdout " success. Name is the parameter name, pCon the connection to report" +puts stdout " errors too, value the new value" +puts stdout "------------------------------------------------------------------------*/" +puts stdout "static int ${prefix}SetDriverPar(void *data, SConnection *pCon," +puts stdout " char *name, float value){" +stdCast +puts stdout " return 0;" +puts stdout "}" + +puts stdout "/*-----------------------------------------------------------------------" +puts stdout " ListDriverPar lists the names and values of driver parameters to " +puts stdout " pCon. Motorname is the name of the motor ro prefix to the listing." +puts stdout "-------------------------------------------------------------------------*/" +puts stdout "static void ${prefix}ListDriverPar(void *data, char *motorname, " +puts stdout " SConnection *pCon){" +stdCast +puts stdout "}" + +puts stdout "/*-----------------------------------------------------------------------" +puts stdout " KillPrivate has the task to delete possibly dynamically allocated " +puts stdout " memory in the private part of the driver structure" +puts stdout "------------------------------------------------------------------------*/" +puts stdout "static void ${prefix}KillPrivate(void *data){" +stdCast +puts stdout "}" + +puts stdout "/*=======================================================================*/" +puts stdout "MotorDriver *${prefix}MakeMotorDriver(void) {" +puts stdout " ${prefix}MotorDriver *pNew = NULL;" +puts stdout "" +puts stdout " pNew = malloc(sizeof(${prefix}MotorDriver));" +puts stdout " if(pNew == NULL){" +puts stdout " return NULL;" +puts stdout " }" +puts stdout " memset(pNew,0,sizeof(${prefix}MotorDriver));" +puts stdout " " +puts stdout " pNew->GetPosition = ${prefix}GetPos;" +puts stdout " pNew->RunTo = ${prefix}RunTo;" +puts stdout " pNew->Halt = ${prefix}Halt;" +puts stdout " pNew->GetStatus = ${prefix}CheckStatus;" +puts stdout " pNew->GetError = ${prefix}GetError;" +puts stdout " pNew->TryAndFixIt = ${prefix}FixIt;" +puts stdout " pNew->GetDriverPar = ${prefix}GetDriverPar;" +puts stdout " pNew->SetDriverPar = ${prefix}SetDriverPar;" +puts stdout " pNew->ListDriverPar = ${prefix}ListDriverPar;" +puts stdout " pNew->KillPrivate = ${prefix}KillPrivate;" +puts stdout " " +puts stdout " return (MotorDriver *)pNew;" +puts stdout "}" +puts stdout "" diff --git a/tcl/ritaframe b/tcl/ritaframe new file mode 100755 index 00000000..97b46a3e --- /dev/null +++ b/tcl/ritaframe @@ -0,0 +1,51 @@ +#!/usr/bin/tclsh +#-------------------------------------------------------------------------- +# script for extracting a frame of rita data from a file and to dump +# the frame into an ASCII file +# +# Mark Koennecke, November 2006 +#------------------------------------------------------------------------- +set loadnx "/afs/psi.ch/project/sinq/sl-linux/lib/" +load [file join $loadnx nxinter.so] + +if {$argc < 2} { + puts stdout "Usage:\n\tritaframe filename number" + exit 1 +} +set num [lindex $argv 1] + +set f [nx_open [lindex $argv 0] $NXACC_READ] +nx_openpath $f /entry1/data/counts +set info [nx_getinfo $f] +set dim1 [expr int([get_nxds_value $info 2])] +set dim2 [expr int([get_nxds_value $info 3])] +set nFrames [expr int([get_nxds_value $info 4])] +if {$num < 0 || $num > $nFrames-1} { + nx_close $f + puts stdout "Requested frame out of range" + exit1 +} +set start [create_nxds 1 $NX_INT32 3] +set end [create_nxds 1 $NX_INT32 3] +put_nxds_value $start 0 0 +put_nxds_value $start 0 1 +put_nxds_value $start $num 2 + +put_nxds_value $end $dim1 0 +put_nxds_value $end $dim2 1 +put_nxds_value $end 1 2 + +set data [nx_getslab $f $start $end] +for {set y 0} {$y < $dim2} {incr y} { + for {set x 0} {$x < $dim1} {incr x} { + set val [expr int([get_nxds_value $data $x $y])] + puts -nonewline stdout [format " %8d" $val] + } + puts stdout "" +} +drop_nxds $start +drop_nxds $end +drop_nxds $data + +nx_close $f +exit 0 diff --git a/tcl/tjxp b/tcl/tjxp new file mode 100755 index 00000000..3f7682c8 --- /dev/null +++ b/tcl/tjxp @@ -0,0 +1,73 @@ +#!/usr/bin/tclsh +#---------------------------------------------------------------------- +# This is a Tcl template processor in the style of JSP tags. Unmarked +# text is left alone. But there is special markup: +# <% script %> execute Tcl script and output result +# <%=var%> print The Tcl variable var +# <%! script%> execute the script and print nothing +# +# copyright: GPL +# +# Mark Koennecke, November 2006 +#---------------------------------------------------------------------- +proc loadTemplate {input} { + return [read $input] +} +#--------------------------------------------------------------------- +proc processScript {script} { + set startChar [string index $script 0] + if {[string equal $startChar =] == 1 } { + set varName [string trim [string range $script 1 end]] + set cmd [format "return \$%s" $varName] + return [uplevel #0 $cmd] + } elseif {[string equal $startChar !] == 1} { + set script [string range $script 1 end] + uplevel #0 $script + } else { + return [uplevel #0 $script] + } + return "" +} +#---------------------------------------------------------------------- +# process The template: read template from input, +# write to output channel +#---------------------------------------------------------------------- +proc processTemplate {input output} { + set template [loadTemplate $input] + set current 0 + set start [string first "<%" $template] + set end [string first "%>" $template $start] + while {$start >= 0} { + if {$end < 0} { + error "Found start tag but no end in $template" + } + puts -nonewline $output [string range $template $current \ + [expr $start -1]] + set script [string range $template [expr $start +2] \ + [expr $end -1]] + set txt [processScript $script] + if {[string length $txt] >= 1} { + puts -nonewline $output $txt + } + set template [string range $template [expr $end +2] end] + set start [string first "<%" $template] + set end [string first "%>" $template $start] + + } + puts -nonewline $output $template +} +#================ MAIN ================================================ +if {$argc < 2} { + puts stdout "Usage:\n\ttjxp infile outfile" + puts stdout "\t Outfile can be - for stdout" + exit 1 +} +set in [open [lindex $argv 0] r] +set outfile [lindex $argv 1] +if {[string equal [string trim $outfile] -] == 1} { + set out stdout +} else { + set out [open $outfile w] +} +processTemplate $in $out +exit 0 diff --git a/tcl/tjxphelp b/tcl/tjxphelp new file mode 100644 index 00000000..c5847ac1 --- /dev/null +++ b/tcl/tjxphelp @@ -0,0 +1,38 @@ + + + Tcl Template Processing System. + + This is a test file and help text for my Tcl template processing + system. It was inspired by JSP and JXP. But is in my favourite + scripting language Tcl. Basically it allows to mix Tcl scripts with + text. The text can contain special marks which are then executed as + Tcl scripts in a variety of ways. Three tags are supported: + + <%! set var waschmaschine %> + + This tag executes the Tcl script but prints nothing, except may + be error messages. Please note that this can be used to source + more Tcl files which contains procedures you need for doing your + work. + + <%=var %> prints the value of the Tcl variable var. When processed, + this should print waschmaschine. + + <% set a [list 1 2 3] + join $a + %> + executes the Tcl code within and prints the result. This should be + 1 2 3. + + All Tcl code is executed at global level. There is nothing more to + this. All this was done in 75 lines of Tcl, including comments! You + should be able to process this file through tjxp to see what you get. + Txjp is brough to you by: + + Mark Koennecke, Mark.Koennecke@psi.ch + + txjp is copyrighted under the GNU Public Licence 2.0, which you can + find elsewhere. + + Enjoy! + \ No newline at end of file diff --git a/test/DataNumber b/test/DataNumber new file mode 100644 index 00000000..00a6883b --- /dev/null +++ b/test/DataNumber @@ -0,0 +1,3 @@ + 75 +NEVER, EVER modify or delete this file +You'll risk eternal damnation and a reincarnation as a cockroach!|n \ No newline at end of file diff --git a/test/batchtest.tcl b/test/batchtest.tcl new file mode 100644 index 00000000..a78dca36 --- /dev/null +++ b/test/batchtest.tcl @@ -0,0 +1,128 @@ +#------------------------------------------------------------------------------ +# This is a set of regression tests for the batch processing feauture +# in SICS +# +# Mark Koennecke, October 2006 +#------------------------------------------------------------------------------ + +puts stdout "Testing batch processing" + +test batch-1.0 {Test Batch File Execution} -body { + config rights User User + set result [eval exe job1.tcl] + if {[string first TERMINATED $result] < 0} { + error "Failed to process batch file" + } + if {[string first Job1 $result] < 0} { + error "Output from batch file missing, received: $result" + } + return OK +} -result OK + +test batch-1.1 {Test Batch File Interruption} -body { + config rights User user + exec ./interrupt.tcl & + set result [eval exe job1.tcl] + if {[string first TERMINATED $result] < 0} { + error "Failed to process batch file" + } + if {[string first interrupted $result] < 0} { + error "Interrupting did not work" + } + return OK +} -result OK + +test batch-1.2 {Test Nested Batch File Execution} -body { + config rights User user + set result [eval exe job2.tcl] + if {[string first TERMINATED $result] < 0} { + error "Failed to process batch file" + } + if {[string first NestOne $result] < 0} { + error "Output from batch file missing" + } + if {[string first NestTwo $result] < 0} { + error "Output from batch file missing" + } + if {[string first NestThree $result] < 0} { + error "Output from batch file missing" + } + return OK +} -result OK + +test batch-1.3 {Test Nested Batch File Interruption} -body { + config rights User user + exec ./interrupt.tcl & + set result [eval exe job2.tcl] + if {[string first TERMINATED $result] < 0} { + error "Failed to process batch file" + } + if {[string first NestOne $result] < 0} { + error "Output from batch file missing" + } + if {[string first NestTwo $result] < 0} { + error "Output from batch file missing" + } + if {[string first NestThree $result] < 0} { + error "Output from batch file missing" + } + if {[string first interrupted $result] < 0} { + error "Interrupting did not work" + } + return OK +} -result OK + +test batch-1.4 {Test Path Parameters} -body { + testPar "exe batchpath" tmp User + testPar "exe syspath" tmp Mugger + return OK +} -result OK + +test batch-1.5 {Test Path Failure} -body { + config rights Mugger Mugger + exe batchpath tmp + exe syspath tmp + set result [exe job4.tcl] + if {[string first "not found" $result] < 0} { + error "Batch file found which should not" + } + exe batchpath ./ + exe syspath ./ + return OK +} -result OK + +test batch-1.6 {Test Uploading} -body { + config rights User User + catch {exec rm hugo.job} + testOK "exe upload" + testOK "exe append clientput hugo" + testOK "exe append wait 2" + testOK "exe save hugo.job" + testOK "exe upload" + testOK "exe append clientput hugo" + testOK "exe append wait 2" + set stat [catch {testOK "exe save hugo.job" } msg ] + if {$stat == 0} { + error "Failed to trigger overwrite error" + } + testOK "exe forcesave hugo.job" + return OK +} -result OK + +test batch-1.7 {Test Notifications} -body { + config rights User User + testOK "exe interest" + set result [eval exe job4.tcl] + if {[string first BATCHSTART $result] < 0} { + error "BATCHSTART missing" + } + if {[string first BATCHEND $result] < 0} { + error "BATCHEND missing" + } + if {[string first job4.tcl.range $result] < 0} { + error "Range entries missing" + } + return OK +} -result OK + + diff --git a/test/countertest.tcl b/test/countertest.tcl new file mode 100644 index 00000000..4b814687 --- /dev/null +++ b/test/countertest.tcl @@ -0,0 +1,271 @@ +#------------------------------------------------------------- +# Testing of the counter module +# +# The regression counter has various errortypes which can be simulated: +# 0 = none +# 1 = failed start +# 2 = status failure +# 3 = pause fail +# 4 = continue fail +# 5 = failed read +# +# Another parameter is recover which causes the problem to go away +# when 1 +# +# TODO: What shall happen when pausing fails? Currently it continues +# counting. This may be exactly what we need, but???? +# +# This code needs the counter name two times: once as countername and +# as errorname. The purpose is that this module may be used for testing +# both the real and the multi counter. +# +# Mark Koennecke, September 2006 +#------------------------------------------------------------- +#set countername aba +#set errorname aba + +puts stdout "Testing counter: $countername" + +#--------------------------------------------------------------- +config rights Mugger Mugger +$errorname setpar errortype 1 0 + +test counter-1.0 {Test Mode Setting} -body { + config rights Spy Spy + set res [eval $countername setmode monitor] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval $countername setmode monitor] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "$countername getmode"] + compareValue [string tolower $readback] monitor + config rights Spy Spy + set res [eval $countername setmode timer] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval $countername setmode timer] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "$countername getmode"] + compareValue [string tolower $readback] timer + return "OK" +} -result OK +#------------------------------------------------------------------- +test counter-1.1 {Test Preset Setting} -body { + config rights Spy Spy + set val 12 + set res [eval $countername setpreset $val] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval $countername setpreset $val] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "$countername getpreset"] + compareValue $readback $val + return "OK" +} -result OK +#--------------------------------------------------------------------- +test counter-1.3 {Test Normal Counting} -body { + config rights Spy Spy + set status [catch {testNBCounting "$countername countnb 10" 11} msg] + if {$status == 0} { + error "Counted in spite of lacking privilege" + } + config rights User User + testNBCounting "$countername countnb 10" 11 +} -result OK +#--------------------------------------------------------------------- +test counter-1.4 {Test Blocking Counting} -body { + config rights Spy Spy + set status [catch {testBlockCounting "$countername countnb 10" 11} msg] + if {$status == 0} { + error "Counted in spite of lacking privilege" + } + config rights User User + testBlockCounting "$countername countnb 10" 11 +} -result OK +#-------------------------------------------------------------------- +test counter-1.5 {Interrupted Counting} -body { + testInterruptedCount "$countername countnb 100" +} -result OK +#-------------------------------------------------------------------- +config rights User User + +test counter-1.51 {Pause Counting Test} -body { + global socke + $countername countnb 300 + exec sleep 1 + set ans [status] + if {[string first Counting $ans] < 0} { + error "Failed to start counting: $ans" + } + pause + exec sleep 1 + set ans [status] + if {[string first Paus $ans] < 0} { + error "Failed to pause counting: $ans" + } + puts $socke continue + flush $socke + exec sleep 1 + set ans [status] + if {[string first Count $ans] < 0} { + error "Failed to continue counting: $ans" + } + puts $socke "INT1712 3" + flush $socke + set ans [status] + return OK +} -result OK +#--------------------------------------------------------- +test counter-1.52 {Pause Interrupt Test} -body { + global socke + $countername countnb 300 + exec sleep 2 + set ans [status] + if {[string first Counting $ans] < 0} { + error "Failed to start counting: $ans" + } + pause + exec sleep 1 + set ans [status] + if {[string first Paus $ans] < 0} { + error "Failed to pause counting: $ans" + } + puts $socke "INT1712 3" + flush $socke + set ans [status] + if {[string first Eager $ans] < 0} { + error "Failed to interrupt paused counting: $ans" + } + return OK +} -result OK +#------------------------------------------------------------------- +test counter-1.53 {Counter Value Read Test} -body { + config rights User User + $countername count 10 + set ans [SICSValue "$countername gettime"] + compareValue $ans 10 + set ans [SICSValue "$countername getcounts"] + compareValue $ans 5 + set ans [SICSValue "$countername getmonitor 1"] + compareValue $ans 10 + set ans [SICSValue "$countername getmonitor 2"] + compareValue $ans 25 + set ans [SICSValue "$countername getmonitor 3"] + compareValue $ans 35 + set ans [SICSValue "$countername getmonitor 4"] + compareValue $ans 45 + set ans [SICSValue "$countername getmonitor 5"] + compareValue $ans 55 + set ans [SICSValue "$countername getmonitor 6"] + compareValue $ans 65 + return OK +} -result OK +#-------------------------------------------------------------------- +config rights Mugger Mugger +$errorname setpar errortype 1 1 +$errorname setpar recover 1 0 + +test counter-1.6 {Counting Start Failure} -body { + set ans [$countername countnb 100] + if { [string first "Counting aborted" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + return OK +} -result OK +#--------------------------------------------------------------- +$errorname setpar errortype 1 1 +$errorname setpar recover 1 1 + +test counter-1.7 {Counting Start Failure with Recovery} -body { + set ans [$countername countnb 10] + if { [string first "WARNING" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + set ans [SICSValue status] + if {[string first Counting $ans] < 0} { + error "Did not recover from start failure" + } + exec sleep 12 + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after start failure" + } + return OK +} -result OK +#---------------------------------------------------------------------- +$errorname setpar errortype 1 2 +$errorname setpar recover 1 0 + +test counter-1.8 {Counting Status Failure} -body { + set ans [$countername countnb 100] + set ans [status] + if { [string first "Full Stop called" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + return OK +} -result OK +#--------------------------------------------------------------- +$errorname setpar errortype 1 2 +$errorname setpar recover 1 1 + +test counter-1.9 {Counting Status Failure with Recovery} -body { + set ans [$countername countnb 10] + set ans [status] + if { [string first "WARNING" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + if {[string first Counting $ans] < 0} { + error "Did not recover from status failure" + } + exec sleep 12 + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after status failure" + } + return OK +} -result OK +#------------------------------------------------------------------- +$errorname setpar errortype 1 5 +$errorname setpar recover 1 0 + +test counter-1.10 {Counter Read Failure} -body { + set ans [$countername count 2] + if { [string first "Full Stop" $ans] < 0} { + error "Failed to trigger count read failure: $ans" + } + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after read failure" + } + return OK +} -result OK + +#---------------------------------------------------------------- +$errorname setpar errortype 1 5 +$errorname setpar recover 1 1 + +test counter-1.10 {Counter Read Recover} -body { + set ans [$countername count 2] + if { [string first "WARN" $ans] < 0} { + error "Failed to trigger count read failure: $ans" + } + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after read failure" + } + return OK +} -result OK + + diff --git a/test/histtest.tcl b/test/histtest.tcl new file mode 100644 index 00000000..c48f48ba --- /dev/null +++ b/test/histtest.tcl @@ -0,0 +1,342 @@ +#--------------------------------------------------------------------------- +# This is for testing the histogram memory code +# The errortypes are the same as in the counter module +# +# Mark Koennecke, October 2006 +#--------------------------------------------------------------------------- +puts stdout "Testing Histogram Memory" +config rights Mugger Mugegr +hm config errotype 0 +hm init + +test hm-1.0 {Test Mode Setting} -body { + config rights Spy Spy + set res [eval hm countmode monitor] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval hm countmode monitor] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "hm countmode"] + compareValue [string tolower $readback] monitor + config rights Spy Spy + set res [eval hm countmode timer] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval hm countmode timer] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "hm countmode"] + compareValue [string tolower $readback] timer + return OK +} -result OK +#------------------------------------------------------------------- +test hm-1.1 {Test Preset Setting} -body { + config rights Spy Spy + set val 12 + set res [eval hm preset $val] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights User User + set res [eval hm preset $val] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue "hm preset"] + compareValue $readback $val + return "OK" +} -result OK +#--------------------------------------------------------------------- +test hm-1.3 {Test Normal Counting} -body { + config rights Spy Spy + set status [catch {testNBCounting "hm count" 11} msg] + if {$status == 0} { + error "Counted in spite of lacking privilege" + } + config rights User User + testOK "hm countmode timer" + testOK "hm preset 5" + testNBCounting "hm count" 11 +} -result OK +#--------------------------------------------------------------------- +test hm-1.4 {Test Blocking Counting} -body { + config rights Spy Spy + set status [catch {testBlockCounting "hm countblock" 11} msg] + if {$status == 0} { + error "Counted in spite of lacking privilege" + } + config rights User User + testBlockCounting "hm countblock" 11 +} -result OK +#-------------------------------------------------------------------- +test hm-1.5 {Interrupted Counting} -body { + hm preset 10 + testInterruptedCount "hm count" +} -result OK +#-------------------------------------------------------------------- +config rights User User + +test hm-1.51 {Pause Counting Test} -body { + global socke + hm preset 300 + hm count + exec sleep 1 + set ans [status] + if {[string first Counting $ans] < 0} { + error "Failed to start counting: $ans" + } + pause + exec sleep 1 + set ans [status] + if {[string first Paus $ans] < 0} { + error "Failed to pause counting: $ans" + } + puts $socke continue + flush $socke + exec sleep 1 + set ans [status] + if {[string first Count $ans] < 0} { + error "Failed to continue counting: $ans" + } + puts $socke "INT1712 3" + flush $socke + set ans [status] + return OK +} -result OK +#--------------------------------------------------------- +test hm-1.52 {Pause Interrupt Test} -body { + global socke + hm count 300 + exec sleep 2 + set ans [status] + if {[string first Counting $ans] < 0} { + error "Failed to start counting: $ans" + } + pause + exec sleep 1 + set ans [status] + if {[string first Paus $ans] < 0} { + error "Failed to pause counting: $ans" + } + puts $socke "INT1712 3" + flush $socke + set ans [status] + if {[string first Eager $ans] < 0} { + error "Failed to interrupt paused counting: $ans" + } + return OK +} -result OK +#-------------------------------------------------------------------- +config rights Mugger Mugger +hm configure errortype 1 +hm configure recover 0 +hm init +hm preset 10 + +test hm-1.6 {Counting Start Failure} -body { + set ans [hm count] + if { [string first "cannot start" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + return OK +} -result OK +#------------------------------------------------------------------------- +hm configure errortype 1 +hm configure recover 1 +hm init + +test hm-1.7 {Counting Start Failure with Recovery} -body { + set ans [hm count] + if { [string first "WARNING" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + set ans [SICSValue status] + if {[string first Counting $ans] < 0} { + error "Did not recover from start failure" + } + exec sleep 15 + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after start failure" + } + return OK +} -result OK +#---------------------------------------------------------------------- +hm configure errortype 2 +hm configure recover 0 +hm init + +test hm-1.8 {Counting Status Failure} -body { + set ans [hm count] + set ans [status] + if { [string first "Full Stop called" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + return OK +} -result OK +#--------------------------------------------------------------- +hm configure errortype 2 +hm configure recover 1 +hm init + +test hm-1.9 {Counting Status Failure with Recovery} -body { + set ans [hm count 10] + set ans [status] + if { [string first "WARNING" $ans] < 0} { + error "Failed to trigger count start failure: $ans" + } + if {[string first Counting $ans] < 0} { + error "Did not recover from status failure" + } + exec sleep 12 + set ans [SICSValue status] + if {[string first Eager $ans] < 0} { + error "Did not stop counting after status failure" + } + return OK +} -result OK +#---------------------------------------------------------------------- +hm configure errortype 0 +hm configure recover 0 +hm configure testval 3 +hm init +hm preset 2 +hm countblock + +test hm-1.10 {Test data} -body { + set expected [SICSValue "hm configure dim0"] + set data [hm get 0] + if {[string first ERROR $data] >= 0} { + error "Failed to read HM" + } + if {[string first Histogram $data] < 0} { + error "Bad response from HM" + } + set l [split $data =] + set data [lindex $l 1] + set l [split $data] + set count 0 + foreach e $l { + if {![string is space $e]} { + incr count + if {$e != 3} { + error "Bad value in HM, got $e, expected 3" + } + } + } + if {$count != $expected} { + error "HM Datasize does not match, expected $expected, got $count" + } + return OK +} -result OK + +hm configure testval 7 +hm init +hm countblock + +test hm-1.11 {Test data second} -body { + set expected [SICSValue "hm configure dim0"] + set data [hm get 0] + if {[string first ERROR $data] >= 0} { + error "Failed to read HM" + } + if {[string first Histogram $data] < 0} { + error "Bad response from HM" + } + set l [split $data =] + set data [lindex $l 1] + set l [split $data] + set count 0 + foreach e $l { + if {![string is space $e]} { + incr count + if {$e != 7} { + error "Bad value in HM, got $e, expected 3" + } + } + } + if {$count != $expected} { + error "HM Datasize does not match, expected $expected, got $count" + } + return OK +} -result OK +#-------------------------- --------------------------------------------- +test hm-1.13 {Test hm sum} -body { + set test [SICSValue "hm sum 2 4"] + if {$test != 14} { + error "Summing HM failed, expected 14 got $test" + } + return OK +} -result OK +#-------------------------------------------------------------------------- +test hm-1.14 {Test Setting Time Binning} -body { + config rights Mugger Mugger + testOK "tof genbin 50 20 70" + testOK "tof configure testval 1" + testOK "tof init" + return OK +} -result OK +#------------------------------------------------------------------------- +test hm-1.15 {Test Reading Time Binning} -body { + set tst [SICSValue "tof notimebin"] + if {$tst != 70} { + error "NTOF bad, expected 70, got $tst" + } + set tdata [SICSValue "tof timebin"] + set l [split $tdata] + set count 0 + foreach v $l { + if {![string is space $v]} { + set tval [expr 50.0 + $count*20] + if {abs($v - $tval) > 1} { + error "Bad time value $v, expected $tval" + } + incr count + } + } + if {$count < $tst} { + error "Insufficient number of timebins: $count, expected $tst" + } + return OK +} -result OK +#---------------------------------------------------------------------- +tof countmode timer +tof preset 2 +tof countblock +test hm-1.16 {Test Reading TOF Data} -body { + set ntof [SICSValue "tof notimebin"] + set dim [SICSValue "tof configure dim0"] + set alldata [expr $ntof*$dim] + set tdata [SICSValue "tof get 0"] + set l [split $tdata] + set count 0 + foreach v $l { + if {![string is space $v]} { + if {abs($v - 1) > .1} { + error "Bad data value $v, expected $tval" + } + incr count + } + } + if {$count < $alldata} { + error "Datapoints missing, got $count, expected $alldata" + } + return OK +} -result OK +#---------------------------------------------------------------------- +tof initval 1 +test hm-1.16 {Test TOF Sum} -body { + set val [SICSValue "tof sum 2 3 0 20"] + if {$val != 20 } { + error " tof sum failed, expected 20 received $val" + } + return OK +} -result OK + diff --git a/test/interrupt.tcl b/test/interrupt.tcl new file mode 100755 index 00000000..0389cbff --- /dev/null +++ b/test/interrupt.tcl @@ -0,0 +1,14 @@ +#!/usr/bin/tclsh +#------------------------------------------------------------ +# This is a little script which issues an interrupt to SICS +# after five seconds +# +# Mark Koennecke, October 2006 +#------------------------------------------------------------ +source sicstcldebug.tcl +config rights Mugger Mugger +exec sleep 5 +puts $socke "INT1712 3" +exit 1 + + \ No newline at end of file diff --git a/test/job1.tcl b/test/job1.tcl new file mode 100644 index 00000000..b0a882ec --- /dev/null +++ b/test/job1.tcl @@ -0,0 +1,5 @@ +#---------------------------------------------------------- +# One of the job files for testing batch file processing +#---------------------------------------------------------- +clientput "Job1 batch file" +wait 20 diff --git a/test/job2.tcl b/test/job2.tcl new file mode 100644 index 00000000..6dae8a59 --- /dev/null +++ b/test/job2.tcl @@ -0,0 +1,6 @@ +#---------------------------------------------------------- +# One of the job files for testing batch file processing +#---------------------------------------------------------- +clientput "NestOne" +exe job3.tcl +wait 3 diff --git a/test/job3.tcl b/test/job3.tcl new file mode 100644 index 00000000..155bdc1a --- /dev/null +++ b/test/job3.tcl @@ -0,0 +1,6 @@ +#---------------------------------------------------------- +# One of the job files for testing batch file processing +#---------------------------------------------------------- +clientput "NestTwo" +exe job4.tcl +wait 3 diff --git a/test/job4.tcl b/test/job4.tcl new file mode 100644 index 00000000..8d562ec6 --- /dev/null +++ b/test/job4.tcl @@ -0,0 +1,5 @@ +#---------------------------------------------------------- +# One of the job files for testing batch file processing +#---------------------------------------------------------- +clientput "NestThree" +wait 3 diff --git a/test/mottest.tcl b/test/mottest.tcl new file mode 100644 index 00000000..9c6f7b23 --- /dev/null +++ b/test/mottest.tcl @@ -0,0 +1,303 @@ +#------------------------------------------------------------------------------ +# Regression tests fo a motor. It is assumed that the motors name is +# brumm and that it has been initialized with the regress motor +# driver. Moreover, this has to be loaded after tcltest.tcl, testutil.tcl +# and sicstcldebug.tcl +# +# The regression motor has various errortypes which can be simulated: +# 0 = none +# 1 = failed start +# 2 = position fault +# 3 = hardware failure +# 4 = off position, without explicit position fault +# 5 = failed read +# 6 = keep running (for testing interupting) +# Moreover there is a recover flag which causes the motor to recover when it is +# 1 +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, July 2006 +# +#------------------------------------------------------------------------------ +puts stdout "Testing motor code" + +test motorpar-1.0 {Test sll} -body { + testPar "brumm softlowerlim" -175 User } -result OK + +test motorpar-1.1 {Test slu} -body { + testPar "brumm softupperlim" 175 User } -result OK + +test motorpar-1.2 {Test ss} -body { + testPar "brumm softzero" 5 User } -result OK + +test motorpar-1.3 {Test interrupt} -body { + testPar "brumm interruptmode" 2 Mugger } -result OK + +test motorpar-1.4 {Test accesscode} -body { + testPar "brumm accesscode" 3 Mugger } -result OK + +test motorpar-1.5 {Test precision} -body { + testPar "brumm precision" .5 Mugger } -result OK + +test motorpar-1.6 {Test fail} -body { + testPar "brumm failafter" 5 Mugger } -result OK + +test motorpar-1.7 {Test retry} -body { + testPar "brumm maxretry" 5 Mugger } -result OK + +test motorpar-1.8 {Test ignorefault} -body { + testPar "brumm ignorefault" 1 Mugger } -result OK + +test motorpar-1.9 {Test movecount} -body { + testPar "brumm movecount" 12 Mugger } -result OK + +test motorpar-1.10 {Test hardupper} -body { + testROPar "brumm hardupperlim" 180 } -result OK + +test motorpar-1.11 {Test hardlower} -body { + testROPar "brumm hardlowerlim" -180 } -result OK + +brumm recover 0 +brumm errortype 0 +test motor-1.0 {Test Normal Driving} -body { + testDrive brumm 10 User } -result OK + +brumm errortype 6 +test motor-1.1 {Test Interrupting} -body { + testDriveInterrupt brumm 0 } -result OK + +brumm errortype 1 +config rights User User + +test motor-1.2 {Test Start Failure} -body { + set ans [drive brumm 20.3] + if { [string first "Failed to start motor" $ans] < 0} { + error "Failed to trigger motor start failure: $ans" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from start failure" + } + return OK +} -result OK + +brumm recover 1 +test motor-1.3 {Test Recover from start problem} -body { + set ans [drive brumm 20.3] + if { [string first "Failed to start motor" $ans] < 0} { + error "Failed to trigger motor start failure" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from start failure" + } + compareValue [SICSValue brumm] 20.3 +} -result OK + +brumm recover 0 +brumm errortype 2 + +test motor-1.4 {Test Position Failure} -body { + set ans [drive brumm -20.3] + if { [string first "Position not reached" $ans] < 0} { + error "Failed to trigger motor position fault: $ans" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from position failure" + } + set ans [SICSValue brumm] + if {abs($ans - -20.3) < .01} { + error "Motor positioned OK inspite of position fault" + } + return OK +} -result OK + +brumm recover 1 + +test motor-1.6 {Test Position Failure Recover} -body { + set ans [drive brumm 20.3] + if { [string first "Position not reached" $ans] < 0} { + error "Failed to trigger motor position fault: $ans" + } + if { [string first "restarting" $ans] < 0} { + error "Restarting message not received" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from position failure" + } + compareValue [SICSValue brumm] 20.3 + return OK +} -result OK + +brumm errortype 3 +brumm recover 0 +test motor-1.7 {Test Hardware Failure} -body { + set ans [drive brumm 20.3] + if { [string first "Hardware is mad" $ans] < 0} { + error "Failed to trigger motor hardware fault: $ans" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from position failure" + } + set ans [SICSValue brumm] + if {abs($ans - 20.3) < .01} { + error "Motor positioned OK inspite of hardware fault" + } + return OK +} -result OK + +brumm recover 1 + +test motor-1.8 {Test Hardware Failure Recover} -body { + set ans [drive brumm 20.3] + if { [string first "Hardware is mad" $ans] < 0} { + error "Failed to trigger motor hardware fault: $ans" + } + if { [string first "restarting" $ans] < 0} { + error "Restarting message not received" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return from hardware failure" + } + compareValue [SICSValue brumm] 20.3 + return OK +} -result OK + +brumm errortype 4 + +test motor-1.9 {Test Consistent Mispositioning} -body { + set ans [drive brumm -20.3] + if { [string first "off position" $ans] < 0} { + error "Failed to trigger motor off position" + } + if { [string first "restarting" $ans] < 0} { + error "Restarting message not received" + } + if { [string first "aborting" $ans] < 0} { + error "Aborting message not received" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return after consistent position problem" + } + set ans [SICSValue brumm] + if {abs($ans - -20.3) < .01} { + error "Motor positioned OK inspite of mispositioning" + } + return OK +} -result OK + +brumm errortype 0 +drive brumm 27. + +brumm errortype 5 +brumm recover 0 + +test motor-1.10 {Failed read} -body { + set ans [brumm] + if { [string first "Failed to read" $ans] < 0} { + error "Failed to trigger motor failed read" + } + if { [string first "Error obtaining position" $ans] < 0} { + error "Failed to abort reading" + } + if { [string first "cannot fix" $ans] < 0} { + error "Missing cannot fix message" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return after failed read" + } + return OK +} -result OK +brumm recover 1 + +test motor-1.11 {Failed read recover} -body { + set ans [brumm] + if { [string first "Failed to read" $ans] < 0} { + error "Failed to trigger motor failed read" + } + if { [string first "brumm =" $ans] < 0} { + error "Motor did not return value after fixing failed read" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return after failed read" + } + return OK +} -result OK + +brumm errortype 0 +drive brumm 27. +brumm recover 0 +brumm errortype 3 + +test motor-1.12 {Motor Alarm} -body { + drive brumm -27 + drive brumm -27 + drive brumm -27 + drive brumm -27 + set ans [drive brumm -27] + if { [string first "MOTOR ALARM" $ans] < 0} { + error "Motor did not stop with Alarm" + } + set ans [status] + if { [string first "Eager" $ans] < 0} { + error "Motor did not return after Alarm" + } + brumm errortype 0 + set ans [drive brumm -27] + if { [string first "sucessfully" $ans] < 0} { + error "Motor did not recover after Alarm" + } + return OK +} -result OK + +brumm errortype 0 +config rights Mugger Mugger + +test motor-1.13 {Motor Sign} -body { + brumm sign 1 + drive brumm 27. + set old [SICSValue brumm] + brumm sign -1 + set newVal [SICSValue brumm] + set br [brumm sign] + brumm sign 1 + return [compareValue [expr $old * -1] $newVal] +} -result OK + +brumm sign 1. + +test motor-1.14 {Motor Recover} -body { + brumm sign -1. + brumm softzero 5 + set data [brumm list] + backup hugo.bck + recover hugo.bck + set newData [brumm list] + if {[string compare $data $newData] != 0} { + backup hugo2.bck + error "Recovery failed: look at diff between hugo.bck and hugo2.bck" + } + brumm sign 1 + brumm softzero 0 + set data [brumm list] + backup hugo.bck + recover hugo.bck + set newData [brumm list] + if {[string compare $data $newData] != 0} { + backup hugo2.bck + error "Recovery failed: look at diff between hugo.bck and hugo2.bck" + } + return OK +} -result OK + +config rights Spy Spy +test motorpar-1.15 {Test sign setting} -body { + testPar "brumm sign" -1 Mugger } -result OK diff --git a/test/nxscripttest.tcl b/test/nxscripttest.tcl new file mode 100644 index 00000000..6421d087 --- /dev/null +++ b/test/nxscripttest.tcl @@ -0,0 +1,106 @@ +#--------------------------------------------------------------------------- +# Regression tests for the SICS nxscript module. +# +# Mark Koennecke, November 2006 +#--------------------------------------------------------------------------- + +puts stdout "Testing NXScript" + +test nxscript-1.0 {Test opening file} -body { + config rights Spy Spy + testCommand "nxscript createxml test.xml test.dic" ERROR + config rights User User + testOK "nxscript createxml test.xml test.dic" +} -result OK + +test nxscript-1.1 {Write text} -body { + testNoError "nxscript puttext text Hugo ist eine Nassnase" +} -result OK + +test nxscript-1.2 {Write float} -body { + testNoError "nxscript putfloat testfloat 27.8" +} -result OK + +test nxscript-1.3 {Write int} -body { + testNoError "nxscript putint testint 177" +} -result OK + +drive a4 15 +a4 softzer0 1. + +test nxscript-1.4 {Write motor} -body { + testNoError "nxscript putmot testmot a4" +} -result OK + +aba count 10 +test nxscript-1.5 {Write counter} -body { + testNoError "nxscript putcounter testcter aba" +} -result OK + +hm initval 55 +test nxscript-1.6 {Write HM} -body { + testNoError "nxscript puthm testhm hm" +} -result OK + +config rights Mugger Mugger +tof genbin 500 300 20 +tof init +config rights User User + +test nxscript-1.7 {Write time binning} -body { + testNoError "nxscript puttimebinning testhmtb tof" +} -result OK + + +test nxscript-1.8 {Write array } -body { + makearray + set t [nxscript putarray testar ar 10] + if {[string first ERROR $t] >= 0 || [string first WARNING $t] >= 0} { + error "Failed to write array with: $t" + } + return OK +} -result OK + +test nxscript-1.9 {Write int array } -body { + makeintarray + set t [nxscript putintarray testintar ar 10] + if {[string first ERROR $t] >= 0 || [string first WARNING $t] >= 0} { + error "Failed to write intarray with: $t" + } + return OK +} -result OK + +test nxscript-1.10 {Write global } -body { + testNoError "nxscript putglobal Instrument Washmaschine" +} -result OK + +test nxscript-1.11 {Write attribute } -body { + testNoError "nxscript putattribute testhm signal 1" +} -result OK + +test nxscript-1.12 {Writing link } -body { + testNoError "nxscript makelink testlink text" +} -result OK + +test nxscript-1.13 {Writing sicsdata } -body { + hm initval 23 + data clear + data copyhm 0 hm + testNoError "nxscript putsicsdata testsd data" +} -result OK + +test nxscript-1.20 {Close file} -body { + testOK "nxscript close" +} -result OK + +test nxscript-1.21 {Testing file content } -body { + set status [catch {exec diff --ignore-matching-lines=file_time test.xml testsoll.xml} msg] + if {$status != 0} { + error "Difference in NXSCRIP-XML file: $msg" + } + return OK +} -result OK + + + + \ No newline at end of file diff --git a/test/object.tcl b/test/object.tcl new file mode 100644 index 00000000..c8bc5ad5 --- /dev/null +++ b/test/object.tcl @@ -0,0 +1,305 @@ +# +# $Id: object.tcl,v 1.2 2007-02-12 01:15:03 ffr Exp $ +# +# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that: (1) source code distributions +# retain the above copyright notice and this paragraph in its entirety, (2) +# distributions including binary code include the above copyright notice and +# this paragraph in its entirety in the documentation or other materials +# provided with the distribution, and (3) all advertising materials mentioning +# features or use of this software display the following acknowledgement: +# ``This product includes software developed by the University of California, +# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of +# the University nor the names of its contributors may be used to endorse +# or promote products derived from this software without specific prior +# written permission. +# +# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED +# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. +# + +set object_priv(currentClass) {} +set object_priv(objectCounter) 0 + +#---------------------------------------------------------------------- +proc object_class {name spec} { + global object_priv + set object_priv(currentClass) $name + lappend object_priv(objects) $name + upvar #0 ${name}_priv class + set class(__members) {} + set class(__methods) {} + set class(__params) {} + set class(__class_vars) {} + set class(__class_methods) {} + uplevel $spec + proc $name:config args "uplevel \[concat object_config \$args]" + proc $name:configure args "uplevel \[concat object_config \$args]" + proc $name:cget {self option} "uplevel \[list object_cget \$self \$option]" +} +#--------------------------------------------------------------------- +proc method {name args body} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + if {[lsearch $class(__methods) $name] < 0} { + lappend class(__methods) $name + } + set methodArgs self + append methodArgs " " $args + proc $className:$name $methodArgs "upvar #0 \$self slot ${className}_priv class_var\n$body" +} +#------------------------------------------------------------------ +proc object_method {name {defaultValue {}}} [info body method] +#------------------------------------------------------------------ +proc member {name {defaultValue {}}} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + lappend class(__members) [list $name $defaultValue] +} +#---------------------------------------------------------------------- +proc object_member {name {defaultValue {}}} [info body member] +#--------------------------------------------------------------------- +proc param {name {defaultValue {}} {resourceClass {}} {configCode {}}} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + if {$resourceClass == ""} { + set resourceClass \ + [string toupper [string index $name 0]][string range $name 1 end] + } + if ![info exists class(__param_info/$name)] { + lappend class(__params) $name + } + set class(__param_info/$name) [list $defaultValue $resourceClass] + if {$configCode != {}} { + proc $className:config:$name self $configCode + } +} +#------------------------------------------------------------------------- +proc object_param {name {defaultValue {}} {resourceClass {}} {configCode {}}} \ + [info body param] + +#-------------------------------------------------------------------------- +proc object_class_var {name {initialValue ""}} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + set class($name) $initialValue + set class(__initial_value.$name) $initialValue + lappend class(__class_vars) $name +} +#--------------------------------------------------------------------------- +proc object_class_method {name args body} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + if {[lsearch $class(__class_methods) $name] < 0} { + lappend class(__class_methods) $name + } + proc $className:$name $args "upvar #0 ${className}_priv class_var\n$body" +} +#--------------------------------------------------------------------------- +proc object_include {super_class_name} { + global object_priv + set className $object_priv(currentClass) + upvar #0 ${className}_priv class + upvar #0 ${super_class_name}_priv super_class + foreach p $super_class(__params) { + lappend class(__params) $p + set class(__param_info/$p) $super_class(__param_info/$p) + } + set class(__members) [concat $super_class(__members) $class(__members)] + set class(__class_vars) \ + [concat $super_class(__class_vars) $class(__class_vars)] + foreach v $super_class(__class_vars) { + set class($v) \ + [set class(__initial_value.$v) $super_class(__initial_value.$v)] + } + set class(__class_methods) \ + [concat $super_class(__class_methods) $class(__class_methods)] + set class(__methods) \ + [concat $super_class(__methods) $class(__methods)] + foreach m $super_class(__methods) { + set proc $super_class_name:$m + proc $className:$m [object_get_formals $proc] [info body $proc] + } + foreach m $super_class(__class_methods) { + set proc $super_class_name:$m + regexp "^\[^\n\]+\n(.*)" [info body $proc] dummy body + proc $className:$m [object_get_formals $proc] \ + "upvar #0 ${className}_priv class_var\n$body" + } +} +#--------------------------------------------------------------------------- +proc object_new {className {name {}}} { + if {$name == {}} { + global object_priv + set name O_[incr object_priv(objectCounter)] + } + upvar #0 $name object + upvar #0 ${className}_priv class + set object(__class) $className + foreach var $class(__params) { + set info $class(__param_info/$var) + set resourceClass [lindex $info 1] + if ![catch {set val [option get $name $var $resourceClass]}] { + if {$val == ""} { + set val [lindex $info 0] + } + } else { + set val [lindex $info 0] + } + set object($var) $val + } + foreach var $class(__members) { + set object([lindex $var 0]) [lindex $var 1] + } + proc $name {method args} [format { + upvar #0 %s object + uplevel [concat $object(__class):$method %s $args] + } $name $name] + return $name +} +#--------------------------------------------------------------- +proc object_define_creator {windowType name spec} { + object_class $name $spec + if {[info procs $name:create] == {}} { + error "widget \"$name\" must define a create method" + } + if {[info procs $name:reconfig] == {}} { + error "widget \"$name\" must define a reconfig method" + } + proc $name {window args} [format { + %s $window -class %s + rename $window object_window_of$window + upvar #0 $window object + set object(__window) $window + object_new %s $window + proc %s:frame {self args} \ + "uplevel \[concat object_window_of$window \$args]" + uplevel [concat $window config $args] + $window create + set object(__created) 1 + bind $window \ + "if !\[string compare %%W $window\] { object_delete $window }" + $window reconfig + return $window + } $windowType \ + [string toupper [string index $name 0]][string range $name 1 end] \ + $name $name] +} +#------------------------------------------------------------------ +proc object_config {self args} { + upvar #0 $self object + set len [llength $args] + if {$len == 0} { + upvar #0 $object(__class)_priv class + set result {} + foreach param $class(__params) { + set info $class(__param_info/$param) + lappend result \ + [list -$param $param [lindex $info 1] [lindex $info 0] \ + $object($param)] + } + if [info exists object(__window)] { + set result [concat $result [object_window_of$object(__window) config]] + } + return $result + } + if {$len == 1} { + upvar #0 $object(__class)_priv class + if {[string index $args 0] != "-"} { + error "param '$args' didn't start with dash" + } + set param [string range $args 1 end] + if {[set ndx [lsearch -exact $class(__params) $param]] == -1} { + if [info exists object(__window)] { + return [object_window_of$object(__window) config -$param] + } + error "no param '$args'" + } + set info $class(__param_info/$param) + return [list -$param $param [lindex $info 1] [lindex $info 0] \ + $object($param)] + } + # accumulate commands and eval them later so that no changes will take + # place if we find an error + set cmds "" + while {$args != ""} { + set fieldId [lindex $args 0] + if {[string index $fieldId 0] != "-"} { + error "param '$fieldId' didn't start with dash" + } + set fieldId [string range $fieldId 1 end] + if ![info exists object($fieldId)] { + if {[info exists object(__window)]} { + if [catch [list object_window_of$object(__window) config -$fieldId]] { + error "tried to set param '$fieldId' which did not exist." + } else { + lappend cmds \ + [list object_window_of$object(__window) config -$fieldId [lindex $args 1]] + set args [lrange $args 2 end] + continue + } + } + + } + if {[llength $args] == 1} { + return $object($fieldId) + } else { + lappend cmds [list set object($fieldId) [lindex $args 1]] + if {[info procs $object(__class):config:$fieldId] != {}} { + lappend cmds [list $self config:$fieldId] + } + set args [lrange $args 2 end] + } + } + foreach cmd $cmds { + eval $cmd + } + if {[info exists object(__created)] && [info procs $object(__class):reconfig] != {}} { + $self reconfig + } +} + +proc object_cget {self var} { + upvar #0 $self object + return [lindex [object_config $self $var] 4] +} +#--------------------------------------------------------------------------- +proc object_delete self { + upvar #0 $self object + if {[info exists object(__class)] && [info commands $object(__class):destroy] != ""} { + $object(__class):destroy $self + } + if [info exists object(__window)] { + if [string length [info commands object_window_of$self]] { + catch {rename $self {}} + rename object_window_of$self $self + } + destroy $self + } + catch {unset object} +} +#-------------------------------------------------------------------------- +proc object_slotname slot { + upvar self self + return [set self]($slot) +} +#-------------------------------------------------------------------------- +proc object_get_formals {proc} { + set formals {} + foreach arg [info args $proc] { + if [info default $proc $arg def] { + lappend formals [list $arg $def] + } else { + lappend formals $arg + } + } + return $formals +} diff --git a/test/optitest.tcl b/test/optitest.tcl new file mode 100644 index 00000000..824f311e --- /dev/null +++ b/test/optitest.tcl @@ -0,0 +1,171 @@ +#-------------------------------------------------------------------- +# This file contaisn test for the peak optimization routines in SICS +# +# Mark Koennecke, October 2006 +#------------------------------------------------------------------- +clientput "Testing optimization routines...." + +config rights Mugger Mugger +aba setpar errortype 1 0 +config rights User User + +test opt-1.0 {Test Normal Optimizer} -body { + testOK "opti clear" + testOK "opti addvar a4 .3 20 .3" + testOK "opti preset 2" + testOK "opti countmode timer" + drive a4 4. + set result [eval opti run] + if { [string first ERROR $result] > 0} { + puts stdout $result + error "Error occurred during optimization run" + } + if {[string first finished $result] < 0} { + error "Optimization did not finish normally" + } + set val [SICSValue a4] + if {abs($val - 5.3) > .1} { + error "Optimisation did not arrive at desired position" + } + return OK +} -result OK + +test opt-1.1 {Test Normal Optimizer Aborting} -body { + testOK "opti clear" + testOK "opti addvar a4 .3 20 .3" + testOK "opti preset 2" + testOK "opti countmode timer" + drive a4 4. + exec interrupt.tcl & + set result [eval opti run] + if {[string first "Scan aborted" $result] < 0} { + error "Optimiser did not abort + } + set result [status] + if { [string first Eager $result] < 0} { + puts stdout $result + error "Optimiser did not interrupt!" + } + return OK +} -result OK + +test opt-1.2 {Test Climbing } -body { + testOK "opti clear" + testOK "opti addvar a4 .3 20 .5" + testOK "opti preset 2" + testOK "opti countmode timer" + drive a4 4. + set result [eval opti climb] + if { [string first ERROR $result] > 0} { + puts stdout $result + error "Error occurred during optimization run" + } + if {[string first finished $result] < 0} { + error "Optimization did not finish normally" + } + set val [SICSValue a4] + if {abs($val - 5.3) > .5} { + error "Optimisation did not arrive at desired position" + } + return OK +} -result OK + +test opt-1.3 {Test Climbing } -body { + testOK "opti clear" + testOK "opti addvar a4 .3 20 .5" + testOK "opti preset 2" + testOK "opti countmode timer" + drive a4 6. + set result [eval opti climb] + if { [string first ERROR $result] > 0} { + puts stdout $result + error "Error occurred during optimization run" + } + if {[string first finished $result] < 0} { + error "Optimization did not finish normally" + } + set val [SICSValue a4] + if {abs($val - 5.3) > .5} { + error "Optimisation did not arrive at desired position" + } + return OK +} -result OK + +test opt-1.4 {Test Climbing Interruption} -body { + testOK "opti clear" + testOK "opti addvar a4 .3 20 .5" + testOK "opti preset 2" + testOK "opti countmode timer" + drive a4 4. + exec interrupt.tcl & + set result [eval opti climb] + if {[string first "Scan was aborted" $result] < 0} { + error "Optimiser did not abort" + } + set result [status] + if { [string first Eager $result] < 0} { + puts stdout $result + error "Optimiser did not interrupt!" + } + return OK +} -result OK + + +test opt-1.5 {Test Maximizer} -body { + drive a4 4. + set result [eval max a4 .2 timer 2] + if { [string first ERROR $result] > 0} { + puts stdout $result + error "Error occurred during maximization" + } + if {[string first Found $result] < 0} { + error "Optimization did not finish normally" + } + set val [SICSValue a4] + if {abs($val - 5.3) > .1} { + error "Maximization did not arrive at desired position" + } + return OK +} -result OK + +test opt-1.6 {Test Maximizer} -body { + drive a4 6. + set result [eval max a4 .2 timer 2] + if { [string first ERROR $result] > 0} { + puts stdout $result + error "Error occurred during maximization" + } + if {[string first Found $result] < 0} { + error "Optimization did not finish normally" + } + set val [SICSValue a4] + if {abs($val - 5.3) > .1} { + error "Maximization did not arrive at desired position" + } + return OK +} -result OK + +test opt-1.6 {Test Maximizer Aborting} -body { + drive a4 6. + exec interrupt.tcl & + set result [eval max a4 .2 timer 2] + if { [string first "Full Stop" $result] < 0} { + puts stdout $result + error "Maximize did not interrupt!" + } + set result [status] + if { [string first Eager $result] < 0} { + puts stdout $result + error "Maximize did not interrupt!" + } + return OK +} -result OK + +test opt-1.7 {Test Maximizer Parameter} -body { + testOK "max in360 1" + testOK "max maxpts 50" + testCommand "max in360" max.in360 + testCommand "max maxpts" max.maxpts + return OK +} -result OK + diff --git a/test/scancommand.tcl b/test/scancommand.tcl new file mode 100644 index 00000000..04e5ee02 --- /dev/null +++ b/test/scancommand.tcl @@ -0,0 +1,486 @@ +#-------------------------------------------------------------------------- +# general scan command wrappers for TOPSI and the like. +# New version using the object.tcl system from sntl instead of obTcl which +# caused a lot of trouble with tcl8.0 +# +# Requires the built in scan command xxxscan. +# +# Mark Koennecke, February 2000 +#-------------------------------------------------------------------------- + +source object.tcl +set recoverfil recover.bin + +#-------------------------- some utility functions ------------------------- +proc MC { t n } { + set string $t + for { set i 1 } { $i < $n } { incr i } { + set string [format "%s%s" $string $t] + } + return $string +} +#-------------------------------------------------------------------------- +proc GetNum { text } { + set list [split $text =] + return [lindex $list 1] +} +#--------------------------------------------------------------------------- + + +#************** Definition of scan class ********************************** + +object_class ScanCommand { + member Mode Monitor + member NP 1 + member counter counter + member NoVar 0 + member Preset 10000 + member File default.dat + member pinterest "" + member Channel 0 + member Active 0 + member Recover 0 + member scanvars + member scanstart + member scanstep + member pinterest + + method var {name start step} { + # check for activity + if {$slot(Active)} { + ClientPut "ERROR: cannot change parameters while scanning" error + return + } + # check parameters + set t [SICSType $name] + if { [string compare $t DRIV] != 0 } { + ClientPut [format "ERROR: %s is not drivable" $name] error + return 0 + } + set t [SICSType $start] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $start] error + return 0 + } + set t [SICSType $step] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $step] error + return 0 + } +# install the variable + set i $slot(NoVar) + incr slot(NoVar) + lappend slot(scanvars) $name + lappend slot(scanstart) $start + lappend slot(scanstep) $step + $self SendInterest pinterest ScanVarChange + ClientPut OK + } + + method info {} { + if { $slot(NoVar) < 1 } { + return "0,1,NONE,0.,0.,default.dat" + } + append result $slot(NP) "," $slot(NoVar) + for {set i 0} { $i < $slot(NoVar) } { incr i} { + append result "," [lindex $slot(scanvars) $i] + } + append result "," [lindex $slot(scanstart) 0] "," \ + [lindex $slot(scanstep) 0] + set r1 [xxxscan getfile] + set l1 [split $r1 "="] + append result "," [lindex $l1 1] + return $result + } + + method getvars {} { + set list "" + lappend list $slot(scanvars) + return [format "scan.Vars = %s -END-" $list] + } + + method xaxis {} { + if { $slot(NoVar) <= 0} { +#---- default Answer + set t [format "%s.xaxis = %f %f" $self 0 1] + } else { + set t [format "%s.xaxis = %f %f" $self [lindex $slot(scanstart) 0] \ + [lindex $slot(scanstep) 0] ] + } + ClientPut $t + } + + method cinterest {} { + xxxscan interest + } + + method uuinterest {} { + xxxscan uuinterest + } + + method pinterest {} { + set nam [GetNum [config MyName]] + lappend $slot(pinterest) $nam + } + + method SendInterest { type text } { +#------ check list first + set l1 $slot($type) + set l2 "" + foreach e $l1 { + set b [string trim $e] + set g [string trim $b "{}"] + set ret [SICSType $g] + if { [string first COM $ret] >= 0 } { + lappend l2 $e + } + } +#-------- update scan data and write + set slot($type) $l2 + foreach e $l2 { + set b [string trim $e] + $b put $text + } + } + + method mode { {NewVal NULL} } { + if { [string compare $NewVal NULL] == 0 } { + set val [format "%s.Mode = %s" $self $slot(Mode)] + ClientPut $val + return $val + } else { +# check for activity + if {$slot(Active)} { + ClientPut "ERROR: cannot change parameters while scanning" error + return + } + set tmp [string tolower $NewVal] + set NewVal $tmp + if { ([string compare $NewVal "timer"] == 0) || \ + ([string compare $NewVal monitor] ==0) } { + set slot(Mode) $NewVal + ClientPut OK + } else { + ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal] + } + } + } + + method np { { NewVal NULL } } { + if { [string compare $NewVal NULL] == 0 } { + set val [format "%s.NP = %d" $self $slot(NP)] + ClientPut $val + return $val + } else { +# check for activity + if {$slot(Active)} { + ClientPut "ERROR: cannot change parameters while scanning" error + return + } + set t [SICSType $NewVal] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number" $NewVal] error + return + } + set slot(NP) $NewVal + ClientPut OK + } + } + + method preset { {NewVal NULL} } { + if { [string compare $NewVal NULL] == 0 } { + set val [format "%s.Preset = %f" $self $slot(Preset)] + ClientPut $val + return $val + } else { +# check for activity + if {$slot(Active)} { + ClientPut "ERROR: cannot change parameters while scanning" error + return + } + set t [SICSType $NewVal] + if { [string compare $t NUM] != 0} { + ClientPut [format "ERROR: %s is no number" $NewVal] error + return + } + set slot(Preset) $NewVal + ClientPut OK + } + } + + method file {} { + return [xxxscan file] + } + + method setchannel {num} { + set ret [catch {xxxscan setchannel $num} msg] + if { $ret == 0} { + set slot(Channel) $num + } else { + return $msg + } + } + + method list { } { + ClientPut [format "%s.Preset = %f" $self $slot(Preset)] + ClientPut [format "%s.Mode = %s" $self $slot(Mode)] + ClientPut [format "%s.File = %s" $self $slot(File)] + ClientPut [format "%s.NP = %d" $self $slot(NP)] + ClientPut [format "%s.Channel = %d" $self $slot(Channel)] + ClientPut "ScanVariables:" + for { set i 0 } {$i < $slot(NoVar) } { incr i } { + ClientPut [format " %s %f %f" [lindex $slot(scanvars) $i] \ + [lindex $slot(scanstart) $i] \ + [lindex $slot(scanstep) $i] ] + } + } + + method clear {} { +# check for activity + if {$slot(Active)} { + ClientPut "ERROR: cannot clear running scan" error + return + } + + set slot(NP) 0 + set slot(NoVar) 0 + set slot(scanvars) "" + set slot(scanstart) "" + set slot(scanstep) "" + $self SendInterest pinterest ScanVarChange + xxxscan clear + ClientPut OK + } + + method getcounts {} { + return [xxxscan getcounts] + } + + method run { } { +# start with error checking + if { $slot(NP) < 1 } { + ClientPut "ERROR: Insufficient Number of ScanPoints" + return + } + if { $slot(NoVar) < 1 } { + ClientPut "ERROR: No variables to scan given!" + return + } +#------- check for activity + if {$slot(Active)} { + ClientPut "ERROR: Scan already in progress" error + return + } + set slot(Active) 1 + xxxscan clear + for {set i 0 } { $i < $slot(NoVar)} {incr i} { + set ret [catch {xxxscan add [lindex $slot(scanvars) $i] \ + [lindex $slot(scanstart) $i] [lindex $slot(scanstep) $i]} msg] + if {$ret != 0} { + set slot(Active) 0 + error $msg + } + } + set ret [catch \ + {xxxscan run $slot(NP) $slot(Mode) $slot(Preset)} msg] + set slot(Active) 0 + if {$ret != 0 } { + error $msg + } else { + return "Scan Finished" + } + } + + method recover {} { + set slot(Active) 1 + catch {xxxscan recover} msg + set slot(Active) 0 + return "Scan Finished" + } + + method forceclear {} { + set Active 0 + } +} +#---- end of ScanCommand definition + +#********************** initialisation of module commands to SICS ********** + +set ret [catch {scan list} msg] +if {$ret != 0} { + object_new ScanCommand scan + Publish scan Spy + Publish scancounts Spy + Publish textstatus Spy + Publish cscan User + Publish sscan User + Publish sftime Spy + Publish scaninfo Spy +} + +#************************************************************************* + +#===================== Helper commands for status display work ============ +# a new user command which allows status clients to read the counts in a scan +# This is just to circumvent the user protection on scan +proc scancounts { } { + set status [ catch {scan getcounts} result] + if { $status == 0 } { + return $result + } else { + return "scan.Counts= 0" + } +} +#--------------------------------------------------------------------------- +# This is just another utilility function which helps in implementing the +# status display client +proc textstatus { } { + set text [status] + return [format "Status = %s" $text] +} +#--------------------------------------------------------------------------- +# Dumps time in a useful format +proc sftime {} { + return [format "sicstime = %s" [sicstime]] +} +#------------------------------------------------------------------------- +# Utility function which gives scan parameters as an easily parsable +# comma separated list for java status client +proc scaninfo {} { + set result [scan info] + set r1 [sample] + set l1 [split $r1 "="] + append result "," [lindex $l1 1] + append result "," [sicstime] + set r1 [lastscancommand] + set l1 [split $r1 "="] + append result "," [lindex $l1 1] + return [format "scaninfo = %s" $result] +} + +#===================== Syntactical sugar around scan =================== +# center scan. A convenience scan for the one and only Daniel Clemens +# at TOPSI. Scans around a given ceter point. Requires the scan command +# for TOPSI to work. +# +# another convenience scan: +# sscan var1 start end var1 start end .... np preset +# scans var1, var2 from start to end with np steps and a preset of preset +# +# Mark Koennecke, August, 22, 1997 +#----------------------------------------------------------------------------- +proc cscan { var center delta np preset } { +#------ start with some argument checking + set t [SICSType $var] + if { [string compare $t DRIV] != 0 } { + ClientPut [format "ERROR: %s is NOT drivable!" $var] + return + } + set t [SICSType $center] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $center] + return + } + set t [SICSType $delta] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $delta] + return + } + set t [SICSType $np] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $np] + return + } + set t [SICSType $preset] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: %s is no number!" $preset] + return + } +#-------- store command in lastscancommand + set txt [format "cscan %s %s %s %s %s" $var $center \ + $delta $np $preset] + catch {lastscancommand $txt} +#-------- set standard parameters + scan clear + scan preset $preset + scan np [expr $np*2 + 1] +#--------- calculate start + set start [expr $center - $np * $delta] + set ret [catch {scan var $var $start $delta} msg] + if { $ret != 0} { + ClientPut $msg + return + } +#---------- start scan + set ret [catch {scan run} msg] + if {$ret != 0} { + error $msg + } +} +#--------------------------------------------------------------------------- +proc sscan args { + scan clear +#------- check arguments: the last two must be preset and np! + set l [llength $args] + if { $l < 5} { + ClientPut "ERROR: Insufficient number of arguments to sscan" + return + } + set preset [lindex $args [expr $l - 1]] + set np [lindex $args [expr $l - 2]] + set t [SICSType $preset] + ClientPut $t + ClientPut [string first $t "NUM"] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for preset, got %s" \ + $preset] + return + } + set t [SICSType $np] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for np, got %s" \ + $np] + return + } + scan preset $preset + scan np $np +#--------- do variables + set nvar [expr ($l - 2) / 3] + for { set i 0 } { $i < $nvar} { incr i } { + set var [lindex $args [expr $i * 3]] + set t [SICSType $var] + if {[string compare $t DRIV] != 0} { + ClientPut [format "ERROR: %s is not drivable" $var] + return + } + set start [lindex $args [expr ($i * 3) + 1]] + set t [SICSType $start] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for start, got %s" \ + $start] + return + } + set end [lindex $args [expr ($i * 3) + 2]] + set t [SICSType $end] + if { [string compare $t NUM] != 0 } { + ClientPut [format "ERROR: expected number for end, got %s" \ + $end] + return + } +#--------- do scan parameters + set step [expr double($end - $start)/double($np)] + set ret [catch {scan var $var $start $step} msg] + if { $ret != 0} { + ClientPut $msg + return + } + } +#------------- set lastcommand text + set txt [format "sscan %s" [join $args]] + catch {lastscancommand $txt} +#------------- start scan + set ret [catch {scan run} msg] + if {$ret != 0} { + error $msg + } +} diff --git a/test/scantest.tcl b/test/scantest.tcl new file mode 100644 index 00000000..2b085b24 --- /dev/null +++ b/test/scantest.tcl @@ -0,0 +1,177 @@ +#-------------------------------------------------------------------------- +# This file contains some regression tests for the SICS scan module. +# This relies on the presence of a suitable configured multicounter in +# the test initialization file. That multi counters script must have been +# configured to generate an gaussian based on a a4 position. This gaussian +# will then be used to check data and for testing peak based algorithms +# such as optimization routines, peak and center etc. +# +# Mark Koennecke, October 2006 +#-------------------------------------------------------------------------- + +clientput "Testing scan routines.." + +config rights Mugger Mugger +aba setpar errortype 1 0 +config rights User User + +proc testScanResults {} { + set result [eval peak data] + set l [split $result ,] + if { abs([lindex $l 0] - 5.3) > .1} { + error "Bad peak position" + } + if { abs([lindex $l 1] - 1.4) > .3} { + error "Bad peak FWHM" + } + if { abs([lindex $l 2] - 288) > 7} { + error "Bad peak Value" + } +} + +test scan-1.0 {Test Normal Scan} -body { + testOK "xxxscan clear" + testOK "xxxscan add a4 2. .2" + set result [eval xxxscan run 30 timer 2] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + testScanResults + return OK +} -result OK + +test scan-1.1 {Test cscan} -body { + set result [eval cscan a4 5.3 .2 15 3] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + testScanResults + return OK +} -result OK + +test scan-1.2 {Test sscan} -body { + set result [eval sscan a4 2 7 30 2] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + testScanResults + return OK +} -result OK + +test scan-1.3 {Test scan interest} -body { + testOK "xxxscan interest" + set result [eval xxxscan run 3 timer 2] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + if {[string first NewScan $result] < 0} { + error " NewScan missing" + } + if {[string first scan.Counts $result] < 0} { + error "count data missing" + } + if {[string first ScanEnd $result] < 0} { + error "ScanEnd missing" + } + xxxscan uninterest + return OK +} -result OK + +test scan-1.3.1 {Test scan uuinterest} -body { + testOK "xxxscan uuinterest" + set result [eval xxxscan run 3 timer 2] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + if {[string first NewScan $result] < 0} { + error " NewScan missing" + } + if {[string first ScanData $result] < 0} { + error "count data missing" + } + if {[string first ScanEnd $result] < 0} { + error "ScanEnd missing" + } + xxxscan uninterest + return OK +} -result OK + +test scan-1.3.2 {Test scan dyninterest} -body { + testOK "xxxscan dyninterest" + set result [eval xxxscan run 3 timer 2] + if {[string first ERROR $result] >= 0} { + set idx [string first ERROR $result] + set errText [string range $result $idx end] + error "ERROR occurred during scan: $errText" + } + if {[string first NewScan $result] < 0} { + error " NewScan missing" + } + if {[string first xxxscan.scanpoint $result] < 0} { + error "scan point data missing" + } + if {[string first ScanEnd $result] < 0} { + error "ScanEnd missing" + } + xxxscan uninterest + return OK +} -result OK + +test scan-1.4 {Test scan log} -body { + testOK "xxxscan log brumm" + return OK +} -result OK + +test scan-1.5 {Test scan getfile} -body { + testCommand "xxxscan getfile" scan.File +} -result OK + +test scan-1.6 {Test scan getcounts} -body { + testCommand "xxxscan getcounts" xxxscan.Counts +} -result OK + +test scan-1.7 {Test scan getmonitor } -body { + testCommand "xxxscan getmonitor 1" xxxscan.mon01 +} -result OK + +test scan-1.8 {Test scan gettimes } -body { + testCommand "xxxscan gettimes" xxxscan.scantimes +} -result OK + +test scan-1.9 {Test scan np } -body { + testCommand "xxxscan np" xxxscan.nP +} -result OK + +test scan-1.10 {Test scan getvardata } -body { + testCommand "xxxscan getvardata 0" scan.a4 +} -result OK + +test scan-1.11 {Test scan noscanvar } -body { + testCommand "xxxscan noscanvar" xxxscan.noscanvar +} -result OK + +test scan-1.12 {Test scan getvarpar} -body { + testCommand "xxxscan getvarpar 0" xxxscan.a4 +} -result OK + +test scan-1.13 {Test scan aborting} -body { + exec interrupt.tcl & + set result [eval cscan a4 5.3 .2 15 3] + if {[string first "Scan aborted" $result] < 0} { + error "Scan did not interrupt!" + } + return OK +} -result OK + + + diff --git a/test/sicsdatasoll.dat b/test/sicsdatasoll.dat new file mode 100644 index 00000000..b5406ef2 --- /dev/null +++ b/test/sicsdatasoll.dat @@ -0,0 +1,23 @@ + 0 32 + 1 32 + 2 32 + 3 32 + 4 32 + 5 32 + 6 32 + 7 32 + 8 32 + 9 32 + 10 32 + 11 32 + 12 32 + 13 32 + 14 32 + 15 32 + 16 32 + 17 32 + 18 32 + 19 32 + 20 32 + 21 32 + 22 32 diff --git a/test/sicsstat.tcl b/test/sicsstat.tcl new file mode 100644 index 00000000..f9c6d419 --- /dev/null +++ b/test/sicsstat.tcl @@ -0,0 +1,163 @@ +exe batchpath ./ +exe syspath ./ +lotte Wuergehals was here +lotte setAccess 2 +# Motor brumm +brumm sign 1.000000 +brumm SoftZero 0.000000 +brumm SoftLowerLim -180.000000 +brumm SoftUpperLim 180.000000 +brumm Fixed -1.000000 +brumm InterruptMode 0.000000 +brumm precision 0.010000 +brumm ignorefault 0.000000 +brumm AccessCode 2.000000 +brumm movecount 10.000000 +# Motor miau +miau sign 1.000000 +miau SoftZero 0.000000 +miau SoftLowerLim -180.000000 +miau SoftUpperLim 180.000000 +miau Fixed -1.000000 +miau InterruptMode 0.000000 +miau precision 0.010000 +miau ignorefault 0.000000 +miau AccessCode 2.000000 +miau movecount 10.000000 +# Counter aba +aba SetPreset 10.000000 +aba SetMode Timer +# Counter hugo +hugo SetPreset 1000.000000 +hugo SetMode Timer +# Counter lieselotte +lieselotte SetPreset 1000.000000 +lieselotte SetMode Timer +# Counter multi +multi SetPreset 0.000000 +multi SetMode Timer +# Motor a1 +a1 sign 1.000000 +a1 SoftZero 0.000000 +a1 SoftLowerLim -2.000000 +a1 SoftUpperLim 180.000000 +a1 Fixed -1.000000 +a1 InterruptMode 0.000000 +a1 precision 0.010000 +a1 ignorefault 0.000000 +a1 AccessCode 2.000000 +a1 movecount 10.000000 +# Motor a2 +a2 sign 1.000000 +a2 SoftZero 0.000000 +a2 SoftLowerLim 30.000000 +a2 SoftUpperLim 150.000000 +a2 Fixed -1.000000 +a2 InterruptMode 0.000000 +a2 precision 0.010000 +a2 ignorefault 0.000000 +a2 AccessCode 2.000000 +a2 movecount 10.000000 +# Motor a3 +a3 sign 1.000000 +a3 SoftZero 0.000000 +a3 SoftLowerLim -360.000000 +a3 SoftUpperLim 360.000000 +a3 Fixed -1.000000 +a3 InterruptMode 0.000000 +a3 precision 0.010000 +a3 ignorefault 0.000000 +a3 AccessCode 2.000000 +a3 movecount 10.000000 +# Motor a4 +a4 sign 1.000000 +a4 SoftZero 0.000000 +a4 SoftLowerLim -180.000000 +a4 SoftUpperLim 180.000000 +a4 Fixed -1.000000 +a4 InterruptMode 0.000000 +a4 precision 0.010000 +a4 ignorefault 0.000000 +a4 AccessCode 2.000000 +a4 movecount 10.000000 +# Motor a5 +a5 sign 1.000000 +a5 SoftZero 0.000000 +a5 SoftLowerLim -180.000000 +a5 SoftUpperLim 180.000000 +a5 Fixed -1.000000 +a5 InterruptMode 0.000000 +a5 precision 0.010000 +a5 ignorefault 0.000000 +a5 AccessCode 2.000000 +a5 movecount 10.000000 +# Motor a6 +a6 sign 1.000000 +a6 SoftZero 0.000000 +a6 SoftLowerLim -180.000000 +a6 SoftUpperLim 180.000000 +a6 Fixed -1.000000 +a6 InterruptMode 0.000000 +a6 precision 0.010000 +a6 ignorefault 0.000000 +a6 AccessCode 2.000000 +a6 movecount 10.000000 +# Motor sgu +sgu sign 1.000000 +sgu SoftZero 0.000000 +sgu SoftLowerLim -20.000000 +sgu SoftUpperLim 20.000000 +sgu Fixed -1.000000 +sgu InterruptMode 0.000000 +sgu precision 0.010000 +sgu ignorefault 0.000000 +sgu AccessCode 2.000000 +sgu movecount 10.000000 +# Motor sgl +sgl sign 1.000000 +sgl SoftZero 0.000000 +sgl SoftLowerLim -20.000000 +sgl SoftUpperLim 20.000000 +sgl Fixed -1.000000 +sgl InterruptMode 0.000000 +sgl precision 0.010000 +sgl ignorefault 0.000000 +sgl AccessCode 2.000000 +sgl movecount 10.000000 +# Counter scancter +scancter SetPreset 0.000000 +scancter SetMode Timer +hm CountMode timer +hm preset 10.000000 +tof CountMode timer +tof preset 10.000000 +tof genbin 500.000000 300.000000 20 +tof init +#---- tasUB module tasub +tasub mono dd 3.354610 +tasub mono hb1 1.000000 +tasub mono hb2 1.000000 +tasub mono vb1 1.000000 +tasub mono vb2 1.000000 +tasub mono ss 1 +tasub ana dd 3.354610 +tasub ana hb1 1.000000 +tasub ana hb2 1.000000 +tasub ana vb1 1.000000 +tasub ana vb2 1.000000 +tasub ana ss -1 +tasub cell 9.950000 9.950000 22.240000 90.000000 90.000000 90.000000 +tasub clear +tasub addref 1.00 0.00 0.00 168.27 -23.46 0.00 0.00 5.00 5.00 +tasub addref 0.00 0.00 1.00 84.78 -10.44 0.00 0.00 5.00 5.00 +tasub outofplane 1 +tasub const kf +tasub ss -1 + tasub setub -0.100503 -0.000000 -0.000000 0.000000 -0.000000 -0.044964 0.000000 -0.100503 -0.000000 + tasub setnormal 0.000000 0.000000 1.000000 +tasub settarget 1.200000 0.000000 1.000000 0.000000 1.553424 1.553424 +tasub r1 1.00 0.00 0.00 168.27 -23.46 0.00 0.00 5.00 5.00 +tasub r2 0.00 0.00 1.00 84.78 -10.44 0.00 0.00 5.00 5.00 +tasub update +#----- MultiMotor sa +sa recovernampos noeff a3 24 a4 48 diff --git a/test/sicstcldebug.tcl b/test/sicstcldebug.tcl new file mode 100644 index 00000000..b6c8273b --- /dev/null +++ b/test/sicstcldebug.tcl @@ -0,0 +1,40 @@ +#------------------------------------------------------------------ +# This is a helper file in order to debug SICS Tcl scripts. The idea +# is that a connection to a SICS interpreter at localhost:2911 is opened. +# Then unknown is reimplemented to send unknown commands (which must be +# SICS commands) to the SICS interpreter for evaluation. This is done +# with transact in order to figure out when SICS finished processing. +# Thus is should be possible to debug SICS Tcl scripts in a normal +# standalone interpreter without the overhead of restarting SICS +# all the time. It may even be possible to use one of the normal +# Tcl debuggers then.... +# +# Mark Koennecke, February 2006 +#------------------------------------------------------------------ + +set socke [socket localhost 2911] +gets $socke +puts $socke "Spy Spy" +flush $socke +gets $socke +#------------------------------------------------------------------ +proc unknown args { + global socke + append com "transact " [join $args] + puts $socke $com + flush $socke + set reply "" + while {1} { + set line [gets $socke] + if {[string first TRANSACTIONFINISHED $line] >= 0} { + return $reply + } else { + append reply $line "\n" + } + } +} +#------------------------------------------------------------------ +proc clientput args { + puts stdout [join $args] +} +#------------------------------------------------------------------ diff --git a/test/tcltest.tcl b/test/tcltest.tcl new file mode 100644 index 00000000..5c4e42cb --- /dev/null +++ b/test/tcltest.tcl @@ -0,0 +1,3354 @@ +# tcltest.tcl -- +# +# This file contains support code for the Tcl test suite. It +# defines the tcltest namespace and finds and defines the output +# directory, constraints available, output and error channels, +# etc. used by Tcl tests. See the tcltest man page for more +# details. +# +# This design was based on the Tcl testing approach designed and +# initially implemented by Mary Ann May-Pumphrey of Sun +# Microsystems. +# +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2000 by Ajuba Solutions +# Contributions from Don Porter, NIST, 2002. (not subject to US copyright) +# All rights reserved. +# +# RCS: @(#) $Id: tcltest.tcl,v 1.2 2007-02-12 01:15:02 ffr Exp $ + +package require Tcl 8.3 ;# uses [glob -directory] +namespace eval tcltest { + + # When the version number changes, be sure to update the pkgIndex.tcl file, + # and the install directory in the Makefiles. When the minor version + # changes (new feature) be sure to update the man page as well. + variable Version 2.2.8 + + # Compatibility support for dumb variables defined in tcltest 1 + # Do not use these. Call [package provide Tcl] and [info patchlevel] + # yourself. You don't need tcltest to wrap it for you. + variable version [package provide Tcl] + variable patchLevel [info patchlevel] + +##### Export the public tcltest procs; several categories + # + # Export the main functional commands that do useful things + namespace export cleanupTests loadTestedCommands makeDirectory \ + makeFile removeDirectory removeFile runAllTests test + + # Export configuration commands that control the functional commands + namespace export configure customMatch errorChannel interpreter \ + outputChannel testConstraint + + # Export commands that are duplication (candidates for deprecation) + namespace export bytestring ;# dups [encoding convertfrom identity] + namespace export debug ;# [configure -debug] + namespace export errorFile ;# [configure -errfile] + namespace export limitConstraints ;# [configure -limitconstraints] + namespace export loadFile ;# [configure -loadfile] + namespace export loadScript ;# [configure -load] + namespace export match ;# [configure -match] + namespace export matchFiles ;# [configure -file] + namespace export matchDirectories ;# [configure -relateddir] + namespace export normalizeMsg ;# application of [customMatch] + namespace export normalizePath ;# [file normalize] (8.4) + namespace export outputFile ;# [configure -outfile] + namespace export preserveCore ;# [configure -preservecore] + namespace export singleProcess ;# [configure -singleproc] + namespace export skip ;# [configure -skip] + namespace export skipFiles ;# [configure -notfile] + namespace export skipDirectories ;# [configure -asidefromdir] + namespace export temporaryDirectory ;# [configure -tmpdir] + namespace export testsDirectory ;# [configure -testdir] + namespace export verbose ;# [configure -verbose] + namespace export viewFile ;# binary encoding [read] + namespace export workingDirectory ;# [cd] [pwd] + + # Export deprecated commands for tcltest 1 compatibility + namespace export getMatchingFiles mainThread restoreState saveState \ + threadReap + + # tcltest::normalizePath -- + # + # This procedure resolves any symlinks in the path thus creating + # a path without internal redirection. It assumes that the + # incoming path is absolute. + # + # Arguments + # pathVar - name of variable containing path to modify. + # + # Results + # The path is modified in place. + # + # Side Effects: + # None. + # + proc normalizePath {pathVar} { + upvar $pathVar path + set oldpwd [pwd] + catch {cd $path} + set path [pwd] + cd $oldpwd + return $path + } + +##### Verification commands used to test values of variables and options + # + # Verification command that accepts everything + proc AcceptAll {value} { + return $value + } + + # Verification command that accepts valid Tcl lists + proc AcceptList { list } { + return [lrange $list 0 end] + } + + # Verification command that accepts a glob pattern + proc AcceptPattern { pattern } { + return [AcceptAll $pattern] + } + + # Verification command that accepts integers + proc AcceptInteger { level } { + return [incr level 0] + } + + # Verification command that accepts boolean values + proc AcceptBoolean { boolean } { + return [expr {$boolean && $boolean}] + } + + # Verification command that accepts (syntactically) valid Tcl scripts + proc AcceptScript { script } { + if {![info complete $script]} { + return -code error "invalid Tcl script: $script" + } + return $script + } + + # Verification command that accepts (converts to) absolute pathnames + proc AcceptAbsolutePath { path } { + return [file join [pwd] $path] + } + + # Verification command that accepts existing readable directories + proc AcceptReadable { path } { + if {![file readable $path]} { + return -code error "\"$path\" is not readable" + } + return $path + } + proc AcceptDirectory { directory } { + set directory [AcceptAbsolutePath $directory] + if {![file exists $directory]} { + return -code error "\"$directory\" does not exist" + } + if {![file isdir $directory]} { + return -code error "\"$directory\" is not a directory" + } + return [AcceptReadable $directory] + } + +##### Initialize internal arrays of tcltest, but only if the caller + # has not already pre-initialized them. This is done to support + # compatibility with older tests that directly access internals + # rather than go through command interfaces. + # + proc ArrayDefault {varName value} { + variable $varName + if {[array exists $varName]} { + return + } + if {[info exists $varName]} { + # Pre-initialized value is a scalar: destroy it! + unset $varName + } + array set $varName $value + } + + # save the original environment so that it can be restored later + ArrayDefault originalEnv [array get ::env] + + # initialize numTests array to keep track of the number of tests + # that pass, fail, and are skipped. + ArrayDefault numTests [list Total 0 Passed 0 Skipped 0 Failed 0] + + # createdNewFiles will store test files as indices and the list of + # files (that should not have been) left behind by the test files + # as values. + ArrayDefault createdNewFiles {} + + # initialize skippedBecause array to keep track of constraints that + # kept tests from running; a constraint name of "userSpecifiedSkip" + # means that the test appeared on the list of tests that matched the + # -skip value given to the flag; "userSpecifiedNonMatch" means that + # the test didn't match the argument given to the -match flag; both + # of these constraints are counted only if tcltest::debug is set to + # true. + ArrayDefault skippedBecause {} + + # initialize the testConstraints array to keep track of valid + # predefined constraints (see the explanation for the + # InitConstraints proc for more details). + ArrayDefault testConstraints {} + +##### Initialize internal variables of tcltest, but only if the caller + # has not already pre-initialized them. This is done to support + # compatibility with older tests that directly access internals + # rather than go through command interfaces. + # + proc Default {varName value {verify AcceptAll}} { + variable $varName + if {![info exists $varName]} { + variable $varName [$verify $value] + } else { + variable $varName [$verify [set $varName]] + } + } + + # Save any arguments that we might want to pass through to other + # programs. This is used by the -args flag. + # FINDUSER + Default parameters {} + + # Count the number of files tested (0 if runAllTests wasn't called). + # runAllTests will set testSingleFile to false, so stats will + # not be printed until runAllTests calls the cleanupTests proc. + # The currentFailure var stores the boolean value of whether the + # current test file has had any failures. The failFiles list + # stores the names of test files that had failures. + Default numTestFiles 0 AcceptInteger + Default testSingleFile true AcceptBoolean + Default currentFailure false AcceptBoolean + Default failFiles {} AcceptList + + # Tests should remove all files they create. The test suite will + # check the current working dir for files created by the tests. + # filesMade keeps track of such files created using the makeFile and + # makeDirectory procedures. filesExisted stores the names of + # pre-existing files. + # + # Note that $filesExisted lists only those files that exist in + # the original [temporaryDirectory]. + Default filesMade {} AcceptList + Default filesExisted {} AcceptList + proc FillFilesExisted {} { + variable filesExisted + + # Save the names of files that already exist in the scratch directory. + foreach file [glob -nocomplain -directory [temporaryDirectory] *] { + lappend filesExisted [file tail $file] + } + + # After successful filling, turn this into a no-op. + proc FillFilesExisted args {} + } + + # Kept only for compatibility + Default constraintsSpecified {} AcceptList + trace variable constraintsSpecified r {set ::tcltest::constraintsSpecified \ + [array names ::tcltest::testConstraints] ;# } + + # tests that use threads need to know which is the main thread + Default mainThread 1 + variable mainThread + if {[info commands thread::id] != {}} { + set mainThread [thread::id] + } elseif {[info commands testthread] != {}} { + set mainThread [testthread id] + } + + # Set workingDirectory to [pwd]. The default output directory for + # Tcl tests is the working directory. Whenever this value changes + # change to that directory. + variable workingDirectory + trace variable workingDirectory w \ + [namespace code {cd $workingDirectory ;#}] + + Default workingDirectory [pwd] AcceptAbsolutePath + proc workingDirectory { {dir ""} } { + variable workingDirectory + if {[llength [info level 0]] == 1} { + return $workingDirectory + } + set workingDirectory [AcceptAbsolutePath $dir] + } + + # Set the location of the execuatble + Default tcltest [info nameofexecutable] + trace variable tcltest w [namespace code {testConstraint stdio \ + [eval [ConstraintInitializer stdio]] ;#}] + + # save the platform information so it can be restored later + Default originalTclPlatform [array get ::tcl_platform] + + # If a core file exists, save its modification time. + if {[file exists [file join [workingDirectory] core]]} { + Default coreModTime \ + [file mtime [file join [workingDirectory] core]] + } + + # stdout and stderr buffers for use when we want to store them + Default outData {} + Default errData {} + + # keep track of test level for nested test commands + variable testLevel 0 + + # the variables and procs that existed when saveState was called are + # stored in a variable of the same name + Default saveState {} + + # Internationalization support -- used in [SetIso8859_1_Locale] and + # [RestoreLocale]. Those commands are used in cmdIL.test. + + if {![info exists [namespace current]::isoLocale]} { + variable isoLocale fr + switch -- $::tcl_platform(platform) { + "unix" { + + # Try some 'known' values for some platforms: + + switch -exact -- $::tcl_platform(os) { + "FreeBSD" { + set isoLocale fr_FR.ISO_8859-1 + } + HP-UX { + set isoLocale fr_FR.iso88591 + } + Linux - + IRIX { + set isoLocale fr + } + default { + + # Works on SunOS 4 and Solaris, and maybe + # others... Define it to something else on your + # system if you want to test those. + + set isoLocale iso_8859_1 + } + } + } + "windows" { + set isoLocale French + } + } + } + + variable ChannelsWeOpened; array set ChannelsWeOpened {} + # output goes to stdout by default + Default outputChannel stdout + proc outputChannel { {filename ""} } { + variable outputChannel + variable ChannelsWeOpened + + # This is very subtle and tricky, so let me try to explain. + # (Hopefully this longer comment will be clear when I come + # back in a few months, unlike its predecessor :) ) + # + # The [outputChannel] command (and underlying variable) have to + # be kept in sync with the [configure -outfile] configuration + # option ( and underlying variable Option(-outfile) ). This is + # accomplished with a write trace on Option(-outfile) that will + # update [outputChannel] whenver a new value is written. That + # much is easy. + # + # The trick is that in order to maintain compatibility with + # version 1 of tcltest, we must allow every configuration option + # to get its inital value from command line arguments. This is + # accomplished by setting initial read traces on all the + # configuration options to parse the command line option the first + # time they are read. These traces are cancelled whenever the + # program itself calls [configure]. + # + # OK, then so to support tcltest 1 compatibility, it seems we want + # to get the return from [outputFile] to trigger the read traces, + # just in case. + # + # BUT! A little known feature of Tcl variable traces is that + # traces are disabled during the handling of other traces. So, + # if we trigger read traces on Option(-outfile) and that triggers + # command line parsing which turns around and sets an initial + # value for Option(-outfile) -- -- the write trace that + # would keep [outputChannel] in sync with that new initial value + # would not fire! + # + # SO, finally, as a workaround, instead of triggering read traces + # by invoking [outputFile], we instead trigger the same set of + # read traces by invoking [debug]. Any command that reads a + # configuration option would do. [debug] is just a handy one. + # The end result is that we support tcltest 1 compatibility and + # keep outputChannel and -outfile in sync in all cases. + debug + + if {[llength [info level 0]] == 1} { + return $outputChannel + } + if {[info exists ChannelsWeOpened($outputChannel)]} { + close $outputChannel + unset ChannelsWeOpened($outputChannel) + } + switch -exact -- $filename { + stderr - + stdout { + set outputChannel $filename + } + default { + set outputChannel [open $filename a] + set ChannelsWeOpened($outputChannel) 1 + + # If we created the file in [temporaryDirectory], then + # [cleanupTests] will delete it, unless we claim it was + # already there. + set outdir [normalizePath [file dirname \ + [file join [pwd] $filename]]] + if {[string equal $outdir [temporaryDirectory]]} { + variable filesExisted + FillFilesExisted + set filename [file tail $filename] + if {[lsearch -exact $filesExisted $filename] == -1} { + lappend filesExisted $filename + } + } + } + } + return $outputChannel + } + + # errors go to stderr by default + Default errorChannel stderr + proc errorChannel { {filename ""} } { + variable errorChannel + variable ChannelsWeOpened + + # This is subtle and tricky. See the comment above in + # [outputChannel] for a detailed explanation. + debug + + if {[llength [info level 0]] == 1} { + return $errorChannel + } + if {[info exists ChannelsWeOpened($errorChannel)]} { + close $errorChannel + unset ChannelsWeOpened($errorChannel) + } + switch -exact -- $filename { + stderr - + stdout { + set errorChannel $filename + } + default { + set errorChannel [open $filename a] + set ChannelsWeOpened($errorChannel) 1 + + # If we created the file in [temporaryDirectory], then + # [cleanupTests] will delete it, unless we claim it was + # already there. + set outdir [normalizePath [file dirname \ + [file join [pwd] $filename]]] + if {[string equal $outdir [temporaryDirectory]]} { + variable filesExisted + FillFilesExisted + set filename [file tail $filename] + if {[lsearch -exact $filesExisted $filename] == -1} { + lappend filesExisted $filename + } + } + } + } + return $errorChannel + } + +##### Set up the configurable options + # + # The configurable options of the package + variable Option; array set Option {} + + # Usage strings for those options + variable Usage; array set Usage {} + + # Verification commands for those options + variable Verify; array set Verify {} + + # Initialize the default values of the configurable options that are + # historically associated with an exported variable. If that variable + # is already set, support compatibility by accepting its pre-set value. + # Use [trace] to establish ongoing connection between the deprecated + # exported variable and the modern option kept as a true internal var. + # Also set up usage string and value testing for the option. + proc Option {option value usage {verify AcceptAll} {varName {}}} { + variable Option + variable Verify + variable Usage + variable OptionControlledVariables + set Usage($option) $usage + set Verify($option) $verify + if {[catch {$verify $value} msg]} { + return -code error $msg + } else { + set Option($option) $msg + } + if {[string length $varName]} { + variable $varName + if {[info exists $varName]} { + if {[catch {$verify [set $varName]} msg]} { + return -code error $msg + } else { + set Option($option) $msg + } + unset $varName + } + namespace eval [namespace current] \ + [list upvar 0 Option($option) $varName] + # Workaround for Bug (now Feature Request) 572889. Grrrr.... + # Track all the variables tied to options + lappend OptionControlledVariables $varName + # Later, set auto-configure read traces on all + # of them, since a single trace on Option does not work. + proc $varName {{value {}}} [subst -nocommands { + if {[llength [info level 0]] == 2} { + Configure $option [set value] + } + return [Configure $option] + }] + } + } + + proc MatchingOption {option} { + variable Option + set match [array names Option $option*] + switch -- [llength $match] { + 0 { + set sorted [lsort [array names Option]] + set values [join [lrange $sorted 0 end-1] ", "] + append values ", or [lindex $sorted end]" + return -code error "unknown option $option: should be\ + one of $values" + } + 1 { + return [lindex $match 0] + } + default { + # Exact match trumps ambiguity + if {[lsearch -exact $match $option] >= 0} { + return $option + } + set values [join [lrange $match 0 end-1] ", "] + append values ", or [lindex $match end]" + return -code error "ambiguous option $option:\ + could match $values" + } + } + } + + proc EstablishAutoConfigureTraces {} { + variable OptionControlledVariables + foreach varName [concat $OptionControlledVariables Option] { + variable $varName + trace variable $varName r [namespace code {ProcessCmdLineArgs ;#}] + } + } + + proc RemoveAutoConfigureTraces {} { + variable OptionControlledVariables + foreach varName [concat $OptionControlledVariables Option] { + variable $varName + foreach pair [trace vinfo $varName] { + foreach {op cmd} $pair break + if {[string equal r $op] + && [string match *ProcessCmdLineArgs* $cmd]} { + trace vdelete $varName $op $cmd + } + } + } + # Once the traces are removed, this can become a no-op + proc RemoveAutoConfigureTraces {} {} + } + + proc Configure args { + variable Option + variable Verify + set n [llength $args] + if {$n == 0} { + return [lsort [array names Option]] + } + if {$n == 1} { + if {[catch {MatchingOption [lindex $args 0]} option]} { + return -code error $option + } + return $Option($option) + } + while {[llength $args] > 1} { + if {[catch {MatchingOption [lindex $args 0]} option]} { + return -code error $option + } + if {[catch {$Verify($option) [lindex $args 1]} value]} { + return -code error "invalid $option\ + value \"[lindex $args 1]\": $value" + } + set Option($option) $value + set args [lrange $args 2 end] + } + if {[llength $args]} { + if {[catch {MatchingOption [lindex $args 0]} option]} { + return -code error $option + } + return -code error "missing value for option $option" + } + } + proc configure args { + RemoveAutoConfigureTraces + set code [catch {eval Configure $args} msg] + return -code $code $msg + } + + proc AcceptVerbose { level } { + set level [AcceptList $level] + if {[llength $level] == 1} { + if {![regexp {^(pass|body|skip|start|error)$} $level]} { + # translate single characters abbreviations to expanded list + set level [string map {p pass b body s skip t start e error} \ + [split $level {}]] + } + } + set valid [list] + foreach v $level { + if {[regexp {^(pass|body|skip|start|error)$} $v]} { + lappend valid $v + } + } + return $valid + } + + proc IsVerbose {level} { + variable Option + return [expr {[lsearch -exact $Option(-verbose) $level] != -1}] + } + + # Default verbosity is to show bodies of failed tests + Option -verbose {body error} { + Takes any combination of the values 'p', 's', 'b', 't' and 'e'. + Test suite will display all passed tests if 'p' is specified, all + skipped tests if 's' is specified, the bodies of failed tests if + 'b' is specified, and when tests start if 't' is specified. + ErrorInfo is displayed if 'e' is specified. + } AcceptVerbose verbose + + # Match and skip patterns default to the empty list, except for + # matchFiles, which defaults to all .test files in the + # testsDirectory and matchDirectories, which defaults to all + # directories. + Option -match * { + Run all tests within the specified files that match one of the + list of glob patterns given. + } AcceptList match + + Option -skip {} { + Skip all tests within the specified tests (via -match) and files + that match one of the list of glob patterns given. + } AcceptList skip + + Option -file *.test { + Run tests in all test files that match the glob pattern given. + } AcceptPattern matchFiles + + # By default, skip files that appear to be SCCS lock files. + Option -notfile l.*.test { + Skip all test files that match the glob pattern given. + } AcceptPattern skipFiles + + Option -relateddir * { + Run tests in directories that match the glob pattern given. + } AcceptPattern matchDirectories + + Option -asidefromdir {} { + Skip tests in directories that match the glob pattern given. + } AcceptPattern skipDirectories + + # By default, don't save core files + Option -preservecore 0 { + If 2, save any core files produced during testing in the directory + specified by -tmpdir. If 1, notify the user if core files are + created. + } AcceptInteger preserveCore + + # debug output doesn't get printed by default; debug level 1 spits + # up only the tests that were skipped because they didn't match or + # were specifically skipped. A debug level of 2 would spit up the + # tcltest variables and flags provided; a debug level of 3 causes + # some additional output regarding operations of the test harness. + # The tcltest package currently implements only up to debug level 3. + Option -debug 0 { + Internal debug level + } AcceptInteger debug + + proc SetSelectedConstraints args { + variable Option + foreach c $Option(-constraints) { + testConstraint $c 1 + } + } + Option -constraints {} { + Do not skip the listed constraints listed in -constraints. + } AcceptList + trace variable Option(-constraints) w \ + [namespace code {SetSelectedConstraints ;#}] + + # Don't run only the "-constraint" specified tests by default + proc ClearUnselectedConstraints args { + variable Option + variable testConstraints + if {!$Option(-limitconstraints)} {return} + foreach c [array names testConstraints] { + if {[lsearch -exact $Option(-constraints) $c] == -1} { + testConstraint $c 0 + } + } + } + Option -limitconstraints false { + whether to run only tests with the constraints + } AcceptBoolean limitConstraints + trace variable Option(-limitconstraints) w \ + [namespace code {ClearUnselectedConstraints ;#}] + + # A test application has to know how to load the tested commands + # into the interpreter. + Option -load {} { + Specifies the script to load the tested commands. + } AcceptScript loadScript + + # Default is to run each test file in a separate process + Option -singleproc 0 { + whether to run all tests in one process + } AcceptBoolean singleProcess + + proc AcceptTemporaryDirectory { directory } { + set directory [AcceptAbsolutePath $directory] + if {![file exists $directory]} { + file mkdir $directory + } + set directory [AcceptDirectory $directory] + if {![file writable $directory]} { + if {[string equal [workingDirectory] $directory]} { + # Special exception: accept the default value + # even if the directory is not writable + return $directory + } + return -code error "\"$directory\" is not writeable" + } + return $directory + } + + # Directory where files should be created + Option -tmpdir [workingDirectory] { + Save temporary files in the specified directory. + } AcceptTemporaryDirectory temporaryDirectory + trace variable Option(-tmpdir) w \ + [namespace code {normalizePath Option(-tmpdir) ;#}] + + # Tests should not rely on the current working directory. + # Files that are part of the test suite should be accessed relative + # to [testsDirectory] + Option -testdir [workingDirectory] { + Search tests in the specified directory. + } AcceptDirectory testsDirectory + trace variable Option(-testdir) w \ + [namespace code {normalizePath Option(-testdir) ;#}] + + proc AcceptLoadFile { file } { + if {[string equal "" $file]} {return $file} + set file [file join [temporaryDirectory] $file] + return [AcceptReadable $file] + } + proc ReadLoadScript {args} { + variable Option + if {[string equal "" $Option(-loadfile)]} {return} + set tmp [open $Option(-loadfile) r] + loadScript [read $tmp] + close $tmp + } + Option -loadfile {} { + Read the script to load the tested commands from the specified file. + } AcceptLoadFile loadFile + trace variable Option(-loadfile) w [namespace code ReadLoadScript] + + proc AcceptOutFile { file } { + if {[string equal stderr $file]} {return $file} + if {[string equal stdout $file]} {return $file} + return [file join [temporaryDirectory] $file] + } + + # output goes to stdout by default + Option -outfile stdout { + Send output from test runs to the specified file. + } AcceptOutFile outputFile + trace variable Option(-outfile) w \ + [namespace code {outputChannel $Option(-outfile) ;#}] + + # errors go to stderr by default + Option -errfile stderr { + Send errors from test runs to the specified file. + } AcceptOutFile errorFile + trace variable Option(-errfile) w \ + [namespace code {errorChannel $Option(-errfile) ;#}] + +} + +##################################################################### + +# tcltest::Debug* -- +# +# Internal helper procedures to write out debug information +# dependent on the chosen level. A test shell may overide +# them, f.e. to redirect the output into a different +# channel, or even into a GUI. + +# tcltest::DebugPuts -- +# +# Prints the specified string if the current debug level is +# higher than the provided level argument. +# +# Arguments: +# level The lowest debug level triggering the output +# string The string to print out. +# +# Results: +# Prints the string. Nothing else is allowed. +# +# Side Effects: +# None. +# + +proc tcltest::DebugPuts {level string} { + variable debug + if {$debug >= $level} { + puts $string + } + return +} + +# tcltest::DebugPArray -- +# +# Prints the contents of the specified array if the current +# debug level is higher than the provided level argument +# +# Arguments: +# level The lowest debug level triggering the output +# arrayvar The name of the array to print out. +# +# Results: +# Prints the contents of the array. Nothing else is allowed. +# +# Side Effects: +# None. +# + +proc tcltest::DebugPArray {level arrayvar} { + variable debug + + if {$debug >= $level} { + catch {upvar $arrayvar $arrayvar} + parray $arrayvar + } + return +} + +# Define our own [parray] in ::tcltest that will inherit use of the [puts] +# defined in ::tcltest. NOTE: Ought to construct with [info args] and +# [info default], but can't be bothered now. If [parray] changes, then +# this will need changing too. +auto_load ::parray +proc tcltest::parray {a {pattern *}} [info body ::parray] + +# tcltest::DebugDo -- +# +# Executes the script if the current debug level is greater than +# the provided level argument +# +# Arguments: +# level The lowest debug level triggering the execution. +# script The tcl script executed upon a debug level high enough. +# +# Results: +# Arbitrary side effects, dependent on the executed script. +# +# Side Effects: +# None. +# + +proc tcltest::DebugDo {level script} { + variable debug + + if {$debug >= $level} { + uplevel 1 $script + } + return +} + +##################################################################### + +proc tcltest::Warn {msg} { + puts [outputChannel] "WARNING: $msg" +} + +# tcltest::mainThread +# +# Accessor command for tcltest variable mainThread. +# +proc tcltest::mainThread { {new ""} } { + variable mainThread + if {[llength [info level 0]] == 1} { + return $mainThread + } + set mainThread $new +} + +# tcltest::testConstraint -- +# +# sets a test constraint to a value; to do multiple constraints, +# call this proc multiple times. also returns the value of the +# named constraint if no value was supplied. +# +# Arguments: +# constraint - name of the constraint +# value - new value for constraint (should be boolean) - if not +# supplied, this is a query +# +# Results: +# content of tcltest::testConstraints($constraint) +# +# Side effects: +# none + +proc tcltest::testConstraint {constraint {value ""}} { + variable testConstraints + variable Option + DebugPuts 3 "entering testConstraint $constraint $value" + if {[llength [info level 0]] == 2} { + return $testConstraints($constraint) + } + # Check for boolean values + if {[catch {expr {$value && $value}} msg]} { + return -code error $msg + } + if {[limitConstraints] + && [lsearch -exact $Option(-constraints) $constraint] == -1} { + set value 0 + } + set testConstraints($constraint) $value +} + +# tcltest::interpreter -- +# +# the interpreter name stored in tcltest::tcltest +# +# Arguments: +# executable name +# +# Results: +# content of tcltest::tcltest +# +# Side effects: +# None. + +proc tcltest::interpreter { {interp ""} } { + variable tcltest + if {[llength [info level 0]] == 1} { + return $tcltest + } + if {[string equal {} $interp]} { + set tcltest {} + } else { + set tcltest $interp + } +} + +##################################################################### + +# tcltest::AddToSkippedBecause -- +# +# Increments the variable used to track how many tests were +# skipped because of a particular constraint. +# +# Arguments: +# constraint The name of the constraint to be modified +# +# Results: +# Modifies tcltest::skippedBecause; sets the variable to 1 if +# didn't previously exist - otherwise, it just increments it. +# +# Side effects: +# None. + +proc tcltest::AddToSkippedBecause { constraint {value 1}} { + # add the constraint to the list of constraints that kept tests + # from running + variable skippedBecause + + if {[info exists skippedBecause($constraint)]} { + incr skippedBecause($constraint) $value + } else { + set skippedBecause($constraint) $value + } + return +} + +# tcltest::PrintError -- +# +# Prints errors to tcltest::errorChannel and then flushes that +# channel, making sure that all messages are < 80 characters per +# line. +# +# Arguments: +# errorMsg String containing the error to be printed +# +# Results: +# None. +# +# Side effects: +# None. + +proc tcltest::PrintError {errorMsg} { + set InitialMessage "Error: " + set InitialMsgLen [string length $InitialMessage] + puts -nonewline [errorChannel] $InitialMessage + + # Keep track of where the end of the string is. + set endingIndex [string length $errorMsg] + + if {$endingIndex < (80 - $InitialMsgLen)} { + puts [errorChannel] $errorMsg + } else { + # Print up to 80 characters on the first line, including the + # InitialMessage. + set beginningIndex [string last " " [string range $errorMsg 0 \ + [expr {80 - $InitialMsgLen}]]] + puts [errorChannel] [string range $errorMsg 0 $beginningIndex] + + while {![string equal end $beginningIndex]} { + puts -nonewline [errorChannel] \ + [string repeat " " $InitialMsgLen] + if {($endingIndex - $beginningIndex) + < (80 - $InitialMsgLen)} { + puts [errorChannel] [string trim \ + [string range $errorMsg $beginningIndex end]] + break + } else { + set newEndingIndex [expr {[string last " " \ + [string range $errorMsg $beginningIndex \ + [expr {$beginningIndex + + (80 - $InitialMsgLen)}] + ]] + $beginningIndex}] + if {($newEndingIndex <= 0) + || ($newEndingIndex <= $beginningIndex)} { + set newEndingIndex end + } + puts [errorChannel] [string trim \ + [string range $errorMsg \ + $beginningIndex $newEndingIndex]] + set beginningIndex $newEndingIndex + } + } + } + flush [errorChannel] + return +} + +# tcltest::SafeFetch -- +# +# The following trace procedure makes it so that we can safely +# refer to non-existent members of the testConstraints array +# without causing an error. Instead, reading a non-existent +# member will return 0. This is necessary because tests are +# allowed to use constraint "X" without ensuring that +# testConstraints("X") is defined. +# +# Arguments: +# n1 - name of the array (testConstraints) +# n2 - array key value (constraint name) +# op - operation performed on testConstraints (generally r) +# +# Results: +# none +# +# Side effects: +# sets testConstraints($n2) to 0 if it's referenced but never +# before used + +proc tcltest::SafeFetch {n1 n2 op} { + variable testConstraints + DebugPuts 3 "entering SafeFetch $n1 $n2 $op" + if {[string equal {} $n2]} {return} + if {![info exists testConstraints($n2)]} { + if {[catch {testConstraint $n2 [eval [ConstraintInitializer $n2]]}]} { + testConstraint $n2 0 + } + } +} + +# tcltest::ConstraintInitializer -- +# +# Get or set a script that when evaluated in the tcltest namespace +# will return a boolean value with which to initialize the +# associated constraint. +# +# Arguments: +# constraint - name of the constraint initialized by the script +# script - the initializer script +# +# Results +# boolean value of the constraint - enabled or disabled +# +# Side effects: +# Constraint is initialized for future reference by [test] +proc tcltest::ConstraintInitializer {constraint {script ""}} { + variable ConstraintInitializer + DebugPuts 3 "entering ConstraintInitializer $constraint $script" + if {[llength [info level 0]] == 2} { + return $ConstraintInitializer($constraint) + } + # Check for boolean values + if {![info complete $script]} { + return -code error "ConstraintInitializer must be complete script" + } + set ConstraintInitializer($constraint) $script +} + +# tcltest::InitConstraints -- +# +# Call all registered constraint initializers to force initialization +# of all known constraints. +# See the tcltest man page for the list of built-in constraints defined +# in this procedure. +# +# Arguments: +# none +# +# Results: +# The testConstraints array is reset to have an index for each +# built-in test constraint. +# +# Side Effects: +# None. +# + +proc tcltest::InitConstraints {} { + variable ConstraintInitializer + initConstraintsHook + foreach constraint [array names ConstraintInitializer] { + testConstraint $constraint + } +} + +proc tcltest::DefineConstraintInitializers {} { + ConstraintInitializer singleTestInterp {singleProcess} + + # All the 'pc' constraints are here for backward compatibility and + # are not documented. They have been replaced with equivalent 'win' + # constraints. + + ConstraintInitializer unixOnly \ + {string equal $::tcl_platform(platform) unix} + ConstraintInitializer macOnly \ + {string equal $::tcl_platform(platform) macintosh} + ConstraintInitializer pcOnly \ + {string equal $::tcl_platform(platform) windows} + ConstraintInitializer winOnly \ + {string equal $::tcl_platform(platform) windows} + + ConstraintInitializer unix {testConstraint unixOnly} + ConstraintInitializer mac {testConstraint macOnly} + ConstraintInitializer pc {testConstraint pcOnly} + ConstraintInitializer win {testConstraint winOnly} + + ConstraintInitializer unixOrPc \ + {expr {[testConstraint unix] || [testConstraint pc]}} + ConstraintInitializer macOrPc \ + {expr {[testConstraint mac] || [testConstraint pc]}} + ConstraintInitializer unixOrWin \ + {expr {[testConstraint unix] || [testConstraint win]}} + ConstraintInitializer macOrWin \ + {expr {[testConstraint mac] || [testConstraint win]}} + ConstraintInitializer macOrUnix \ + {expr {[testConstraint mac] || [testConstraint unix]}} + + ConstraintInitializer nt {string equal $::tcl_platform(os) "Windows NT"} + ConstraintInitializer 95 {string equal $::tcl_platform(os) "Windows 95"} + ConstraintInitializer 98 {string equal $::tcl_platform(os) "Windows 98"} + + # The following Constraints switches are used to mark tests that + # should work, but have been temporarily disabled on certain + # platforms because they don't and we haven't gotten around to + # fixing the underlying problem. + + ConstraintInitializer tempNotPc {expr {![testConstraint pc]}} + ConstraintInitializer tempNotWin {expr {![testConstraint win]}} + ConstraintInitializer tempNotMac {expr {![testConstraint mac]}} + ConstraintInitializer tempNotUnix {expr {![testConstraint unix]}} + + # The following Constraints switches are used to mark tests that + # crash on certain platforms, so that they can be reactivated again + # when the underlying problem is fixed. + + ConstraintInitializer pcCrash {expr {![testConstraint pc]}} + ConstraintInitializer winCrash {expr {![testConstraint win]}} + ConstraintInitializer macCrash {expr {![testConstraint mac]}} + ConstraintInitializer unixCrash {expr {![testConstraint unix]}} + + # Skip empty tests + + ConstraintInitializer emptyTest {format 0} + + # By default, tests that expose known bugs are skipped. + + ConstraintInitializer knownBug {format 0} + + # By default, non-portable tests are skipped. + + ConstraintInitializer nonPortable {format 0} + + # Some tests require user interaction. + + ConstraintInitializer userInteraction {format 0} + + # Some tests must be skipped if the interpreter is not in + # interactive mode + + ConstraintInitializer interactive \ + {expr {[info exists ::tcl_interactive] && $::tcl_interactive}} + + # Some tests can only be run if the installation came from a CD + # image instead of a web image. Some tests must be skipped if you + # are running as root on Unix. Other tests can only be run if you + # are running as root on Unix. + + ConstraintInitializer root {expr \ + {[string equal unix $::tcl_platform(platform)] + && ([string equal root $::tcl_platform(user)] + || [string equal "" $::tcl_platform(user)])}} + ConstraintInitializer notRoot {expr {![testConstraint root]}} + + # Set nonBlockFiles constraint: 1 means this platform supports + # setting files into nonblocking mode. + + ConstraintInitializer nonBlockFiles { + set code [expr {[catch {set f [open defs r]}] + || [catch {fconfigure $f -blocking off}]}] + catch {close $f} + set code + } + + # Set asyncPipeClose constraint: 1 means this platform supports + # async flush and async close on a pipe. + # + # Test for SCO Unix - cannot run async flushing tests because a + # potential problem with select is apparently interfering. + # (Mark Diekhans). + + ConstraintInitializer asyncPipeClose {expr { + !([string equal unix $::tcl_platform(platform)] + && ([catch {exec uname -X | fgrep {Release = 3.2v}}] == 0))}} + + # Test to see if we have a broken version of sprintf with respect + # to the "e" format of floating-point numbers. + + ConstraintInitializer eformat {string equal [format %g 5e-5] 5e-05} + + # Test to see if execed commands such as cat, echo, rm and so forth + # are present on this machine. + + ConstraintInitializer unixExecs { + set code 1 + if {[string equal macintosh $::tcl_platform(platform)]} { + set code 0 + } + if {[string equal windows $::tcl_platform(platform)]} { + if {[catch { + set file _tcl_test_remove_me.txt + makeFile {hello} $file + }]} { + set code 0 + } elseif { + [catch {exec cat $file}] || + [catch {exec echo hello}] || + [catch {exec sh -c echo hello}] || + [catch {exec wc $file}] || + [catch {exec sleep 1}] || + [catch {exec echo abc > $file}] || + [catch {exec chmod 644 $file}] || + [catch {exec rm $file}] || + [llength [auto_execok mkdir]] == 0 || + [llength [auto_execok fgrep]] == 0 || + [llength [auto_execok grep]] == 0 || + [llength [auto_execok ps]] == 0 + } { + set code 0 + } + removeFile $file + } + set code + } + + ConstraintInitializer stdio { + set code 0 + if {![catch {set f [open "|[list [interpreter]]" w]}]} { + if {![catch {puts $f exit}]} { + if {![catch {close $f}]} { + set code 1 + } + } + } + set code + } + + # Deliberately call socket with the wrong number of arguments. The + # error message you get will indicate whether sockets are available + # on this system. + + ConstraintInitializer socket { + catch {socket} msg + string compare $msg "sockets are not available on this system" + } + + # Check for internationalization + ConstraintInitializer hasIsoLocale { + if {[llength [info commands testlocale]] == 0} { + set code 0 + } else { + set code [string length [SetIso8859_1_Locale]] + RestoreLocale + } + set code + } + +} +##################################################################### + +# Usage and command line arguments processing. + +# tcltest::PrintUsageInfo +# +# Prints out the usage information for package tcltest. This can +# be customized with the redefinition of [PrintUsageInfoHook]. +# +# Arguments: +# none +# +# Results: +# none +# +# Side Effects: +# none +proc tcltest::PrintUsageInfo {} { + puts [Usage] + PrintUsageInfoHook +} + +proc tcltest::Usage { {option ""} } { + variable Usage + variable Verify + if {[llength [info level 0]] == 1} { + set msg "Usage: [file tail [info nameofexecutable]] script " + append msg "?-help? ?flag value? ... \n" + append msg "Available flags (and valid input values) are:" + + set max 0 + set allOpts [concat -help [Configure]] + foreach opt $allOpts { + set foo [Usage $opt] + foreach [list x type($opt) usage($opt)] $foo break + set line($opt) " $opt $type($opt) " + set length($opt) [string length $line($opt)] + if {$length($opt) > $max} {set max $length($opt)} + } + set rest [expr {72 - $max}] + foreach opt $allOpts { + append msg \n$line($opt) + append msg [string repeat " " [expr {$max - $length($opt)}]] + set u [string trim $usage($opt)] + catch {append u " (default: \[[Configure $opt]])"} + regsub -all {\s*\n\s*} $u " " u + while {[string length $u] > $rest} { + set break [string wordstart $u $rest] + if {$break == 0} { + set break [string wordend $u 0] + } + append msg [string range $u 0 [expr {$break - 1}]] + set u [string trim [string range $u $break end]] + append msg \n[string repeat " " $max] + } + append msg $u + } + return $msg\n + } elseif {[string equal -help $option]} { + return [list -help "" "Display this usage information."] + } else { + set type [lindex [info args $Verify($option)] 0] + return [list $option $type $Usage($option)] + } +} + +# tcltest::ProcessFlags -- +# +# process command line arguments supplied in the flagArray - this +# is called by processCmdLineArgs. Modifies tcltest variables +# according to the content of the flagArray. +# +# Arguments: +# flagArray - array containing name/value pairs of flags +# +# Results: +# sets tcltest variables according to their values as defined by +# flagArray +# +# Side effects: +# None. + +proc tcltest::ProcessFlags {flagArray} { + # Process -help first + if {[lsearch -exact $flagArray {-help}] != -1} { + PrintUsageInfo + exit 1 + } + + if {[llength $flagArray] == 0} { + RemoveAutoConfigureTraces + } else { + set args $flagArray + while {[llength $args]>1 && [catch {eval configure $args} msg]} { + + # Something went wrong parsing $args for tcltest options + # Check whether the problem is "unknown option" + if {[regexp {^unknown option (\S+):} $msg -> option]} { + # Could be this is an option the Hook knows about + set moreOptions [processCmdLineArgsAddFlagsHook] + if {[lsearch -exact $moreOptions $option] == -1} { + # Nope. Report the error, including additional options, + # but keep going + if {[llength $moreOptions]} { + append msg ", " + append msg [join [lrange $moreOptions 0 end-1] ", "] + append msg "or [lindex $moreOptions end]" + } + Warn $msg + } + } else { + # error is something other than "unknown option" + # notify user of the error; and exit + puts [errorChannel] $msg + exit 1 + } + + # To recover, find that unknown option and remove up to it. + # then retry + while {![string equal [lindex $args 0] $option]} { + set args [lrange $args 2 end] + } + set args [lrange $args 2 end] + } + if {[llength $args] == 1} { + puts [errorChannel] \ + "missing value for option [lindex $args 0]" + exit 1 + } + } + + # Call the hook + catch { + array set flag $flagArray + processCmdLineArgsHook [array get flag] + } + return +} + +# tcltest::ProcessCmdLineArgs -- +# +# This procedure must be run after constraint initialization is +# set up (by [DefineConstraintInitializers]) because some constraints +# can be overridden. +# +# Perform configuration according to the command-line options. +# +# Arguments: +# none +# +# Results: +# Sets the above-named variables in the tcltest namespace. +# +# Side Effects: +# None. +# + +proc tcltest::ProcessCmdLineArgs {} { + variable originalEnv + variable testConstraints + + # The "argv" var doesn't exist in some cases, so use {}. + if {![info exists ::argv]} { + ProcessFlags {} + } else { + ProcessFlags $::argv + } + + # Spit out everything you know if we're at a debug level 2 or + # greater + DebugPuts 2 "Flags passed into tcltest:" + if {[info exists ::env(TCLTEST_OPTIONS)]} { + DebugPuts 2 \ + " ::env(TCLTEST_OPTIONS): $::env(TCLTEST_OPTIONS)" + } + if {[info exists ::argv]} { + DebugPuts 2 " argv: $::argv" + } + DebugPuts 2 "tcltest::debug = [debug]" + DebugPuts 2 "tcltest::testsDirectory = [testsDirectory]" + DebugPuts 2 "tcltest::workingDirectory = [workingDirectory]" + DebugPuts 2 "tcltest::temporaryDirectory = [temporaryDirectory]" + DebugPuts 2 "tcltest::outputChannel = [outputChannel]" + DebugPuts 2 "tcltest::errorChannel = [errorChannel]" + DebugPuts 2 "Original environment (tcltest::originalEnv):" + DebugPArray 2 originalEnv + DebugPuts 2 "Constraints:" + DebugPArray 2 testConstraints +} + +##################################################################### + +# Code to run the tests goes here. + +# tcltest::TestPuts -- +# +# Used to redefine puts in test environment. Stores whatever goes +# out on stdout in tcltest::outData and stderr in errData before +# sending it on to the regular puts. +# +# Arguments: +# same as standard puts +# +# Results: +# none +# +# Side effects: +# Intercepts puts; data that would otherwise go to stdout, stderr, +# or file channels specified in outputChannel and errorChannel +# does not get sent to the normal puts function. +namespace eval tcltest::Replace { + namespace export puts +} +proc tcltest::Replace::puts {args} { + variable [namespace parent]::outData + variable [namespace parent]::errData + switch [llength $args] { + 1 { + # Only the string to be printed is specified + append outData [lindex $args 0]\n + return + # return [Puts [lindex $args 0]] + } + 2 { + # Either -nonewline or channelId has been specified + if {[string equal -nonewline [lindex $args 0]]} { + append outData [lindex $args end] + return + # return [Puts -nonewline [lindex $args end]] + } else { + set channel [lindex $args 0] + set newline \n + } + } + 3 { + if {[string equal -nonewline [lindex $args 0]]} { + # Both -nonewline and channelId are specified, unless + # it's an error. -nonewline is supposed to be argv[0]. + set channel [lindex $args 1] + set newline "" + } + } + } + + if {[info exists channel]} { + if {[string equal $channel [[namespace parent]::outputChannel]] + || [string equal $channel stdout]} { + append outData [lindex $args end]$newline + return + } elseif {[string equal $channel [[namespace parent]::errorChannel]] + || [string equal $channel stderr]} { + append errData [lindex $args end]$newline + return + } + } + + # If we haven't returned by now, we don't know how to handle the + # input. Let puts handle it. + return [eval Puts $args] +} + +# tcltest::Eval -- +# +# Evaluate the script in the test environment. If ignoreOutput is +# false, store data sent to stderr and stdout in outData and +# errData. Otherwise, ignore this output altogether. +# +# Arguments: +# script Script to evaluate +# ?ignoreOutput? Indicates whether or not to ignore output +# sent to stdout & stderr +# +# Results: +# result from running the script +# +# Side effects: +# Empties the contents of outData and errData before running a +# test if ignoreOutput is set to 0. + +proc tcltest::Eval {script {ignoreOutput 1}} { + variable outData + variable errData + DebugPuts 3 "[lindex [info level 0] 0] called" + if {!$ignoreOutput} { + set outData {} + set errData {} + rename ::puts [namespace current]::Replace::Puts + namespace eval :: \ + [list namespace import [namespace origin Replace::puts]] + namespace import Replace::puts + } + set result [uplevel 1 $script] + if {!$ignoreOutput} { + namespace forget puts + namespace eval :: namespace forget puts + rename [namespace current]::Replace::Puts ::puts + } + return $result +} + +# tcltest::CompareStrings -- +# +# compares the expected answer to the actual answer, depending on +# the mode provided. Mode determines whether a regexp, exact, +# glob or custom comparison is done. +# +# Arguments: +# actual - string containing the actual result +# expected - pattern to be matched against +# mode - type of comparison to be done +# +# Results: +# result of the match +# +# Side effects: +# None. + +proc tcltest::CompareStrings {actual expected mode} { + variable CustomMatch + if {![info exists CustomMatch($mode)]} { + return -code error "No matching command registered for `-match $mode'" + } + set match [namespace eval :: $CustomMatch($mode) [list $expected $actual]] + if {[catch {expr {$match && $match}} result]} { + return -code error "Invalid result from `-match $mode' command: $result" + } + return $match +} + +# tcltest::customMatch -- +# +# registers a command to be called when a particular type of +# matching is required. +# +# Arguments: +# nickname - Keyword for the type of matching +# cmd - Incomplete command that implements that type of matching +# when completed with expected string and actual string +# and then evaluated. +# +# Results: +# None. +# +# Side effects: +# Sets the variable tcltest::CustomMatch + +proc tcltest::customMatch {mode script} { + variable CustomMatch + if {![info complete $script]} { + return -code error \ + "invalid customMatch script; can't evaluate after completion" + } + set CustomMatch($mode) $script +} + +# tcltest::SubstArguments list +# +# This helper function takes in a list of words, then perform a +# substitution on the list as though each word in the list is a separate +# argument to the Tcl function. For example, if this function is +# invoked as: +# +# SubstArguments {$a {$a}} +# +# Then it is as though the function is invoked as: +# +# SubstArguments $a {$a} +# +# This code is adapted from Paul Duffin's function "SplitIntoWords". +# The original function can be found on: +# +# http://purl.org/thecliff/tcl/wiki/858.html +# +# Results: +# a list containing the result of the substitution +# +# Exceptions: +# An error may occur if the list containing unbalanced quote or +# unknown variable. +# +# Side Effects: +# None. +# + +proc tcltest::SubstArguments {argList} { + + # We need to split the argList up into tokens but cannot use list + # operations as they throw away some significant quoting, and + # [split] ignores braces as it should. Therefore what we do is + # gradually build up a string out of whitespace seperated strings. + # We cannot use [split] to split the argList into whitespace + # separated strings as it throws away the whitespace which maybe + # important so we have to do it all by hand. + + set result {} + set token "" + + while {[string length $argList]} { + # Look for the next word containing a quote: " { } + if {[regexp -indices {[^ \t\n]*[\"\{\}]+[^ \t\n]*} \ + $argList all]} { + # Get the text leading up to this word, but not including + # this word, from the argList. + set text [string range $argList 0 \ + [expr {[lindex $all 0] - 1}]] + # Get the word with the quote + set word [string range $argList \ + [lindex $all 0] [lindex $all 1]] + + # Remove all text up to and including the word from the + # argList. + set argList [string range $argList \ + [expr {[lindex $all 1] + 1}] end] + } else { + # Take everything up to the end of the argList. + set text $argList + set word {} + set argList {} + } + + if {$token != {}} { + # If we saw a word with quote before, then there is a + # multi-word token starting with that word. In this case, + # add the text and the current word to this token. + append token $text $word + } else { + # Add the text to the result. There is no need to parse + # the text because it couldn't be a part of any multi-word + # token. Then start a new multi-word token with the word + # because we need to pass this token to the Tcl parser to + # check for balancing quotes + append result $text + set token $word + } + + if { [catch {llength $token} length] == 0 && $length == 1} { + # The token is a valid list so add it to the result. + # lappend result [string trim $token] + append result \{$token\} + set token {} + } + } + + # If the last token has not been added to the list then there + # is a problem. + if { [string length $token] } { + error "incomplete token \"$token\"" + } + + return $result +} + + +# tcltest::test -- +# +# This procedure runs a test and prints an error message if the test +# fails. If verbose has been set, it also prints a message even if the +# test succeeds. The test will be skipped if it doesn't match the +# match variable, if it matches an element in skip, or if one of the +# elements of "constraints" turns out not to be true. +# +# If testLevel is 1, then this is a top level test, and we record +# pass/fail information; otherwise, this information is not logged and +# is not added to running totals. +# +# Attributes: +# Only description is a required attribute. All others are optional. +# Default values are indicated. +# +# constraints - A list of one or more keywords, each of which +# must be the name of an element in the array +# "testConstraints". If any of these elements is +# zero, the test is skipped. This attribute is +# optional; default is {} +# body - Script to run to carry out the test. It must +# return a result that can be checked for +# correctness. This attribute is optional; +# default is {} +# result - Expected result from script. This attribute is +# optional; default is {}. +# output - Expected output sent to stdout. This attribute +# is optional; default is {}. +# errorOutput - Expected output sent to stderr. This attribute +# is optional; default is {}. +# returnCodes - Expected return codes. This attribute is +# optional; default is {0 2}. +# setup - Code to run before $script (above). This +# attribute is optional; default is {}. +# cleanup - Code to run after $script (above). This +# attribute is optional; default is {}. +# match - specifies type of matching to do on result, +# output, errorOutput; this must be a string +# previously registered by a call to [customMatch]. +# The strings exact, glob, and regexp are pre-registered +# by the tcltest package. Default value is exact. +# +# Arguments: +# name - Name of test, in the form foo-1.2. +# description - Short textual description of the test, to +# help humans understand what it does. +# +# Results: +# None. +# +# Side effects: +# Just about anything is possible depending on the test. +# + +proc tcltest::test {name description args} { + global tcl_platform + variable testLevel + variable coreModTime + DebugPuts 3 "test $name $args" + DebugDo 1 { + variable TestNames + catch { + puts "test name '$name' re-used; prior use in $TestNames($name)" + } + set TestNames($name) [info script] + } + + FillFilesExisted + incr testLevel + + # Pre-define everything to null except output and errorOutput. We + # determine whether or not to trap output based on whether or not + # these variables (output & errorOutput) are defined. + foreach item {constraints setup cleanup body result returnCodes + match} { + set $item {} + } + + # Set the default match mode + set match exact + + # Set the default match values for return codes (0 is the standard + # expected return value if everything went well; 2 represents + # 'return' being used in the test script). + set returnCodes [list 0 2] + + # The old test format can't have a 3rd argument (constraints or + # script) that starts with '-'. + if {[string match -* [lindex $args 0]] + || ([llength $args] <= 1)} { + if {[llength $args] == 1} { + set list [SubstArguments [lindex $args 0]] + foreach {element value} $list { + set testAttributes($element) $value + } + foreach item {constraints match setup body cleanup \ + result returnCodes output errorOutput} { + if {[info exists testAttributes(-$item)]} { + set testAttributes(-$item) [uplevel 1 \ + ::concat $testAttributes(-$item)] + } + } + } else { + array set testAttributes $args + } + + set validFlags {-setup -cleanup -body -result -returnCodes \ + -match -output -errorOutput -constraints} + + foreach flag [array names testAttributes] { + if {[lsearch -exact $validFlags $flag] == -1} { + incr testLevel -1 + set sorted [lsort $validFlags] + set options [join [lrange $sorted 0 end-1] ", "] + append options ", or [lindex $sorted end]" + return -code error "bad option \"$flag\": must be $options" + } + } + + # store whatever the user gave us + foreach item [array names testAttributes] { + set [string trimleft $item "-"] $testAttributes($item) + } + + # Check the values supplied for -match + variable CustomMatch + if {[lsearch [array names CustomMatch] $match] == -1} { + incr testLevel -1 + set sorted [lsort [array names CustomMatch]] + set values [join [lrange $sorted 0 end-1] ", "] + append values ", or [lindex $sorted end]" + return -code error "bad -match value \"$match\":\ + must be $values" + } + + # Replace symbolic valies supplied for -returnCodes + foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} { + set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes] + } + } else { + # This is parsing for the old test command format; it is here + # for backward compatibility. + set result [lindex $args end] + if {[llength $args] == 2} { + set body [lindex $args 0] + } elseif {[llength $args] == 3} { + set constraints [lindex $args 0] + set body [lindex $args 1] + } else { + incr testLevel -1 + return -code error "wrong # args:\ + should be \"test name desc ?options?\"" + } + } + + if {[Skipped $name $constraints]} { + incr testLevel -1 + return + } + + # Save information about the core file. + if {[preserveCore]} { + if {[file exists [file join [workingDirectory] core]]} { + set coreModTime [file mtime [file join [workingDirectory] core]] + } + } + + # First, run the setup script + set code [catch {uplevel 1 $setup} setupMsg] + if {$code == 1} { + set errorInfo(setup) $::errorInfo + set errorCode(setup) $::errorCode + } + set setupFailure [expr {$code != 0}] + + # Only run the test body if the setup was successful + if {!$setupFailure} { + + # Verbose notification of $body start + if {[IsVerbose start]} { + puts [outputChannel] "---- $name start" + flush [outputChannel] + } + + set command [list [namespace origin RunTest] $name $body] + if {[info exists output] || [info exists errorOutput]} { + set testResult [uplevel 1 [list [namespace origin Eval] $command 0]] + } else { + set testResult [uplevel 1 [list [namespace origin Eval] $command 1]] + } + foreach {actualAnswer returnCode} $testResult break + if {$returnCode == 1} { + set errorInfo(body) $::errorInfo + set errorCode(body) $::errorCode + } + } + + # Always run the cleanup script + set code [catch {uplevel 1 $cleanup} cleanupMsg] + if {$code == 1} { + set errorInfo(cleanup) $::errorInfo + set errorCode(cleanup) $::errorCode + } + set cleanupFailure [expr {$code != 0}] + + set coreFailure 0 + set coreMsg "" + # check for a core file first - if one was created by the test, + # then the test failed + if {[preserveCore]} { + if {[file exists [file join [workingDirectory] core]]} { + # There's only a test failure if there is a core file + # and (1) there previously wasn't one or (2) the new + # one is different from the old one. + if {[info exists coreModTime]} { + if {$coreModTime != [file mtime \ + [file join [workingDirectory] core]]} { + set coreFailure 1 + } + } else { + set coreFailure 1 + } + + if {([preserveCore] > 1) && ($coreFailure)} { + append coreMsg "\nMoving file to:\ + [file join [temporaryDirectory] core-$name]" + catch {file rename -force \ + [file join [workingDirectory] core] \ + [file join [temporaryDirectory] core-$name] + } msg + if {[string length $msg] > 0} { + append coreMsg "\nError:\ + Problem renaming core file: $msg" + } + } + } + } + + # check if the return code matched the expected return code + set codeFailure 0 + if {!$setupFailure && [lsearch -exact $returnCodes $returnCode] == -1} { + set codeFailure 1 + } + + # If expected output/error strings exist, we have to compare + # them. If the comparison fails, then so did the test. + set outputFailure 0 + variable outData + if {[info exists output] && !$codeFailure} { + if {[set outputCompare [catch { + CompareStrings $outData $output $match + } outputMatch]] == 0} { + set outputFailure [expr {!$outputMatch}] + } else { + set outputFailure 1 + } + } + + set errorFailure 0 + variable errData + if {[info exists errorOutput] && !$codeFailure} { + if {[set errorCompare [catch { + CompareStrings $errData $errorOutput $match + } errorMatch]] == 0} { + set errorFailure [expr {!$errorMatch}] + } else { + set errorFailure 1 + } + } + + # check if the answer matched the expected answer + # Only check if we ran the body of the test (no setup failure) + if {$setupFailure || $codeFailure} { + set scriptFailure 0 + } elseif {[set scriptCompare [catch { + CompareStrings $actualAnswer $result $match + } scriptMatch]] == 0} { + set scriptFailure [expr {!$scriptMatch}] + } else { + set scriptFailure 1 + } + + # if we didn't experience any failures, then we passed + variable numTests + if {!($setupFailure || $cleanupFailure || $coreFailure + || $outputFailure || $errorFailure || $codeFailure + || $scriptFailure)} { + if {$testLevel == 1} { + incr numTests(Passed) + if {[IsVerbose pass]} { + puts [outputChannel] "++++ $name PASSED" + } + } + incr testLevel -1 + return + } + + # We know the test failed, tally it... + if {$testLevel == 1} { + incr numTests(Failed) + } + + # ... then report according to the type of failure + variable currentFailure true + if {![IsVerbose body]} { + set body "" + } + puts [outputChannel] "\n==== $name\ + [string trim $description] FAILED" + if {[string length $body]} { + puts [outputChannel] "==== Contents of test case:" + puts [outputChannel] $body + } + if {$setupFailure} { + puts [outputChannel] "---- Test setup\ + failed:\n$setupMsg" + if {[info exists errorInfo(setup)]} { + puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)" + puts [outputChannel] "---- errorCode(setup): $errorCode(setup)" + } + } + if {$scriptFailure} { + if {$scriptCompare} { + puts [outputChannel] "---- Error testing result: $scriptMatch" + } else { + puts [outputChannel] "---- Result was:\n$actualAnswer" + puts [outputChannel] "---- Result should have been\ + ($match matching):\n$result" + } + } + if {$codeFailure} { + switch -- $returnCode { + 0 { set msg "Test completed normally" } + 1 { set msg "Test generated error" } + 2 { set msg "Test generated return exception" } + 3 { set msg "Test generated break exception" } + 4 { set msg "Test generated continue exception" } + default { set msg "Test generated exception" } + } + puts [outputChannel] "---- $msg; Return code was: $returnCode" + puts [outputChannel] "---- Return code should have been\ + one of: $returnCodes" + if {[IsVerbose error]} { + if {[info exists errorInfo(body)] && ([lsearch $returnCodes 1]<0)} { + puts [outputChannel] "---- errorInfo: $errorInfo(body)" + puts [outputChannel] "---- errorCode: $errorCode(body)" + } + } + } + if {$outputFailure} { + if {$outputCompare} { + puts [outputChannel] "---- Error testing output: $outputMatch" + } else { + puts [outputChannel] "---- Output was:\n$outData" + puts [outputChannel] "---- Output should have been\ + ($match matching):\n$output" + } + } + if {$errorFailure} { + if {$errorCompare} { + puts [outputChannel] "---- Error testing errorOutput: $errorMatch" + } else { + puts [outputChannel] "---- Error output was:\n$errData" + puts [outputChannel] "---- Error output should have\ + been ($match matching):\n$errorOutput" + } + } + if {$cleanupFailure} { + puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg" + if {[info exists errorInfo(cleanup)]} { + puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)" + puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)" + } + } + if {$coreFailure} { + puts [outputChannel] "---- Core file produced while running\ + test! $coreMsg" + } + puts [outputChannel] "==== $name FAILED\n" + + incr testLevel -1 + return +} + +# Skipped -- +# +# Given a test name and it constraints, returns a boolean indicating +# whether the current configuration says the test should be skipped. +# +# Side Effects: Maintains tally of total tests seen and tests skipped. +# +proc tcltest::Skipped {name constraints} { + variable testLevel + variable numTests + variable testConstraints + + if {$testLevel == 1} { + incr numTests(Total) + } + # skip the test if it's name matches an element of skip + foreach pattern [skip] { + if {[string match $pattern $name]} { + if {$testLevel == 1} { + incr numTests(Skipped) + DebugDo 1 {AddToSkippedBecause userSpecifiedSkip} + } + return 1 + } + } + # skip the test if it's name doesn't match any element of match + set ok 0 + foreach pattern [match] { + if {[string match $pattern $name]} { + set ok 1 + break + } + } + if {!$ok} { + if {$testLevel == 1} { + incr numTests(Skipped) + DebugDo 1 {AddToSkippedBecause userSpecifiedNonMatch} + } + return 1 + } + if {[string equal {} $constraints]} { + # If we're limited to the listed constraints and there aren't + # any listed, then we shouldn't run the test. + if {[limitConstraints]} { + AddToSkippedBecause userSpecifiedLimitConstraint + if {$testLevel == 1} { + incr numTests(Skipped) + } + return 1 + } + } else { + # "constraints" argument exists; + # make sure that the constraints are satisfied. + + set doTest 0 + if {[string match {*[$\[]*} $constraints] != 0} { + # full expression, e.g. {$foo > [info tclversion]} + catch {set doTest [uplevel #0 expr $constraints]} + } elseif {[regexp {[^.a-zA-Z0-9 \n\r\t]+} $constraints] != 0} { + # something like {a || b} should be turned into + # $testConstraints(a) || $testConstraints(b). + regsub -all {[.\w]+} $constraints {$testConstraints(&)} c + catch {set doTest [eval expr $c]} + } elseif {![catch {llength $constraints}]} { + # just simple constraints such as {unixOnly fonts}. + set doTest 1 + foreach constraint $constraints { + if {(![info exists testConstraints($constraint)]) \ + || (!$testConstraints($constraint))} { + set doTest 0 + + # store the constraint that kept the test from + # running + set constraints $constraint + break + } + } + } + + if {$doTest == 0} { + if {[IsVerbose skip]} { + puts [outputChannel] "++++ $name SKIPPED: $constraints" + } + + if {$testLevel == 1} { + incr numTests(Skipped) + AddToSkippedBecause $constraints + } + return 1 + } + } + return 0 +} + +# RunTest -- +# +# This is where the body of a test is evaluated. The combination of +# [RunTest] and [Eval] allows the output and error output of the test +# body to be captured for comparison against the expected values. + +proc tcltest::RunTest {name script} { + DebugPuts 3 "Running $name {$script}" + + # If there is no "memory" command (because memory debugging isn't + # enabled), then don't attempt to use the command. + + if {[llength [info commands memory]] == 1} { + memory tag $name + } + + set code [catch {uplevel 1 $script} actualAnswer] + + return [list $actualAnswer $code] +} + +##################################################################### + +# tcltest::cleanupTestsHook -- +# +# This hook allows a harness that builds upon tcltest to specify +# additional things that should be done at cleanup. +# + +if {[llength [info commands tcltest::cleanupTestsHook]] == 0} { + proc tcltest::cleanupTestsHook {} {} +} + +# tcltest::cleanupTests -- +# +# Remove files and dirs created using the makeFile and makeDirectory +# commands since the last time this proc was invoked. +# +# Print the names of the files created without the makeFile command +# since the tests were invoked. +# +# Print the number tests (total, passed, failed, and skipped) since the +# tests were invoked. +# +# Restore original environment (as reported by special variable env). +# +# Arguments: +# calledFromAllFile - if 0, behave as if we are running a single +# test file within an entire suite of tests. if we aren't running +# a single test file, then don't report status. check for new +# files created during the test run and report on them. if 1, +# report collated status from all the test file runs. +# +# Results: +# None. +# +# Side Effects: +# None +# + +proc tcltest::cleanupTests {{calledFromAllFile 0}} { + variable filesMade + variable filesExisted + variable createdNewFiles + variable testSingleFile + variable numTests + variable numTestFiles + variable failFiles + variable skippedBecause + variable currentFailure + variable originalEnv + variable originalTclPlatform + variable coreModTime + + FillFilesExisted + set testFileName [file tail [info script]] + + # Call the cleanup hook + cleanupTestsHook + + # Remove files and directories created by the makeFile and + # makeDirectory procedures. Record the names of files in + # workingDirectory that were not pre-existing, and associate them + # with the test file that created them. + + if {!$calledFromAllFile} { + foreach file $filesMade { + if {[file exists $file]} { + DebugDo 1 {Warn "cleanupTests deleting $file..."} + catch {file delete -force $file} + } + } + set currentFiles {} + foreach file [glob -nocomplain \ + -directory [temporaryDirectory] *] { + lappend currentFiles [file tail $file] + } + set newFiles {} + foreach file $currentFiles { + if {[lsearch -exact $filesExisted $file] == -1} { + lappend newFiles $file + } + } + set filesExisted $currentFiles + if {[llength $newFiles] > 0} { + set createdNewFiles($testFileName) $newFiles + } + } + + if {$calledFromAllFile || $testSingleFile} { + + # print stats + + puts -nonewline [outputChannel] "$testFileName:" + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + puts -nonewline [outputChannel] \ + "\t$index\t$numTests($index)" + } + puts [outputChannel] "" + + # print number test files sourced + # print names of files that ran tests which failed + + if {$calledFromAllFile} { + puts [outputChannel] \ + "Sourced $numTestFiles Test Files." + set numTestFiles 0 + if {[llength $failFiles] > 0} { + puts [outputChannel] \ + "Files with failing tests: $failFiles" + set failFiles {} + } + } + + # if any tests were skipped, print the constraints that kept + # them from running. + + set constraintList [array names skippedBecause] + if {[llength $constraintList] > 0} { + puts [outputChannel] \ + "Number of tests skipped for each constraint:" + foreach constraint [lsort $constraintList] { + puts [outputChannel] \ + "\t$skippedBecause($constraint)\t$constraint" + unset skippedBecause($constraint) + } + } + + # report the names of test files in createdNewFiles, and reset + # the array to be empty. + + set testFilesThatTurded [lsort [array names createdNewFiles]] + if {[llength $testFilesThatTurded] > 0} { + puts [outputChannel] "Warning: files left behind:" + foreach testFile $testFilesThatTurded { + puts [outputChannel] \ + "\t$testFile:\t$createdNewFiles($testFile)" + unset createdNewFiles($testFile) + } + } + + # reset filesMade, filesExisted, and numTests + + set filesMade {} + foreach index [list "Total" "Passed" "Skipped" "Failed"] { + set numTests($index) 0 + } + + # exit only if running Tk in non-interactive mode + # This should be changed to determine if an event + # loop is running, which is the real issue. + # Actually, this doesn't belong here at all. A package + # really has no business [exit]-ing an application. + if {![catch {package present Tk}] && ![testConstraint interactive]} { + exit + } + } else { + + # if we're deferring stat-reporting until all files are sourced, + # then add current file to failFile list if any tests in this + # file failed + + if {$currentFailure \ + && ([lsearch -exact $failFiles $testFileName] == -1)} { + lappend failFiles $testFileName + } + set currentFailure false + + # restore the environment to the state it was in before this package + # was loaded + + set newEnv {} + set changedEnv {} + set removedEnv {} + foreach index [array names ::env] { + if {![info exists originalEnv($index)]} { + lappend newEnv $index + unset ::env($index) + } else { + if {$::env($index) != $originalEnv($index)} { + lappend changedEnv $index + set ::env($index) $originalEnv($index) + } + } + } + foreach index [array names originalEnv] { + if {![info exists ::env($index)]} { + lappend removedEnv $index + set ::env($index) $originalEnv($index) + } + } + if {[llength $newEnv] > 0} { + puts [outputChannel] \ + "env array elements created:\t$newEnv" + } + if {[llength $changedEnv] > 0} { + puts [outputChannel] \ + "env array elements changed:\t$changedEnv" + } + if {[llength $removedEnv] > 0} { + puts [outputChannel] \ + "env array elements removed:\t$removedEnv" + } + + set changedTclPlatform {} + foreach index [array names originalTclPlatform] { + if {$::tcl_platform($index) \ + != $originalTclPlatform($index)} { + lappend changedTclPlatform $index + set ::tcl_platform($index) $originalTclPlatform($index) + } + } + if {[llength $changedTclPlatform] > 0} { + puts [outputChannel] "tcl_platform array elements\ + changed:\t$changedTclPlatform" + } + + if {[file exists [file join [workingDirectory] core]]} { + if {[preserveCore] > 1} { + puts "rename core file (> 1)" + puts [outputChannel] "produced core file! \ + Moving file to: \ + [file join [temporaryDirectory] core-$testFileName]" + catch {file rename -force \ + [file join [workingDirectory] core] \ + [file join [temporaryDirectory] core-$testFileName] + } msg + if {[string length $msg] > 0} { + PrintError "Problem renaming file: $msg" + } + } else { + # Print a message if there is a core file and (1) there + # previously wasn't one or (2) the new one is different + # from the old one. + + if {[info exists coreModTime]} { + if {$coreModTime != [file mtime \ + [file join [workingDirectory] core]]} { + puts [outputChannel] "A core file was created!" + } + } else { + puts [outputChannel] "A core file was created!" + } + } + } + } + flush [outputChannel] + flush [errorChannel] + return +} + +##################################################################### + +# Procs that determine which tests/test files to run + +# tcltest::GetMatchingFiles +# +# Looks at the patterns given to match and skip files and uses +# them to put together a list of the tests that will be run. +# +# Arguments: +# directory to search +# +# Results: +# The constructed list is returned to the user. This will +# primarily be used in 'all.tcl' files. It is used in +# runAllTests. +# +# Side Effects: +# None + +# a lower case version is needed for compatibility with tcltest 1.0 +proc tcltest::getMatchingFiles args {eval GetMatchingFiles $args} + +proc tcltest::GetMatchingFiles { args } { + if {[llength $args]} { + set dirList $args + } else { + # Finding tests only in [testsDirectory] is normal operation. + # This procedure is written to accept multiple directory arguments + # only to satisfy version 1 compatibility. + set dirList [list [testsDirectory]] + } + + set matchingFiles [list] + foreach directory $dirList { + + # List files in $directory that match patterns to run. + set matchFileList [list] + foreach match [matchFiles] { + set matchFileList [concat $matchFileList \ + [glob -directory $directory -types {b c f p s} \ + -nocomplain -- $match]] + } + + # List files in $directory that match patterns to skip. + set skipFileList [list] + foreach skip [skipFiles] { + set skipFileList [concat $skipFileList \ + [glob -directory $directory -types {b c f p s} \ + -nocomplain -- $skip]] + } + + # Add to result list all files in match list and not in skip list + foreach file $matchFileList { + if {[lsearch -exact $skipFileList $file] == -1} { + lappend matchingFiles $file + } + } + } + + if {[llength $matchingFiles] == 0} { + PrintError "No test files remain after applying your match and\ + skip patterns!" + } + return $matchingFiles +} + +# tcltest::GetMatchingDirectories -- +# +# Looks at the patterns given to match and skip directories and +# uses them to put together a list of the test directories that we +# should attempt to run. (Only subdirectories containing an +# "all.tcl" file are put into the list.) +# +# Arguments: +# root directory from which to search +# +# Results: +# The constructed list is returned to the user. This is used in +# the primary all.tcl file. +# +# Side Effects: +# None. + +proc tcltest::GetMatchingDirectories {rootdir} { + + # Determine the skip list first, to avoid [glob]-ing over subdirectories + # we're going to throw away anyway. Be sure we skip the $rootdir if it + # comes up to avoid infinite loops. + set skipDirs [list $rootdir] + foreach pattern [skipDirectories] { + set skipDirs [concat $skipDirs [glob -directory $rootdir -types d \ + -nocomplain -- $pattern]] + } + + # Now step through the matching directories, prune out the skipped ones + # as you go. + set matchDirs [list] + foreach pattern [matchDirectories] { + foreach path [glob -directory $rootdir -types d -nocomplain -- \ + $pattern] { + if {[lsearch -exact $skipDirs $path] == -1} { + set matchDirs [concat $matchDirs [GetMatchingDirectories $path]] + if {[file exists [file join $path all.tcl]]} { + lappend matchDirs $path + } + } + } + } + + if {[llength $matchDirs] == 0} { + DebugPuts 1 "No test directories remain after applying match\ + and skip patterns!" + } + return $matchDirs +} + +# tcltest::runAllTests -- +# +# prints output and sources test files according to the match and +# skip patterns provided. after sourcing test files, it goes on +# to source all.tcl files in matching test subdirectories. +# +# Arguments: +# shell being tested +# +# Results: +# None. +# +# Side effects: +# None. + +proc tcltest::runAllTests { {shell ""} } { + variable testSingleFile + variable numTestFiles + variable numTests + variable failFiles + + FillFilesExisted + if {[llength [info level 0]] == 1} { + set shell [interpreter] + } + + set testSingleFile false + + puts [outputChannel] "Tests running in interp: $shell" + puts [outputChannel] "Tests located in: [testsDirectory]" + puts [outputChannel] "Tests running in: [workingDirectory]" + puts [outputChannel] "Temporary files stored in\ + [temporaryDirectory]" + + # [file system] first available in Tcl 8.4 + if {![catch {file system [testsDirectory]} result] + && ![string equal native [lindex $result 0]]} { + # If we aren't running in the native filesystem, then we must + # run the tests in a single process (via 'source'), because + # trying to run then via a pipe will fail since the files don't + # really exist. + singleProcess 1 + } + + if {[singleProcess]} { + puts [outputChannel] \ + "Test files sourced into current interpreter" + } else { + puts [outputChannel] \ + "Test files run in separate interpreters" + } + if {[llength [skip]] > 0} { + puts [outputChannel] "Skipping tests that match: [skip]" + } + puts [outputChannel] "Running tests that match: [match]" + + if {[llength [skipFiles]] > 0} { + puts [outputChannel] \ + "Skipping test files that match: [skipFiles]" + } + if {[llength [matchFiles]] > 0} { + puts [outputChannel] \ + "Only running test files that match: [matchFiles]" + } + + set timeCmd {clock format [clock seconds]} + puts [outputChannel] "Tests began at [eval $timeCmd]" + + # Run each of the specified tests + foreach file [lsort [GetMatchingFiles]] { + set tail [file tail $file] + puts [outputChannel] $tail + flush [outputChannel] + + if {[singleProcess]} { + incr numTestFiles + uplevel 1 [list ::source $file] + } else { + # Pass along our configuration to the child processes. + # EXCEPT for the -outfile, because the parent process + # needs to read and process output of children. + set childargv [list] + foreach opt [Configure] { + if {[string equal $opt -outfile]} {continue} + lappend childargv $opt [Configure $opt] + } + set cmd [linsert $childargv 0 | $shell $file] + if {[catch { + incr numTestFiles + set pipeFd [open $cmd "r"] + while {[gets $pipeFd line] >= 0} { + if {[regexp [join { + {^([^:]+):\t} + {Total\t([0-9]+)\t} + {Passed\t([0-9]+)\t} + {Skipped\t([0-9]+)\t} + {Failed\t([0-9]+)} + } ""] $line null testFile \ + Total Passed Skipped Failed]} { + foreach index {Total Passed Skipped Failed} { + incr numTests($index) [set $index] + } + if {$Failed > 0} { + lappend failFiles $testFile + } + } elseif {[regexp [join { + {^Number of tests skipped } + {for each constraint:} + {|^\t(\d+)\t(.+)$} + } ""] $line match skipped constraint]} { + if {[string match \t* $match]} { + AddToSkippedBecause $constraint $skipped + } + } else { + puts [outputChannel] $line + } + } + close $pipeFd + } msg]} { + puts [outputChannel] "Test file error: $msg" + # append the name of the test to a list to be reported + # later + lappend testFileFailures $file + } + } + } + + # cleanup + puts [outputChannel] "\nTests ended at [eval $timeCmd]" + cleanupTests 1 + if {[info exists testFileFailures]} { + puts [outputChannel] "\nTest files exiting with errors: \n" + foreach file $testFileFailures { + puts [outputChannel] " [file tail $file]\n" + } + } + + # Checking for subdirectories in which to run tests + foreach directory [GetMatchingDirectories [testsDirectory]] { + set dir [file tail $directory] + puts [outputChannel] [string repeat ~ 44] + puts [outputChannel] "$dir test began at [eval $timeCmd]\n" + + uplevel 1 [list ::source [file join $directory all.tcl]] + + set endTime [eval $timeCmd] + puts [outputChannel] "\n$dir test ended at $endTime" + puts [outputChannel] "" + puts [outputChannel] [string repeat ~ 44] + } + return +} + +##################################################################### + +# Test utility procs - not used in tcltest, but may be useful for +# testing. + +# tcltest::loadTestedCommands -- +# +# Uses the specified script to load the commands to test. Allowed to +# be empty, as the tested commands could have been compiled into the +# interpreter. +# +# Arguments +# none +# +# Results +# none +# +# Side Effects: +# none. + +proc tcltest::loadTestedCommands {} { + variable l + if {[string equal {} [loadScript]]} { + return + } + + return [uplevel 1 [loadScript]] +} + +# tcltest::saveState -- +# +# Save information regarding what procs and variables exist. +# +# Arguments: +# none +# +# Results: +# Modifies the variable saveState +# +# Side effects: +# None. + +proc tcltest::saveState {} { + variable saveState + uplevel 1 [list ::set [namespace which -variable saveState]] \ + {[::list [::info procs] [::info vars]]} + DebugPuts 2 "[lindex [info level 0] 0]: $saveState" + return +} + +# tcltest::restoreState -- +# +# Remove procs and variables that didn't exist before the call to +# [saveState]. +# +# Arguments: +# none +# +# Results: +# Removes procs and variables from your environment if they don't +# exist in the saveState variable. +# +# Side effects: +# None. + +proc tcltest::restoreState {} { + variable saveState + foreach p [uplevel 1 {::info procs}] { + if {([lsearch [lindex $saveState 0] $p] < 0) + && ![string equal [namespace current]::$p \ + [uplevel 1 [list ::namespace origin $p]]]} { + + DebugPuts 2 "[lindex [info level 0] 0]: Removing proc $p" + uplevel 1 [list ::catch [list ::rename $p {}]] + } + } + foreach p [uplevel 1 {::info vars}] { + if {[lsearch [lindex $saveState 1] $p] < 0} { + DebugPuts 2 "[lindex [info level 0] 0]:\ + Removing variable $p" + uplevel 1 [list ::catch [list ::unset $p]] + } + } + return +} + +# tcltest::normalizeMsg -- +# +# Removes "extra" newlines from a string. +# +# Arguments: +# msg String to be modified +# +# Results: +# string with extra newlines removed +# +# Side effects: +# None. + +proc tcltest::normalizeMsg {msg} { + regsub "\n$" [string tolower $msg] "" msg + set msg [string map [list "\n\n" "\n"] $msg] + return [string map [list "\n\}" "\}"] $msg] +} + +# tcltest::makeFile -- +# +# Create a new file with the name , and write to it. +# +# If this file hasn't been created via makeFile since the last time +# cleanupTests was called, add it to the $filesMade list, so it will be +# removed by the next call to cleanupTests. +# +# Arguments: +# contents content of the new file +# name name of the new file +# directory directory name for new file +# +# Results: +# absolute path to the file created +# +# Side effects: +# None. + +proc tcltest::makeFile {contents name {directory ""}} { + variable filesMade + FillFilesExisted + + if {[llength [info level 0]] == 3} { + set directory [temporaryDirectory] + } + + set fullName [file join $directory $name] + + DebugPuts 3 "[lindex [info level 0] 0]:\ + putting ``$contents'' into $fullName" + + set fd [open $fullName w] + fconfigure $fd -translation lf + if {[string equal [string index $contents end] \n]} { + puts -nonewline $fd $contents + } else { + puts $fd $contents + } + close $fd + + if {[lsearch -exact $filesMade $fullName] == -1} { + lappend filesMade $fullName + } + return $fullName +} + +# tcltest::removeFile -- +# +# Removes the named file from the filesystem +# +# Arguments: +# name file to be removed +# directory directory from which to remove file +# +# Results: +# return value from [file delete] +# +# Side effects: +# None. + +proc tcltest::removeFile {name {directory ""}} { + variable filesMade + FillFilesExisted + if {[llength [info level 0]] == 2} { + set directory [temporaryDirectory] + } + set fullName [file join $directory $name] + DebugPuts 3 "[lindex [info level 0] 0]: removing $fullName" + set idx [lsearch -exact $filesMade $fullName] + set filesMade [lreplace $filesMade $idx $idx] + if {$idx == -1} { + DebugDo 1 { + Warn "removeFile removing \"$fullName\":\n not created by makeFile" + } + } + if {![file isfile $fullName]} { + DebugDo 1 { + Warn "removeFile removing \"$fullName\":\n not a file" + } + } + return [file delete $fullName] +} + +# tcltest::makeDirectory -- +# +# Create a new dir with the name . +# +# If this dir hasn't been created via makeDirectory since the last time +# cleanupTests was called, add it to the $directoriesMade list, so it +# will be removed by the next call to cleanupTests. +# +# Arguments: +# name name of the new directory +# directory directory in which to create new dir +# +# Results: +# absolute path to the directory created +# +# Side effects: +# None. + +proc tcltest::makeDirectory {name {directory ""}} { + variable filesMade + FillFilesExisted + if {[llength [info level 0]] == 2} { + set directory [temporaryDirectory] + } + set fullName [file join $directory $name] + DebugPuts 3 "[lindex [info level 0] 0]: creating $fullName" + file mkdir $fullName + if {[lsearch -exact $filesMade $fullName] == -1} { + lappend filesMade $fullName + } + return $fullName +} + +# tcltest::removeDirectory -- +# +# Removes a named directory from the file system. +# +# Arguments: +# name Name of the directory to remove +# directory Directory from which to remove +# +# Results: +# return value from [file delete] +# +# Side effects: +# None + +proc tcltest::removeDirectory {name {directory ""}} { + variable filesMade + FillFilesExisted + if {[llength [info level 0]] == 2} { + set directory [temporaryDirectory] + } + set fullName [file join $directory $name] + DebugPuts 3 "[lindex [info level 0] 0]: deleting $fullName" + set idx [lsearch -exact $filesMade $fullName] + set filesMade [lreplace $filesMade $idx $idx] + if {$idx == -1} { + DebugDo 1 { + Warn "removeDirectory removing \"$fullName\":\n not created\ + by makeDirectory" + } + } + if {![file isdirectory $fullName]} { + DebugDo 1 { + Warn "removeDirectory removing \"$fullName\":\n not a directory" + } + } + return [file delete -force $fullName] +} + +# tcltest::viewFile -- +# +# reads the content of a file and returns it +# +# Arguments: +# name of the file to read +# directory in which file is located +# +# Results: +# content of the named file +# +# Side effects: +# None. + +proc tcltest::viewFile {name {directory ""}} { + FillFilesExisted + if {[llength [info level 0]] == 2} { + set directory [temporaryDirectory] + } + set fullName [file join $directory $name] + set f [open $fullName] + set data [read -nonewline $f] + close $f + return $data +} + +# tcltest::bytestring -- +# +# Construct a string that consists of the requested sequence of bytes, +# as opposed to a string of properly formed UTF-8 characters. +# This allows the tester to +# 1. Create denormalized or improperly formed strings to pass to C +# procedures that are supposed to accept strings with embedded NULL +# bytes. +# 2. Confirm that a string result has a certain pattern of bytes, for +# instance to confirm that "\xe0\0" in a Tcl script is stored +# internally in UTF-8 as the sequence of bytes "\xc3\xa0\xc0\x80". +# +# Generally, it's a bad idea to examine the bytes in a Tcl string or to +# construct improperly formed strings in this manner, because it involves +# exposing that Tcl uses UTF-8 internally. +# +# Arguments: +# string being converted +# +# Results: +# result fom encoding +# +# Side effects: +# None + +proc tcltest::bytestring {string} { + return [encoding convertfrom identity $string] +} + +# tcltest::OpenFiles -- +# +# used in io tests, uses testchannel +# +# Arguments: +# None. +# +# Results: +# ??? +# +# Side effects: +# None. + +proc tcltest::OpenFiles {} { + if {[catch {testchannel open} result]} { + return {} + } + return $result +} + +# tcltest::LeakFiles -- +# +# used in io tests, uses testchannel +# +# Arguments: +# None. +# +# Results: +# ??? +# +# Side effects: +# None. + +proc tcltest::LeakFiles {old} { + if {[catch {testchannel open} new]} { + return {} + } + set leak {} + foreach p $new { + if {[lsearch $old $p] < 0} { + lappend leak $p + } + } + return $leak +} + +# +# Internationalization / ISO support procs -- dl +# + +# tcltest::SetIso8859_1_Locale -- +# +# used in cmdIL.test, uses testlocale +# +# Arguments: +# None. +# +# Results: +# None. +# +# Side effects: +# None. + +proc tcltest::SetIso8859_1_Locale {} { + variable previousLocale + variable isoLocale + if {[info commands testlocale] != ""} { + set previousLocale [testlocale ctype] + testlocale ctype $isoLocale + } + return +} + +# tcltest::RestoreLocale -- +# +# used in cmdIL.test, uses testlocale +# +# Arguments: +# None. +# +# Results: +# None. +# +# Side effects: +# None. + +proc tcltest::RestoreLocale {} { + variable previousLocale + if {[info commands testlocale] != ""} { + testlocale ctype $previousLocale + } + return +} + +# tcltest::threadReap -- +# +# Kill all threads except for the main thread. +# Do nothing if testthread is not defined. +# +# Arguments: +# none. +# +# Results: +# Returns the number of existing threads. +# +# Side Effects: +# none. +# + +proc tcltest::threadReap {} { + if {[info commands testthread] != {}} { + + # testthread built into tcltest + + testthread errorproc ThreadNullError + while {[llength [testthread names]] > 1} { + foreach tid [testthread names] { + if {$tid != [mainThread]} { + catch { + testthread send -async $tid {testthread exit} + } + } + } + ## Enter a bit a sleep to give the threads enough breathing + ## room to kill themselves off, otherwise the end up with a + ## massive queue of repeated events + after 1 + } + testthread errorproc ThreadError + return [llength [testthread names]] + } elseif {[info commands thread::id] != {}} { + + # Thread extension + + thread::errorproc ThreadNullError + while {[llength [thread::names]] > 1} { + foreach tid [thread::names] { + if {$tid != [mainThread]} { + catch {thread::send -async $tid {thread::exit}} + } + } + ## Enter a bit a sleep to give the threads enough breathing + ## room to kill themselves off, otherwise the end up with a + ## massive queue of repeated events + after 1 + } + thread::errorproc ThreadError + return [llength [thread::names]] + } else { + return 1 + } + return 0 +} + +# Initialize the constraints and set up command line arguments +namespace eval tcltest { + # Define initializers for all the built-in contraint definitions + DefineConstraintInitializers + + # Set up the constraints in the testConstraints array to be lazily + # initialized by a registered initializer, or by "false" if no + # initializer is registered. + trace variable testConstraints r [namespace code SafeFetch] + + # Only initialize constraints at package load time if an + # [initConstraintsHook] has been pre-defined. This is only + # for compatibility support. The modern way to add a custom + # test constraint is to just call the [testConstraint] command + # straight away, without all this "hook" nonsense. + if {[string equal [namespace current] \ + [namespace qualifiers [namespace which initConstraintsHook]]]} { + InitConstraints + } else { + proc initConstraintsHook {} {} + } + + # Define the standard match commands + customMatch exact [list string equal] + customMatch glob [list string match] + customMatch regexp [list regexp --] + + # If the TCLTEST_OPTIONS environment variable exists, configure + # tcltest according to the option values it specifies. This has + # the effect of resetting tcltest's default configuration. + proc ConfigureFromEnvironment {} { + upvar #0 env(TCLTEST_OPTIONS) options + if {[catch {llength $options} msg]} { + Warn "invalid TCLTEST_OPTIONS \"$options\":\n invalid\ + Tcl list: $msg" + return + } + if {[llength $::env(TCLTEST_OPTIONS)] % 2} { + Warn "invalid TCLTEST_OPTIONS: \"$options\":\n should be\ + -option value ?-option value ...?" + return + } + if {[catch {eval Configure $::env(TCLTEST_OPTIONS)} msg]} { + Warn "invalid TCLTEST_OPTIONS: \"$options\":\n $msg" + return + } + } + if {[info exists ::env(TCLTEST_OPTIONS)]} { + ConfigureFromEnvironment + } + + proc LoadTimeCmdLineArgParsingRequired {} { + set required false + if {[info exists ::argv] && [lsearch -exact $::argv -help] != -1} { + # The command line asks for -help, so give it (and exit) + # right now. ([configure] does not process -help) + set required true + } + foreach hook { PrintUsageInfoHook processCmdLineArgsHook + processCmdLineArgsAddFlagsHook } { + if {[string equal [namespace current] [namespace qualifiers \ + [namespace which $hook]]]} { + set required true + } else { + proc $hook args {} + } + } + return $required + } + + # Only initialize configurable options from the command line arguments + # at package load time if necessary for backward compatibility. This + # lets the tcltest user call [configure] for themselves if they wish. + # Traces are established for auto-configuration from the command line + # if any configurable options are accessed before the user calls + # [configure]. + if {[LoadTimeCmdLineArgParsingRequired]} { + ProcessCmdLineArgs + } else { + EstablishAutoConfigureTraces + } + + package provide [namespace tail [namespace current]] $Version +} diff --git a/test/test.dic b/test/test.dic new file mode 100644 index 00000000..34616f05 --- /dev/null +++ b/test/test.dic @@ -0,0 +1,31 @@ +##NXDICT-1.0 +#--------------------------------------------------------------------- +# Dictionary file for testing NXdict +# +# Mark Koennecke, November 2006 +#-------------------------------------------------------------------- +text=/entry1,NXentry/SDS testtext -type NX_CHAR +testfloat=/entry1,NXentry/SDS testfloat +testint=/entry1,NXentry/SDS testint -type NX_INT32 +testmot=/entry1,NXentry/SDS position +testmot_null=/entry1,NXentry/SDS position_zeropoint +testcter_preset=/entry1,NXentry/control,NXmonitor/SDS preset +testcter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR +testcter_time=/entry1,NXentry/control,NXmonitor/SDS time +testcter_00=/entry1,NXentry/control,NXmonitor/SDS counts0 -type NX_INT32 +testcter_01=/entry1,NXentry/control,NXmonitor/SDS counts1 -type NX_INT32 +testcter_02=/entry1,NXentry/control,NXmonitor/SDS counts2 -type NX_INT32 +testcter_03=/entry1,NXentry/control,NXmonitor/SDS counts3 -type NX_INT32 +testcter_04=/entry1,NXentry/control,NXmonitor/SDS counts4 -type NX_INT32 +testhm=/entry1,NXentry/detector,NXdata/SDS hmdata -type NX_INT32 -rank 1 \ + -dim {$(dim0)} +testhmtb=/entry1,NXentry/detector,NXdata/SDS time_binning +testar=/entry1,NXentry/detector,NXdata/SDS x_axis +testintar=/entry1,NXentry/detector,NXdata/SDS y_axis -type NX_INT32 +testsd=/entry1,NXentry/detector,NXdata/SDS gurke -rank 1 \ + -type NX_INT32 -dim {$(dim0)} +testlink=/entry1,NXentry/detector,NXdata/NXVGROUP + + + + \ No newline at end of file diff --git a/test/test.hdd b/test/test.hdd new file mode 100644 index 00000000..2e05e49c --- /dev/null +++ b/test/test.hdd @@ -0,0 +1,7 @@ +*************************** Test Data File ******************************** +Original Filename = !!FILE!! +File Creation Date = !!DATE!! +**************************************************************************** +---------------------------------------------------------------------------- +!!SCANZERO!! +**************************** DATA ****************************************** diff --git a/test/testinc.tcl b/test/testinc.tcl new file mode 100644 index 00000000..d86d45a0 --- /dev/null +++ b/test/testinc.tcl @@ -0,0 +1,10 @@ +#------------------------------------------------------------------------------ +# This is a prelude to source into tcl for testing regression tests. +# copyright: see file COPYRIGHT +# +# Mark Koennecke, July 2006 +#------------------------------------------------------------------------------ +source tcltest.tcl +namespace import tcltest::* +source testutil.tcl +source sicstcldebug.tcl diff --git a/test/testini.tcl b/test/testini.tcl new file mode 100644 index 00000000..d87dfc6a --- /dev/null +++ b/test/testini.tcl @@ -0,0 +1,196 @@ +# -------------------------------------------------------------------------- +# Initialization script for testing SICS +# +# Started: Dr. Mark Koennecke, July 2006 +#--------------------------------------------------------------------------- +# O P T I O N S + +# --------------- Initialize Tcl internals -------------------------------- + +# first all the server options are set + +ServerOption ReadTimeOut 10 +# timeout when checking for commands. In the main loop SICS checks for +# pending commands on each connection with the above timeout, has +# PERFORMANCE impact! + +ServerOption AcceptTimeOut 10 +# timeout when checking for connection req. +# Similar to above, but for connections + +ServerOption ReadUserPasswdTimeout 500000 +# time to wiat for a user/passwd to be sent from a client. Increase this +# if there is a problem connecting to a server due to network overload\ + +ServerOption ServerPort 2911 +# the port number the server is going to listen at. The client MUST know +# this number in order to connect. It is in client.ini + +ServerOption InterruptPort 2913 +# The UDP port where the server will wait for Interrupts from clients. +# Obviously, clients wishing to interrupt need to know this number. + + +#--------------------------------------------------------------------------- +# U S E R S + +# than the SICS users are specified +# Syntax: SicsUser name password userRightsCode +SicsUser Mugger Mugger 1 +SicsUser User User 2 +SicsUser Spy Spy 3 +#SicsUser Spy 007 1 + +#----------------- SICS Variable +VarMake lotte Text User + +#----------------- Motors --------------------------------------------------- +Motor brumm regress +MakeDrive +#----------------- Alias ---------------------------------------------------- +SicsAlias brumm miau +#----------------- Counters ------------------------------------------------- +MakeCounter aba regress +MakeCounter hugo SIM -1. +MakeCounter lieselotte SIM -1. +#------------------------------ +proc SICSValue {command} { + set txt [eval $command] + set l [split $txt =] + return [string trim [lindex $l 1]] +} +#----------------------------- +proc multitransfer {} { + append res [SICSValue "aba gettime"] " " + for {set i 0} {$i < 7} {incr i} { + append res [SICSValue "aba getmonitor $i"] " " + } + return $res +} +#----------------------------------- +MakeMultiCounter multi aba hugo lieselotte +multi transferscript multitransfer + +#------------- For Scanning --------------------------------------------- +# This is with the tricky bit set: we use a multicounter and use the +# scantransfer function to return values of a gaussian for a4 positions. +# This gives nice scan data which can be used to test all sorts of things. +#------------------------------------------------------------------------- +MakeDataNumber SicsDataNumber ./DataNumber +VarMake SicsDataPath Text Mugger +SicsDataPath ./ +SicsDataPath lock +VarMake SicsDataPrefix Text Mugger +SicsDataPrefix regression +SicsDataPrefix lock +VarMake SicsDataPostFix Text Mugger +SicsDataPostFix .dat +SicsDataPostFix lock + +Motor a1 SIM -2 180 -.1 10 +Motor a2 SIM 30 150 -.1 10 +Motor a3 SIM -360 360 -.1 10 +Motor a4 SIM -180 180 -.1 10 +Motor a5 SIM -180 180 -.1 10 +Motor a6 SIM -180 180 -.1 10 +Motor sgu SIM -20 20 -.1 10 +Motor sgl SIM -20 20 -.1 10 +MakeMultiCounter scanCter aba + +proc scantransfer {} { + set FWHM 1.5 + set pos 5.33 + set height 700 + set stddev [expr $FWHM/2.354] + set ftmp [expr ([SICSValue a4] - $pos)/$stddev] + set count [expr 10 + $height*0.4*exp(-.5*$ftmp*$ftmp)] + set counti [expr int($count)] + append res [SICSValue "lieselotte gettime"] " " + append res $counti " " + for {set i 1} {$i < 7} {incr i} { + append res [SICSValue "lieselotte getmonitor $i"] " " + } + return $res +} +scancter transferscript scantransfer + +MakeScanCommand xxxscan scancter test.hdd recover.bin +MakePeakCenter xxxscan +source scancommand.tcl +MakeOptimise opti scancter +MakeMaximize scancter + +#------------------------------------------------------------------------- +# Histogram Memory +#------------------------------------------------------------------------ +MakeHM hm regress +hm configure rank 1 +hm configure dim0 23 +hm configure testval 1 +hm configure errortype 0 +hm configure recover 1 +hm configure init 1 +hm init + +MakeHM tof regress +tof configure rank 1 +tof configure HistMode TOF +tof configure dim0 23 +tof configure testval 1 +tof configure errortype 0 +tof configure recover 1 +tof genbin 10 12 100 +tof configure init 1 +tof init + +#------------------------------------------------------------------------- +# NXscript +#------------------------------------------------------------------------- +MakeNXScript +#------------------------------------------------------------------------- +proc makearray {} { + global ar + for { set i 10} {$i < 20} {incr i} { + set ar([expr $i - 10]) [expr $i*1.0] + } +} +#------------------------------------------------------------------------ +proc makeintarray {} { + global ar + for { set i 10} {$i < 20} {incr i} { + set ar([expr $i - 10]) $i + } +} +Publish makearray User +Publish makeintarray User +Publish parray User + +#------------------------------------------------------------------------ +# SicsData +#------------------------------------------------------------------------ +sicsdatafactory new data +sicsdatafactory new duta +#----------------------------------------------------------------------- +# tasub +#----------------------------------------------------------------------- +MakeTasUB tasub +#----------------------------------------------------------------------- +# MultiMotors +#---------------------------------------------------------------------- +MakeMulti sa +sa alias a3 om +sa alias a4 stt +sa pos noeff a3 24 a4 48 +sa endconfig + +#----------------------------------------------------------------------- +# Hipadaba +#---------------------------------------------------------------------- +InstallHdb +hmake /instrument spy none +hmake /instrument/sample spy none +hattach /instrument/sample a3 omega +hattach /instrument/sample qh qh +hmake /instrument/detector spy none +hattach /instrument/detector hm data +hattach /instrument lotte title \ No newline at end of file diff --git a/test/testmisc.tcl b/test/testmisc.tcl new file mode 100644 index 00000000..7122b49a --- /dev/null +++ b/test/testmisc.tcl @@ -0,0 +1,21 @@ +#-------------------------------------------------------------------- +# This is for testing odd bits and pieces +# +# Mark Koennecke, October 2006 +#-------------------------------------------------------------------- + +puts stdout "Testing variables and aliases" + +test misc-1.0 {Test Variables} -body { + testPar lotte Uuuuuurgs User + return OK +} -result OK + +test misc-1.1 {Test Alias} -body { + config rights User User + miau errortype 0 + testDrive miau 10 User + return OK +} -result OK + + diff --git a/test/testmumo.tcl b/test/testmumo.tcl new file mode 100644 index 00000000..3a40d2e8 --- /dev/null +++ b/test/testmumo.tcl @@ -0,0 +1,80 @@ +#----------------------------------------------------------------------- +# Some tests for SANS style MultiMotors. A MultiMotor with the name sa +# must have been initialized in the test initializaton file. +# +# Mark Koennecke, November 2006 +#---------------------------------------------------------------------- +puts stdout "Testing SANS MultiMotor Module..." + +proc testMumoPosition {omPos sttPos} { + set txt [sa] + set luf [split $txt "\n"] + set l1 [lindex $luf 0] + if {[string first "Status listing" $l1] < 0} { + error "Bad first line on MultiMotor: $l1" + } + set l2 [lindex $luf 1] + set li2 [split $l2 =] + if {abs([lindex $li2 1] - $omPos) > .1} { + error "Bad omega position: $li2, expected $omPos" + } + set l2 [lindex $luf 2] + set li2 [split $l2 =] + if {abs([lindex $li2 1] - $sttPos) > .1} { + error "Bad stt position: $li2, expected $sttPos" + } + return OK +} +#--------------------------------------------------------------------- +test mumo-1.0 {Test Reading} -body { + config rights Mugger Mugger + drive a3 0 a4 0 + return [testMumoPosition .0 .0] +} -result OK +#---------------------------------------------------------------------- +test mumo-1.1 {Test Named Position} -body { + sa noeff + return [testMumoPosition 24. 48.] +} -result OK +#--------------------------------------------------------------------- +test mumo-1.2 {Test Back} -body { + sa back + return [testMumoPosition 0. 0.] +} -result OK +#---------------------------------------------------------------------- +test mumo-1.3 {Test defpos} -body { + sa defpos fart om 10 stt 43 + sa fart + return [testMumoPosition 10. 43.] +} -result OK +#----------------------------------------------------------------------- +test mumo-1.4 {Test individual driving} -body { + sa noeff + sa om 27 + return [testMumoPosition 27 48.] +} -result OK +#----------------------------------------------------------------------- +test mumo-1.5 {Test pos definiton} -body { + sa pos gurke + sa back + sa gurke + return [testMumoPosition 27 48.] +} -result OK +#---------------------------------------------------------------------- +test mumo-1.6 {Test dropping named position} -body { + sa drop fart + set txt [sa fart] + if {[string first ERROR $txt] < 0} { + error "Did not trigger error when trying to drive a dropped position" + } + return OK +} -result OK +#---------------------------------------------------------------------- +test mumo-1.6 {Test Permission} -body { + config rights Spy Spy + set txt [sa neoff] + if {[string first ERROR $txt] < 0} { + error "Did not trigger error whithout permission" + } + return OK +} -result OK diff --git a/test/testsics b/test/testsics new file mode 100755 index 00000000..5fabdb39 --- /dev/null +++ b/test/testsics @@ -0,0 +1,60 @@ +#!/usr/bin/tclsh +#------------------------------------------------------------------------------ +# This is a regression test for SICS. Before this can be used a SICServer must +# have been started with: SICServer testini.tcl. This file uses the +# tcltest package which comes with SICS for tests. +# +# copyright: see file COPYRIGHT +# +# Started: Mark Koennecke, July 2006 +#------------------------------------------------------------------------------ +# as of now we have tcl8.3 which has an outdated version of tcltest. We use +# a better version in a local file. Once tcl8.4 has made it into the distro +# I use, use the line below. We need tcltest 2.+ +# package require tcltest +source tcltest.tcl +namespace import tcltest::* +source testutil.tcl +source sicstcldebug.tcl + +#--------------- Test Miscellaneous stuff +source testmisc.tcl + +#-------------- Test for motors +source mottest.tcl + +#-------------- Test Counter +set countername aba +set errorname aba +source countertest.tcl + +#-------------- Test Multi Counter +set countername multi +source countertest.tcl + +#-------------- Test batch processing +source batchtest.tcl + +#-------------- Test scans +source scantest.tcl + +#------------ Test peak optimization +source optitest.tcl + +#----------- test histogram memory +source histtest.tcl + +#----------- test sics data +source testsicsdata.tcl + + +#----------- test nxscript +source nxscripttest.tcl + +#------------ test SANS MultiMotor +source testmumo.tcl + +#------------ print test summary +cleanupTests +exit 1 + diff --git a/test/testsicsdata.tcl b/test/testsicsdata.tcl new file mode 100644 index 00000000..c42b5fa9 --- /dev/null +++ b/test/testsicsdata.tcl @@ -0,0 +1,218 @@ +#------------------------------------------------------------------------- +# This is a regression test for the SICS data module +# +# Mark Koennecke, November 2006 +#------------------------------------------------------------------------- +puts stdout "Testing SicsData" +data clear + +test sicsdata-1.0 {Test writing int} -body { + config rights User User + for {set i 0} {$i < 5} { incr i} { + testOK "data putint $i $i" + } + for {set i 0} {$i < 5} { incr i} { + set val [SICSValue "data get $i"] + if {$val != $i} { + error "SicsData returned a bad value: expected $i received $val" + } + } + return OK +} -result OK + +test sicsdata-1.1 {Test writing float} -body { + for {set i 0} {$i < 5} { incr i} { + set v [expr $i * 1.0] + testOK "data putfloat $i $v" + } + for {set i 0} {$i < 5} { incr i} { + set val [SICSValue "data get $i"] + if {abs($val - $i) > .000001} { + error "SicsData returned a bad value: expected $i received $val" + } + } + return OK +} -result OK + +test sicsdata-1.2 {Test used} -body { + set val [SICSValue "data used"] + if {$val != 5} { + error "Expected data used to be 5, not $val" + } + return OK +} -result OK + +test sicsdata-1.3 {Test clear} -body { + testOK "data clear" + set val [SICSValue "data used"] + if {$val != 0} { + error "Expected data used to be 0, not $val" + } + return OK +} -result OK + +xxxscan clear +xxxscan add a4 2. .2 +xxxscan run 30 timer 2 + +test sicsdata-1.4 {Testing scancounts} -body { + testOK "data copyscancounts 0 xxxscan" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {$val != 10} { + error "Expected data 0 to be 10, not $val" + } + set val [SICSValue "data get 10"] + if {$val != 41} { + error "Expected data 10 to be 41, not $val" + } + set val [SICSValue "data get 20"] + if {$val != 171} { + error "Expected data 10 to be 171, not $val" + } + return OK +} -result OK + +test sicsdata-1.5 {Testing scanmonitor} -body { + testOK "data clear" + testOK "data copyscanmon 0 xxxscan 2" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {$val != 0} { + error "Expected data 0 to be 0, not $val" + } + return OK +} -result OK + +test sicsdata-1.6 {Testing scanvar} -body { + testOK "data copyscanvar 0 xxxscan 0" + set val [SICSValue "data used"] + if {$val != 30} { + error "Expected data used to be 30, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 2.0) > .001} { + error "Expected data 0 to be 2.0, not $val" + } + set val [SICSValue "data get 20"] + if {abs($val - 6.0) > .001} { + error "Expected data 20 to be 6.0, not $val" + } + set val [SICSValue "data get 29"] + if {abs($val - 7.8) > .001} { + error "Expected data 29 to be 7.8, not $val" + } + return OK +} -result OK + +config rights Mugger Mugger +tof genbin 20 10 50 +tof init + +test sicsdata-1.7 {Testing timebin} -body { + testOK "data clear" + testOK "data copytimebin 0 tof" + set val [SICSValue "data used"] + if {$val != 50} { + error "Expected data used to be 50, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 20.0) > .001} { + error "Expected data 0 to be 20.0, not $val" + } + set val [SICSValue "data get 49"] + if {abs($val - 510.0) > .001} { + error "Expected data 49 to be 510.0, not $val" + } + return OK +} -result OK + +hm initval 32 + +test sicsdata-1.8 {Testing hm} -body { + testOK "data clear" + testOK "data copyhm 0 hm" + set val [SICSValue "data used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + set val [SICSValue "data get 0"] + if {abs($val - 32.0) > .001} { + error "Expected data 0 to be 32.0, not $val" + } + set val [SICSValue "data get 22"] + if {abs($val - 32.0) > .001} { + error "Expected data 22 to be 32.0, not $val" + } + return OK +} -result OK + +test sicsdata-1.8 {Testing UU write} -body { + set text [data writeuu hugo] + if {[string first "begin 622" $text] < 0} { + error "Bad reply on uuwrite: $text" + } + return OK +} -result OK + +test sicsdata-1.9 {Testing file dump} -body { + data clear + data copyhm 0 hm + testOK "data dump test.dat" + set status [catch {exec diff test.dat sicsdatasoll.dat} msg] + if {$status != 0} { + error "Difference in dump file: $msg" + } + return OK +} -result OK + +test sicsdata-1.10 {Copying sicsdata} -body { + duta clear + data clear + data copyhm 0 hm + testNoError "duta copydata 0 data 0 23" + set val [SICSValue "duta used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + for {set i 0} {$i < 23} {incr i} { + set val [SICSValue "duta get $"] + if {abs($val - 32.0) > .001} { + error "Expected data $i to be 32.0, not $val" + } + } + return OK +} -result OK + +test sicsdata-1.11 {Division} -body { + + config rights Mugger Mugger + duta clear + data clear + hm initval 32 + data copyhm 0 hm + hm initval 16 + duta copyhm 0 hm + testNoError "data divideby duta" + set val [SICSValue "data used"] + if {$val != 23} { + error "Expected data used to be 23, not $val" + } + for {set i 0} {$i < 23} {incr i} { + set val [SICSValue "data get $"] + if {abs($val - 2.0) > .001} { + error "Expected data $i to be 2.0, not $val" + } + } + return OK +} -result OK + + + + diff --git a/test/testsoll.xml b/test/testsoll.xml new file mode 100644 index 00000000..3d0c0638 --- /dev/null +++ b/test/testsoll.xml @@ -0,0 +1,79 @@ + + + + Hugo ist eine Nassnase + + 27.8000 + + + 177 + + + 15.0000 + + + 0.0000 + + + + 10.0000 + + timer + + + 5 + + + 10 + + + 25 + + + 35 + + + 45 + + + + + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 55 + 55 55 55 + + + 500.0000 800.0000 1100.0000 1400.0000 + 1700.0000 2000.0000 2300.0000 2600.0000 + 2900.0000 3200.0000 3500.0000 3800.0000 + 4100.0000 4400.0000 4700.0000 5000.0000 + 5300.0000 5600.0000 5900.0000 6200.0000 + + + 10.0000 11.0000 12.0000 13.0000 + 14.0000 15.0000 16.0000 17.0000 + 18.0000 19.0000 + + + 10 11 12 13 + 14 15 16 17 + 18 19 + + + + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 23 + 23 23 23 + + + + diff --git a/test/testtasub.tcl b/test/testtasub.tcl new file mode 100644 index 00000000..486ac33e --- /dev/null +++ b/test/testtasub.tcl @@ -0,0 +1,265 @@ +#---------------------------------------------------------------------- +# This is a set of regression tests for the tasub module. +# This module does the UB matrix algorithm as described by Mark Lumsden +# triple axis spectrometers. +# +# Mark Koennecke, November 2006 +#---------------------------------------------------------------------- +puts stdout "Testing Tasub" +#---------------------------------------------------------------------- +# testTasubCalculation tests the tasub calculation. The input is a list +# containg the cell constants and two lists denoting reflections. +# For each reflection the list must hold: +# 0 1 2 3 4 5 6 7 8 9 10 11 12 +# qh qk ql ei ef a1 a2 a3 a4 sgu sgl a5 a6 +# testTasubCalculation then inputs the cell and the reflections into +# tasub and calculates a UB from that. Then it tries to drive to the +# QE positions given for the reflections and checks if the angles are right +# It also checks QE positions in order to check if they have been properly +# updated. +# This then can be used with various inputs to check various configurations +# of the instrument. +#---------------------------------------------------------------------- +proc testTasubCalculation {cell ref1 ref2} { + if {[llength $cell] < 6} { + error "Not enough cell parameters" + } + if {[llength $ref1] < 13} { + error "Not enough parameters for reflection 1" + } + if {[llength $ref2] < 13} { + error "Not enough parameters for reflection 2" + } + checkSettingCell $cell + checkMakeUB $ref1 $ref2 + checkDrivingReflection $ref1 + checkDrivingReflection $ref2 +} +#------------------------------------------------------------------- +proc checkSettingCell {cell} { + config rights Mugger Mugger + append cmd "tasub cell " [join $cell] + testOK $cmd + set readback [string trim [SICSValue "tasub cell"]] + set l [split $readback] + for {set i 0} {$i < [llength $cell]} {incr i} { + set ori [lindex $cell $i] + set val [lindex $l $i] + if {abs($ori - $val) > .01} { + error "Bad cell readback, in $cell, back $readback" + } + } +} +#--------------------------------------------------------------------- +proc checkMakeUB {ref1 ref2} { + checkOK "tasub clear" + set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \ + [lindex $ref1 0] [lindex $ref1 1] [lindex $ref1 2] \ + [lindex $ref1 7] [lindex $ref1 8] [lindex $ref1 9] \ + [lindex $ref1 10] \ + [lindex $ref1 3] [lindex $ref1 4]] + eval $cmd + set cmd [format "tasub addref %f %f %f %f %f %f %f %f %f" \ + [lindex $ref2 0] [lindex $ref2 1] [lindex $ref2 2] \ + [lindex $ref2 7] [lindex $ref2 8] [lindex $ref2 9] \ + [lindex $ref2 10] \ + [lindex $ref2 3] [lindex $ref2 4]] + eval $cmd + set test [tasub makeub 1 2] + if {[string first ERROR $test] > 0} { + error "Problem calculating UB: $test" + } +} +#-------------------------------------------------------------------- +proc checkDrivingReflection {ref} { + set cmd [format "drive qh %f qk %f ql %f ei %f ef %f" \ + [lindex $ref 0] [lindex $ref 1] [lindex $ref 2] \ + [lindex $ref 3] [lindex $ref 4]] + set test [eval $cmd] + puts $cmd + if {[string first ERROR $test] >= 0} { + error "Failed to drive reflection: $test" + } + set a1 [SICSValue a1] + set a1soll [lindex $ref 5] + if {abs($a1soll - $a1) >.01} { + error "Bad a1 position, should $a1soll, is $a1" + } + set a1 [SICSValue a1] + set a1soll [lindex $ref 5] + if {abs($a1soll - $a1) >.01} { + error "Bad a1 position, should $a1soll, is $a1" + } + set a2 [SICSValue a2] + set a2soll [lindex $ref 6] + if {abs($a2soll - $a2) >.01} { + error "Bad a2 position, should $a2soll, is $a2" + } + set a3 [SICSValue a3] + set a3soll [lindex $ref 7] + if {abs($a3soll - $a3) >.01} { + error "Bad a3 position, should $a3soll, is $a3" + } + set a4 [SICSValue a4] + set a4soll [lindex $ref 8] + if {abs($a4soll - $a4) >.01} { + error "Bad a4 position, should $a4soll, is $a4" + } + set sgu [SICSValue sgu] + set sgusoll [lindex $ref 9] + if {abs($sgusoll - $sgu) >.01} { + error "Bad sgu position, should $sgusoll, is $sgu" + } + set sgl [SICSValue sgl] + set sglsoll [lindex $ref 10] + if {abs($sglsoll - $sgl) >.01} { + error "Bad sgl position, should $sglsoll, is $sgl" + } + set a5 [SICSValue a5] + set a5soll [lindex $ref 11] + if {abs($a5soll - $a5) >.01} { + error "Bad a5 position, should $a5soll, is $a5" + } + set a6 [SICSValue a6] + set a6soll [lindex $ref 12] + if {abs($a6soll - $a6) >.01} { + error "Bad a6 position, should $a6soll, is $a6" + } + + set qh [SICSValue qh] + set qhsoll [lindex $ref 0] + if {abs($qhsoll - $qh) >.01} { + error "Bad qh position, should $qhsoll, is $qh" + } + set qk [SICSValue qk] + set qksoll [lindex $ref 1] + if {abs($qksoll - $qk) >.01} { + error "Bad qk position, should $qksoll, is $qk" + } + set ql [SICSValue ql] + set qlsoll [lindex $ref 2] + if {abs($qlsoll - $ql) >.01} { + error "Bad ql position, should $qlsoll, is $ql" + } + + set ei [SICSValue ei] + set eisoll [lindex $ref 3] + if {abs($eisoll - $ei) >.01} { + error "Bad ei position, should $eisoll, is $ei" + } + set ef [SICSValue ef] + set efsoll [lindex $ref 4] + if {abs($efsoll - $ef) >.01} { + error "Bad ef position, should $efsoll, is $ef" + } +} +#===================== tests ========================================= +test tasub-1.0 {Test setting dd} -body { + testPar "tasub mono dd" 3.35461 Mugger + testPar "tasub ana dd" 3.35461 Mugger + return OK +} -result OK + +test tasub-1.1 {Test setting ss} -body { + testPar "tasub mono ss" 1 Mugger + testPar "tasub ana ss" 1 Mugger + return OK +} -result OK + +test tasub-1.2 {Test setting sample configuration} -body { + testPar "tasub const" kf Mugger + testPar "tasub ss" -1 Mugger + return OK +} -result OK + +test tasub-1.3 {Test clearing tasub} -body { + testOK "tasub clear" + return OK +} -result OK + +test tasub-1.4 {Test setting cell} -body { + checkSettingCell [list 7. 7. 7. 90. 90. 90.] + return OK +} -result OK + +tasub mono dd 3.35461 +tasub ana dd 3.35461 +tasub mono ss 1 +tasub ana ss 1 +tasub const kf +tasub ss -1 + +test tasub-1.5 {Basic calculation test} -body { + set ref1 [list 1 0 0 5 5 37.075 74.150 168.27 -23.46 0 0 37.075 74.15] + set ref2 [list 0 0 1 5 5 37.075 74.150 84.78 -10.44 0 0 37.075 74.15] + set cell [list 9.95 9.95 22.24 90 90 90] + testTasubCalculation $cell $ref1 $ref2 + return OK +} -result OK + + +test tasub-1.6 {Test driving ei} -body { + drive ei 5.0 + set eit [SICSValue ei] + set a1 [SICSValue a1] + set a2 [SICSValue a2] + if {abs(5 - $eit) > .001} { + error "Readback of ei failed" + } + if {abs(37.07 - $a1) > .01} { + error "Bad a1 value, is $a1, should 37.07" + } + if {abs(74.15 - $a2) > .01} { + error "Bad a2 value, is $a2, should 74.15" + } + return OK +} -result OK + +test tasub-1.7 {Test driving ef} -body { + drive ef 5. + set eit [SICSValue ef] + set a1 [SICSValue a5] + set a2 [SICSValue a6] + if {abs(5. - $eit) > .001} { + error "Readback of ei failed" + } + if {abs(37.07 - $a1) > .01} { + error "Bad a5 value, is $a1, should 37.07" + } + if {abs(74.15 - $a2) > .01} { + error "Bad a6 value, is $a2, should 74.15" + } + return OK +} -result OK + +test tasub-1.8 {Test reading en} -body { + drive ei 5. ef 3.7 + set en [SICSValue en] + if {abs($en - 1.3) > .01} { + error "Bad en value: should: 1.3, is $en" + } + return OK +} -result OK + +test tasub-1.9 {Test driving ef, different scattering sense} -body { + tasub ana ss -1 + drive ef 5.0 + set eit [SICSValue ef] + set a1 [SICSValue a5] + set a2 [SICSValue a6] + if {abs(5 - $eit) > .001} { + error "Readback of ef failed" + } + if {abs(-37.07 - $a1) > .01} { + error "Bad a5 value, is $a1, should -37.07" + } + if {abs(-74.15 - $a2) > .01} { + error "Bad a6 value, is $a2, should -74.15" + } + return OK +} -result OK + + + + + \ No newline at end of file diff --git a/test/testutil.tcl b/test/testutil.tcl new file mode 100644 index 00000000..c8b3d1c5 --- /dev/null +++ b/test/testutil.tcl @@ -0,0 +1,165 @@ +#------------------------------------------------------------------------------ +# utility routines for testing SICS +# +# copyright: see file COPYRIGHT +# +# Mark Koennecke, July 2006 +#------------------------------------------------------------------------------ +proc SICSValue {command} { + set txt [eval $command] + set l [split $txt =] + return [string trim [lindex $l 1]] +} +#----------------------------------------------------------------------------- +proc compareValue {is should} { + if {[string is double $is] == 1} { + if {abs($should - $is) > .01} { + error "Bad compare is: $is, should $should" + } + } else { + if {[string compare $is $should] != 0} { + error "Bad compare is: $is, should $should" + } + } + return OK +} +#------------------------------------------------------------------------------ +proc testPar {name testval priv } { + config rights Spy Spy + set value [SICSValue $name] + set res [eval $name $testval] + if {[string first ERROR $res] < 0} { + error "Managed to set parameter even if not allowed" + } + config rights $priv $priv + set res [eval $name $testval] + if {[string first ERROR $res] >= 0} { + error "Setting parameter failed with $res" + } + set readback [SICSValue $name] + compareValue $readback $testval + eval $name $value + return "OK" +} +#------------------------------------------------------------------------------- +proc testROPar {name val} { + config rights Mugger Mugger + set value [SICSValue $name] + compareValue $value $val + catch {$name [expr $val + 1]} msg + set value [SICSValue $name] + compareValue $value $val + config rights Spy Spy + return OK +} +#------------------------------------------------------------------------------ +proc testDrive {name value priv} { + config rights Spy Spy + set ans [eval drive $name $value] + if {[string first ERROR $ans] < 0} { + error "Protection on drivable does not work" + } + config rights $priv $priv + set ans [eval drive $name $value] + if { [string first sucessfully $ans] < 0} { + error "Driving $name failed: $ans" + } + set readback [SICSValue $name] + compareValue $readback $value + config rights Spy Spy + return OK +} +#------------------------------------------------------------------------------ +proc testDriveInterrupt {name value} { + global socke + config rights Mugger Mugger + run $name $value + puts $socke "INT1712 3" + flush $socke + set ans [eval status] + config rights Spy Spy + if {[string first Interrupt $ans] < 0} { + puts stdout $ans + error "Failed to abort driving" + } + if { [string first Eager $ans] < 0} { + error "Failed to finish driving" + } + return OK +} +#--------------------------------------------------------------------- +proc testNBCounting {startCommand waitTime} { + set res [$startCommand] + if {[string first ERROR $res] >= 0} { + error "Starting count failed with $res" + } + exec sleep 1 + set res [SICSValue status] + if {[string first "Count" $res] < 0} { + error "Status does not say counting" + } + exec sleep $waitTime + set res [SICSValue status] + if {[string first "Eager" $res] < 0} { + error "Counting did not stop" + } + return "OK" +} +#---------------------------------------------------------------- +proc testBlockCounting {startCommand waitTime} { + set res [$startCommand] + if {[string first ERROR $res] >= 0} { + error "Starting count failed with $res" + } + exec sleep $waitTime + set res [SICSValue status] + if {[string first "Eager" $res] < 0} { + error "Counting did not stop" + } + return "OK" +} +#--------------------------------------------------------------- +proc testInterruptedCount {startCommand} { + global socke + set res [$startCommand] + if {[string first ERROR $res] >= 0} { + error "Starting count failed with $res" + } + puts $socke "INT1712 3" + flush $socke + exec sleep 10 + set ans [eval status] + config rights Spy Spy + if {[string first Interrupt $ans] < 0} { + puts stdout $ans + error "Failed to abort counting" + } + if { [string first Eager $ans] < 0} { + error "Failed to finish counting" + } + return OK +} +#------------------------------------------------------------------------ +proc testOK {command} { + set test [eval $command] + if {[string first OK $test] < 0} { + error [format "Expected OK, got %s" $test] + } + return OK +} +#------------------------------------------------------------------------ +proc testNoError {command} { + set test [eval $command] + if {[string first ERROR $test] >= 0} { + error [format "Located Error: %s" $test] + } + return OK +} +#------------------------------------------------------------------------ +proc testCommand {command response} { + set result [eval $command] + if {[string first $response $result] < 0} { + error "Expected $response, received $result" + } + return OK +} diff --git a/tmp/hdbscan.tcl b/tmp/hdbscan.tcl new file mode 100644 index 00000000..aadb0277 --- /dev/null +++ b/tmp/hdbscan.tcl @@ -0,0 +1,9 @@ +hset /commands/scan/scan_variables som +hset /commands/scan/scan_start 5 +hset /commands/scan/scan_increments .5 +hset /commands/scan/NP 10 +hset /commands/scan/mode Timer +hset /commands/scan/preset 2 + + + diff --git a/velo.c b/velo.c index 3f8c260c..75c9465d 100644 --- a/velo.c +++ b/velo.c @@ -326,6 +326,7 @@ static void VSListForbidden(pVelSel self, SConnection *pCon){ pVelSel VSCreate(pMotor pTilt, pVelSelDriv pDriv) { pVelSel pNew = NULL; + SConnection *pCon = NULL; assert(pTilt); assert(pDriv); @@ -389,7 +390,12 @@ static void VSListForbidden(pVelSel self, SConnection *pCon){ /* deal with that motor, have him AccessCode Internal */ pNew->pTilt = pTilt; - ObParInit(pTilt->ParArray,8,"accesscode",(float)usInternal,usInternal); + pCon = SCCreateDummyConnection(pServ->pSics); + if(pCon != NULL) + { + MotorSetPar(pTilt,pCon,"accesscode",(float)usInternal); + SCDeleteConnection(pCon); + } /* enter driver */ pNew->pDriv = pDriv;