.TITLE	ETHERMON_FASTSHR	Fast I/O interface for ETHERMON
	.IDENT	/ETHERMON-V2.4 #2/

FASTSHR_VERSION	==	2		; patch level of shareable image

	.LIBRARY	/SYS$LIBRARY:LIB/
	$ACBDEF
	$CCBDEF
	$CXBDEF
	$DCDEF
	$DDTDEF
	$DEVDEF
	$DPTDEF		; only to pick up the VMS version we were compiled at
	$DYNDEF
	$IODEF
	$IPLDEF
	$IRPDEF
	.IF	LE DPT$C_VERSION-4
	$JIBDEF
	.ENDC
	$PCBDEF
	$PHDDEF
	$PLVDEF
	$PRDEF
	$PRTDEF
	$PRVDEF
	$PSLDEF
	$QIODEF
	$SSDEF
	$STSDEF
	$UCBDEF
	.IF	GE DPT$C_VERSION-5
	$SPLCODDEF
	$$SYSTEM_PRIM_DATADEF
	.ENDC

	.SHOW	BINARY
	.SBTTL	I/O Postprocessing Intercept Routine

	.PSECT	$CODE,EXE,RD,NOWRT,PIC,SHR,QUAD

kernel_intercept_block:
	.LONG	0		; address of requesting PCB
blk_l_ipid = .-kernel_intercept_block
	.LONG	0		; IPID of requesting process
blk_w_size = .-kernel_intercept_block
	.WORD	pool_block_size	; block size
blk_b_type = .-kernel_intercept_block
	.BYTE	DYN$C_LOADCODE
	.BYTE	DYN$C_NON_PAGED
blk_w_ioc = .-kernel_intercept_block
	.WORD	0		; counter of outstanding I/O's for intercept
blk_w_flags = .-kernel_intercept_block
	.WORD	0		; flags: bit 0=1 -> deallocate on IOC = 0
	.ENABLE	LSB
98$:	MOVW	#SS$_ILLIOFUNC,- ; load internal inconsistency status into I/OSB,
		IRP$L_IOST1(R3)
	BRW	102$		; send IRP back to post-processing.
97$:	ADDL2	#8,SP		; clean up stack,
	MOVL	(SP)+,R3	; restore IRP pointer,
	MOVW	#SS$_PROTOCOL,-	; load unknown packet type status into I/OSB,
		IRP$L_IOST1(R3)
99$:	BRW	102$		; send IRP back to post-processing.
blk_i_code = .-kernel_intercept_block
	MOVL	R5,R3		; put stuff in the correct registers,
	BBC	#IRP$V_DIAGBUF,- ; skip ahead if no diagbuf,
		IRP$W_STS(R3),98$
	MOVL	IRP$L_DIAGBUF(R3),R2 ; else get address of diagnostic buffer,
	MOVL	(R2),R2		; get address of data area,
	CMPW	IRP$L_IOST1(R3),- ; check if successful read (so far),
		#SS$_NORMAL
	BNEQ	99$
	MOVL	IRP$L_SVAPTE(R3),R1 ; OK, get address of buffered I/O block,
	CMPB	IRP$B_TYPE(R1),#DYN$C_CXB ; verify that it is a CXB,
	BNEQ	98$		; skip if not,
	PUSHL	R3		; else save IRP address,
	CLRB	IRP$L_IOST2(R3)	; zero offset storage location,
	MOVL	(R1),R1		; get start address of actual data body,
	MOVQ	R1,-(SP)	; save buffer pointers,
	CMPC3	#12,-14(R1),(R2) ; test if standard Ethernet packet,
	BEQL	14$
	MOVQ	(SP),R1
	CMPC3	#12,-17(R1),(R2) ; test if IEEE 802.3 packet (1 byte CTL),
	BEQL	17$
	MOVQ	(SP),R1
	CMPC3	#12,-18(R1),(R2) ; test if IEEE 802.3 packet (2 byte CTL),
	BEQL	18$
	MOVQ	(SP),R1
	CMPC3	#12,-22(R1),(R2) ; test if IEEE 802.3 SNAP packet,
	BNEQ	97$		; skip out if none of the above,
	MOVZBL	#8,R0		; else load offset correction for IEEE SNAP.
	BRB	30$
14$:	MOVZBL	#2,R0		; load offset correction for Ethernet,
	BRB	30$
