.MCALL .MODULE .MODULE DUPSCN,VERSION=11,COMMENT=,IDENT=NO ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only 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 except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL Edit History ; Edit History: ; ; 001 28-Jan-80 10:54 Guldenschuh, Chuck cpg [240,148] ; Correct scan while volume offline problem ; (001) ; 002 31-Jan-80 01:44 Guldenschuh, Chuck cpg [240,148] ; Correct MDUP conditional assembly ; (002) ; 003 02-Dec-80 11:31 AM David Fingerhut [240,134] ; Account for RK07 Status Word during bad block scan ; (003) ; 004 20-Mar-81 03:03 PM David Fingerhut [240,134] ; INIT/BAD does /REPLACE rather than create FILE.BAD's ; (004) ; 005 24-Nov-81 02:05 PM David Fingerhut [40,134] ; Don't allow over 128 bad blocks ; (005) ; 006 16-Feb-82 12:47 PM David Fingerhut [40,134] ; MDUP - debug ; (006) ; 009 06-Nov-1990 JFW ; bracket error messages in ;+/;ERROR/.../;- ; (010) 09-Jun-91 MBG Correct code to allow /END:0 ; ; (011) 25-Jul-91 MBG Added code to validate the home block for ; devices which do replacement. .SBTTL PSECT definitions .ENABL LC,GBL .IIF NDF MDUP, MDUP = 0 ;Default to no MDUP .IIF NDF M$UPD, M$UPD = 0 ;Default to no MDUP Update .IIF NDF SDC, SDC = 0 ;Default to no SDCOPY .IIF NDF .DBG., .DBG. == 0 ;Default to no debugging PSECT ...ERS ; ;001 PSECT IMPURE ;Impure data area PSECT PURE ;Data psect PSECT PUREB ;Data psect PSECT .LIBD. ;Library data (error messages) PSECT .LIBP. ;Library pointers (error messages) PSECT .LIBC. ;Library code psect PSECT SCAN1 ;Code psect PSECT PATCH ;Patch psect .BLKW 32. .MACRO PRINT BUF .IF NB BUF MOV BUF,R0 .IFF MOV #CRLF,R0 .ENDC CALL PRTIT .ENDM PRINT .IF EQ MDUP .SBTTL Error Messages .MACRO ERRMSG NAME,TEXT DS NAME,BYTE .PSECT .LIBD. EM.'NAME: .ASCII \TEXT\<200> .PSECT .LIBP. .WORD EM.'NAME .ENDM ERRMSG .MACRO MSGLST NAME .DSECT ...ERS,GLOBAL=NO .PSECT .LIBP. NAME: .WORD ..MAX. .ENDM MSGLST .MACRO MSGEND DS ..MAX.,BYTE .ENDM MSGEND ;+ ;ERROR MSGLST OERTAB ERRMSG BSA, ;001 ERRMSG NBB, MSGEND ;- .IFTF ;EQ MDUP ;CG03 .SBTTL Impure data PSECT IMPURE LSTBLK: .WORD 0 ;Size of device ;Error message area block .IFT ;EQ MDUP ;CG03 OEAREA: .BYTE 0 ; Error code byte .BYTE 0 ; Error level/return flag .WORD ERRPRE ; -> Error message prefix .WORD ERRLEV ; -> Error level byte .WORD OERTAB ; -> Error message offset table .WORD 0 ; -> File name block .WORD ABORT ; -> Abort return .ENDC ;EQ MDUP .IF EQ MDUP OUTBLK: .WORD 0 THISFL: .WORD 0 .ENDC ;EQ MDUP PSECT PUREB .NLIST BEX HEAD1: .ASCIZ \ Block Type\ .IF EQ MDUP HEAD2: .ASCIZ \ File Block\ .IFT ;EQ MDUP REP: .ASCIZ \Replaceable \ REPD: .ASCIZ \Replaced \ .IFTF ;EQ MDUP SOFT: .ASCIZ \Soft \ HARD: .ASCIZ \Hard \ .IFT ;EQ MDUP UNUSED: .ASCIZ \< UNUSED > \ .ENDC ;EQ MDUP CRLF: .ASCIZ <15><12> ;+ ;ERROR .IF EQ SDC .IF EQ MDUP DUPI: .ASCII \?DUP\ .IFF ;EQ MDUP DUPI: .ASCII \?MDUP\ .ENDC ;EQ MDUP .IFF ;EQ SDC DUPI: .ASCII \?SDCOPY\ .ENDC ;EQ SDC .ASCII \-W-Bad blocks detected \ DUPNUM: .ASCII \00000.\<200> ;- .LIST BEX .SBTTL SCAN - Bad block scan ;+ ; SCAN ; This routine does the setup for the actual scan routine, and processes ; the data that it and the error handler return to it. ; ; CALL SCAN ;- ORIGIN SCAN1 .ENABL LSB SCAN:: SAVE05 ;Save all registers. We may be called. WAIT #WAITIN,#INFILE ;Wait for the input device .IF EQ MDUP MOV REDEND,R4 ;R4 = Last block to scan .IFTF ;EQ MDUP MOV #INST,R0 ;Else get the device size;R0 -> .DSTATUS info MOV #$ISFLG,R1 ;R1 -> device file flag MOV #ICHAN,R2 ;R2 = input channel number CALL GTDVSZ ;Get the device size of the file .IFT ;EQ MDUP MOV R1,LSTBLK ;Save the device size TST REDSW ;Was /END value specified? BNE 20$ ;Yes, so even /END:0 is valid .ENDC ;EQ MDUP TST R1 ;Get a value? BNE 10$ ;Branch if so DEC R1 ;Fix for INC below 10$: DEC R1 ;Fix for 0 basing below MOV R1,R4 ;Save the device size 20$: MOV REDSTR,R3 ;R3 = input block number to start scanning SUB R3,R4 ;R4 = the number of blocks to scan BHIS 30$ ;/END value greater or equal to /START ;+ ;ERROR .ERR #ERAREA,#ILC,LEVEL=FATAL,RETURN=NO ; <-F-Invalid command> ;- 30$: INC R4 ;0 based block numbers .GTCOR # ;Get the bad block list area BCS 50$ ;Branch if we didn't get enough MOV R0,BADLHD ;Save the address CLR @R0 ;No entries in table yet 40$: .GTCOR #-2 ;Ask for what's left BCC 60$ ;Branch if we got some ;+ ;ERROR 50$: .ERR #ERAREA,#FE.NOM,LEVEL=FATAL,RETURN=NO ; <-F-Insufficient memory> ;- ; ; Since the .SPFUN reads may need some extra space in the buffer, make sure ; that there is at least one word more in the buffer than we will actually ; use in most cases. ; 60$: TST (R0)+ ;Bump the pointer by 1 word MOV R0,R2 ;Save the buffer start address MOV R1,BSIZE ;Save the size of the allocated block ;CLC ;Got to be clear to get here ROR R1 ;R1 = number of words DEC R1 ; minus 1 for .SPFUN sluff MOV R1,R0 ;Save number of words we got BIC #377,R1 ;Get number of blocks in high byte (= # words) BEQ 50$ ;Branch on error BIT #DEV.SC,$ISFLG ;Do we use .SPFUN read's to scan the device? BEQ 70$ ;Branch if not INCB SPFUNI ;Say that we're doing .SPFUN's to the device INCB SPFUNO ;Do .SPFUN's for the /VERIFY too 70$: MOV R1,R5 ;R5 = number of words .IF EQ MDUP ;002 READ #IOAREA,#ICHAN,R2,#1,#0 ;Read 1 word to see if device is;001 BCC 80$ ;Branch if it looks ok ;001 ;+ ;ERROR .ERR #OEAREA,#BSA,LEVEL=FATAL,RETURN=NO,FILE=#INFILE ;001 ; <-F-Bad block in system area DEV:> ;001 ;- ;001 .ENDC ;EQ MDUP ;002 80$: CALL SCCA ;Inhibit ^C ;001 CALL SCANER ;Go do the scan. CLRB SPFUNI ;No more spfun's CLRB SPFUNO ;No more spfun's TST CTRLC ;Did we get an ^C? BPL 90$ ;Branch if not CLR CTRLC ;Clear the flag .TTYIN ;Eat the first ^C .TTYIN ;Eat the second ^C 90$: CALL NOSCCA ;Turn off ^C intercept .IF EQ MDUP BIT #,$ISFLG ;Device support bad block replacement? BEQ 100$ ;Branch if not BIT #,$ISFLG ;Is device MSCP? BNE 100$ ;Branch if so INCB SPFUNI ;Do read with a .SPFUN CALL GTMBSF ;Get and merge manufactuors bad sector file CLRB SPFUNI ;Do real .READ's now .ENDC ;EQ MDUP 100$: MOV #FREMLH,R0 ;R0 -> free memory list head MOV BSIZE,R1 ;R1 = size of the buffer we were allocated TST -(R2) ;Return the word that we stole CALL $RLCB ;Release the scan buffer MOV BADLHD,R5 ;R5 -> bad block data MOV (R5)+,R4 ;R4 = number of entries BNE 110$ ;Branch if we got some ;+ ;ERROR .ERR #OEAREA,#NBB,LEVEL=INFORM,RETURN=YES,FILE=#INFILE ; <-I-No bad blocks detected dev:> ;- .PURGE #OCHAN ;Get rid of the output file, if any MOV BADLHD,R2 ;R2 -> bad block list area MOV #,R1 ;R1 = size of area MOV #FREMLH,R0 ;R0 -> free memory list head CALL $RLCB ;Release the memory CLR BADLHD ;In case called by initialize code RETURN ;No more output to do! 110$: ;005 ;+ ;ERROR ;We're not allowing more than MAXBAD bad blocks ;005 ; CMP R4,#MAXBAD ;Too many bads? ;005 ; BLE 120$ ;Branch if not ;005 ; .ERR #ERAREA,#TMB,LEVEL=WARN,RETURN=YES,FILE=#INFILE ;005 ; <-W-Too many bad blocks dev:> ;- 120$: .IF EQ MDUP BIT #FL.ZRO,$AFLAG ;Are we initializing the device? BNE 210$ ;BR if so. No replacement table or filenames BIT #,$ISFLG ;Device support bad block replacement BEQ 180$ ;Branch if not .GTCOR #*2 ;Get buffer for replacement table ; (MAXREP entries @ 2 words/entry plus ; fence word, all @ 2 bytes/word) BCC 140$ ;Branch if no error ;001 130$: JMP 50$ ;Else, no room ;001 ; <-F-Insufficient memory> ;001 140$: MOV R0,REPBUF ;Save the start address ;001 MOV R1,BSIZE ; and the amount actually allocated READ #IOAREA,#ICHAN,REPBUF,#,#HOMBLK ;Read in table BCS 160$ ;In case of error... MOV REPBUF,R0 ;R0 -> Replacement table MOV #,R1 ;R1 = Replacement table length (words) 150$: TST (R0)+ ;Found end of table? BEQ 190$ ;Yes, table is valid... DEC R1 ;Nope, keep looking for fence BGT 150$ ; ... BR 170$ ;No end to table, invalidate it... ;+ ;ERROR 160$: .ERR #ERAREA,#ERT,LEVEL=FATAL,RETURN=YES,FILE=#INFILE ; <-F-Error reading bad block replacement table dev:> ;- 170$: MOV #FREMLH,R0 ;R0 -> free memory list head MOV REPBUF,R2 ;R2 -> block to release CALL $RLCB ;Release the memory 180$: CLR REPBUF ;Don't try to check the table 190$: BIT #FL.FIL,$MFLAG ;Does he want filenames? BEQ 210$ ;Branch if not .GTCOR # ;Get a directory buffer BCS 130$ ;Branch if not enough memory ; <-F-Insufficient memory> MOV R0,$DIRBF ;Save the pointer to the buffer MOV #1,$NXTSG ;Start with the first segment CLR $NXTFL ;Start with first file ;+ ;ERROR MOV #ICHAN,$DIRCH ;Set up the channel CALL NEXTFL ;Point to first file BCC 200$ ;Branch if no error MOV R0,R1 ;Save the error code .ERR #ERAREA,R1,LEVEL=FATAL,RETURN=YES,FILE=#INFILE ;CG11 ; <-F-Directory input error dev:> ; <-F-Invalid directory dev:> ;- MOV #FREMLH,R0 ;R0 -> free memory list head MOV #,R1 ;R1 = size of the buffer MOV $DIRBF,R2 ;R2 -> area to release CALL $RLCB ;Release the core block BIC #FL.FIL,$MFLAG ;Don't print filenames BR 210$ ; 200$: MOV R0,THISFL ;Save pointer to filename .IFTF ;EQ MDUP 210$: CLR OUTBUF ;Clear the output buffer pointer .IFT ;EQ MDUP .GTCOR #512. ;Get the buffer space BCS 130$ ;Branch if no room .IFF ;EQ MDUP .GTCOR #80. ;Get small buffer space BCS 50$ ;Branch if no room .ENDC ;EQ MDUP ; <-F-Insuffient memory> MOV R0,OUTBUF ;Save the pointer to the buffer MOV R0,BFPTR ;Initialize the buffer pointer ADD R1,R0 ;R0 -> end of the buffer MOV R0,BUFEND ;Save it 220$: .BR SCAN2 ;Go do output via root segment .DSABL LSB .SBTTL SCAN2 - Output bad block scan information ;+ ; SCAN2 ; This routine is called to output the information gathered by the scan code. ; ; R4 = # of entries in the bad block list ; R5 -> 1st entry in bad block list ; ; JMP SCAN2L ; ; Bad block information sent to output file ;- .ENABL LSB SCAN2:: .IF EQ MDUP CLR OUTBLK ;Clear the output block number .IFTF ;EQ MDUP PRINT #HEAD1 ;Set up the header .IFT ;EQ MDUP BIT #FL.FIL,$MFLAG ;Want the filenames? BEQ 1$ ;Branch if not PRINT #HEAD2 ;Set up the second part of the header .IFTF ;EQ MDUP 1$: PRINT ;Print the header 2$: MOV (R5)+,R3 ;Save the bad block flag MOV (R5)+,R1 ;Get the block number .IFT ;EQ MDUP BNE 3$ ;Branch if there JMP 20$ ;Else done .IFF ;EQ MDUP BEQ 22$ ;Branch if done .IFTF ;EQ MDUP 3$: TST (R5)+ ;Skip the number of blocks (=1) CALL TWODIG ;Output the block number .IFT ;EQ MDUP MOV #SOFT,R2 ;Assume a soft error BIT #BAD.SW,R3 ;Is it? BNE 8$ ;Branch if so MOV #REP,R2 ;Try replaceable BIT #BAD.RP,R3 ;Is it? BEQ 7$ ;Branch if not TST REPBUF ;Got a replacement table? BEQ 8$ ;Branch if not. Can't be "replaced" yet MOV R0,-(SP) ;Save the line buffer pointer MOV REPBUF,R0 ;R0 -> replacement table buffer 4$: TST @R0 ;Are we done? ;CG11 BEQ 6$ ;Branch if so. Block not replaced ;CG11 CMP R1,@R0 ;Is this the block? BEQ 5$ ;Branch if so CMP (R0)+,(R0)+ ;R0 -> next entry BR 4$ ;Try again 5$: MOV #REPD,R2 ;Say it's replaced 6$: MOV (SP)+,R0 ;Restore line buffer pointer BR 8$ ; .IFTF ;EQ MDUP 7$: MOV #HARD,R2 ;Got to be hard 8$: PRINT R2 ;Store the bad block type .IFT ;EQ MDUP BIT #FL.FIL,$MFLAG ;Output the filename? BEQ 18$ ;Branch if not MOV R0,-(SP) ;Save the line buffer pointer 9$: MOV THISFL,R2 ;R2 -> current file in the directory buffer 10$: BIT #DS.EOS,@R2 ;This an end of segment? BNE 11$ ;Branch if so. Get next file CMP R1,$STBLK ;Is the bad block in this file? BHI 14$ ;Branch if maybe BEQ 15$ ;Branch if yes ;+ ;ERROR 11$: CALL NEXTFL ;Else get the next directory entry BCS 13$ ;Branch on error ;- TST R0 ;Did we find an entry? BEQ 12$ ;Branch on end of directory !!!??? MOV R0,R2 ;Save the pointer to the entry MOV R0,THISFL ;Save it here for later ;CG11 BR 10$ ;Try again 12$: MOV #ILD,R0 ;Assume Invalid directory 13$: MOV R0,R2 ;Copy the error code PRINT ;Output a ;CG11 ;+ ;ERROR .ERR #ERAREA,R2,LEVEL=FATAL,RETURN=YES,FILE=#INFILE ; <-F-Invalid directory dev:> ; <-F-Directory input error dev:> ;- MOV (SP)+,R0 ;Restore the line buffer pointer BIC #FL.FIL,$MFLAG ;Turn off filename printing BR 19$ ;Continue ;CG11 14$: MOV $STBLK,R0 ;R0 = start block for current entry ADD DE.LEN(R2),R0 ;R0 -> next entry CMP R1,R0 ;Is bad block in file? BHIS 11$ ;Branch if not. Try next file 15$: SUB $STBLK,R1 ;R1 = Relative block number MOV (SP)+,R0 ;Restore line buffer pointer BIT #,(R2)+ ;Permanent file? BEQ 16$ ;Branch if so PRINT #UNUSED ;Else it's an unused entry BR 17$ 16$: MOV R1,-(SP) ;Save the relative block number MOV #CMDBUF,R1 ;R1 -> temp output buffer MOV (R2)+,R0 ;R0 = 1st word of filename CALL $R50AS ;Convert to ASCII MOV (R2)+,R0 ;R0 = 2nd word of filename CALL $R50AS ;Convert it to ASCII MOVB #'.,(R1)+ ;Put in a '.' MOV @R2,R0 ;R0 = filetype CALL $R50AS ;Convert it to ASCII MOVB #BLANK,(R1)+ ;Store a blank MOVB #BLANK,(R1)+ ; and another one CLRB @R1 ;Make it ASCIZ MOV (SP)+,R1 ;Restore the relative block number PRINT #CMDBUF ;Print the filename 17$: CALL TWODIG ; and the relative block number .IFTF ;EQ MDUP 18$: PRINT ;Print the line 19$: DEC R4 ;Decrement the count ;CG11 .IFT ;EQ MDUP BEQ 20$ ;Branch if done JMP 2$ ;Do the next one .IFF ;EQ MDUP BNE 2$ ;Do the next one .IFT ;EQ MDUP 20$: BIT #FLG.DV,$OSFLG ;Output file being generated? BEQ 22$ ;Branch if not MOV BFPTR,R4 ;R4 -> current position in buffer 21$: CLRB (R4)+ ;Clear a byte CMP R4,BUFEND ;At the end of the buffer? BLO 21$ ;Branch if not MOV R4,BFPTR ;Save the buffer pointer PRINT #HEAD2+1 ;Force the buffer out .IFTF ;EQ MDUP 22$: MOV OUTBUF,R2 ;R2 -> output buffer BEQ 23$ ;Branch if none MOV #FREMLH,R0 ;R0 -> free memory list head .IFT ;EQ MDUP MOV #512.,R1 ;R1 = size of output buffer .IFF ;EQ MDUP MOV #80.,R1 ;R1 = size of output buffer .IFTF ;EQ MDUP CALL $RLCB ;Release it 23$: .IFT ;EQ MDUP MOV $DIRBF,R2 ;R2 -> directory buffer BEQ 24$ ;Branch if none MOV #FREMLH,R0 ;R0 -> free memory list head MOV #,R1 ;R1 = size of directory segment CALL $RLCB ;Release it 24$: MOV REPBUF,R2 ;R2 -> replacement table buffer BEQ 25$ ;Branch if none MOV #FREMLH,R0 ;R0 -> free memory list head MOV #,R1 ;R1 = size of replacement table buffer CALL $RLCB ;Release the memory .ENDC ;EQ MDUP 25$: MOV BADLHD,R5 ;R5 -> bad block list MOV @R5,R1 ;R1 = number of bad blocks MOV #DUPNUM,R0 ;R0 -> output address for # of bad blocks CLR R2 ;Set no lead zero flag CALL $CBDMG ;Convert it to ASCII MOVB #'.,(R0)+ ;Store a decimal point CLRB @R0 ;Make it ASCIZ .PRINT #DUPI ;Print the message BISB #2,@#S$UERB ;Set the warning bit RETURN .DSABL LSB .SBTTL SCANER - Scan the disk ;+ ; SCANER ; This routine does the actual scan. If an error is encountered, it calls ; EHNDLR to process it. Please note that it is very important that the ; register assignments not be changed, as this routine is reentrant! ; ; R2 -> input buffer ; R3 = input block number ; R4 = # of blocks left to scan ; R5 = buffer size in words ; SPFUNI <> 0 => .SPFUN reads ; ; CALL SCANER ;- SCANER:: TST CTRLC ;^C^C typed? BMI 3$ ;Branch if so. Abort now. MOV R4,R0 ;R0 = # blocks left to read BEQ 3$ ;Branch if done MOV R5,R1 ;R1 = # words to read SWAB R1 ;R1 = # blocks in buffer CMP R0,R1 ;More to read than room for? BHIS 1$ ;Branch if so SWAB R0 ;Make # left a word count MOV R0,R5 ;Make it the buffer size 1$: READ #IOAREA,#ICHAN,R2,R5,R3 ;Read a buffer load BCC 2$ ;Branch if no error CALL EHNDLR ;Else go handle the error MOV R5,R0 ;Get word count back 2$: ADD #377,R0 ;Round up to block boundary BIC #377,R0 ; SWAB R0 ;Make it blocks ADD R0,R3 ;Update input block number SUB R0,R4 ; and # blocks left to read BNE SCANER ;Branch if more to read 3$: RETURN .SBTTL EHNDLR - Error handler ;+ ; EHNDLR ; This routine really does all the work in the bad block scan. Since the ; block number of the block which causes an error on a multiple block ; transfer is unknown, we have to search for it. This is done by saving ; the current state of the scan (SAVE35!!!), modifying the number of blocks ; left to read to be the number of blocks requested in the last transfer, ; splitting the buffer size in approximately half, and calling the scanner. ; When the block size is one and an error occurs, we have found a bad block. ; The block number is then saved, the previous state restored (via RETURN ; thru $SAVRG coroutine), and the scan continues. EHNDLR may be entered ; several times before the block is found. Multiple bad blocks in a transfer ; will automatically be picked up by this method. ; ; R2 -> input buffer ; R3 = input block number ; R4 = # blocks left to read ; R5 = # words to read ; SPFUNI <> 0 => .SPFUN read's used to scan. ; ; CALL EHNDLR ;- EHNDLR:: SAVE35 ;Save non-volatile registers (SCAN STATE!!!) MOV R5,R0 ;R0 = # words of last attempted transfer SWAB R0 ;R0 = # blocks of last attempted transfer DEC R0 ;Was it 1? BEQ 1$ ;Branch if so. We found a bad block ; MOV #BAD.PS,R5 ;Set up a "possible" bad block ; CALL 6$ ;Go put it in the list ; DEC @BADLHD ;Not a real bad block, yet ; NOTE: Remove the next line when this code goes in INC R0 ;Fix the count MOV R0,R4 ;This is new # blocks left to read MOV #400,R5 ;R5 = new word size of buffer (1 block) JMP SCANER ;Call the scanner. It will return to itself! 1$: CLR R5 ;Clear the bad block type flag .IF EQ MDUP BIT #FL.WRT,$MFLAG ;/H given? BEQ 2$ ;Branch if not WRITE #IOAREA ;Write the block back out READ #IOAREA ;Read it back in BCS 2$ ;Branch if no error MOV #BAD.SW,R5 ;Soft error BR 4$ ; .IFTF ;EQ MDUP 2$: CLR R0 ;Fix the number of blocks (- 1) .IFT ;EQ MDUP MOV #BAD.RP,R5 ;Assume replaceable bad block BIT #DEV.DU,$ISFLG ;Is device MSCP? BNE 3$ ;Branch if so BIT #DEV.SR,$ISFLG ;Does device support bad block replacement? BNE 5$ ;Branch if it does once in a while BIT #DEV.AR,$ISFLG ;Always replaceable? BNE 6$ ;Branch if so .IFTF ;EQ MDUP 3$: MOV #BAD.NR,R5 ;Never replaceable or block not replaceable .IFT ;EQ MDUP BR 6$ ; 4$: CLR R0 ;Fix the block count (- 1) 5$: BIT #,@R2 ;Is this block replaceable?(BSE or HVRC) BEQ 3$ ;Branch if not. Make it a .BAD 6$: BIT #BAD.RP,R5 ;Is this a replaceable block? BEQ 7$ ;Branch if not BIT #FL.REP,$MFLAG ;Are we doing bad block replacement? BNE 7$ ;Branch if so BIS #BAD.NR,R5 ;Say that it is non-replaceable .ENDC ;EQ MDUP 7$: MOV BADLHD,R1 ;R1 -> Bad block list MOV @R1,R4 ;R4 = number of entries INC (R1)+ ;We're adding one more CMP R4,#MAXBAD ;Do we have the max already? BLT 75$ ;Branch if not ;005 ;+ ;ERROR .ERR #ERAREA,#TMB,LEVEL=FATAL,RETURN=NO ;005 ; <-F-Too many bad blocks> ;005 ;- ; BGE 9$ ;Branch if so. Can't add any more ;005 75$: ASL R4 ;Make R4 a word offset ;005 MOV R4,-(SP) ;Triple word table ASL R4 ;So multiply by 2 ADD (SP)+,R4 ; by 3 ADD R4,R1 ;R1 -> new entry in table ; TST @R1 ;Is there a possible bad block there? ; BEQ 8$ ;Branch if not. Go ahead ; CMP R4,2(R1) ;Do the starting blocks match ; BEQ 8$ ;Branch if so. Update in place ; MOV 2(R1),-(SP) ;Save start block number ; ADD 4(R1),@SP ;Add in size ; CMP R4,(SP)+ ;Was this one inside the other? ; BLO 8$ ;Branch if so. Update in place ; CLR 6(R1) ;Set up next block for call ; BR 6$ ;Add another block ; 8$: MOV R5,(R1)+ ;Store the bad block type flag MOV R3,(R1)+ ;Store the block number INC R0 ;Fix the block count MOV R0,(R1)+ ;Store the number of blocks CLR @R1 ;Zero the next element 9$: RETURN .SBTTL TWODIG - Output an octal and decimal value ;+ ; TWODIG ; This routine outputs is called to output block numbers in octal and decimal. ; ; R1 = number to output ; ; CALL TWODIG ; ; Number is output ; CMDBUF is modified ;- TWODIG: SAVE05 ;Preserve all registers MOV R1,R5 ;Save the number MOV #CMDBUF,R3 ;R3 -> temp output buffer CALL OCTOUT ;Set up the octal version MOVB #BLANK,(R3)+ ;Put in a blank MOVB #BLANK,(R3)+ ; and another one MOV R5,R1 ;Get the value back CALL DECOUT ;Output it as decimal MOVB #'.,(R3)+ ;Put in the decimal point MOVB #BLANK,(R3)+ ;Put in a blank MOVB #BLANK,(R3)+ ; and another one CLRB (R3)+ ;Make it ASCIZ PRINT #CMDBUF ;Move it to the output buffer RETURN DECOUT: MOV #5,R0 ;Field width is 5 JSR R3,SETUP ;Set up for conversion CLR R2 ;Flag no leading zeros CALL $CBDMG ;Convert the number RETURN ;!!!Co-routine return OCTOUT: CLR R0 ;Field width is 0 JSR R3,SETUP ;Set up for conversion MOV #1,R2 ;Flag leading zeros wanted CALL $CBOMG ;Convert the number RETURN ;!!!Co-routine return SETUP: MOV R0,-(SP) ;Save the field width SUB #6,SP ;Set up the temp buffer MOV SP,R0 ;Save pointer to area MOV R3,-(SP) ;Put return address on stack JSR PC,@(SP)+ ;Co-routine return SUB SP,R0 ;Get the number characters converted MOV 10(SP),R3 ;Point to output buffer MOV R3,R1 ;Copy it MOV R3,R2 ;Copy it ADD 6(SP),R3 ;Add the field size CMP R2,R3 ;Zero length feild? BEQ 2$ ;Branch if so SUB R0,R3 ;We have to have that many characters MOV R3,R1 ;Save it 1$: CMP R2,R3 ;Blank this space? BHIS 2$ ;Branch if not MOVB #40,-(R3) ;Put in a blank BR 1$ ;Loop 2$: MOV R1,R3 ;Copy the output pointer MOV SP,R1 ;Point to temp buffer 3$: DEC R0 ;Count down BLT 4$ ;Branch if done MOVB (R1)+,(R3)+ ;Store the character BR 3$ ;Loop 4$: ADD #12,SP ;Clean off the stack RETURN .SBTTL PRTIT - Output routine ;+ ; PRTIT ; This routine sends a line to the output file or the terminal. ; ; R0 -> line to be output (ASCIZ) ; ; CALL PRTIT ;- PRTIT: SAVE35 ;Save non-volatile registers MOV R0,R5 ;Save line pointer MOV BFPTR,R4 ;R4 -> current position in output buffer .IF EQ MDUP 1$: CMP R4,BUFEND ;Room left? BLO 3$ ;Branch if so WRITE #IOAREA,#OCHAN,OUTBUF,#256.,OUTBLK BCC 2$ ;Branch if no error ;+ ;ERROR .ERR #ERAREA,#FE.OPE,LEVEL=FATAL,RETURN=NO,FILE=#OUTFIL ; <-F-Output error dev:filename> ;- 2$: INC OUTBLK ;Bump the output block number MOV OUTBUF,R4 ;R4 -> start of the output buffer MOV R4,BFPTR ;Set up the buffer pointer .IFTF ;EQ MDUP 3$: MOVB (R5)+,(R4)+ ;Store a byte .IFT ;EQ MDUP BNE 1$ ;Branch if more to come .IFF ;EQ MDUP BNE 3$ ;Branch if more to come .IFTF ;EQ MDUP DEC R4 ;Back off a byte MOV R4,BFPTR ;Save the new pointer .IFT ;EQ MDUP BIT #FLG.DV,$OSFLG ;Do we actually have an output file? BNE 4$ ;Branch if so .ENDC ;EQ MDUP MOVB #200,@R4 ;No extraneous .PRINT OUTBUF ;Print the line MOV OUTBUF,BFPTR ;Start at the beginning again 4$: RETURN .SBTTL GTMBSF - Get and merge manufacturer's bad sector file ;+ ; This routine reads in the manufacturer's bad sector file and merges it with ; the bad block list. ; ; * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * ; This routine is duplicated in DUPZRO. If you modify one, modify them both!! ; * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * NOTE * ; ; R2 -> input buffer ; ; CALL GTMBSF ;- .MACRO MBSF DEV,SLUFF,NUMSEC,TPC,SPT,HACK .WORD DEV'ID ;Data for DEV .WORD SLUFF ;Bad sector file starts at last block + SLUFF .WORD NUMSEC ;NUMSEC sectors containing file .WORD TPC ;TPC tracks/cylinder .WORD SPT ;SPT sectors/track .WORD HACK ;Computed block is divided by 2^HACK .ENDM MBSF PSECT PURE .LIST MEB MBSFTB:: MBSF DM,44.,5,3,22.,0 MBT.SZ = . - MBSFTB MBSF DL,10.,5,2,40.,1 .NLIST MEB .BLKW MBT.SZ*2 ;Leave room for 2 more devices .WORD 0 ;End of table PSECT IMPURE LISTMB: .BLKW 3 ;Temp bad block element PSECT * GTMBSF:: SAVE05 ;Save all registers MOV #MBSFTB,R3 ;R3 -> table of device data 1$: TST @R3 ;Any more devices to check? BEQ 11$ ;Branch if not. Done CMPB @R3,INST ;Is this the device BEQ 2$ ;Branch if so. ADD #MBT.SZ,R3 ;R3 -> data for next device BR 1$ ;Go try again 2$: MOV R2,R4 ;R4 -> start of input buffer TST (R3)+ ;Get rid of device id MOV (R3)+,R1 ;R1 = number of blocks to add to last block ADD LSTBLK,R1 ;R1 = block number of bad sector file 3$: MOV R4,R2 ;Restore R2 to point to start of input buffer READ #IOAREA,#ICHAN,R2,#256.,R1 ;Read in a block of the file BCC 5$ ;Branch if no error 4$: ADD #2,R1 ;R1 -> next block of file DEC @R3 ;Decrement the number of blocks left in file BEQ 11$ ;Branch if none left BR 3$ ;Try to read this one 5$: BIT #DEV.SR,$ISFLG ;Input device sometimes replaceable (RK06/7)? BEQ 6$ ;Branch if not TST (R2)+ ;Skip status return 6$: TST (R3)+ ;Skip number of blocks CMP (R2)+,(R2)+ ;Skip pack serial number TST @R2 ;Is the word 0? BEQ 7$ ;Branch if so TST -(R3) ;Back up -> block counter ;003 BR 4$ ;Try read the next one 7$: CMP (R2)+,(R2)+ ;Skip leading 0 words 8$: CMP @R2,#-1 ;At the end of file? BEQ 11$ ;Branch if so. MOV R3,-(SP) ;Save R3 for next element in file MOV (R2)+,R1 ;R1 = cylinder of bad sector MOV (R3)+,R0 ;R0 = # tracks/cylinder CALL $MUL ;R1 = CYL * TRK/CYL MOV (R2)+,R4 ;R4 = .BYTE SECTOR,TRACK MOV R4,-(SP) ;Save it CLRB R4 ;Get rid of sector SWAB R4 ;Get track in low byte ADD R4,R1 ;R1 = CYL * TRK/CYL + TRK MOV (R3)+,R0 ;R0 = sectors/track CALL $MUL ;R1 = (CYL * TRK/CYL + TRK) * SEC/TRK MOV (SP)+,R4 ;Get track,sector back BIC #^C<377>,R4 ;Leave only sector ADD R4,R1 ;R1 = (CYL * TRK/CYL + TRK) * SEC/TRK + SEC MOV (R3)+,R0 ;R0 = Divisor BEQ 10$ ;Branch if none 9$: CLC ;Clear C-bit ROR R1 ;Divide by 2 SOB R0,9$ ;Loop 10$: MOV #LISTMB,R0 ;R0 -> bad block list element MOV R0,R5 ;R5 -> bad block list element .IF NE MDUP ;006 MOV #BAD.RP,(R5)+ ;Say that block is replacable ;006 .IFF ;NE MDUP ;006 BIT #FL.REP,$MFLAG ;Are we doing replacement? ;**-1 BNE 101$ ;Branch if we're not ;004 BIS #BAD.NR,(R5) ;Say we want a .BAD file ;004 101$: BIS #BAD.RP,(R5)+ ;But it's replaceable ;004 .ENDC ;NE MDUP ;006 MOV R1,(R5)+ ;Store the block number of the block MOV #1,@R5 ;Always 1 block CALL MERGE ;Merge it into our list MOV (SP)+,R3 ;R3 -> device data BR 8$ ;Try for another one 11$: RETURN