- Fixed a bug which caused the SICServer to die when a socket was broken.

- Fixed many things in DIFRAC subsystem:
  * Recoded tcentr.f etc so that the course centering will work and will not
    go into an endless loop.
  * fixed boundary overwrites which occurred when yesno or alfnum where
    uset to get a single character and several were given.
  * Addeded documentation for DIFRAC
- Added tcl-files which  support the WWW status system

commandlog.c

@@ -59,6 +59,14 @@
          return;
       }
       
+      /* suppress TRANSACTIONFINISHED as well in order to make the WWW
+         commandlog work
+      */
+      if(strstr(pText,"TRANSACTIONFINISHED") != NULL)
+      {
+         return;
+      }
+
       /* create tail buffer as needed */
       if(!pTail)
       {

conman.c

@@ -367,6 +367,21 @@ extern pServer pServ;
        return;
      }
     
+     if(pVictim->inUse  > 0)
+     {
+       SCnoSock(pVictim);
+       if(pVictim->pSock)
+       {
+         NETClosePort(pVictim->pSock);
+         free(pVictim->pSock);
+         pVictim->pSock = NULL;
+       } 
+       WriteToCommandLog("SYS> ",
+              "ERROR: Erraneous deletion of used Connection stopped");
+       return;
+     }
+     
+     
      /* remove the connection from the server log if it has captured
         something
      */
@@ -471,6 +486,7 @@ extern pServer pServ;
   {
      char *pStart = NULL, *pPtr;
      int iCount, iState;
+     int iRet = 1;
      
      pStart = pBuffer;
      pPtr = pStart;
@@ -484,8 +500,8 @@ extern pServer pServ;
                    if( (*pPtr == '\r') || (*pPtr == '\n') )
                    {
                       iState = LF;
-                      NETWrite(pSock,pStart,iCount);        
+                      iRet = NETWrite(pSock,pStart,iCount);        
-                      NETWrite(pSock,"\r\n",2);
+                      iRet = NETWrite(pSock,"\r\n",2);
                       iCount = 0;
                    } 
                    else
@@ -510,10 +526,10 @@ extern pServer pServ;
      }
      if(iCount > 0)
      {
-         NETWrite(pSock,pStart,iCount);        
+         iRet = NETWrite(pSock,pStart,iCount);        
-         NETWrite(pSock,"\r\n",2);
+         iRet = NETWrite(pSock,"\r\n",2);
      }
-     return 1;
+     return iRet;
   }  
 /*-------------------------------------------------------------------------*/
   int SCWrite(SConnection *self, char *pBuffer, int iOut)
@@ -566,7 +582,7 @@ extern pServer pServ;
          {
            if(self->iTelnet)
            {
-             TelnetWrite(self->pSock,buffer);
+             iRet = TelnetWrite(self->pSock,buffer);
            }
            else
            {
@@ -576,6 +592,11 @@ extern pServer pServ;
                iRet = NETWrite(self->pSock,"\n",sizeof("\n"));
              }  
            }
+           if(!iRet)
+           {
+              SCnoSock(self);
+              WriteToCommandLog("SYS> ","Connection broken on send");
+           }
          }
          else
          {
@@ -594,7 +615,7 @@ extern pServer pServ;
        {
          if(self->iTelnet)
          {
-           TelnetWrite(self->pSock,buffer);
+           iRet = TelnetWrite(self->pSock,buffer);
          }
          else
          {
@@ -605,7 +626,10 @@ extern pServer pServ;
            }  
          }
          if(!iRet)
-           return 0;
+         {
+           SCnoSock(self);
+           WriteToCommandLog("SYS> ","Send broken to connection");
+         }
        }
        else
        {
@@ -863,6 +887,7 @@ extern pServer pServ;
         
         int iRet, i;
         char *pPtr = NULL;
+        char pFrom[50];
         Status eOld;
 
         if(!VerifyConnection(pCon))
@@ -890,6 +915,8 @@ extern pServer pServ;
              SetStatus(eOld);
              CostaLock(pCon->pStack);
              strncpy(pResult,pPtr,iLen);
+             sprintf(pFrom,"Prompted from sock %2.2d: ", pCon->pSock->sockid);
+             WriteToCommandLog(pFrom,pPtr);
              return 1;
           }
         }
@@ -1361,9 +1388,16 @@ extern pServer pServ;
       }
       
       if(self->iEnd)  
+      {
+        if(self->inUse != 0)
+        {
+          return 1;
+        }
+        else
         {   
           return 0;
         }
+      }
 
 
       /* pop and execute */
@@ -1380,9 +1414,16 @@ extern pServer pServ;
         }
       }  
       if(self->iEnd)  
+      {
+        if(self->inUse != 0)
+        {
+          return 1;
+        }
+        else
         {   
           return 0;
         }
+      }
       
       return 1;
    }

danu.dat

@@ -1,3 +1,3 @@
- 5378 
+ 5424 
 NEVER, EVER modify or delete this file
 You'll risk eternal damnation and a reincarnation as a cockroach!|n

devexec.c

@@ -386,6 +386,11 @@
                         DeleteDevEntry(pDev);
                         LLDnodeDelete(self->iList);
                         iRet = LLDnodePtr2Prev(self->iList);
+                        if(SCGetInterrupt(self->pOwner) != eContinue)
+                        {
+                           self->iStatus = DEVINT;
+                           return -1;
+                        }   
                         self->iStatus = DEVDONE;
                         break;
            case HWFault: /* real HW error: burning, no net etc.. */
@@ -400,7 +405,6 @@
                         if(SCGetInterrupt(self->pOwner) != eContinue)
                         {
                            self->iStatus = DEVINT;
-                           StopExe(self,"all");
                            return -1;
                         }   
                         break;             
@@ -443,7 +447,6 @@
                         if(SCGetInterrupt(self->pOwner) != eContinue)
                         {
                            self->iStatus = DEVINT;
-                           StopExe(self,"all");
                            return -1;
                         }   
                         break;
