ASMB,L,R,C
*     NAME:   PURGE 
*     SOURCE: 92070-18051 
*     RELOC:  92070-16051 
*     PGMR:   G.A.A.
*     MOD:    M.L.K.
* 
*  ***************************************************************
*  * (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.       *
*  ***************************************************************
* 
* 
      NAM PURGE,7  92070-1X051  REV.1941  790709
* 
      HED PURGE 
      ENT PURGE 
      EXT OPEN,.ENTR,CLOSE,$SWLU
* 
* 
      SUP 
* 
*  PURGE  IS THE FILE DELETION ROUTINE FOR THE RTE
*         FILE MANAGEMENT PACKAGE 
* 
*       THE FORTRAN CALLING SEQUENCE IS:
* 
*     CALL PURGE(IDCB,IERR,NAME,IS,ILU) 
* 
*  W H E R E: 
* 
*     IDCB          IS A 144-WORD DATA CONTROL BLOCK
*                   WHICH IS USED BY PURGE AS A 
*                   WORKING BUFFER.  IDCB IS FREE 
*                   FOR OTHER USE AFTER A PURGE.
* 
*     IERR          IS THE ERROR RETURN LOCATION. 
* 
*     NAME          IS THE NAME OF THE FILE TO BE PURGED. 
* 
*     IS            IS THE FILE'S SECURITY CODE.
* 
*     ILU           IS THE DISC THAT THE FILE IS ON.
*                     IF ILU >0 THEN ON DISC LABELED ILU
*                     IF ILU <0 THEN ON DISC AT LOGICAL UNIT (-ILU) 
* 
*       ERRORS RETURNED BY PURGE ARE: 
* 
*     CODE    REASON
*     0       NO ERRORS 
*     -1      DISC READ/WRITE ERROR 
*     -6      FILE (OR DISC) NOT FOUND
*     -7      ILLEGAL SECURITY CODE 
*     -8      FILE IS OPEN TO SOME OTHER PROGRAM
*     -10     NOT ENOUGH PARAMETERS 
*     -13     DISC LOCKED 
*     -16     ATTEMPT TO PURGE A TYPE 0 FILE
*     -37     ATTEMPT TO PURGE A TYPE 6 OR SWAP FILE
* 
* 
      SKP 
PURGE NOP 
      LDA DZERO 
      STA NAME
      STA SC
      STA LU
      LDA PURGE 
      STA DURGE 
      JMP DURGE+1 
* 
* 
DCB   NOP 
IERR  NOP 
NAME  DEF ZERO
SC    DEF ZERO
LU    DEF ZERO
      SPC 1 
DURGE NOP           ENTRY POINT 
      JSB .ENTR     DO ENTRY ROUTINE
      DEF DCB 
      LDA N10       NOT ENOUGH PRAM 
      LDB NAME      ERROR 
      CPB DZERO     ? 
      JMP EXIT      YES-EXIT
      CLA           CLEAR THE TRUNCATE WORD 
      STA LNG       AND 
      SPC 1 
      JSB OPEN      NO; GO
      DEF OPRTN      OPEN 
      DEF DCB,I       EXCLUSIVELY 
      DEF IERR,I       TO 
      DEF NAME,I        CALLER
DZERO DEF ZERO
      DEF SC,I      PASS THE SECURITY CODE
      DEF LU,I       AND THE DISC ID
OPRTN SSA           OPEN ERROR? 
      JMP EXIT       YES; EXIT
      SZA,RSS         NO; TYPE ZERO 
      JMP EX16         YES - ILLEGAL PURGE
      SPC 1 
      CPA .6        IS THIS A TYPE 6 FILE?
      JMP EX37      YES, ERROR, MAKE THEM USE THE PU CMND 
      SPC 1 
      LDA DCB,I     GET DIRECTORY ADDRESS 
      AND B77       ISOLATE DISC LU 
      CPA $SWLU     SWAP FILE ON THIS DISC? 
      RSS            YES, CHECK IF ITS THIS FILE
      JMP SECCD      NO, GO CHECK SECURITY CODE 
      LDA DCB       GET DCB ADDRESS 
      ADA .3        POINT TO TRACK ADDRESS
      LDB A,I       GET TRACK ADDRESS 
      CPB ATRAK,I   COMPARE TO SWAP FILE'S, SAME? 
      RSS            YES, BETTER CHECK SECTOR 
      JMP SECCD      NO, GO CHECK SECURITY CODE 
      INA           POINT TO SECTOR ADDRESS 
      LDB A,I       GET SECTOR ADDRESS
      CPB ASEC,I    SAME AS SWAP FILE'S?
      JMP EX37       YES, ERROR, CAN'T PURGE
* 
SECCD LDA DCB       GET ADDRESS 
      ADA .7         OF 
      LDB A,I         SECURITY
      SSB,RSS           IF MISMATCH 
      JMP EX7            GO SET ERROR EXIT
      SPC 1 
      ADA N2        ADDRESS OF FILE LENGTH
      LDA A,I       GET FILE LENGTH 
      ARS           SET TO BLOCK LENGTH 
      STA LNG       SET FOR TRUNCATE CODE 
      SPC 1 
CLOS  JSB CLOSE     CLOSE THE FILE AND TRUNCATE TO ZERO 
      DEF *+4        (I.E. PURGE IT)
      DEF DCB,I       FILE
      DEF LU           DUMMY ERROR RETURN 
      DEF LNG           TRUNCATE WORD ADDRESS 
      LDB IERR,I    GET CURRENT ERROR CODE
      SSB           IF NONE SKIP
      LDA B         ELSE USE IT 
EXIT  STA IERR,I    SET THE ERROR CODE
      JMP DURGE,I         AND EXIT
      SPC 2 
EX7   LDA .7        SET ERROR 
      CMA,INA,RSS    CODE AND SKIP
EX16  LDA N16 
      STA IERR,I    SET CODE IN USER AREA 
      JMP CLOS      GO CLOSE THE FILE 
EX37  LDA N37 
      STA IERR,I
      JMP CLOS
      SPC 3 
N2    DEC -2
N10   DEC -10 
.3    DEC 3 
.6    DEC 6 
.7    DEC 7 
N16   DEC -16 
N37   DEC -37 
B77   OCT 77
ATRAK DEF $SWLU+1 
ASEC  DEF $SWLU+2 
LNG   NOP 
ZERO  NOP 
A     EQU 0 
B     EQU 1 
      SPC 2 
END   EQU * 
      END 
                                                                                                                                                                                                            