.
.         DELETE ELEMENT AND FILE COMMAND PROCESS
.
.
.         (C)  Copyright 1972-1978  John Walker
.
.         This software is in the public domain
.
          AXR$
          DEFUNCT$
          FANG
          procroutines
.
          PURE      CODE
.
DELETE*   R$DIT     .                   ENTER EDITING MODE
          LX        X9,CDBPC,X8         GET ELEMENT PARAMETER
          TZ        ELALL,X9            SIGNAL TO DELETE FILE ?
          J         FILDEL              YES.  GO AND DELETE THE FILE
          LX        X10,ELFDT,X9        GET THE FDT ADDRESS
          LA        A0,FDTYPE,X10       GET THE FILE TYPE
          JTAPE     A0,TAPDEL           ERROR IF DELETING ELEMENT ON TAPE
          LA,U      A9                  CLEAR ELEMENTS DELETED COUNTER
          LMJ       X6,GELT             READ IN FILE TABLE INDEX, ELEMENT TABLE
          J         BSPERR              ERROR FROM BSP.  PRINT MESSAGE
.
LOOKD     AA,U      A10,1               INCREMENT SEQUENCE NUMBER
          LA        A1,A10              LOAD SEQUENCE NUMBER
          LA        A0,A14              LOAD FCT ADDRESS
          etnl      .                   get next element from file
          J         ENDET               END OF TABLE.  FINISH UP
          TP        EIFLG,A0            IS ELEMENT DELETED ALREADY ?
          J         LOOKD               YES.  DON'T DO IT IN AGAIN
          LX,U      X6,,A0              SAVE ADDRESS OF SEARCH ITEM
          LX        X5,A12              GET PARAMETER ADDRESS
          LMJ       X11,SELECT          APPLY SELECTION CRITERIA
          J         LOOKD               NOT CHOSEN FOR DELETION
          AA,U      A9,1                INCREMENT ELEMENTS DELETED
          LA        A0,EITYP,X6         LOAD TYPE OF CHOSEN ELEMENT
          TG,U      A0,TY$SYM+1         IT IS A PROC ?
          TG,U      A0,TY$REL           PROC TYPE BETWEEN SYM AND REL
          J         $+2                 NO.  SIMPLY DELETE THE ELEMENT
          J         PROKDL              YES.  GO DELETE THE PROC ENTRIES
PRKDLN    BGET      EIL                 ALLOCATE AN ELEMENT ITEM BUFFER
          LA,U      A1,,A0              SAVE THE BUFFER ADDRESS
          LXI,U     A0,1                LOAD STORE INCREMENT
          LXI,U     X6,1                GET INCREMENT FOR SOURCE
          LR,U      R1,EIL              LOAD LENGTH TO MOVE
          BT        A0,,*X6             MOVE DATA TO ITEM BUFFER
          LX,U      X6,,A1              SAVE THE BUFFER ADDRESS
          LA        A0,A14              LOAD THE FTI ADDRESS
          etid      .                   DELETE ITEM FROM ELEMENT TABLE
          J         BSPERD              ERROR.  RELEASE ITEM AND ERROR
          BRELP     X6                  RELEASE THE ITEM
          TOP,U     A8,OPTION('T')      LIST DELETED ELEMENTS ?
          J         LOOKD               NO.  PROCESS NEXT ONE
          LA        A1,A10              GET ELEMENT SEQUENCE NUMBER
          LA        A0,A14              RELOAD BSP FCT ADDRESS
          etnl      .                   LOOK UP ELEMENT
          IERR      .                   AIN'T NO WAY THIS CAN HAPPEN
          LX,U      X9,,A0              LOAD THE TABLE ITEM
          LMJ       X5,TOCLE            EDIT THE TOC LINE
          J         LOOKD               PROCESS THE NEXT ELEMENT
.
ENDET     TE,U      A0,014              END OF TABLE STATUS ?
          J         BSPERR              NO.  BSP ERROR
          JZ        A9,NOELD            ANY ELEMENTS DELETED ?
          LA        A0,A14              LOAD FCT ADDRESS
          wpfet     .                   WRITE BACK ELEMENT TABLE
          J         BSPERR              ERROR.  LOG IT
          LA        A0,A14              RELOAD FCT ADDRESS
          wfti      .                   WRITE OUT FILE ITEM TABLE
          J         BSPERR              TAKE ERROR RETURN
          LMJ       A1,EBUFRL           RELEASE ELEMENT BUFFERS
          R$DITX    .                   END OF EDITING MODE
          COMPLETE  .                   TERMINATE THIS COMMAND
