.
.         ERASE COMMAND PROCESS
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          AXR$
          DEFUNCT$
          FANG
.
          PURE      CODE
.
MAXTRK    EQU       0177777/(28*64)     NUMBER OF TRACKS IN '64K'
RELLEN    EQU       MAXTRK*28*64        MAXIMUM RELEASE IN 64K ACW
.
ERASE*    LA        A0,CDBPC,X8         LINK TO PARAMETER
          LA        A14,CDOPTS,X8       LOAD OPTION BITS
          LX        X9,PBVAL,A0         GET FDT ADDRESS FOR THE FILE
          LA,U      A1,,X9              LOAD FDT ADDRESS IN A1
          LMJ       A2,IOGET            BUILD AN I/O FCT
          LX,U      X10,,A0             SAVE I/O FCT ADDRESS
          LA        A0,('SECRET')       LOAD SECRET DATA
          SA        A0,IOBB,X10         STORE IN MAKESHIFT I/O BUFFER
          LA,U      A0,IOBB,X10         GET BUFFER ADDRESS
          SA        A0,IOACW,X10        SET UP ACCESS WORD
          TNZ       IOMASS,X10          MASS STORAGE FILE ?
          J         TERASE              NO.  ERASE THE TAPE
          LA,U      A0,REL$             LOAD RELEASE SPACE FUNCTION
          SA        A0,IOFUNC,X10       PUT FUNCTION IN PACKET
          LA,U      A5                  CLEAR CURRENT ADDRESS
          LA        A3,FDHITRK,X9       LOAD HIGHEST TRACK REFERENCED
          TNZ       IOWAD,X10           WORD ADDRESSABLE FILE ?
          J         FFREL               NO.  RELEASE FASTRAND FORMAT FILE
          LA        A3,FDFLW,X9         LOAD LENGTH IN WORDS
          ANA,U     A3,1                DECREMENT LENGTH
          DSA       A3,36               SHIFT IT OVER
          DI,U      A3,1792             COMPUTE LENGTH IN TRACKS
FFREL     AA,U      A3,1                BUMP HIGHEST TRACK
          MSI,U     A3,1792             COMPUTE LENGTH IN WORDS
RELIOL    SA        A5,IODRAD,X10       STORE DRUM ADDRESS
          LA,U      A0,RELLEN           LOAD LENGTH TO RELEASE
          TG        A0,A3               MORE THAN IS LEFT ?
          LA        A0,A3               YES.  RELEASE THAT MUCH
          SA,H1     A0,IOACW,X10        PUT LENGTH IN ACCESS WORD
          ANA       A3,A0               COMPUTE LENGTH REMAINING
          TOP,U     A14,OPTION('W')     TOP SECRET ERASE ?
          J         RELIOW              NO.  JUST RELEASE SPACE
          LA,H1     A0,IOACW,X10        LOAD ACCESS LENGTH
          OR,U      A0,0200000          SET INHIBIT BIT
          SA,H1     A1,IOACW,X10        REPLACE ACCESS LENGTH
          LA,U      A0,W$               LOAD WRITE FUNCTION
          SA        A0,IOFUNC,X10       SET FUNCTION IN PACKET
          IOW$      IOPKT,X10           OVERWRITE THE DATA
          TZ        IOSTATUS,X10        CHECK I/O STATUS
          J         IOEREL              ERROR.  EDIT MESSAGE
          LA,U      A0,REL$             LOAD RELEASE FUNCTION
          SA        A0,IOFUNC,X10       REPLACE FUNCTION IN PACKET
          LA,H1     A0,IOACW,X10        LOAD ACCESS LENGTH
          AND,U     A0,-0200000         REMOVE INHIBIT BIT
          SA,H1     A1,IOACW,X10        REPLACE ACCESS LENGTH
RELIOW    IOW$      IOPKT,X10           RELEASE SOME SPACE
          TZ        IOSTATUS,X10        NORMAL COMPLETION ?
          J         IOEREL              NO.  I/O ERROR ON RELEASE
          JZ        A3,RELDUN           ALL SPACE RELEASED ?
          LA,H1     A0,IOACW,X10        LOAD ACCESS LENGTH
          TZ        IOWAD,X10           W.A.D. MODE ?
          J         WADRELB             YES.  ADD LENGTH IN WORDS
          DSL       A0,36               RIGHT JUSTIFY LENGTH
          DI,U      A0,28               COMPUTE NUMBER OF SECTORS
WADRELB   AA        A5,A0               INCREMENT FILE ADDRESS
          J         RELIOL              GO RELEASE MORE SPACE
.
TERASE    LA,U      A0,W$               LOAD WRITE FUNCTION
          SA        A0,IOFUNC,X10       PUT FUNCTION IN PACKET
          LA,U      A0,0200000+8000     GET 8000 WORD ACCESS WITH INHIBIT
          SA,H1     A0,IOACW,X10        SET UP FOR OBSCURATION
WRITEM    IOW$      IOPKT,X10           WRITE A BLOCK
          LA        A1,IOSTATUS,X10     LOAD STATUS
          JZ        A1,WRITEM           ZERO ?  WRITE ON !!
          TE,U      A1,2                FOUND END OF TAPE YET ?
          J         IOEREL              NO.  SOME OTHER ERROR
          LA,U      A0,REW$             LOAD REWIND FUNCTION
          TEP,U     A14,OPTION('I')     UNLESS 'I' OPTION IS ON...
          LA,U      A0,REWI$            ...CAUSING A REWIND WITH INTERLOCK
          SA        A0,IOFUNC,X10       SET UP FUNCTION
          IOW$      IOPKT,X10           REWIND THE TAPE
          TZ        IOSTATUS,X10        NORMAL COMPLETION ?
          J         IOEREL              NO.  EDIT MESSAGE
.
RELDUN    BRELP     X10                 RELEASE I/O FCT
          COMPLETE  .                   TERMINATE THIS COMMAND
.
IOEREL    LMJ       X11,IOSEDT          EDIT I/O STATUS MESSAGE
          ZAP       .                   ERROR THIS COMMAND
          J         RELDUN              TERMINATE COMMAND
          END