17$:	MOVZBL	#3,R0		; load offset correction for IEEE CTL1.
	BRB	30$
18$:	MOVZBL	#4,R0		; load offset correction for IEEE CTL2.
30$:	ADDL2	#8,SP		; restore saved registers,
	MOVL	(SP)+,R3
	MOVB	R0,IRP$L_IOST2(R3) ; store size of header correction,
	MOVL	@IRP$L_SVAPTE(R3),R2 ; get address of CXB data area,
	MOVL	@IRP$L_DIAGBUF(R3),R4 ; get address of data area of diagbuf,
	MNEGL	R0,R1		; get offset for starting data copy,
	PUSHL	R3		; save critical register,
	MOVC5	R0,(R2)[R1],#0,#8,12(R4) ; copy data into diagnostic buffer,
	MOVL	(SP)+,R3	; restore critical register,
102$:	MOVL	blk_l_ipid+kernel_intercept_block,-
		IRP$L_PID(R3)	; put PID back to proper value,
	DECW	blk_w_ioc+kernel_intercept_block ; decrement I/O count for intercept,
	MOVL	IRP$L_UCB(R3),R5
	.IF	GE DPT$C_VERSION-5
	JSB	@#COM$POST_NOCNT ; send patched IRP back to post-processing,
	.IF_FALSE
	DECL	UCB$L_OPCNT(R5)	; adjust operation count for erroneous update,
	JSB	@#COM$POST	; now send patched IRP back to post-processing,
	.ENDC
	BLBS	blk_w_flags+kernel_intercept_block,-
		100$		; skip if running down,
101$:	RSB			; exit.
100$:	TSTW	blk_w_ioc+kernel_intercept_block ; test if all done,
	BNEQ	101$		; skip if I/O's still outstanding,
	MOVZWL	blk_w_size+kernel_intercept_block,-
		R0		; else credit block back to user quota,
	MOVL	kernel_intercept_block,R4
	.IF	GE DPT$C_VERSION-5
	JSB	@#EXE$CREDIT_BYTCNT
	.IF_FALSE
	MOVL	PCB$L_JIB(R4),R1
	ADDL2	R0,JIB$L_BYTCNT(R1)
	.ENDC
	MOVAB	kernel_intercept_block,R0 ; deallocate block.
	JMP	@#EXE$DEANONPAGED
POOL_BLOCK_SIZE = .-kernel_intercept_block
	.DISABLE	LSB
	.SBTTL	Patched $QIO system service

START_OF_KERNEL_CODE:
	.ENABLE	LSB

;;;LB_0000371C:
;;;	BBC	#DEV$V_SHR,UCB$L_DEVCHAR(R5),LB_00003755
;;;	BBC	R7,L^B_00004E78,LB_0000373B
;;;	BBS	#CCB$V_RDCHKDON,CCB$B_STS(R6),LB_0000373B
;;;	JSB	@#EXE$CHKRDACCES
;;;	BLBC	R0,LB_0000379D
;;;	BISB2	#CCB$M_RDCHKDON,CCB$B_STS(R6)
;;;LB_0000373B:
;;;	BBC	R7,L^B_00004E80,LB_00003755
;;;	BBS	#CCB$V_WRTCHKDON,CCB$B_STS(R6),LB_00003755
;;;	JSB	@#EXE$CHKWRTACCES
;;;	BLBC	R0,LB_0000379D
;;;	BISB2	#CCB$M_WRTCHKDON,CCB$B_STS(R6)
;;;LB_00003755:
;;;	BRW	LB_00003807
;;;LB_00003758:
;;;	LOCK	SCHED,LOCKIPL=#IPL$_SCHED
;;;	MOVZWL	#RSN$_ASTWAIT,PCB$L_EFWM(R4)
;;;	MOVAQ	@#SCH$GQ_MWAIT,R2
;;;	BBSSI	S^#1,@#SCH$GL_RESMASK,LB_00003785
;;;LB_00003785:
;;;	JMP	@#SCH$WAIT
10$:	JSB	@#SCH$CLREF
	BRB	1$
11$:	MOVZWL	#SS$_IVCHAN,R0
;;;	BRB	13$
;;;12$:	MOVZWL	#SS$_NOPRIV,R0
13$:	BRW	finish_io_early
;;;14$:	BRB	LB_00003758
;
	.ENTRY	K_FAST_BUFIO_READ_EXE$QIO,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
	MOVZBL	QIO$_EFN(AP),R3
	CMPB	R3,S^#63
	BGTRU	10$
	BBCCI	R3,PCB$L_EFCS(R4),1$
