Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/delfil.mac
There are 4 other files named delfil.mac in the archive. Click here to see a list.
TITLE	DELFIL - VARIOUS FUNCTIONS ON FILES WITH ERRORS V3A(4)



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986.
;ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

VDELFL==3
VEDIT==1
VEDIT==2	;FIX BUG INTRODUCED BY MCO 11396 9-13-84
VEDIT==3	;FIX COPYRIGHTS
VEDIT==4	;FINISH EDIT 2 12-13-85
VMINOR==1
VWHO==0

	SEARCH	UUOSYM

INTERN	.JBVER
.JBVER==137
	LOC	.JBVER
	BYTE	(3)VWHO(9)VDELFL(6)VMINOR(18)VEDIT
	RELOC

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1971,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO

D:

;PARAMETERS FROM COMMOD

RIBPPN==1	;DIRECTORY NAME
RIBNAM==2	;FILE NAME
RIBEXT==3	;(LH) EXT
RIBACD==3	;(RH) ACCESS DATE
RIBERR==3	;(RH) ERROR CODE IF FAILS
RIBPRV==4	;ACCESS PRIVILEGES (BITS 0-8)
RIBMOD==4	;MOD (BITS 9-12)
RIBCTM==4	;CREATION TIME (BITS 13-23)
RIBCDT==4	;CREATION DATE (BITS 24-35)
RIBSIZ==5	;WORDS WRITTEN
RIBVER==6	;VERSION NUMBER
RIBEST==10	;ESTIMATED LENGTH IN CORE AND NUMBER OF BLOCKS
RIBALC==11	;BLOCKS ALLOCATED INCLUDING BOTH RIBS
RIBPOS==12	;LOGICAL BLOCK WITHIN STR OF LAST ALLOCATION
RIBNCA==14	;NONPRIVILEGED CUSTOMER ARG
RIBMTA==15	;TAPE LABEL
RIBDEV==16	;STR FILE STARTS ON
RIBSTS==17	;STATUS BITS
RIBELB==20	;LOGICAL BLOCK WITHIN ERROR IN WHICH ERROR BEGINS
RIBEUN==21	;(LH) LOGICAL UNIT IN STR ERROR OCCURRED ON
RIBNBB==21	;(RH) CONSECUTIVE BAD BLOCKS
RIBQTF==22	;(UFD ONLY) FIRST COME FIRST SERVED QUOTA
RIBQTO==23	;(UFD ONLY) LOGGED OUT QUOTA
RIBQTR==24	;(UFD ONLY) RESERVED QUOTA
RIBUSD==25	;(UFD ONLY) BLOCKS USED
RIBAUT==26	;AUTHOR (PPN)
RIBNXT==27	;NEXT STR IF FILE IS CONTINUED
RIBPRD==30	;PREVIOUS FILE IF CONTINUED
RIBPCA==31	;PRIVILEGED CUSTOMER ARG
RIBUFD==32	;LOGICAL BLOCK OF UFD DATA BLOCK CONTAINING ENTRY FOR THIS FILE

RIBENT==32	;LAST ENTRY
RIBEND==RIBSTS	;LAST ENTRY WE CARE ABOUT

RIPDIR==400000	;DIRECTORY BIT IN RH STATUS WORD
RIPLOG==400000	;JOB IS LOGGED IN


ERRRIB==6	;RIB ERROR ON LOOKUP
ERRPRT==2	;PROTECTION ERROR
;ACCUMULATORS
T=1
T1=T+1
T2=T1+1
T3=T2+1
T4=T3+1
T5=T4+1
SFD=7
F=15
S=16
P=17

;BITS IN F
SWITCH==1
CHAR==2
SUP==4
DSKNAM==10


;IO CHANNELS
TTY==1
DSK==2
UFD==3

;STUFF
OUTSTR==3		;TTCALL OUT STRING FUNCTION
SFDLVL==5		;MAX NUMBER OF NESTED SFD'S

;GETTAB ARGUMENTS
PRJPRG==2
NSWTBL==12
HIGHJB==20
PATH.==110

LF==12

	DEFINE MSG (A)<
	XLIST
	MOVE	T5,[POINT 7,[ASCIZ \A\]]
	PUSHJ	P,PRINT
	LIST
>
DELFIL:	RESET
	INIT	TTY,
	SIXBIT	/TTY/
	XWD	OBUF,IBUF
	EXIT
	MOVE	P,PDL
	OPEN	PHYDSK		;OPEN PHYSICAL DEV DSK
	  JRST	NODSK
	MOVSI	MFDBLK
	BLT	3
	LOOKUP			;LOOKUP THE MFD
	  JRST	NOMFD		;WHAT??????
	MOVSI	MFDBLK
	BLT	3		;ATTEMPT TO UPDATE MFD
	ENTER
	  SKIPA	F,[XWD 400000,0] ;CANT UPDATE - EITHER HAS NO UPDATE OF
				; A UFD HACK OR NOT 1,2
	SETZ	F,		;ALLOWED TO UPDATE UFD'S
	RESET			;BUT I DONT REALLY WANT TO UPDATE MFD
	MOVE	P,PDL		;SET UP PD LIST
	INIT	TTY,
	SIXBIT	/TTY/
	XWD	OBUF,IBUF
	EXIT
	SETOM	LOOKBF
	MOVE	T,[XWD 3,LOOKBF]
	CALLI	T,PATH.
	  SKIPA	SFD,LOOKBF	;NO SFD'S IN MONITOR
	SETZ	SFD,		;MONITOR HAS SFD'S
	MSG	<FOR HELP TYPE /H>
