!<BLF/REQUIRE 'PRETTY'>
%TITLE 'SSDRIVER - VAX/VMS SSP Device Driver'
MODULE ssdriver (IDENT = 'V04-01'		! File: SSDRIVER.BLI
		) =
BEGIN

!++
!
! FACILITY:	VAX/VMS Executive, device drivers
!
! ABSTRACT:
!		This module implements a VAX/VMS device driver that is
!		used to control a signal processing device via a DR11-C
!		interface.
!
! ENVIRONMENT:	VAX/VMS, kernel mode, elevated IPL, interrupt stack
!
! AUTHOR:	Michael S. Jordan
!
! CREATED:	10 April 1983
!
! MODIFIED BY:
!
!	V01.0	Michael S. Jordan, 10 April 1983
!		Original.
!
!	V04-01	Michael S. Jordan, 5 January 1987
!		Revised version that is V4.x compatible with extra
!		commentary.
!
!--


%SBTTL 'Declarations'

!+
! SWITCHES:
!-

SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE);

!+
! LINKAGE/GLOBAL REGISTERS:
!-

!	None.

!+
! LINKAGES:
!-

LINKAGE
    alonon_linkage = JSB (REGISTER = 1; REGISTER = 1, REGISTER = 2) : NOPRESERVE (3),
    bufquo_linkage = JSB (REGISTER = 1, REGISTER = 4) : NOPRESERVE (2, 3),
    cancel_linkage = JSB (REGISTER = 3, REGISTER = 4, REGISTER = 5, REGISTER = 8),
    deanon_linkage = JSB (REGISTER = 0) : NOPRESERVE (2, 3),
    fdt_linkage = JSB (REGISTER = 3, REGISTER = 4, REGISTER = 5) : NOPRESERVE (1, 2, 7, 8, 9, 10, 11),
    finishio_linkage = JSB (REGISTER = 0, REGISTER = 3, REGISTER = 5),
    forkprc_linkage = JSB (REGISTER = 4, REGISTER = 5) : NOPRESERVE (0, 1, 2, 3, 4, 5),
    init_linkage = JSB (REGISTER = 4, REGISTER = 5),
    qast_linkage = JSB (REGISTER = 2, REGISTER = 5) : NOPRESERVE (1, 3, 4),
    queue_packet_linkage = JSB (REGISTER = 3, REGISTER = 5),
    readchk_linkage = JSB (REGISTER = 0, REGISTER = 1, REGISTER = 3) : NOPRESERVE (2),
    start_linkage = JSB (REGISTER = 3, REGISTER = 5);

!+
! TABLE OF CONTENTS:
!-

FORWARD ROUTINE
    ss_cancel : 				! Cancel I/O routine
	NOVALUE cancel_linkage,
    ss_error_enable : 				! Error interrupt enable FDT routine
	NOVALUE fdt_linkage,
    ss_error_interrupt : 			! Error handling fork process
	NOVALUE forkprc_linkage,
    ss_read_registers : 			! Register read FDT routine
	NOVALUE fdt_linkage,
    ss_unit_init : 				! Unit initialization routine
	NOVALUE init_linkage,
    ss_write_registers : 			! Register write FDT routine
	NOVALUE fdt_linkage;

!+
! INCLUDE FILES:
!-

LIBRARY 'SYS$LIBRARY:LIB';			! System symbol definitions.

LIBRARY 'DIR_UTILITY:LIBEXT';			!

REQUIRE 'DR11CDEF.B32';				! DR11-C register definitions.

REQUIRE 'SSDEF.B32';				! SSDRIVER data structure definitions.

!+
! MACROS:
!-

!	None

!+
! FIELDS:
!-

!	None

!+
! STRUCTURES:
!-

!	None

!+
! PSECTS:
!-