1$:	BICL3	#^XFFFF000F,QIO$_CHAN(AP),R0
	BEQL	11$
	CMPW	R0,@#CTL$GW_CHINDX
	BGTRU	11$
	MNEGL	R0,R9
	MOVL	@#CTL$GL_CCBBASE,R6
	MOVAB	(R6)[R9],R6
	MOVPSL	R3
	MOVZBL	CCB$B_AMOD(R6),R0
	BEQL	11$
	EXTZV	#PSL$V_PRVMOD,#PSL$S_PRVMOD,R3,R11
	ASHL	S^#16,R9,R9
;;;	CMPB	R11,R0
;;;	BGEQ	12$
	MOVL	CCB$L_UCB(R6),R5
;;;	BLBS	CCB$L_WIND(R6),14$
	MOVZBL	#IO$_READVBLK,R10	;;;	MOVZWL	QIO$_FUNC(AP),R10
	MOVZBL	#IO$_READVBLK,R7	;;;	BICL3	#IO$M_FMODIFIERS,R10,R7
;;;	BBS	#DEV$V_SPL,UCB$L_DEVCHAR(R5),LB_00003873
;;;LB_00003802:
;;;	BBC	#DEV$V_FOD,UCB$L_DEVCHAR(R5),LB_0000387E
;;;LB_00003807:
	MOVL	UCB$L_DDT(R5),R0
	MOVL	DDT$L_FDT(R0),R8
	BBC	R7,(R8),error_illiofunc
	BBC	#UCB$V_ONLINE,UCB$L_STS(R5),error_devofflin
;;;LB_00003819:
	MOVL	QIO$_IOSB(AP),R1
	BEQL	LB_00003827
	IFNOWRT	#8,(R1),error_accvio
	CLRQ	(R1)
LB_00003827:
	.IF	GE DPT$C_VERSION-5
	SETIPL	#IPL$_ASTDEL,ENVIRON=UNIPROCESSOR
	.IF_FALSE
	SETIPL	#IPL$_ASTDEL
	.ENDC
	BBC	R7,8(R8),error_illiofunc ;;;	BBS	R7,B^8(R8),LB_00003832
					 ;;;	BRW	LB_000038D1
;;;LB_00003832:
	INCW	R9
	ADAWI	#-1,PCB$W_BIOCNT(R4)
	BLSS	LB_0000383F
	BRW	LB_000038D9
LB_0000383F:
	PUSHAW	PCB$W_BIOCNT(R4)
LB_00003842:
	MOVL	(SP),R2
	ADAWI	S^#1,(R2)
	.IF	GE DPT$C_VERSION-5
	SETIPL	#0,ENVIRON=UNIPROCESSOR
	.IF_FALSE
	SETIPL	#0
	.ENDC
	JSB	@#EXE$SNGLEQUOTA
	BLBC	R0,finish_io_early
	ADAWI	#-1,@(SP)+
	BRB	LB_000038D9
error_illiofunc:
	MOVZWL	#SS$_ILLIOFUNC,R0
	BRB	finish_io_early
error_devofflin:
;;;	CMPB	#IO$_DEACCESS,R7
;;;	BEQL	LB_00003819
;;;	CMPB	#IO$_ACPCONTROL,R7
;;;	BEQL	LB_00003819
	MOVZWL	#SS$_DEVOFFLINE,R0
	BRB	finish_io_early
;;;LB_00003873:
;;;	CMPL	#IO$_LOGICAL,R7
;;;	BGEQ	LB_00003802
;;;	MOVL	UCB$L_AMB(R5),R5
;;;	BRB	LB_00003802
;;;LB_0000387E:
;;;	BRW	LB_0000371C
error_accvio:
	MOVZWL	#SS$_ACCVIO,R0
finish_io_early:
	.IF	GE DPT$C_VERSION-5
	SETIPL	#0,ENVIRON=UNIPROCESSOR
	.IF_FALSE
	SETIPL	#0
	.ENDC
	PUSHL	R0
	MOVL	PCB$L_PID(R4),R1
	CLRL	R2
	MOVZBL	QIO$_EFN(AP),R3
	JSB	@#SCH$POSTEF
	MOVL	(SP)+,R0
	RET
