SPL,L,O,M,C 
!     NAME:   PK..
!     SOURCE: 92064-18158 
!     RELOC:  92064-16055 
!     PGMR:   G.A.A.
!     MOD:    G.L.M.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     *
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
!  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
!  ***************************************************************
! 
! 
      NAME PK..(7) " 92064-16055  REV.1805  771018" 
! 
!  MODIFIED 750416 TO NOT MOVE EXTENTS IF THEY ALREADY RESIDE AT
!  THE DESTINATION AND ALSO TO CORRECTLY HANDLE FILES TO 32K SECTORS
!     PK..  IS THE PACKING ROUTINE FOR THE
!           RTE FMGR PROGRAM. 
! 
!     IT PACKS RTE FILES AS FOLLOWS:
! 
! 
!     1.  EACH FILE IS MOVED DOWN (IF NECESSARY). 
!         AFTER EACH FILE IS MOVED ITS DIRECTORY
!         ENTRY IS UPDATED. 
!     (THUS NO MORE THAN ONE FILE IS
!         LOST BY A CRASH.) 
! 
!     2.  AFTER ALL FILES ARE MOVED  A NEW DIRECTORY
!         IS CREATED PACKING OUT ALL THE PURGED 
!         ENTRIES AND THIS IS WRITTEN ON THE DISC DIRECTLY AFTER
!         REQUESTING A LOCK VIA D.RFP 
! 
!     THIS ROUTINE IS ENTERED BY THE COMMAND: 
! 
!     PK,CR 
! 
!         WHERE CR IS OPTIONAL AND RESTRICTS
!         THE PACK TO DISC CR.
! 
!     DECLARE EXTERNALS 
! 
      LET D.RIO,DR.RD,LOCK.,MSS.,\
                     EXEC,READF, \
          WRITF,RWNDF,MVW,LIMEM  \
                           BE SUBROUTINE,EXTERNAL 
! 
      LET IER.,JER.,CLD.R BE SUBROUTINE,EXTERNAL,DIRECT 
! 
! 
      LET D.SDR,PK.DR,DS.LU,IDCB1,IDCB2,\ 
     .E.R,.P1,.P2,.P3,.P4,.P5 BE INTEGER,EXTERNAL 
! 
!     DECLARE INTERNAL SUBROUTINES
! 
      LET       SETAD,BADTR\
                        BE SUBROUTINE 
! 
!     DECLARE ARRAYS
! 
      LET BTL(6)        BE INTEGER
! 
!     DECLARE CONSTANTS 
! 
      LET READI     BE CONSTANT(    1)
      LET WRIT      BE CONSTANT(    2)
      LET XEQT      BE CONSTANT(1717K)
      LET KEYWD     BE CONSTANT(1657K)
      LET A         BE CONSTANT(   3 )
      LET B         BE CONSTANT(   1 )
! 
! 
PK..: SUBROUTINE(N,LIS,ER) GLOBAL  !ENTRY POINT 
      PACK_$(@LIS+1)               !GET THE PACK
      LUPT_@D.SDR 
      PAKAD_@PK.DR                 !SET DIRECTORY ADD.
      CALL LIMEM(1,FWAM,WRDS)      !SEE IF ANY MEMORY AVAIL.
      WRDS_WRDS AND 77600K         !FULL SECTOR BOUNDS
PK1:  D.RIO(READI)
! 
AGAIN:DIS_[IF PACK THEN PACK,ELSE -$LUPT] 
      IFNOT DIS THEN [CALL LIMEM(-1);\ !END OF DISC DIRECTORY 
                        RETURN]        !RETURN MEMORY AND EXIT
      CALL JER.     !CHECK FOR BREAK
      LOCK.(DIS,3)?[MSS.(DIS);GO TO NXDIS]
! 
      DR.RD(READI,DIS,0)?[ER_54;RETURN] 
! 
      FILCO_0 
      SETAD 
      LU_$$@DS.LU 
! 
!     SET UP DCBS FOR PACKING 
! 
                DCB5_[NXSEC_[NXTR_[DCB2_[\
                      DCB_@IDCB1]+2]+1]+1]+1
      DCB21_[DCB20_[DCB19_[OBUF_[DCB9_[DCB8_[DCB7_[DCB6_ \
                      DCB5+1]+1]+1]+1]+7]+3]+1]+1 
      TBUF_DCB+32 
      IDCB1_0 
      MVW(@IDCB1,@IDCB1+1,31) 
      $DCB_LU 
      $DCB2_1 
      $DCB6_128     !SET RECORD SIZE
      $DCB7_100200K    !SECURITY FLAG 
      $DCB8_$PKD6 AND 377K            !SET #SECT TRK
      $DCB9_$XEQT   !AND OPEN FLAG
      FOR T_DCB TO DCB9 DO[T1_T+16;$T1_$T]
