Trailing-Edge
-
PDP-10 Archives
-
bb-jr93d-bb
-
7,6/ap015/delfil.x15
There are 2 other files named delfil.x15 in the archive. Click here to see a list.
TITLE DELFIL - VARIOUS FUNCTIONS ON FILES WITH ERRORS V3B(5)
;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==5
VMINOR==2
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
;REVISION HISTORY
;
;2 FIX BUG INTRODUCED BY MCO 11396 9-13-84
;
;3 FIX COPYRIGHTS
;
;4 ;FINISH EDIT 2 12-13-85
;
;5 35593 18-Sep-86 BAH
; Change DELFIL to do SUSET.s instead of USETI/Os.
;
;END OF REVISION HISTORY
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
JUMPGE F,FNDHN1 ;[5] IF CANT UPDATE UFD,
MOVE T,T3 ;[5] DO A SUPER USETO FOR THIS BLOCK NUMBER
TLO T,(<DSK>B12!SU.SOT) ;[5] CHANNEL NUMBER AT SU.SCH
SUSET. T, ;[5] READ THE HOME BLOCK
JRST CANTWT ;[5] ERROR
FNDHN1: SKIPL F ;[5] 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
MOVEI T1,1 ;[5] BLOCK 1
TLO T1,(<DSK>B12) ;[5] CHANNEL NUMBER AT SU.SCH
SUSET. T1, ;[5] READ THE HOME BLOCK
POPJ P, ;[5] ERROR
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,
MOVE T1,T3 ;[5] BLOCK # TO READ
TLO T1,(<DSK>B12) ;[5] CHANNEL NUMBER AT SU.SCH
SUSET. T1, ;[5]
POPJ P, ;[5] ERROR
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
JUMPGE F,DELUF7 ;[5] IF CANT UPDATE UFD,
MOVE T,T3 ;[5] BLOCK NUMBER
TLO T,(<DSK>B12!SU.SOT) ;[5] CHANNEL NUMBER AT SU.SCH
SUSET. T, ;[5] DO A SUPER USETO TO LAST BLOCK READ
JRST CANTWT ;[5] ERROR
DELUF7: 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