SPL,L,O,M,C 
!     NAME:   PU..  
!     SOURCE: 92064-18159 
!     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 PU..(7) " 92064-16055  REV.1650  760923" 
! 
! 
!     PURGE FILE ROUTINE FOR THE RTE FILE MANAGER 
! 
!     ENTERED AFTER A:
! 
!     PU,NAMR 
! 
!     W H E R E:
! 
!     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 ,IDCB1,N.OPL,PK.DR      BE INTEGER,EXTERNAL
! 
      LET      LOCK.,PURGE,EXEC,MSS. \
                                BE SUBROUTINE,EXTERNAL
      LET IER.                  BE SUBROUTINE,EXTERNAL,DIRECT 
      LET FM.AB                 BE LABEL,EXTERNAL 
! 
! 
      LET PUIT                 BE SUBROUTINE,DIRECT 
      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                             !GO PURGE IT 
! 
! 
      IF .E.R  = -16 THEN GO TO ZPURG 
! 
      IER.
      RETURN
! 
ZPURG:DCB2_[DCB1_@IDCB1]+1             !SET UP DIRECTORY ADDRESS WORDS
! 
      LU_$DCB1 AND 77K                 !SAVE LU OF DISK 
      LOCK.(-LU,3)                     !SET LOCK ON DISK
      PUIT                             !FORCE CURRENT DIR. ADDRESS
                                       !TO BE SET INTO DCB1&2 
! 
      TR_(($DCB1 AND 177700K) -> 6)    !ISOLATE TRACK 
      SECT_$DCB2 AND 377K              !    SECTOR
      OFFSET_(($DCB2 AND 177400K) -> 8) !       AND OFFSET OF DIR ENT 
! 
! 
      EXEC(READI,LU,IDCB1,128,TR,SECT) !READ BLOCK HOLDING ENTRY
      IF $1 #128 THEN \                !MUST GET FULL BLOCK 
          [MSS.(1,LU);GOTO FM.AB] 
      $(DCB1+OFFSET)_-1                !SET THE ENTRY AS PURGED 
      EXEC(WRIT,LU,IDCB1,128,TR,SECT)  !WRITE IT BACK OUT 
! 
      IDCB1_0                          !CLEAR FOR CLOSE 
      LOCK.(-LU,5)                     !CLEAR THE LOCK
      RETURN
      END 
! 
! 
PUIT:SUBROUTINE DIRECT
     PURGE(IDCB1,.E.R,$BLK,N.OPL,$T)
     RETURN 
     END
      END 
      END$
                                                                  