! 
!     THE DISC IS LOCKED AND WE MAY START 
!     PACKING - WE MUST HAVE A BUFFER 
!     AND ITS SIZE.  IF LIMEM GOT MORE
!     THAN 256 WORDS USE THAT MEMORY; 
!     ELSE USE IDCB1+32 (256 WDS) 
! 
! 
! 
!     WRDS AND FWAM WERE SET UP BY CALL TO LIMEM UPON ENTRY 
! 
! 
      IF WRDS>256 THEN [BUFAD_FWAM;LN_WRDS;\
               GOTO PK5]               !USE LARGER BUFFER FOR SPEED 
! 
! 
PK3:  DO[LN_256;BUFAD_TBUF] 
PK5:  SECSZ_LN-<10  !SET SECTOR COUNT.
! 
!     BUFFER AND LENGTH ARE SET NOW 
!     START TO PACK 
! 
! 
       DO[$NXTR_$PKD4; FOR\ 
                    T_@BTL TO @BTL+5 DO[\ 
                     PKD9_PKD9+1; $T_$PKD9]]
      $NXSEC,BLK_0
NXBLK:DR.RD(READI,DIS,BLK)?[GO TO CLEAN]
! 
      FILCO_0 
! 
NXFIL:SETAD?[GO TO WRBLK] 
! 
! 
      IFNOT $PKD THEN GOTO CLEAN  !END
! 
      IF $PKD<0 THEN GOTO NXFIL   !PURGED 
      IFNOT $PKD3  THEN GOTO NXFIL !TYPE0 
! 
!     IF THE FILE CONTAINS A BAD TRACK
!     PURGE IT AND CONTINUE 
! 
      BADTR($PKD4,[$DCB20_$PKD5 AND 377K],$PKD6)?[WRFL,$PKD_ -1;\ 
                    GO TO WRBLK]
! 
! 
!     COMPUTE NEW LOCATION
! 
NEWLO:BADTR($NXTR,$NXSEC,$PKD6)?[\
            $NXTR_$BT+1;$NXSEC_0;GO TO NEWLO] 
! 
!     IF NEW LOCATION SAME AS OLD THEN
!     GO TO NEXT FILE 
! 
      IF $NXTR=$PKD4 THEN [IF $NXSEC=$DCB20 THEN\ 
                     GO TO PK11]
! 
!     FAKE OPEN THE FILES 
! 
      WRFL,CO,$DCB5,$DCB21_$PKD6    !# OF SECTORS 
      $DCB19_$PKD4  !START TRACK
      RWNDF(IDCB1,.E.R ) !SET REST OF DCB 
      IER.
      RWNDF($OBUF,.E.R ) !FOR IN AND OUT
      IER.
PK10: XFER_[IF CO>SECSZ THEN LN,ELSE CO-<6] 
      READF($OBUF,.E.R ,$BUFAD,XFER)
      IER.
      WRITF(IDCB1,.E.R ,$BUFAD,XFER)
      IER.
      IF [CO_CO-(XFER-<10)] THEN GOTO PK10
      DO[$PKD4_$NXTR;$PKD5_$NXSEC+($PKD5 AND 177400K)]
PK11: DO[$NXTR_NTR;$NXSEC_NSEC]!UPDATE FOR NEXT FILE
! 
! PONTERS ARE UPDATED 
! 
!     FILE IS MOVED - UPDATE DIRECTORY
!     THEN GO DO NEXT FILE. 
! 
WRBLK:IF WRFL THEN[DR.RD(WRIT,DIS,BLK);WRFL_0]
      IF FILCO=128 THEN[BLK_BLK+1;GOTO NXBLK],ELSE\ 
           GO TO NXFIL
! 
! 
! 
      ASSEMBLE " SKP" 
! 
! 
! 
! 
! 
CLEAN:   TCNT,FCNT,FBLK,TBLK_0           !INITIALIZE POINTERS 
      FBF_@PK.DR                       !SET ADDRESS OF DIR BUFFER 
      TBF_@IDCB1                       !SET ADDRESS OF OUT BUF