DELF2:	MSG	<
*>
	SETZM	CLEANW
	SETZM	ERRWRD
	OUTPUT	TTY,
	SETZM	LOOKBF		;CLEAR THE BUFFER
	MOVE	T,[XWD LOOKBF,LOOKBF+1]
	BLT	T,SFDNAM+SFDLVL
	PUSHJ	P,GETNAM	;GET NAME OF FILE TO BE DELETED
	  JRST	DELF2		;NOT QUITE, TRY AGAIN
	TLNN	F,CHAR		;ANYTHING TYPED AT ALL?
	JRST	DELF2		;JUST CR-LF, TRY AGAIN
	TLNN	F,SWITCH	;SWITCH TYPED?
	JRST	QUEST		;NO
	MOVE	T,[XWD 1,1]
	HLRZ	T1,EXT		;IF EXTENSION=UFD
	CAIN	T1,'UFD'
	SKIPE	PPN		;AND NO PRJ,PRG GIVEN
	SKIPA	T,PPN
	MOVEM	T,PPN		;MAKE PRJ,PRG= 1,1
	SKIPG	SFD		;DEFAULT PPN IF AN SFD
	MOVE	T,FILE		;UFD - FILE NAME IS PPN
	MOVEM	T,DFTPPN
	SKIPN	CLEANW		;IF /C OR /R
	JRST	DELF3
	SKIPE	T1,STRNAM	;GET DEV
	CAMN	T1,[SIXBIT /DSK/] ;DEVICE="DSK"?
	TDZA	T1,T1		;YES, DO ALL STR'S
	JRST	DELF3		;NO, DO ONLY SPECIFIED STR'S
	SYSSTR	T1,		;GET 1ST STR IN SYSTEM
	  JRST	QUEST		;OOPS
	MOVEM	T1,STRNAM	;SAVE STR NAME
	HRRZS	CLEANW		;SET CLEANW >0 AS A SWITCH
DELF3:	SKIPN	T1,STRNAM	;STR GIVEN?
	MOVSI	T1,'DSK'	;NO, USE DSK
	MOVEM	T1,STRNAM	;SAVE NAME
	MOVEI	T,17		;INIT DSK IN DUMP MODE
	SETZ	T2,
	OPEN	DSK,T
	  JRST	QUEST		;OOPS THERE
	SETZM	LFAIL		;NO, CLEAR BAD-FLAG
	MOVEI	T,SFDBLK
	SKIPLE	SFD
	EXCH	T,PPN		;IF THERE WERE SFD'S TYPED, 
	CAIE	T,SFDBLK
	MOVEM	T,SFDPPN	;DO A PATH-TYPE LOOKUP
	LOOKUP	DSK,LOOKBF	;DO THE LOOKUP
	  SETOM	LFAIL		;IT DIDN'T WIN
	TLNE	F,SUP		;WANT THE FILE DELETED BY HAND?
	JRST	TRYHNS		;YES, GO DO SO
	SKIPE	ERRWRD
	JRST	.+3
	SKIPE	CLEANW
	JRST	GOCLEN
	MOVE	T,LOOKBF+RIBSTS	;STATUS OF FILE
	TRNE	T,RIPDIR	;DIRECTORY?
	JRST	DELUFD		;YES, DELETE ALL FILES IN IT FIRST
	SKIPE	ERRWRD
	JRST	DELF5
DELF4:	SKIPE	LFAIL		;IF WE DIDN'T WIN ON THE LOOKUP
	JRST	TRYHND		;DO IT BY HAND
	RENAME	DSK,RENBLK	;DELETE THE FILE REGULARLY
	  JRST	RENERR		;LOST!
	MSG	<DELETED>	;WON - INDICATE SO
	JRST	DELF2		;SEE IF HE WANTS MORE
DELF5:	MSG	<MUST BE A DIRECTORY FOR /R>
	JRST	DELF2

RENERR:	HRRZ	T,RENBLK+1
	CAIE	T,ERRPRT	;PROTECTION ERR?
	JRST	RENER1		;NO
	MSG	<PROTECTION ERROR ON RENAME. ARE YOU [1,2]?>
	JRST	DELF2
RENER1:	MSG	<RENAME FAILED, ERROR CODE: >
	PUSHJ	P,OCTPRT
	JRST	DELF2

NODSK:	MSG	<CAN'T OPEN DSK!>
	EXIT

NOMFD:	MSG	<LOOKUP OF MFD FAILED!>
	EXIT

QUEST:	MSG	<?>
	JRST	DELF2
;HERE WHEN THE LOOKUP FAILED - DO IT THE HARD WAY
TRYHND:	HRRZ	T,LOOKBF+RIBERR;ERROR CODE
	CAIE	T,ERRRIB	;RIB ERROR?
	JRST	LOOKER		;NO, DONT DELETE
