.TITLE FIFODRIVER MAGIC ONE's Example Fifo Driver. .SBTTL User WARNING and history. .IDENT 'Version 5.01' ;**************************************************************************** ;***** ***** ;***** NOTE: This driver has NOT been debugged and ***** ;***** is provided strictly on an "as is" basis. ***** ;***** ***** ;***** Use at your own risk!!! ***** ;***** ***** ;**************************************************************************** ;*********************************************************************************** ; ; 12 July 1988 ; Converted driver to VMS V5.0 and added synchronization information ; (IPL and spin locks) to comments. New comments start with ; ; ;; ; ; Where: ; IPL character is one of: ; A = IPL$_ASTDEL ; D = Device IPL ; F = Fork IPL ; X = IPL$_POWER (exclusive ownership of CPU) ; ; SPIN LOCK characters are one of: ; Not specified = no locks held ; D = device spin lock ; F = fork spin lock ; ; If multiple paths through a given section of code have different ; synchronization states then each one is listed in the comment ; separated with a slash (/) character. An example is: ; ; ;DD/DDF; Device IPL and device spin lock also ; device IPL with device and fork spin locks. ; ; ;D; Represents execution at device IPL with no spin ; locks being held. ; ;*********************************************************************************** .PAGE .SBTTL External Data Definitions. .DISABLE GLOBAL ; Define the external system constants. $CANDEF $DCDEF $DEVDEF $DYNDEF $IODEF $IPLDEF $SPLDEF $SSDEF ; Define the external system data structures. $CRBDEF $DDBDEF $IDBDEF $IRPDEF $JIBDEF $PCBDEF $UCBDEF $VECDEF .EXTERNAL SMP$GL_FLAGS ; Define the external system routines. .EXTERNAL COM$POST .EXTERNAL EXE$ABORTIO .EXTERNAL EXE$ALTQUEPKT .EXTERNAL EXE$DEBIT_BYTCNT_ALO .EXTERNAL EXE$QIODRVPKT .EXTERNAL EXE$QIORETURN .EXTERNAL EXE$READCHK .EXTERNAL EXE$WRITECHK .EXTERNAL IOC$MNTVER .EXTERNAL IOC$REQCOM .EXTERNAL IOC$RETURN .PAGE .SBTTL Define The Device Hardware. ; Define the register offsets. $DEFINI DEV_ $DEF DEV_W_CSR .BLKW 1 ; Control and status register. $DEF DEV_W_DATA .BLKW 1 ; Data input / output register. $DEFEND DEV_ ; Define the control and status register bits. _VIELD CSR, 6, < - < IE, , M >, - ; Interrupt enable bit. < DA, , M > - ; Data available bit. > ; Define the device IPL. BR_LEVEL == 7 DEV_IPL == BR_LEVEL + 15 ; Define the maximum fifo segment length. ; One segment with header, surrounded by ACKs. FIFO_LENGTH == 64 MAX_SEG_LEN == FIFO_LENGTH - 1 - 1 - 1 ; Header, ACK, ACK. ; Define the maximum message length. (Note: This is a software limit.) MAX_MSG_LEN == 1024 ; Define the protocol words. ACK == 0 ; Header / data segment acknowledgment. ; Define the parameter offsets. P1 == 0 P2 == P1 + 4 P3 == P2 + 4 P4 == P3 + 4 P5 == P4 + 4 P6 == P5 + 4 .PAGE .SBTTL Define the UCB Extensions. $DEFINI UCB . = UCB$K_LENGTH ; Position at end of UCB. ; Define the device specific extensions. $DEF UCB_L_CSR .BLKL 1 ; CSR address. Copy of IDB$L_CSR. $DEF UCB_L_MAX_SEG_LEN .BLKL 1 ; Maximum segment length. ; Define the transmit state machine extensions. $DEF UCB_L_TX_STATE .BLKL 1 ; Transmit state machine return address. $DEF UCB_L_TX_IRP .BLKL 1 ; Transmit output request packet. $DEF UCB_L_TRANS_BUF .BLKL 1 ; Transmit buffer address. $DEF UCB_L_TRANS_LEN .BLKL 1 ; Total length of buffer in words. $DEF UCB_L_TX_LEN .BLKL 1 ; Number of words in this segment. ; Define the receive state machine extensions. $DEF UCB_L_RX_STATE .BLKL 1 ; Receive state machine return address. $DEF UCB_L_RX_IRP .BLKL 1 ; Receive input request packet. $DEF UCB_Q_RX_IRPS .BLKQ 1 ; Receive machine input request packets. $DEF UCB_L_RX_BUF .BLKL 1 ; Receive buffer address. $DEF UCB_L_RX_FLAGS .BLKL 1 ; Receive state machine flags. _VIELD RXF, 0, < - < WAIT_FOR_BUF, , M >, - ; Waiting for a receive buffer. < INITIALIZED, , M > - ; UCB initialized. > $DEF UCB_W_RX_LEN .BLKW 1 ; Receive buffer length. ; Define the length of the required UCB. $DEF UCB_C_SIZE $DEFEND UCB .PAGE .SBTTL Driver Prologue Table. DPTAB - END=FIFO_END, - ; End of driver label. ADAPTER=UBA, - ; UNIBUS or Q22 bus device. UCBSIZE=, - ; Length of UCB. MAXUNITS=1, - ; Only one unit per controller. DEFUNITS=1, - ; Default to only one unit. NAME=FIFODRIVER ; Driver name. DPT_STORE INIT ; One time initialization (constants). DPT_STORE UCB,UCB$B_FLCK, B, SPL$C_IOLOCK8 ; Device fork IPL. DPT_STORE UCB, UCB$B_DIPL, B, DEV_IPL ; Device interrupt IPL. DPT_STORE UCB, UCB$L_DEVCHAR, L, < - ; Device characteristics. DEV$M_IDV ! - ; input device. DEV$M_ODV ! - ; output device. DEV$M_RTM ! - ; real time device. DEV$M_NET ! - ; network device. DEV$M_AVL > ; device is available. DPT_STORE UCB,UCB$B_DEVCLASS,B,DC$_SCOM ; Synchronous communications device. DPT_STORE UCB, UCB$W_DEVBUFSIZ, W, - ; Maximum message size. MAX_MSG_LEN DPT_STORE UCB, UCB_L_MAX_SEG_LEN, L, - ; Maximum segment length. MAX_SEG_LEN DPT_STORE REINIT ; Driver reload initialization ; (data structure pointers). DPT_STORE DDB, DDB$L_DDT, D, FIFO$DDT ; DDT address. DPT_STORE CRB, CRB$L_INTD+VEC$L_ISR, D, - ; ISR address. FIFO_INTERRUPT ;D; DPT_STORE CRB, - ; Controller init routine address. CRB$L_INTD+VEC$L_INITIAL, - D, FIFO_INIT ;X; DPT_STORE END ; End of initialization tables. .PAGE .SBTTL Driver Dispatch Table & FDTs. ; ; Driver dispatch table. ; DDTAB - ; DDT-creation macro. DEVNAM=FIFO, - ; Name of device. START=START_TRANSMIT, - ;FF; Transmit machine entry point. ALTSTART=START_RECEIVE, - ;FF; Receive machine entry point. CANCEL=FIFO_CANCEL, - ;FF; Cancel routine entry point. FUNCTB=FIFO_FUNCTABLE ; FDT address. ; ; Function decision tables. ; FIFO_FUNCTABLE:: ; FDT for driver. FUNCTAB , < - ; Valid I/O functions. READVBLK, - ; Read virtual READLBLK, - ; Read logical READPBLK, - ; Read physical WRITEVBLK, - ; Write virtual WRITELBLK, - ; Write logical WRITEPBLK - ; Write physical > FUNCTAB , < - ; Buffered I/O functions. READVBLK, - ; Read virtual READLBLK, - ; Read logical READPBLK, - ; Read physical WRITEVBLK, - ; Write virtual WRITELBLK, - ; Write logical WRITEPBLK - ; Write physical > FUNCTAB RX_FDT, < - ;A; Receive FDT routine. READVBLK, - READLBLK, - READPBLK - > FUNCTAB TX_FDT, < - ;A; Transmit FDT routine. WRITEVBLK, - WRITELBLK, - WRITEPBLK - > .PAGE .SBTTL FIFO Initialization Routine. .ENABLE LOCAL_BLOCK .SHOW MEB ;;;; Inputs: ;;;; R4 - CSR address. ;;;; R5 - IDB address. ;;;; R6 - DDB address. ;;;; R7 - CRB address. ;;;; IPL - IPL$_POWER FIFO_INIT:: ;X; MOVL IDB$L_UCBLST(R5), R0 ;X; Get the UCB address. MOVL R0, IDB$L_OWNER(R5) ;X; This UCB always owns controller. MOVL R4, UCB_L_CSR(R4) ;X; Set the CSR value. BBSSI # RXF_V_INITIALIZED, - ;X; Driver already loaded, don't UCB_L_RX_FLAGS(R0), 10$ ;X; initialize the RX queue - branch. MOVAQ UCB_Q_RX_IRPS(R0), R1 ;X; Get the receive queue address. MOVAQ (R1), (R1) ;X; Initialize the receive queue. MOVAQ (R1), 4(R1) ;X; MOVAB RECEIVE_MACHINE, UCB_L_RX_STATE(R0) ;X; Init receive machine. 10$: ;X; MOVW #CSR_M_IE, DEV_W_CSR(R4) ;X; Start the receive machine. RSB ;X; .DISABLE LOCAL_BLOCK .PAGE .SBTTL FDT Routines. .ENABLE LOCAL_BLOCK ; Inputs: ; R0 - Address of the FDT routine being called. ; R3 - Address of the IRP for the current I/O request. ; R4 - Address of the PCB of the current process. ; R5 - Address of the UCB. ; R6 - Address of the CCB. ; R7 - Function code. ; R8 - Address of the current entry in the FDT. ; AP - Address of the first function dependent parameter. ; IPL - IPL$_ASTDEL (no locks held). ; ; Available registers: ; R0 - R2, R9 - R11 ; ; Register Useage: ; R0 - Temporary. ; R1 - Transfer length. ; R2 - Buffer address. TX_FDT:: ;A; MOVL P2(AP), R1 ;A; Get the transfer count. BEQL 10$ ;A; Must transfer something - branch BBS #0, R1, 10$ ;A; Transfer count must be even. MOVZWL UCB$W_DEVBUFSIZ, R0 ;A; Get the maximum transfer count. CMPL R1, R0 ;A; Check for too long a transfer. BGTRU 10$ ;A; Too long - branch. MOVL P1(AP), R0 ;A; Get the user buffer address. JSB G^ EXE$WRITECHK ;A; Check for read access to buffer. BRB 30$ ;A; Enter common initialization. 10$: ;A; MOVZWL #SS$_IVBUFLEN, R0 ;A; Set invalid buffer length error. 20$: ;A; JMP G^ EXE$ABORTIO ;A; Abort this I/O request. RX_FDT:: ;A; MOVL P2(AP), R1 ;A; Get the transfer count. MOVZWL UCB$W_DEVBUFSIZ, R0 ;A; Get the maximum transfer count. CMPL R1, R0 ;A; Correct receive buffer length? BNEQ 10$ ;A; No, must be max msg size-branch. MOVL P1(AP), R0 ;A; Get the user's buffer address. JSB G^ EXE$READCHK ;A; Check for write access to buffer .PAGE .SBTTL Common FDT routine. ; Buffer length is valid, check for correct quota to continue. 30$: ;A; MOVW #SS$_NORMAL, IRP$L_IOST1(R3) ;A; Set the default final status. MOVW R1, IRP$L_IOST1+2(R3) ;A; Entire buffer sent / received. MOVL R2, IRP$L_IOST2(R3) ;A; 0 = Write, 1 = Read. ADDL #12, R1 ;A; Account for the buffer header. PUSHR # ^M < R1, R3 > ;A; Save IRP addr & transfer count. JSB G^ EXE$DEBIT_BYTCNT_ALO ;A; Check quota and allocate buffer. POPR # ^M < R1, R3 > ;A; Restore IRP addr & transfer cnt. BLBC R0, 20$ ;A; Quota/allocation failure-branch. ; Save the system buffer characteristics. MOVL R2, IRP$L_SVAPTE(R3) ;A; Set the system buffer address. MOVW R1, IRP$W_BOFF(R3) ;A; Set the system buffer length. ; Build the buffer header. MOVAB 12(R2), (R2) ;A; Pointer to data area in buffer. MOVL P1(AP), 4(R2) ;A; User's buffer address. ; Copy the user's buffer for write functions. BLBS IRP$L_IOST2(R3), 40$ ;A; Read function - branch. PUSHR # ^M < R0, R1, R2, R3, R4, R5 > ;A; MOVC3 IRP$L_BCNT(R3), @P1(AP), 12(R2) ;A; Save the user's buffer contents. PUSHR # ^M < R0, R1, R2, R3, R4, R5 > ;A; ; Start the process the I/O request. JMP G^ EXE$QIODRVPKT ;A; Start transmit request. 40$: ;A; JSB G^ EXE$ALTQUEPKT ;A; Start receive request. JMP G^ EXE$QIORETURN ;A; Exit to QIO. .DISABLE LOCAL_BLOCK .PAGE .SBTTL Interrupt Dispatcher. .ENABLE LOCAL_BLOCK ;;; Inputs: ;;; 0(SP) = Address of address of the IDB. ;;; 4(SP) = R0 before the interrupt. ;;; 8(SP) = R1 before the interrupt. ;;; C(SP) = R2 before the interrupt. ;;; 10(SP) = R3 before the interrupt. ;;; 14(SP) = R4 before the interrupt. ;;; 18(SP) = R5 before the interrupt. ;;; 1C(SP) = PSL before the interrupt. ;;; 20(SP) = PC before the interrupt. ;;; IPL = Device IPL (no locks held). FIFO_INTERRUPT:: ;D; MOVL @(SP)+,R4 ;D; Get the IDB address. DEVICELOCK - ;D; Synchronize with the device. LOCKADDR=IDB$L_SPL(R4), - ;D; CONDITION=NOSETIPL, - ;D; PRESERVE=NO ;D; ASSUME IDB$L_OWNER EQ < IDB$L_CSR + 4 > MOVQ IDB$L_CSR(R4), R4 ;DD; Get the CSR and UCB addresses. ;;; Get the next state control word. 10$: ;DD; MOVZWL DEV_W_DATA(R4), R0 ;DD; Get the state control word. BEQL 20$ ;DD; ACK, enter TX machine - branch. ;;; Process the segment / message length. MOVL UCB_L_RX_IRP(R5), R3 ;DD; Get the receive IRP address. JSB @UCB_L_RX_STATE(R5) ;DD; Enter the RX state machine. BRB 30$ ;DD; ;;; Process the ACK. 20$: ;DD; MOVL UCB_L_TX_IRP(R5), R3 ;DD; Get the transmit IRP address. JSB @UCB_L_TX_STATE(R5) ;DD; Enter the TX state machine. 30$: ;DD; BICW3 # ^C CSR_M_DA, DEV_W_CSR(R4), R0 ;DD; More data? BNEQ 10$ ;DD; Yes, another transaction - branch. ;;; Exit the driver. DEVICEUNLOCK - ;DD; Release the device synchronization. CONDITION=RESTORE, - ;DD; PRESERVE=NO ;DD; POPR #^M ;D; Restore R0-R5 REI ;D; .PAGE .SBTTL Receive State Machine. .ENABLE LOCAL_BLOCK ;; Receiver alternate start I/O entry point. ;; ;; Inputs: ;; R3 - IRP address. ;; R5 - UCB address. ;; IPL - Fork IPL (Fork lock held). START_RECEIVE:: ;FF; DEVICELOCK - ;FF; Buffer needed, save IPL and LOCKIPL=UCB$B_DIPL(R5), - ;FF; synchronize with other device SAVIPL=-(SP), - ;FF; operations. PRESERVE=NO ;FF; INSQUE (R3), @UCB_Q_RX_IRPS+4(R5) ;DDF; Save the IRP. BNEQ 10$ ;DDF; Not first entry - branch. BBCCI #RXF_V_WAIT_FOR_BUF, UCB_L_RX_FLAGS(R5), 10$ ;DDF; Buffer needed? MOVL R3, UCB_L_RX_IRP(R5) ;DDF; Get the receive IRP address. JSB @UCB_L_RX_STATE(R5) ;DDF; Enter the RX state machine. 10$: ;DDF; DEVICEUNLOCK - ;DDF; Release device synchronization NEWIPL=(SP)+, - ;DDF; Restore previous IPL. CONDITION=RESTORE, - ;DDF; PRESERVE=NO ;DDF; RSB ;FF; ;;;***** ;;; ;;; The real interrupt driven state machine. ;;; ;;;***** RECEIVE_MACHINE:: ;DD; ;;; ;;; Receive State 1. ;;; MOVW R0, UCB_W_RX_LEN(R5) ;DD; Save the receive length. ;;; ;;; Receive State 2. ;;; 20$: ;DD/DDF; REMQUE @UCB_Q_RX_IRPS(R5), R3 ;DD/DDF; Check for a buffer (IRP). BVC 30$ ;DD/DDF; Buffer available - branch. BBSSI #RXF_V_WAIT_FOR_BUF, - ;DD; Tell RX start about delay. UCB_L_RX_FLAGS(R5), 25$ ;DD; 25$: ;DD/DDF; BSBB SAVE_RX_STATE ;DD/DDF; Wait for the buffer. BRB 20$ ;DD/DDF; 30$: ;DD/DDF; MOVL @IRP$L_SVAPTE(R3), UCB_L_RX_BUF(R5) ;DD/DDF; Save buffer address ADDW3 UCB_W_RX_LEN(R5), UCB_W_RX_LEN(R5), - ;DD/DDF; Set received length IRP$L_IOST1+2(R3) ;DD/DDF; in bytes. ;;; ;;; Receive State 3. ;;; MOVW #ACK, DEV_W_DATA(R4) ;DD/DDF; Ready to receive, ACK msg header. 40$: ;DD/DDF; BSBB SAVE_RX_STATE ;DD/DDF; Wait for next segment. ;;; ;;; Receive State 4. ;;; SUBW R0, UCB_W_RX_LEN(R5) ;DD; Account for this segment. MOVL UCB_L_RX_BUF(R5), R1 ;DD; Get the buffer address. 50$: ;DD; BICW #^C CSR_M_DA, DEV_W_CSR(R4) ;DD; Check for another data word. BEQL 50$ ;DD; No, not yet, wait for it - branch. MOVW DEV_W_DATA(R4), (R1)+ ;DD; Save this word. SOBGTR R0, 50$ ;DD; Receive the entire segment. MOVL R1, UCB_L_RX_BUF(R5) ;DD; Save the new buffer address. ;;; ;;; Receive State 5. ;;; MOVW #ACK, DEV_W_DATA(R4) ;DD; Acknowledge this segment. TSTW UCB_W_RX_LEN(R5) ;DD; Done with last message? BNEQ 40$ ;DD; No, receive next seg - branch. JSB G^ COM$POST ;DD; Complete this request. BSBB SAVE_RX_STATE ;DD; Wait for another request. BRB RECEIVE_MACHINE ;DD; Yes, receive the next message. .DISABLE LOCAL_BLOCK .PAGE .SBTTL Exit Receive State Machine Subroutine. .ENABLE LOCAL_BLOCK SAVE_RX_STATE:: ;DD/DDF; MOVL R3, UCB_L_RX_IRP(R5) ;DD/DDF; Save the IRP address. MOVL (SP)+, UCB_L_RX_STATE(R5) ;DD/DDF; Save state machine return RSB ;DD/DDF; address. .DISABLE LOCAL_BLOCK .PAGE .SBTTL Transmit State Machine. .ENABLE LOCAL_BLOCK ;; Inputs: ;; R3 - IRP address. ;; R5 - UCB address. ;; IPL - Fork IPL (Fork lock held). START_TRANSMIT:: ;FF; ;; ;; Transmit State 1. ;; MOVL @IRP$L_SVAPTE(R3), UCB_L_TRANS_BUF(R5) ;FF; Get the buffer address. ASHL #-1, IRP$L_BCNT(R3), UCB_L_TRANS_LEN(R5) ;FF; Set word count. MOVL UCB_L_CSR(R5), R4 ;FF; Get the CSR. DEVICELOCK - ;FF; Sync with other device LOCKIPL=UCB$B_DIPL(R5), - ;FF; operations. SAVIPL=-(SP), - ;FF; PRESERVE=NO ;FF; PUSHAB 40$ ;DDF; Set the return address ;;; ;;; Transmit state 2. ;;; MOVW UCB_L_TRANS_LEN(R5), DEV_W_DATA(R4) ;DDF; Send message header. ;;; ;;; Transmit state 3. ;;; BSBW SAVE_TX_STATE ;DDF; Wait for the header ACK. ;;; ;;; Transmit state 4. ;;; 10$: ;DD; MOVL UCB_L_TRANS_LEN(R5), R0 ;DD; Get the next segment length. CMPL R0, UCB_L_MAX_SEG_LEN(R5) ;DD; Check for too long. BLEQU 20$ ;DD; Not too long - branch. MOVL UCB_L_MAX_SEG_LEN(R5), R0 ;DD; Use maximum segment length. 20$: ;DD; MOVL R0, UCB_L_TX_LEN(R5) ;DD; Save segment length. MOVL UCB_L_TRANS_BUF(R5), R1 ;DD; Get the buffer address. ADDL3 R0, R1, UCB_L_TRANS_BUF(R5) ;DD; Set the next buffer address. MOVW R0, DEV_W_DATA(R4) ;DD; Send the segment header. 30$: ;DD; MOVW (R1)+, DEV_W_DATA(R4) ;DD; Send the segment data. SOBGTR R0, 30$ ;DD; Send it all. ;;; ;;; Transmit state 5. ;;; BSBW SAVE_TX_STATE ;DD; Wait for segment ACK. SUBL UCB_L_TX_LEN(R5), UCB_L_TRANS_LEN(R5) ;DD; Set next segment length BGTR 10$ ;DD; Another segment-branch. ASSUME IRP$L_IOST2 EQ < IRP$L_IOST1 + 4 > MOVQ IRP$L_IOST1(R3), R0 ;DD; Get completion status. MOVL R3, UCB$L_IRP(R5) ;DD; Set the IPR address. JMP G^ IOC$REQCOM ;DD; Complete this request. 40$: ;DDF; DEVICEUNLOCK - ;DDF; Release device synchronization NEWIPL=(SP)+, - ;DDF; CONDITION=RESTORE, - ;DDF; PRESERVE=NO ;DDF; RSB ;FF; .DISABLE LOCAL_BLOCK .PAGE .SBTTL Exit Transmit State Machine Subroutine. .ENABLE LOCAL_BLOCK SAVE_TX_STATE:: ;DD/DDF; MOVL R3, UCB_L_TX_IRP(R5) ;DD/DDF; Save the IRP address. MOVL (SP)+, UCB_L_TX_STATE(R5) ;DD/DDF; Save state machine return RSB ;DD/DDF; address. .DISABLE LOCAL_BLOCK .PAGE .SBTTL FIFO Cancel Routine. .ENABLE LOCAL_BLOCK ;; Inputs: ;; R2 - Channel index number. ;; R3 - IRP address. ;; R4 - PCB address. ;; R5 - UCB address. ;; R8 - Reason for cancel ;; CAN$C_CANCEL - called by $CANCEL or $DALLOC. ;; CAN$C_DASSGN - called by $DASSGN. ;; IPL - Fork IPL (Fork lock held). ;; ;; Available Registers: ;; R0 - R3 FIFO_CANCEL:: ;FF; DEVICELOCK - ;FF; Sync with other device LOCKIPL=UCB$B_DIPL(R5), - ;FF; operations. SAVIPL=-(SP), - ;FF; PRESERVE=NO ;FF; MOVAQ UCB_Q_RX_IRPS(R5), R1 ;DDF; Get the IRP queue head address MOVL (R1), R0 ;DDF; Get the first queue entry. 10$: ;DDF; CMPL R0, R1 ;DDF; Check for last request. BEQL 40$ ;DDF; Yes - branch. ;;; Only cancel requests on this channel. PUSHL R1 ;DDF; Save the queue header address. MOVL (R0), -(SP) ;DDF; Get the next request address. CMPL PCB$L_PID(R4), IRP$L_PID(R0) ;DDF; Check for the correct process. BNEQ 30$ ;DDF; No - branch. CMPW R2, IRP$W_CHAN(R0) ;DDF; Check for the correct channel. BNEQ 30$ ;DDF; No - branch. ;;; Cancel this I/O request. BBCC #IRP$V_FUNC, IRP$W_STS(R0), 20$ ;DDF; Don't transfer any data. 20$: ;DDF; MOVQ R2, -(SP) ;DDF; Save the channel number & IRP. MOVL R0, R3 ;DDF; Set the IPR address. MOVZWL # SS$_CANCEL, IRP$L_IOST1(R3) ;DDF; Cancel this request. CLRL IRP$L_IOST2(R3) ;DDF; JSB G^ COM$POST ;DDF; Complete this request. MOVQ (SP)+, R2 ;DDF; Get channel # & IRP address. 30$: ;DDF; MOVQ (SP)+, R0 ;DDF; Get next IRP & header address. BRB 10$ ;DDF; Cancel it if necessary-branch. ;;; All requests have been canceled. 40$: ;DDF; DEVICEUNLOCK - ;DDF; Release device synchronization NEWIPL=(SP)+, - ;DDF; CONDITION=RESTORE, - ;DDF; PRESERVE=NO ;DDF; RSB ;FF; .DISABLE LOCAL_BLOCK .PAGE .SBTTL End Of The Driver. FIFO_END:: ; Last location in driver .END