! 
TOP:  DR.RD(READI,DIS,FBLK)?[GO TO EED]!READ DIRECTORY BLOCK
                                       !GO TO END IF LAST+1 
! 
      IF FBLK THEN GO TO PCK           !IF NOT FIRST--CONTINUE
! 
! 
      FILCO_0                          !CLEAR FILE COUNT FOR SETAD
      SETAD                            !THIS IS THE DIR ID
      $PKD9_$NXTR                      !SET NEXT TRACK
      $PKD5_$NXSEC                     !SET NEXT SECTOR 
      GO TO MOK                        !MOVE THIS ENTRY 
! 
! 
! 
! 
PCK:  IFNOT [T_$(FBF+FCNT)]THEN\       !GET OUT IF
                        GO TO EED,\    !END OF DIRECTORY
          ELSE[IF T<0 THEN GO TO NEX ] !IF PURGED-TRY NEXT ONE
! 
MOK:  MVW(FBF+FCNT,TBF+TCNT,16)        !MOVE DIR ENTRY TO SAVE BUF
! 
      IF [TCNT_TCNT+16]=128 THEN\      !BUMP OUT COUNT-IF FULL
            [TCNT_0;\                  !RESET OUT COUNT 
             DR.RD(-2,DIS,TBLK);\      !WRITE THE BLOCK 
             TBLK_TBLK+1]              !BUMP THE BLOCK CONUT
! 
  
NEX : IF [FCNT_FCNT+16]=128 THEN\        !BUMP IN COUNT-IF EMPTY
        [FCNT_0;FBLK_FBLK+1;GO TO TOP],\ !RESET IN COUNT
                       ELSE GOTO PCK
                                       !BUMP BLOCK COUNT
                                       !GO READ NEXT BLOCK
! 
EED:  $(TBF+TCNT)_0                    !CLEAR "CURRENT" FW OF BUF 
      T_(128-TCNT)-1                   !CALCULATE # WORDS TO MOVE 
                                       !TO CLEAR REST OF BUFFER 
! 
      MVW(TBF+TCNT,TBF+TCNT+1,T)       !CLEAR REST OF BUFFER
! 
! 
WIPE: CALL DR.RD(-2,DIS,TBLK)          !WRITE IT OUT
      TBLK_TBLK+1                      !BUMP BLOCK COUNT
! 
! 
   IFNOT FBLK < TBLK THEN [IFNOT TCNT\ !CLEAR REST OF DIRECTORY 
                     THEN GO TO WIPE,\ !CONT AT WIPE IF 
                        ELSE[\         !ELSE CLEAR FULL BUFFER
                        TCNT_0;GO TO EED]]
! 
! 
! 
! 
! 
! 
! 
! 
PK26: LOCK.(DIS,5)         !UNLOCK DISC 
NXDIS: IDCB2_0                         !CLEAR FW SO CLOSE WON'T 
                                       !GET SCREWED UP
       IFNOT PACK THEN [LUPT_LUPT+4;GOTO AGAIN] 
      CALL LIMEM(-1)
      RETURN
      END 
! 
!     SETAD SETS THE ADDRESSES FOR THE NEXT FILES ENTRY 
!     IN PK.DR - IF NONE THEN AN FRETURN IS MADE. 
! 
SETAD:SUBROUTINE FEXIT
! 
      IF FILCO=128 THEN FRETURN 
      PKD9_[PKD8_[PKD6_[PKD5_[PKD4_[PKD3_[PKD_\ 
                          PAKAD+FILCO]+3]+1]+1]+1]\ 
                            +2]+1 
      FILCO_FILCO+16
      RETURN
      END 
! 
!     BADTR RETURNS FALSE IF THE CURRENT FILE 
!     AREA CONTAINS A BAD TRACK.
! 
BADTR:SUBROUTINE(TRAK,SECT,NOSEC)FEXIT
      NTR_((SECT+NOSEC)->1)/($DCB8->1)+TRAK  !COMPUTE (ROTATE TO AVOID
      NSEC_$B+$B    !NEXT TRACK & SECTOR (32K SECTORS SIGN PROB.) 
!     CHECK EACH TRACK AGAINST THE BAD LIST.
      FOR T_TRAK TO[IF NSEC THEN 0,ELSE -1]\
                              + NTR DO[\
           FOR BT_@BTL TO @BTL+5 DO[  \ 
         IF $BT THEN[IF  T=$BT THEN FRETURN]]]
      RETURN
      END 
      END 
      END$
!