ASMB,R,L,C
      HED (FMP) PURGE: PURGE A FILE 
*     NAME:   PURGE 
*     SOURCE: 92071-18051 
*     RELOC:  92071-16051 
*     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.       *
*  ***************************************************************
* 
      NAM PURGE,7 92071-1X051 REV.2041 800331 
* 
      ENT PURGE 
* 
      EXT CLOSE 
      EXT CLD.R, .P1, .P2, .P3, .P4, .P6, .P7, .R1
      EXT .ENTR 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     PURGE  IS THE FILE DELETION ROUTINE FOR THE RTE 
*     FILE MANAGEMENT PACKAGE 
* 
*     THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL PURGE(IDCB,IERR,NAME,ISECU,ICR)
* 
*     WHERE:
* 
*     IDCB   IS A DATA CONTROL BLOCK (144-WORD ARRAY) 
*            WHICH IS REQUIRED FOR UNIFORMITY WITH FMP ROUTINES.
*            IDCB IS CLOSED AND WILL BE AVAILABLE FOR OTHER USE 
*            AFTER A PURGE. 
* 
*     IERR   WILL BE THE ERROR RETURN CODE. 
* 
*     NAME   IS THE NAME OF THE FILE TO BE PURGED.
* 
*     ISECU  IS THE FILE'S SECURITY CODE. 
* 
*     ICR    IS THE DISC THAT THE FILE IS ON. 
*             IF ICR >0 THEN ON DISC LABELED ICR
*             IF ICR <0 THEN ON DISC AT LOGICAL UNIT (-ICR) 
* 
*     POSSIBLE ERRORS:
* 
*      0      NO ERRORS 
*     -10     NOT ENOUGH PARAMETERS 
      SKP 
* 
*     ENTRY 
* 
PURGE NOP 
      LDA DZERO 
      STA NAME
      STA ISECU 
      STA ICR 
      LDA PURGE 
      STA DURGE 
      JMP DURGE+1 
* 
IDCB  NOP 
IERR  NOP 
NAME  DEF ZERO
ISECU DEF ZERO
ICR   DEF ZERO
* 
DURGE NOP           ENTRY POINT 
      JSB .ENTR     DO ENTRY ROUTINE
      DEF IDCB
* 
      LDA NAME      GET LAST REQUIRED PARAMETER 
      CPA DZERO     IF NOT SUPPLIED,
      JMP ER10       THEN TAKE ERROR EXIT 
      SKP 
* 
*     PROCESS REQUEST 
* 
      JSB CLOSE     CLOSE THE DCB 
      DEF *+3 
      DEF IDCB,I
      DEF IERR,I    IGNORE ANY ERROR
* 
      LDA .11       SET FUNCTION CODE 
      STA .P1 
* 
      LDA ICR,I     SET CARTRIDGE REFERENCE NUMBER
      STA .P2 
* 
      LDA NAME,I    SET 2 CHARS OF NAME 
      STA .P3 
      ISZ NAME
      DLD NAME,I    SET 4 CHARS OF NAME 
      DST .P4 
* 
      LDA ISECU,I   SET SECURITY CODE 
      STA .P6 
* 
      CLA           SET SUBFUNCTION CODE
      STA .P7 
* 
      JSB CLD.R     CALL D.RTR
* 
      LDA .R1       GET ERROR CODE
* 
EREX  STA IERR,I    SET THE ERROR CODE
      JMP DURGE,I         AND EXIT
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
      JMP EREX
      SKP 
* 
*     STORAGE AREA
* 
ZERO  NOP 
* 
.11   DEC 11
* 
N10   DEC -10 
* 
DZERO DEF ZERO
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                