SPL,L,O,M 
!     NAME:   PU..
!     SOURCE: 92067-18224 
!     RELOC:  92067-16185 
!     PGMR:   G.A.A.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 PU..(8) "92067-16185 REV.1903 790319"
! 
!  MODIFICATION RECORD: 
! 
!  1) 780516   TO HANDLE LOCK. ERROR RETURN PARAMETER 
!  2) 790112   TO USE NEW DCB FORMAT FOR TRK,SEC,SEC OFFSET 
!  3) 790127   TO HANDLE PURGE OF TYPE 0 ON ANY DISC CARTRIDGE
! 
!     PURGE FILE ROUTINE FOR THE RTE FILE MANAGER 
! 
!     ENTERED AFTER A:
! 
!     PU,NAMR 
! 
!     WHERE:
! 
!     NAMR     IS THE FILE'S NAMR WHICH CAN CONTAIN:
! 
!     CR       (OPTIONAL) IS THE CARTRIDGE ID.
! 
!     SC       (OPTIONAL) IS THE FILE SECURITY CODE.
! 
! 
!     DEFINE EXTERNAL ADDRESSES 
! 
      LET .E.R.,                     \FMGR ERROR WORD 
          I.BUF,                     \INTERNAL FMGR BUFFER
          N.OPL,                     \FMGR SUBPARAMETER ARRAY 
          PK.DR                      \FILE DIRECTORY BUFFER 
             BE INTEGER,EXTERNAL
! 
      LET DR.RD,                     \RTE EXEC ROUTINE
          IER.,                      \FMGR ERROR HANDLING ROUTINE 
          LOCK.,                     \CARTRIDGE LOCK ROUTINE
          MSS.,                      \FMGR ERROR MESSAGE ROUTINE
          PURGE                      \FMP FILE PURGE ROUTINE
             BE SUBROUTINE,EXTERNAL 
! 
      LET PUIT                       \PURGE ROUTINE 
             BE SUBROUTINE,DIRECT 
! 
      LET TATSD                      BE CONSTANT (1756K)
      LET SECT2                      BE CONSTANT (1757K)
      LET WRIT                       BE CONSTANT (2)
      LET READI                      BE CONSTANT (1)
! 
PU..: SUBROUTINE(NCAM,PLIST,ER) GLOBAL   !ENTRY POINT 
      LET NCAM,PLIST,ER  BE INTEGER 
! 
      DO[T_@N.OPL+1;BLK_@PLIST+1] 
      PUIT                               !CALL PURGE
      IF .E.R.= -6 THEN .E.R._ -2006     !SET UNDEFINED MESSAGE 
      IF .E.R. = -16 THEN GO TO ZPURG 
      IER.
      RETURN
! 
ZPURG:DCB2_[T_@I.BUF]+1        !ADDRESSES OF DCB WORDS 1 AND 2
      DIS_$T AND 77K           !LU FROM DCB WORD 1 (BITS 0-5) 
      DR.RD(READI,-DIS,0)?     \READ CARTRIDGE SPECIFICATION ENTRY
         [ER_54;RETURN]        !DISC NOT MOUNTED ERROR
      DIRTR_[LSTTR_[SECTR_@PK.DR+6]+1]+1   !-#DIR TRK,LAST TRK,SEC/TRK
      LOCK.(-DIS,3,LKER)?      \LOCK THE DISC 
         [MSS.(LKER);RETURN]   !PRINT LOCK ERROR AND RETURN 
      PUIT                     !CALL PURGE IN CASE ADDRESSES CHANGED
      TRK_$DCB2                !DIRECTORY TRACK 
      SEC_($T AND 17700K) >- 6 !SECTOR NUMBER 
      OFSET_(($T AND 160000K) -< 3)*16 !SECTOR OFFSET 
      TI,BLK_0                 !COMPUTE BLOCK #, START WITH ZERO
TEST: IF TI=SEC THEN GO TO FOUND !IF MATCH, FOUND BLOCK # 
      BLK_BLK+1                  !INCREMENT BLOCK # 
      TI_(TI+14)/$SECTR        !COMPUTE NEXT LOGICAL BLOCK ADDRESS
      TI_$1 
      GO TO TEST               !CHECK FOR A MATCH 
! 
FOUND:BLK_BLK+(($LSTTR-$DIRTR-1)-TRK)*($SECTR/2) !BLKTR FOR EACH DRTRK
      OFSET_OFSET+@PK.DR       !ADDRESS OF DIRECTORY ENTRY
      DR.RD(READI,-DIS,BLK)?   \READ BLOCK CONTAINING DIR ENTRY 
         [ER_54;RETURN]        !DISC NOT MOUNTED ERROR
      IF [T_$(OFSET+8)] THEN   \IF SECURITY CODE AND
         [IF T-N.OPL THEN      \IT DOESN'T MATCH, THEN
            [ER_-7;GOTO EXIT]] !RETURN -7 ERROR 
      $OFSET_ -1               !MARK ENTRY AS PURGED
      DR.RD(WRIT,-DIS,BLK)?    \WRITE BLOCK CONTAINING PURGED ENTRY 
         [ER_54;GO TO EXIT] 
! 
EXIT: LOCK.(-DIS,5)            !UNLOCK THE CARTRIDGE
      RETURN
      END 
! 
PUIT: SUBROUTINE DIRECT 
      PURGE(I.BUF,.E.R.,$BLK,N.OPL,$T) !(TRY TO) PURGE THE FILE 
      RETURN
      END 
      END 
      END$
                                                                                                                                                                        