@@ -907,7 +910,8 @@
          {
             if(self->pOwner)
             {
-              SCWrite(self->pOwner,"ERROR: Interrupting Current Hardware Operation",
+              SCWrite(self->pOwner,
+                      "ERROR: Interrupting Current Hardware Operation",
                       eError); 
               SCSetInterrupt(self->pOwner,*iInt);        
             }

difrac/Makefile

@@ -3,7 +3,7 @@
 #
 # Mark Koennecke, November 1999
 #----------------------------------------------------------------------------
-CFLAGS = -g -c 
+CFLAGS = -C -g -c 
 FL     = f77 $(CFLAGS)
 ROOT   = ..
 LIBS   = $(ROOT)\libs

difrac/align.f

@@ -474,7 +474,7 @@ C-----------------------------------------------------------------------
       SUBROUTINE ALEDIT (NTOT)
       INCLUDE 'COMDIF'
       DIMENSION NDEL(100)
-      CHARACTER IOPT*1
+      CHARACTER IOPT*1,LINE*80
 C-----------------------------------------------------------------------
 C  Read in the existing list of h,k,l values and write it to terminal
 C-----------------------------------------------------------------------
@@ -504,7 +504,8 @@ C-----------------------------------------------------------------------
 C  Get the edit option IOPT
 C-----------------------------------------------------------------------
       WRITE (COUT,13000)
-      CALL ALFNUM (IOPT)
+      CALL ALFNUM (LINE)
+      IOPT = LINE(1:1)
       IF (IOPT .EQ. ' ') IOPT = 'U'
 C-----------------------------------------------------------------------
 C  Option E. Exit from AL with 0 reflns
@@ -519,7 +520,8 @@ C-----------------------------------------------------------------------
       IF (IOPT .EQ. 'U') THEN
         ITRUE = 0
         WRITE (COUT,14100)
-        CALL YESNO ('N',ANS)
+        CALL YESNO ('N',LINE)
+        ANS = LINE(1:1)
         IF (ANS .EQ. 'Y') ITRUE = 1
         RETURN
       ENDIF
@@ -530,7 +532,8 @@ C-----------------------------------------------------------------------
         IF (IOPT .EQ. 'N') NTOT = 0
         ISYMOR = 0
         WRITE (COUT,14000)
-        CALL YESNO ('Y',ANS)
+        CALL YESNO ('Y',LINE)
+        ANS = LINE(1:1)
         IF (ANS .EQ. 'Y') THEN
           ISYMOR = 1
           IOUT = -1

difrac/blind.f

@@ -576,7 +576,7 @@ C EDLIST  Edit the reflection list
 C--------------------------------------------------------------------
       SUBROUTINE EDLIST
       INCLUDE 'COMDIF'
-      CHARACTER FLAG*1,REFNAM*40
+      CHARACTER FLAG*1,REFNAM*40,LINE*80
       DIMENSION THETAS(NSIZE),
      $          OMEGAS(NSIZE),CHIS(NSIZE),PHIS(NSIZE),ICNTS(NSIZE)
       EQUIVALENCE (ACOUNT(        1),THETAS(1)),
@@ -596,7 +596,8 @@ C--------------------------------------------------------------------
    90 WRITE (COUT,11000)
       CALL GWRITE (ITP,' ')
   100 WRITE (COUT,12000)
-      CALL ALFNUM (ANS)
+      CALL ALFNUM (LINE)
+      ANS = LINE(1:1)
       IF (ANS .NE. 'L' .AND. ANS .NE. 'D' .AND. ANS .NE. 'R' .AND.
      $    ANS .NE. 'A' .AND. ANS .NE. 'F' .AND. ANS .NE. 'E') 
      $    GO TO 90

difrac/cfind.f

@@ -1,24 +1,31 @@
 C-----------------------------------------------------------------------
 C  Subroutine to find the coarse centre for Chi
 C-----------------------------------------------------------------------
-      SUBROUTINE CFIND (TIM)
+      SUBROUTINE CFIND (TIM,MAXCOUNT)
       INCLUDE 'COMDIF'
+      REAL MAXCOUNT, MCOUNT
       DIMENSION TCOUNT(NSIZE)
       EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
       ICPSMX = 25000
       STEPM  = 0.02
       SENSE  = -1.0
-      CSTEP  = 0.25
+      CSTEP  = 1.5
       NPTS   = 10
-      CHI = CHI + NPTS*CSTEP/2
+      NRUN = 0
   100 IF (CHI .LT.   0) CHI = CHI + 360
       IF (CHI .GE. 360) CHI = CHI - 360
+      CHI = CHI + NPTS*CSTEP/2
       CHISV = CHI
   110 CALL ANGSET (THETA,OMEGA,CHISV,PHI,NATT,ICOL)
       ICOUNT = 0
       MCOUNT = 0
       DO 120 I = 1,NPTS
         CALL CCTIME (TIM,TCOUNT(I))
+        CALL KORQ (IFLAG1)
+        IF (IFLAG1 .NE. 1) THEN
+          KI = 'O4'
+          RETURN
+        ENDIF
         IF (TCOUNT(I)/TIM .GT. ICPSMX .AND. NATT .LT. NATTEN) THEN
           NATT = NATT + 1
           GO TO 110
@@ -32,25 +39,25 @@ C-----------------------------------------------------------------------
         IF (CHI .GE. 360) CHI = CHI - 360
         CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
   120 CONTINUE
+      MAXCOUNT = REAL(MCOUNT)
       IF (ICOUNT .EQ. 1) THEN
+C
+C try the other direction, but only once otherwise we get into an 
+C endless loop
+C
+        IF(NRUN .GT. 0) THEN
+           MAXCOUNT = 0.
+           RETURN
+        ENDIF
         SENSE = -SENSE
-        CHI = CHI + 9*SENSE*CSTEP
+        CHI = CHISV + 9*SENSE*CSTEP
+        NRUN = NRUN + 1
         GO TO 100
-      ELSE IF (ICOUNT .EQ. 10) THEN
+      ELSE IF (ICOUNT .EQ. 20) THEN
-        CHI = CHI - 3*SENSE*CSTEP
+        CHI = CHISV - 3*SENSE*CSTEP
         GO TO 100
       ENDIF
-      CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP
+C      CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP
-      IF(TCOUNT(ICOUNT) .GT. 0)THEN
+      CHI = CHISV + ICOUNT*SENSE*CSTEP
-         TIM = 500.*TIM/TCOUNT(ICOUNT)
-      ELSE
-         TIM = 500 * TIM
-      ENDIF
-      IF (TIM .LT. 10000.0) THEN
-        IF (TIM .LT. 1000.) TIM =1000. 
-        CSTEP = CSTEP/4
-        IF (CSTEP .GT. STEPM) GO TO 100
-      ENDIF
-      CHI = CHI + 5*SENSE*CSTEP
       RETURN
       END

difrac/cinput.f

@@ -5,7 +5,7 @@ C-----------------------------------------------------------------------
       INCLUDE 'COMDIF'
       DIMENSION A(3),ALP(3),SYS(7),TRANS(3,3,7),AA(3,3),PRIM(3),
      $          ANPRIM(3),TRANSF(3,3),H(3,3)
-      CHARACTER CATMOD*1,SYS*1
+      CHARACTER CATMOD*1,SYS*1,LINE*80
       DATA SYS/'P','A','B','C','I','F','R'/
       DATA TRANS/ 1, 0, 0,   0, 1, 0,   0, 0, 1,   1, 0, 0,   0,.5,.5,
      $            0, 0, 1,  .5, 0,.5,   0, 1, 0,   0, 0, 1,  .5,.5, 0,
@@ -20,7 +20,8 @@ C-----------------------------------------------------------------------
         ALP(I) = RADEG*ATAN2(SANG(I),CANG(I))
   100 CONTINUE
   110 WRITE (COUT,10000)
-      CALL ALFNUM (CATMOD)
+      CALL ALFNUM (LINE)
+      CATMOD = LINE(1:1)
       IF (CATMOD .EQ. ' ') CATMOD = 'P'
       READ (CATMOD,11000) ATMOD
       WRITE (COUT,12000) A,ALP,CATMOD

difrac/difint.f

@@ -12,6 +12,7 @@ C-----------------------------------------------------------------------
       SUBROUTINE DIFINT(COMMAND, LEN)
       INTEGER COMMAND(256), LEN
       INCLUDE 'COMDIF'
+      CHARACTER STRING*80
 
       KI(1:1) = CHAR(COMMAND(1))
       KI(2:2) = CHAR(COMMAND(2))
@@ -83,7 +84,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 2) THEN
@@ -91,7 +93,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 3) THEN
@@ -99,7 +102,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 4) THEN
@@ -107,7 +111,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 5) THEN
@@ -115,7 +120,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 6) THEN
@@ -125,7 +131,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN
@@ -133,7 +140,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
         ENDIF

