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