LB_0000389D:
	JSB	@#EXE$ALLOCIRP
	BLBS	R0,LB_000038F5
	PUSHAW	PCB$W_BIOCNT(R4)
	BLBS	R9,LB_000038AF
	PUSHAW	PCB$W_DIOCNT(R4)
LB_000038AF:
	ADAWI	S^#1,@(SP)+
	BRB	finish_io_early
;;;LB_000038B4:
;;;	PUSHAW	PCB$W_DIOCNT(R4)
;;;	BRB	LB_00003842
;;;LB_000038B9:
;;;	CVTWL	CCB$L_WIND(R6),R0
;;;	MOVL	@#CTL$GL_PHD,R1
;;;	ADDL2	PHD$L_PSTBASOFF(R1),R1
;;;	MOVL	B^12(R1)[R0],B^-4(R2)
;;;	BRB	LB_0000393C
;;;LB_000038D1:
;;;	ADAWI	#-1,PCB$W_DIOCNT(R4)
;;;	BLSS	LB_000038B4
LB_000038D9:
	.IF	GE DPT$C_VERSION-5
	MOVL	@#EXE$AR_SYSTEM_PRIMITIVES_DATA,R2
	CLRL	R0
50$:	REMQHI	IOC_GQ_IRPIQ(R2),R2
	BGEQU	51$
	AOBLSS	#900000,R0,50$
	BUG_CHECK	BADQHDR,FATAL
51$:
	.IF_FALSE
	REMQUE	@#IOC$GL_IRPFL,R2
	.ENDC
	BVS	LB_0000389D
LB_000038F5:
	INCW	CCB$W_IOC(R6)
	MOVL	W^KERNEL_BLOCK_PTR,R0	; also update safety counter for
	INCW	blk_w_ioc(R0)		; intercept code
	MOVAQ	(R2)+,R3
	MOVQ	QIO$_ASTADR(AP),R0
	MOVL	PCB$L_ARB(R4),IRP$L_ARB(R3)
	TSTL	R0
	BEQL	LB_00003913
	BISB2	#ACB$M_QUOTA,R11
	ADAWI	#-1,PCB$W_ASTCNT(R4)
LB_00003913:
	ASHL	S^#24,R11,R11
	ASSUME	IRP$B_RMOD EQ IRP$B_TYPE+1
	BISL3	R11,#<<DYN$C_IRP@16>+IRP$K_LENGTH>,(R2)+
	ASSUME	PCB$B_PRIB EQ PCB$W_STATE+3
	ROTL	S^#16,PCB$W_STATE(R4),R11
	ASSUME	IRP$L_PID EQ IRP$B_RMOD+1
	ADDL3	W^KERNEL_BLOCK_PTR,#blk_i_code,(R2)+ ;;; MOVL PCB$L_PID(R4),(R2)+
	MOVB	QIO$_EFN(AP),R11
	ASSUME	IRP$L_AST EQ IRP$L_PID+4
	ASSUME	IRP$L_ASTPRM EQ IRP$L_AST+4
	MOVQ	R0,(R2)+
	ROTL	S^#16,R11,R11
	ASSUME	IRP$L_WIND EQ IRP$L_ASTPRM+4
	MOVL	CCB$L_WIND(R6),(R2)+
;;;	BLEQ	LB_0000393C
;;;	BRW	LB_000038B9
;;;LB_0000393C:
	ASSUME	IRP$L_UCB EQ IRP$L_WIND+4
	MOVL	R5,(R2)+
	MOVW	R10,R11
	ASSUME	IRP$W_FUNC EQ IRP$L_UCB+4
	ASSUME	IRP$B_EFN EQ IRP$W_FUNC+2
	ASSUME	IRP$B_PRI EQ IRP$B_EFN+1
	MOVL	R11,(R2)+
	ADDL2	S^#4,R8
	ASSUME	IRP$L_IOSB EQ IRP$W_FUNC+4
	MOVL	QIO$_IOSB(AP),(R2)+
	ADDL2	#QIO$_P1,AP
	ASSUME	IRP$W_CHAN EQ IRP$L_IOSB+4
	ASSUME	IRP$W_STS EQ IRP$W_CHAN+2
	ROTL	S^#16,R9,(R2)+