TRYHNS:	MOVE	S,STRNAM
	CAME	S,['DSK   ']	;"DSK" SPECIFIED?
	JRST	TRYHN1		;NO, DO ONLY THE GIVEN STR
	TLO	F,DSKNAM	;YES, INDICATE GENERIC DSK
	SETO	S,		;S WILL HAVE STR NAME
TRYHN0:	MOVEI	T,S
	TLNE	F,DSKNAM	;DONT DO OTHER STRS IF NOT "DSK"
	JOBSTR	T,		;NEXT STR
	  JRST	CANTFN
	JUMPE	S,CANTFN
TRYHN1:	MOVEM	S,T1		;INTO T1
	MOVEI	T,17		;INIT IN DUMP MODE
	SETZ	T2,
	OPEN	DSK,T
	  JRST	QUEST
	JUMPLE	SFD,TRYHN2
	MOVE	T,SFDNAM-1(SFD)
	MOVSI	T1,(SIXBIT .SFD.)
	MOVE	T3,[SFDBLK,,PTHBLK]
	BLT	T3,PTHNM1-2(SFD) ;COPY ALL BUT LAST SFD
	SETZM	PTHNM1-1(SFD)	;NAME INTO PATH BLOCK
	MOVEI	T3,PTHBLK
	JRST	TRYHN3
TRYHN2:	MOVE	T,PPN
	MOVSI	T1,'UFD'
	MOVE	T3,[XWD 1,1]
TRYHN3:	LOOKUP	DSK,T		;FIND THE DIRECTORY
	  JRST	TRYHN0		;LOST
	JUMPL	F,TRYHN4	;WON. DONT TRY TO UPDATE IF CANT
	MOVE	T3,[XWD 1,1]	;SET FOR UPDATE-ENTER
	HLLZS	T1
	SETZ	T2,
	ENTER	DSK,T
	  JRST	CANTWT		;CANT WRITE IN THE UFD
TRYHN4:	HLLZS	EXT		;WON
	MOVEI	T3,1		;T3 COUNTS BLOCKS IN THE UFD
TRYHN5:	INPUT	DSK,IOW		;GET A UFD BLOCK
	STATZ	DSK,760000	;OK?
	JRST	TRYHN0		 ;NO - ERROR 
	MOVE	T,FILE		;YES. SEARCH FOR FILE NAME
	MOVE	T1,IOW
TRYHN6:	CAME	T,1(T1)
	JRST	TRYHN7
	HLLZ	T2,2(T1)	;NAMES MATCH, TRY EXTENSION
	CAMN	T2,EXT
	JRST	FNDHND		;FOUND THE GUY TO WIPE OUT
TRYHN7:	AOBJN	T1,.+1
	AOBJN	T1,TRYHN6	;TRY NEXT ENTRY IN UFD
	AOJA	T3,TRYHN5	;TRY NEXT BLOCK IN UFD
CANTFN:	MSG	<CAN'T FIND FILE IN DIRECTORY>
	JRST	DELF2		;TRY NEXT COMMAND



;HERE WHEN WE FOUND THE FILE NAME IN SPECIFIED DIRECTORY
FNDHND:	PUSH	P,T1		;SAVE IOWD
	PUSHJ	P,PHYSBN	;CONVERT T3 TO PHYS BLOCK NUMBER
	 JRST	CNTWT		;ERROR
	POP	P,T1		;RESTORE IOWD
	HRLI	T,3(T1)		;SET TO BLT OVER THE NAME
	HRRI	T,1(T1)
	BLT	T,DBUF+175	;WIPE OUT THE ENTRY IN UFD
	SETZM	DBUF+176	;CLEAR LAST SLOT
	SETZM	DBUF+177
	SKIPGE	F		;IF CANT UPDATE UFD,
	USETO	DSK,T3		; DO A SUPER USETO
	SKIPL	F		;IF CAN UPDATE UFD,
	USETO	DSK,(T3)	;SET TO WRITE THE BLOCK
	OUTPUT	DSK,IOW		;ZAP
	STATZ	DSK,740000	;DID WE WIN?
	JRST	CANTWT		;NO, GIVE AN ERROR
	MSG	<DELETED>
	LOOKUP	DSK,LOOKBF	;MAKE SURE THE NMB CFP GETS ZEROED
	  JFCL			;SHOULD GET FILE-NOT FOUND
	JRST	DELF2


LOOKER:	MSG	< LOOKUP FAILURE: >
	PUSHJ	P,OCTPRT
	JRST	DELF2

CNTWT1:	POP	P,T5
CNTWT:	POP	P,T1
CANTWT:	MSG	<CAN'T WRITE IN THE UFD. ARE YOU [1,2]?>
	JRST	DELF2
