.
. 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