;;;	BICL3	S^#1,R7,R9
	ASSUME	IRP$L_SVAPTE EQ IRP$W_STS+2
	ASSUME	IRP$W_BOFF EQ IRP$L_SVAPTE+4
	CLRQ	(R2)+
	CLRL	(R2)
	CLRL	IRP$L_DIAGBUF(R3)
	TSTL	@#PMS$GL_IOPFMPDB
	BEQL	LB_0000396E
	JSB	@#PMS$START_RQ
	BRB	LB_000039A4
LB_0000396E:
	.IF	GE DPT$C_VERSION-5
	LOCK	PERFMON,LOCKIPL=#IPL$_PERFMON,PRESERVE=NO
	.IF_FALSE
	DSBINT	#IPL$_PERFMON
	.ENDC
	MOVL	@#PMS$GL_IOPFMSEQ,IRP$L_SEQNUM(R3)
	INCL	@#PMS$GL_IOPFMSEQ
	.IF	GE DPT$C_VERSION-5
	UNLOCK	PERFMON,NEWIPL=#IPL$_ASTDEL,PRESERVE=NO
	.IF_FALSE
	ENBINT
	.ENDC
LB_000039A4:
;;;	MOVL	UCB$L_DEVCHAR(R5),R11
;;;	CMPL	#IO$_WRITEVBLK,R9
;;;	BNEQ	LB_000039E2
;;;	BBC	#DEV$V_FOD,R11,LB_000039BE
;;;	TSTL	IRP$L_WIND(R3)
;;;	BNEQ	LB_000039CE
;;;	BBC	#DEV$V_MNT,R11,LB_00003A19
;;;	BBC	#DEV$V_FOR,R11,LB_00003A2C
;;;LB_000039BE:
	SUBL2	#<IO$_WRITEVBLK-IO$_WRITELBLK>,R7
	SUBW2	#<IO$_WRITEVBLK-IO$_WRITELBLK>,IRP$W_FUNC(R3)
;;;	BITL	#<DEV$M_SPL!DEV$M_FOD!DEV$M_SHR>,R11
;;;	BNEQ	LB_000039E2
;;;LB_000039CE:
	TSTW	PCB$W_ASTCNT(R4)
	BLSS	LB_00003A22
LB_000039D3:
	ADDL2	S^#12,R8
	BBC	R7,(R8),LB_000039D3
	MOVL	B^8(R8),R0
	JSB	(R0)
	BRB	LB_000039D3
;;;LB_000039E2:
;;;	CMPL	#IO$_LOGICAL,R7
;;;	BLSS	LB_00003A2C
;;;	BBS	S^#22,PCB$Q_PRIV(R4),LB_00003A2C
;;;	CMPL	#IO$_PHYSICAL,R7
;;;	BLSS	LB_00003A6B
;;;	BBC	#PRV$V_LOG_IO,PCB$Q_PRIV(R4),LB_00003A19
;;;	MOVL	#CCB$V_PHYCHKDON,R9
;;;	MOVAB	@#EXE$CHKPHYACCES,R10
;;;	BRB	LB_00003A7B
;;;LB_00003A04:
;;;	BBC	#DEV$V_SHR,R11,LB_00003A2C
;;;LB_00003A08:
;;;	BBS	R9,CCB$B_STS(R6),LB_00003A2C
;;;	JSB	(R10)
;;;	BLBC	R0,LB_00003A1C
;;;	BBSS	R9,CCB$B_STS(R6),LB_00003A17
;;;LB_00003A17:
;;;	BRB	LB_00003A2C
;;;LB_00003A19:
;;;	MOVZWL	#SS$_NOPRIV,R0
LB_00003A22:
	TSTL	IRP$L_AST(R3)
	BEQL	LB_000039D3
	MOVZWL	#SS$_EXQUOTA,R0
;;;	BRB	LB_00003A1C
;;;LB_00003A1C:
	JMP	G^EXE$ABORTIO