PSECT
    PLIT = $$$115_driver (NOPIC, READ, WRITE, LOCAL, NOSHARE, EXECUTE, CONCATENATE, ALIGN (2)),
    CODE = $$$115_driver (NOPIC, READ, WRITE, LOCAL, NOSHARE, EXECUTE, CONCATENATE, ALIGN (2)),
    OWN = $$$115_driver (NOPIC, READ, WRITE, LOCAL, NOSHARE, EXECUTE, CONCATENATE, ALIGN (2)),
    GLOBAL = $$$115_driver (NOPIC, READ, WRITE, LOCAL, NOSHARE, EXECUTE, CONCATENATE, ALIGN (2));

!+
! EQUATED SYMBOLS:
!-

LITERAL
    k_bit_high_limit = 128,			! Number of iterations to spin on CSR bits
    k_delay_count = 8,				! Number of iterations to delay by before looping on REQA
    k_error_address = 0,			! SPP error status register address
    k_false = 0,				! Logical false
    k_true = 1;					! Logical true

!+
! OWN (R/O) STORAGE:
!-

!	None.

!+
! OWN (R/W) STORAGE:
!-

!	None

!+
! BUILTIN DECLARATIONS:
!-

!	None.

!+
! EXTERNAL ROUTINES:
!-

EXTERNAL ROUTINE
    exe$allocbuf : 				! Allocate system buffer
	alonon_linkage,
    exe$alononpaged : 				! Allocate nonpaged pool
	alonon_linkage,
    exe$buffrquota : 				! Check buffered I/O quota
	bufquo_linkage,
    exe$deanonpaged : 				! Deallocate nonpaged pool
	NOVALUE deanon_linkage,
    exe$finishioc : 				! Complete I/O request in FDT context
	NOVALUE finishio_linkage,
    exe$readchkr : 				! Check for write access to user buffer
	readchk_linkage,
    exe$writechkr : 				! Check for read access to user buffer
	readchk_linkage,
    sch$qast : 					! Queue AST to process
	qast_linkage;

!+
! EXTERNAL REFERENCES:
!-

!	None.

%SBTTL 'SS_CANCEL - Cancel I/O routine'

GLOBAL ROUTINE ss_cancel (			!
    r_irp : REF BLOCK [, BYTE], 		!
    r_pcb : REF BLOCK [, BYTE], 		!
    r_ucb : REF BLOCK [, BYTE], 		!
    l_reason					!
    ) : NOVALUE cancel_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called by either EXE$DASSGN or EXE$CANCEL for
!	the purpose of either canceling I/O or performing channel rundown.
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!	r_irp --> address of IRP that is currently being processed if the
!		  device is busy
!
!	r_pcb --> address of current process' PCB
!
!	r_ucb --> address of the UCB associated with the unit being cancelled
!
!	l_reason - a code indicating which context the routine is being
!		   called in (CAN$C_CANCEL or CAN$C_DASSGN)
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	Idles device.
!
!--

    BEGIN

    BIND
	r_crb = 				!
	    .r_ucb [ucb$l_crb] : BLOCK [, BYTE],
	r_vec = 				!
	    r_crb [crb$l_intd] : BLOCK [, BYTE],
	r_idb = 				!
	    .r_vec [vec$l_idb] : BLOCK [, BYTE],
	r_dr11c_registers = 			!
	    .r_idb [idb$l_csr] : BLOCK [, BYTE] VOLATILE,
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE;

    !+
    !	Disable error interrupts by clearing the CSR.
    !-

    w_csr = 0;
    r_ucb [ssucb_v_error_enabled] = k_false;
    r_ucb [ucb$v_int] = k_false;
    END;					! End of routine SS_CANCEL


%SBTTL 'SS_ERROR_ENABLE - Enable error interrupts from device'

GLOBAL ROUTINE ss_error_enable (		!
    r_irp : REF BLOCK [, BYTE], 		!
    r_pcb : REF BLOCK [, BYTE], 		!
    r_ucb : REF BLOCK [, BYTE], 		!
    r_ccb : REF BLOCK [, BYTE]			!
    ) : NOVALUE fdt_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This FDT is routine is called when the user makes a request to
