MINICERN/packlib/zebra/rz/rzlock.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:01  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZLOCK(CHLOCK)
  15 *
  16 ************************************************************************
  17 *
  18 *        To lock the CWD
  19 * Input:
  20 *   CHLOCK  Character variable  identifying the owner  of the  lock (e.g.
  21 *           specifying the name of the user, his computer identifier,...)
  22 *           This parameter is used to avoid two users,  who have both the
  23 *           write password for  a directory,  trying to change  it at the
  24 *           same time.    CHLOCK is also useful  in the case of  a system
  25 *           crash while a directory was locked.
  26 *
  27 * Called by <USER>
  28 *
  29 *  Author  : R.Brun DD/US/PD
  30 *  Written : 02.05.86
  31 *  Last mod: 04.10.90
  32 *
  33 ************************************************************************
  34 #include "zebra/zunit.inc"
  35 #include "zebra/rzcl.inc"
  36 #include "zebra/rzclun.inc"
  37 #include "zebra/rzk.inc"
  38       CHARACTER*(*) CHLOCK
  39       DIMENSION IHL(2),KHL(2)
  40 *
  41 *-----------------------------------------------------------------------
  42 *
  43 #include "zebra/q_jbit.inc"
  44 #include "zebra/q_jbyt.inc"
  45
  46       IQUEST(1)=0
  47       IF(LQRS.EQ.0)GO TO 99
  48       IF(LTOP.EQ.0)GO TO 99
  49       LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
  50       NCH=LEN(CHLOCK)
  51       IF(NCH.GT.8)NCH=8
  52       CALL UCTOH(CHLOCK,IHL,4,NCH)
  53       IF(NCH.LT.5)CALL VBLANK(IHL(2),1)
  54       CALL ZHTOI(IHL,IHL,2)
  55 *
  56 *           Check write permission
  57 *
  58 ***      IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)THEN
  59 ***         IQUEST(1)=4
  60 ***         IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
  61 *** 9010    FORMAT(' RZLOCK. No authorisation to write in that directory')
  62 ***         GO TO 99
  63 ***      ENDIF
  64 *
  65 *           Lock first record
  66 *
  67       LRIN  = LQ(KQSP+LTOP-7)
  68       LPURG = LQ(KQSP+LTOP-5)
  69       LROUT = LQ(KQSP+LTOP-6)
  70       IF(LRIN.EQ.0)THEN
  71          CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
  72          IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
  73       ENDIF
  74       NWL =50
  75       NTRY=0
  76   10  CALL RZIODO(LUN,NWL,1,IQ(KQSP+LRIN+1),1)
  77       IF(IQUEST(1).NE.0)GO TO 99
  78       IF(IQ(KQSP+LRIN+2).GT.NWL)THEN
  79          NWL=IQ(KQSP+LRIN+2)
  80          GO TO 10
  81       ENDIF
  82       NWL=IQ(KQSP+LRIN+2)
  83       IQ(KQSP+LTOP+KIRIN)=0
  84       IF(IQ(KQSP+LRIN+3).NE.0)THEN
  85          NWL=50
  86          NTRY=NTRY+1
  87 #if defined(CERNLIB_QMVAX)
  88          IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
  89          CALL LIB$WAIT(0.1)
  90 #endif
  91          IF(NTRY.LT.100.AND.IQUEST(1).EQ.0)GO TO 10
  92          IF(LOGLV.GE.-2) WRITE(IQLOG,1000)
  93  1000    FORMAT(' RZLOCK. Cannot lock that directory')
  94          IQUEST(1)=1
  95          GO TO 99
  96       ENDIF
  97       IQ(KQSP+LRIN+3)=1
  98       CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
  99 *
 100       IQ(KQSP+LRIN+3)=0
 101       NLOCK=IQ(KQSP+LRIN+1)
 102       NREC=IQ(KQSP+LTOP+KQUOTA)
 103       LDC=IQ(KQSP+LCDIR+KLD)
 104       IRD=IQ(KQSP+LCDIR+LDC+1)
 105 *
 106 *           Read fresh Top directory
 107 *
 108       IF(LTOP.NE.LCDIR)CALL RZRTOP
 109 *
 110 *          Check that directory is not already locked
 111 *
 112       IF(NLOCK.GT.0)THEN
 113          LL=4
 114   20     IF(IQ(KQSP+LRIN+LL).NE.0)THEN
 115 *
 116 *          Check mother directories
 117 *
 118             IMOT=0
 119             IRCUR=IQ(KQSP+LRIN+LL+4)
 120             IF(IRCUR.EQ.2.OR.IRCUR.EQ.IRD)IMOT=1
 121             IF(IMOT.NE.0)THEN
 122                CALL ZITOH(IQ(KQSP+LRIN+LL+1),KHL,2)
 123                IF(LOGLV.GE.-2) WRITE(IQLOG,3000)KHL
 124  3000          FORMAT(' RZLOCK. Directory already locked by ',2A4)
 125                IQUEST(1)=2
 126                GO TO 90
 127             ELSE
 128                LL=LL+IQ(KQSP+LRIN+LL)
 129                GO TO 20
 130             ENDIF
 131          ENDIF
 132       ENDIF
 133 *
 134 *          Fill 'free' bank with allocated records as a function
 135 *          of quota
 136 *
 137       NFREE=0
 138       NRUSED=IQ(KQSP+LCDIR+KRUSED)
 139       NDATA=IQ(KQSP+LFREE-1)
 140       LB=IQ(KQSP+LTOP+KLB)
 141       IFR=2
 142       DO 50 I=3,NREC
 143          LL=4
 144   30     NMORE=IQ(KQSP+LRIN+LL)
 145          IF(NMORE.NE.0)THEN
 146             ND=IQ(KQSP+LRIN+LL+5)
 147             DO 40 J=1,ND
 148                IR1=IQ(KQSP+LRIN+LL+2*J+4)
 149                IRL=IQ(KQSP+LRIN+LL+2*J+5)
 150                IF(I.GE.IR1.AND.I.LE.IRL)GO TO 50
 151   40        CONTINUE
 152             LL=LL+NMORE
 153             GO TO 30
 154          ENDIF
 155 *
 156          IWORD=(I-1)/32+1
 157          IBIT=I-32*(IWORD-1)
 158          IF(JBIT(IQ(KQSP+LTOP+LB+2+IWORD),IBIT).EQ.0)THEN
 159             NRUSED=NRUSED+1
 160             IF(NRUSED.GT.IQ(KQSP+LCDIR+KQUOTA))GO TO 60
 161             IF(IQ(KQSP+LFREE+IFR).EQ.0)THEN
 162                NFREE=NFREE+1
 163                IQ(KQSP+LFREE+1)=NFREE
 164                IQ(KQSP+LFREE+IFR)=I
 165                IQ(KQSP+LFREE+IFR+1)=I
 166             ELSE
 167                IF(I.EQ.IQ(KQSP+LFREE+IFR+1)+1)THEN
 168                   NFREE=IQ(KQSP+LFREE+1)
 169                   IF(NFREE.EQ.0)NFREE=1
 170                   IQ(KQSP+LFREE+IFR+1)=I
 171                ELSE
 172                   NFREE=NFREE+1
 173                   IQ(KQSP+LFREE+1)=NFREE
 174                   IF(2*NFREE+3.GT.NDATA)THEN
 175                      CALL MZPUSH(JQPDVS,LFREE,0,20,'I')
 176                      NDATA=NDATA+20
 177                   ENDIF
 178                   IFR=IFR+2
 179                   IQ(KQSP+LFREE+IFR)=I
 180                   IQ(KQSP+LFREE+IFR+1)=I
 181                ENDIF
 182             ENDIF
 183          ENDIF
 184   50  CONTINUE
 185 *
 186 *          Build new lock
 187 *
 188   60  NMORE=2*NFREE+6
 189       IF(NFREE.LE.0)THEN
 190          IF(LOGLV.GE.-2) WRITE(IQLOG,3100)
 191  3100    FORMAT(' RZLOCK. Cannot allocate free records -',
 192      +          ' RZ quota for this file has been reached.')
 193          IQUEST(1)=3
 194          GO TO 90
 195       ENDIF
 196       IF(NWL.EQ.0)NWL=4
 197       IF(NWL+NMORE.GT.LREC)THEN
 198          NF=NFREE
 199          NFREE=(LREC-NWL-6)/2
 200          IQ(KQSP+LFREE+1)=NFREE
 201          IF(NFREE.GT.0)THEN
 202             CALL UCOPY(IQ(KQSP+LFREE+2*NF),IQ(KQSP+LFREE+2*NFREE),2)
 203             IQ(KQSP+LFREE+2*NFREE+2)=0
 204             NMORE=2*NFREE+6
 205             IF(LOGLV.GE.-2) WRITE(IQLOG,4000)
 206  4000       FORMAT(' RZLOCK. Cannot allocate all free records')
 207          ELSE
 208             IF(LOGLV.GE.-2) WRITE(IQLOG,4100)
 209  4100       FORMAT(' RZLOCK. Data base is too fragmented')
 210             IQUEST(1)=1
 211             IQ(KQSP+LFREE+1)=0
 212             GO TO 90
 213          ENDIF
 214       ENDIF
 215       IQ(KQSP+LRIN+NWL)=NMORE
 216       IQ(KQSP+LRIN+NWL+1)=IHL(1)
 217       IQ(KQSP+LRIN+NWL+2)=IHL(2)
 218       IQ(KQSP+LRIN+NWL+3)=0
 219       CALL RZDATE(IQ(KQSP+LRIN+NWL+3),IDATE,ITIME,2)
 220       IQ(KQSP+LRIN+NWL+4)=IQ(KQSP+LCDIR+LDC+1)
 221       CALL UCOPY(IQ(KQSP+LFREE+1),IQ(KQSP+LRIN+NWL+5),2*NFREE+1)
 222       NWL=NWL+NMORE
 223       IQ(KQSP+LRIN+NWL)=0
 224       IQ(KQSP+LRIN+1)=IQ(KQSP+LRIN+1)+1
 225       IQ(KQSP+LRIN+2)=NWL
 226 *
 227 *          Reset the lock and write record 1
 228 *
 229   90  CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
 230       IQUEST(10)=IQ(KQSP+LRIN+1)
 231 *
 232   99  RETURN
 233       END