;;;LB_00003A2C:
;;;	CMPL	#IO$_PHYSICAL,R7
;;;	BLSS	LB_000039CE
;;;	BISW2	#IRP$M_PHYSIO,IRP$W_STS(R3)
;;;	MOVL	<QIO$_P6-QIO$_P1>(AP),R9
;;;	BEQL	LB_000039CE
;;;	BBC	#PRV$V_DIAGNOSE,PCB$Q_PRIV(R4),LB_00003A19
;;;	MOVL	UCB$L_DDT(R5),R1
;;;	MOVZWL	DDT$W_DIAGBUF(R1),R1
;;;	BEQL	LB_00003A68
;;;	JSB	@#EXE$ALLOCBUF
;;;	BLBC	R0,LB_00003A1C
;;;	MOVL	R2,IRP$L_DIAGBUF(R3)
;;;	MOVAB	B^12(R2),(R2)+
;;;	MOVL	R9,(R2)
;;;	BISW2	#IRP$M_DIAGBUF,IRP$W_STS(R3)
;;;LB_00003A68:
;;;	BRW	LB_000039CE
;;;LB_00003A6B:
;;;	BBS	#PRV$V_LOG_IO,PCB$Q_PRIV(R4),LB_00003A68
;;;	MOVL	#CCB$V_LOGCHKDON,R9
;;;	MOVAB	@#EXE$CHKLOGACCES,R10
;;;LB_00003A7B:
;;;	BBS	#DEV$V_SPL,R11,LB_00003A19
;;;	BBC	#DEV$V_FOD,R11,LB_00003A04
;;;	BBC	#DEV$V_MNT,R11,LB_00003A19
;;;	BBC	#DEV$V_FOR,R11,LB_00003A19
;;;	BRW	LB_00003A08

	.DISABLE	LSB

	.ALIGN	LONG
kernel_exit_handler:
	MOVL	W^KERNEL_BLOCK_PTR,R5
	BEQL	99$			; skip all if no block allocated,
	BISW2	#1,blk_w_flags(R5)	; else mark block for deallocation,
	CLRL	W^KERNEL_BLOCK_PTR	; mark so we don't try to use it again.
	TSTW	blk_w_ioc(R5)		; test if any pending IRP's on it,
	BNEQ	99$			; yes, leave block alone.
	MOVZWL	blk_w_size(R5),R0	; credit block back to user quota,
	MOVL	(R5),R4
	.IF	GE DPT$C_VERSION-5
	JSB	@#EXE$CREDIT_BYTCNT
	.IF_FALSE
	MOVL	PCB$L_JIB(R4),R1
	ADDL2	R0,JIB$L_BYTCNT(R1)
	.ENDC
	MOVL	R5,R0			; deallocate block.
	JSB	@#EXE$DEANONPAGED
99$:	RSB

END_OF_KERNEL_CODE:

	.ENTRY	create_intercept_routine,^M<R2,R3,R4,R5>
	PUSHAB	END_OF_KERNEL_CODE	; lock down virtual memory used at
	PUSHAB	START_OF_KERNEL_CODE	; high IPL,
	MOVL	SP,R0
	$LKWSET_S	INADR=(R0)
	BLBC	R0,99$
	ADDL2	#8,SP
	MOVZWL	#POOL_BLOCK_SIZE,R1	; specify size of block to get,
	.IF	GE DPT$C_VERSION-5
	JSB	@#EXE$DEBIT_BYTCNT_ALO	; try to get it,
	BLBC	R0,99$			; abort if failure,
	.IF_FALSE
	JSB	@#EXE$BUFFRQUOTA	; see if enough quota left,
	BLBC	R0,99$			; abort if failure,
	JSB	@#EXE$ALLOCBUF		; OK, try to get the buffer,
	BLBC	R0,99$			; abort if failure,
	MOVL	PCB$L_JIB(R4),R0	; else get JIB address,
	SUBL2	R1,JIB$L_BYTCNT(R0)	; adjust quota,
	.ENDC
	MOVL	R2,W^KERNEL_BLOCK_PTR	; save the block address,
	MOVL	PCB$L_PID(R4),4(R2)	; save IPID for intercept routine,
	MOVL	R4,(R2)			; save PCB address for rundown,
	PUSHR	#^M<R2,R4>		; save registers,
	MOVC3	#<POOL_BLOCK_SIZE-blk_b_type>,- ; copy intercept code to pool,
		kernel_intercept_block+blk_b_type,blk_b_type(R2)
	POPR	#^M<R2,R4>		; restore registers,
	MOVZWL	#SS$_NORMAL,R0		; load success status,