difrac/mesint.f

@@ -26,7 +26,10 @@ C-----------------------------------------------------------------------
       IWARN = 0
       ISIGN = 1
       IF (THETA .LT. 0.0 .OR. THETA .GT. 180.0) ISIGN = -1
-      D12 = BS*ABS(TAN(0.5*THETA/DEG))
+C---- Modified MK: there is no alpha1 alpha2 separation with neutrons
+C      D12 = BS*ABS(TAN(0.5*THETA/DEG))
+      D12 = 0.
+C---- end of modification
       TTIME = 0.20*PRESET
   110 CALL SHUTTR (1)
       IF (NATTEN .GT. 0) THEN

difrac/pfind.f

@@ -1,8 +1,9 @@
 C-----------------------------------------------------------------------
 C  Get the coarse value of Phi for PCENTR
 C-----------------------------------------------------------------------
-      SUBROUTINE PFIND (TIM)
+      SUBROUTINE PFIND (TIM,MAXCOUNT)
       INCLUDE 'COMDIF'
+      REAL MAXCOUNT, MCOUNT
       DIMENSION PCOUNT(NSIZE)
       EQUIVALENCE (ACOUNT(9*NSIZE + 1), PCOUNT(1))
 C-----------------------------------------------------------------------
@@ -30,6 +31,11 @@ C-----------------------------------------------------------------------
       MCOUNT = 0
       DO 110 I = 1,NPTS
         CALL CCTIME (TIM,PCOUNT(I))
+        CALL KORQ (IFLAG1)
+        IF (IFLAG1 .NE. 1) THEN
+          KI = 'O4'
+          RETURN
+        ENDIF
         IF (PCOUNT(I) .GT. MCOUNT) THEN
           MCOUNT = PCOUNT(I)
           ICOUNT = I
@@ -39,16 +45,11 @@ C-----------------------------------------------------------------------
         IF (PHI .GE. 360.0) PHI = PHI - 360.0
         CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
   110 CONTINUE
+      MAXCOUNT = REAL(MCOUNT)
       IF (ICOUNT .EQ. 1 .OR. ICOUNT .EQ. NPTS) THEN
-         TIM = 5.0
+         TIM = -5.0
          RETURN 
       ENDIF
       PHI = PHIOFF + (ICOUNT - 1)*PSTEP
-      TIM = 500.0*TIM/PCOUNT(ICOUNT)
-      IF (TIM .LT. 10000.0) THEN
-        IF (TIM .LT. 1000.) TIM = 1000.
-        PSTEP = PSTEP/4
-        IF (PSTEP .GT. STEPM) GO TO 100
-      ENDIF
       RETURN
       END

difrac/prnbas.f

@@ -6,7 +6,8 @@ C-----------------------------------------------------------------------
       DIMENSION RW(3,3),ANG(3)
       CHARACTER CPROF*4,STRING*10
       WRITE (COUT,10000)
-      CALL ALFNUM (ANS)
+      CALL ALFNUM (STRING)
+      ANS = STRING(1:1)
       KZ = -1
       IF (ANS .EQ. ' ' .OR. ANS .EQ. '0') KZ = 0
       IF (ANS .EQ. '1') KZ = 1
@@ -115,7 +116,8 @@ C-----------------------------------------------------------------------
 C  Pause to allow users to read the screen
 C-----------------------------------------------------------------------
       WRITE (COUT,20000)
-      CALL ALFNUM (ANS)
+      CALL ALFNUM (STRING)
+      ANS = STRING(1:1)
 C-----------------------------------------------------------------------
 C  Theta min/max and h,k,l max data
 C-----------------------------------------------------------------------

difrac/profil.f

@@ -183,8 +183,10 @@ C  The profile is suitable for analysis to find the limits
 C  J1 is the beginning of the low angle search
 C  J2 is the beginning of the high angle search
 C-----------------------------------------------------------------------
-      J1 = MAXI - STEPOF*CON*AS - A2*ID12
+C      J1 = MAXI - STEPOF*CON*AS - A2*ID12
-      J2 = MAXI + STEPOF*CON*CS + A1*ID12
+C      J2 = MAXI + STEPOF*CON*CS + A1*ID12
+      J1 = MAXI - ((STEPOF*AS)/STEP) - A2*ID12
+      J2 = MAXI + ((STEPOF*CS)/STEP) + A1*ID12
       IF (J1 .LE. NWIND .OR. J2 .GE. NP-NWIND) THEN
         ILOW = 1
         IHIGH = NP