!	enable error inteerupts from the device (IO$_SETMODE).
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!   	r_irp --> address of I/O Request Packet
!   	r_pcb --> address of Process Control Block
!   	r_ucb --> address of Unit Control Block
!   	r_ccb --> address of Channel Control Block
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	Will cause I/O request to complete.
!
!--

    BEGIN

    BUILTIN
	AP;

    MAP
	AP : 					! QIO parameters P1 - P8.
	    REF VECTOR [, LONG];

    BIND
	l_p2 = 					! P2 = ast_address.
	    AP [1],
	r_crb = 				!
	    .r_ucb [ucb$l_crb] : BLOCK [, BYTE],
	r_vec = 				!
	    r_crb [crb$l_intd] : BLOCK [, BYTE],
	r_idb = 				!
	    .r_vec [vec$l_idb] : BLOCK [, BYTE],
	r_dr11c_registers = 			!
	    .r_idb [idb$l_csr] : BLOCK [, BYTE] VOLATILE,
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE;

    LOCAL
	l_csr_image : 				!
	    BLOCK [1, LONG];

    !+
    ! Check to see if error interrupts are already enabled.
    !-

    IF .r_ucb [ssucb_v_error_enabled]
    THEN
	exe$finishioc (ss$_normal, r_irp [0, 0, 0, 0], r_ucb [0, 0, 0, 0])
    ELSE
	BEGIN

	!+
	! Copy AST delivery parameters to the UCB.
	!-

	r_ucb [ssucb_a_error_ast_address] = .l_p2;
	r_ucb [ssucb_b_error_ast_rmod] = .r_irp [irp$b_rmod];

	!+
	! Raise IPL to device.
	!-

	_setipl (ipl = r_ucb [ucb$b_dipl]);

	!+
	! Read current CSR.
	!-

	l_csr_image = .w_csr;

	!+
	! Enable error interrupts.
	!-

	l_csr_image [dr11c_csr_v_ie_b] = k_true;
	w_csr = .l_csr_image;

	!+
	! Indicate interrupts enabled.
	!-

	r_ucb [ssucb_v_error_enabled] = k_true;
	r_ucb [ucb$v_int] = k_true;

	!+
	! Complete request.
	!-

	exe$finishioc (ss$_normal, r_irp [0, 0, 0, 0], r_ucb [0, 0, 0, 0]);
	END;

    END;					! End of routine SS_ERROR_ENABLE


%SBTTL 'SS_ERROR_INTERRUPT - Device error interrupt service routine'

GLOBAL ROUTINE ss_error_interrupt (		!
    r_dr11c_registers : REF BLOCK [, BYTE]VOLATILE, 	!
    r_ucb : REF BLOCK [, BYTE]			!
    ) : NOVALUE forkprc_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called at device IPL as a result of an error
