; DEC/CMS REPLACEMENT HISTORY, Element UKDRIVER.MAR ; *1 15-MAY-1991 09:42:45 PANNER "YELLOW$SIGMA - Example DR11W to VME driver" ; DEC/CMS REPLACEMENT HISTORY, Element UKDRIVER.MAR .TITLE QKDRIVER - VAX/VMS VMEbus IKon DR11-W Emulator DRIVER .IDENT 'X-02' ; ;**************************************************************************** ;* * ;* COPYRIGHT (c) 1990 BY * ;* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * ;* ALL RIGHTS RESERVED. * ;* * ;* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * ;* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * ;* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * ;* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ;* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * ;* TRANSFERRED. * ;* * ;* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * ;* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * ;* CORPORATION. * ;* * ;* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * ;* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * ;* * ;* * ;**************************************************************************** ; ;++ ; ; FACILITY: ; ; VAX/VMS Executive, I/O Drivers ; ; ABSTRACT: ; ; This module contains the driver for the VMEbus Ikon DR11-W Emulator ; (XMI). ; ; ; ENVIRONMENT: ; ; Kernel Mode, Non-paged ; ; ; ;-- .SBTTL External and local symbol definitions ; External symbols $ACBDEF ; AST control block $ADPDEF ; Adapter control block $CRBDEF ; Channel request block $DCDEF ; Device types $DDBDEF ; Device data block $DEVDEF ; Device characteristics $DPTDEF ; Driver prolog table $DYNDEF ; Dynamic data structure types $EMBDEF ; EMB offsets $IDBDEF ; Interrupt data block $IODEF ; I/O function codes $IPLDEF ; Hardware IPL definitions $IRPDEF ; I/O request packet $PRDEF ; Internal processor registers $PRIDEF ; Scheduler priority increments $SSDEF ; System status codes $UCBDEF ; Unit control block $VECDEF ; Interrupt vector block $XADEF ; Define device specific characteristics $XVIBDEF ; VME definitions ; Local symbols ; Argument list (AP) offsets for device-dependent QIO parameters P1 = 0 ; First QIO parameter P2 = 4 ; Second QIO parameter P3 = 8 ; Third QIO parameter P4 = 12 ; Fourth QIO parameter P5 = 16 ; Fifth QIO parameter P6 = 20 ; Sixth QIO parameter ; Other constants QK_DMA_DEF_TIMEOUT = 10 ; 10 second DMA default timeout QK_READ_SYNCH_TIMEOUT = 10 ; 10 second Time out to synchronize ; with a READ request. QK_DEF_BUFSIZ = 65535 ; Default buffer size QK_RESET_DELAY = <<2+9>/10> ; Delay N microseconds after RESET ; (rounded up to 10 microsec intervals) QK_ADDR_MOD_10089 = ^XD00 ; Select 32 bit addressing on the VME. ; Which is 0D. This value is in the ; high byte of the Register. QK_ADDR_MOD_10099 = ^X8B00 ; Block Mode. ; DR11-W definitions that follow the standard UCB fields $DEFINI UCB .=UCB$L_DPC+4 $DEF UCB$L_MAPREG_DESC ; The Mapping Register Descriptor. $DEF UCB$W_START_MAPREG ; The Starting Map Register. .BLKW 1 $DEF UCB$W_NUMBER_MAPREG ; The number of Map Registers. .BLKW 1 $DEF UCB$W_QK_UNEXPECTED ; Counter for # of unexpected interrupts. .BLKW 1 $DEF UCB$W_QK_CSRTMP ; Temporary storage of Control Reg image .BLKW 1 $DEF UCB$W_QK_BARTMPLOW ; Temporary storage of BAR Reg LOW image .BLKW 1 $DEF UCB$W_QK_BARTMPHIGH ; Temporary storage of BAR Reg HIGH image .BLKW 1 $DEF UCB$W_QK_WCRTMPLOW ; Temporary storage of WCR Reg LOW image .BLKW 1 $DEF UCB$W_QK_WCRTMPHIGH ; Temporory storage of WCR Reg HIGH image. .BLKW 1 $DEF UCB$W_QK_PULSE ; Storage for the Pulse command register. .BLKW 1 $DEF UCB$W_QK_VECTOR ; Storage for the Vector and Address .BLKW 1 ; Modifier Register. $DEF UCB$W_QK_CSR ; Saved STATUS Reg on interrupt .BLKW 1 $DEF UCB$W_QK_BARLOW ; Saved BAR register LOW on interrupt .BLKW 1 $DEF UCB$W_QK_BARHIGH ; Saved BAR register HIGH on interrupt .BLKW 1 $DEF UCB$W_QK_WCRLOW ; Saved WCR register LOW on interrupt .BLKW 1 $DEF UCB$W_QK_WCRHIGH ; Saved WCR register HIGH on interrupt .BLKW 1 $DEF UCB$W_QK_ERROR ; Saved Error return. .BLKW 1 ; Bit positions for device-dependent status field in UCB $VIELD UCB,0,<- ; UCB device specific bit definitions ,- ; The READ partner QIO is ready. ,- ; The Waiting for READ partner interrupt. > UCB$K_SIZE=. $DEFEND UCB ; Device register offsets from CSR address $DEFINI QK ; Start of Ikon DR11-W definitions $DEF QK_CONTROL ; Control Register $DEF QK_STATUS ; Status Register .BLKW 1 $DEF QK_DATA_OUT ; Data Out Register $DEF QK_DATA_IN ; Data In Register .BLKW 1 $DEF QK_MODIFIER_VECTOR ; Address Modifier and Vector Register. .BLKW 1 $DEF QK_PULSE_COMMAND ; Pulse Command Register .BLKW 1 .BLKW 5 ; Empty space in register area. $DEF QK_BAR_LOW_WRITE ; DMA address Low 16 bits. WRITE .BLKW 1 $DEF QK_WCR_LOW ; DMA Word Count Low 16 bits register. .BLKW 1 $DEF QK_BAR_LOW_READ ; DMA address Low 16 bits. READ .BLKW 1 .BLKW 1 ; Empty space in register area. $DEF QK_BAR_HIGH_WRITE ; DMA address High 16 bits. Write .BLKW 1 $DEF QK_WCR_HIGH ; DMA Word Count High 16 bits register. .BLKW 1 $DEF QK_BAR_HIGH_READ ; DMA address High 16 bits. READ .BLKW 1 ; Bit positions for device control/status register $EQULST QK$K_,,0,1,<- ; Define CSR FNCT bit values - - - - ; Define CSR STATUS bit values - - > $VIELD QK_CONTROL,0,<- ; Control register ,- ; Start device ,- ; CSR FNCT bits ,- ; Software direction ,- ; Unused bit ,- ; Enable interrupts ,- ; Terminate active DMA. ,- ; Starts slave transmit ,- ; UNUSED bits ,- ; Master Clear. ,- ; Reset Parity Error Flag. ,- ; Reset Attention flag and its interrupt. ,- ; Reset DMA Done flag and its interrupt. > $VIELD QK_STATUS,0,<- ; Status register ,- ; Device Flag ,- ; FNCT bits ,- ; State of SDIR latch ,- ; Bus error flag ,- ; Enable interrupts ,- ; DMA Ready. ,- ; UNUSED bit ,- ; Status bits ,- ; Parity error flag. ,- ; State of Attention H input. ,- ; Attention interrupt. ,- ; DMA Done interrupt. > $DEFEND QK ; End of DR11-W definition .SBTTL Device Driver Tables ; Driver prologue table DPTAB - ; DPT-creation macro END=QK_END,- ; End of driver label ADAPTER=VME,- ; Adapter type FLAGS=DPT$M_SVP,- ; Allocate system page table UCBSIZE=UCB$K_SIZE,- ; UCB size NAME=QKDRIVER ; Driver name DPT_STORE INIT ; Start of load ; initialization table DPT_STORE UCB,UCB$B_FLCK,B,SPL$C_IOLOCK8 ; Device fork IPL DPT_STORE UCB,UCB$B_DIPL,B,22 ; Device interrupt IPL DPT_STORE UCB,UCB$L_DEVCHAR,L,<- ; Device characteristics DEV$M_AVL!- ; Available DEV$M_RTM!- ; Real Time device DEV$M_ELG!- ; Error Logging enabled DEV$M_IDV!- ; input device DEV$M_ODV> ; output device DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_REALTIME ; Device class DPT_STORE UCB,UCB$B_DEVTYPE,B,DT$_XVIB ; Device Type DPT_STORE UCB,UCB$W_DEVBUFSIZ,W,- ; Default buffer size QK_DEF_BUFSIZ DPT_STORE REINIT ; Start of reload ; initialization table DPT_STORE DDB,DDB$L_DDT,D,QK$DDT ; Address of DDT DPT_STORE CRB,CRB$L_INTD+4,D,- ; Address of interrupt QK_INTERRUPT ; service routine DPT_STORE CRB,CRB$L_INTD+VEC$L_INITIAL,-; Address of controller D,QK_CONTROL_INIT ; initialization routine DPT_STORE END ; End of initialization ; tables ; Driver dispatch table DDTAB - ; DDT-creation macro DEVNAM=QK,- ; Name of device START=QK_START,- ; Start I/O routine FUNCTB=QK_FUNCTABLE,- ; FDT address CANCEL=QK_CANCEL ; Cancel I/O routine ; ; Function dispatch table ; QK_FUNCTABLE: ; FDT for driver FUNCTAB ,- ; Valid I/O functions FUNCTAB , ; No buffered functions FUNCTAB QK_READ_WRITE,- ; Device-specific FDT FUNCTAB +EXE$QIODRVPKT,- .SBTTL QK_CONTROL_INIT, Controller initialization ;++ ; QK_CONTROL_INIT, Called when driver is loaded, system is booted, or ; power failure recovery. ; ; Functional Description: ; ; 1) Allocates the direct data path permanently ; 2) Assigns the controller data channel permanently ; 3) Clears the Control and Status Register ; 4) If power recovery, requests device time-out ; ; Inputs: ; ; R4 = address of CSR ; R5 = address of IDB ; R6 = address of DDB ; R8 = address of CRB ; ; Outputs: ; ; ;-- QK_CONTROL_INIT: MOVL IDB$L_UCBLST(R5),R0 ; Address of UCB MOVL R0,IDB$L_OWNER(R5) ; Make permanent controller owner BISW #UCB$M_ONLINE,UCB$W_STS(R0) ; Set device status "on-line" CLRW UCB$W_QK_UNEXPECTED(R0) ; Init Unexpected Interrupt counter. 10$: PUSHR #^M ; Save R5 MOVZBL IDB$B_VECTOR(R5),R1 ; Get the vector address. ROTL #2,R1,R1 ; Normalize the vector PUSHL R0 READ_CSR QK_STATUS(R4),R2,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC POPL R0 SWAPWORD R2 ; Swap the bytes. MOVL #QK_ADDR_MOD_10089,R3 ; Set R3 to the Address Modifier value. BBC #QK_STATUS$V_DFLG,R2,50$; Branch if this is the 10089 revision. MOVL #QK_ADDR_MOD_10099,R3 ; Set R2 to the Address Modifier value. 50$: ADDL2 R3,R1 ; Add in the Address Modifier. MOVW R1,UCB$W_QK_VECTOR(R0) ; Save the Vector and Address Mod value. SWAPWORD R1 ; Swap the bytes. PUSHL R0 WRITE_CSR R1,QK_MODIFIER_VECTOR(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC POPL R0 MOVL R0,R5 ; Copy UCB address to R5 BSBW QK_DEV_HWRESET POPR #^M ; Restore R5 RSB ; Done .SBTTL QK_READ_WRITE, FDT for device data transfers ;++ ; QK_READ_WRITE, FDT for READLBLK,READVBLK,READPBLK,WRITELBLK,WRITEVBLK, ; WRITEPBLK ; ; Functional description: ; ; 1) Rejects QUEUE I/O's with odd transfer count ; ; Inputs: ; ; R3 = Address of IRP ; R4 = Address of PCB ; R5 = Address of UCB ; R6 = Address of CCB ; R8 = Address of FDT routine ; AP = Address of P1 ; P1 = Buffer Address ; P2 = Buffer size in bytes ; P3 = DMA Time Out Time in seconds ; P4 = VMEbus control flags. ; ; Outputs: ; ; R0 = Error status if odd transfer count ; ;-- QK_READ_WRITE: BLBS P1(AP),2$ ; The Buffer address must not be on ; a byte boundary. BLBC P2(AP),20$ ; Branch if transfer count even 2$: MOVZWL #SS$_BADPARAM,R0 ; Set error status code 5$: JMP G^EXE$ABORTIO ; Abort request 20$: TSTL P2(AP) ; Error if no transfer count. BEQL 2$ MOVL P3(AP),IRP$L_MEDIA(R3) ; Save the Time Out time. BNEQ 30$ ; Branch if there is a time out time. MOVL #QK_DMA_DEF_TIMEOUT,- ; Set Time Out time to the default. IRP$L_MEDIA(R3) 30$: MOVL P4(AP),IRP$L_MEDIA+4(R3); Sve the VMEbus control flags. MOVL P1(AP),R0 ; Get the buffer address. MOVL P2(AP),R1 ; Get the byte count. JSB G^EXE$MODIFYLOCKR ; Check buffer for access and lock down BLBC R0,5$ RSB ; the buffer. .SBTTL QK_START, Start I/O routines ;++ ; QK_START - Start a data transfer, set characteristics, enable ATTN AST. ; ; Functional Description: ; ; This routine has two major functions: ; ; 1) Start an I/O transfer. This transfer can be in either word ; or block mode. The FNCTN bits in the DR11-W CSR are set. If ; the transfer count is zero, the STATUS bits in the DR11-W CSR ; are read and the request completed. ; ; Inputs: ; ; R3 = Address of the I/O request packet ; R5 = Address of the UCB ; ; Outputs: ; ; R0 = final status and number of bytes transferred ; R1 = value of CSR STATUS bits and value of input data buffer register ; Device errors are logged ; Diagnostic buffer is filled ; ;-- .ENABL LSB QK_START: ASSUME IDB$L_CSR EQ 0 MOVL UCB$L_CRB(R5),R4 ; Address of CRB MOVL @CRB$L_INTD+VEC$L_IDB(R4),R4 ; Get the CSR address. MOVAL UCB$L_MAPREG_DESC(R5),R1 ; Set R1 to the address of mapreg desc. MOVL UCB$L_CRB(R5),R2 ; Get CRB address. MOVL CRB$L_INTD+VEC$L_ADP(R2),R2 ; Get address of ADP. PUSHL R3 ; Save R3. MOVL IRP$L_BCNT(R3),R0 ; Get the byte count. MOVZWL IRP$W_BOFF(R3),R3 MOVAB ^X3FF(R0)[R3],R3 ; Calculate highest relative byte and round ASHL #-9,R3,R3 ; Calculate number of map registers required BSBW IOC$ALOVMEMAP_DMAN ; Allocate a set of VME map regs. POPL R3 ; Restore R3 BLBS R0,50$ MOVZWL #SS$_INSFMAPREG,R0 ; Set to error and end QIO. CLRL R1 JMP QIO_DONE 50$: MOVL IRP$L_MEDIA+4(R3),R0 ; Get the VMEbus control flags. MOVAL UCB$L_MAPREG_DESC(R5),R1; Set the Mapreg desc address. PUSHR #^M ; Save R3-R5. MOVL IRP$L_BCNT(R3),R4 ; Set R4 to the byte count. MOVZWL IRP$W_BOFF(R3),R5 ; Set R5 to the byte offset into 1st page. MOVL IRP$L_SVAPTE(R3),R3 ; Set R3 to the SVAPTE of first page. BSBW IOC$LOADVMEMAP_DMAN ; Load the VME mapping registers. POPR #^M ; Restore R3-R5. ; ; Build the BAR registers. ; MOVZWL IRP$W_BOFF(R3),R1 ; Byte offset in first page of xfer INSV UCB$W_START_MAPREG(R5),#9,#16,R1 ; Insert the Starting Map Register number ; R1 contains the BAR value. ASHL #-1,R1,R1 ; The DR11-W wants the data shifted ; one place to the right. MOVW R1,UCB$W_QK_BARTMPLOW(R5) ; Save the BAR Low Register value. ASHL #-16,R1,R2 ; Set R1 to BAR High value. MOVW R2,UCB$W_QK_BARTMPHIGH(R5) ; Save the BAR High Register value. ; ; Store the Word Count register contents. ; MOVL IRP$L_BCNT(R3),R0 ; Fetch byte count ASHL #-1,R0,R1 ; Make byte count into word count DECL R1 ; The Ikon DR11-2 wants # of words ; Minus 1 for the Word Count. ASHL #-16,R1,R0 ; R1 Word has WC Low value. ; R0 Word has WC High value. MOVW R1,UCB$W_QK_WCRTMPLOW(R5) ; Set the WC Low Register value. MOVW R0,UCB$W_QK_WCRTMPHIGH(R5) ; Set the WC High Register value. ; Initialize the CSR contents for a Read. Enable interrupts and set the Go ; Bit. Set the 1st function bit to set direction ; Use the Pulse command Function 2 to interrupt the Transmitter partner. ; MOVW #,- UCB$W_QK_CSRTMP(R5) MOVW #QK$K_FNCT2,UCB$W_QK_PULSE(R5) DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Lock device access SAVIPL=-(SP),- ; Save current IPL PRESERVE=NO ; DON'T Preserve R0 ; Branch if a Read request. ; CMPW #IO$_READPBLK,IRP$W_FUNC(R3) BEQL 1000$ ; Write Request. Make sure that the Read Partner is ready. ; CLRW UCB$W_QK_PULSE(R5) BBS #UCB$V_READ_READY,UCB$W_DEVSTS(R5),500$ BISW #UCB$M_WAITING_FOR_READ,- UCB$W_DEVSTS(R5) ; Set the flag that we are waiting for ; the READ partner to be ready. WFIKPCH QK_TIME_OUT,#QK_READ_SYNCH_TIMEOUT ; Wait for Read ATTN interrupt ; indicating the READ partner ; is Ready. IOFORK DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Lock device access SAVIPL=-(SP),- ; Save current IPL PRESERVE=NO ; DON'T Preserve R0 MOVL UCB$L_IRP(R5),R3 ; Get the IRP. 500$: BICW #,- UCB$W_DEVSTS(R5) ; Clear the READ Ready Flag and Waiting ; For Read flag. ; Initialize the CSR contents for a WRITE. Enable interrupts, set the Go, and ; Cycle Bits. ; MOVW #,- UCB$W_QK_CSRTMP(R5) 1000$: SETIPL #31,- ; Raise to IPL POWER ENVIRON=UNIPROCESSOR MOVW UCB$W_QK_WCRTMPLOW(R5),R0 ; Get the WC low register. SWAPWORD R0 ; Swap the bytes. WRITE_CSR R0,QK_WCR_LOW(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC MOVW UCB$W_QK_WCRTMPHIGH(R5),R0 ; Get the WC High register. SWAPWORD R0 ; Swap the bytes. WRITE_CSR R0,QK_WCR_HIGH(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC MOVW UCB$W_QK_BARTMPLOW(R5),R0 ; Set the Buffer Address Registers. SWAPWORD R0 WRITE_CSR R0,QK_BAR_LOW_WRITE(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC MOVW UCB$W_QK_BARTMPHIGH(R5),R0 SWAPWORD R0 WRITE_CSR R0,QK_BAR_HIGH_WRITE(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC CMPW #IO$_READPBLK,IRP$W_FUNC(R3) BNEQ 1010$ MOVW UCB$W_QK_PULSE(R5),R0 ; Set the pulse command to set ATTN SWAPWORD R0 ; for Reads. WRITE_CSR R0,QK_PULSE_COMMAND(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC 1010$: MOVW UCB$W_QK_CSRTMP(R5),R0 ; Move all bits to CSR SWAPWORD R0 WRITE_CSR R0,QK_CONTROL(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC ; Wait for transfer complete interrupt, powerfail, or device time-out WFIKPCH QK_TIME_OUT,IRP$L_MEDIA(R3) ; Wait for interrupt ; Device has interrupted, FORK IOFORK ; FORK to lower IPL ; Handle request completion, release VME resources, check for errors MOVZWL #SS$_NORMAL,-(SP) ; Assume success, store code on stack MOVAL UCB$L_MAPREG_DESC(R5),R1; Get address of mapreg desc. MOVL UCB$L_CRB(R5),R2 ; Get CRB address. MOVL CRB$L_INTD+VEC$L_ADP(R2),R2 ; Get address of ADP. BSBW IOC$RELVMEMAP_DMAN ; Release the mapping registers. ; Check for errors and return status CMPW UCB$W_QK_WCRHIGH(R5),#^XFFFF ; All words transferred? BNEQ 1080$ ; NO CMPW UCB$W_QK_WCRLOW(R5),#^XFFFF ; All words transferred? BEQL 1100$ ; Yes 1080$: MOVZWL #SS$_OPINCOMPL,(SP) ; No, flag operation not complete BICW #,- UCB$W_DEVSTS(R5) ; Clear the read ready flags. 1100$: BBC #QK_STATUS$V_PERR,UCB$W_QK_CSR(R5),1110$ ; Branch on CSR error bit 1105$: MOVZWL UCB$W_QK_ERROR(R5),(SP) ; Flag for controller/drive error status BSBW QK_DEV_RESET ; Reset DR11-W BRB 1200$ 1110$: BBS #QK_STATUS$V_BERR,UCB$W_QK_CSR(R5),1105$ 1200$: MOVL (SP)+,R0 ; Get final device status MOVZWL UCB$W_QK_WCRLOW(R5),R1 ; Return Word Count. ASHL #16,R1,R1 MOVW UCB$W_QK_CSR(R5),R1 ; Return CSR in IOSB QIO_DONE: REQCOM ; Finish request in exec .PAGE .SBTTL DR11-W DEVICE TIME-OUT ;++ ; DR11-W device TIME-OUT ; If a DMA transfer was in progress, release UBA resources. ; For DMA or WORD mode, deliver ATTN AST's, log a device timeout error, ; and do a hard reset on the controller. ; ; Clear DR11-W CSR ; Return error status ; ; Power failure will appear as a device time-out ;-- .ENABL LSB QK_TIME_OUT: ; Time-out for DMA transfer IOFORK ; Fork to complete request MOVAL UCB$L_MAPREG_DESC(R5),R1; Get address of mapreg desc. MOVL UCB$L_CRB(R5),R2 ; Get CRB address. MOVL CRB$L_INTD+VEC$L_ADP(R2),R2 ; Get address of ADP. BSBW IOC$RELVMEMAP_DMAN ; Release the mapping registers. BSBW QK_REGISTER ; Read DR11-W registers BSBW QK_DEV_RESET ; Reset controller MOVZWL #SS$_TIMEOUT,R0 ; Assume error status CLRL R1 BBC #UCB$V_CANCEL,- UCB$W_STS(R5),20$ ; Branch if not cancel MOVZWL #SS$_CANCEL,R0 ; Set status 20$: BBC #UCB$V_WAITING_FOR_READ,- UCB$W_DEVSTS(R5),25$ ; Branch if waiting for Read. INCL R1 ; Set R1 to a 1 to indicate Waiting for ; Read. ; Clear unwanted flags. 25$: INSV R1,#16,#16,R0 ; Insert the Time out type. MOVZWL UCB$W_QK_WCRLOW(R5),R1 ; ASHL #16,R1,R1 MOVW UCB$W_QK_CSR(R5),R1 ; Store the CSR and word count low. BICW #,- UCB$W_DEVSTS(R5) ; Clear the read ready flags. BICW #,- UCB$W_STS(R5) ; Clear unit status flags REQCOM ; Complete I/O in exec .DSABL LSB .PAGE .SBTTL QK_INTERRUPT, Interrupt service routine for DR11-W ;++ ; QK_INTERRUPT, Handles interrupts generated by DR11-W ; ; Functional description: ; ; This routine is entered whenever an interrupt is generated ; by the DR11-W. It checks that an interrupt was expected. ; If not, it sets the unexpected (unsolicited) interrupt flag. ; All device registers are read and stored into the UCB. ; If an interrupt was expected, it calls the driver back at its Wait ; For Interrupt point. ; Deliver ATTN AST's if unexpected interrupt. ; ; Inputs: ; ; 00(SP) = Pointer to address of the device IDB ; 04(SP) = saved R0 ; 08(SP) = saved R1 ; 12(SP) = saved R2 ; 16(SP) = saved R3 ; 20(SP) = saved R4 ; 24(SP) = saved R5 ; 28(SP) = saved PSL ; 32(SP) = saved PC ; ; Outputs: ; ; The driver is called at its Wait For Interrupt point if an ; interrupt was expected. ; The current value of the DR11-W CSR's are stored in the UCB. ; ;-- QK_INTERRUPT: ; Interrupt service for DR11-W MOVL @(SP)+,R4 ; Address of IDB and pop SP MOVQ (R4),R4 ; CSR and UCB address from IDB DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Lock device access CONDITION=NOSETIPL,- ; already at DIPL PRESERVE=NO ; Don't preserve R0 ; Check to see if device transfer request active or not ; If so, call driver back at Wait for Interrupt point and ; Clear unexpected interrupt flag. BBCC #UCB$V_INT,UCB$W_STS(R5),24$ ; If clear, no interrupt expected ; Read the DR11-W device registers (WCR, BAR, CSR) and store into UCB. BSBW QK_REGISTER ; Read device registers MOVL UCB$L_FR3(R5),R3 ; Restore drivers R3 JSB @UCB$L_FPC(R5) ; Call driver back BRB 25$ 24$: BSBW QK_REGISTER ; Read device registers INCW UCB$W_QK_UNEXPECTED(R5) ; Increment Unexpected Interrupt count. 25$: DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Unlock device access PRESERVE=NO POPR #^M ; Restore registers REI ; Return from interrupt .PAGE .SBTTL QK_REGISTER - Handle DR11-W CSR transfers ;++ ; QK_REGISTER - Routine to handle DR11-W register transfers ; ; INPUTS: ; ; R4 - DR11-W CSR address ; R5 - UCB address of unit ; ; OUTPUTS: ; ; CSR, WCR, BAR, and status are read and stored into UCB. ; The DR11-W is placed in its initial state with interrupts enabled. ; R0 - .true. if no hard error ; .false. if hard error (cannot clear ATTN) ; ; If the CSR ERROR bit is set and the associated condition can be cleared, then ; the error is transient and recoverable. The status returned is SS$_DRVERR. ; If the CSR ERROR bit is set and cannot be cleared by clearing the CSR, then ; this is a hard error and cannot be recovered. The returned status is ; SS$_CTRLERR. ; ; R0,R1 - destroyed, all other registers preserved. ;-- QK_REGISTER: CLRL R1 READ_CSR QK_STATUS(R4),R1,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC SWAPWORD R1 MOVW R1,UCB$W_QK_CSR(R5) ; Save STATUS reg in UCB MOVW #,R0 SWAPWORD R0 WRITE_CSR R0,QK_CONTROL(R4),#0,- LENGTH=WORD,ENVIRON=SPECIFIC BBC #QK_STATUS$V_ATTF,R1,50$ ; Branch if not ATTN interrupt. BISW #UCB$M_READ_READY,- ; Indicate that the Read is Ready. UCB$W_DEVSTS(R5) 50$: MOVZWL #SS$_NORMAL,R0 ; Assume success BBC #QK_STATUS$V_PERR,R1,55$ ; Branch if no PARITY error MOVZWL #SS$_DRVERR,R0 ; Assume "drive" error BRB 60$ 55$: BBC #QK_STATUS$V_BERR,R1,60$ ; Branch if no VMEbus error. MOVZWL #SS$_CTRLERR,R0 ; Assume "Controller" error. 60$: CLRL R1 READ_CSR QK_BAR_LOW_READ(R4),R1,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC SWAPWORD R1 MOVW R1,UCB$W_QK_BARLOW(R5) CLRL R1 READ_CSR QK_BAR_HIGH_READ(R4),R1,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC SWAPWORD R1 MOVW R1,UCB$W_QK_BARHIGH(R5) READ_CSR QK_WCR_LOW(R4),R1,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC SWAPWORD R1 MOVW R1,UCB$W_QK_WCRLOW(R5) CLRL R1 READ_CSR QK_WCR_HIGH(R4),R1,VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC SWAPWORD R1 MOVW R1,UCB$W_QK_WCRHIGH(R5) MOVW #QK_CONTROL$M_IE,R1 ; Enable interrupts. SWAPWORD R1 WRITE_CSR R1,QK_CONTROL(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC 100$: MOVW R0,UCB$W_QK_ERROR(R5) ; Save error in UCB. RSB .SBTTL QK_CANCEL, Cancel I/O routine ;++ ; QK_CANCEL, Cancels an I/O operation in progress ; ; Functional description: ; ; Flushes Attention AST queue for the user. ; If transfer in progress, do a device reset to DR11-W and finish the ; request. ; Clear interrupt expected flag. ; ; Inputs: ; ; R2 = negated value of channel index ; R3 = address of current IRP ; R4 = address of the PCB requesting the cancel ; R5 = address of the device's UCB ; ; Outputs: ; ;-- QK_CANCEL: ; Cancel I/O DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Lock device access SAVIPL=-(SP),- ; Save current IPL PRESERVE=NO ; Don't preserve R0 ; Check to see if a data transfer request is in progress ; for this process on this channel 20$: BBC #UCB$V_INT,- ; br if I/O not in progress UCB$W_STS(R5),30$ JSB G^IOC$CANCELIO ; Check if transfer going BBC #UCB$V_CANCEL,- UCB$W_STS(R5),30$ ; Branch if not for this guy ; ; Force timeout ; CLRL UCB$L_DUETIM(R5) ; clear timer BISW #UCB$M_TIM,UCB$W_STS(R5) ; set timed BICW #UCB$M_TIMOUT,- UCB$W_STS(R5) ; Clear timed out 30$: DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Unlock device access NEWIPL=(SP)+,- ; Enable interrupts PRESERVE=NO RSB ; Return .PAGE .SBTTL QK_DEV_RESET - Device reset DR11-W ;++ ; QK_DEV_RESET - DR11-W Device reset routine ; ; This routine raises IPL to device IPL, performs a device reset to ; the required controler, and re-enables device interrupts. ; ; Must be called at or below device IPL to prevent a confict in ; aquiring the device_spinlock. ; ; Inputs: ; ; R4 - Address of Control and Status Register ; R5 - Address of UCB ; ; Outputs: ; ; Controller is reset, controller interrupts are enabled ; ;-- QK_DEV_RESET: PUSHR #^M ; Save some registers DEVICELOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Lock device access SAVIPL=-(SP),- ; Save current IPL PRESERVE=NO ; Don't preserve R0 BSBB QK_DEV_HWRESET DEVICEUNLOCK - LOCKADDR=UCB$L_DLCK(R5),- ; Unlock device access NEWIPL=(SP)+,- ; Enable interrupts PRESERVE=NO POPR #^M ; Restore registers RSB QK_DEV_HWRESET: MOVW #QK_CONTROL$M_MCLR,R0 ; Issue a Master Clear to the device. SWAPWORD R0 WRITE_CSR R0,QK_CONTROL(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC ; *** Must delay here depending on reset interval TIMEDWAIT TIME=#QK_RESET_DELAY ; No. of 10 micro-sec intervals to wait MOVW #QK_CONTROL$M_IE,R0 ; Enable device interrupts SWAPWORD R0 WRITE_CSR R0,QK_CONTROL(R4),VME=#0,- LENGTH=WORD,ENVIRON=SPECIFIC RSB QK_END: ; End of driver label .END