@@ -255,6 +257,9 @@ C-----------------------------------------------------------------------
         DO 220 I = 1,ILOW-1
           B1 = B1 + ACOUNT(I)
   220   CONTINUE
+C---mk
+      B1 = B1/ILOW
+C---      
       ENDIF
       FRAC1 = (FRAC*NP + ILOW - 1)/NPK
       PEAK = 0.0
@@ -266,9 +271,12 @@ C-----------------------------------------------------------------------
         DO 230 I = IHIGH+1,NP
           B2 = B2 + ACOUNT(I)
   230   CONTINUE
+      IDIV = NP - IHIGH
+      IF(IDIV .LE. 0)IDIV =1
+      B2 = B2/IDIV
       ENDIF
       FRAC2 = (FRAC*NP + NP - IHIGH)/NPK
-      BTOT = 0.5*(B1/FRAC1 + B2/FRAC2)
+      BTOT = 0.5*(B1/FRAC1 + B2/FRAC2)*NP
       TOP1 = PEAK - BTOT
       BOT1 = SQRT(PEAK + 0.25*(B1/(FRAC1*FRAC1) + B2/(FRAC2*FRAC2)))
       FRAC1 = 0.5*(FRAC1 + FRAC2)

difrac/rcpcor.f

@@ -8,6 +8,7 @@ C-----------------------------------------------------------------------
       SUBROUTINE RCPCOR
       INCLUDE 'COMDIF'
       DIMENSION RM1(3,3),XA(3),HA(3)
+      CHARACTER STRING*80
       IF (KI .EQ. 'AH') THEN
         WRITE (COUT,10000)
         CALL GWRITE (ITP,' ')
@@ -59,6 +60,7 @@ C  in the equator plane and normal to the microscope viewing direction
 C  at the Kappa angles -45, 78, kappa (-60 start), phi (0 start)
 C-----------------------------------------------------------------------
       SUBROUTINE FACEIN
+      CHARACTER STRING*80 
       INCLUDE 'COMDIF'
       DATA ISENSE/-1/
       NATT = 0
@@ -79,7 +81,8 @@ C-----------------------------------------------------------------------
 C  Get the adjusted angles and transform them
 C-----------------------------------------------------------------------
   100 WRITE (COUT,11000)
-      CALL ALFNUM (ANS)
+      CALL ALFNUM (STRING)
+      ANS = STRING(1:1)
 C      write (cout,99990)
 C99990 format (' Type omk, kap, phk for face ',$)
 C      call freefm (itr)

difrac/setop.f

@@ -11,8 +11,10 @@ C
 C-----------------------------------------------------------------------
       SUBROUTINE SETOP
       INCLUDE 'COMDIF'
+      CHARACTER STRING*80
   100 WRITE (COUT,10000)
-      CALL ALFNUM (KI)
+      CALL ALFNUM (STRING)
+      KI = STRING(1:2)
       IF (KI .EQ. 'Q') THEN
          CALL WNEND
          STOP
@@ -74,7 +76,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 2) THEN
@@ -82,7 +85,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 3) THEN
@@ -90,7 +94,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 4) THEN
@@ -98,7 +103,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 5) THEN
@@ -106,7 +112,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (I .EQ. 0 .OR. I .EQ. 6) THEN
@@ -116,7 +123,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
           IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN
@@ -124,7 +132,8 @@ C-----------------------------------------------------------------------
             CALL GWRITE (ITP,' ')
             IF (I .EQ. 0) THEN
               WRITE (COUT,14000)
-              CALL ALFNUM (ANS)
+              CALL ALFNUM (STRING)
+              ANS = STRING(1:1)
             ENDIF
           ENDIF
         ENDIF

difrac/tcentr.f

@@ -16,6 +16,7 @@ C-----------------------------------------------------------------------
      $            (ACOUNT(6*NSIZE+1),OMEGP(1)),
      $            (ACOUNT(7*NSIZE+1),CHIP(1)),
      $            (ACOUNT(8*NSIZE+1),PHIP(1))
+      REAL CURCTS,MAXCTS
       WIDTH = 1.25
 C-----------------------------------------------------------------------
 C  Read the peaks from disk
@@ -60,85 +61,57 @@ C  Set the angles at the approximate position of the peak and adjust
 C  Phi, Chi and 2Theta to get maximum intensity in the detector.
 C  Sietronics interface works via MAXPOINT; CAD4 via CADCEN
 C-----------------------------------------------------------------------
+C CAD-4 and Sietronics deleted for clarity: Mark Koennecke
         CALL SHUTTR (99)
-        ITIMS(J) = 0
-        IF (DFMODL .EQ. 'CAD4') THEN
-          KI = 'SP'
-          CALL CADCEN (0)
-          IF (KI .EQ. 'FF') THEN
-            WHICH = 'Phi'
-            WRITE (COUT,13000) WHICH
-            CALL GWRITE (ITP,' ')
-            WRITE (LPT,13000) WHICH
-            GO TO 200
-          ENDIF
-  110     CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
-          KI = 'ST'
-          IGOOD = 0
-          CALL CADCEN (IGOOD)
-C       write (lpt,99993) ki,igood
-C99993 format (' KI,igood ',a,i4)
-          IF (KI .EQ. 'FF' .OR. KI .EQ. 'TO' .OR. KI .EQ. 'BO') THEN
-            CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,IERR)
-            KI = 'SC'
-            RTIM = PRESET
-            CALL CFIND (RTIM)
-            CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
-            IF (RTIM .GT. 3.0) THEN
-              WHICH = 'Chi'
-              WRITE (COUT,13000) WHICH
-              CALL GWRITE (ITP,' ')
-              WRITE (LPT,13000) WHICH
-              GO TO 200
-            ENDIF
-            KI = 'SO'
-            IGOOD = 0
-            CALL CADCEN (IGOOD)
-            IF (KI .EQ. 'FF') THEN
-              WHICH = 'Omega'
-              WRITE (COUT,13000) WHICH
-              CALL GWRITE (ITP,' ')
-              WRITE (LPT,13000) WHICH
-              GO TO 200
-            ENDIF
-            GO TO 110
-          ENDIF
-          IF (IGOOD .NE. 0) GO TO 110
-C-----------------------------------------------------------------------
-C  Sietronics 145D centring
-C-----------------------------------------------------------------------
-        ELSE IF (DFMODL .EQ. '145D') THEN
-          PWIDTH = 2*WIDTH
-          CALL MAXPOINT (3,PWIDTH,0.1,RMAXPT)
-          PHI = RMAXPT
-          CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
-          CWIDTH = 4*WIDTH
-          CALL MAXPOINT (2,CWIDTH,0.1,RMAXPT)
-          CHI = RMAXPT
-          OMEGA = OMEGA - 0.5*TWIDTH
-          CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
-          TWIDTH = WIDTH
-          CALL MAXPOINT (4,TWIDTH,0.1,RMAXPT)
-          THETA = RMAXPT
 C-----------------------------------------------------------------------
 C  All other machines for the moment