.
BSPERD    DS        A0,R6               SAVE THE ERROR STATUS
          BRELP     X6                  RELEASE THE ITEM SAVE BUFFER
          DL        A0,R6               RESTORE THE ERROR CODE
          J         BSPERR              ERROR OFF
.
.         DELETE PROC ENTRIES FOR PROCS BEING DELETED
.
PROKDL    LX,U      X5,,A0              SAVE ELEMENT TYPE
          BGET      1792                ALLOCATE A PROC TABLE
          SA        A0,R5               SAVE ADDRESS OF THE PROC TABLE
          DSL       A0,18               MOVE ADDRESS TO H1 OF A1
          LXM,U     A1,1792             GET LENGTH OF TABLE
          LA        A0,A14              LOAD FCT ADDRESS
          pircall   RPFxPT,x5           read in proper PROC table
          J         BSPERP              BSP ERROR WITH PROC BUFFER ALLOCATED
          LA,U      A6                  CLEAR PROC ENTRY SEQUENCE
          LA,U      A7                  CLEAR PROC ENTRIES DELETED
PRKLK     AA,U      A6,1                INCREMENT SEQUENCE NUMBER
          LA        A1,A6               LOAD SEQUENCE NUMBER
          LA        A0,A14              LOAD FCT ADDRESS
          pircall   xPTNL,x5            retrieve next PROC entry from table
          J         PRCTET              END OF PROC TABLE
          LA,H1     A1,2,A0             LOAD SEQUENCE NUMBER OF SOURCE ELEMENT
          TNE       A1,A10              IS IT FROM THE ELEMENT BEING DELETED ?
          J         DELPE               YES.  GO DELETE PROC ENTRY
          TG        A10,A1              FROM A HIGHER-SEQUENCE ELEMENT ?
          J         PRKLK               NO.  KEEP ON LOOKING
.
prpre     LA        A0,A14              LOAD THE FCT ADDRESS
          pircall   WPFxPT,x5           WRITE BACK THE PROC TABLE
          J         BSPERP              BSP ERROR IN PROC CODE
          BRELP     R5                  RELEASE THE PROC BUFFER
          J         PRKDLN              RETURN TO ELEMENT DELETE
.
PRCTET    TNE,U     A0,014              END OF TABLE STATUS ?
          J         PRPRE               YES.  WRITE OUT TABLE
BSPERP    DS        A0,R6               SAVE STATUS
BSPERY    BRELP     R5                  RELEASE PROC TABLE BUFFER
          DL        A0,R6               RELOAD STATUS
          J         BSPERR              EDIT BSP ERROR MESSAGE
.
DELPE     LA,U      A1,,A0              LOAD SEARCH ITEM ADDRESS
          LR,U      R1,4                LOAD ASSUMED LENGTH OF PROC ITEM
          LA,U      A0,,X5              LOAD CURRENT ELEMENT TYPE
          TE,U      A0,TY$COBP          COBOL PROC ?
          J         DELPEN              NO.  DON'T CONSIDER LONG LENGTH
          LA,H1     A0,3,A1             LOAD LENGTH FLAG
          TEP,U     A0,BIT(34-18)       IS 8 WORD FLAG SET ?
          LR,U      R1,8                YES.  THIS IS A LONG COBOL PROC
DELPEN    LA        A0,R1               LOAD LENGTH OF ENTRY
          BGET      .                   ALLOCATE A BUFFER
          LA,U      A2,,A0              SAVE THE BUFFER ADDRESS
          LXI,U     A2,1                LOAD THE INCREMENT
          LXI,U     A1,1                GET INCREMENT ON SOURCE FIELD
          BT        A2,,*A1             MOVE FOUND ITEM TO BUFFER
          LA,U      A1,,A0              LOAD THE SEARCH ITEM ADDRESS
          SA        A0,R8               SAVE IT FOR LATER RELEASE
          LA        A0,A14              GET FCT ADDRESS
          pircall   xPTID,x5            delete PROC from table
          J         BSPERX              BSP ERROR.  RELEASE BUFFER AND EIT
          BRELP     R8                  RELEASE THE SEARCH ITEM BUFFER
          J         PRKLK               LOOP TO PROC SCANNING LOOP