99$:	RET				; exit.

	.ALIGN	LONG
	.TRANSFER	P_FAST_BUFIO_READ_$QIO
	.ENTRY	P_FAST_BUFIO_READ_$QIO,^M<>
	MOVZWL	#SS$_NOSUCHPGM,R0
	TSTL	W^KERNEL_BLOCK_PTR
	BGEQ	99$
	$CMKRNL_S	ROUTIN=K_FAST_BUFIO_READ_EXE$QIO,-
			ARGLST=(AP)
99$:	RET
	.SBTTL	Privileged Library Vector (to set up rundown)
;++
; This vector is used by the image activator to connect the privileged shareable
; image to the VMS change mode dispatcher.  The offsets in the vector are self-
; relative to enable the construction of position independent images.  The system
; version number will be used by the image activator to verify that this shareable
; image was linked with the symbol table for the current system.
;
;			Change Mode Vector Format		
;
;	   +------------------------------------------+
;	   !             Vector Type Code             !   PLV$L_TYPE
;	   !             (PLV$C_TYP_CMOD)             !
;	   +------------------------------------------+
;	   !                Reserved                  !
;	   !                                          !
;	   +------------------------------------------+
;	   !      Kernel Mode Dispatcher Offset       !   PLV$L_KERNEL
;	   !                                          !
;	   +------------------------------------------+
;	   !         Exec Mode Entry Offset           !   PLV$L_EXEC
;	   !                                          !
;	   +------------------------------------------+
;	   !	   User Rundown Service Offset        !   PLV$L_USRUNDWN
;	   !                                          !
;	   +------------------------------------------+
;	   !                Reserved                  !
;	   !                                          !
;	   +------------------------------------------+
;	   !          RMS Dispatcher Offset           !   PLV$L_RMS  
;	   !                                          !
;	   +------------------------------------------+
;	   !             Address Check                !   PLV$L_CHECK
;	   !                                          !
;	   +------------------------------------------+
;
;
;
	.PSECT	$VECTOR,PAGE,VEC,PIC,NOWRT,EXE

	.LONG	PLV$C_TYP_CMOD		; Set type of vector to change mode dispatcher
	.LONG	0			; Reserved
	.LONG	0			; No kernel mode dispatcher
	.LONG	0			; No executive mode dispatcher
	.LONG	kernel_exit_handler-.	; Offset to user rundown service
	.LONG	0			; Reserved.
	.LONG	0			; No RMS dispatcher
	.LONG	0			; Address check - PIC image
	.SBTTL	User-Mode Initialization Code

	.PSECT	PROTECTED$DATA,NOEXE,RD,WRT,PIC,NOSHR,LCL,LONG
KERNEL_BLOCK_PTR:
	.LONG	0		; S0-space address of kernel block

	.PSECT	$CODE

enable_CMKRNL_prvmsk:
	.LONG	PRV$M_CMKRNL
	.LONG	0

	.TRANSFER	P_INIT_FAST_$QIO
	.ENTRY	P_INIT_FAST_$QIO,^M<R2,R3,R4,R5>

; verify that user has CMKRNL privilege and enable it
	$SETPRV_S	ENBFLG=#1,PRVADR=enable_CMKRNL_prvmsk
	CMPL	R0,#SS$_NORMAL		; did privilege get set?
	BNEQ	init_fast_failexit	; no, quit.

; get this process's internal PID, allocate the non-paged pool block, & load it
	$CMKRNL_S	ROUTIN=create_intercept_routine,-
			ARGLST=(AP)
	BLBC	R0,init_fast_failexit
	RET

init_fast_failexit:
	BICL2	#STS$M_SEVERITY,R0	; make all errors fatal,
	BISL2	#4,R0
	RET				; exit.

FMT_STRING:
	.ASCII	"kernel block located at !XL, size !UL"
LEN_FMT	=	.-FMT_STRING

	.ALIGN	LONG
	.TRANSFER	P_FAST_$QIO_D_LINE
	.ENTRY	P_FAST_$QIO_D_LINE,^M<R2,R3,R4,R5>
	CLRL	-(SP)			; get length buffer,
	PUSHAB	FMT_STRING		; make descriptor of format string,
	PUSHL	#LEN_FMT
	$FAO_S	CTRSTR=16(SP),-		; format a debug string,
		OUTLEN=20(SP),OUTBUF=@4(AP),-
		P1=KERNEL_BLOCK_PTR,P2=#POOL_BLOCK_SIZE
	MOVL	8(SP),R0		; get length to return,
	RET				; exit.

	.END