;ROUTINE TO CONVERT T3 FROM A RELATIVE BLOCK NUMBER (RELATIVE TO FILE)
;INTO A PHYSICAL BLOCK NUMBER (RELATIVE TO UNIT)
PHYSBN:	JUMPGE	F,CPOPJ1	;NO-OP IF UPDATE
	USETI	DSK,0		;READ THE RIB
	IN	DSK,RIOW
	 TDZA	T5,T5		;RIB IS BLOCK 0
	POPJ	P,
	CLOSE	DSK,		;SWITCH TO SUPER I/O
	USETI	DSK,[1]		;READ THE HOME BLOCK
	IN	DSK,HIOW
	 SKIPA	T1,CCBP		;BP TO CC
	POPJ	P,
	TLZ	T1,77
	HRRI	T1,T1
	MOVEM	T1,CCBP
	MOVE	T1,CABP		;BP TO CA
	TLZ	T1,77
	HRRI	T1,T1
	MOVEM	T1,CABP
	MOVE	T2,RBUF		;AOBJN POINTER TO RTP'S
PHYSB1:	SKIPN	T1,RBUF(T2)	;GET AN RTP
	POPJ	P,		;EOF
	LDB	T4,CCBP		;CLUSTER COUNT
	JUMPN	T4,PHYSB2	;GO IF GROUP POINTER
	ANDI	T1,77		;UNIT POINTER
	MOVEM	T1,UNUM
	JRST	PHYSB3
PHYSB2:	IMUL	T4,BPC		;CONVERT TO BLOCKS
	ADD	T5,T4		;REL BN OF 1ST BLOCK IN NEXT GROUP
	CAMGE	T3,T5		;TOO FAR?
	JRST	PHYSB4		;YES
PHYSB3:	AOBJN	T2,PHYSB1	;GET NEXT RTP
	POPJ	P,		;THERE'S NO SUCH THING AS AN EXTENDED DIRECTORY
PHYSB4:	SUB	T5,T4		;BACK UP TO 1ST BLOCK IN THIS GROUP
	SUB	T3,T5		;OFFSET RELATIVE TO THIS GROUP
	LDB	T2,CABP		;CLUSTER ADDR
	IMUL	T2,BPC		;CONVERT TO BLOCKS
	ADD	T3,T2		;TARGET BN
	MOVE	T1,UNUM		;UNIT NUMBER
	SETZ	T2,		;MAKE IT SIXBIT
	LSHC	T1,-3
	ADDI	T2,'0'/10
	ROT	T2,-3
	JUMPE	T1,PHYSB5
	ADDI	T1,'0'
	LSHC	T1,-6
PHYSB5:	MOVEI	T1,DSK		;GET STR NAME
	MOVEM	T1,HBUF+.DCNAM	;CAN'T USE HOME BLOCK, MIGHT BE ALIAS
	MOVE	T1,[XWD .DCSNM+1,HBUF]
	DSKCHR	T1,
	 POPJ	P,
	MOVE	T1,HBUF+.DCSNM	;BUILD LOGICAL UNIT NAME
PHYSB6:	LSH	T1,-6
	TRNN	T1,77
	JRST	PHYSB6
PHYSB7:	LSHC	T1,6
	TLNN	T1,770000
	JRST	PHYSB7
	MOVEM	T1,DEV+.OPDEV
	OPEN	DSK,DEV		;OPEN THE TARGET UNIT
	 POPJ	P,
	USETI	DSK,T3		;READ THE TARGET BLOCK
	IN	DSK,HIOW
	 CAIA
	POPJ	P,
	MOVEI	T1,177		;COMPARE
PHYSB8:	MOVE	T2,DBUF(T1)
	CAME	T2,HBUF(T1)
	POPJ	P,
	SOJGE	T1,PHYSB8
	JRST	CPOPJ1		;WIN
UFDNG:	MSG	< BUT THE DIRECTORY ITSELF HAS A RIB ERROR!>
	EXIT


;HERE TO DELETE ALL THE FILES IN THE UFD
DELUFD:	SKIPE	LFAIL		;IF A LOOKUP ERROR
	SKIPN	ERRWRD		;ON /R
	JRST	DELUF0		; CANT FIX UP THE UFD
	HRRZ	T,EXT		;ERROR CODE
	JUMPE	T,CLEAN9	;TRY NEXT STR IF NOT FOUND ON THIS STR
	CAIN	T,23		;TRY  NEXT STR IF SFD NOT FOUND
	JRST	CLEAN9
DELUF0:	MOVE	T1,DFTPPN
	JUMPL	SFD,DELU0A	;IF THIS MONITOR SUPPORTS SFD'S,
	HLRZ	T2,EXT
	CAIN	T2,'UFD'
	JRST	DELU0A		;IF THE DIRECTORY IS AN SFD
	MOVE	T1,[SFDBLK,,PTHBLK]
	BLT	T1,PTHNM1-1(SFD); COPY ALL THE SFD NAMES
	MOVE	T,FILE
	MOVEM	T,PTHNM1(SFD)	; ADD THE DESIRED SFD TO THE PATH
	SETZM	PTHNM1+1(SFD)
	MOVEI	T1,PTHBLK
DELU0A:	MOVEM	T1,DELPNT	;SET E+3 TO PPN OR PNTR TO PATH
	SKIPN	ERRWRD		;/R?
	JRST	DELU0B
	JUMPL	F,.+3
	ENTER	DSK,LOOKBF	;YES, SET FOR UPDATE MODE
	  JRST	CANTWT		;MUST NOT BE 1,2
	MOVEI	T5,1		;T5 WILL COUNT BLOCKS IN THE UFD