!	interrupt from the device.  The error status register is read
!	and passed to the owning process as the AST parameter on an
!	AST that gets queued herein.
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!	r_dr11c_registers --> address of device registers
!	r_ucb --> address of the Unit Control Block
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	An AST is queued to the associated process with the AST
!	parameter being the value read from the error status register.
!
!--

    BEGIN

    BIND
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE,
	w_output_buffer = 			!
	    r_dr11c_registers [dr11c_w_outbuf] : WORD VOLATILE,
	w_input_buffer = 			!
	    r_dr11c_registers [dr11c_w_inbuf] : WORD VOLATILE;

    LOCAL
	r_acb : 				!
	    REF BLOCK [, BYTE],
	l_csr_image : 				!
	    BLOCK [1, LONG],
	l_size;					!

    !+
    ! Now executing at fork IPL, which is assumed to be IPL$_QUEUEAST.
    !-

    IF exe$alononpaged (acb$k_length; l_size, r_acb)
    THEN
	BEGIN

	!+
	! Initialize fields in the AST control block.
	!-

	r_acb [acb$w_size] = .l_size;
	r_acb [acb$b_type] = dyn$c_acb;
	r_acb [acb$l_pid] = .r_ucb [ucb$l_pid];
	r_acb [acb$b_rmod] = .r_ucb [ssucb_b_error_ast_rmod];
	r_acb [acb$l_ast] = .r_ucb [ssucb_a_error_ast_address];

	!+
	! Raise IPL to device and read device registers.
	!-

	_setipl (ipl = r_ucb [ucb$b_dipl]);

	!+
	! Load error status register address into output data buffer register.
	!-

	w_output_buffer = k_error_address;

	!+
	! Toggle CSR0 to initiate read from the error status address.
	!-

	l_csr_image = .w_csr;
	l_csr_image [dr11c_csr_v_csr0] = k_true;
	w_csr = .l_csr_image;

	!+
	! Wait for request A to go high.
	!-

	IF NOT (INCRU i TO k_bit_high_limit DO
		BEGIN
		l_csr_image = .w_csr;

		IF .l_csr_image [dr11c_csr_v_req_a] THEN EXITLOOP k_false;

		END
	    )
	THEN
	    BEGIN

	    !+
	    ! Read error status from the input data buffer register and place it
	    ! into the AST parameter field of the ACB.
	    !-

	    r_acb [acb$l_astprm] = .w_input_buffer;

	    !+
	    ! Queue AST to process.
	    !-

	    sch$qast (pri$_ticom, r_acb [0, 0, 0, 0]);
	    END
	ELSE

	!+
	! Failed to read status from SSP.  Deallocate ACB.
	!-

	    exe$deanonpaged (r_acb [0, 0, 0, 0]);

	END;

    !+
    ! Making sure that IPL is at device, reenable error interrupts.
    !-

    _setipl (ipl = r_ucb [ucb$b_dipl]);
    l_csr_image = .w_csr;
    l_csr_image [dr11c_csr_v_ie_b] = k_true;
    w_csr = .l_csr_image;

    !+
    ! Lower IPL to fork and return to fork dispatcher.
    !-

    _setipl (ipl = r_ucb [ucb$b_fipl]);
    END;					! End of routine SS_ERROR_INTERRUPT


%SBTTL 'SS_READ_REGISTERS - Register read FDT routine'

GLOBAL ROUTINE ss_read_registers (		!
    r_irp : REF BLOCK [, BYTE], 		!
    r_pcb : REF BLOCK [, BYTE], 		!
    r_ucb : REF BLOCK [, BYTE], 		!
    r_ccb : REF BLOCK [, BYTE]			!
    ) : NOVALUE fdt_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This FDT routine is called to process a user request to read
