ASMB,R,L,C HED PURGE * NAME: PURGE * SOURCE: 92067-18128 * RELOC: 92067-16125 * PGMR: G.A.A. * * *************************************************************** * * (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 92067-16125 REV.2001 790924 ENT PURGE EXT .ENTR, OPEN, ECLOS, EXEC EXT SESSN, ISMVE, OVRD., $SMID * 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 (OPTIONAL) IS THE FILE'S SECURITY CODE. * * ILU (OPTIONAL) 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: * * FROM D.RTR * -1 DISC READ/WRITE ERROR * -6 FILE NOT FOUND * -8 FILE IS OPEN TO SOME OTHER PROGRAM * -13 DISC LOCKED * -19 ILLEGAL ACCESS ON SYSTEM DISC * -32 DISC NOT FOUND * * FROM PURGE * -7 ILLEGAL SECURITY CODE * -10 NOT ENOUGH PARAMETERS * -16 ATTEMPT TO PURGE A TYPE 0 FILE SKP DCB NOP IERR NOP NAME DEF ZERO SC DEF ZERO LU DEF ZERO * PURGE NOP ENTRY POINT JSB .ENTR FETCH INCOMING DEF DCB PARAMETERS LDA N10 ENOUGH LDB NAME PARAMETERS CPB DZERO SUPPLIED? JMP EXIT NO - ERROR EXIT CLA CLEAR THE TRUNCATE CLB DOUBLE WORD DST LNG * * OPEN FILE EXCULSIVELY * JSB OPEN DEF OPRTN OPEN FILE DEF DCB,I EXCLUSIVELY DEF IERR,I TO DEF NAME,I CALLER DZERO DEF ZERO DEF SC,I SECURITY CODE DEF LU,I DISC ID OPRTN SSA OPEN ERROR? JMP EXIT YES - ERROR EXIT SZA,RSS TYPE ZERO? JMP EX16 YES - ILLEGAL PURGE CPA .6 TYPE 6 FILE? RSS YES - DO SPECIAL CHECK TO ALLOW PURGE JMP PRG0 NOPE - CONTINUE NORMAL PURGE * * IF A SESSION CALLER, ALLOW PURGE OF TYPE 6 FROM LU 2 OR 3 * IF CALLER IS ONE WHO SP'ED IT. WORD 39 OF RECORD 1 CONTAINS * PRIVATE ID OF CALLER WHO SP'ED THIS PROGRAM * JSB SESSN SEE IF IN SESSION DEF *+2 DEF XEQT * SEZ IN SESSION? JMP PRG0 NO - WILL BE ABLE TO PRG ANY TYPE 6 FILE STB BUF SAVE SESSION ID JSB ISMVE READ USER ID FROM SCB DEF *+5 DEF BUF SESSION ID DEF $SMID OFFSET DEF ID PUT ID HERE DEF .1 GET ONLY 1 WORD * LDB DCB GET ADDRESS OF DCB LDA B,I AND 1ST WORD OF DCB AND B77 MASK TO LU AND ADA PRC ADD IN SPECIAL FUNCTION BITS STA DLU AND SAVE FOR EXEC CALL ADB .3 POSITION TO TRACK WORD LDA B,I AND GET IT STA TRACK SAVE FOR EXEC CALL INB INCREMENT POINTER TO 2ND WORD OF DCB LDA B,I GET SECTOR FROM DCB STA SECT AND SAVE FOR EXEC CALL * JSB EXEC READ 39 WORDS OF 1ST RECORD DEF *+7 OF THE TYPE 6 FILE INTO BUF DEF .1 DEF DLU DEF BUF DEF .39 DEF TRACK DEF SECT * LDA N1 PRESET IN CASE OF ERROR CPB .39 CHECK TRANSMISSION LOG RSS OK JMP EXIT ERROR EXIT * LDA ABUF GET ADDRESS OF BUFFER ADA .38 POSITION TO 39TH WORD LDA A,I THIS SHOULD BE THE ID WORD AND B7777 MASK TO LOWER 12 BITS CPA ID SAME AS CALLERS? RSS YES - LET HIM PURGE IT JMP PRG0 NO - GO AHEAD BECAUSE WILL GET KICKED OUT * WITH SECURITY CHECKS LDA OVRD. SET OVERIDE TO ALLOW OPEN ON LU 2 WITH STA BUF WRITE ACCESS - KEEP ORIG TO RESET LATER IOR BIT14 SET BIT 14 - P,G,S - IF NOT ALREADY SET STA OVRD. AND REPLACE JSB OPEN DEF OPRN1 REOPEN WITH OVERRIDE SET DEF DCB,I DEF IERR,I DEF NAME,I DEF ZERO DEF SC,I DEF LU,I OPRN1 SSA ERRORS?? JMP EXIT YES - ERROR EXIT LDA BUF REPLACE OVRD. THE STA OVRD. WAY IT WAS BEFORE * * NORMAL PURGE OPERATION. CHECK SECURITY AND SET UP TO * CLOSE AND TRUNCATE ENTIRE FILE SIZE. * PRG0 LDA DCB GET ADDRESS OF ADA .7 SECURITY BITS LDB A,I FROM DCB SSB,RSS SECURITY BIT SET? JMP EX7 NO - BAD SECURITY OR ON 2 OR 3 - ERROR EXIT * ADA N2 POSITION TO ADDRESS OF FILE SIZE CLB CLEAR B IN CASE SIZE ALREADY IN SECTORS LDA A,I GET FILE SIZE SSA,RSS IN +SECTORS OR -"128 QUANTITY"? JMP PRG1 +SECTORS CMA,INA -"128 QUANTITY" - MAKE POSITIVE LSL 8 MULT BY "128 QUANTITY" TO GET SECTORS PRG1 LSR 1 DIVIDE BY 2 TO GET BLOCKS SWP GET HIGH ORDER BITS TO A-REG DST LNG AND SAVE FOR TRUNCATE * CLOS JSB ECLOS CLOSE THE FILE AND TRUNCATE TO ZERO SIZE 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 LDB DZERO RESET STB NAME THE STB SC INCOMING STB LU PARAMETERS JMP PURGE,I AND EXIT * * 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 * * * N1 DEC -1 N2 DEC -2 N10 DEC -10 N16 DEC -16 .1 DEC 1 .3 DEC 3 .6 DEC 6 .7 DEC 7 .38 DEC 38 .39 DEC 39 B77 OCT 77 B7777 OCT 7777 BIT14 OCT 40000 PRC OCT 74000 LNG BSS 2 ID NOP TRACK NOP SECT NOP DLU NOP ZERO NOP BUF BSS 39 ABUF DEF BUF * * XEQT EQU 1717B A EQU 0 B EQU 1 * * END EQU * END