DELU0B:	SKIPE	LFAIL		;IF ERROR ON UFD
	JRST	TRYHND		;DELETE IT THE HARD WAY
	MOVE	T1,STRNAM	;NO. OPEN A CHANNEL FOR READING THE UFD
	SETZB	T,T2
	OPEN	UFD,T
	  JRST	QUEST
DELUF1:	INPUT	DSK,IOW		;READ A UFD BLOCK
	STATZ	DSK,760000	;EOF OR ERROR?
	JRST	DELUF8		;YES - THIS STR IS DONE
	MOVE	T4,IOW		;NO. SET TO LOOK AT FILES IN UFD
DELUF2:	SKIPN	T,1(T4)		;GET A FILE NAME
	AOJA	T5,DELUF1	;0 - THIS BLOCK DONE
	HLLZ	T1,2(T4)	;EXTENSION
	MOVE	T3,DELPNT	;PPN OR PATH LOC
	LOOKUP	UFD,T		;LOOKUP THE FILE
	  JRST	DELUF4		;ERROR ON LOOKUP
	SKIPE	ERRWRD		;DELETING ONLY ERROR FILES?
	JRST	DELUF3		;YES
	RENAME	UFD,RENBLK	;NO, DELETE THE FILE
	  JRST	DELUF5		;CANT DELETE IT!
DELUF3:	AOBJN	T4,.+1		;STEP TO NEXT ENTRY IN UFD
	AOBJN	T4,DELUF2
	AOJA	T5,DELUF1	;COUNT THIS BLOCK, READ NEXT


DELUF4:	HRRZS	T1		;ERROR CODE IS IN RH(T1)
	JUMPE	T1,DELUF3	;0 IF FILE-NOT-FOUND
	CAIN	T1,ERRRIB	;RIB ERROR?
	JRST	DELUF6		;YES
	HRRM	T1,LOOKBF+RIBERR ;NO. SAVE CODE FOR MESSAGE
	PUSHJ	P,UFDCNT	;TYPE "CANT DELETE UFD BECAUSE FILE"
	JRST	TRYHND		;TYPE THE ERROR CODE
DELUF5:	PUSHJ	P,UFDCNT	;TYPE "CANT DELETE UFD BECAUSE FILE - "
	JRST	RENERR		;TYPE RENAME FAILURE

DELUF6:	SKIPN	ERRWRD		;DELETING FILES WITH RIB ERRS?
	JRST	DELUF3		;NO, LOOK AT NEXT FILE IN UFD
	PUSH	P,T4		;SAVE A COUPLE
	PUSH	P,T5		; OF REGISTERS
	HRRZ	T3,T5		;COPY THE FILE RELATIVE BLOCK NUMBER
	PUSHJ	P,PHYSBN	;CONVERT TO PHYSICAL BLOCK NUMBER
	 JRST	CNTWT1		;ERROR, JUST CLEAN UP AND COMPLAIN
	POP	P,T5		;RESTORE THE FILE BLOCK NUMBER
	POP	P,T4		;AND THE AOBJN POINTER WITHIN THE BLOCK
	MOVE	T1,1(T4)	;YES. SAVE FILE NAME
	HLLZ	T2,2(T4)	;SAVE EXT
	MOVSI	T,3(T4)		;SET TO BLT UFD BLOCK
	HRRI	T,1(T4)
	BLT	T,DBUF+175	;ZAP OUT THE ENTRY
	SETZM	DBUF+176
	SETZM	DBUF+177
	SKIPGE	F		;IF CANT UPDATE UFD,
	USETO	DSK,T3		; DO A SUPER USETO TO LAST BLOCK READ
	SKIPL	F		;OTHERWISE,
	USETO	DSK,(T5)	; SET TO REWRITE THE BLOCK
	OUTPUT	DSK,IOW		;REWRITE THE UFD BLOCK
	STATZ	DSK,740000	;ERROR?
	JRST	CANTWT		;YES, TYPE A MESSAGE
	PUSH	P,T2		;NO. SAVE EXT
	MOVE	T,T1		;FILE NAME
	PUSHJ	P,SIXPRT	;TYPE IT
	POP	P,T1		;EXT
	JUMPE	T1,.+4		;NULL IF 0
	PUSHJ	P,DOT		;TYPE "."
	MOVE	T,T1		;TYPE EXT
	PUSHJ	P,SIXPRT
	PUSHJ	P,CRLF		;AND CR-LF
	JUMPGE	F,DELUF2	;LOOK FOR MORE RIB ERRS
	MOVEI	T,17		;CHANNEL DSK IS NOW A SUPER USETI/O CHAN,
	SETZ	T2,		; SO RE-OPEN CHAN TO TURN OFF SUPER MODE
	MOVE	T1,STRNAM
	OPEN	DSK,T
	  JRST	UFDNG		;THIS REALLY WONT HAPPEN
	LOOKUP	DSK,LOOKBF	;SET THE FILE AGAIN
	  EXIT			;THIS WONT HAPPEN
	USETI	DSK,(T5)	;BLOCK WE WERE READING
	INPUT	DSK,IOW		;READ IT AGAIN
	JRST	DELUF2		;AND GO LOOK FOR MORE RIB ERRS