+C  Modified: Mark Koennecke for TRICS
+C  Do initial search. But use the results of the searches
+C  only if they improved the countrate.
 C-----------------------------------------------------------------------
-        ELSE
+          CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
-          RTIM = 1000.
+          CALL CCTIME (PRESET,CURCTS)
-          CALL PFIND (RTIM)
+C----- first two theta          
+          RTIM = PRESET
+          CALL TFIND(RTIM,MAXCTS)
+          IF(MAXCTS .LT. CURCTS) THEN
             THETA = RTHETA
             OMEGA    = ROMEGA
-          IF (RTIM .GT. 10000.0) GO TO 200
+          ELSE
-C          IF (RTIM .GT. 1.0) RTIM = 1.0
+            CURCTS = MAXCTS
-          CHI = RCHI + 1.25
-          CALL CFIND (RTIM)
-          THETA = RTHETA + 1.25
-          OMEGA = OMEGA  - 0.625
-          IF (RTIM .GT. 10000.0) GO TO 200
-C          IF (RTIM .GT. 1.0) RTIM = 1.0
-          CALL TFIND (RTIM)
-          IF (RTIM .GT. 10000.0) GO TO 200
           ENDIF
+          CALL KORQ (IFLAG1)
+          IF (IFLAG1 .NE. 1) THEN
+            KI = 'O4'
+            RETURN
+          ENDIF
+C----- now phi
+          RTIM = PRESET
+          CALL PFIND(RTIM,MAXCTS)
+          IF(MAXCTS .LT. CURCTS) THEN
+            PHI = RPHI
+          ELSE
+            CURCTS = MAXCTS
+          ENDIF
+          CALL KORQ (IFLAG1)
+          IF (IFLAG1 .NE. 1) THEN
+            KI = 'O4'
+            RETURN
+          ENDIF
+C------ finally phi
+          RTIM = PRESET
+          CALL CFIND(RTIM,MAXCTS)
+          IF(MAXCTS .LT. CURCTS) THEN
+           CHI  = RCHI
+          ELSE
+            CURCTS = MAXCTS
+          ENDIF
+          CALL KORQ (IFLAG1)
+          IF (IFLAG1 .NE. 1) THEN
+            KI = 'O4'
+            RETURN
+          ENDIF
+C------- end of pre centering
         WRITE (COUT,11000) THETA,OMEGA,CHI,PHI
         CALL GWRITE (ITP,' ')
         WRITE (LPT,11000) THETA,OMEGA,CHI,PHI

difrac/tfind.f

@@ -1,8 +1,9 @@
 C-----------------------------------------------------------------------
 C  Find the Coarse setting for 2-Theta
 C-----------------------------------------------------------------------
-      SUBROUTINE TFIND (TIM)
+      SUBROUTINE TFIND (TIM, MAXCOUNT)
       INCLUDE 'COMDIF'
+      REAL MAXCOUNT, MCOUNT
       DIMENSION TCOUNT(NSIZE)
       EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
       STEPM = 0.01
@@ -10,6 +11,7 @@ C-----------------------------------------------------------------------
       TSTEP = 0.25
       NATT = 0
       NPTS = 10
+      NRUN = 0
 100   THEOFF = THETA
       OMEOFF = OMEGA
       CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@@ -17,6 +19,11 @@ C-----------------------------------------------------------------------
       MCOUNT = 0
       DO 110 I = 1,NPTS
         CALL CCTIME (TIM,TCOUNT(I))
+        CALL KORQ (IFLAG1)
+        IF (IFLAG1 .NE. 1) THEN
+          KI = 'O4'
+          RETURN
+        ENDIF
         IF (TCOUNT(I) .GT. MCOUNT) THEN
           MCOUNT = TCOUNT(I)
           ICOUNT = I
@@ -25,10 +32,20 @@ C-----------------------------------------------------------------------
         OMEGA = OMEGA - SENSE*TSTEP*0.5
         CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
   110 CONTINUE
+      MAXCOUNT = MCOUNT
       IF (ICOUNT .EQ. 1) THEN
+C 
+C try, the other direction. But only once as checked by NRUN
+C otherwise we end in an endless loop.
+C
+        IF (NRUN .GT. 0) THEN
+           MAXCOUNT = 0.
+           RETURN
+        ENDIF
         SENSE = -SENSE
         THETA = THEOFF + 9.0*SENSE*TSTEP
         OMEGA = OMEOFF - 9.0*SENSE*TSTEP/2
+        NRUN = NRUN + 1
         GO TO 100
       ENDIF
       IF (ICOUNT .EQ. 10) THEN
@@ -36,14 +53,6 @@ C-----------------------------------------------------------------------
         OMEGA = OMEOFF + 3.0*SENSE*TSTEP/2
         GO TO 100
       ENDIF
-      THETA = THEOFF +     (ICOUNT - 2.25)*SENSE*TSTEP
-      OMEGA = OMEOFF - 0.5*(ICOUNT - 2.25)*SENSE*TSTEP
-      TIM = 500.0*TIM/TCOUNT(ICOUNT)
-      IF (TIM .LT. 10000.0) THEN
-        IF (TIM .LT. 1000.) TIM = 1000.
-        TSTEP = TSTEP/4.0
-        IF (TSTEP .GT. STEPM) GO TO 100
-      ENDIF
       THETA = THEOFF + ICOUNT*SENSE*TSTEP
       OMEGA = OMEOFF - ICOUNT*SENSE*TSTEP/2
       RETURN

difrac/yesno.f

@@ -18,14 +18,15 @@ C-----------------------------------------------------------------------
       COMMON /IOUASS/ IOUNIT(12)
       CHARACTER*132 COUT(20)
       COMMON /IOUASC/ COUT