!	the internal registers of the signal processing device (IO$_READxBLK).
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!   	r_irp --> address of I/O Request Packet
!   	r_pcb --> address of Process Control Block
!   	r_ucb --> address of Unit Control Block
!   	r_ccb --> address of Channel Control Block
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	I/O request is completed.
!
!--

    BEGIN

    BUILTIN
	AP;

    MAP
	AP : 					! QIO parameters P1 - P8.
	    REF VECTOR [, LONG];

    BIND
	l_p1 = 					! P1 = buffer address.
	    AP [0],
	l_p2 = 					! P2 = buffer size in bytes.
	    AP [1],
	r_jib = 				!
	    .r_pcb [pcb$l_jib] : BLOCK [, BYTE],
	r_crb = 				!
	    .r_ucb [ucb$l_crb] : BLOCK [, BYTE],
	r_vec = 				!
	    r_crb [crb$l_intd] : BLOCK [, BYTE],
	r_idb = 				!
	    .r_vec [vec$l_idb] : BLOCK [, BYTE],
	r_dr11c_registers = 			!
	    .r_idb [idb$l_csr] : BLOCK [, BYTE] VOLATILE,
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE,
	w_input_buffer = 			!
	    r_dr11c_registers [dr11c_w_inbuf] : WORD VOLATILE,
	w_output_buffer = 			!
	    r_dr11c_registers [dr11c_w_outbuf] : WORD VOLATILE;

    LOCAL
	r_address_buffer : 			!
	    REF BLOCK [, BYTE],
	aw_address_vector : 			!
	    REF VECTOR [, WORD],
	l_csr_image : 				!
	    BLOCK [1, LONG],
	l_size,					!
	l_status : 				!
	    BLOCK [1, LONG];

    !+
    ! Check for write accessibility to user buffer.
    !-

    IF (l_status = exe$readchkr (.l_p1, .l_p2*2, r_irp [0, 0, 0, 0]))
    THEN

    !+
    ! Check for sufficient buffered I/O quota.
    !-

	IF (l_status = exe$buffrquota (.l_p2*2 + buf_k_hdrsiz, r_pcb [0, 0, 0, 0]))
	THEN

	!+
	! Allocate a system buffer to hold the addresses currently in the buffer.
	!-

	    IF (l_status = exe$allocbuf (.l_p2*2 + buf_k_hdrsiz; l_size, r_address_buffer))
	    THEN
		BEGIN

		!+
		! Make quota charge against user for buffer and set amount to restore
		! quota by in the IRP.
		!-

		r_jib [jib$l_bytcnt] = .r_jib [jib$l_bytcnt] - (.l_p2*2 + buf_k_hdrsiz);
		r_irp [irp$w_boff] = .l_p2*2 + buf_k_hdrsiz;

		!+
		! Initialize the fields of the system buffer.
		!-

		r_address_buffer [buf_a_data_address] = r_address_buffer [buf_b_data_area];
		r_address_buffer [buf_a_user_buffer] = .l_p1;
		r_irp [irp$l_svapte] = r_address_buffer [0, 0, 0, 0];

		!+
		! Copy addresses to the address buffer.
		!-

		CH$MOVE (.l_p2*2, .l_p1, .r_address_buffer [buf_a_data_address]);

		!+
		! Save number of registers to read in the IRP.
		!-

		r_irp [irp$w_bcnt] = .l_p2*2;

		!+
		! Everything is now set up.  Raise IPL to device and commence reading
		! the registers.
		!-

		_setipl (ipl = r_ucb [ucb$b_dipl]);

		!+
		! Bind a vector addressable structure to the data area in the user
		! buffer.
		!-

		aw_address_vector = .r_address_buffer [buf_a_data_address];

		IF NOT
		    BEGIN

		    INCRU i FROM 0 TO (.r_irp [irp$w_bcnt]/2) - 1 DO
			BEGIN

			!+
			! Load address into output data buffer register.
			!-

			l_csr_image = .w_csr;
			l_csr_image [dr11c_csr_v_csr0] = k_true;
			l_csr_image [dr11c_csr_v_csr1] = k_false;
			w_csr = .l_csr_image;
			w_output_buffer = .aw_address_vector [.i];

			INCRU k TO k_delay_count DO
			    1;

			IF NOT
			    BEGIN

			    INCRU j TO k_bit_high_limit DO
				BEGIN
				l_csr_image = .w_csr;

				IF .l_csr_image [dr11c_csr_v_req_a] THEN EXITLOOP k_false

				END

			    END
			THEN
			    BEGIN

			    !+
			    ! Lower CSR0.
			    !-

			    l_csr_image = .w_csr;
			    l_csr_image [dr11c_csr_v_csr0] = k_false;
			    w_csr = .l_csr_image;
			    aw_address_vector [.i] = .w_input_buffer
			    END
			ELSE
			    EXITLOOP k_false

			END

		    END
		THEN
		    l_status = ss$_opincompl
		ELSE
		    l_status = ss$_normal;

		END;

    exe$finishioc (.l_status, r_irp [0, 0, 0, 0], r_ucb [0, 0, 0, 0]);
    END;					! End of routine SS_READ_REGISTERS


%SBTTL 'SS_UNIT_INIT - Unit initialization routine'

GLOBAL ROUTINE ss_unit_init (			!
    r_dr11c_registers : REF BLOCK [, BYTE]VOLATILE, 	!
    r_ucb : REF BLOCK [, BYTE]			!
    ) : NOVALUE init_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This routine is called by SYSGEN when the device is connected.
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!	r_dr11c_registers --> address of device registers
!	r_ucb --> address of Unit Control Block
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	The CSR is initialized, the device set on-line, and the UCB
!	(which is assumed to be the only UCB) is set as the owner of
!	the controller.
!
!--

    BEGIN

    BIND
	r_crb = 				!
	    .r_ucb [ucb$l_crb] : BLOCK [, BYTE],
	r_vec = 				!
	    r_crb [crb$l_intd] : BLOCK [, BYTE],
	r_idb = 				!
	    .r_vec [vec$l_idb] : BLOCK [, BYTE],
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE;

    !+
    ! Initialize the CSR and mark the device on line.
    !-

    w_csr = 0;
    r_ucb [ucb$v_online] = k_true;

    !+
    ! Set owner UCB address in IDB.
    !-

    r_idb [idb$l_owner] = r_ucb [0, 0, 0, 0];
    END;					! End of routine SS_UNIT_INIT