DELUF8:	SKIPN	ERRWRD		 ;STR DONE - DELETE UFD?
	JRST	DELF4		;YES, ZAP IT
	JRST	CLEAN8		;NO, LOOK AT NEXT STR IN REQUEST

UFDCNT:	MSG	<CANT DELETE DIRECTORY BECAUSE FILE >
	MOVE	T,1(T4)
	PUSHJ	P,SIXPRT
	PUSHJ	P,DOT
	HLLZ	T,2(T4)
	PUSHJ	P,SIXPRT
	MSG	< -
>
	POPJ	P,
GOCLEN:	SKIPE	LFAIL		;ERROR ON MFD LOOKUP?
	JRST	NOMFD		;YES

CLEAN1:	MOVEI	T,17		;SET TO OPEN ANOTHER CHAN
	MOVE	T1,STRNAM	;IN DUMP MODE - TO READ UFD
	SETZ	T2,
	OPEN	UFD,T
	  JRST	QUEST		;OOPS
CLEAN2:	INPUT	DSK,IOW		;READ AN MFD BLOCK
	STATZ	DSK,760000	;EOF OR ERROR?
	JRST	CLEAN8		;YES, DONE
	MOVE	T4,IOW		;NO. SET TO LOOK AT ENTRIES IN MFD
CLEAN3:	SKIPN	T,1(T4)		;GET AN MFD DATA BLOCK
	JRST	CLEAN2		;THIS BLOCK DONE - READ NEXT
	MOVEI	T1,SPTLEN	;LENGTH OF SPECIAL TABLE
	CAMN	T,SPTBL(T1)	;IS THIS ENTRY SPECIAL?
	JRST	CLEAN5		;YES, DONT DELETE IT
	SOJGE	T1,.-2
	HLLZ	T1,2(T4)	;NO, GET EXT
	MOVE	T3,[XWD 1,1]	;PPN = MFD
	LOOKUP	UFD,T		;LOOKUP THE UFD
	  JRST	CLEAN5		;CANT - LEAVE IT ALONE
CLEAN4:	INPUT	UFD,IOW1	;READ A UFD DATA BLOCK 
	STATZ	UFD,20000	;EOF?
	JRST	CLEAN6		;YES, UFD IS EMPTY
	SKIPN	FSTWRD		;NO, IS THERE DATA IN UFD?
	JRST	CLEAN4		;NO, READ NEXT BLOCK
CLEAN5:	AOBJN	T4,.+1		;YES. LEAVE THIS UFD ALONE
	AOBJN	T4,CLEAN3	;AND GO LOOK AT NEXT
	JRST	CLEAN2		;READ NEXT MFD DATA BLOCK
CLEAN6:	MOVE	T1,[XWD HIGHJB,NSWTBL]
	GETTAB	T1,		;GET HIGHEST JOB IN SYSTEM
	  JRST	QUEST
	MOVE	T2,[XWD 1,PRJPRG] ;LOOK AT ALL LOGGED-IN JOBS
CLEN6A:	MOVE	T3,T2
	ADD	T2,[XWD 1,0]	;IF THE UFD OWNER IS LOGGED IN,
	GETTAB	T3,		; DONT DELETE THE UFD
	  JRST	QUEST
	CAMN	T,T3
	JRST	CLEAN5		;LOGGED IN
	SOJG	T1,CLEN6A
	RENAME	UFD,RENBLK	;NOT LOGGED IN - DELETE THE UFD
	  JRST	CLEAN7		;CANT DELETE IT
	PUSHJ	P,UFDPRT	;OK, TYPE THE UFD NAME
	JRST	CLEAN5		;AND LOOK FOR ANOTHER
CLEAN7:	PUSHJ	P,UFDPRT	;TYPE UFD NAME
	JRST	RENERR		;AND A RENAME-FAILURE MESSAGE

CLEAN8:	MOVE	T,STRNAM	;ALL THROUGH. TYPE STR
	PUSHJ	P,SIXPRT
	MSG	<  FINISHED
>
	OUTPUT	TTY,
CLEAN9:	MOVE	T,STRNAM
	SKIPL	CLEANW		;IF DOING ALL STRS
	SYSSTR	T,		;GET NEXT STR IN SYSTEM
	  JRST	DELF2
	JUMPE	T,.-1		;0 IF AT END
	MOVEM	T,STRNAM	;HAVE A NEW ONE - SAVE NAME
	JRST	DELF3		;GO CLEAN UP THIS STR
GETNAM:	SETZM	STRNAM
	SETZM	FILE
	SETZM	EXT
	SETZM	PPN
	SKIPL	SFD
	SETZ	SFD,
	TLZ	F,SWITCH!CHAR!SUP
	MOVEI	T,RIBEND
	MOVEM	T,LOOKBF
NAM0:	PUSHJ	P,SIXAN
NAM0A:	CAIE	T,":"
	JRST	NAM1
	MOVEM	T1,STRNAM
	JRST	NAM0
NAM1:	CAIE	T,"."
	JRST	NAM2
	MOVEM	T1,FILE
	JRST	NAM0