-      CHARACTER DEFOLT*1,ANS*1
+      CHARACTER DEFOLT*1,ANS*1,LINE*80
       ITR = IOUNIT(5)
       ITP = IOUNIT(6)
 C-----------------------------------------------------------------------
 C  This code gets round IBM VM/CMS limitations
 C-----------------------------------------------------------------------
   100 CALL GWRITE (ITP,'$')
-      CALL GETLIN (ANS)
+      CALL GETLIN (LINE)
+      ANS=LINE(1:1)
       IF (ANS .EQ. '?') STOP
       IF (ANS .EQ. 'y') ANS = 'Y'
       IF (ANS .EQ. 'n') ANS = 'N'

doc/user/tricsingle.htm

@@ -14,14 +14,20 @@ to be solved are:
 <li>Measure a couple of reflections.
 <li>Furthermore there are some specialities.
 </ul> 
-There are two ways to achieve all this: The older way uses some built in SICS functionality plus some external prograsm inherited from the ILL. This is called the ILL operation. Then a complete four circle packaage called DIFRAC from P. White and Eric Gabe was integrated into SICS. Thsi is The Difrac way of operation.
+There are two ways to achieve all this: 
+The older way uses some built in SICS functionality plus some external
+programs inherited from the ILL. This is called the ILL operation. 
+Then a complete 
+four circle package called DIFRAC from P. White and Eric Gabe was 
+integrated into SICS.
+This is The Difrac way of operation.
 </p>
 <h2>DIFRAC</h2>
 <p>
 The DIFRAC commands are accessed by prepending the difrac commands
 with <b>dif</b>. For example: "dif td" calls the difrac td
 command. For more information on DIFRAC commands see the separate
-DIFRAC manual.
+<a href="diftrics.htm">DIFRAC manual</a>.
 </p> 
 
 <h2>ILL operation</h2>

drive.c

@@ -51,7 +51,7 @@
 #include "splitter.h"
 #include "status.h"
 #include "devexec.h"
-
+#include "motor.h"
 
 /*---------------------------------------------------------------------------*/
   int Drive(SConnection *pCon, SicsInterp *pInter, char *name, float fNew)
@@ -250,6 +250,27 @@
     pObjectDescriptor pDes = NULL;
     pIDrivable pInt = NULL;
     Dummy *pDum = NULL;
+    pMotor pMot = NULL;
+    float fPos;
+    int iRet;
+
+    /* 
+      treat motors separatetly in order to correct for zero points
+      Sighh.........
+    */
+    pMot = FindMotor(pSics,name);
+    if(pMot != NULL)
+    {
+       iRet = MotorGetSoftPosition(pMot,pCon,&fPos);
+       if(iRet)
+       {
+         return fPos;
+       }
+       else
+       {
+         return -999.;
+       }
+    }
 
     pObject = FindCommand(pSics,name);
     if(pObject)
@@ -341,11 +362,12 @@
         SCWrite(pCon,pBueffel,eError);
         ClearExecutor(GetExecutor());
         SetStatus(eOld);
-        return 1;
+        return 0;
       }
       else if(iRet == DEVINT)
       {      
-        SCWrite(pCon,"Driving Interrupted",eError);
+        sprintf(pBueffel,"Driving Interrupted!",argv[0]);
+        SCWrite(pCon,pBueffel,eError);
         ClearExecutor(GetExecutor());
         SetStatus(eOld);
         return 0;

fowrite.c

@@ -429,6 +429,13 @@
      sprintf(pBueffel,"%d",iInt);
      NXDupdate(pDict,"timebin",pBueffel);
      lData = GetHistogramPointer(self->pHist,pCon);
+     if(!lData)
+     {
+         SCWrite(pCon,"ERROR: failed to find Histogram Memory Data",eError);
+         NXclose(&pFile);
+         NXDclose(pDict,NULL);
+         return;
+     }
      setFMDataPointer(lData,iTime);     
      if(self->iUpper)
      {
@@ -615,7 +622,6 @@
             
 
      /* close everything */
-     free(lData);
      NXclose(&pFile);
      NXDclose(pDict,NULL);
       

histmem.c

@@ -62,7 +62,6 @@
 
 /*
 #define LOADDEBUG 1
-
 */
 /*------------------------------------------------------------------------*/
   static int HistHalt(void *pData)
@@ -997,6 +996,12 @@
          return NULL;
     }
 
+    if(self->iLocalData == NULL)
+    {
+          self->iLocalUpdate = 1;
+          self->tLocal = 0;
+    }
+
     /* get the full histogram if an update is needed */
     if( (self->iLocalUpdate) && (time(NULL) > self->tLocal) )
     {

nread.c

@@ -367,7 +367,8 @@ extern VerifyChannel(mkChannel *self); /* defined in network.c */
            pTel = CreateTelnet(pRes);
            if(!pTel)
            {
-             SICSLogWrite("Failure to allocate new Telnet Task Object",eInternal);
+             SICSLogWrite("Failure to allocate new Telnet Task Object",
+                          eInternal);
              SCDeleteConnection(pRes);
              return 0;
            }

nxsans.c

@@ -284,6 +284,9 @@
      lVal = GetHistMonitor(self,0,pCon);
      iVal = (int32)lVal;
      NXDputalias(Nfil,pDict,"m1counts",&iVal);
+     lVal = GetHistMonitor(self,4,pCon);
+     iVal = (int32)lVal;
+     NXDputalias(Nfil,pDict,"pbcounts",&iVal);
 
      /* the collimator */
      pCom = FindCommand(pSics,"sps2");

scan.c

@@ -134,6 +134,8 @@ extern void  SNXFormatTime(char *pBuffer, int iLen);
      pIDrivable    pDriv = NULL;
      float fVal;
      pMotor pMot = NULL;
+     pVarEntry pScanVar = NULL;
+     void *pVoid = NULL;
      
      assert(self->pSics);
      assert(self->pCon);
@@ -286,9 +288,31 @@ extern void  SNXFormatTime(char *pBuffer, int iLen);
           fprintf(self->fd,"%s %s\n",pBuffer,self->pFile);
           continue;
         }
+/*------------ scanzero */
+        pPtr = strstr(pBuffer,"!!SCANZERO!!");
+        if(pPtr)
+        {
+           *pPtr = '\0';
+           /* write zero point of first scan variable if motor */
+           DynarGet(self->pScanVar,0,&pVoid);
+           pScanVar = (pVarEntry)pVoid;
+           if(pScanVar)
+           {
+                pMot = NULL;
+                pMot = FindMotor(self->pSics,pScanVar->Name);
+                if(pMot != NULL)
+	        {
+                  MotorGetPar(pMot,"softzero",&fVal);
+                  fprintf(self->fd,"%s zero = %8.3f\n",pScanVar->Name, fVal);
+                }        
+            }
+        }
 /* --------- plain text */
         fprintf(self->fd,"%s",pBuffer);        
      } /* end while */
