MINICERN/packlib/zebra/rz/rzpurg.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:05  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:26  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZPURG(NKEEP)
  15 *
  16 ************************************************************************
  17 *
  18 *        Purge cycles in the CWD
  19 * Input:
  20 *   NKEEP   Number of cycles which must be kept for the given key
  21 *           If NKEEP < 1 then NKEEP is taken to be 1 and only the highest
  22 *           cycle is kept
  23 *
  24 * Called by <USER>
  25 *
  26 *  Author  : R.Brun DD/US/PD
  27 *  Written : 06.04.86
  28 *  Last mod: 11.12.88
  29 *          : 04.03.94 S.Banerjee (Change in cycle structure)
  30 *
  31 ************************************************************************
  32 #include "zebra/rzcl.inc"
  33 #include "zebra/rzclun.inc"
  34 #include "zebra/rzk.inc"
  35 #include "zebra/rzcycle.inc"
  36 *
  37 *-----------------------------------------------------------------------
  38 *
  39 #include "zebra/q_jbit.inc"
  40 #include "zebra/q_jbyt.inc"
  41
  42       IQUEST(1)=0
  43       NK=NKEEP
  44       IF(NK.LT.1)NK=1
  45 *
  46 *           Check if write permission
  47 *
  48       IF(LQRS.EQ.0)GO TO 999
  49       IFLAG=1
  50       CALL RZMODS('RZPURG',IFLAG)
  51       IF(IFLAG.NE.0)GO TO 999
  52 *
  53       LK=IQ(KQSP+LCDIR+KLK)
  54       LC=IQ(KQSP+LCDIR+KLC)
  55       LE=IQ(KQSP+LCDIR+KLE)
  56       NKEYS =IQ(KQSP+LCDIR+KNKEYS)
  57       NWKEY =IQ(KQSP+LCDIR+KNWKEY)
  58       IF(NKEYS.EQ.0)GO TO 999
  59 *
  60       NPUOLD=0
  61       IF(LPURG.NE.0)THEN
  62          NPURG=IQ(KQSP+LPURG+1)
  63          DO 5 I=1,NPURG
  64             NPUOLD=NPUOLD+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
  65    5     CONTINUE
  66       ENDIF
  67 *
  68       DO 20 IK=1,NKEYS
  69          LKC=LK+(NWKEY+1)*(IK-1)
  70          LCYC=IQ(KQSP+LCDIR+LKC)
  71          NC=0
  72   10     NC=NC+1
  73          IF (KVSCYC.EQ.0) THEN
  74             LCOLD = JBYT(IQ(KQSP+LCDIR+LCYC+KPPCYC), 1,16)
  75          ELSE
  76             LCOLD = IQ(KQSP+LCDIR+LCYC+KPPCYC)
  77          ENDIF
  78 *
  79 *              Check for first cycle to be kept
  80 *
  81          LKEEP=LCOLD
  82          IF(LKEEP.NE.0)THEN
  83   12        IF(JBIT(IQ(KQSP+LCDIR+LKEEP+KFLCYC),5).EQ.0)THEN
  84                IF (KVSCYC.EQ.0) THEN
  85                   LKEEP = JBYT(IQ(KQSP+LCDIR+LKEEP+KPPCYC),1,16)
  86                ELSE
  87                   LKEEP = IQ(KQSP+LCDIR+LKEEP+KPPCYC)
  88                ENDIF
  89                IF(LKEEP.NE.0)GO TO 12
  90             ENDIF
  91          ENDIF
  92          IF(NC.EQ.NK)THEN
  93             IF (KVSCYC.EQ.0) THEN
  94                CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
  95             ELSE
  96                IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
  97             ENDIF
  98          ENDIF
  99          IF(NC.GT.NK)THEN
 100             IF(JBIT(IQ(KQSP+LCDIR+LCYC+KFLCYC),5).NE.0)THEN
 101                IF (KVSCYC.EQ.0) THEN
 102                   CALL SBYT(LKEEP,IQ(KQSP+LCDIR+LCYC+KPPCYC),1,16)
 103                ELSE
 104                   IQ(KQSP+LCDIR+LCYC+KPPCYC) = LKEEP
 105                ENDIF
 106                GO TO 15
 107             ENDIF
 108             IF (KVSCYC.EQ.0) THEN
 109                IR1  = JBYT(IQ(KQSP+LCDIR+LCYC+KFRCYC),17,16)
 110                IP1  = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,16)
 111                NW   = JBYT(IQ(KQSP+LCDIR+LCYC+KNWCYC), 1,20)
 112                IR2  = JBYT(IQ(KQSP+LCDIR+LCYC+KSRCYC),17,16)
 113             ELSE
 114                IR1  = IQ(KQSP+LCDIR+LCYC+KFRCYC)
 115                IP1  = JBYT(IQ(KQSP+LCDIR+LCYC+KORCYC), 1,20)
 116                NW   = IQ(KQSP+LCDIR+LCYC+KNWCYC)
 117                IR2  = IQ(KQSP+LCDIR+LCYC+KSRCYC)
 118             ENDIF
 119             IRL  =0
 120             NWL  =0
 121 *
 122 *              Mark all records that can be purged in first pass
 123 *
 124             NLEFT=LREC-IP1+1
 125             NW1=NW
 126             IF(NW1.GE.NLEFT)NW1=NLEFT
 127             IF(IR2.NE.0)THEN
 128                NR=(NW-NW1-1)/LREC+1
 129                IF(NR.GT.1)THEN
 130                   CALL RZPURF(NR-1,IR2)
 131                ENDIF
 132                IRL=IR2+NR-1
 133                NWL=NW-NW1-(NR-1)*LREC
 134             ENDIF
 135             IF(NW1.EQ.LREC)THEN
 136                CALL RZPURF(1,IR1)
 137                IR1=0
 138             ENDIF
 139             IF(NWL.EQ.LREC)THEN
 140                CALL RZPURF(1,IRL)
 141                IRL=0
 142             ENDIF
 143             IRLOUT=IQ(KQSP+LCDIR+KRLOUT)
 144             IF(IRL.EQ.IRLOUT.AND.NWL+1.EQ.IQ(KQSP+LCDIR+KIP1))THEN
 145                CALL RZPURF(1,IRL)
 146             ENDIF
 147             IQ(KQSP+LCDIR+LCYC  )=-1
 148             IQ(KQSP+LCDIR+LCYC+1)=IR1
 149             IQ(KQSP+LCDIR+LCYC+2)=IRL
 150          ENDIF
 151 *
 152   15     IF(LCOLD.NE.0.AND.LCOLD.NE.LCYC)THEN
 153             LCYC=LCOLD
 154             GO TO 10
 155          ENDIF
 156   20  CONTINUE
 157 *
 158 *           Now loop on all purged cycles to find complete records
 159 *           purged
 160 *
 161       DO 70 LKC=LC,LE-KLCYCL+1,KLCYCL
 162          IF(IQ(KQSP+LCDIR+LKC).NE.-1)GO TO 70
 163          IR1=IQ(KQSP+LCDIR+LKC+1)
 164          IRL=IQ(KQSP+LCDIR+LKC+2)
 165          IF(IR1.NE.0)THEN
 166             DO 30 LKC1=LC,LE-KLCYCL+1,KLCYCL
 167                IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 30
 168                IF (KVSCYC.EQ.0) THEN
 169                   KR1  = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
 170                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
 171                   NW   = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
 172                   KR2  = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
 173                ELSE
 174                   KR1  = IQ(KQSP+LCDIR+LKC1+KFRCYC)
 175                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
 176                   NW   = IQ(KQSP+LCDIR+LKC1+KNWCYC)
 177                   KR2  = IQ(KQSP+LCDIR+LKC1+KSRCYC)
 178                ENDIF
 179                KRL  =0
 180                NLEFT=LREC-KP1+1
 181                NW1=NW
 182                IF(NW1.GE.NLEFT)NW1=NLEFT
 183                IF(KR2.NE.0)THEN
 184                   NR=(NW-NW1-1)/LREC+1
 185                   KRL=KR2+NR-1
 186                ENDIF
 187                IF(KR1.EQ.IR1.OR.KRL.EQ.IR1)GO TO 40
 188   30        CONTINUE
 189             CALL RZPURF(1,IR1)
 190          ENDIF
 191 *
 192   40     IF(IRL.NE.0)THEN
 193             DO 50 LKC1=LC,LE-KLCYCL+1,KLCYCL
 194                IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)GO TO 50
 195                IF (KVSCYC.EQ.0) THEN
 196                   KR1  = JBYT(IQ(KQSP+LCDIR+LKC1+KFRCYC),17,16)
 197                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,16)
 198                   NW   = JBYT(IQ(KQSP+LCDIR+LKC1+KNWCYC), 1,20)
 199                   KR2  = JBYT(IQ(KQSP+LCDIR+LKC1+KSRCYC),17,16)
 200                ELSE
 201                   KR1  = IQ(KQSP+LCDIR+LKC1+KFRCYC)
 202                   KP1  = JBYT(IQ(KQSP+LCDIR+LKC1+KORCYC), 1,20)
 203                   NW   = IQ(KQSP+LCDIR+LKC1+KNWCYC)
 204                   KR2  = IQ(KQSP+LCDIR+LKC1+KSRCYC)
 205                ENDIF
 206                KRL  =0
 207                NLEFT=LREC-KP1+1
 208                NW1=NW
 209                IF(NW1.GE.NLEFT)NW1=NLEFT
 210                IF(KR2.NE.0)THEN
 211                   NR=(NW-NW1-1)/LREC+1
 212                   KRL=KR2+NR-1
 213                ENDIF
 214                IF(KR1.EQ.IRL.OR.KRL.EQ.IRL)GO TO 70
 215   50        CONTINUE
 216             CALL RZPURF(1,IRL)
 217          ENDIF
 218   70  CONTINUE
 219 *
 220 *           Garbage collection on cycles area + relocation
 221 *
 222       LKC3=LE-KLCYCL+1
 223   80  IF(LKC3.LT.LC)GO TO 200
 224       IF(IQ(KQSP+LCDIR+LKC3).EQ.-1)THEN
 225          LKC3=LKC3+KLCYCL
 226          LKC2=LKC3-2*KLCYCL
 227   90     IF(IQ(KQSP+LCDIR+LKC2).NE.-1)THEN
 228             LKC2=LKC2+KLCYCL
 229             LKC1=LKC2-2*KLCYCL
 230             IF(LKC1.LT.LC)LKC1=LC
 231  100        IF(IQ(KQSP+LCDIR+LKC1).EQ.-1)THEN
 232                IF(LKC1.GT.LC)LKC1=LKC1+KLCYCL
 233             ELSE
 234                IF(LKC1.GT.LC)THEN
 235                   LKC1=LKC1-KLCYCL
 236                   GO TO 100
 237                ENDIF
 238             ENDIF
 239 *
 240             NPUSH=LKC3-LKC2
 241             DO 110 LKC=LC,LKC2-KLCYCL,KLCYCL
 242                IF(IQ(KQSP+LCDIR+LKC).NE.-1)THEN
 243                   IF (KVSCYC.EQ.0) THEN
 244                      LCOLD = JBYT(IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
 245                   ELSE
 246                      LCOLD = IQ(KQSP+LCDIR+LKC+KPPCYC)
 247                   ENDIF
 248                   IF(LCOLD.GE.LKC1.AND.LCOLD.LT.LKC2)THEN
 249                      LCOLD=LCOLD+NPUSH
 250                      IF (KVSCYC.EQ.0) THEN
 251                         CALL SBYT(LCOLD,IQ(KQSP+LCDIR+LKC+KPPCYC),1,16)
 252                      ELSE
 253                         IQ(KQSP+LCDIR+LKC+KPPCYC) = LCOLD
 254                      ENDIF
 255                   ENDIF
 256                ENDIF
 257  110        CONTINUE
 258 *
 259             DO 120 IK=1,NKEYS
 260                LCYC=IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))
 261                IF(LCYC.GE.LKC1.AND.LCYC.LT.LKC2)THEN
 262                   IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))=
 263      +            IQ(KQSP+LCDIR+LK+(NWKEY+1)*(IK-1))+NPUSH
 264                ENDIF
 265  120        CONTINUE
 266 *
 267             CALL UCOPY2(IQ(KQSP+LCDIR+LKC1),IQ(KQSP+LCDIR+LKC1+NPUSH),
 268      +                  LKC2-LKC1)
 269             LKC3=LKC1+NPUSH
 270             LKC2=LKC1-KLCYCL
 271             IF(LKC1.NE.LC)GO TO 90
 272             LC=LC+NPUSH
 273             GO TO 200
 274 *
 275          ELSE
 276             LKC2=LKC2-KLCYCL
 277             IF(LKC2.GE.LC)GO TO 90
 278          ENDIF
 279       ELSE
 280          LKC3=LKC3-KLCYCL
 281          GO TO 80
 282       ENDIF
 283 *
 284 *           Reset internal pointers
 285 *
 286  200  CONTINUE
 287 *
 288       NPUNEW=0
 289       IF(LPURG.NE.0)THEN
 290          NPURG=IQ(KQSP+LPURG+1)
 291          DO 210 I=1,NPURG
 292             NPUNEW=NPUNEW+IQ(KQSP+LPURG+2*I+1)-IQ(KQSP+LPURG+2*I)+1
 293  210     CONTINUE
 294       ENDIF
 295       NPU=NPUNEW-NPUOLD
 296       IQUEST( 9)=IQ(KQSP+LCDIR+KQUOTA)-IQ(KQSP+LCDIR+KRUSED)+NPU
 297       IQUEST(11)=(LC-IQ(KQSP+LCDIR+KLC))/KLCYCL
 298       IQUEST(12)=NPU*LREC
 299       IQUEST(13)=NPU
 300 *
 301       IQ(KQSP+LCDIR+KRUSED)=IQ(KQSP+LCDIR+KRUSED)-NPU
 302       NWP=NPU*LREC
 303       NMEGA=NWP/1000000
 304       IQ(KQSP+LCDIR+KMEGA)=IQ(KQSP+LCDIR+KMEGA)-NMEGA
 305       NWP=NWP-1000000*NMEGA
 306       IQ(KQSP+LCDIR+KWUSED)=IQ(KQSP+LCDIR+KWUSED)-NWP
 307       IQ(KQSP+LCDIR+KNFREE)=IQ(KQSP+LCDIR+KNFREE)+LC-IQ(KQSP+LCDIR+KLC)
 308       IQ(KQSP+LCDIR+KLC)=LC
 309 *
 310  999  RETURN
 311       END