SPL,L,O,M 
!     NAME:   PU..
!     SOURCE: 92071-18028 
!     RELOC:  92071-16028 
!     PGMR:   G.A.A.
!     MOD:    M.L.K., E.D.B.
! 
!  ***************************************************************
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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) "92071-1X028 REV.2041 800728"
! 
!     PURGE FILE ROUTINE FOR THE RTE FILE MANAGER 
! 
!     ENTERED BY
! 
!     PU,NAMR1
!       OR
!     PU,NAMR2,MSC
! 
!     WHERE:
! 
!     NAMR1    IS A FILE NAMR NOT CONTAINING A WILDCARD SPECIFICATION.
! 
!     NAMR2    IS A FILE NAMR CONTAINING A WILDCARD SPECIFICATION.
! 
!              THE FOLLOWING SUBPARAMETERS MAY ALSO BE SPECIFIED
!              FOR BOTH NAMR1 AND NAMR2:
! 
!               CR  (OPTIONAL) IS THE CARTRIDGE ID. 
!               SC  (OPTIONAL) IS THE FILE SECURITY CODE. 
! 
!     MSC      (REQUIRED FOR WILDCARD PURGE) IS THE MASTER
!              SECURITY CODE
! 
!  EXTERNAL SUBROUTINES 
      LET FM.ER     BE SUBROUTINE,EXTERNAL
      LET MSS.      BE SUBROUTINE,EXTERNAL
      LET FSTAT     BE SUBROUTINE,EXTERNAL
      LET PURGE     BE SUBROUTINE,EXTERNAL
!  EXTERNAL FUNCTIONS 
      LET IFBRK     BE FUNCTION,EXTERNAL
      LET F.SET     BE FUNCTION,EXTERNAL
      LET F.GET     BE FUNCTION,EXTERNAL
      LET MSC.      BE FUNCTION,EXTERNAL
!  EXTERNAL VARIABLES 
      LET O.BUF     BE INTEGER,EXTERNAL 
      LET N.OPL     BE INTEGER,EXTERNAL 
      LET .E.R      BE INTEGER,EXTERNAL 
!  INTERNAL VARIABLES 
      LET DIS,ENTRY BE INTEGER
      LET FNAME(16) BE INTEGER
      LET D.SDR(124)BE INTEGER
      LET DFALT(3)  BE INTEGER
! 
      INITIALIZE DFALT TO "------"
! 
PU..: SUBROUTINE(N,LIS,ER) GLOBAL                !ENTRY POINT 
!*****IF LIS=0 THEN [MASK_ @DFALT; CRN_ @N.OPL+1]!THIS FORM NOT ALLOWED YET 
      IF LIS=0 THEN GOTO BADPM
!*****IF LIS=1 THEN [MASK_ @DFALT; CRN_ @LIS+1]  !THIS FORM NOT ALLOWED YET 
      IF LIS=1 THEN GOTO BADPM
      IF LIS=3 THEN [MASK_ @LIS+1; CRN_ @N.OPL+1] 
! 
      MSKFL_ F.SET($MASK,N.OPL)                  !SET UP FILE MASK
      CRN_ $CRN                                  ! AND DISC ID
! 
      IF MSKFL THEN GOTO MULTI                   !CHECK FOR MULTIPLE PURGE
! 
!     PURGE SINGLE FILE 
! 
      PURGE(O.BUF,ER,$MASK,N.OPL,CRN)            !PURGE THE FILE
      IF ER= -6 THEN ER_ -2006                   !FIX -6 ERROR
      IF ER= -7 THEN ER_ -2007                   !FIX -7 ERROR
      RETURN                                     !RETURN
! 
!     PURGE MULTIPLE FILES
! 
MULTI:IFNOT $[LIS4_ @LIS+4] THEN MSC_ 0,         \IF NO MSC GIVEN, CONTINUE 
      ELSE [                                     \
          IFNOT [MSC_ MSC.($LIS4)] THEN GOTO SCER] !IF BAD MSC GIVEN, ERR 
! 
      FOUND_ 0                                   !CLEAR FOUND FLAG
      FSTAT(D.SDR,124)                           !GET CARTRIDGE DIRECTORY 
      LUPT_ @D.SDR                               !SET POINTER 
! 
AGAIN:DIS_ [IF CRN THEN CRN, ELSE -$LUPT]        !GET DISC ID 
      IFNOT DIS THEN GOTO NFER                   !CHECK FOR END OF LIST 
      ENTRY_ 0                                   !START WITH FIRST ENTRY
! 
LOOP: IF IFBRK THEN RETURN                       !CHECK FOR BREAK 
      IF [T_F.GET(FNAME,DIS)] THEN GOTO ENDIR    !GET DIRECTORY ENTRY 
      IF FNAME(1)<0 THEN GOTO LOOP               !CHECK FOR CARTRIDGE ENTRY 
      IF FNAME(4) THEN [                         \CHECK FOR EXTENT ENTRY
          IF FNAME(6) AND 177400K THEN GOTO LOOP] ! 
! 
      FM.ER(1,FNAME,3)                           !PRINT FILE NAME 
      IF MSC THEN N.OPL_ FNAME(9)                !USE CORRECT SECOD 
 !
      PURGE(O.BUF,ER,FNAME,N.OPL,DIS)            !GO PURGE IT 
      FOUND_ -1                                  !SET FOUND FLAG
      IF ER= -6 THEN ER_ -2006                   !FIX -6 ERROR
      IF ER= -7 THEN ER_ -2007                   !FIX -7 ERROR
      IF ER<0   THEN MSS.(ER)                    !PRINT ERROR MESSAGE 
      GOTO LOOP                                  !AND DO NEXT FILE
! 
!     REACHED END OF A DIRECTORY
! 
ENDIR:IF T= -32 THEN GOTO CRNER                  !CHECK FOR MISSING CART
      IF FOUND THEN RETURN                       !CHECK FOR NORMAL END
      IFNOT CRN THEN [LUPT_ LUPT+4; GOTO AGAIN]  !TRY ANOTHER CARTRIDGE 
      GOTO NFER                                  !TAKE ERROR EXIT 
! 
!     ERROR EXITS 
! 
NFER: DO[ER_ -50; RETURN]                        !FILE NOT FOUND
SCER: DO[ER_ 51; RETURN]                         !BAD MASTER SECURITY CODE
BADPM:DO[ER_ 56; RETURN]                         !BAD PARAMETER 
CRNER:DO[ER_ -32; RETURN]                        !CARTRIDGE NOT FOUND 
! 
      END 
      END 
! 
      END$
                                                                  