.
.         DELETE FILE IF FILE NAME ONLY SPECIFIED ON COMMAND
.
FILDEL    LX        X5,ELFDT,X9         LOAD ADDRESS OF FDT FOR FILE
          LA        A1,FDOPTS,X5        LOAD ASSIGN OPTIONS USED ON FILE
          LA,U      A0,FRECRD           GET @FREE CARD TO FREE TEMPORARY FILE
          TEP       A1,(BIT(34))        IS FILE ASSIGNED TEMPORARY ?
          J         DODEL               YES.  JUST FREE IT
          AND       A1,(OPTION('C','U')) IS FILE IN CATALOGUING STATE ?
          LA,U      A0,DELCRD           GET IMAGE TO FREE,D THE FILE
          JZ        A2,DODEL            IF FILE IS CATALOGUED ALREADY, DO FREE,D
          LA,U      A0,INHIBIT          IF FILE IS ASSIGNED WITH 'C' OR 'U',
.                                       DO A FREE,I TO INHIBIT CATALOGUING
DODEL     E$MSG     .                   COPY APPROPRIATE COMMAND IMAGE
          LMJ       X6,EFILE            EDIT FILE NAME INTO COMMAND
          LA,H2     A0,,X1              LOAD IMAGE BUFFER ADDRESS FOR RDIT$
          LMJ       X11,CSF             SUBMIT DYNAMIC COMMAND TO SYSTEM
          IERR      .                   SYNTAX ERROR, BALONEY !!
          LMJ       X5,CSFSTR           EDIT STATUS FOR CSF REQUEST
          LX        X5,ELFDT,X9         LOAD FDT FOR FILE JUST DELETED
          SZ        FDFRF,X5            FLAG NO FREE FOR DELETED FILE
          LA        A8,CDOPTS,X8        LOAD COMMAND OPTIONS
          TOP,U     A8,OPTION('T')      IS 'T' OPTION ON ?
          COMPLETE  .                   TERMINATE THIS COMMAND
          R$DIT     .                   FIRE UP EDITOR
          LX        X5,ELFDT,X9         LOAD FDT ADDRESS
          LMJ       X6,EFILE            EDIT FILE NAME
          E$FD4     (' DELETED ')       EDIT 'DELETED'
          LMJ       X11,IST             APPEND STATEMENT NUMBER AND PRINT
          COMPLETE  .                   COMPLETE THE COMMAND
.
BSPERX    DS        A0,R6               SAVE BSP ERROR STATUS
          BRELP     R8                  RELEASE THE SEARCH ITEM BUFFER
          J         BSPERY              EDIT BSP ERROR MESSAGE
.
.
TAPDEL    E$MSG     FILDM               COPY TAPE DELETE MESSAGE
          LA        A0,ELFDT,X9         LOAD FDT ADDRESS
          LMJ       X11,FIST            APPEND FILE AND STATEMENT
          ZAP       .                   DISABLE THE FILE
          COMPLETE  .                   COMPLETE THE COMMAND
.
.
NOELD     E$MSG     NOELM               EDIT MESSAGEE FOR NO ELEMENTS DELETED
          LA        A0,A12              LOAD ELEMENT PARAMETER ADDRESS
          LA        A0,ELFDT,A0         LINK TO THE FDT
          LMJ       X11,FIST            PRINT ERROR MESSAGE
          LMJ       A1,EBUFRL           RELEASE ELEMENT BUFFERS
          COMPLETE  .                   TERMINATE COMMAND
.
          PURE      DATA
FILDM     'CANNOT DELETE ELEMENTS FROM TAPE !'
NOELM     'NO ELEMENTS DELETED FROM !'
FRECRD    '@FREE !'                     TO 'DELETE' TEMPORARY FILE
DELCRD    '@FREE,D !'                   TO DELETE CATALOGUED FILE
INHIBIT   '@FREE,I !'                   TO INHIBIT CATALOGUING OF PENDING FILE
          END