+
+
+     /* remember position for seeking to it for writing data */
      self->lPos = ftell(self->fd);
 
      fclose(fd);

sicsstatus.tcl

@@ -6,7 +6,7 @@ flightpath setAccess 1
 delay 2500.000000
 delay setAccess 1
 hm CountMode timer
-hm preset 100.000000
+hm preset 2.000000
 hm genbin 120.000000 35.000000 512
 hm init
 datafile focus-1001848.hdf
@@ -117,10 +117,10 @@ twotheta AccessCode 2.000000
 lastscancommand sscan ch  180  190  10  2 
 lastscancommand setAccess 2
 banana CountMode timer
-banana preset 100.000000
+banana preset 2.000000
 sample_mur 0.000000
 sample_mur setAccess 2
-email UNKNOWN
+email Uwe.Nurps@nurps.nurpstown.de
 email setAccess 2
 fax UNKNOWN
 fax setAccess 2
@@ -129,7 +129,7 @@ phone setAccess 2
 adress UNKNOWN
 adress setAccess 2
 # Counter counter
-counter SetPreset 1.000000
+counter SetPreset 120.000000
 counter SetMode Timer
 # Motor som
 som SoftZero 0.000000
@@ -244,9 +244,9 @@ d1r sign 1.000000
 d1r InterruptMode 0.000000
 d1r AccessCode 2.000000
 # Motor tasse
-tasse SoftZero 0.000000
+tasse SoftZero 10.000000
-tasse SoftLowerLim -130.000000
+tasse SoftLowerLim -140.000000
-tasse SoftUpperLim 130.000000
+tasse SoftUpperLim 120.000000
 tasse Fixed -1.000000
 tasse sign 1.000000
 tasse InterruptMode 0.000000
@@ -332,9 +332,9 @@ a5 sign 1.000000
 a5 InterruptMode 0.000000
 a5 AccessCode 2.000000
 # Motor a4
-a4 SoftZero 0.000000
+a4 SoftZero 10.000000
-a4 SoftLowerLim -130.000000
+a4 SoftLowerLim -140.000000
-a4 SoftUpperLim 130.000000
+a4 SoftUpperLim 120.000000
 a4 Fixed -1.000000
 a4 sign 1.000000
 a4 InterruptMode 0.000000
@@ -363,11 +363,11 @@ a1 Fixed -1.000000
 a1 sign 1.000000
 a1 InterruptMode 0.000000
 a1 AccessCode 2.000000
-user Daniel_the_Clementine
+user Joseph Stalin 
 user setAccess 2
-sample DanielOxid
+sample Fischdosen
 sample setAccess 2
-title TopsiTupsiTapsi
+title Nasse Fische  in  Dosen 
 title setAccess 2
-starttime UNKNOWN
+starttime 2000-03-31 11:40:31 
 starttime setAccess 2

tcl/count.tcl

@@ -10,6 +10,7 @@ proc SplitReply { text } {
 }
 #--------------------------------------------------------------------------
 proc count { {mode  NULL } { preset NULL } } {
+     starttime [sicstime]
 #----- deal with mode
      set mode2 [string toupper $mode]
      set mode3 [string trim $mode2]
@@ -32,14 +33,21 @@ proc count { {mode  NULL } { preset NULL } } {
                $bb $aa] 
 #------- count
      banana InitVal 0
+     wait 1
      banana count
-     Success
+     set ret [catch {Success} msg]
 #------- StoreData
-#     ClientPut [StoreData]
+#     StoreData
+     if { $ret != 0 } {
+       error [format "Counting ended with error"]
+     }
 }
 #---------------- Repeat -----------------------------------------------
 proc repeat { num {mode  NULL} {preset NULL} }  {
      for { set i 0 } { $i < $num } { incr i } {
-        count $mode $preset
+        set ret [catch {count $mode $preset} msg]
+        if {$ret != 0} {
+            error "Counting ended with error"
+        }
      }
 }

tcl/scancom.tcl

@@ -318,6 +318,7 @@ if {$ret != 0} {
    Publish sscan User
    Publish sftime Spy
    Publish scaninfo Spy
+   Publish wwwsics  Spy
 }
 
 #*************************************************************************
@@ -359,10 +360,50 @@ proc scaninfo {} {
     append result "," [lindex $l1 1]
     return [format "scaninfo = %s" $result]
 }