%SBTTL 'SS_WRITE_REGISTERS - Register write FDT routine'

GLOBAL ROUTINE ss_write_registers (		!
    r_irp : REF BLOCK [, BYTE], 		!
    r_pcb : REF BLOCK [, BYTE], 		!
    r_ucb : REF BLOCK [, BYTE], 		!
    r_ccb : REF BLOCK [, BYTE]			!
    ) : NOVALUE fdt_linkage =

!++
!
! FUNCTIONAL DESCRIPTION:
!
!	This FDT routine is called as a result of aÊuser request to
!	write to the internal registers of the signal processing device
!	by way of the DR11-C interface (IO$_WRTIExBLK).
!
! CALLING SEQUENCE:
!
!	Not user callable.
!
! FORMAL PARAMETERS:
!
!   	r_irp --> address of I/O Request Packet
!   	r_pcb --> address of Process Control Block
!   	r_ucb --> address of Unit Control Block
!   	r_ccb --> address of Channel Control Block
!
! IMPLICIT INPUTS:
!
!	None.
!
! IMPLICIT OUTPUTS:
!
!	None.
!
! COMPLETION STATUS:
!
!	None.
!
! SIDE EFFECTS:
!
!	An I/O rerquest is completed.  Internal state of the device's
!	registers may change.
!
!
!--

    BEGIN

    BUILTIN
	AP;

    MAP
	AP : 					! QIO parameters P1 - P8.
	    REF VECTOR [, LONG];

    BIND
	l_p1 = 					! P1 = buffer address.
	    AP [0],
	l_p2 = 					! P2 = buffer size in bytes.
	    AP [1],
	r_jib = 				!
	    .r_pcb [pcb$l_jib] : BLOCK [, BYTE],
	r_crb = 				!
	    .r_ucb [ucb$l_crb] : BLOCK [, BYTE],
	r_vec = 				!
	    r_crb [crb$l_intd] : BLOCK [, BYTE],
	r_idb = 				!
	    .r_vec [vec$l_idb] : BLOCK [, BYTE],
	r_dr11c_registers = 			!
	    .r_idb [idb$l_csr] : BLOCK [, BYTE] VOLATILE,
	w_csr = 				!
	    r_dr11c_registers [dr11c_w_csr] : WORD VOLATILE,
	w_input_buffer = 			!
	    r_dr11c_registers [dr11c_w_inbuf] : WORD VOLATILE,
	w_output_buffer = 			!
	    r_dr11c_registers [dr11c_w_outbuf] : WORD VOLATILE;

    LOCAL
	l_csr_image : 				!
	    BLOCK [1, LONG],
	r_data_buffer : 			!
	    REF BLOCK [, BYTE],
	aw_data_vector : 			!
	    REF VECTOR [, WORD],
	l_registers_written : 			!
	    INITIAL (0),
	l_size,					!
	l_status : 				!
	    BLOCK [1, LONG];

    !+
    ! Check for read accessibility to user buffer.
    !-

    IF (l_status = exe$writechkr (.l_p1, .l_p2*4, r_irp [0, 0, 0, 0]))
    THEN

    !+
    ! Check for sufficient buffered I/O quota.
    !-

	IF (l_status = exe$buffrquota (.l_p2*4 + buf_k_hdrsiz, r_pcb [0, 0, 0, 0]))
	THEN

	!+
	! Allocate a system buffer to hold the addresses currently in the buffer.
	!-

	    IF (l_status = exe$allocbuf (.l_p2*4 + buf_k_hdrsiz; l_size, r_data_buffer))
	    THEN
		BEGIN

		!+
		! Make quota charge against user for buffer and set amount to restore
		! quota by in the IRP.
		!-

		r_jib [jib$l_bytcnt] = .r_jib [jib$l_bytcnt] - (.l_p2*4 + buf_k_hdrsiz);
		r_irp [irp$w_boff] = .l_p2*4 + buf_k_hdrsiz;

		!+
		! Initialize the fields of the system buffer.
		!-

		r_data_buffer [buf_a_data_address] = r_data_buffer [buf_b_data_area];
		r_irp [irp$l_svapte] = r_data_buffer [0, 0, 0, 0];

		!+
		! Copy data address pairs to the data buffer.
		!-

		CH$MOVE (.l_p2*4, .l_p1, .r_data_buffer [buf_a_data_address]);

		!+
		! Save number of registers to write in the IRP.
		!-

		IF (r_irp [irp$w_bcnt] = .l_p2) NEQ 0
		THEN
		    BEGIN

		    !+
		    ! Indicate to I/O postprocessing that the buffer should be deleted upon
		    ! request completion.
		    !-

		    r_irp [irp$v_func] = k_false;

		    !+
		    ! Everything is now set up.  Raise IPL to device and commence reading
		    ! the registers.
		    !-

		    _setipl (ipl = r_ucb [ucb$b_dipl]);

		    !+
		    ! Bind a vector addressable structure to the data area in the user
		    ! buffer.
		    !-

		    aw_data_vector = r_data_buffer [buf_b_data_area];

		    IF
			BEGIN

			INCRU i TO (.r_irp [irp$w_bcnt]*2) - 1 BY 2 DO
			    BEGIN

			    !+
			    ! Load address into output data buffer register.
			    !-

			    l_csr_image = .w_csr;
			    l_csr_image [dr11c_csr_v_csr0] = k_true;
			    l_csr_image [dr11c_csr_v_csr1] = k_true;
			    w_csr = .l_csr_image;

			    INCRU l TO k_delay_count DO
				1;

			    w_output_buffer = .aw_data_vector [.i + 1];

			    INCRU k TO k_delay_count - 1 DO
				1;

			    IF NOT
				BEGIN

				INCRU j TO k_bit_high_limit DO
				    BEGIN
				    l_csr_image = .w_csr;

				    IF .l_csr_image [dr11c_csr_v_req_a] THEN EXITLOOP k_false

				    END

				END
			    THEN
				BEGIN

				!+
				! Load data into output buffer.
				!-

				l_csr_image = .w_csr;
				l_csr_image [dr11c_csr_v_csr0] = k_false;
				l_csr_image [dr11c_csr_v_csr1] = k_true;
				w_csr = .l_csr_image;
				w_output_buffer = .aw_data_vector [.i];

				INCRU k TO k_delay_count - 1 DO
				    1;

				IF
				    BEGIN

				    INCRU j TO k_bit_high_limit DO
					BEGIN
					l_csr_image = .w_csr;

					IF .l_csr_image [dr11c_csr_v_req_a] THEN EXITLOOP k_false

					END

				    END
				THEN
				    EXITLOOP k_false
				ELSE
				    BEGIN

				    !+
				    ! Lower  CSR0 and CSR1.
				    !-

				    l_csr_image = .w_csr;
				    l_csr_image [dr11c_csr_v_csr0] = k_false;
				    l_csr_image [dr11c_csr_v_csr1] = k_false;
				    w_csr = .l_csr_image;

				    !+
				    ! Indicate that another register was written.
				    !-

				    l_registers_written = .l_registers_written + 1;
				    END;

				END
			    ELSE
				EXITLOOP k_false;

			    END

			END
		    THEN
			l_status = ss$_normal OR .l_registers_written^16
		    ELSE
			l_status = ss$_opincompl;

		    END
		ELSE
		    l_status = ss$_ivbuflen;

		END;

    exe$finishioc (.l_status, r_irp [0, 0, 0, 0], r_ucb [0, 0, 0, 0]);
    END;					! End of routine SS_WRITE_REGISTERS

END						! End of module SSDRIVER

ELUDOM