.MCALL .MODULE .MODULE DW,VERSION=30,COMMENT=,AUDIT=YES ; 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 Conditional assembly summary ;+ ;COND ; ; MMG$T std conditional ; TIM$IT std conditional (no code effects) ; ERL$G std conditional (additive only) ;- .REM % The DW handler is formally designated the Martin B. Gentry Commemorative Handler in recognition of their mutual reduction of excessive avoirdupois. % .PSECT DWDVR .PSECT SETOVR .PSECT DWBOOT .SBTTL DESCRIPTION .ENABL LC ;+ ; Description: ; ; This handler supports the RD5x series of mini-winchester disks. ; ; This RT-11 handler is meant to act as either a system or non-system ; device handler. A set option is provided to enable or disable a write ; check that consists of a read sector command after data has been written ; to a sector. If the controller reads the sector back successfully, the ; write check is successful. In any case, the data read back by the ; controller is ignored. ; ; Macros are used to generate the parameters used by the handler so ; that all such parameters depend only on the primary constants, rather ; than depending on manual copying of values. Those primary constants ; are the PC option slot number, the RD5xC controller ID number, the ; size of the cylinder, head, and sector bit fields in a block number, ; and the absolute maximum allowable sizes of the above-mentioned bit ; fields. ; ; The handler is meant to drive an RD5xC controller on a PC bus. It is ; assumed that certain parts of the interrupt setup procedure have been ; performed by the PC firmware as described in the PC hardware spec. ;- .SBTTL USAGE ;+ ; This handler is meant to drive a single RD5xC controller, and is meant to ; be used on a PC hardware system only. In particular, the controller ; interface requires that the device registers be addressed only as words for ; write operations. Instructions that specify byte reads of the device ; registers, such as TSTB, are used in this handler. If those instructions ; are executed by an LSI-11 processor, a DATIOB bus cycle will occur, ; violating the interface specification. Also, the PC device interrupt scheme ; used in this handler is different from the normal PDP-11 concept. ; ; The extended handler functions are as follows: ; ; CODE NAME FUNCTION ; ---- ---- -------- ; 377 ABSRW Read absolute sector (block) - read any block on the ; device, including physical block 0 and the last cylinder ; 376 ABSRW Write absolute sector (block) - write any block on the ; device, including physical block 0 and the last cylinder ; 373 DSIZ Get device size - 5 MB for RD50, 10 MB for RD51 ; ; The available set options are as follows: ; ; SET DW WCHECK/NOWCHECK Enables/disables read after write verify ; SET DW WRITE/NOWRITE Write enables/disables the device ; SET DW RETRY/NORETRY Change the number of retries ;- .SBTTL MACRO DEFINITIONS ;+ ; Macro to generate the maximum number of entities that can be counted ; by a field the specified number of bits in size ; ; Calling sequence: ; ; MAXVAL BITS, VAL ; ; Where: ; ; BITS Inputs the number of bits in the bit field ; ; VAL Returns the largest unsigned number that can be ; contained in the bit field + 1, i.e., the number ; of entities that the field can count ;- .MACRO MAXVAL BITS, VAL VAL = 1 .REPT BITS VAL = VAL * 2 .ENDR .ENDM ;+ ; Macro to generate a bit mask for accessing ID registers ; ; Calling sequence: ; ; BITMSK ARG, CMASK, BITS ; ; Where: ; ; ARG Inputs the maximum supported value for an ID ; ; CMASK Returns the logical complement of value "MASK - 1", ; where "MASK" is the lowest number that is a power of ; 2 and is greater than ARG. Thus, "MASK - 1" contains ; a right-justified field of contiguous 1's, with 0's in ; the higher order bits, such that: ; ; ARG .AND. (MASK-1) = ARG ; ; but ; ; (ARG*N) .AND. (MASK-1) <> (ARG*N) ; ; where N >= 2. ; ; "MASK - 1" is complemented to permit its use as a mask ; that will pass a right-justified data field in a bit ; clear instruction. ; ; ; BITS Returns the logarithm base 2 of MASK, that is, the ; number of bits that CMASK will pass. ;- .MACRO BITMSK ARG, CMASK, BITS .IIF EQ ARG, .ERROR ;Bitmask argument must be nonzero N = ARG ;Don't actually change ARG MASK = 1 ;Initialize mask word BITS = 0 ;Initialize masked bits counter FLAG = 0 ;Exitloop flag .REPT 16 ;Test all 16 bits in ARG .IF EQ FLAG ;If exitloop has not occured yet MASK = MASK * 2 ;Shift the mask BITS = BITS + 1 ;Increment the bits counter N = N / 2 ;Shift ARG .IF EQ N ;If ARG -> 0 FLAG = 1 ;Exitloop .ENDC ;EQ ARG .ENDC ;EQ FLAG .ENDR ;End of loop CMASK = ^C ;Return the actual bit mask, inverted for BIC's .ENDM ;+ ; Macro $TYPE$ ; ; $TYPE$ will generate a table of values for each type of disk that DW ; supports. ; ;- .MACRO $TYPE$ CODE,HEADS,TOTCYL,RSIZE,USIZE,HASIZ,LASIZ,USIZ,?L1 L1: .WORD CODE ;DW$TYP .WORD HEADS ;DW$SRF .WORD TOTCYL ;DW$CYL .WORD LASIZ ;DWASIZ .WORD USIZ ;DWUSIZ TSIZE=.-L1 .ENDM .SBTTL PRIMARY DECLARATIONS ;+ ; RT-11 Handler for the PC RD50C Mini-Winchester Disk ; ; Define the base constants from which all of the device register, ; interrupt vector, device size parameters, and installation ; verification parameters are calculated. RT-11 sysgen should supply ; some of these values, at which time they would be defined here ; conditionally as defaults. ; ; PC-specific primaries ;- PC$CSR =: 174000 ;Base device address of PC option modules PC$VEC =: 300 ;Base interrupt vector address for PC options PC$IC1 =: 173206 ;PC interrupt controller 1 CSR address PC$IC2 =: 173212 ;PC interrupt controller 2 CSR address MMUSR0 =: 177572 ;Memory management unit SR0 MMUSR3 =: 172516 ;Memory management unit SR3 .IRPC X <01234567> KISAR'X =: 172340+<2*X> ;Kernel Instruction PAR'X KISDR'X =: 172300+<2*X> ;Kernel Instruction PDR'X .ENDR AP$ACF=: 077406 ;4KW page with no trap/abort PROCFG =: 37776 ;PAR1 biased address of start of PRO3xx CONFIG table CTI =: -10. ;Offset to number of option slots SLOT0 =: -14. ;Option slot 0 ID PC$PRI =: 4 ;PC interrupt controllers' interrupting prior. ;+ ; PC-specific primaries unique to the DW controller ; (Sysgen should define these symbols) ;- DW$ID =: 401 ;RD50C controller ID code ;+ ; Device size limits and options ; ; For all RD5x series disks, the first physical block and the last cylinder ; are reserved ; for the hardware, and cannot be accessed unless you're using the absolute ; read/write SPFUN's. ; ; On the RD52's this means that the last cylinder may NOT be the physically ; last cylinder, because for the ATASI and QUANTUM are formatted to the ; size of the smaller CDC. ; ; Also, you must NOT do a seek on the RD50 past the last block because ; you can damage the drive. ;- DW$SEC =: 16. ;16 sectors per track (true for all RD5x's) ;+ ; Absolute device size limits and their derivatives (defined by the number ; of bits, including those allocated for future expansion, in the ID device ; registers as described in the PC RD50C hardware specification). ;- SECIDMX =: 5 ;Maximum number of bits in a Sector ID (from spec) SRFIDMX =: 3 ;Maxumum number of bits in a Head ID (from spec) CYLIDMX =: 10. ;Maximum number of bits in a Cylinder ID (from spec) MAXVAL SECIDMX, MAXSEC ;Calculate maximum possible number of sectors MAXVAL SRFIDMX, MAXSRF ;Calculate maximum possible number of heads MAXVAL CYLIDMX, MAXCYL ;Calculate maximum possible number of cylinders ;+ ; Guarantee that the absolute maximum sized fields can contain the ; values specified at sysgen ;- .IIF GT .ERROR ;Max Sector ID bit field exceeded .SBTTL BLOCK LAYOUT ON THE RD50C DISK ;+ ; The physical medium consists of "H" surfaces (serviced by "H" magnetic ; heads), "C" concentric tracks per surface, "S" sectors per track, and 512 ; decimal bytes of data per sector. Each track on a surface is part of a ; cylinder of similar tracks on the rest of the surfaces. Thus there are "C" ; cylinders on the medium. A particular track is then addressed by specifying ; the surface on which it physically resides and the cylinder that it is part ; of. ; ; The order in which logically numbered sectors are physically arranged on a ; track is important in optimizing the transfer of data that occupies several ; logically sequential sectors. When the data transfer for the current sector ; is complete, it is desirable that the (logically) next sector pass under the ; head as soon as possible thereafter. This is accomplished by assigning ; logical sector numbers to the physical sectors of a track in an interleaving ; pattern that leaves appropriate physical gaps, occupied by other sectors, ; between the logically successive sectors. The mapping from logical to ; physical sectors of a track is normally accomplished by software, and can be ; time consuming. ; ; The RD50C subsystem relieves the system device handler software of the ; overhead of logical to physical sector mapping when accessing the disk. ; The controller provides a format command, not supported in this handler, ; that writes the logical sector ID's of the "S" sectors on ; a track in any order specified. Once a track has been formatted, a sector ; is addressed for I/O by specifying the logical sector ID to the controller. ; The actual physical sector number of a sector can only be determined by ; counting sectors as they pass under the head, starting with the first sector ; after the beginning of track index, and is thus meaningless except during ; formatting. ; ; The sector interleave factor is determined at format time, and is completely ; invisible to this handler. ; ; A similar case occurs when a logical sequence of sectors starts on one ; cylinder and continues on another, usually the next innermost, cylinder. ; While the heads are moving to the new cylinder and being allowed to settle ; mechanically, several sectors may pass under the heads. It is once again ; desirable that the (logically) next sector pass under the heads as soon as ; possible after they are operable. This is accomplished by skewing the ; angular orientation of each cylinder as a whole with respect to its ; adjacent cylinders. This inter-cylinder skew is likewise determined at ; format time and is again completely invisible to this handler. ; ; The only aspect of the physical layout of the device that this handler is ; concerned with is the distribution of logically sequential sectors among the ; cylinders and surfaces. The important factor in deciding on the mapping ; scheme to use is that in changing from one surface to another (switching ; heads) the action taken is electronic and happens very quickly compared with ; the mechanical action taken in stepping the heads to the next cylinder. ; Therefore, in numbering logically sequential sectors, all of the sectors in ; a cylinder should be exhausted before moving to another cylinder. ; ; This handler recognizes the sequence of sectors on the device to start at ; cylinder 0, surface 0, sector 0, and continue on the same track to cylinder ; 0, surface 0, sector "S-1". The next sequential sector is cylinder 0, ; surface 1, sector 0. This sequence continues on the same cylinder until ; cylinder 0, surface "H-1", sector "S-1". The next sequential sector is ; cylinder 1, surface 0, sector 0. This pattern of exhausting one sector at ; a time sequentially through a track, then one track at a time sequentially ; through a cylinder, then one cylinder at a time sequentially through the ; device continues to the last logical sector on the device at cylinder "C-1", ; surface "H-1", sector "S-1". ; ; Note that the PC power-up self test ROM program writes to the first physical ; sector on the disk, so it should not be used for data storage. ; - .SBTTL PREAMBLE SECTION ;+ ; I/O queue element format: ; ; NAME OFFSET CONTENTS ; ; Q.LINK 0 Link to next queue element ; Q.CSW 2 Pointer to channel status word ; Q.BLKN 4 Block number ; Q.FUNC 6 Function code (bits 7-0 of low order byte) ; Q.JNUM 7 Job number (bits 6-3 of high order byte) ; Q.UNIT 7 Device unit (bits 2-0 of high order byte) ; Q.BUFF 10 Virtual address of user buffer ; Q.WCNT 12 Word count (<0 for Write, >0 for Read) ; Q.COMP 14 Completion routine address code ; Q.PAR 16 PAR1 value to map user buffer ; ; The .DRDEF macro defines the following identification codes, offsets, and ; bit patterns: ; ; Base CSR and vector addresses: ; ; DW$CSR The address declared in the definition of DW$CSR ; DW$VEC The address declared in the definition of DW$VEC ; ; Offsets into the current I/O queue element, relative to the pointer that the ; monitor leaves in handler address DWCQE: ; ; NAME USE ; ; Q$LINK Offset from queue element pointer to Q.LINK ; Q$CSW Offset from queue element pointer to Q.CSW ; Q$BLKN Offset from queue element pointer to Q.BLKN ; Q$FUNC Offset from queue element pointer to Q.FUNC ; Q$JNUM Offset from queue element pointer to Q.JNUM ; Q$UNIT Offset from queue element pointer to Q.UNIT ; Q$BUFF Offset from queue element pointer to Q.BUFF ; Q$WCNT Offset from queue element pointer to Q.WCNT ; Q$COMP Offset from queue element pointer to Q.COMP ; Q$PAR Offset from queue element pointer to Q.PAR ; ; Bit masks for the Channel Status Word: ; ; HDERR$ Hard error bit in the CSW ; EOF$ End of file bit in the CSW ; ; Identification codes for the header: ; ; DWDSIZ Device size for .DSTATUS ; DW$COD Device identifier code ; DWSTS Device status word ; ; Bits in the device status word: ; ; VARS$ SPFUN 373 request is valid ; SPFUN$ Special functions supported ; HNLDR$ Abort on job aborts ; SPECL$ Special directory-structured device ; WONLY$ Write-only device ; RONLY$ Read-only device ; FILST$ Sequential/random access device ;- .MCALL .DRDEF, .ASSUME, .ADDR .BR .CKXX .CKXX ;+ ; Define the standard preamble for the following parameters: ; ; Device name - DW ; Device identifier - 53 ; Device status - RANDOM ACCESS, SPFUN, VARIABLE SIZED ; Device size - DWSIZ ; Default CSR address - DW$CSR ; Default vector address - DW$VEC ;- .DRDEF DW,53,FILST$!SPFUN$!VARSZ$,0,0,0,DMA=NO .DRPTR FETCH=FETCH,LOAD=FETCH .DREST CLASS=DVC.DK .DRSPF <373> ;#-5 (373) Determine device size .DRSPF <376> ;#-2 (376) Write absolute sector .DRSPF <377> ;#-1 (377) Read absolute sector .SBTTL CONSTANT DEFINITIONS SYSPTR =: 54 ;Pointer to base of RMON P1EXT =: 432 ;Offset from $RMON to external routine GETVEC =: 436 ;Offset from $RMON to $GTVEC routine $GTVEC=:0 ; @+0 $GTCSR=:2 ; @+2 $GTSLT=:4 ; @+4 DWTYPE =: 440 ;Offset from $RMON to DW device type code TYP50 =: 1. TYP51 =: 2. TYP31 =: 3. TYP52C =: 4. TYP52Q =: 5. TYP52A =: 6. TYP53 =: 7. TYP32 =: 8. DPT.BT =: 12 ;LOAD code entered from BSTRAP ;+ ; Define the CSR addresses for the PC interrupt controllers that ; service the OP ENDED interrupt and the DATA REQUEST interrupt ;- ICOPND =: PC$IC1 ;OP ENDED handled by controller 1 ICDRQ =: PC$IC2 ;DRQ handled by controller 2 ;+ ; Define the PC interrupt controller CSR register commands. Only the ; commands that set and clear the IMR and IRR bits for the interrupts ; associated with the slot containing the RD50C controller are defined, ; and no other commands should be used by this handler. ;- ;+ ; Define the device register addresses as offsets from the device CSR ; address DW$CSR. ;- DWID =: 0 ;ID register DWERR =: 4 ;ERROR/PRECOMP register (Logged) DWPRE =: 4 ; DWREV =: 6 ;BACKUP REV/SECTOR ID register DWSEC =: 6 ; (Logged) DWBUF =: 10 ;DATA BUFFER register DWCYL =: 12 ;CYLINDER ID register (Logged) DWHEAD =: 14 ;HEAD ID register (Logged) DWST2 =: 16 ;STA 2/COMMAND register (Logged) DWCMD =: 16 ; DWSTAT =: 20 ;STATUS/INIT register (Logged) DWINIT =: 20 ; .IF NE ERL$G ;If error logging system ERLRGS =: 6 ;Number of device registers to log .ENDC ;NE ERL$G ;+ ; Define the ERROR/PRECOMP register error bits. ;- EDWM =: 0400 ;Data Mark not found during read sector ERTR0 =: 01000 ;Track 0 not found during restore ERABO =: 02000 ;Illegal/aborted command ERIDNF =: 10000 ;Sector not found ERICRC =: 20000 ;ID CRC error EDWCRC =: 40000 ;Data CRC error ;+ ; Define the BACKUP REV/SECTOR ID register Sector ID bits. ;- BITMSK DW$SEC-1,SECMSK,SECBIT ;Invoke the bit mask generating macro BITMSK MAXSEC-1,MXSECM,MXSECB ;Invoke the bit mask generating macro .IIF NE .ERROR ;Bitmask macro failed ;+ ; Define the HEAD ID register bits. ;- BITMSK MAXSRF-1,MXSRFM,MXSRFB ;Invoke the bit mask generating macro .IIF NE .ERROR ;Bitmask macro failed ;+ ; Define the CYLINDER ID register bits ;- BITMSK MAXCYL-1,MXCYLM,MXCYLB ;Invoke the bit mask generating macro .IIF NE .ERROR ;Bitmask macro failed ;+ ; Define the STA 2/COMMAND register status bits. ;- S2ERR =: 400 ;Error status valid in ERROR/PRECOMP register S2DRQ =: 4000 ;Data transfer request S2SEK =: 10000 ;Seek complete S2WRF =: 20000 ;Write fault S2DWY =: 40000 ;Drive ready ;+ ; Define the STA 2/COMMAND register command bits. ;- CMREST =: 20 ;Restore command CMREAD =: 40 ;Read sector command CMWRIT =: 60 ;Write sector command CMFORM =: 120 ;Format command ;+ ; Define the STATUS/INIT register status bits. ;- STOPND =: 1 ;Operation ended STDRQ =: 200 ;Data transfer request STDCAP =: 400 ;Drive capacity (1 = 5 Meg, 0 = ?? Meg) STBUSY =: 100000 ;Busy (controller's internal bus in use) ;+ ; Define the STATUS/INIT register init bits. ;- STINIT =: 10 ;Reset/initialize ;+ ; Other constants ;- RETRYS =: 8. ;Allow 8 tries (7 retries) per operation WREQ =: 100000 ;Bit 15 - Write request flag AREQ =: 200 ;Bit 7 - Absolute block request RREQ =: 1 ;Bit 0 - Read request flag RDAWRT =: 1 ;Bit 0 - Read after write bit .SBTTL INSTALLATION VERIFICATION ROUTINE .DRINS -DW .ENABL LSB BR 10$ ;Non-system device entry point MOV #DW$ID,-(SP) ;System device - put DW ID on stack CALL @R3 ;Call boot GETCSR routine BR 20$ ;Merge below 10$: NOP ;BPT for testing MOV #DW$ID,-(SP) ;Non-system device, put DW ID on stack MOV @#SYSPTR,R0 ;Get start of RMON CALL @GETVEC(R0) ;Call monitor GETVEC routine 20$: MOV (SP)+,R1 ;DW VEC in R1 from GETVEC MOV INSCSR,R0 ;was it specified (SET DW SLOT)? BNE 30$ ;yes, use specified one BCS 50$ ;No CSR, go out BR 40$ ;yes, good 30$: TST @R0 ;does the CSR exist? NOP ; for J11 BCS 50$ ; NO CMP @R0,#DW$ID ;Is it a DW controller? BNE 50$ ; NO 40$: I.GOOD: TST (PC)+ ;Clear C-bit I.BAD: 50$: SEC ;Can't install handler RETURN .ENABLE LSB ;+ ;Routine to find the entry for DW in the monitor device tables ;- FINDRV: .ADDR #DEVNAM,R0 ;R0 -> DEVICE NAME .ADDR #DAREA,-(SP) ;(SP) -> .DSTATUS information area EMT 342 ;.DSTATUS (#DAREA,#DEVNAM) BCS I.BAD ;Branch if not known MOV DAREA+4,R1 ;Return the entry point BEQ I.BAD ;Branch if handler is not loaded BR I.GOOD ;Return with success DAREA: .BLKW 4 ;.DSTAT information DEVNAM: .RAD50 /DW / ;Device name I.SLOT: CMPB (R3)+,(R3)+ ;make 5 into 7 BIC R3,CLRIRR ;clear out any old slot number BIC R3,CLRIMR BIC R3,SETIMR BIS R1,CLRIRR ;set in new slot number BIS R1,CLRIMR BIS R1,SETIMR CLRB DWTYPE(R2) ;clear a byte in DWTYPE ;High byte if explicit ;Low byte if search RETURN ;normal return (CLRB clears carry) .ASSUME . LE 400,MESSAGE=<;Install area overflow> .DSABL LSB .SBTTL HANDLER SET OPTIONS ;+ ; Supported set options are: ; ; SET DW: WCHECK/NOWCHECK (Enable/disable read after write verify) ; ; Define the set options table ;- .DRSET RETRY, 127., O.RTRY, NUM .IF NE ERL$G .DRSET SUCCES, -1, O.SUCC, NO .ENDC ;NE ERL$G .DRSET WRITE,1,O.WP,NO .DRSET WCHECK,1,SETW,NO ;Enable/disable write check .DRSET SLOT,5,SETSLT,NUM ;force slot selection .SBTTL HANDLER MODIFICATION ROUTINES ; SET DW RETRY O.RTRY: CMP R0,R3 ;RETRY entry - asking for too many? BHI O.BAD ;Yes, user is being unreasonable MOV R0,DRETRY ;Nope, so tell the handler BNE O.GOOD ;Okay if non-zero BR O.BAD ;Can't ask for no retries .IF NE ERL$G O.SUCC: MOV #0,R3 ;'Success' entry point ; (Must be two words) N.SUCC: MOV R3,SCSFLG ;'Nosuccess' entry point .ASSUME O.SUCC+4 EQ N.SUCC BR O.GOOD .ENDC ;NE ERL$G .ENABLE LSB ; SET DW WRITE/NOWRITE O.WP: NOP ;'WRITE ENABLE' entry point TST (PC)+ ; SEC ;'WRITE LOCK' entry point ROL (PC)+ ;Save the selection of state O.WPF: .WORD 0 ; Write protect select BIC #<^C1>,O.WPF ;Discard old selection MOVB R1,R0 ;Store unit number ;;; CMP R0,R3 ;Is unit within range? ;;; BHI O.BAD ;Branch if not - error BNE O.BAD ;only unit 0 allowed ;+ ;Alter the on-disk image of the protection table. ;- MOV R0,-(SP) ;Save the selected unit number .ADDR #DWWPRO,R0,ADD ;Pointer to the protection table MOVB O.WPF,@R0 ;Set the write protect status ;+ ;Alter the in-core image of the protection table. ;- CALL FINDRV ;Is the handler loaded? MOV (SP)+,R0 ; (Restore unit number before error ; check isnce 'MOV' doesn't affect ; carry) BCS O.GOOD ;Branch if not needed to alter CMP @#SYSPTR,R1 ;is this the system handler? BHI 10$ ; no, then leave 1-shot as is MOV #100000,DWW1-DWLQE(R1) ; yes, set it 10$: ADD #DWWPRO-DWLQE,R1 ;Add offset from entry to table ADD R0,R1 ;Add in unit offset MOVB O.WPF,@R1 ;Set the write protect status O.GOOD: TST (PC)+ ;Clear C-bit O.BAD: SEC ;Set C-bit. Don't install RETURN .DSABLE LSB ;+ ; Set DW write check enable/disable routine to modify the handler ;- .ENABLE LSB SETW: BR 10$ ;"SET DW WCHK" entry point . = SETW+4 ;"SET DW NOWCHK" entry point CLR DWWCHK ;Clear write check flag to false BR 20$ ;Successful return 10$: MOV #-1,DWWCHK ;Set write check flag to true 20$: CLC ;Flag a successful return RETURN .DSABLE LSB .ENABLE LSB SETSLT: ;"SET DW SLOT=n" entry point MOV @#SYSPTR,R2 ;Point to RMON INC R2 ;assume explicit number CMP R0,R3 ;too high? BGT O.BAD ;yes CMP R0,#-1 ;search (default)? BEQ 10$ ;yes TST R0 ;positive? BMI O.BAD ;no, error MOV R0,R1 ;save number ASH #7,R0 ;make into CSR offset ADD #PC$CSR,R0 ;and add in base CSR BR 20$ 10$: CLR R0 ;indicate search DEC R2 ;search, not explicit number 20$: MOV R0,DWCSR ;and setup CSR word MOV R0,INSCSR BEQ 30$ ;setup CTI type vector table MOV #>/2.-1+^o100000,DWSTRT MOV R1,R0 ;copy number ASH #3,R0 ;make into VEC offset ADD #PC$VEC,R0 ;and add in base CSR MOV R0,XW$VTB+0 ;update first vector in table CMP (R0)+,(R0)+ ;bump by 4 MOV R0,XW$VTB+6 ; and second vector in table BR 40$ 30$: MOV #>/2.-1+^o100000,DWSTRT CLR R1 ;no slot number 40$: JMP I.SLOT ;rest of code in INSTALL area .DSABLE LSB .ASSUME . LE 1000,MESSAGE=<;Set area overflow> .SBTTL HEADER SECTION ;+ ; Create the header ;- .DRBEG DW DWBASE=:DWSTRT+6 BR DWENT ;Branch over the protection table ;+ ; Set option variables ;- DWWPRO: .WORD 0 ;Unit 0 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> .IF NE ERL$G SCSFLG: .WORD 0 ; :Successful logging flag (default=YES) ; =0 - Log successes, ; <>0 - Don't log successes .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> .ENDC ;NE ERL$G DWWCHK: .WORD 0 ;Write check flag (activated by set command) .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> ;+ ; Other handler variables ;- DWFBLK: .WORD 0,0,0,0 ;Fork block ;next five words in order, please. DRETRY: .WORD RETRYS ;Number of retries - default is 8 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> RETRY: .WORD 0 ;Retry count INREST: .WORD 0 ;Flag that a restore operation is in progress FNFLAG: .WORD 0 ;Flag to interrupt routine of function type WRFLAG: .WORD 0 ;Flag to intercept write fault error condition WCNT: .WORD 0 ;Copy of Q$WCNT(R5) ;next three words in order, please. CRNTCYL:.WORD 0 ;Copy of current Cyl. ID for retries & wchk CRNTHD: .WORD 0 ;Copy of current Head ID for retries & wchk CRNTSEC:.WORD 0 ;Copy of current Sector ID for retries & wchk RDTYP: ;RD5x type table ;RD5x is default $TYPE$ 0 0 177777 177777 177777 177777 177777 177777 ;RD5x DW$TYP =: RDTYP+0 DW$SRF =: RDTYP+2 DW$CYL =: RDTYP+4 DWASIZ =: RDTYP+6 DWUSIZ =: RDTYP+8. .IF EQ MMG$T ;If not extended memory system BUFF: .WORD 0 ;Copy of Q$BUFF(R5) .ENDC ;EQ MMG$T .IF NE ERL$G ;If error logging system ERLIST: .BLKW ERLRGS ;Contents of device registers to log .ENDC ;NE ERL$G .SBTTL VECTOR TABLE ;+ ; Create table to associate vectors with interrupt entry points ; Note that both interrupts vector to the same entry point ;- DW$VEC =: PC$VEC .DRVTB XW,300,DWINT .DRVTB ,304,DWINT .DRVTB DW,0,DWINT,SLOTID=DW$ID ;OP ENDED interrupt .DRVTB ,4,DWINT ;DRQ interrupt .SBTTL I/O INITIATION SECTION ;+ ; Initiation entry point - DWCQE points at the current queue element ; ; The controller must not be busy at this point, since no I/O can be ; in progress. The only possibility would be if the single job monitor ; aborted the current job, which it does by executing a RESET ; instruction. The effect of the RESET, which asserts the INIT signal ; on the CTI bus, is to cause the controller to enter an initialization ; sequence, which terminates with a drive restore. ; ; If the user is quick enough to invoke another disk access from the ; keyboard before the restore has completed, the controller will be ; found busy. Waiting for the busy condition to end would hang the ; system, and so should not be done. Although the busy condition could ; be the result of the controller itself being hung, the cause cannot ; be determined at this point. Therefore, this error is considered ; a user error and is not logged. Note that if the auto restore ; completed unsuccessfully, an error condition will exist and go ; unnoticed. Whether the subsequent I/O operation succeeds is ; independent of a TR000 error, however, so the whole problem of ; recognizing an auto restore in progress or an error resulting from ; an auto restore is ignored by this handler. ;- .ENABL LSB DWENT: MOV #.-.,R4 ;Point to DW device registers DWCSR =:.-2 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> CK.R4=DWID CK.R4 DWID TST DWSTAT(R4) ;Is controller busy (busy bit (15) set)? .ASSUME EQ 100000 BMI JMPFD1 ;Fatal error - Nothing's been initiated MOV #.-.,R0 ;Point to init list DRETR1 =:.-2 CK.R0=DRETRY CK.R0 DRETRY,+2 CK.R0 RETRY,+2 MOV (R0)+,(R0)+ ;Initialize retry count CK.R0 INREST,+2 CLR (R0)+ ;Clear restore in progress flag CK.R0 FNFLAG,+2 CLR (R0)+ ;Clear flag assuming a special function CK.R0 WRFLAG,+2 CLR (R0)+ ;Clear write fault catcher bit MOV DWCQE,R5 ;Point to Q$BLKN CK.R5=Q$BLKN CK.R5 Q$BLKN MOV @R5,R3 ;Get block number ;+ ; Extract the unit number and check if legal. ;- CK.R5 Q$BLKN MOVB Q$UNIT(R5),R0 ;Get the unit/job number byte BIC #^C<7>,R0 ;Mask in just the unit number bits BNE JMPFU1 ;Fatal user error (only unit 0 supported) ;+ ; Decode the request function. The zero function is a READ(X)/WRIT(X) ; request. Negative functions are .SPFUN requests. The function code ; is normalized to a number >= 0 by adding to it the most negative ; legal function code. The code is checked to see if the function is ; within range. Note that if the function code is too negative in ; value that it will be normalized to a negative value, and will cause ; a request failure. ;- XRETRY: CK.R5 Q$BLKN MOVB Q$FUNC(R5),R0 ;Get the function code ADD #FNEG,R0 ;Normalize to >= 0 CMP R0,#FNUM ;Compare with total number of codes BLO DISPAT ;Within range (0 =< R0 < FNUM) JMPFU1: JMP DWFUE ;Relay to fatal user error JMPFD1: JMP DWFDE ;Relay to fatal device error .DSABL LSB .SBTTL COMMAND DISPATCH ;+ ; The normalized function code is now doubled to produce a word ; offset into the dispatch table, and the offset in the table ; entry is added to the PC, which is pointing to the start of ; the table during execution of the final ADD instruction. ; The result is a computed goto operation. ; Since the most negative function code has been normalized to 0, it ; must be the top entry in the dispatch table. ;- DISPAT: ASL R0 ;Make function code into word offset ADD #.-.,R0 ;Add offset from here to FNTBL FNTBL1 =:.-2 ADD @R0,PC ;Add table entry to PC (PC -> FNTBL) ; JMP ... ;Strange jump instruction JMPREF: ;This label must follow "ADD @R0,PC" ;+ ; This is the function dispatch table. Any new function codes must ; be entered at the top of the table, as the most negative code. ; ; There cannot be any holes in the table, or the normalizing routine ; will not work. Fill unused slots with a hard error return. ;- FNTBL: .WORD ;#-5 (373) Determine device size .WORD ;#-4 Unused slot .WORD ;#-3 Unused slot .WORD ;#-2 (376) Write absolute sector .WORD ;#-1 (377) Read absolute sector ;NOTE: if you add any SPFUN codes also add them to .DRSPF ;+ ; READ(X)/WRIT(X) function goes here. Label must stay with code #0. ;- FTBZER: .WORD ;#0 READ(X)/WRIT(X) ;+ ; Any positive functions can go here, before label. ;- FTBEND: ;Last table entry + 2 ;+ ; Dispatch table statistics to check for legal function code when a ; request is made (2 bytes per table entry) ;- FNEG =: /2 ;Number of .SPFUN requests, including unused slots FNUM =: /2 ;Total number of requests, including unused slots .Assume FNEG+1 EQ FNUM .SBTTL HANDLER FUNCTIONS SECTION ;+ ; Description: ; ; This section contains the mainline code for all of the supported ; special functions and I/O functions. ; ; Each routine is entered with the busy bit in the STATUS/INIT ; register clear, and the CPU registers in the following state: ; ; R3 - Contains the block number ; R4 - Points to the DW device registers ; R5 - Points to the current queue element at offset Q$BLKN ; ; In addition, the following conditions are set up: ; ; FNFLAG Cleared ; WRFLAG Cleared ; INREST Cleared ; RETRY Preset to "RETRYS" ; ;- .SBTTL ABSRW - Read/write absolute sector ;+ ; These two SPFUN's allow the user to access any block (sector) on the ; device. This includes the "hidden" block 0, and the last cylinder, ; which is reserved for bad block replacement. ;- ABSW: CK.R5 Q$BLKN NEG Q$WCNT(R5) ;Make the word count negative for a write ABSR: BIS #AREQ,FNFLAG ;High bit set (byte) absolute .BR RW .SBTTL - READ(X)/WRIT(X) FUNCTION ;+ ; Description: ; ; This function initiates a READ/WRITE absolute block request. ; The block number is decoded into the correct Sector, Head, and ; Cylinder ID values, and the I/O is initiated. ; ; The next block of a multi-block READ/WRITE and the retry of a ; soft error each have their own entry point to code in this section. ; The entry values of the CPU registers are the same as for the main ; entry point, but some of the variables have been assigned new values ; by the interrupt service routine. The ID calculations do not need ; to be repeated for a retry, since the current ID'S are saved. In ; addition, the controller has already been found not busy by the ; interrupt service routine. ; ; If a write fault has occured, a write operation cannot be done. ;- .ENABLE LSB RW: CK.R5 Q$BLKN BIT #1,Q$BUFF(R5) ;Is user buffer word-aligned? BNE JMPFU1 ;User error - Word-aligned device CK.R5 Q$BLKN TST Q$WCNT(R5) ;Check sign of word count BMI 10$ ;Word count is negative for a write BNE 25$ ;Word count is positive for a read BR INTRQS ;No data (seek) - Exit (with no error) 10$: CK.R4 DWID BIT #S2WRF,DWST2(R4);Has a write fault occured? BNE JMPFD1 ;Yes - Can't write until next power-up ; HERE TO CHECK IF UNIT IS WRITE-PROTECTED ASL (PC)+ ;Check write anyway one-shot DWW1: .WORD .-. ; 100000 means write anyway .ASSUME . LE DWSTRT+1000 BCS 20$ ;Skip test if write anyway TST DWWPRO ;Are we write-locked? BNE JMPFU1 ;If yes, branch 20$: MOV #S2WRF,WRFLAG ;Set flag to catch write fault condition BIS #WREQ,FNFLAG ;Set flag for write request CK.R5 Q$BLKN NEG Q$WCNT(R5) ;Get the real word count for a write BR RWNEXT ;Join common code 25$: BIS #RREQ,FNFLAG ;Set flag assuming a read request .BR RWNEXT ;Join common code ;+ ; Entry points for next block after successful completion of previous ; block during a multiblock READ(X)/WRIT(X) ;- RWNEXT: INC R3 ;Make block number physical TSTB FNFLAG ;Is this an absolute sector read/write? BPL 30$ ;If not, branch .Assume AREQ EQ 200 CMP R3,DWASIZ ;Is the requested block on the device? BHIS JMPFU1 ;User error - Block number too large BR 40$ ;Merge below 30$: CMP R3,DWUSIZ ;Is the requested block on the device? BHI JMPFU1 ;User error - Block number too large 40$: MOV R3,R1 ;Copy block number BIC #SECMSK,R1 ;Mask out all but Sector ID ASH #-SECBIT,R3 ;Get the number of sector bits (same for all) .Assume SECBIT EQ 4 BIC #170000,R3 ;Mask out high 4 bits propagated by the ASH CLR R2 ;Set up for DIV DIV DW$SRF,R2 ;heads in R3, cylinders in R2 CMP R2,DW$CYL ;Trying to seek beyond highest track? BHIS JMPFU1 ;User error - Cylinder ID too large MOV #.-.,R0 ;Point to cylinder,head,sector words CRNT1 =:.-2 CK.R0=CRNTCYL CK.R0 CRNTCYL,+2 MOV R2,(R0)+ ;Save current values of Cylinder, Head, CK.R0 CRNTHD,+2 MOV R3,(R0)+ ; and Sector ID'S so calculations aren't CK.R0 CRNTSEC,+2 MOV R1,(R0)+ ; repeated during retries & write checks .BR RWRTRY ;+ ; Entry point for READ(X)/WRIT(X) retries ;- RWRTRY: CALL DSKADR ;Set the disk address up TST FNFLAG ;Read or write request? .Assume WREQ EQ 100000 BMI 50$ ;Request is for a write DOREAD: MOV #110,@#ICDRQ ;Clear IRR bit in DRQ controller CLRIRR =:.-4 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> CK.R4 DWID MOV #CMREAD,DWCMD(R4) ;Issue the read command MOV #050,@#ICDRQ ;Clear IMR bit in DRQ controller CLRIMR =:.-4 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> RETURN ;Wait for seek and read to complete 50$: ;>>>this may be broken BIC #RDAWRT,FNFLAG ;Set read after write bit to writing MOV CLRIRR,@#ICOPND ;Clear IRR bit in OP ENDED controller CK.R4 DWID MOV #CMWRIT,DWCMD(R4) ;Issue the write command JSR R0,MTFILL ;Fill the controller's sector buffer MOV (R2)+,@R4 ;Buffer fill instruction CLR @R4 ;Buffer zero-fill instruction CALLR CLRPND ;Clear IMR bit in OP ENDED controller .DSABL LSB .SBTTL DSIZ - Get disk size ;+ ; DSIZ processes the SPFUN 373 request. ;- .ENABLE LSB DSIZ: .IF EQ MMG$T CK.R5 Q$BLKN MOV DWUSIZ,@Q$BUFF(R5) ;Put usable size into buffer .IFF ;EQ MMG$T ;;; MOV R4,-(SP) ;Save R4 ;;; S.TOP=CK.R4 MOV DWUSIZ,-(SP) ;Put usable size on the stack CK.R5 Q$BLKN CK.R4=CK.R5 MOV R5,R4 ;Copy queue pointer for $PTWRD CALL @$PTWRD ;Put size in buffer ;;; MOV (SP)+,R4 ;Pop the stack ;;; CK.R4=S.TOP .ENDC ;EQ MMG$T .BR INTRQS ;Go out .DSABL LSB .SBTTL INTERRUPT SERVICE SECTION ;+ ; Description: ; ; The DW device interrupt enters here. If the current request is ; a read, the interrupt will be the result of the DRQ bit becoming ; set in the STATUS/INIT device register. The controller's sector ; buffer is emptied here, and the operation continued if more blocks ; are to be read, else the request is completed. If the current ; request is a write, the interrupt will be the result of the OP ; ENDED bit becoming set in the STATUS/INIT device register. If ; write checking is enabled, the block is read after the write has ; completed successfully, and if the read completes without error, ; the read data is removed from the controller's sector buffer and ; dropped, and the operation is continued if more blocks are to be ; written, else the request is completed. ; ; If a write fault occured and the write fault catcher flag is set ; (meaning that the current operation writes to the disk and therefore ; the error just occured), a hard error condition exists since the ; write fault condition persists until the next power-up. ; ; If an error is encountered, a retry is attempted unless the retry ; counter is exhausted, at which point a hard error completion of ; the request is made. If the error logging feature is selected, ; the appropriate call to the logger will be made on each pass ; through this section. ;- .ENABLE LSB INTRQS: JMP DWRQS ;Relay to successful completion .DRAST DW,PC$PRI ;;;(Generate RTS PC for abort entry) MOV #070,@#ICOPND ;;;Set IMR bit in both controllers SETIMR =:.-4 .Assume . LE DWSTRT+1000,MESSAGE=<;SET object not in block 1> MOV SETIMR,@#ICDRQ ;;; to disable both interrupts .FORK DWFBLK ;;;Get to FORK level immediately MOV DWCQE,R5 ;Point to queue element for this call CK.R5=Q$BLKN MOV DWCSR,R4 ;Point to DW device registers CK.R4=DWID CK.R4 DWID TST DWSTAT(R4) ;BUSY bit set? (It must not be) BMI DWFD1 ;Fatal device error CK.R4 DWID BIT WRFLAG,DWST2(R4) ;Did write fault occur during this operation? BNE DWFD1 ;Yes - Hard error (can't be reset by software) CK.R4 DWID BIT #S2ERR,DWST2(R4);Error status? BNE 70$ ;Yes - Error ;+ ; The previous transfer just completed without error. If the restore ; in progress flag is set, a previous soft error still needs to be ; retried, so the soft error processing is entered (after the error ; logging section, since the error was already logged). Otherwise, ; the successful transfer is logged if error logging is selected. The ; request is completed if it is a special function, or the sector buffer ; is emptied if the request is a read. If the request is read or write, ; the word count and the user buffer addressing are updated with the ; values left by the buffer empty/fill subroutine. If the word count ; has gone to zero, the request is complete. If not, everything is ; set up to initiate the transfer of the next block of data. TST INREST ;Did a restore just complete? BNE 90$ ;Yes - Continue with soft error .IF NE ERL$G ;If error logging system TST SCSFLG ;Logging successful transfer? BNE 10$ ;If not, branch MOV R5,-(SP) ;Save R5 and R4 S.TOP=CK.R5 MOV R4,-(SP) S.TOP2=CK.R4 MOV #<!377>,R4 ;Success flag and device identifier CALL @$ELPTR ;Log a successful transfer MOV (SP)+,R4 ;Restore R5 and R4 CK.R4=S.TOP2 MOV (SP)+,R5 CK.R5=S.TOP .ENDC ;NE ERL$G 10$: MOV FNFLAG,R0 ;Test function type flag .Assume WREQ!RDAWRT!RREQ NE 0 BEQ INTRQS ;Not a read or write, so it's done .Assume RDAWRT GT 0 BPL 30$ ;Read request TST DWWCHK ;Write checking enabled? BEQ 40$ ;No - Finished with this block .Assume RREQ EQ 1 ASR R0 ;Did the read after write just finish? BCC 20$ ;No - Initiate it now CALL DUMP ;Yes - Empty the sector buffer BR 40$ ;Finished with this block .Assume RREQ EQ 1 20$: INC FNFLAG ;Set flag to reading after write BR 110$ ;Initiate the read from this routine 30$: BMI 40$ ;Write request JSR R0,MTFILL ;Empty the controller's sector buffer MOV @R4,(R2)+ ;Buffer empty instruction MOV @R4,R5 ;Drop buffer data instruction CK.R5 Q$BLKN 40$: MOV WCNT,Q$WCNT(R5) ;Update word count BEQ INTRQS ;Word count -> zero - Request complete .IF NE MMG$T ;If extended memory system CK.R5 Q$BLKN MOV PARVAL,Q$PAR(R5) ;Update PAR1 mapping for user buffer .IFF CK.R5 Q$BLKN MOV BUFF,Q$BUFF(R5) ;Update user buffer address .ENDC ;NE MMG$T TST FNFLAG ;Is this a write? .Assume WREQ EQ 100000 BPL 50$ ;If not, branch ASL (PC)+ ;Is this the first write? .WORD 100000 BCS 60$ ;If yes, branch 50$: CK.R5 Q$BLKN INC @R5 ;Update block number 60$: CK.R5 Q$BLKN MOV @R5,R3 ;Get block number for next pass MOV DRETRY,RETRY ;Reset retry counter for next block JMP RWNEXT ;Do next block of request ;+ ; An error occured in the previous operation - ; If a restore was being attempted, or if an error of track 0 not found ; or illegal/aborted command occured, a hard error condition exists and ; the operation is not retried. Otherwise, a soft error is logged if ; error logging is selected, and the operation is retried. ;- 70$: TST INREST ;Was a restore in progress? DWFD1: BNE DWFDE ;Yes - Hard error (even if not TR000) CK.R4 DWID BIT #,DWERR(R4) ;TR000 and illegal/aborted BNE DWFDE ;Command are hard errors .IF NE ERL$G ;If error logging system MOV R5,-(SP) ;Save R5 and R4 S.TOP=CK.R5 MOV R4,-(SP) S.TOP2=CK.R4 CALL ERLSET ;Set up registers for error logger BISB RETRY,R4 ;Or in the current retry count CALL @$ELPTR ;Log an unsuccessful transfer MOV (SP)+,R4 ;Restore R5 and R4 CK.R4=S.TOP2 MOV (SP)+,R5 CK.R5=S.TOP .ENDC ;NE ERL$G ;+ ; If the error occured during a read, the controller may have interrupted ; with a DRQ, even if no data was read (such as a Sector ID not found ; error). The DRQ will not go away until the controller's sector ; buffer is emptied. Since the interrupt controller's request latches ; are edge triggered, the DRQ must be made to go away now or no other ; DRQ interrupt will ever occur. ;- CK.R4 DWID TSTB DWSTAT(R4) ;Is the DRQ bit set? BPL 80$ ;No - OK to continue CALL DUMP ;Empty the sector buffer 80$: CK.R4 DWID BIT #ERIDNF,DWERR(R4) ;Sector ID not found? BEQ 90$ ;No - Retry the error now ;+ ; Sector ID not found - Must do a restore before continuing with ; the drive. Can't issue a restore command unless DRIVE READY and ; SEEK COMPLETE are set and WRITE FAULT is clear in the STA 2 device ; register, so a hard error condition exists unless a restore can be ; done. Otherwise the restore in progress flag is set, the restore ; command is issued, and a return is made to the system to wait for the ; OP ENDED interrupt, at which point the handling of the Sector ID not ; found error will be continued (unless the restore results in another ; error, which must be considered hard no matter what type of error it ; really is). CK.R4 DWID MOV DWST2(R4),R3 ;Get STA 2 information BIT #S2WRF,R3 ;Does a write fault condition exist? BNE DWFDE ;Yes - Can't do restore, so hard error BIC #^C,R3 ;Get SEEK COMPLETE and DRIVE READY bits CMP #,R3 ;Are both bits set? BNE DWFDE ;No - Can't do restore, so hard error MOV SP,INREST ;Set the restore in progress flag MOV CLRIRR,@#ICOPND ;Clear IRR bit in OP ENDED controller CK.R4 DWID MOV #CMREST,DWCMD(R4) ;Issue the restore command CLRPND: MOV CLRIMR,@#ICOPND ;Clear IMR bit in OP ENDED controller RETURN ;Wait for the OP ENDED interrupt 90$: DEC RETRY ;Decrement the retry count BEQ DWFDE ;No more retries left CLR INREST ;Clear restore in progress flag TST FNFLAG ;Read/write request? .Assume RREQ!WREQ NE 0 BEQ 120$ ;No - Special function .Assume WREQ EQ 100000 BPL 100$ ;Read request - Retry it BIT #RDAWRT,FNFLAG ;Write request - Reading after write? BNE 110$ ;Yes - Retry the read 100$: JMP RWRTRY ;Try this block again 110$: CALL DSKADR ;Set up disk address CALLR DOREAD ;Request a read operation 120$: JMP XRETRY ;Redispatch .DSABLE LSB .SBTTL I/O COMPLETION SECTION ;+ ; Description: ; ; This section is entered either at request initiation level or FORK ; level. All registers are expendable. If a hard device error ; condition exists, a hard error is logged if error logging support is ; being included. If any hard error condition exists, the hard error ; bit is set in the channel status word. Control is then transferred ; to the request completion section in the monitor. ; ; Inputs: ; ; R5 - Points to the current queue element at offset Q$BLKN ; ; Hard device error entry point ;- .ENABL LSB DWFDE: .IF NE ERL$G ;If error logging system MOV R5,-(SP) ;Save R5 S.TOP=CK.R5 CALL ERLSET ;Set up registers for error logger CALL @$ELPTR ;Log an unsuccessful transfer MOV (SP)+,R5 ;Restore R5 CK.R5=S.TOP .ENDC ;NE ERL$G ;+ ; Hard user error entry point ;- DWFUE: CK.R5 Q$BLKN BIS #HDERR$,@Q$CSW(R5) ;Set hard error bit in channel status ; ; Successful completion entry point ;- DWRQS: ;+ ; Jump to the monitor's completion section ;- .DRFIN DW .DSABLE LSB .SBTTL EMPTY/FILL THE CONTROLLER'S SECTOR BUFFER SUBROUTINE ;+ ; Description: ; ; This routine either inserts or removes data in the DW controller's ; sector buffer. The buffer's capacity is 256. words of data, and ; 256. words must be transferred each time this routine is called. ; The data is transferred one word at a time. The instructions that ; perform the actual insert or remove operation are passed to this ; routine as in-line arguments and are inserted into this routine's ; code on the fly. If the RX01 handler can do it, this one can, too. ; ; The buffer pointer and word count are both copied from the queue ; element and adjusted to address the next block in the user buffer ; in case this call does not exhaust the word count. If the ensuing ; disk transaction encounters no errors, the adjusted values will be ; copied back into the queue element before the next block for the ; request is addressed. If the remaining word count is less than 256., ; the rest of the sector buffer is filled/emptied by zero-filling or ; droping the remaining data. ; ; This routine expects the busy bit in the DW STATUS/INIT register to ; be clear upon entry, and to remain clear until the 256. transfers ; have been made, and then to become set if the sector buffer is being ; filled (signifying a seek in progress). If the sector buffer is being ; emptied, the OP ENDED bit is expected to become set after the 256. ; transfers, and the BUSY bit to remain clear. Likewise, the DRQ bit ; in the DW STATUS/INIT register is expected to be set upon entry, to ; become set for each of the expected transfers, and to become clear ; after the last transfer when busy becomes set. If the hardware fails ; in these respects, the handler will hang the system (unless device ; timeout is implemented) in some cases, or trap to 4 (crashing the ; system, since this subroutine is always called from system state) ; in other cases. ; ; This routine uses move instructions instead of test instructions on ; the device registers because in an LSI-11/23 processor the source ; operand time for a MOV or MOVB is faster than the destination operand ; time for a TST or TSTB. Also, the STATUS register is copied with a ; MOV instruction and then shifted to test the pertinent status bits ; for the same reason. In a loop of 256. passes, the time saved by ; these efforts is significant. ; ; Inputs: ; ; Word 1 of 2 in-line arguments ; ; MOV (R2)+,@R4 ;To fill sector buffer from user buffer (write) ; MOV @R4,(R2)+ ;To empty sector buffer into user buffer (read) ; ; Word 2 of 2 in-line arguments ; ; CLR @R4 ;To zero-fill sector buffer (write) ; MOV @R4,R5 ;To drop sector buffer data (read) ; ; R5 - Points to queue element at offset Q$BLKN ; R4 - Points to device registers ; R0 - Subroutine link register ; ; Outputs: ; ; BUFF - Value of Q$BUFF(R5), incremented by 256., to point ; at the next block in the user buffer, for ; unmapped systems only ; ; PAR - Value of Q$PAR(R5), incremented by 256./32., to ; point Q$BUFF(R5) at the next 256. word block ; in the user buffer, for mapped systems only ; ; WCNT - Value of Q$WCNT(R5), decremented by 256., or set to ; zero if it is already less than 256. ; ; Registers changed: ; ; R1, R2, R3 ;- .ENABL LSB MTFILL: S.TOP=CK.R5 MOV R5,-(SP) ;Save I/O queue element pointer S.TOP2=CK.R4 MOV R4,-(SP) ;Save device register pointer MOV (R0)+,60$ ;Put buffer fill instruction in-line MOV (R0)+,100$ ;Put buffer zero-fill instruction in-line CK.R4 DWID MOV R4,R3 ;Copy device register address CK.R3=CK.R4 ADD #DWSTAT,R3 ;Point to STATUS/INIT register CK.R3 DWID,+DWSTAT ADD #DWBUF,R4 ;Point to DATA BUFFER register CK.R4 DWID,+DWBUF CK.R5 Q$BLKN MOV Q$BUFF(R5),R2 ;Get virtual address of user buffer CK.R5 Q$BLKN MOV Q$WCNT(R5),R1 ;Get word count BEQ 90$ ;Zero - Zero-fill/dump sector buffer MOV R1,WCNT ;Copy word count for adjusting CMP R1,#256. ;Word count > 256. ? BLOS 10$ ;No MOV #256.,R1 ;Can only do 256. words per seek 10$: TST FNFLAG ;Is this a write? .Assume WREQ EQ 100000 BPL 20$ ;If not, branch ASL (PC)+ ;Is this the first write? .WORD 100000 BCS 30$ ;If yes, branch 20$: SUB R1,WCNT ;Adjust saved copy of word count 30$: .IF NE MMG$T ;If extended memory system CK.R5 Q$BLKN MOV Q$PAR(R5),PARVAL ;Get PAR1 mapping for the user buffer JSR R0,@#.-. ;Let the monitor execute the following code. $P1EXT =:.-2 .WORD PARVAL-. ;Number of instructions in bytes plus 2. .IFF MOV R2,BUFF ;Copy buffer address TST FNFLAG ;Is this a write? .Assume WREQ EQ 100000 BPL 40$ ;If not, branch ASL (PC)+ ;Is this the first write? .WORD 100000 BCS 60$ ;If yes, branch 40$: ADD #512.,BUFF ;Point to next block in buffer for next time .ENDC ;NE MMG$T 60$: .WORD 0 ;Insert/remove a word of user data to data reg SOB R1,60$ ;Repeat until word count exhausted .IF NE MMG$T ;If extended memory system PARVAL: .WORD 0 ;use this value for the PAR 1 bias. TST FNFLAG ;Is this a write? .Assume WREQ EQ 100000 BPL 70$ ;If not, branch ASL (PC)+ ;Is this the first write? .WORD 100000 BCS 80$ ;If yes, branch 70$: ADD #<256./32.>,PARVAL ;Map to next block in buffer next time 80$: .ENDC ;NE MMG$T 90$: CK.R3 DWSTAT MOV @R3,R5 ;BUSY bit set yet? .Assume STBUSY EQ 100000 BMI 110$ ;Yes - Done transferring data (write) .Assume STOPND EQ 1 ASR R5 ;OP ENDED bit (bit 0) set yet? BCS 110$ ;Yes - Done transferring data (read) .Assume STDRQ EQ 200 ASLB R5 ;DRQ bit (bit 7) set? BPL 90$ ;No 100$: .WORD 0 ;Zero-fill/dump a word in data buffer register BR 90$ ;Continue looping 110$: ;;; TSTB @R3 ;DRQ still set????? ;;; BPL 7$ ;No ;;; HALT ;Yes - Find out why!!!!! ;;;7$: MOV (SP)+,R4 ;Restore device register pointer CK.R4=S.TOP2 MOV (SP)+,R5 ;Restore I/O queue element pointer CK.R5=S.TOP RTS R0 ;Return .DSABL LSB .SBTTL DUMP THE CONTROLLER'S SECTOR BUFFER SUBROUTINE ;+ ; Description: ; ; This subroutine empties the entire sector buffer, discarding the ; data. It is assumed that the OP ENDED bit in the STATUS/INIT ; register will become set after the last word of data has been ; transferred by the controller. Thus the loop is not counted. ; If the DRQ bit never goes away, we will hang here forever unless ; device timeout is implemented. ; ; The same use is made of the LSI-11/23's instruction timing as in ; the empty/fill subroutine to expedite the 256. pass loop. ; ; Inputs: ; ; R4 - Points to device registers ; ; Registers changed: ; ; R1, R2, R3 ;- .ENABLE LSB DUMP: CK.R4 DWID CK.R2=CK.R4 MOV R4,R2 ;Copy device register pointer ADD #DWSTAT,R2 ;Point to STATUS/INIT register CK.R2 DWID,+DWSTAT MOV R4,R3 ;Copy device register pointer CK.R3=CK.R4 ADD #DWBUF,R3 ;Point to DATA BUFFER register CK.R3 DWID,+DWBUF 10$: CK.R2 DWSTAT MOV @R2,R1 ;Get STATUS register ASR R1 ;OP ENDED bit (bit 0) set yet? .Assume STOPND EQ 1 BCS 20$ ;Yes - Done dropping data ASLB R1 ;DRQ bit (bit 7) set? .Assume STDRQ EQ 200 BPL 10$ ;No CK.R3 DWBUF MOV @R3,R1 ;Drop a word from the sector buffer BR 10$ ;Continue until buffer is empty 20$: ;;; TSTB @R2 ;DRQ still set????? ;;; BPL 3$ ;No ;;; HALT ;Yes - Find out why!!!!! ;;;3$: RETURN .DSABL LSB DSKADR: MOV #.-.,R0 ;point to cylinder,head,sector CRNT2 =:.-2 CK.R0=CRNTCYL CK.R0 CRNTCYL,+2 CK.R4 DWID MOV (R0)+,DWCYL(R4) ;Load Cylinder ID register CK.R0 CRNTHD,+2 CK.R4 DWID MOV (R0)+,DWHEAD(R4) ;Load Head ID register CK.R0 CRNTSEC,+2 CK.R4 DWID MOV (R0)+,DWSEC(R4) ;Load Sector ID register RETURN .IF NE ERL$G ;If error logging system .SBTTL ERROR LOGGING SETUP SUBROUTINE ;+ ; Discription: ; ; This routine sets up the CPU registers for a call to the error logger ; when an error is to be reported. It also copies the contents of the ; STATUS/INIT device register into the device register list for the ; logger. If the register's BUSY bit is clear, the contents of the ; other pertinent device registers are copied into the list. If the ; BUSY bit is set, accessing any other device register would cause a ; trap to 4 (and a system crash, since we are in system state), so ; -1 is written into each other word in the list. The low byte of R4 ; is cleared so that the retry count can be inserted by the caller ; using a BISB instruction. For a hard error the retry count is zero, ; so R4 is already set up. ;- .ENABLE LSB ERLSET: .ADDR #ERLIST,R2 ;Device register list for logger MOV R2,R3 ;Copy R2 CK.R4 DWID MOV DWSTAT(R4),(R3)+ ;STATUS/INIT register .Assume STBUSY EQ 100000 BMI 10$ ;BUSY bit set - Can't read other registers CK.R4 DWID MOV DWCYL(R4),(R3)+ ;CYLINDER ID register CK.R4 DWID MOV DWHEAD(R4),(R3)+ ;HEAD ID register CK.R4 DWID MOV DWSEC(R4),(R3)+ ;BACKUP REV/SECTOR ID register CK.R4 DWID MOV DWERR(R4),(R3)+ ;ERROR/PRECOMP register CK.R4 DWID MOV DWST2(R4),@R3 ;STA 2/COMMAND register BR 20$ ;Continue 10$: MOV #-1,@R3 ;Signify CYLINDER ID register not read MOV (R3)+,@R3 ;HEAD ID register not read MOV (R3)+,@R3 ;BACKUP REV/SECTOR ID register not read MOV (R3)+,@R3 ;ERROR/PRECOMP register not read MOV (R3)+,@R3 ;STA 2/COMMAND register not read 20$: MOV DRETRY,R3 ;Get retry count SWAB R3 ;(DRETRY*400) = total retries allowed in high byte BISB #ERLRGS,R3 ;OR in number of device registers to log MOV #,R4 ;Device identifier in high byte RETURN ;Caller fills in low byte of R4 .DSABL LSB .ENDC ;NE ERL$G .SBTTL BOOTSTRAP READ ROUTINE ;+ ; Invoke the primary driver setup macro ; ; BOOT1 - Entry point of the software bootstrap routine ; READ - Entry point of the bootstrap read routine ;- .DRBOT DW,BOOT1,READ,CONTROL= .ENABL LSB .=DWBOOT+14 ;This routine is used by READ in BSTRAP and FETCH in FETCH and LOAD DSKTYP: MOV #7,R3 ;Load loop count and Head number CK.R4=DWID CLR DWSEC(R4) ;Load sector reg with sector 0 10$: CK.R5=CK.R4 MOV R4,R5 ;Copy device register pointer BR 20$ .=DWBOOT+40 ; Put next instruction in syscom area BOOT1: JMP @# ; Go to software bootstrap 20$: CK.R5 DWID,+DWCYL ADD #DWCYL,R5 ;Point to CYLINDER ID register CK.R5 DWCYL,+2 CLR (R5)+ ;Load cylinder reg with cylinder 0 CK.R5 DWHEAD,+2 MOV R3,(R5)+ ;Get the current number of heads CK.R5 DWCMD,+2 MOV #CMREAD,(R5)+ ;Issue read command BR 25$ .Assume . LE DWBOOT+120,MESSAGE=<;Bootstrap overlap> .=DWBOOT+120 25$: 30$: CK.R5 DWSTAT TST @R5 ;BUSY bit set? .Assume STBUSY EQ 100000 BMI 30$ ;Yes - Wait for seek to complete CK.R4 DWID BIT #S2ERR,DWST2(R4) ;Did the SEEK succeed? BEQ 40$ ;If yes, branch CK.R4 DWID BIT #ERIDNF!ERABO,DWERR(R4) ;Was the sector there? BEQ 40$ ;If yes, continue SOB R3,10$ ;Go until we find a valid head BR 60$ ;Invalid head, go out 40$: CK.R5 DWSTAT BIT #STOPND,@R5 ;OP ENDED bit set yet? BNE 50$ ;Yes - Done transferring data CK.R5 DWSTAT TSTB @R5 ;DRQ bit set? .Assume STDRQ EQ 200 BPL 40$ ;No CK.R4 DWID TST DWBUF(R4) ;Drop a word from controller BR 40$ ;Continue 50$: INC R3 ;This is the valid head number TST (PC)+ ;Clear carry 60$: SEC ;Set carry RETURN HITYP: .DSABL LSB ;+ ;Bootstrap read routine ;Controller should not be busy upon entry ;- .ENABL LSB READ: ASRB (PC)+ ; 1 time code .WORD 1 BCC READX ; done, skip it CLR R5 ;Prepare to find configuration table BISB @#173050,R5 ;Get 32KB top of system RAM boundary SWAB R5 ;Convert to ASL R5 ; PAR value SUB #200,R5 ; of last 4KW page MOV R5,@#KISAR1 ;Map to it through kernel PAR1 MOV #AP$ACF,R5 MOV R5,@#KISDR1 ;Set 4K with no system trap/abort action CLR @#KISAR0 MOV R5,@#KISDR0 ;Set 4K with no system trap/abort action MOV #177600,@#KISAR7 ;Make KERNEL PAR7 -> I/O page MOV R5,@#KISDR7 ;Set 4K with no system trap/abort action BIS #20,@#MMUSR3 ;Turn on 22 bit addressing. INC @#MMUSR0 ;Turn on the KT-11 MOV #CTI+PROCFG,R3 ;Point to # of option slots .ASSUME SLOT0 EQ CTI-4 MOV @R3,R4 ;R4 = # of option slots MOV R4,R5 10$: TST -(R3) CMP -(R3),#DW$ID BEQ 20$ SOB R5,10$ ;Continue looking for device id CLR @#MMUSR0 ;Turn off memory management BR ERRX ; not found, error 20$: CLR @#MMUSR0 ;Turn off memory management SUB R5,R4 ; calc CSR address from slot number ASH #7.,R4 ADD R4,DWCSR1 MOV DWCSR1,R4 ;Get the DW CSR CK.R4=DWID CK.R4 DWID BIT #STDCAP,DWSTAT(R4) ;Is this an RD50? BNE READX ;Branch if it is MOV #-1,DW$CY1 ;Else don't limit cylinder number CALL DSKTYP ;count heads BCS ERRX ;failed MOV R3,DW$HD ;Save head number .DSABL LSB .ENABL LSB READX: MOV (PC)+,R4 DWCSR1: .WORD PC$CSR CK.R4=DWID CK.R4 DWID TST DWSTAT(R4) ;Controller busy? .Assume STBUSY EQ 100000 BMI ERRX ;Yes, error 10$: MOV R0,-(SP) ;Save block number MOV R1,-(SP) ;Save word count BOTNXT: MOV @SP,R3 ;Get current word count CMP R3,#256. ;Word count > 256. ? BLOS 20$ ;No MOV #256.,R3 ;Can only do 256. words per seek 20$: SUB R3,@SP ;Adjust word count MOV 2(SP),R1 ;Get current block number INC R1 ;Make it physical INC 2(SP) ;Increment block number (for next block) MOV R1,R5 ;Copy block number BIC #SECMSK,R5 ;Mask out all but Sector ID CK.R4 DWID MOV R5,DWSEC(R4) ;Load Sector ID register ASH #-SECBIT,R1 ;SECBIT shifts to get R0/DW$SEC .Assume SECBIT EQ 4 BIC #170000,R1 ;Mask out high 4 bits propagated by ASH CLR R0 DIV #4,R0 ;Heads in R1, cylinders in R0 DW$HD =:.-2 CMP R0,(PC)+ ;Trying to seek beyond highest track? DW$CY1: .WORD 153. BLO 30$ ;Within range ERRX: JMP @# ;Hard error 30$: CK.R4 DWID MOV R4,R5 ;Copy device register pointer CK.R5=CK.R4 CK.R5 DWID,+DWCYL ADD #DWCYL,R5 ;Point to CYLINDER ID register CK.R5 DWCYL,+2 MOV R0,(R5)+ ;Load Cylinder ID register CK.R5 DWHEAD,+2 MOV R1,(R5)+ ;Load Head ID register CK.R5 DWCMD,+2 MOV #CMREAD,(R5)+ ;Issue read command .DSABL LSB .ENABL LSB 10$: CK.R5 DWSTAT TST @R5 ;BUSY bit set? .Assume STBUSY EQ 100000 BMI 10$ ;Yes - Wait for seek to complete CK.R4 DWID BIT #S2ERR,DWST2(R4) ;Did the seek fail? BNE ERRX ;Yes - Hard error 20$: 30$: CK.R5 DWSTAT TSTB @R5 ;DRQ bit set? .Assume STDRQ EQ 200 BPL 30$ ;No - Wait MOV DWBUF(R4),(R2)+ ;Transfer a word from controller to RAM SOB R3,20$ ;Repeat until word count exhausted 40$: CK.R5 DWSTAT BIT #STOPND,@R5 ;OP ENDED bit set yet? BNE 50$ ;Yes - Done transferring data TSTB @R5 ;DRQ bit set? .Assume STDRQ EQ 200 BPL 40$ ;No CK.R4 DWID TST DWBUF(R4) ;Drop a word from controller BR 40$ ;Continue 50$: TST @SP ;Word count zero yet? BNE BOTNXT ;No - Go read next block CMP (SP)+,(SP)+ ;Drop word count and block number CLC ;Clear the carry bit RETURN .Assume . LE DWBOOT+612,MESSAGE=<;Bootstrap overlap> .DSABL LSB ;+ ;Software bootstrap section ;- .=DWBOOT+612 BOOT: MOV #10000,SP ;Set up the stack pointer MOV #2,R0 ;Block number of secondary bootstrap MOV #<4*256.>,R1 ;Word count of 4 blocks (2-5) MOV #1000,R2 ;Memory address of secondary boot (B$BOOT) CALL READ ;Load the secondary boot MOV #,@#B$READ ;Store pointer to read routine MOV #B$DNAM,@#B$DEVN ;Store RAD50 device name CLR @#B$DEVU ;Store unit number (always 0) JMP @#B$BOOT ;Enter the secondary boot .DREND DW .SBTTL FETCH/LOAD code .PSECT SETOVR SETOVR: FETCH: JMP FETCH1 ; SUBROUTINE TO READ SECTOR 2 WITH HEAD 0 AT THE SPECIFIED CYLINDER ; ; This routine will read data from the DW device at the specifed ; cylinder. The cylinder, number of words, and storage buffer ; are the trailing arguments. The device CSR must be in R0 when ; this routine is called. ; ; INPUT VARIABLES: ; ; R0 BASE ADDRESS (DWID) OF THE DW CONTROLLER ; ; OUTPUT VARIABLES: ; ; NONE ; ; REGISTERS DESTROYED: ; ; NONE ; ; CALLING SEQUENCE: ; ; JSR R5,DWREAD ; .WORD CYLINDER ; .WORD WORD_COUNT ; LESS THAN OR EQUAL TO 256 ; .WORD BUFFER_ADDRESS ; ADDRESS WHERE THE DATA IS TO BE STORED ; DWREAD: MOV R0,-(SP) ; Save registers used MOV R4,-(SP) MOV #2,DWSEC(R0) ; Read sector 2 (logical sector 1) ADD #DWCYL,R0 ; Point to DW CYLINDER ID register MOV (R5)+,(R0)+ ; Load cylinder to read CLR (R0)+ ; Set HEAD ID to 0 MOV #CMREAD,(R0)+ ; Issue read command MOV (R5)+,R3 ; Get number of words to read MOV (R5)+,R4 ; Get buffer to read (R3) words into 10$: TST (R0) ; Is device BUSY? BMI 10$ ; YES - Wait for seek to complete 20$: TSTB (R0) ; Data Request bit set? BPL 20$ ; NO - Wait for it to be set MOV DWBUF-DWSTAT(R0),(R4)+ ; Read a word into buffer SOB R3,20$ ; Loop until (R3) words read 30$: TSTB (R0) ; Data Request bit set? BPL 40$ ; NO TST DWBUF-DWSTAT(R0); YES - Drop a word from the controller 40$: BIT #STOPND,(R0) ; Is OP ENDED bit set yet? BEQ 30$ ; Loop until OP ENDED bit is set BIT #S2ERR,DWST2-DWSTAT(R0) ; Did the SEEK succeed? BEQ 50$ ; YES - Return success SEC ; Set carry - Error 50$: MOV (SP)+,R4 ; Restore registers MOV (SP)+,R0 RTS R5 ; Return .ENABL LSB ;----------------------------------------------------------------------------- ; FIND DEVICE GEOMETRY ; ; THIS ROUTINE WILL DETERMINE THE TYPE OF DEVICE WHEN TWO OR MORE DEVICES ; HAVE THE SAME NUMBER OF HEADS. THIS IS DONE BY CALCULATING THE ADDRESS ; WHICH WOULD WRAP TO THE HOME BLOCK. THE FIRST 3 WORDS OF THE HOME BLOCK ; AND THE WRAP BLOCK ARE COMPARED. IF DIFFERENT, A WRAP DID NOT OCCUR AND ; THE POINTER TO THE DEVICE GEOMETRY/CHARACTERISTICS TABLE IN BUMPED TO THE ; NEXT DEVICE. IF IDENTICAL, THE DATA IN THE HOME BLOCK IS MODIFIED AND ; WRITTEN TO THE DEVICE. THE FIRST WRAP BLOCK IS READ AGAIN AND THE FIRST ; 3 WORDS OF THE HOME AND WRAP BLOCKS ARE COMPARED AND IF DIFFERENT, THE ; POINTER TO THE DEVICE GEOMETRY/CHARACTERISTICS TABLE IS BUMPED TO THE ; NEXT DEVICE. OTHERWISE, THE POINTER REMAINS UNCHANGED. ; ; THIS OPERATION CONTINUES UNTIL THE LARGEST DISK WITH A GIVEN NUMBER OF ; HEADS IS FOUND. ; ; REGISTERS CONTAIN THE FOLLOWING INFORMATION ON ENTRY AND EXIT ; ; R0 ADDRESS OF DWID REGISTER ; R1 POINTER TO DEVICE GEOMETRY/CHARACTERISTICS TABLE ; - UPDATED ON EXIT ; R2 POINTER TO RMON ; R3 DEVICE TYPE ; - UPDATED ON EXIT ; R4 ADDRESS OF READ ROUTINE ; R5 ADDRESS OF START OF HANDLER ; ;----------------------------------------------------------------------------- FNGEOM: TST DWTYPS ; Is device type known? BNE 95$ ; YES - Don't size device CMP 2(R1),TSIZE+2(R1) ; Does next entry have the same ; number of heads? BNE 95$ ; NO - Done MOV R2,-(SP) ; Save R2 .ADDR #BUFHOM,R2 ; Setup address of home block buffer MOV R2,10$ ; JSR R5,DWREAD ; Read home block .WORD 0 ; Cylinder 0 .WORD 256. ; 256. WORDS 10$: .WORD 0 ; BUFFER BCS 90$ MOV R4,-(SP) MOV #-1,35$ ; Initialize gate 15$: MOV 4(R1),20$ ; Get last physical cylinder number INC 20$ ; Cause it to wrap .ADDR #BUFWRP,R2 ; Setup address of wrap block buffer MOV R2,25$ ; JSR R5,DWREAD ; Read wrap block 20$: .WORD 0 ; Cylinder 4(R1)+1 .WORD SIZWRP ; SIZWRP WORDS 25$: .WORD 0 ; Wrap block Buffer BCS 85$ MOV #SIZWRP,R2 ; Compare the data .ADDR #BUFHOM,R3 ; Point to home block buffer .ADDR #BUFWRP,R4 ; Point to wrap block buffer 30$: CMP (R3)+,(R4)+ ; Compare a word BNE 80$ ; Data is different SOB R2,30$ ; Loop till done INC (PC)+ ; Branch if 2nd time thru here 35$: .WORD -1 BNE 75$ MOV #SIZWRP,R2 ; Check home block data .ADDR #HOMPAT+,R4 ; Point to expected home block data 40$: CMP -(R3),-(R4) ; Is data identical? BNE 45$ ; NO - Data is different SOB R2,40$ ; Loop till done CMP (R3)+,(R4)+ ; Swap second and 3rd words in home block TST (R4)+ MOV (R4),(R3)+ MOV -(R4),(R3) CMP -(R3),-(R3) ; Reset pointer to start of home block BR 60$ 45$: MOV (R4),(R3) ; Put expected home block data into home block BR 55$ 50$: MOV -(R4),-(R3) 55$: SOB R2,50$ 60$: MOV #2,DWSEC(R0) ; Write logical block number 1 CLR DWCYL(R0) CLR DWHEAD(R0) MOV #CMWRIT,DWCMD(R0) ; Start write operation 65$: TSTB DWSTAT(R0) ; Is data being requested by the device? BPL 70$ ; NO MOV (R3)+,DWBUF(R0) ; Write a word of data to the device 70$: BIT #STOPND,DWSTAT(R0) ; Is operation ended? BEQ 65$ ; NO - Loop till done BR 15$ ; Loop thru for final check 75$: SEC ; Set carry, geometry not changed BR 85$ ; Stay with current geometry 80$: ADD #TSIZE,R1 ; Point to next entry in geometry table CLC ; Clear carry, geometry changed 85$: MOV (SP)+,R4 ; Restore registers 90$: MOV (SP)+,R2 BCC FNGEOM ; If geometry changed, loop 95$: MOV (R1),R3 ; Get device type ;***************************************************************************** CK.R5=DWBASE CK.R2=SYSPTR MOV #TSIZE/2,R0 ;word to move CK.R5 DWBASE ADD #RDTYP-DWBASE,R5 ; and to RDTYP 100$: MOV (R1)+,(R5)+ SOB R0,100$ 105$: ;>>>here if SET SLOT=n, put in dwtype+1 CK.R2 SYSPTR MOVB R3,DWTYPE(R2) ;Set fixed offset with geometry number DWTYPX=:.-2 FETXIT: TST (PC)+ ;Normal return FETERR: SEC ;Error return BIC R0,R0 ;*C* clear R0 RETURN .DSABL LSB DWTAB: .BYTE TYP51,TYP52C,TYP32,TYP52A,TYP52Q ; 1 2 3 4 5 6 7 8 ;number of heads ; ;DWTAB: .BYTE 2, 4, 8.,6, 5 ;DW type codes ; ; 1 7 ;added DW type codes ; 3 ;... ; ; 5 5 3 5 5 ; 1 2 2 2 2 ; ; 5 5 ; 0 3 ; ; 3 ; 1 .EVEN DEVCHR: ;RDxx device characteristics table ;***************************************************************************** ; THIS TABLE MUST BE GROUPED BY THE NUMBER OF HEAD. THE ENTRIES WITHIN ; THE GROUP MUST BE SORTED BY THE NUMBER OF CYLINDERS IN INCREASING ORDER. ; THE TABLE IS TERMINATED WITH A HEAD COUNT OF 65535. ;***************************************************************************** ; C H CYL REAL USER HIGH LOW USER DEVICE ; O E SIZE SIZE SIZE SIZE SIZE ; D A ; E D ; S $TYPE$ TYP50 4. 153. 9792. 9727. 0. 9792. 9727. ;RD50# $TYPE$ TYP51 4. 306. 19584. 19519. 0. 19584. 19519. ;RD51 $TYPE$ TYP31 4. 615. 39360. 39295. 0. 39360. 39295. ;RD31*$ $TYPE$ TYP52C 5. 697. 55760. 55679. 0. 55760. 55679. ;RD52* CDC $TYPE$ TYP32 6. 820. 78720. 78623. 13088. 65535. 65535. ;RD32 $TYPE$ TYP52A 7. 645. 72240. 72127. 6705. 65535. 65535. ;RD52* ATASI $TYPE$ TYP52Q 8. 512. 65536. 65407. 1. 65535. 65407. ;RD52*$ QUANTUM $TYPE$ TYP53 8. 1024. 131072. 130943. 65535. 65535. 65535. ;RD53*$ $TYPE$ 0 -1 0. 0. 0. 0. 0. 0. ;TERMINATOR ; ; Note: ; ; For the RD53 there are 65537. blocks that are left over after allocating ; the maximum number of blocks that RT-11 allows (65535.) for partition 0. ; Since 65537. will not fit in a PDP-11 unsigned word, the remainder size ; used in the $TYPE$ macro is 65535. ; ;$TYPE$ TYP53 8. 1024. 131072. 130943. 65537. 65535. 65535. ;RD53*$ ; ; A B C D E F G ; ; C=16.*A*B Physical size of device ; D=16.*A*(B-1)-1 usable size (first block reserved for start-up ; diagnostics and last cyl reserved for FCT) ; E=MIN(MAX(C-65535.,0),65535.) Physical size over 65535. blocks ; F=MIN(C,65535.) Partition 0 physical size ; G=MIN(D,65535.) Partition 0 useable size ; ;# bit indicates RD50 ;* contains FCT ;$ seek test required to determine SIZWRP =: 3. BLKHOM =: 1. ;Actual home block location HOMPAT: .WORD 0,170000,7777 DWTYPS: .WORD 0 BUFWRP: .BLKW SIZWRP BUFHOM: .=BUFWRP ; FETCH/LOAD ROUTINE ; ; THIS AREA WILL BE USED AS DATA STORAGE WHEN CHECKING DEVICE GEOMETRY ; .ENABL LSB FETCH1: NOP ;BPT for debugging MOV @R5,R5 ;Point to memory resident handler code CK.R5=DWBASE MOV @#SYSPTR,R2 ;Load addr of RMON CK.R2=SYSPTR .IF NE MMG$T CK.R2 SYSPTR CK.R5 DWBASE MOV P1EXT(R2),$P1EXT-DWBASE(R5) ;Setup pointer to P1EXT .ENDC ;NE MMG$T CK.R5 DWBASE MOV DWCSR-DWBASE(R5),R0 ;get address of DW CSRs CK.R0=DWID BNE 15$ ;don't search MOV #DW$ID,-(SP) ;Put DW controller ID on stack CK.R1=$GTVEC CK.R1 ,+2 TST (R1)+ ;Change pointer to GETCSR from GETVEC CK.R1 $GTCSR CALL @R1 ;Look for the DW controller MOV (SP)+,R0 ;*C* Save response, align stack CK.R0=DWID BCS FETERR ;Really BAD! since we installed CK.R0 DWID CK.R5 DWBASE MOV R0,DWCSR-DWBASE(R5) ;Setup address of DW CSRs MOV #DW$ID,-(SP) ;now get slot number CK.R1 $GTCSR,+2 TST (R1)+ ;point to $GTSLT CK.R1 $GTSLT CALL @R1 ;get the slot number CK.R5 DWBASE BIS @SP,CLRIMR-DWBASE(R5) ;Setup slot bits in Int Cntrl commands CK.R5 DWBASE BIS @SP,SETIMR-DWBASE(R5) ;... CK.R5 DWBASE BIS (SP)+,CLRIRR-DWBASE(R5) ;... BR 17$ 15$: INC DWTYPX ;UGH, put type code in high byte 17$: MOV R5,R1 ;Copy base of DW CK.R1=CK.R5 ADD #DRETRY-DWBASE,R1 ; calc addr CK.R1 ,+DRETRY-DWBASE CK.R1 DRETRY CK.R5 DWBASE MOV R1,DRETR1-DWBASE(R5) ;put pic addr in DW CK.R1 DRETRY ADD #CRNTCYL-DRETRY,R1 ; calc addr CK.R1 ,+CRNTCYL-DRETRY CK.R1 CRNTCYL CK.R5 DWBASE MOV R1,CRNT1-DWBASE(R5) ;put pic addr in DW CK.R1 CRNTCYL CK.R5 DWBASE MOV R1,CRNT2-DWBASE(R5) ;put pic addr in DW CK.R1 CRNTCYL ADD #FNTBL-CRNTCYL,R1 ; calc addr CK.R1 ,+FNTBL-CRNTCYL CK.R1 FNTBL CK.R5 DWBASE MOV R1,FNTBL1-DWBASE(R5) ;put pic addr in DW CMP #DPT.BT,R3 ;BSTRAP entry? BNE 20$ ;No, use RMON MOV @#DW$HD-DWBOOT,R3 ;Get head count from DRBOT routine ;note: clears SET SLOT flag BR HEADCK ;join after head search .SBTTL Use the DSKTYP routine in DRBOT CK.R2 SYSPTR 20$: MOV DWTYPE(R2),R3 ;is the geometry already known? BIT #1,DWTYPX ;Was slot specified? BEQ 23$ ;no SWAB R3 ;yes, slide down a byte (for now) 23$: MOVB R3,R3 ;clear high byte BNE 31$ ;yes, then we don't have to count heads MOV R4,-(SP) ;Save read routine address S.TOP=CK.R4 MOV R5,-(SP) ;and DWBASE pointer S.TOP2=CK.R5 CK.R0 DWID MOV R0,R4 ;Point to CSRs CK.R4=CK.R0 CK.R4 DWID CALL DSKTYP ;get head count MOV (SP)+,R5 ;*C*restore DWBASE pointer CK.R5=S.TOP2 MOV (SP)+,R4 ;*C*restore read routine address CK.R4=S.TOP BCS FETERR ;failed HEADCK: CMP #4,R3 ;Is this a 4 head drive? BNE 30$ ;No CK.R3=4 CK.R0 DWID BIT #STDCAP,DWSTAT(R0) ; Is it an RD50? BEQ 30$ ;No MOV #TYP50,R3 ;RD50 type code 31$: INC DWTYPS ;Note that device type is known. BR FETUPD 30$: .BR FETXLT CK.R5 DWBASE CK.R2 SYSPTR .DSABL LSB .ENABL LSB FETXLT: .ADDR #DWTAB-4,R3,ADD ;point to entry MOVB @R3,R3 ;Change head number to type code FETUPD: .ADDR #DEVCHR,R1 ;point to geometry table 10$: CMPB @R1,R3 ;is it the correct entry? BEQ 20$ ; yes ADD #TSIZE,R1 ; no, try next BR 10$ ; (forever?) 20$: JMP FNGEOM ; Go find largest geometry ; device with same number of heads .DSABL LSB .ASSUME BUFHOM+1000 LE SETOVR+2000,MESSAGE=<;FETCH area overflow> .ASSUME .+ LE SETOVR+2000,MESSAGE=<;DSKTYP not all in FETCH blocks> .END