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.
9 * Revision 1.1.1.1 1996/03/06 10:47:25 mclareni
13 #include "zebra/pilot.h"
14 SUBROUTINE RZLOCK(CHLOCK)
16 ************************************************************************
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.
29 * Author : R.Brun DD/US/PD
33 ************************************************************************
34 #include "zebra/zunit.inc"
35 #include "zebra/rzcl.inc"
36 #include "zebra/rzclun.inc"
37 #include "zebra/rzk.inc"
39 DIMENSION IHL(2),KHL(2)
41 *-----------------------------------------------------------------------
43 #include "zebra/q_jbit.inc"
44 #include "zebra/q_jbyt.inc"
49 LOGLV=JBYT(IQ(KQSP+LTOP),15,3)-3
52 CALL UCTOH(CHLOCK,IHL,4,NCH)
53 IF(NCH.LT.5)CALL VBLANK(IHL(2),1)
56 * Check write permission
58 *** IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)THEN
60 *** IF(LOGLV.GE.-2) WRITE(IQLOG,9010)
61 *** 9010 FORMAT(' RZLOCK. No authorisation to write in that directory')
67 LRIN = LQ(KQSP+LTOP-7)
68 LPURG = LQ(KQSP+LTOP-5)
69 LROUT = LQ(KQSP+LTOP-6)
71 CALL MZBOOK(JQPDVS,LRIN,LTOP,-7,'RZIN',0,0,LREC+1,2,-1)
72 IQ(KQSP+LRIN-5)=IQ(KQSP+LTOP-5)
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
84 IF(IQ(KQSP+LRIN+3).NE.0)THEN
87 #if defined(CERNLIB_QMVAX)
88 IF(IRELAT.NE.0)UNLOCK(UNIT=LUN)
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')
98 CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
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)
106 * Read fresh Top directory
108 IF(LTOP.NE.LCDIR)CALL RZRTOP
110 * Check that directory is not already locked
114 20 IF(IQ(KQSP+LRIN+LL).NE.0)THEN
116 * Check mother directories
119 IRCUR=IQ(KQSP+LRIN+LL+4)
120 IF(IRCUR.EQ.2.OR.IRCUR.EQ.IRD)IMOT=1
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)
128 LL=LL+IQ(KQSP+LRIN+LL)
134 * Fill 'free' bank with allocated records as a function
138 NRUSED=IQ(KQSP+LCDIR+KRUSED)
139 NDATA=IQ(KQSP+LFREE-1)
144 30 NMORE=IQ(KQSP+LRIN+LL)
146 ND=IQ(KQSP+LRIN+LL+5)
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
158 IF(JBIT(IQ(KQSP+LTOP+LB+2+IWORD),IBIT).EQ.0)THEN
160 IF(NRUSED.GT.IQ(KQSP+LCDIR+KQUOTA))GO TO 60
161 IF(IQ(KQSP+LFREE+IFR).EQ.0)THEN
163 IQ(KQSP+LFREE+1)=NFREE
165 IQ(KQSP+LFREE+IFR+1)=I
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
173 IQ(KQSP+LFREE+1)=NFREE
174 IF(2*NFREE+3.GT.NDATA)THEN
175 CALL MZPUSH(JQPDVS,LFREE,0,20,'I')
180 IQ(KQSP+LFREE+IFR+1)=I
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.')
197 IF(NWL+NMORE.GT.LREC)THEN
200 IQ(KQSP+LFREE+1)=NFREE
202 CALL UCOPY(IQ(KQSP+LFREE+2*NF),IQ(KQSP+LFREE+2*NFREE),2)
203 IQ(KQSP+LFREE+2*NFREE+2)=0
205 IF(LOGLV.GE.-2) WRITE(IQLOG,4000)
206 4000 FORMAT(' RZLOCK. Cannot allocate all free records')
208 IF(LOGLV.GE.-2) WRITE(IQLOG,4100)
209 4100 FORMAT(' RZLOCK. Data base is too fragmented')
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)
224 IQ(KQSP+LRIN+1)=IQ(KQSP+LRIN+1)+1
227 * Reset the lock and write record 1
229 90 CALL RZIODO(LUN,MAX(NWL,50),1,IQ(KQSP+LRIN+1),2)
230 IQUEST(10)=IQ(KQSP+LRIN+1)