.TITLE PUG .IDENT /XX01/ ; ; SCAN THE VOLUME INDEX FILE TO LOCATE ALL ZERO-BLOCK FILES ; .MCALL FDBDF$,EXIT$S,QIOW$,DIR$,FDRC$A,FDOP$A .MCALL FDOF$L,FCSBT$,FINIT$,FSRSZ$,GMCR$ FDOF$L FCSBT$ FSRSZ$ 0 FDB1: FDBDF$ FDOP$A 1,,,FO.RD FDB2: FDBDF$ FDRC$A FD.RWM FDOP$A 2,,,FO.RD DSP1: .WORD 0,0 .WORD DIR1L,DIR1S .WORD NAM1L,NAM1S DSP2: .WORD 0,0 .WORD DIR2L,DIR2S .WORD NAM2L,NAM2S DIR1S: .ASCII "[000,000]" DIR1L=.-DIR1S NAM1S: .ASCII "*.DIR;1" NAM1L=.-NAM1S DIR2S: .ASCII "[000,000]" DIR2L=.-DIR2S NAM2S: .ASCII "*.*;*" NAM2L=.-NAM2S .EVEN OUTBUF: .BLKB 37. DEFLAG: .BLKB 1 QIOW: QIOW$ IO.WLB,5,5,,,, GMCR: GMCR$ .MACRO ERROR STRING,GOTO,?LABEL MOV #LABEL,R5 CALL MSG .IF B GOTO EXIT$S .IFF MOV #OUTBUF,Q.IOPL(R3) JMP GOTO .ENDC LABEL: .ASCIZ <15><12>"PUG -- 'STRING'"<12> .EVEN .ENDM SCAN: FINIT$ ; INITIALIZE FCS DIR$ #GMCR ; GET A COMMAND LINE BCS 1000$ ; IF CS, NONE AVAILABLE MOV $DSW,R2 ; DID WE GET ANYTHING? BPL 1100$ ; IF PL, YES -- DON'T KISS IT GOODBYE 1000$: ERROR 1100$: MOV #GMCR+G.MCRB,R0 ; POINT TO THE COMMAND 1$: CMPB #' ,(R0)+ ; FIND A SPACE YET? BEQ 2$ ; IF EQ, YES SOB R2,1$ ; KEEP LOOKING ERROR 2$: MOV R0,DSP1+2 ; SET ADDRESS OF DEVICE STRING MOV R0,DSP2+2 ; FOR BOTH FDB'S MOV R0,R1 ; COPY IT FOR LATER 21$: CMPB #':,(R0)+ ; FIND THE END YET? BEQ 22$ ; IF EQ, YES SOB R2,21$ ; KEEP LOOKING UNTIL WE RUN OUT ERROR 22$: MOV R0,R2 ; COPY END OF DEVICE STRING SUB R1,R2 ; COMPUTE LENGTH OF THE STRING MOV R2,DSP1+0 ; SAVE IT MOV R2,DSP2+0 ; CLRB DEFLAG ; DEFAULT TO LISTING ONLY, NO DELETE CMPB #'/,(R0)+ ; SWITCH COMING? BNE 33$ ; IF NE, NO CMPB #'D,(R0)+ ; IS IT "/DE"? BNE 33$ ; IF NE, NOT A CHANCE CMPB #'E,(R0)+ ; WELL? BNE 33$ ; IF NE, NO -- HE BLEW IT INCB DEFLAG ; FLAG THE SWITCH INC R0 ; MAKE THE NEXT PART WORK NOW 33$: CMPB #15,-(R0) ; END OF THE COMMAND? BEQ 4$ ; IF EQ, YES CMPB #33,(R0) ; ONE MORE CHANCE BEQ 4$ ; IF EQ, GOOD ERROR 4$: MOV #FDB1,R0 ; LOAD MFD FDB ADDRESS MOV #FDB1+F.FNB,R1 ; LOAD ADDRESS OF FILENAME BLOCK MOV #DSP1,R2 ; GET ADDRESS OF DATASET POINTER CLR R3 ; NO DEFAULT FILENAME BLOCK CALL .PARSE ; FILL IN THE FDB FILENAME BLOCK BCC 801$ ; IF CC, PARSE OKAY ERROR 801$: MOV #FDB1,R0 ; LOAD MFD FDB ADDRESS AGAIN MOV #FDB1+F.FNB,R1 ; AND FILENAME BLOCK ADDRESS CALL .FIND ; FIND THE NEXT UFD BCS DONE ; IF CS, NO SUCH FILE -- DONE!! MOV R1,R3 ; COPY FILENAME BLOCK ADDRESS MOV #DIR2S+1,R0 ; GET OUTPUT AREA ADDRESS MOV N.FNAM(R3),R1 ; GET THE FIRST PART CMP #<^R000>,R1 ; IS IT [000,nnn]? BEQ 801$ ; IF EQ, YES -- DON'T USE IT CALL $C5TA ; CONVERT FROM RAD50 TO ASCII TSTB (R0)+ ; SKIP PAST THE COMMA MOV N.FNAM+2(R3),R1 ; GET THE NEXT PART CMP #<^R000>,R1 ; IS IT [nnn,000]? BEQ 801$ ; IF EQ, YES CALL $C5TA ; CONVERT IT, TOO TST N.FNAM+4(R3) ; LEGAL FILE NAME? BNE 801$ ; IF NE, NO -- SKIP IT MOV #FDB2,R0 ; LOAD UFD FDB ADDRESS MOV #FDB2+F.FNB,R1 ; POINT TO THE FILENAME BLOCK MOV #DSP2,R2 ; GET THE DATASET POINTER ADDRESS CLR R3 ; NO DEFAULT FILENAME BLOCK CALL .PARSE ; PARSE THE FILENAME BCS 801$ ; IF CS, IGNORE THIS UFD 800$: MOV #FDB2,R0 ; GET FDB ADDRESS MOV #FDB2+F.FNB,R1 ; GET ADDRESS OF FILENAME BLOCK CALL .FIND ; FIND THE NEXT MATCHING FILE BCS 801$ ; IF CS, NO MORE LEFT -- DO NEXT UFD CMP #<^RSYS>,N.FTYP(R1) ; IS FILENAME EXTENSION "SYS"? BEQ 800$ ; IF EQ, YES -- DON'T DELETE IT CALL .OPFNB ; OPEN THE FILE BCS 805$ ; IF CS, OPEN FAILED TST F.HIBK(R0) ; ANYTHING ALLOCATED FOR THIS FILE? BNE 807$ ; IF NE, YES TST F.HIBK+2(R0) ; WELL? BEQ 3000$ ; IF EQ, FILE SIZE IS 0./0. BLOCKS 807$: CALL .CLOSE ; CLOSE THE FILE, IT IS GOOD!! BR 800$ ; KEEP GOING, DON'T STOP NOW 805$: CMPB #IE.CLO,F.ERR(R0) ; FAILED DUE TO BEING LOCKED? BNE 800$ ; IF NE, NO -- DON'T TOUCH IT 3000$: MOV #OUTBUF+2,R0 ; GET OUTPUT AREA ADDRESS MOV R1,R3 ; COPY FILENAME BLOCK ADDRESS CALL FILNAM ; INSERT THE FILE NAME MOV #OUTBUF,R2 ; GET OUTPUT AREA ADDRESS SUB R2,R0 ; COMPUTE LENGTH OF STRING TO PRINT MOV R0,QIOW+Q.IOPL+2 ; SAVE IT MOV #" ,(R2) ; INDICATE FILE NOT DELETED MOV #FDB2,R0 ; GET FDB ADDRESS OF OPEN FILE MOV #FDB2+F.FNB,R1 ; GET FILENAME BLOCK ADDRESS TSTB DEFLAG ; DELETE THE FILE? BEQ 4002$ ; IF EQ, NO MOV N.STAT(R1),-(SP) ; SAVE WHATEVER MOV N.NEXT(R1),-(SP) ; CLR N.STAT(R1) ; CLEAR WHATEVER CLR N.NEXT(R1) ; CALL .DLFNB ; DELETE THE SUCKER MOV (SP)+,N.NEXT(R1) ; GET BACK WHATEVER MOV (SP)+,N.STAT(R1) ; BCS 4001$ ; IF CS, NO GOOD MOV #"* ,(R2) ; SUCCESSFUL!! BR 4000$ ; JUMP OVER NEXT INSTRUCTION 4001$: MOV #"? ,(R2) ; INDICATE FAILURE 4002$: CALL .CLOSE ; CLOSE THE FILE 4000$: DIR$ #QIOW ; PRINT OUT THE FILENAME INFORMATION BR 800$ ; LOOP AROUND FOR MORE DONE: EXIT$S ; AWAY WE GO... FILNAM: MOV N.DVNM(R3),(R0)+ ; COPY OVER DEVICE NAME MOV N.UNIT(R3),R1 ; GET UNIT NUMBER CLR R2 ; NO LEADING ZEROS CALL $CBTMG ; CONVERT TO OCTAL MOVB #':,(R0)+ ; STICK IN A COLON MOV #DIR2S,R4 ; GET ADDRESS OF DIRECTORY STRING MOV #DIR2L,R5 ; AND ITS LENGTH 1$: MOVB (R4)+,(R0)+ ; COPY A BYTE SOB R5,1$ ; DO THE WHOLE THING MOV N.FNAM(R3),R1 ; CONVERT THE FILE NAME TO ASCII CALL 10$ ; MOV N.FNAM+2(R3),R1 ; CALL 10$ ; MOV N.FNAM+4(R3),R1 ; CALL 10$ ; MOVB #'.,(R0)+ ; SEPARATE WITH A PERIOD MOV N.FTYP(R3),R1 ; CONVERT FILE TYPE TO ASCII CALL 10$ ; MOVB #';,(R0)+ ; SEPARATE WITH A SEMICOLON MOV N.FVER(R3),R1 ; GET VERSION NUMBER CLR R2 ; NO LEADING ZEROS CALL $CBOMG ; CONVERT TO OCTAL MAGNITUDE RETURN ; 10$: BEQ 20$ ; IF EQ, DON'T BOTHER DOING ANYTHING CALL $C5TA ; CONVERT RAD50 TO ASCII SUB #2,R0 ; POINT BACK TWO CHARACTERS CMPB #' ,(R0)+ ; SPACE HERE? BEQ 15$ ; IF EQ, YES -- RETURN CMPB #' ,(R0)+ ; HERE, PERHAPS? BNE 20$ ; IF NE, NO -- JUST LEAVE 15$: DEC R0 ; POINT BEHIND THE SPACE CHARACTER 20$: RETURN ; MSG: MOV R5,R4 ; GET ERROR MESSAGE ADDRESS 10$: TSTB (R4)+ ; SEARCH FOR THE END OF THE STRING BNE 10$ ; IF NE, DON'T HAVE IT YET SUB R5,R4 ; SET R4 TO THE STRING LENGTH MOV #QIOW,R3 ; GET QIO DPB ADDRESS MOV R5,Q.IOPL(R3) ; SET STRING ADDRESS MOV R4,Q.IOPL+2(R3) ; AND ITS LENGTH DIR$ R3 ; PRINT THE ERROR MESSAGE RETURN ; SAIL AWAY... .END SCAN