NAM2:	CAIE	T,"["
	JRST	NAM3
	SKIPE	FILE
	MOVEM	T1,EXT
	SKIPN	FILE
	MOVEM	T1,FILE
	PUSHJ	P,OCTRD
	CAIE	T,","
	JRST	FILERR
	HRLZM	T1,PPN
	PUSHJ	P,OCTRD
	HRRM	T1,PPN
NAM2A:	CAIE	T,","
	JRST	NAM2B
	CAILE	SFD,SFDLVL
	JRST	TOOMNY
	JUMPL	SFD,NOSFDS
	PUSHJ	P,SIXAN
	EXCH	T1,SFDNAM(SFD)	;SAVE SFD NAME, ZERO T1
	AOJA	SFD,NAM2A
NAM2B:	CAIN	T,"]"
	PUSHJ	P,TTI
	CAIGE	T,40
	JRST	CPOPJ1
NAM3:	CAIE	T,"/"
	JRST	NAM4
	TLO	F,SWITCH	;SAW A SWITCH
	SKIPE	FILE
	JRST	NAM3A
	MOVEM	T1,FILE
	JRST	NAM3B
NAM3A:	SKIPN	EXT
	MOVEM	T1,EXT
NAM3B:	PUSHJ	P,TTI
	CAIN	T,"S"		;DELETE BY HAND?
	TLOA	F,SUP		;YES
	CAIN	T,"D"
	JRST	NXTCHR
	CAIN	T,"X"
	CALLI	1,12
	CAIN	T,"H"
	JRST	HELPMS
	CAIN	T,"C"
	JRST	CLEAN
	CAIN	T,"R"
	JRST	ERRDEL
	JRST	FILERR

ERRDEL:	SETOM	CLEANW
	SETOM	ERRWRD
NXTCHR:	PUSHJ	P,TTI
	CAIN	T,","
	JRST	FILERR		;ONLY 1 FILE AT A TIME
	JRST	CPOPJ1

NOSFDS:	MSG	<THIS MONITOR DOES NOT SUPPORT SFD'S>
	JRST	DELF2

TOOMNY:	MSG	<TOO MANY SFD'S IN PATH SPECIFICATION>
	JRST	DELF2
NAM4:	CAIE	T,","
	JRST	NAM5
	SKIPE	FILE
	JRST	FILERR
	MOVE	T2,T1		;T2=CHARS READ
	MOVE	T3,[POINT 6,T2]
	SETZ	T,
SIXOC1:	TLNN	T3,770000
	JRST	NAM4A
	ILDB	T1,T3		;T1=NEXT CHAR
	JUMPE	T1,NAM4A	;QUIT IF NO MORE CHARS
	SUBI	T1,20		;CONVERT SIXBIT TO BINARY
	CAILE	T1,7		;SKIP IF OCTAL DIGIT
	JRST	FILERR
	LSH	T,3
	ADD	T,T1
	JRST	SIXOC1
NAM4A:	HRLM	T,(P)		;REMEMBER PROJECT NUMBER
	PUSHJ	P,OCTRD		;READ PROGRAMMER NUMBER
	HLL	T1,(P)		;RESTORE PROJECT
	MOVEI	T2,RIPDIR	;SET DIRECTORY BIT IN CASE LOOKUP FAILS
	ORM	T2,LOOKBF+RIBSTS;SO WILL PRINT CORRECT NAME
	JRST	NAM0A		;AND PRETEND WE HAVE A FILE NAME
NAM5:	CAIL	T,40
	JRST	FILERR
	SKIPE	FILE
	MOVEM	T1,EXT
	SKIPN	FILE
	MOVEM	T1,FILE
CPOPJ1:	AOS	(P)
	POPJ	P,

FILERR:	MOVEI	T1,[ASCIZ .
?.]
	JRST	TYPEX

HELPMS:	MOVEI	T1,DELF2
	HRRM	T1,(P)
	MOVEI	T1,HELPTX
	JRST	TYPEX

	PUSHJ	P,TTI
TYPEX:	CAIE	T,LF
	JRST	.-2
	TTCALL	OUTSTR,(T1)
	POPJ	P,
OCTPRT:	SKIPA	T2,[^D8]
DECPRT:	MOVEI	T2,^D10
RDXPRT:	JUMPGE	T,RDXPR1	;OK IF POS
	PUSH	P,T
	MOVEI	T,"-"		;PUT OUT MINUS SIGN
	PUSHJ	P,TYO
	POP	P,T		;RESTORE WORD
	MOVMS	T		;POSITIVE VALUE
RDXPR1:	IDIVI	T,(T2)
	HRLM	T1,(P)
	SKIPE	T
	PUSHJ	P,RDXPR1
	HLRZ	T,(P)
	ADDI	T,"0"
TYO:	SOSG	OBUF+2
	OUTPUT	TTY,
	IDPB	T,OBUF+1
	POPJ	P,

COMMA:	SKIPA	T,[","]
DOT:	MOVEI	T,"."
	JRST	TYO

CRLF:	MOVEI	T,15
	PUSHJ	P,TYO
	MOVEI	T,12
	JRST	TYO


SIXPRT:	MOVE	T2,T		;SAVE WORD IN T2
	MOVE	T1,[POINT 6,T2]
SIXPR1:	TLNN	T1,770000
CPOPJ:	POPJ	P,
	ILDB	T,T1
	JUMPE	T,CPOPJ
	ADDI	T,40
	PUSHJ	P,TYO
	JRST	SIXPR1


