.TITLE SRDLST-LIST THE DIRECTORY .IDENT -6.3- ; 01-JUN-83 .ENABL LC ;+ ; ; **SRD--SORT DIRECTORY ; ; THIS MODULE CREATS A SELECTIVE LISTING OF THE FILE ; ; ; THIS TASK WILL SORT A RSX11M DIRECTORY ; THEN CREATE A LISTING WITH MANY SELECTION OPTIONS ;- ; ; MODIFICATIONS: ; ; BT001 - 01-DEC-81 ; IMPLEMENT /ZE SWITCH TO FIND ZERO USED BLOCK FILES; ; WHEN HEADER ATTRIBUTES SHOW 0 BLOCKS ALLOCATED, CALCULATE VALUE ; FROM RETRIEVAL POINTERS, AND INCLUDE IN DIRECTORY TOTAL ; ; RBD001 13-JUL-82 ; Lower case messages for 'M Version 4.0 fans ; ; BT002 - 18-May-83 ; Merged in /SM, /HD, and /BK switches from Glen Everhart's ; Fall 1982 version; ; Correct bug which caused version number selection to fail ; to list the proper files in many cases. ; ; CEF001 - 1-June-83 ; ADD .PSECT FOR DATA & CODE ; ; ; ; SYSTEM MACRO CALLS ; ;CEF001 .PSECT SRDATA,D,RW,LCL,REL,CON ;CEF001 ; ;CEF001 ; .MCALL FHDOF$,CALLR,DIR$,QIOW$S,WTSE$S,PUT$S,GCMLD$ GCMLD$ FHDOF$ DEF$L DTSTR: .BYTE 40,2,'-,3,'-,2,' ,2,':,2,' ,0 .EVEN FUTABL: .BYTE H.UFAT+F.EFBK+2 ; FCS'S END OF FILE .BYTE 14.,0,0 ; SIZE,LEADING CHAR,TRAILING CHAR .WORD SIZECV ; CONVERSION ROUTINE .BYTE 2,6,0,0 .WORD CLMCV ; Contiguous/Locked etc. .BYTE H.PROG,10.,'[,'] .WORD UICCV ; OWNER UIC CONVERSION .BYTE H.FNUM,12.,'(,') ; FILE NUMBER .WORD FIDCV .BYTE H.FPRO,22.,'[,'] .WORD FPROCV .WORD 0 ; END OF TABLE MITABL: .BYTE H.UFAT+F.EFBK+2 ; FCS'S END OF FILE .BYTE 14.,0,0 ; SIZE,LEADING CHAR,TRAILING CHAR .WORD SIZECV ; CONVERTION ROUTINE .BYTE 2,6,0,0 .WORD CLMCV ; Contiguous/Locked etc. .BYTE H.FNUM,12.,'(,') ; FILE NUMBER .WORD FIDCV .WORD 0 ; End of Table ; FPSTR: .ASCIZ /RWED/ TERMRS: .ASCII \.;\ ; FILE-NAME FIELD TERMINATORS QBUF$: .ASCII " [Y/N/G/Q] ? _"<10> ; /SD PROMPT MESSAGE SUFFIX QBUFS$=.-QBUF$ QBF1$: .ASCII <15><12><11>"Are you sure [Y/N] ? _"<10> ; GO VERIFICATION MSG ;RBD001 QBF1S$=.-QBF1$ ;**-1 .EVEN .PAGE ;CEF001 .SBTTL SRDLST GENERATE LISTING - CODE ;CEF001 .PSECT SRDCOD,I,RO,REL,CON,LCL ;CEF001 ; ;CEF001 ; SRDLST:: ; DIRECTORY IS SORTED,NOW GENERATE LISTING ; LSTDIR: BIC #HDFL,FLAGS$ ; FLAG HEADER NOT PRINTED MOV DIRBF$,R5 ;SET START OF DIRECTORY BUFFER UNPACK: CMP R5,UFDFDB+F.BKDS+2 ; At end of buffer? BHIS 10$ ; If HIS yes - end TST (R5) ;ANY THING REMAINING TO UN-PACK? BNE UNP1 ;CONTINUE ; 10$: MOV #FILMSG,R0 ; LIST OUT FILE COUNTS MOV NUMFS,R1 BNE 1$ ; DON'T SHOW ZERO SELECTED IF WILDCARD UIC TST NXUIC$ BNE 2$ 1$: MOV #33012,R2 CALL $CBTA MOV #FTMSG,R0 MOV NUMFT,R1 MOV #33012,R2 CALL $CBTA TST UFDFDB+F.BDB ; IS DIRECTORY STILL OPEN ??? BNE 21$ ; YES--DON'T PRINT TOTALS YET BIT #SMSW,SWMS3$ ; WAS THE /SM SUMMARY SWITCH SELECTED? ;BT002 BEQ 21$ ; IF EQ NO - DON'T OUTPUT THE SUMMARY ;BT002 PUT$S #LSTFDB,#FILMSG,#FMLEN ; SHOW SELECTED BLOCKS USED/ALLOCATED BIT #,SWMSK$ ; WERE HEADERS READ ? BEQ 21$ ; NO MOV #SBAREA,R0 MOV #TBLKU,R1 CLR R2 CALL $CDDMG MOVB #'.,(R0)+ MOVB #'/,(R0)+ MOV #TBLKA,R1 CLR R2 CALL $CDDMG MOVB #'.,(R0)+ MOV R0,R2 SUB #SBMSG,R2 PUT$S #LSTFDB,#SBMSG,R2 21$: MOV #LINBUF,LSTFDB+F.NRBD+2 2$: RETURN UNP1: INC NUMFT MOV R5,READHD+Q.IOPL ; SET FILE ID POINTER INCASE HEADER IS NEEDED MOV LSTFDB+F.NRBD+2,R0 ; SET TO POINT AT START OF REC ADD #D.FNAM,R5 ; POINT AT FILE-NAME PORTION 10$: BIT #HVSW,SWMS2$ ; SELECTING VERSIONS HIGHER THAN? BEQ CVAS ; BR IF NO MOV LVNUM$,R1 ; GET LOWEST VERSION TO SELECT BNE 20$ ; BR IF USER GAVE VALUE MOV #2,R1 ; ELSE USE 2 AS LOW LIMIT 20$: CMP (R5),R1 ; VERSION HIGH ENOUGH? BHIS CVAS ; BR IF SELECTING THIS VERSION ADD #,R5 ; ADVACE POINTER TO NEXT ENTRY BR UNPACK ; AND LOOK AT NEXT ; ; CONVERT DIRECTORY ENTRY TO ASCII ; CVAS: MOV #3,R3 ; NUMBER OF WORDS IN NAME 20$: MOV (R5)+,R1 ; GET A RADIX-50 WORD CALL $C5TA ; CONVERT TO ASCII DEC R3 ; COUNT NUMBER OF ENTRIES DONE BGT 20$ ; BR IF STILL DOING NAME BMI 30$ ; BR IF JUST DID TYPE MOVB #'.,(R0)+ ; SEPARATE NAME AND TYPE BR 20$ ; ---AND DO TYPE 30$: MOVB #';,(R0)+ ; SEPARATE TYPE AND VERSION MOV (R5)+,R1 ; NOW GET VERSION CLR R2 ; SET ZERO SUPPRESS FLAG CALL $CBOMG ; CONVERT TO ASCII CLRB (R0) ; INSERT NULL AFTER VERSION NUMBER ;BT002 BIT #SESW,SWMSK$ ; IS THIS A SELECTIVE LIST? BEQ CKVRSN ; BR IF NO-CK FOR VERSION SELECTION MOV #SEBUF$,R2 ; SET SELECTION STRING ADDRESS MOV LSTFDB+F.NRBD+2,R1 ; SET START OF NAME CALL SRDTST ; LOOK FOR A MATCH... BCC FOUND ; GOT A MATCH! FAILED: BIT #NESW,SWMSK$ ; NEGATED TESTS? BNE CKVRSN ; YES JMP UNPACK ; NO, GET NEXT FILE. FOUND: BIT #NESW,SWMSK$ ; NEGATED TESTS? BEQ CKVRSN ; NO JMP UNPACK ; YES, GET NEXT FILE. ; ; SEE IF VERSION SELECTION IS REQUIRED ; CKVRSN: BIT #SVSW,SWMSK$ ; VERSION SELECTION NEEDED? BEQ CKDATE ; BR IF NO-PROCEED WITH DATE MOV R5,R3 ; COPY PLACE IN DIRECTORY SUB #<5*2>,R3 ; BACK UP OVER THE NAME FIELD MOV R3,R2 ; MAKE A COPY OF THAT MOV R5,-(SP) ; Save R5 for now MOV R0,-(SP) ; And R0 MOV R3,R0 ; Copy again ADD #D.SIZ,R0 ; and set to next entry CLR R4 ; Set 'same as last' flag CLR R5 ; Set 'same as next' flag SUB #D.SIZ,R2 ; AND BACK THAT UP TO PRVIOUS ENTRY MOV #4,R1 ; LENGTH OF NAME AND TYPE 10$: CMP (R3),(R2)+ ; Same as last BEQ 30$ ; So far so good INC R4 ; No - clear 'same as last' flag ; 30$: CMP (R3)+,(R0)+ ; Same as next? BEQ 40$ ; So far so good INC R5 ; No - clear 'same as next flag' ; 40$: SOB R1,10$ ; LOOP? MOV R5,R3 ; Save 'same as next' flag MOV (SP)+,R0 ; Restore R0 as well MOV (SP)+,R5 ; Restore R5 CMP VRSCT$,#-1 ; Looking for last version? BEQ CKLAST ; If EQ yes - do special check TST R4 ; No - is it same as last? BNE 20$ ; If NE no - check next INC VRSNS$ ; COUNT UP THE NUMBER OF EXTRA VERSIONS OF FILE MOV VRSCT$,R1 ; GET PURG THRESHOLD BNE 12$ ; BR IF A VALUE IS PRESENT INC R1 ; ELSE MAKE IT ONE 12$: BIT #PUSW,SWMSK$ ; SELECTING VERSIONS FOR PURGE OR OBSOLETE LIST? BNE 14$ ; BR IF PURGING CMP VRSNS$,R1 ; PRINTED ENOUGH OF THIS FILE NAME? BLO CKDATE ; BR IF SELECT THIS VERSION BR UNPK0 ; ELSE FORGET THIS FILE 14$: CMP VRSNS$,R1 ; ENOUGH VERSIONS TO REQUIRE A DELETE? BHIS CKDATE ; BR IF YES- CHECK FOR DATE MATCH BR UNPK0 ; ELSE UNPACK THE NEXT 20$: CLR VRSNS$ ; ZERO NUMBER OF VERSIONS OF FILE SEEN BIT #PUSW,SWMSK$ ; FILES NOT SAME NAME - CHECK FOR PURGE/OBSOLETE BEQ CKDATE ; IF NOT PURGING-CONTINUE SELECTING THIS FILE UNPK0: JMP UNPACK ; UN PACK THE NEXT CKLAST: BIT #PUSW,SWMSK$ ; Purge or Obsolete? BNE 60$ ; If NE yes - check for it TST R3 ; No - Same as next? BEQ UNPK0 ; If EQ yes - ignore it BR CKDATE ; No - check for date range ; 60$: TST R3 ; This the last version? BNE UNPK0 ; If NE yes - save it BR CKDATE ; No - purge/list it CKDATE: BIT #,SWMSK$ ; FULL LISTING, OR DATE SELECT? BNE 10$ ; BR IF YES BIT #,SWMS2$ ; SELECT CONTIG, LOCKED, MULTI- ;BT001 ; ; HEADER, OR ZERO-USED-BLOCKS?;BT001 BEQ CKD1 ; BR IF NO ;**-1 10$: CLR HDBUF$ ; DIR$ #READHD ; READ THE FILE HEADER BCC 20$ CALL ALERR BR 10$ 20$: WTSE$S #EFN1 CMPB IOSB$,#IS.SUC ; OKAY? BEQ CKCLM CMPB IOSB$,#IE.SQC ; FILE ID/SEQ NUMBER CHECK BNE 25$ DIAG SQCHK BR CKCLM 25$: CMPB IOSB$,#IE.PRI ; PRIV BEQ 30$ DIAG HDRE ; SOME OTHER ERROR BR CKCLM 30$: DIAG HDPRV CKCLM: MOV #" ,CLMFLD ; BLANK CLM FILE CHARACTERISTICS MOV #" ,CLMFLD+2 ; FIELD MOVB HDBUF$+H.UCHA,R1 ; GET USER-CONTROLLED FILE CHARACTERISTICS BITB #COFLAG,R1 ; IS CONTIGUOUS FLAG SET? BEQ 20$ ; NO - BRANCH MOVB #'C,CLMFLD ; INSERT CONTIGUOUS SYMBOL BR 30$ ; PROCEED 20$: BIT #COSW,SWMS2$ ; CONTIGUOUS SWITCH SPECIFIED? BNE REJECT ; YES - REJECT FILE 30$: BITB #LOFLAG,R1 ; IS FILE LOCKED? BEQ 40$ ; NO - BRANCH MOVB #'L,CLMFLD+1 ; INSERT LOCKED SYMBOL BR 50$ ; PROCEED 40$: BIT #LOSW,SWMS2$ ; LOCKED SWITCH SPECIFIED? BNE REJECT ; YES - REJECT FILE 50$: TST HDBUF$+S.HDHD+S.IDHD+M.EFNU ; HEADER EXTENSIONS? BEQ 60$ ; NO - BRANCH MOVB #'M,CLMFLD+2 ; INSERT MULTI-HEADER SYMBOL BR CKZE ; PROCEED ;BT001 60$: BIT #MUSW,SWMS2$ ; MULTI-HEADER SWITCH SPECIFIED? ;**-1 BEQ CKZE ; PROCEED ;BT001 REJECT: JMP UNPACK ; UNPACK THE NEXT ENTRY ;**-1 CKZE: BIT #ZESW,SWMS2$ ; ZERO USED BLOCKS FILE SWITCH SET? ;BT001 BEQ CKD1 ; NO - PROCEED ;BT001 MOV #HDBUF$+H.UFAT,R1 ; USER ATTIBUTES AREA ;BT001 TST F.FFBY(R1) ; FIRST FREE BYTE ZERO? ;BT001 BNE REJECT ; IF NE NO - REJECT FILE ;BT001 TST F.EFBK(R1) ; ANY USED BLOCKS INDICATED (HIGH ORDER)? ;BT001 BNE REJECT ; IF NE YES - REJECT FILE ;BT001 MOV F.EFBK+2(R1),R1 ; GET USED BLOCKS (LOW ORDER) ;BT001 BEQ CKD1 ; IF EQ - 0 BLOCKS USED ;BT001 DEC R1 ; WAS THE VALUE 1? ;BT001 BNE REJECT ; IF NE NO - REJECT FILE ;BT001 CKD1: MOVB HDBUF$,R1 ;GET OFFSET TO IDENT AREA IN HEADER ASL R1 ;MAKE AWORD OFFSET ; FOR DATE SELECT, USE REVISION DATE (IF EVER REVISED), OR ; CREATION DATE (IF NEVER REVISED). THIS ADDR IN R1. ADD #HDBUF$,R1 ; POINT AT IDENT AREA BIT #RDSW,SWMS2$ ; USE REVISION DATE ?? BEQ 5$ ; NO !!!! TST I.RVNO(R1) ; EVER REVISED ?? BEQ 5$ ; NO--USE CREATION DATE ADD #,R1 ; YES--USE REVISION DATE 5$: ADD #,R1 MOV R1,R3 ; SAVE THIS ADDRESS BIT #DASW,SWMSK$ ; DOING DATE SELECTION? BEQ LSTENT ; NO-LIST IT CALL CVDATE ; CONVERT DATE TO INTEGER CMP R2,AFBUF$ ; AFTER GIVEN DATE? BLO 100$ ; IF LO NO - IGNORE THIS ONE ;BT001 BNE 1$ ; If not the same OK - carry on ;**-1 TST AFBUF$+2 ; An After Time given? BNE 1$ ; If NE yes - sort it out there BIT #AFSW,SWMSK$ ; Equality included? BNE 100$ ; IF NE NO - IGNORE THIS ONE ;BT001 ; ;**-1 1$: CMP R2,BEBUF$ ; BEFORE GIVEN DATE? BHI 100$ ; IF HI NO - IGNORE THIS ONE BNE 2$ ; If not the same OK - carry on TST BEBUF$+2 ; A Before Time given? BNE 2$ ; If NE Yes - sort it out there BIT #BFSW,SWMSK$ ; Equality included? BEQ 2$ ; If EQ OK - carry on ; 100$: JMP UNPACK ; Check the next one ; 2$: MOV R3,R1 ; GET BACK ADDRESS OF DATE ADD #I.CRTI-I.CRDT,R1 ; POINT AT CREATION TIME MOV R3,R4 ; SAVE ADDRESS OF CREATION DATE CALL CVTIME ; CONVERT IT MOV R3,R1 ; SAVE TIME MOV R4,R3 ; RESTORE ADDRESS OF DATE CMP R2,AFBUF$ ; SAME DATE AS AFTER DATE? BNE 10$ ; IF NE NO - CHECK FOR BEFORE TST AFBUF$+2 ; AFTER TIME SPECIFIED? BEQ 10$ ; IF EQ NO - OMIT CHECK CMP R1,AFBUF$+2 ; AFTER GIVEN TIME? BLO 100$ ; IF LO NO - IGNORE IT BNE 10$ ; If not the same OK - carry on BIT #AFSW,SWMSK$ ; Equality included? BNE 100$ ; If NE no - omit it ; 10$: CMP R2,BEBUF$ ; SAME DAY AS BEFORE DAY? BNE LSTENT ; IF NE NO - MUST BE OK TST BEBUF$+2 ; BEFORE TIME SPECIFIED? BEQ LSTENT ; NO - WE MUST BE OK CMP R1,BEBUF$+2 ; YES - BEFORE GIVEN TIME? BHI 100$ ; IF HI NO - IGNORE IT BNE 15$ ; If not the same OK - carry on BIT #BFSW,SWMSK$ ; Equality included? BNE 100$ ; If NE no - omit it ; 15$: .ENABLE LSB LSTENT: BIT #HDFL,FLAGS$ ; HAS HEADER BEEN LISTED? BEQ 2$ ; IF EQ NO - LIST IT ;BT002 JMP LSTE1 ; OTHERWISE, BRANCH AROUND ;BT002 2$: ;BT002 BIS #,FLAGS$ ; FLAG AS PRINTED ;**-1 SUB #D.SIZ,R5 ; BACK UP TO DO THIS 1 AGAIN DEC NUMFT ; MOV LSTFDB+F.NRBD+2,R0 ; RESET POINTER TO TOP OF BUFFER BIT #SPSW,SWMSK$ ; THIS LISTING GETTING SPOOLED? BEQ 4$ ; BR IF NO MOV (PC)+,(R0)+ ; INSERT A FORM FEED .BYTE 15,14 ; CR/FF CALL PUTLST ; Output it 4$: MOV #" *,(R0)+ ; FLAG NEW ENTRY MOV #"* ,(R0)+ ; THAT MAKES LISTING EASIER TO READ MOV ,(R0)+ ; COPY DEVICE NAME INTO LISTING MOV ,R1 ; GET UNIT NUMBER ASR R1 ASR R1 ASR R1 ; DIVIDE BY 10(OCTAL) BEQ 6$ ; BR IF UNIT LESS THAN 10(OCTAL) ADD #'0,R1 ; MAKE PRINTABLE MOVB R1,(R0)+ ; INSERT INTO LISTING 6$: MOV ,R1 ; GET UNIT BACK BIC #177770,R1 ; REDUCE TO <0-7> ADD #'0,R1 ; ADD IN ASCII BIAS MOVB R1,(R0)+ ; INSERT IN LISTING MOVB #':,(R0)+ ; NOW DELINIT DEVICE NAME MOVB #'[,(R0)+ ; SET UIC DELIMITER MOV UFDFDB+F.FNAM,R1 ; GET DIRECTORY NAME CALL 20$ ; CONVERT GROUP NAME TO ENGLISH MOVB #',,(R0)+ ; SEPARATE GROUP & USER MOV UFDFDB+F.FNAM+2,R1 ; GET OTHER HALF OF NAME CALL 20$ ; CONVERT PROGRAMMER NUMBER MOVB #'],(R0)+ ; TERMINATE UIC MOVB #' ,(R0)+ ; SEPARATE MOV #TDBUF$,R1 ; POINT AT DATE 10$: MOVB (R1)+,(R0)+ ; FILL IN DATE CMP R1,# ; FINISH DATE? BLO 10$ ; BR IF NO MOVB #' ,(R0)+ ; ADD A SPACE MOV #TDTIM$,R1 ; POINT AT TIME 12$: MOVB (R1)+,(R0)+ ; FILL IN TIME CMP R1,# ; FINISH TIME? BLO 12$ ; BR IF NO PTNAM: CALL PUTLS1 ;PRINT THAT ; PUT COMMAND LINE TST CMDBLK+G.CMLD BEQ 15$ BIT #HDSW,SWMS3$ ; /HD HEADER SWITCH SPECIFIED? ;BT002 BEQ 15$ ; IF EQ NO - OMIT COMMAND LINE ;BT002 PUT$S #LSTFDB,CMDBLK+G.CMLD+2,CMDBLK+G.CMLD MOV #LINBUF,LSTFDB+F.NRBD+2 MOV #LINBUF,R0 ; **** GIVE MSG IF WE HAVE TO DO IT IN PIECES**** 15$: TST UFDFDB+F.BDB ; IS DIRECTORY OPEN??? BEQ 11$ ; NO DIAG 0 ; YES--PUT MESSAGE 11$: JMP UNPACK ;DO FILE LISTING AGAIN 20$: MOV R0,-(SP) ; SAVE START POINT CALL $C5TA ; CHANGE TO ENGLISH MOV (SP)+,R2 ; GET TOP OF LIST DEC R0 ; BACK UP TO LAST CHAR IN STRING 30$: CMPB R2,R0 ; ALL DONE? BHIS 50$ ; BR IF DONE CMPB #'0,(R2) ; LEADING ZERO? BNE 50$ ; BR IF NO MOVB 1(R2),(R2) ; MOVE UP STRING MOVB 2(R2),1(R2) ; ... DEC R0 ; SHORTEN STRING BR 30$ ; TRY FOR MORE 50$: INC R0 ; RESET POINTER PAST STRING RETURN .DSABL LSB LSTE1: INC NUMFS ; ACCUM TOTAL BLOCKS USED/ALLOCATED MOV #HDBUF$+H.UFAT,R4 ; ADDR OF USER ATTRIBUTES ADD F.HIBK+2(R4),TBLKA+2 ; ALLOC ADC TBLKA ADD F.HIBK(R4),TBLKA MOV F.EFBK+2(R4),R1 ; USED BEQ 10$ TST F.FFBY(R4) ; 1ST FREE BYTE = 0? BNE 10$ DEC R1 ; YES--DON'T COUNT THE BLOCK 10$: ADD R1,TBLKU+2 ADC TBLKU BIT #LISW!MISW!FUSW,SWMSK$ ; JUMP OUT IF LISTING NOT WANTED BNE 20$ JMP PUT1 ; 20$: BIT #,SWMSK$ ;FULL or Medium LISTING BEQ PUT1 ;BR IF NO MOV LSTFDB+F.NRBD+2,R1;START OF LINE BUF ADD #20.,R1 ;POINT AT END OF NAME FIELD ; 30$: MOVB #' ,(R0)+ ; Pad with spaces CMP R0,R1 ; Enough? BLOS 30$ ; No - do another BIT #,SWMSK$ ; Just a Date type one? BEQ 90$ ; If EQ yes - just do dates MOV #FUTABL,R3 ; FORMAT TABLE ADDRESS BIT #FUSW,SWMSK$ ; REALLY BIG LISTING BNE 40$ ; If NE yes - get UICs & suchlike BIT #M2SW,SWMS2$ ; Type 2 Middle Size? BEQ 90$ ; If EQ no - just get Revision Date MOV #MITABL,R3 ; No - Change Table Address ; 40$: MOVB (R3)+,R4 ; PICK UP NEXT OFFSET BEQ 90$ ; BR WHEN END ADD #HDBUF$,R4 ; ADJ FOR ADDRESS OF BUFFER MOVB (R3)+,R1 ; PICK UP SIZE OF FIELD 50$: MOV R1,R2 ; COPY THAT ADD R0,R2 ; FIND HOW BIG THE LINE WILL BE MOV LINSZ$,-(SP) ; PUSH MAX SIZE OF RECORD ADD LSTFDB+F.NRBD+2,(SP) ; ADD IN START OF RECORD CMP R2,(SP)+ ; WILL IT GET TOO BIG? BLOS 60$ ; BR IF NO CALL PUTLST ; WRITE IT OUT MOV (PC)+,(R0)+ ; INSERT SOME SPACE .BYTE 40,40 ; 2 SPACES BR 50$ ; TRY AGAIN 60$: MOV R2,-(SP) ; PUSH END OF BUFFER MOVB (R3)+,(R0)+ ; INSERT LEADING CHAR BNE 70$ ; BR IF NOT A NULL DEC R0 ; BACK UP OVER NULL 70$: MOVB (R3)+,-(SP) ; SAVE TRAILING CHAR FOR LATER MOV (R4)+,R1 ; PICK UP 16 BIT ARG CALL @(R3)+ ; DISPATCH TO ROUTINE MOVB (SP)+,(R0)+ ; COPY TRAILING CHAR BNE 75$ ; Branch if not a Null DEC R0 ; Back up over a null ; 75$: MOV (SP)+,R1 ; GET END OF FIELD ADDRESS 80$: CMP R0,R1 ; IS RECORD UP TO END OF FIELD BHIS 40$ ; BR WHEN FIELD IS FULL MOVB #40,(R0)+ ; SPACE FILL BR 80$ ; TRY AGAIN ;;;; PRINT REVISION DATE & TIME 90$: BIT #RDSW,SWMS2$ ; Selection by Revision Date? BEQ 100$ ; If EQ no - do Creation Date BIT #FUSW,SWMSK$ ; Getting both anyway? BNE 100$ ; If NE yes - do Creation Date BIT #MISW,SWMSK$ ; Definitely only getting one? BEQ 110$ ; If EQ yes - do Revision Date BIT #M2SW,SWMS2$ ; Middle Size type that shows only one? BNE 110$ ; If NE yes - do Revision Date ; 100$: MOVB HDBUF$,R3 ASL R3 ADD #HDBUF$,R3 ADD #I.CRDT,R3 CALL PUTDTM ; INSERT DATE AND TIME BIT #,SWMSK$ ; Full or Middle Listing? BEQ PUT1 ; If EQ no - we've had enough BIT #FUSW,SWMSK$ ; Full Listing? BNE 110$ ; If NE yes - we want Revision Date BIT #M2SW,SWMS2$ ; Type 2 Middle Listing? BNE PUT1 ; If NE yes - we don't want Revision Date ; 110$: MOVB HDBUF$,R3 ASL R3 ADD #HDBUF$,R3 MOV I.RVNO(R3),R4 BEQ PUT1 ; NEVER REVISED, FORGET IT ADD #I.RVDT,R3 CALL PUTDTM CMP R4,#1 ; Not really revised if <1 BEQ PUT1 ; So ignore it MOV R4,R1 CLR R2 MOVB #'(,(R0)+ CALL $CBDMG MOVB #'.,(R0)+ MOVB #'),(R0)+ PUT1: BIT #SDSW,SWMSK$ ; Doing Selective Delete? BNE 10$ ; If NE yes - list in Read with Prompt BIT #LISW!MISW!FUSW,SWMSK$ ; Doing a listing? BEQ 5$ ; If EQ no - carry on CALL PUTLST ; OUTPUT THE LINE ; 5$: BIT #DESW,SWMSK$ ; ALWAYS DELETE BNE 80$ ; YES-DON'T BOTHER TO ASK JMP UNPACK ; Nope - go away 10$: MOV LSTFDB+F.NRBD+2,R2 ;GET ADDRESS OF BUFFER. SUB R2,R0 ; COMPUTE LENGTH OF BUFFER. MOV #PRMPT,R1 ; POINT TO PROMPT STRING. MOV (PC)+,(R1)+ ; START OUT AT BEGINNING OF LINE. .BYTE 15,12 ; 20$: MOVB (R2)+,(R1)+ ; MOVE IN THE FILENAME. SOB R0,20$ ; MOVE ALL OF IT. MOV #QBUF$,R2 ; POINT TO MESSAGE SUFFIX FOR QUESTION PROMPT MOV #QBUFS$,R0 ; GET LENGTH OF MESSAGE SUFFIX 30$: MOVB (R2)+,(R1)+ ; MOVE IT INTO PLACE SOB R0,30$ ; LOOP UNTIL THROUGH SUB #PRMPT,R1 ; COMPUTE LENGTH OF PROMPT STRING. 40$: CLRB LINBUF ; ERASE ANY PREVIOUS YES RESPONSES .IF DF R$$11M & R$$M30 ; ON RSX11M VERSION 3.0 OR EARLIER? QIOW$S #IO.WVB,#TTYLUN,#EFN1,,,,<#PRMPT,R1,#0> QIOW$S #IO.RVB,#TTYLUN,#EFN1,,#IOSB$,,<#LINBUF,#4> .IFF QIOW$S #IO.RPR,#TTYLUN,#EFN1,,#IOSB$,,<#LINBUF,#4,,#PRMPT,R1,#0> .ENDC MOV LSTFDB+F.NRBD+2,R0 ; RECOVER BUFFER ADDR TSTB IOSB$ ; ANY ERR-MUST BE EOF BGT 60$ ; BR IF NO ERR 50$: RETURN ; *** EXIT THIS RUN ### 60$: BICB #40,LINBUF ; CONVERT TO UPPER CASE CMPB #'Y,LINBUF ; WAS THE ANSWER YES? BEQ 80$ ; IF YES, DELETE THE FILE CMPB #'G,LINBUF ; WAS THE ANSWER GO? BNE 70$ ; IF NO, CHECK FOR QUIT .IF DF R$$11M & R$$M30 ; ON RSX11M VERSION 3.0 OR EARLIER? QIOW$S #IO.WVB,#TTYLUN,#EFN1,,,,<#QBF1$,#QBF1S$,#0> ; ASK IF SURE QIOW$S #IO.RVB,#TTYLUN,#EFN1,,#IOSB$,,<#LINBUF,#4> ; READ RESPONSE .IFF QIOW$S #IO.RPR,#TTYLUN,#EFN1,,#IOSB$,,<#LINBUF,#4,,#QBF1$,#QBF1S$,#0> .ENDC TSTB IOSB$ ; ANY ERRORS? BLE 50$ ; IF YES, RETURN BICB #40,LINBUF ; CONVERT TO UPPER CASE CMPB #'Y,LINBUF ; SURE? BNE 40$ ; IF NOT, PROMPT AGAIN BIC #SDSW,SWMSK$ ; CLEAR SELECTIVE DELETE FLAG BIS #DESW,SWMSK$ ; SET DELETE SWITCH BR 80$ ; START TO DELETE THE FILES 70$: CMPB #'Q,LINBUF ; WAS THE ANSWER QUIT? BEQ 50$ ; IF YES, RETURN BR UNPK1 ; NO FOR THIS FILE; SEE ABOUT ABOUT NEXT FILE 80$: MOV R5,R0 ; COPY PLCE IN DIRECTORY BUFFER MOV #UFDFDB+F.FNB+N.FVER+2,R1 ; POINT AT FILE NAME BLOCK END MOV #8.,R2 ; SET NUMBER OF WORDS IN DIRECTORY ENTRY 90$: MOV -(R0),-(R1) ; COPY THE DATA SOB R2,90$ ; DO ALL MOV #UFDFDB,R0 ; POINT AT FDB PROPER MOV SAVDID,F.FNB+N.DID(R0) ; RESTORE MOV SAVDID+2,F.FNB+N.DID+2(R0) ; DIRECTORY ID MOV SAVUNM,F.FNB+N.UNIT(R0) ; DEVICE UNIT NUMBER MOV SAVDVN,F.FNB+N.DVNM(R0) ; ---AND FINALLY NAME CALL .DLFNB BCC UNPK1 ; BR IF DELETE WORKED DIAG FDEL ; ISSUE DIAGNOSTIC MESSAGE UNPK1: JMP UNPACK ; DO THE NEXT PUTDTM: MOV #DTSTR,R2 ;DATE-TIME FORMAT STRING MOVB (R2)+,(R0)+ ;ONE MORE 4$: MOVB (R2)+,R1 ;GET NEXT SIZE BEQ 8$ 6$: MOVB (R3)+,(R0)+ ;COPY DATE SOB R1,6$ ;COUNT FIELD MOVB (R2)+,(R0)+ ;TERMINATOR BR 4$ 8$: RETURN ; SIZECV: CLR R2 ; SET ZERO SUPPRESS FLAG TST -2>(R4) ; IS FIRST FREE BYTE 0 BNE 10$ ; IF NO-PROCEED TST R1 ; Any blocks? BEQ 10$ ; If EQ no - don't want -1 DEC R1 ; IF YES-DONT COUNT THIS BLOCK IN SIZE 10$: CALL $CBDMG ; CHANGE SIZE TO ENGLISH MOV >(R4),R1 ; GET HIGHEST ALLOCATED BNE 20$ ; IF NE - HIGHEST ALLOCATED NON-ZERO ;BT001 CALL ABCALC ; CALC ALLOC BLKS FROM RETRIEVAL PTRS ;BT001 20$: ;BT001 MOVB #'.,(R0)+ ; INSERT A . MOVB #'/,(R0)+ ; INSERT A SEPARTOR CLR R2 ; ZERO SUPPRESS CALL $CBDMG ; COVERT MOVB #'.,(R0)+ ; INDICATE DECIMAL. RETURN ; AND RETURN. ; ;BT001 ;ABCALC---CALCULATE ALLOCATED BLOCKS FROM RETRIEVAL POINTERS IN CASE VALUE ;BT001 ; STORED IN HEADER IS INCORRECT (E.G. FILE NOT PROPERLY CLOSED) ;BT001 ; CALLED ONLY WHEN VALUE IN HEADER IS ZERO. (EXTENSION HEADERS ;BT001 ; ARE IGNORED.) RETURNS VALUE IN R1; DESTROYS R2. ;BT001 ABCALC: CLR R1 ; START WITH 0 BLOCKS ;BT001 MOVB HDBUF$+S.HDHD+S.IDHD+M.USE,R2 ; # OF WORDS OF PTRS IN USE ;BT001 BEQ 60$ ; IF EQ - ALLOCATION IS REALLY 0 ;BT001 ASR R2 ; CONVERT TO # OF RETRIEVAL PTS IN USE ;BT001 BIC #177600,R2 ; CLEAR ANY SIGN EXTENSION FROM MOVB AND ASR ;BT001 MOV R0,-(SP) ; SAVE R0 ;BT001 MOV R4,-(SP) ; SAVE R4 ;BT001 MOV #HDBUF$+S.HDHD+S.IDHD+M.RTRV,R4 ; START OF RETRIEVAL PTRS ;BT001 20$: MOV (R4)+,R0 ; GET FIRST RETRIEVAL POINTER WORD ;BT001 CLRB R0 ; CLEAR NON-COUNT PORTION ;BT001 SWAB R0 ; COUNT - 1 ;BT001 INC R0 ; COUNT FOR THIS POINTER ;BT001 ADD R0,R1 ; ADD THIS TO TOTAL FOR THIS FILE ;BT001 TST (R4)+ ; ADVANCE TO NEXT RETRIEVAL POINTER ;BT001 SOB R2,20$ ; PROCESS NEXT ONE ;BT001 TST HDBUF$+H.UFAT+F.HIBK+2 ; HEADER REPORTS 0 ALLOCATED BLOCKS? ;BT001 BNE 50$ ; IF NE NO ;BT001 ADD R1,TBLKA+2 ; YES - ADD VALUE CALCULATED TO DIRECTORY TOTAL ;BT001 ADC TBLKA ;BT001 50$: MOV (SP)+,R4 ; RESTORE R4 ;BT001 MOV (SP)+,R0 ; RESTORE R0 ;BT001 60$: RETURN ; AND RETURN ;BT001 ; UICCV: MOV R1,-(SP) ; SAVE UIC CLRB R1 ; REMOVE PROGRAMMER NUMBER SWAB R1 ; GET PROGECT INTO LO BYTE CLR R2 ; SUPPRESS ZERO'S CALL $CBOMG ; CONVERT THAT MUCH CLR R1 ; GET READY FOR UNSIGNED--- BISB (SP)+,R1 ; MOVE BYTE OF PROGRAMMER NUMBER CLR R2 ; ZERO SUPPRESS MOVB #',,(R0)+ ; SEPARATE WITH COMMA CALLR $CBOMG ; COVERT FOR OUTPUT ; CLMCV: MOV #CLMFLD,R2 ; GET ADDRESS OF CONTIG-LOCKED-MULTIHDR FIELD MOV #4,R1 ; BYTE COUNT 30$: MOVB (R2)+,(R0)+ ; MOVE FIELD TO OUTPUT LINE SOB R1,30$ ; MOVE ALL OF IT RETURN ; FIDCV: CLR R2 ; SUPPRESS ZEROS CALL $CBOMG ; CONVERT TO OCTAL MOVB #',,(R0)+ ; SEPARATE MOV (R4),R1 ; GET SEQ NUMBER CLR R2 ; SET ZERO SUPPRESS AGAIN! CALLR $CBOMG ; CONVERT THAT ; FPROCV: MOV #4,R2 ; NUMBER OF FILELDS TO CONVERT 10$: MOV #FPSTR,R3 ; FORMAT STRING 20$: ASR R1 ; MOVE 1 BIT INTO C BCS 30$ ; BR IF NOT ACTIVE MOVB (R3),(R0)+ ; INSERT A DESRIPTOR CHAR 30$: INC R3 ; ADJ FORMAT STRING TSTB (R3) ; END OF LIST BNE 20$ ; BR IF NO MOVB #',,(R0)+ ; INSERT A SEPARATOR SOB R2,10$ ; LOOP? DEC R0 ; NO-BACK UP OVER LAST COMMA ; 40$: RETURN ; ;PUTLST---PUT A RECORD INTO LISTING FILE ; PUTLST: BIT #BKSW,SWMS3$ ; /BK INITIAL BLANKS SWITCH SPECIFIED? ;BT002 BEQ PUTLS1 ; IF EQ NO - OMIT THE 2 BLANKS ;BT002 SUB #2,LSTFDB+F.NRBD+2 ; 2 LEADING SPACES PUTLS1: SUB LSTFDB+F.NRBD+2,R0 ;FIND LENGTH OF LINE MOV R0,LSTFDB+F.NRBD ;SET LENGTH INTO FDB PUT$S #LSTFDB ;WRITE THE LINE MOV #LINBUF,LSTFDB+F.NRBD+2 BCC 10$ FERR PUTE ;???CAN'T DO PUT??? 10$: MOV #LINBUF,R0 ;GET RECORD BUFFER RETURN .END