-
+#----------------------------------------------------------------------
+# wwwsics is a procedure which formats the most important status 
+# information for the WWW-status. 
+proc wwwsics {} {
+#----- get all the data we need
+ set user  [GetNum [user]]
+ set sample [GetNum [sample]]
+ set tit    [GetNum [title]]
+ set ret [catch {lambda} msg]
+ if {$ret != 0 } {
+    set lam Undetermined
+ } else {
+    set lam [GetNum $msg]
+ }
+ set lscan [GetNum [lastscancommand]]
+ set svar  [GetNum [scan getvars]]
+ set ind [string last -END- $svar]
+ if { $ind > 2 } {
+   set svar [string range $svar 0 $ind]
+ } else {
+   set svar " "
+ }
+ set res [scan info]
+ set l [split $res ,]
+ set fil [lindex $l 5] 
+ set run [GetNum [sicsdatanumber]]
+ set stat [GetNum [status]]
+#------- html format the reply
+ append result "<table BORDER=2>"
+ append result <tr> <th>Run Number</th> <td> $run </td> </tr>
+ append result <tr> <th>Title</th> <td> $tit </td> </tr>
+ append result <tr> <th>User</th> <td> $user </td> </tr>
+ append result <tr> <th>Sample </th> <td> $sample </td> </tr>
+ append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
+ append result <tr> <th>Status</th> <td> $stat</td> </tr>
+ append result <tr> <th>Scan Variables</th> <td> $svar</td> </tr>
+ append result <tr> <th>File </th> <td> $fil</td> </tr>
+ append result <tr> <th>Last Scan Command</th> <td> $lscan</td> </tr>
+ append result </table>
+ return $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 
+# at TOPSI. Scans around a given center point. Requires the scan command 
 # for TOPSI to work.
 #
 # another convenience scan:

tcl/wwwpulver.tcl

@@ -0,0 +1,43 @@
+#------------------------------------------------------------------------
+# This implements the wwwsics command which generates a listing of
+# important experiment parameters in html format for the SICS WWW Status
+# application. This version is for the powder diffractometers DMC and
+# HRPT. 
+#
+# Mark Koennecke, March 2000
+#------------------------------------------------------------------------
+proc wwwsics {} {
+#----- get all the data we need
+ set user  [GetNum [user]]
+ set sample [GetNum [sample]]
+ set tit    [GetNum [title]]
+ set ret [catch {lambda} msg]
+ if {$ret != 0 } {
+    set lam Undetermined
+ } else {
+    set lam [GetNum $msg]
+ }
+ set ret [catch {temperature} msg]
+ if {$ret != 0 } {
+    set tem Undetermined
+ } else {
+    set tem [GetNum $msg]
+ }
+ set run [GetNum [sicsdatanumber]]
+ catch {incr run} msg
+ set stat [GetNum [status]]
+#------- html format the reply
+ append result "<table BORDER=2>"
+ append result <tr> <th>Run Number</th> <td> $run </td> </tr>
+ append result <tr> <th>Title</th> <td> $tit </td> </tr>
+ append result <tr> <th>User</th> <td> $user </td> </tr>
+ append result <tr> <th>Sample </th> <td> $sample </td> </tr>
+ append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
+ append result <tr> <th>Sample Temperature</th> <td> $tem</td> </tr>
+ append result <tr> <th>Status</th> <td> $stat</td> </tr>
+ append result </table>
+ return $result
+} 
+
+#------------ install command
+catch {Publish wwwsics Spy} msg

telnet.c

@@ -104,9 +104,16 @@
       assert(self);
       
       if(self->pCon->iEnd)
+      {
+        if(self->pCon->inUse > 0)
+	{
+          return 1;
+        }
+        else
 	{
            return 0;
         }
+      }
       
       /* pop and execute */
       iRet = CostaPop(self->pCon->pStack,&pPtr);
@@ -136,11 +143,13 @@
              pLogin = strstr(pPtr,self->pLoginWord);
              if(!pLogin)
              {
-                SCWrite(self->pCon,"------------------- Get Lost -------------------",
+                SCWrite(self->pCon,
+                "------------------- Get Lost -------------------",
                  eError);
                 if(time(&shit) > self->tStart + LOGINWAIT)
                 {
-                  SCWrite(self->pCon,"I cannot stand your login attempts anymore!",
+                  SCWrite(self->pCon,
+                          "I cannot stand your login attempts anymore!",
                           eError);
                   NetReadRemove(pServ->pReader,self->pCon->pSock);
                   self->pCon->iEnd = 1;
@@ -161,7 +170,8 @@
                    sprintf(pBuffer,"SYSTEM ATTACK by %s / %s",pUser,
                           pPasswd);
                    SICSLogWrite(pBuffer,eInternal);
-                   SCWrite(self->pCon,"I do not know you, I do not let you in",eError);
+                   SCWrite(self->pCon,
+                     "I do not know you, I do not let you in",eError);
                    SendGA(self->pCon);
                    free(pPtr);
                    return 1;
@@ -190,9 +200,16 @@
       
       /* check for end */  
       if(self->pCon->iEnd)
+      {
+        if(self->pCon->inUse > 0)
+	{
+          return 1;
+        }
+        else
 	{
            return 0;
         }
+      }
       
       return 1;
    }

test.tcl

@@ -204,8 +204,8 @@ VarMake email  Text User
 VarMake sample_mur Float User
 
 MakeDataNumber SicsDataNumber "$shome/sics/danu.dat"
-InitSANS  $shome/sics/sansdict.dic
+#InitSANS  $shome/sics/sansdict.dic
-#InitDMC
+InitDMC
 
 MakeScanCommand  xxxscan counter topsi.hdd recover.bin
 MakePeakCenter xxxscan
@@ -228,7 +228,8 @@ banana CountMode Timer
 banana init
 ClientPut "HM initialized"
 source $shome/sics/tcl/scancom.tcl
-source $shome/sics/countf.tcl
+#source $shome/sics/countf.tcl
+source $shome/sics/tcl/count.tcl
 Publish count User
 Publish repeat user
 source $shome/sics/tcl/fit.tcl
@@ -340,14 +341,14 @@ MakeFocusAverager average hm
 FocusInstall hm focus.dic $shome/sics/focusmerge.dat 
 
 #MakeChopper choco docho lnsp20 4000 8
-MakeChopper choco sim
+#MakeChopper choco sim
 #ChopperAdapter fermispeed choco chopper1.nspee 0 20000
 #ChopperAdapter diskspeed  choco chopper2.nspee 0 20000
 #ChopperAdapter phase      choco chopper2.nphas 0 90.
 #ChopperAdapter ratio      choco chopper2.ratio 0 6.
-ChopperAdapter diskspeed  choco speed 0 20000
+#ChopperAdapter diskspeed  choco speed 0 20000
-ChopperAdapter phase      choco phase  0 90.
+#ChopperAdapter phase      choco phase  0 90.
-ChopperAdapter ratio      choco ratio 0 6.
+#ChopperAdapter ratio      choco ratio 0 6.
  
 source chosta.tcl
 Publish chosta Spy

topsi.hdd

@@ -15,4 +15,5 @@ Zero   STL = !!ZERO(STL)!!
 Zero   STU = !!ZERO(STU)!!
 Zero   SGL = !!ZERO(SGL)!!
 Zero   SGU = !!ZERO(SGU)!!
+!!SCANZERO!!
 **************************** DATA ******************************************

ufortify.h

@@ -21,9 +21,9 @@
 #define FILL_ON_FREE                 /* free'd memory is cleared       */
 #define FILL_ON_FREE_VALUE     0xA9  /* Value to de-initialize with    */
 
-/*
 #define CHECK_ALL_MEMORY_ON_MALLOC  
 #define CHECK_ALL_MEMORY_ON_FREE   
+/*
 #define PARANOID_FREE              
 */