PRINT:	PUSH	P,T
	ILDB	T,T5
	JUMPE	T,TPOPJ
	PUSHJ	P,TYO
	JRST	PRINT+1
TPOPJ:	POP	P,T
	POPJ	P,
CLEAN:	SETOM	CLEANW
	MOVE	T,[XWD 1,1]
	MOVEM	T,FILE
	MOVEM	T,PPN
	MOVSI	T,'UFD'
	MOVEM	T,EXT
	JRST	CPOPJ1

UFDPRT:	HLRZ	T,1(T4)
	PUSHJ	P,OCTPRT
	PUSHJ	P,COMMA
	HRRZ	T,1(T4)
	PUSHJ	P,OCTPRT
	PUSHJ	P,DOT
	HLLZ	T,2(T4)
	PUSHJ	P,SIXPRT
	JRST	CRLF

SIXAN:	SETZ	T1,
	MOVE	T2,[POINT 6,T1]
	PUSHJ	P,SSP
	JRST	.+2
SIXANL:	PUSHJ	P,TTI
	CAIG	T,"Z"
	CAIGE	T,"0"
	POPJ	P,
	CAIGE	T,"A"
	CAIG	T,"9"
	JRST	.+2
	POPJ	P,
	SUBI	T,40
	TLNE	T2,770000
	IDPB	T,T2
	JRST	SIXANL

SSP:	PUSHJ	P,TTI
	CAIE	T,11
	CAIN	T,40
	JRST	SSP
	POPJ	P,
OCTRD:	SETZ	T1,
OCTRD1:	PUSHJ	P,TTI
	CAIGE	T,"0"
	POPJ	P,
	CAILE	T,"7"
	POPJ	P,
	LSH	T1,3
	ADDI	T1,-60(T)
	JRST	OCTRD1
TTI:	SOSLE	IBUF+2

	JRST	TTIOK
	INPUT	TTY,
	STATZ	TTY,740000
	JRST
TTIOK:	ILDB	T,IBUF+1
	CAIN	T,32
	EXIT	1,
	JUMPE	T,TTI
	CAIE	T,15		;IGNORE CARRIAGE RETURNS
	CAIN	T,177
	JRST	TTI		;IGNORE RIBOUTS
	CAIL	T,175		;CONVERT TO STANDARD ALTMODE
	MOVEI	T,33
	CAIL	T,140		;LOWER CASE TO UPPER CASE
	TRC	T,40
	CAIE	T,12
	TLO	F,CHAR		;SOME CHARACTER SEEN
	POPJ	P,


PDL:	IOWD	20,PDLIST
RENBLK:	0
	0
HELPTX:	ASCIZ	#COMMANDS ARE IN THE FORM "DEV:FILE.EXT[PROJ,PROG,SFD,...]/SWITCH"
SWITCHES INCLUDE:
/D - DELETE THE FILE (VIA RENAME IF NO RIB ERROR)
/S - DELETE THE FILE WITH SUPER USETO, EVEN IF NO RIB ERROR
/R - DELETE ALL (AND ONLY) THOSE FILES FROM THE NAMED UFD WHICH HAVE RIB ERRORS
/C - DELETE ALL EMPTY UFD'S FROM DEV
#
;LITERALS
	XLIST
	LIT
	LIST

;STORAGE
SPTBL:	XWD	1,1
	XWD	1,2
	XWD	1,4
	XWD	3,3
	XWD	10,1
	XWD	1,3
	XWD	1,5
	XWD	5,1
	XWD	5,2
SPTLEN==.-SPTBL-1

IBUF:	BLOCK	3
OBUF:	BLOCK	3
STRNAM:	BLOCK	1
LFAIL:	BLOCK	1
CLEANW:	BLOCK	1
ERRWRD:	BLOCK	1
DFTPPN:	BLOCK	1
DELPNT:	BLOCK	1
LOOKBF:	BLOCK	RIBEND+1
FILE==LOOKBF+RIBNAM
EXT==LOOKBF+RIBEXT
PPN==LOOKBF+RIBPPN
SFDBLK:	BLOCK	2
SFDPPN:	0
SFDNAM:	BLOCK	SFDLVL+1
PTHBLK:	BLOCK	2
PTHPPN:	0
PTHNM1:	BLOCK	SFDLVL+1
RIOW:	IOWD	200,RBUF
	0
RBUF:	BLOCK	200
HIOW:	IOWD	200,HBUF
	0
HBUF:	BLOCK	200
	CCBP=HBUF+16
	CABP=HBUF+20
	BPC=HBUF+21
UNUM:	BLOCK	1
DEV:	.IODMP
	BLOCK	1
	0
IOW:	IOWD	200,DBUF
	0
DBUF:	BLOCK	200
IOW1:	IOWD	1,FSTWRD
	0
FSTWRD:	0
PDLIST:	BLOCK	20
PHYDSK:	XWD	400000,17
	SIXBIT	/DSK/
	0
MFDBLK:	XWD	1,1
	SIXBIT	/UFD/
	0
	XWD	1,1
PATCH:	BLOCK	100
DELEND:	END	DELFIL