SPL,L,O,M ! NAME: PU.. ! SOURCE: 92070-18028 ! RELOC: 92070-16028 ! PGMR: G.A.A. MOD. M.L.K. ! ! *************************************************************** ! * (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. * ! *************************************************************** ! ! NAME PU..(7) " 92070-1X028 REV.1941 790906" ! ! ! PURGE FILE ROUTINE FOR THE RTE FILE MANAGER ! ! ENTERED AFTER A: ! ! PU,NAMR ! ! W H E R E: ! ! NAMR IS THE FILE'S NAMR WHICH CAN CONTAIN: ! ! CR (OPTIONAL) IS THE CARTRIDGE ID. ! ! SC (OPTIONAL) IS THE FILE SECURITY CODE. ! ! ! EXTERNAL SUBROUTINES LET CLOSE BE SUBROUTINE,EXTERNAL LET EXEC BE SUBROUTINE,EXTERNAL LET IER. BE SUBROUTINE,EXTERNAL,DIRECT LET LOCK. BE SUBROUTINE,EXTERNAL LET MSS. BE SUBROUTINE,EXTERNAL LET OPEN BE SUBROUTINE,EXTERNAL LET PURGE BE SUBROUTINE,EXTERNAL ! EXTERNAL VARIBLES LET .E.R BE INTEGER,EXTERNAL LET %IDA BE INTEGER,EXTERNAL LET %IDNM BE INTEGER,EXTERNAL LET %IDSZ BE INTEGER,EXTERNAL LET %SWLU BE INTEGER,EXTERNAL LET O.BUF BE INTEGER,EXTERNAL LET N.OPL BE INTEGER,EXTERNAL ! INTERNAL SUBROUTINES LET PUIT BE SUBROUTINE,DIRECT ! INTERNAL CONSTANTS LET READI BE CONSTANT (1) LET WRIT BE CONSTANT (2) ! ! PU..: SUBROUTINE(NCAM,PLIST,ER) GLOBAL !ENTRY POINT ! LET ER BE INTEGER LET NCAM BE INTEGER LET PLIST BE INTEGER ! DCB8_[DCB7_[DCB5_[DCB4_[DCB3_[DCB1_[DCB0_@O.BUF]+1]+2]+1]+1]+2]+1 ! T_@N.OPL+1 BLK_ @PLIST+1 ! PUIT !GO PURGE IT ! LU _ $DCB0 AND 77K !SAVE LU OF DISC IF .E.R = -6 THEN .E.R_ -2006 !SET UNDEFINED ERROR IF .E.R = -16 THEN GOTO ZPURG !TYPE 0 PURGE IF .E.R = -37 THEN GOTO TYPE6 !TYPE 6 PURGE IER. RETURN ! ! PURGE TYPE 0 FILE ! ZPURG:LOCK.(-LU,3)?[RETURN] !SET LOCK ON DISC PUIT !FORCE CURRENT DIR. ADDRESS !TO BE SET INTO DCB0,1 ! DSLU_ LU + 7700K !PROTECTED DISC LU TR_(($DCB0 AND 177700K) -> 6) !ISOLATE TRACK SECT_$DCB1 AND 377K !SECTOR OFFSET_(($DCB1 AND 177400K) -> 8) !AND OFFSET OF DIR ENT ! EXEC(READI,DSLU,O.BUF,128,TR,SECT) !READ BLOCK HOLDING ENTRY IF $1 #128 THEN \ !MUST GET FULL BLOCK [MSS.(1,LU); RETURN ] $(DCB0+OFFSET)_-1 !SET THE ENTRY AS PURGED EXEC(WRIT,DSLU,O.BUF,128,TR,SECT) !WRITE IT BACK OUT ! O.BUF_0 !CLEAR FOR CLOSE LOCK.(-LU,5) !CLEAR THE LOCK RETURN ! ! PURGE TYPE 6 FILES ! TYPE6:OPEN(O.BUF,ER,$BLK,0,N.OPL,$T) !OPEN EXCLUSIVELY IF ER < 0 THEN RETURN, ELSE ER_ 0 !IF OPEN ERROR, RETURN IF $DCB7 >= 0 THEN[ \IF SECURITY CODES DON'T ER_ -7; \MATCH, SET ERROR -7 RETURN] !AND RETURN TRAK_ $DCB3 !SET UP TRACK IF LU = $%SWLU THEN[ \SAME AS SWAP LU? IF TRAK = $(%SWLU+1) THEN[ \SAME AS SWAP TRACK? IF $DCB4 = $(%SWLU+2) THEN GOTO ER38]] ! SAME SECT, ERROR! IF [SECT_ $DCB4+2] = $DCB8 THEN[ \SET & INCREMENT SECTOR TRAK_ TRAK+1; \IF TRACK OVERFLOW, INCREMENT SECT_ 0] !AND SET SECTOR TO 0 ! IDPTR_ $%IDA + 27 - $%IDSZ !SET POINTER TO ID SEGMENTS FOR I_1 TO $%IDNM DO[ \SCAN ID SEGMENTS IDPTR_ IDPTR + $%IDSZ; \POINT TO NEXT ID IFNOT $(IDPTR-15) THEN GOTO NDLP; \IF ID DORMANT, SKIP IF ($IDPTR AND 377K)= LU THEN[ \LU'S MATCH? IF $(IDPTR-1)= TRAK THEN[ \TRACKS MATCH? SEK_ ($(IDPTR-2) AND 377K) <- 1; \GET LOGCL SECTOR FROM ID IF SEK = SECT THEN[ \SECTORS MATCH? ER38: MSS.(38); \ERROR, ITS ACTIVE! RETURN]]];NDLP:] !EXIT CLOSE(O.BUF,.E.R,($DCB5)/2) !CLOSE AND TRUNCATE RETURN END ! ! PUIT:SUBROUTINE DIRECT PURGE(O.BUF,.E.R,$BLK,N.OPL,$T) RETURN END END END$