	.TITLE	JASMON "System Service Monitor"
	.IDENT /v1.0/
;+
; Facility:
;	JASMON.MAR - Just Another Stupid MONitor
;
; Abstract:
;	The program will patch the P1 system service dispatch vector.
;	Before dispatching a service, a message is sent to
;	SYS$OUTPUT which describes the system service calls.
;
;	The idea was to write something like "SET WATCH FILE" which
;	logged arbitrary SS calls instead of F11 XPQ functions.
;
; Author:
;	Bruce R. Miller, MILLER@TGV.COM
;	TGV, Inc.
;	603 Mission St.
;	Santa Cruz, CA 95060
;	(408) 427-4366
;
; Date:
;	6-MAY-1991
;
; Functional Description:
;
; Acknowledgements:
;	The this code was inspired (if I may call it that) by Ehud
;	Gavron's program which installed itself in P1 space and trapped
;	terminal control characters.
;
; Caveats:
;	   This program will only affect the current process, and
;	not any subprocess or parent process.
;
; Copyright (c) 1991 Bruce R. Miller
; All rights reserved.
;
;	Redistribution and use in source and binary forms are permitted
;	provided that the above copyright notice and this paragraph are
;	duplicated in all such forms and that any documentation,
;	advertising materials, and other materials related to such
;	distribution and use acknowledge that the software was developed
;	by Bruce R. Miller.
;	THIS SOFTWARE IS PROVIDED AS IS'' AND WITHOUT ANY EXPRESS OR
;	IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
;	WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
;
; Modifications:
;
;-

	.link		"sys$system:sys.stb"/SELECTIVE_SEARCH
	.library	"sys$Library:lib.mlb"

	$iodef
	$psldef
	$ssdef
	$CCBDEF
	$DDBDEF
	$IPLDEF
	$SECDEF
	$SGNDEF
	$SYSVECTORDEF
	$UCBDEF


.EXTERNAL	Get_Database
.EXTERNAL	Set_Database
.EXTERNAL	Print_String

JASMON_K_DEFAULT	= 0
JASMON_K_NULL		= 1
JASMON_K_TGV		= 2
JASMON_K_UCX		= 3
JASMON_K_PSI		= 4

	; How many pages of the dispatch vector do we map?
SSV_Pages = SGN$C_SYSVECPGS
	; How many bytes of the dispatch vector do we map?
SSV_Length = SSV_Pages*512

	; How many pages of statistics do we map?
Stat_Pages = 1
	; How many bytes of statistics do we map?
Stat_Length = Stat_Pages*512

OldVA:
	.BLKL 2
NewVA:
	.BLKL 2


.PSECT KData,QUAD,PIC
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Loadable code
;---------------------------------------------------------------------
jbase:
	; Keep track of something
	j_data_size = . - jbase
	jdata_size:		.BLKL 1;

	; Space to store the original 
	j_data_orig = . - jbase
	jdata_orig:		.BLKL 1;

	; Space to store the statistics
	j_data_stats = . - jbase
	jdata_stats:		.BLKL 1;

	; Space to store channel number
	j_data_chan = . - jbase
	jdata_chan:		.BLKL 1;

	; QIO parameter
	j_param_qio = . - jbase
	jparam_qio:		.BLKL 1;

	;  parameter
	j_param_qio_style = . - jbase
	jparam_qio_style:	.BLKL 1;

	;  parameter
	j_param_3 = . - jbase
	jparam_3:		.BLKL 1;

	;  parameter
	j_param_4 = . - jbase
	jparam_4:		.BLKL 1;

j_common = . - jbase
jcommon:
	MOVAB	jdata_stats,R1			; Get addr of stat pntr
	MOVL	(R1),R1				; get address of stats block
	BEQL	20$				; br if no stats
	INCL	(R1)				; Increment counter
20$:	RSB

j_rundown = . - jbase
jrundown:
	; If this is a kernel mode run down, we are killing the whole process
	MOVL	4(AP),R0			; Get access mode
	CMPW	R0,#PSL$C_KERNEL		; Is this a process rundown?
	BNEQ	100$

	PUSHR	^m<R2,R3,R4,R5,R6,R7>		; Save these registers
	MOVAB	jbase,R6			; get base of original code

	; Make channel accessable
	MOVAL	jdata_chan,R1			; Channel pointer
	MOVZWL	(R1),R5				; get channel
	MNEGL	R5,R1				; get negative offset
	MOVL	G^CTL$GL_CCBBASE,R2		; get CCB vector high address
	MOVAB	(R2)[R1],R3			; get CCB
	MOVB	#PSL$C_USER+1,CCB$B_AMOD(R3)	; Set acmode to USER.

	; Deassign the channel
;	PUSHL	R5				; chan
;	CALLS	#1,@#BASE$EXE$K_DASSGN+^x80000000

	POPR	^m<R2,R3,R4,R5,R6,R7>		; Restore these registers
100$:	JMP	@#BASE$EXE$K_RUNDWN+^x80000002

BUFSIZE = 512

j_exec_output = . - jbase
.entry	jexec_output,^m<R2,R3,R4,R5,R6,R7>

	;
	; Log a message
	;

;	DSBINT	IPL=#IPL$_ASTDEL, DST=R7, ENVIRON=UNIPROCESSOR

	MOVPSL	R0
	EXTZV	#PSL$V_CURMOD,#PSL$S_CURMOD,-
		R0,R0
	CMPB	R0,#PSL$C_KERNEL
	BNEQ	10$
;	BRW	110$

10$:	; Make channel accessable
	MOVAL	jdata_chan,R1			; Channel pointer
	MOVZWL	(R1),R5				; get channel
	MNEGL	R5,R1				; get negative offset
	MOVL	G^CTL$GL_CCBBASE,R2		; get CCB vector high address
	MOVAB	(R2)[R1],R6			; get CCB
;	MOVB	#PSL$C_USER+1,CCB$B_AMOD(R6)	; Set acmode to USER.

30$:	; Format the string
	SUBL	#BUFSIZE,SP
	PUSHL	SP				; outbuf desc.pointer
	PUSHL	#BUFSIZE			; outbuf desc.size

	ADDL3	#8,4(AP),-(SP)			; Fix up the descriptor
	PUSHL	@4(AP)				;   for cst (copy on stack)

	MOVAL	-(SP),R3			; retlen pointer

	MOVAL	8(AP),-(SP)			; prmlst
	MOVAL	12(R3),-(SP)			; outbuf
	PUSHL	R3				; outlen
	MOVAL	4(R3),-(SP)			; cstr
	CALLS	#4,@#BASE$EXE$K_FAOL+^x80000000
	POPL	R3				; Get outlen
	MOVZWL	R3,R3				; Mask off high word
	ADDL	#16,SP				; pop descriptors off stack
	BLBC	R0,50$				; If failed exit error
	MOVL	SP,R4

40$:	; Send data
	CLRQ	-(SP)				; P5 / P6
	CLRQ	-(SP)				; P3 / P4
	PUSHL	R3				; P2 == outlen
	PUSHL	R4				; P1 == outbuf
	CLRQ	-(SP)				; ASTADR / ASTPRM
	CLRL	-(SP)				; IOSB
	PUSHL	#IO$_WRITEVBLK			; Func
	PUSHL	R5				; chan
	PUSHL	#0				; EFN
	CALLS	#12,@#BASE$EXE$K_QIO+^x80000000
;	BLBC	R0,100$				; If failed exit error

50$:
	; Remove outbuf from stack
	ADDL	#BUFSIZE,SP

100$:	;Clean up
	MOVB	#PSL$C_EXEC+1,CCB$B_AMOD(R6)
;	ENBINT  SRC=R7
110$:
	RET
;++
;	jsupp_getddb - 
;
;
;--
j_supp_getddb = . - jbase
.entry	jsupp_GetDDB,^m<R2,R3,R4,R5,R7>
	; Lock the IO database
			; this is where we aren't locking the database

	; Find the Device Data Block for the channel in 4(AP)
	MOVL	4(AP),R0
	MNEGL	R0,R1				; get negative offset
	MOVL	G^CTL$GL_CCBBASE,R2		; get CCB vector high address
	MOVAB	(R2)[R1],R0			; get Channel Control Block
	MOVL	CCB$L_UCB(R0),R0		; get Unit Control Block
	BEQL	100$				; fail if non-existant
	MOVL	UCB$L_DDB(R0),R0		; Get Device Data Block

100$:	; Unlock IO database and return
			; this is where we aren't unlocking the database
	RET

j_output = . - jbase
.entry	joutput,^m<R2,R3,R4,R5,R7>

;HACK - Why not go into krnl mode and just call EXE$QIOREQ?
	MOVL	AP,-(SP)
	MOVAB	jexec_output,-(SP)
	CALLS	#2,@#BASE$EXE$K_CMEXEC+^x80000000
	RET

j_dispatch = . - jbase
jdispatch:
	MOVAB	jdata_orig,R0			; get base of original code
	ADDL3	(R0),(SP)+,R0			; add offset
	JMP	(R0)

j_sscall = . - jbase
jsscall:
	MOVAB	jdata_orig,R0			; get base of original code
	ADDL3	(R0),4(SP),R0			; add offset
;	ADDL3	w^jdata_orig,4(SP),R0		; add offset
	CALLG	0(AP),(R0)
;	CALLG	(AP),(R0)
;.LONG	^X0004005F				; cause exception for testing
	RSB

;
;	Replacement RMS code
;

j_rms_close = . - jbase
jrms_close:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_CLOSE_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_CLOSE
 	JMP	W^jgeneric


j_rms_connect = . - jbase
jrms_connect:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_CONNECT_Desc		; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_CONNECT
 	JMP	W^jgeneric


j_rms_create = . - jbase
jrms_create:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_CREATE_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_CREATE
 	JMP	W^jgeneric


j_rms_delete = . - jbase
jrms_delete:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_DELETE_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_DELETE
 	JMP	W^jgeneric


j_rms_flush = . - jbase
jrms_flush:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_FLUSH_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_FLUSH
 	JMP	W^jgeneric


j_rms_get = . - jbase
jrms_get:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_GET_Desc			; cstr
	PUSHL	#4+1
 	JMP	W^jgeneric


j_rms_open = . - jbase
jrms_open:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_OPEN_Desc
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_OPEN
 	JMP	W^jgeneric


j_rms_put = . - jbase
jrms_put:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	RMS_PUT_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$RMS$K_PUT
	JMP	W^jgeneric


;
;	Replacement system services
;

j_assign = . - jbase
jassign:
	; Call common code
	MOVAB	jcommon,R0
	JSB	(R0)

	; Call original ASSIGN
	PUSHL	#BASE$EXE$K_ASSIGN
	JSB	jsscall
	MOVL	R0,(SP)				; save the return code

	; Put a message
	PUSHL	@8(AP)				; P4
	PUSHL	R0				; P3
	MOVZBL	12(AP),-(SP)			; P2
	PUSHL	4(AP)				; P1
	PUSHAB	ASSIGN_Desc			; cstr
	CALLS	#5,w^joutput
	POPL	R0
	RET

j_cancel = . - jbase
jcancel:
	PUSHL	R0				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	CANCEL_Desc			; cstr
	PUSHL	#2+1
	PUSHL	#BASE$EXE$K_CANCEL
	JMP	W^jgeneric


j_canexh = . - jbase
jcanexh:
	PUSHL	R0				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	CANEXH_Desc			; cstr
	PUSHL	#2+1
	PUSHL	#BASE$EXE$K_CANEXH
	JMP	W^jgeneric


j_cantim = . - jbase
jcantim:
	PUSHL	R0				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	CANTIM_Desc			; cstr
	PUSHL	#3+1
	PUSHL	#BASE$EXE$K_CANTIM
	JMP	W^jgeneric


j_canwak = . - jbase
jcanwak:
	PUSHL	R0				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	CANWAK_Desc			; cstr
	PUSHL	#3+1
	PUSHL	#BASE$EXE$K_CANWAK
	JMP	W^jgeneric


j_chkpro = . - jbase
jchkpro:
	PUSHL	R0				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	CHKPRO_Desc			; cstr
	PUSHL	#2+1
	PUSHL	#BASE$EXE$K_CHKPRO
	JMP	W^jgeneric


j_cretva = . - jbase
jcretva:
	PUSHL	R0				; P4
	PUSHL	12(AP)				; P3
	MOVL	4(AP),R0			; Get INADR
	PUSHL	(R0)				; P2
	PUSHL	4(R0)				; P1
	PUSHAB	DASSGN_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$EXE$K_CRETVA
	JMP	W^jgeneric


j_dassgn = . - jbase
jdassgn:
	PUSHL	R0				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	DASSGN_Desc			; cstr
	PUSHL	#2+1
	PUSHL	#BASE$EXE$K_DASSGN
	JMP	W^jgeneric


j_deq = . - jbase
jdeq:
	PUSHL	R0				; P4 - status
	PUSHL	16(AP)				; P3 - flags
	PUSHL	12(AP)				; P2 - acmode
	PUSHL	4(AP)				; P1 - lkid
	PUSHAB	DEQ_Desc			; cstr
	PUSHL	#4+1
	PUSHL	#BASE$EXE$K_DEQ
	JMP	W^jgeneric


j_enq = . - jbase
jenq:
	PUSHL	R0				; P6 - status
	PUSHL	40(AP)				; P5 - acmode
	PUSHL	20(AP)				; P4 - resnam
	PUSHL	16(AP)				; P3 - flags
	PUSHL	12(AP)				; P2 - lock status block
	PUSHL	8(AP)				; P1 - lkmode
	PUSHAB	ENQ_Desc			; cstr
	PUSHL	#6+1
	PUSHL	#BASE$EXE$K_ENQ
	JMP	W^jgeneric


j_enqw = . - jbase
jenqw:
	PUSHL	R0				; P7 - status
	PUSHL	40(AP)				; P6 - acmode
	PUSHL	20(AP)				; P5 - resnam
	PUSHL	16(AP)				; P4 - flags
	MOVL	12(AP),R1			; get lock status block
	PUSHL	4(R1)				; P3 - lk id
	MOVZWL	(R1),-(SP)			; P2 - lk status
	PUSHL	8(AP)				; P1 - lkmode
	PUSHAB	ENQW_Desc			; cstr
	PUSHL	#7+1
	PUSHL	#BASE$EXE$K_ENQW
	JMP	W^jgeneric


j_grant_license = . - jbase
jgrant_license:
	PUSHL	R0				; Status (filled in later)
	PUSHAB	GRANT_LICENSE_Desc
	PUSHL	#1+1				; Arglist count
	PUSHL	#BASE$EXE$K_GRANT_LICENSE
	JMP	W^jgeneric


j_lkwset = . - jbase
jlkwset:
	PUSHL	R0				; Status (filled in later)
	PUSHAB	LKWSET_Desc			; FAO control string
	PUSHL	#1+1				; Arglist count
	PUSHL	#BASE$EXE$K_LKWSET		; vector offset
	JMP	W^jgeneric			; call common handler


j_lookup_license = . - jbase
jlookup_license:
	PUSHL	R0				; Status (filled in later)
	PUSHAB	LOOKUP_LICENSE_Desc
	PUSHL	#1+1				; Arglist count
	PUSHL	#BASE$EXE$K_LOOKUP_LICENSE
	JMP	W^jgeneric


j_getlki = . - jbase
jgetlki:
	; Call common code
	MOVAB	jcommon,R0
	JSB	(R0)

	; Call original $GETLKI
	PUSHL	#BASE$EXE$K_GETLKI
	JSB	jsscall
	MOVL	R0,(SP)				; save the return code

	; Put a message
	PUSHL	R0				; P2 - status
	PUSHL	@8(AP)				; P1 - lkid
	PUSHAB	GETLKI_Desc			; cstr
	CALLS	#2+1,w^joutput

	; Completion
	POPL	R0				; restore $GETLKIW status code
	RET					; return to caller

j_getlkiw = . - jbase
jgetlkiw:
	; Call common code
	MOVAB	jcommon,R0
	JSB	(R0)

	; Call original $GETLKIW
	PUSHL	#BASE$EXE$K_GETLKIW
	JSB	jsscall
	MOVL	R0,(SP)				; save the return code

	; Put a message
	PUSHL	R0				; P4 - status
	MOVL	16(AP),R1			; get IOSB
	PUSHL	4(R1)				; P3 - IOSB 1
	PUSHL	(R1)				; P2 - IOSB 2
	PUSHL	@8(AP)				; P1 - lkid
	PUSHAB	GETLKIW_Desc			; cstr
	CALLS	#4+1,w^joutput

	; Completion
	POPL	R0				; restore $GETLKIW status code
	RET					; return to caller

Get_QIO_funtion_str:
	MOVAL	QIO_NULL_Str,R1
	EXTZV	#0,#6,4(SP),R0			; get the func code sans mods
	CMPB	R0,#IO$_WRITEVBLK
	BNEQ	10$
	MOVAL	QIO_WRITEVBLK_Str,R1
	RSB
10$:	CMPB	R0,#IO$_READVBLK
	BNEQ	20$
	MOVAL	QIO_READVBLK_Str,R1
	RSB
20$:	CMPB	R0,#IO$_ACPCONTROL
	BNEQ	30$
	MOVAL	QIO_ACPCONTROL_Str,R1
	RSB
30$:	CMPB	R0,#IO$_SETMODE
	BNEQ	40$
	MOVAL	QIO_SETMODE_Str,R1
	RSB
40$:	CMPB	R0,#IO$_SETCHAR
	BNEQ	50$
	MOVAL	QIO_SETCHAR_Str,R1
	RSB
50$:	CMPB	R0,#IO$_SENSEMODE
	BNEQ	60$
	MOVAL	QIO_SENSEMODE_Str,R1
	RSB
60$:	CMPB	R0,#IO$_SENSECHAR
	BNEQ	70$
	MOVAL	QIO_SENSECHAR_Str,R1
	RSB
70$:	CMPB	R0,#IO$_ACCESS
	BNEQ	80$
	MOVAL	QIO_ACCESS_Str,R1
	RSB
80$:	CMPB	R0,#IO$_DEACCESS
	BNEQ	100$
	MOVAL	QIO_DEACCESS_Str,R1
	RSB
100$:	RSB

.IF	DF,Not_defined
Print_PSI_QIO_Params:
	PUSHR	#^M<R3,R4>

	; Handle special functions
	EXTZV	#0,#6,12(AP),R4			; get the func code sans mods

480$:
	PUSHL	48(AP)				; P6
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	36(AP)				; P3
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#6				; arglist size
	PUSHAL	QIO_generic_Param_Desc		; descriptor

500$:
	POPL	R3				; Get descriptor
	MOVL	SP,R4				; Save arglist in R4

	; Get space for buffer
	SUBL	#BUFSIZE,SP	
	PUSHL	SP				; outbuf desc.pointer
	PUSHL	#BUFSIZE			; outbuf desc.size

	; Set up descriptors
	ADDL3	#8,R3,-(SP)			; Fix up the descriptor
	PUSHL	(R3)				;   for cst (copy on stack)

	MOVAL	-(SP),R3			; retlen pointer

	; Call the formatting routine
	PUSHAL	4(R4)				; Pushl arglist
	MOVAL	12(R3),-(SP)			; outbuf
	PUSHL	R3				; outlen
	MOVAL	4(R3),-(SP)			; cstr
	CALLS	#4,@#BASE$EXE$K_FAOL+^x80000000
	POPL	R3				; Get outlen
	MOVZWL	R3,R3				; Mask off high word
	ADDL	#16,SP				; pop descriptors off stack
	BLBC	R0,900$				; If failed exit error

	; Call the print routine
	PUSHL	SP				; start of buffer
	PUSHL	R3				; buffer length
	PUSHAB	QIO_PSI_Param_Desc		; cstr
	MOVAB	joutput,R0
	CALLS	#3,(R0)

900$:
	ADDL	#BUFSIZE,SP			; remove tmp buffer
	ASHL	#2,(SP)+,R1			; Arglist length in bytes
	ADDL	R1,SP				; remove arglist
	POPR	#^M<R3,R4>
	RSB


Print_UCX_QIO_Params:
	PUSHR	#^M<R3,R4>

	; Handle special functions
	EXTZV	#0,#6,12(AP),R4			; get the func code sans mods

100$:	CMPL	R4,#IO$_WRITEVBLK		; Is it a write function
	BNEQ	120$				; br if not
	PUSHL	32(AP)				; P2
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#3				; arglist size
	PUSHAL	QIO_UCX_WRITE_Param_Desc	; descriptor
	BRW	500$

120$:	CMPL	R4,#IO$_ACPCONTROL		; Is it an acpcontrol function?
	BNEQ	480$				; br if not
	PUSHL	40(AP)				; P4
	PUSHL	@36(AP)				; P3
	PUSHL	32(AP)				; P2
	MOVL	28(AP),R0			; P1
	PUSHL	@4(R0)				; P1
	PUSHL	#4				; arglist size
	PUSHAL	QIO_UCX_ACPCONTROL_Param_Desc	; descriptor
	BRW	500$

480$:
	PUSHL	48(AP)				; P6
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	36(AP)				; P3
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#6				; arglist size
	PUSHAL	QIO_generic_Param_Desc		; descriptor

500$:
	POPL	R3				; Get descriptor
	MOVL	SP,R4				; Save arglist in R4

	; Get space for buffer
	SUBL	#BUFSIZE,SP	
	PUSHL	SP				; outbuf desc.pointer
	PUSHL	#BUFSIZE			; outbuf desc.size

	; Set up descriptors
	ADDL3	#8,R3,-(SP)			; Fix up the descriptor
	PUSHL	(R3)				;   for cst (copy on stack)

	MOVAL	-(SP),R3			; retlen pointer

	; Call the formatting routine
	PUSHAL	4(R4)				; Pushl arglist
	MOVAL	12(R3),-(SP)			; outbuf
	PUSHL	R3				; outlen
	MOVAL	4(R3),-(SP)			; cstr
	CALLS	#4,@#BASE$EXE$K_FAOL+^x80000000
	POPL	R3				; Get outlen
	MOVZWL	R3,R3				; Mask off high word
	ADDL	#16,SP				; pop descriptors off stack
	BLBC	R0,900$				; If failed exit error

	; Call the print routine
	PUSHL	SP				; start of buffer
	PUSHL	R3				; buffer length
	PUSHAB	QIO_UCX_Param_Desc		; cstr
	MOVAB	joutput,R0
	CALLS	#3,(R0)

900$:
	ADDL	#BUFSIZE,SP			; remove tmp buffer
	ASHL	#2,(SP)+,R1			; Arglist length in bytes
	ADDL	R1,SP				; remove arglist
	POPR	#^M<R3,R4>
	RSB


Print_TGV_QIO_Params:
	PUSHR	#^M<R3,R4>

	; Handle special functions
	EXTZV	#0,#6,12(AP),R4			; get the func code sans mods

100$:	CMPL	R4,#IO$_WRITEVBLK	; Is it a write function?
	BNEQ	120$				; br if not
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	32(AP)				; P2
	PUSHL	32(AP)				; P2
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#6				; arglist size
	PUSHAL	QIO_TGV_WRITE_Param_Desc	; descriptor
	BRW	500$

120$:	CMPL	R4,#IO$_READVBLK		; Is it a read function?
	BNEQ	480$				; br if not
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	32(AP)				; P2
	PUSHL	32(AP)				; P2
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#6				; arglist size
	PUSHAL	QIO_TGV_READ_Param_Desc		; descriptor
	BRW	500$

480$:
	PUSHL	48(AP)				; P6
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	36(AP)				; P3
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHL	#6				; arglist size
	PUSHAL	QIO_generic_Param_Desc		; descriptor

500$:
	POPL	R3				; Get descriptor
	MOVL	SP,R4				; Save arglist in R4

	; Get space for buffer
	SUBL	#BUFSIZE,SP	
	PUSHL	SP				; outbuf desc.pointer
	PUSHL	#BUFSIZE			; outbuf desc.size

	; Set up descriptors
	ADDL3	#8,R3,-(SP)			; Fix up the descriptor
	PUSHL	(R3)				;   for cst (copy on stack)

	MOVAL	-(SP),R3			; retlen pointer

	; Call the formatting routine
	PUSHAL	4(R4)				; Pushl arglist
	MOVAL	12(R3),-(SP)			; outbuf
	PUSHL	R3				; outlen
	MOVAL	4(R3),-(SP)			; cstr
	CALLS	#4,@#BASE$EXE$K_FAOL+^x80000000
	POPL	R3				; Get outlen
	MOVZWL	R3,R3				; Mask off high word
	ADDL	#16,SP				; pop descriptors off stack
	BLBC	R0,900$				; If failed exit error

	; Call the print routine
	PUSHL	SP				; start of buffer
	PUSHL	R3				; buffer length
	PUSHAB	QIO_TGV_Param_Desc		; cstr
	MOVAB	joutput,R0
	CALLS	#3,(R0)

900$:
	ADDL	#BUFSIZE,SP			; remove tmp buffer
	ASHL	#2,(SP)+,R1			; Arglist length in bytes
	ADDL	R1,SP				; remove arglist
	POPR	#^M<R3,R4>
	RSB
.ENDC

Print_DEFAULT_QIO_Params:
	PUSHL	48(AP)				; P6
	PUSHL	44(AP)				; P5
	PUSHL	40(AP)				; P4
	PUSHL	36(AP)				; P3
	PUSHL	32(AP)				; P2
	PUSHL	28(AP)				; P1
	PUSHAB	QIO_Param_Desc			; cstr
	CALLS	#7,w^joutput
	RSB

Print_QIO_Params:
	CMPL	j_param_qio_style(R9),#JASMON_K_DEFAULT
	BNEQ	10$
	JMP	W^Print_DEFAULT_QIO_Params
10$:	CMPL	j_param_qio_style(R9),#JASMON_K_NULL
	BNEQ	20$
	RSB
;	JMP	W^Print_NULL_QIO_Params

20$:
.IF	DF,Not_Defined
	CMPL	j_param_qio_style(R9),#JASMON_K_TGV
	BNEQ	30$
	JMP	W^Print_TGV_QIO_Params
30$:	CMPL	j_param_qio_style(R9),#JASMON_K_UCX
	BNEQ	40$
	JMP	W^Print_UCX_QIO_Params
40$:	CMPL	j_param_qio_style(R9),#JASMON_K_PSI
	BNEQ	50$
	JMP	W^Print_PSI_QIO_Params
.ENDC

50$:	RSB

j_qio = . - jbase
jqio:
	; Call common code
	JSB	w^jcommon

	; Call original QIO
	PUSHL	#BASE$EXE$K_QIO			; push offset
	JSB	jsscall				; do it
	MOVL	R0,(SP)				; save the return code

	; Get a pointer to the jasmon database
	MOVAB	jbase,R9

	; Find this channel's DDB
	PUSHL	8(AP)				; pass channel number
	PUSHL	#1				; pass number of args
	PUSHL	SP				; push arg list
	PUSHAL	j_supp_GetDDB(R9)		; push routine to call
	CALLS	#2,@#BASE$EXE$K_CMKRNL+^x80000000	; Call kernel CMKRNL
	ADDL	#8,SP				; remove arg list

	; Get the target DDB and compare it
	MOVL	j_param_qio(R9),R1		; Get DDB filter
	BEQL	100$				; leave if no DDB filter
	CMPL	R1,R0				; same DDB?
	BNEQ	100$				; leave if wrong DDB filter

	; Pick an ASCIC string (maybe null) to describe function
	PUSHL	12(AP)				; push function code
	JSB	Get_QIO_funtion_str		; Put ASCIC string in R1
	POPL	R0				; restore stack

	; restore QIO status, but leave it on the stack
	MOVL	(SP),R0

	; Put a message
	PUSHL	R0				; P4
	PUSHL	R1				; P3
	PUSHL	12(AP)				; P2
	PUSHL	8(AP)				; P1
	PUSHAB	QIO_Desc			; cstr
	MOVAB	joutput,R0
	CALLS	#4,(R0)

	; Print the parameters on another line (for clarity)
	JSB	Print_QIO_Params

	; Completion
100$:	POPL	R0				; restore QIO status code
110$:	RET					; return to caller


j_qiow = . - jbase
jqiow:
	; Call common code
	JSB	w^jcommon

	; Call original QIOW
	PUSHL	#BASE$EXE$K_QIOW		; push offset
	JSB	jsscall				; do it
	MOVL	R0,(SP)				; save the return code

	; Get a pointer to the jasmon database
	MOVAB	jbase,R9

	; Find this channel's DDB
	PUSHL	8(AP)				; pass channel number
	PUSHL	#1				; pass number of args
	PUSHL	SP				; push arg list
	PUSHAL	j_supp_GetDDB(R9)		; push routine to call
	CALLS	#2,@#BASE$EXE$K_CMKRNL+^x80000000	; Call kernel CMKRNL
	ADDL	#8,SP				; remove arg list

	; Get the target DDB and compare it
	MOVL	j_param_qio(R9),R1		; MOVA for self relative...
	BEQL	100$				; leave if no DDB filter
	CMPL	R1,R0				; same DDB?
	BNEQ	100$				; leave if wrong DDB filter

	; restore QIOW status, but leave it on the stack
	MOVL	(SP),R0

	; Put a message
	TSTL	16(AP)				; check IOSB address
	BEQL	10$				; br if no IOSB
	PUSHQ	@16(AP)				; push the IOSB
	BRB	12$				; continue
10$:	CLRQ	-(SP)				; push zeros
12$:	PUSHL	R0				; P4

	; Pick an ASCIC string (maybe null) to describe function
	PUSHL	12(AP)				; push function code
	JSB	Get_QIO_funtion_str		; Put ASCIC string in R1
	POPL	R0				; restore stack
	PUSHL	R1				; P3

	PUSHL	12(AP)				; P2
	PUSHL	8(AP)				; P1
	PUSHAB	QIOW_Desc			; cstr
	MOVAB	joutput,R0
	CALLS	#7,(R0)

	; Print the parameters on another line (for clarity)
	JSB	Print_QIO_Params

	; Completion
100$:	POPL	R0				; restore $QIOW status code
110$:	RET					; return to caller


j_release_license = . - jbase
jrelease_license:
	PUSHL	R0				; Status (filled in later)
	PUSHAB	RELEASE_LICENSE_Desc
	PUSHL	#1+1				; Arglist count
	PUSHL	#BASE$EXE$K_RELEASE_LICENSE
	JMP	W^jgeneric


Get_Page_Prot_str:
	MOVL	4(SP),R0			; Null pointer?
	BNEQ	10$				; br if yes
	MOVAL	NULL_Str,R1			; Get string table
	BRB	100$

10$:	EXTZV	#0,#4,(R0),R0			; get the low four bits
	MOVAL	Prot_Tab,R1			; Get string table
	SUBL	(R1)[R0],R1
100$:	RSB

j_setprt = . - jbase
jsetprt:
	; Call common code
	MOVAB	jcommon,R0
	JSB	(R0)

	; Call original SETPRT
	PUSHL	#BASE$EXE$K_SETPRT
	JSB	jsscall
	MOVL	R0,(SP)				; save the return code

	; Put a message
	PUSHL	R0				; P6 - Status

	; Pick an ASCIC string (maybe null) to describe protection
	PUSHL	20(AP)				; push protection code
	JSB	Get_Page_Prot_str		; Put ASCIC string in R1
	POPL	R0				; restore stack
	PUSHL	R1				; P5

	; Pick an ASCIC string (maybe null) to describe protection
	PUSHAL	16(AP)				; push protection code
	JSB	Get_Page_Prot_str		; Put ASCIC string in R1
	POPL	R0				; restore stack
	PUSHL	R1				; P5

	PUSHL	12(AP)				; P3 - Access mode
	MOVL	4(AP),R0			; Get INADR
	PUSHL	4(R0)				; P2
	PUSHL	(R0)				; P1
	PUSHAB	SETPRT_Desc			; cstr
	MOVAB	joutput,R0
	CALLS	#7,(R0)

	; Completion
100$:	POPL	R0				; restore $SETPRT status code
110$:	RET					; return to caller


j_setprv = . - jbase
jsetprv:
	PUSHL	R0				; Status (placeholder)
	PUSHL	16(AP)				; P4
	PUSHL	12(AP)				; P3
	PUSHL	8(AP)				; P2
	PUSHL	4(AP)				; P1
	PUSHAB	SETPRV_Desc			; cstr
	PUSHL	#5+1
	PUSHL	#BASE$EXE$K_SETPRV
	JMP	W^jgeneric


j_setime = . - jbase
jsetime:
	PUSHL	R0				; P3
	PUSHL	12(AP)				; P2
	PUSHL	8(AP)				; P1
	PUSHAB	SETIME_Desc			; cstr
	PUSHL	#3+1
	PUSHL	#BASE$EXE$K_SETIME
	JMP	W^jgeneric


j_trnlnm = . - jbase
jtrnlnm:
	PUSHL	R0				; P3
	PUSHL	12(AP)				; P2
	PUSHL	8(AP)				; P1
	PUSHAB	TRNLNM_Desc			; cstr
	PUSHL	#3+1
	PUSHL	#BASE$EXE$K_TRNLNM
	JMP	W^jgeneric


j_generic = . - jbase
jgeneric:
	; Call common code
	MOVAB	jcommon,R0
	JSB	(R0)

	; Call original system service
	JSB	jsscall
	MOVL	R0,(SP)				; save the return code

	; Fix-up the status code
	MOVL	4(SP),R0			; Arglist count
	MOVL	(SP),4(SP)[R0]			; put status in last arg slot

	; Put a message
	MOVAB	joutput,R0
	CALLG	4(SP),(R0)

	; Completion
100$:	POPL	R0				; restore $TRNLNM status code
110$:	RET					; return to caller

CR = 10
LF = 13

OutDesc:
	.ASCID	/SYS$OUTPUT/

; !!!WARNING!!!  .ASCID values are not valid after being copied to
;		 P1 space.  They must be fixed up.

;
; System service descriptions
;
RMS_CLOSE_Desc:
	.ASCID	<CR><LF>"*** RMS$CLOSE (!XL,!XL,!XL) => !XL ***"<LF>

RMS_CREATE_Desc:
	.ASCID	<CR><LF>"*** RMS$CREATE (!XL,!XL,!XL) => !XL ***"<LF>

RMS_CONNECT_Desc:
	.ASCID	<CR><LF>"*** RMS$CONNECT (!XL,!XL,!XL) => !XL ***"<LF>

RMS_DELETE_Desc:
	.ASCID	<CR><LF>"*** RMS$DELETE (!XL,!XL,!XL) => !XL ***"<LF>

RMS_FLUSH_Desc:
	.ASCID	<CR><LF>"*** RMS$FLUSH (!XL,!XL,!XL) => !XL ***"<LF>

RMS_GET_Desc:
	.ASCID	<CR><LF>"*** RMS$GET (!XL,!XL,!XL) => !XL ***"<LF>

RMS_OPEN_Desc:
	.ASCID	<CR><LF>"*** RMS$OPEN (!XL,!XL,!XL) => !XL ***"<LF>

RMS_PUT_Desc:
	.ASCID	<CR><LF>"*** RMS$PUT (!XL,!XL,!XL) => !XL ***"<LF>

;
; System service descriptions
;
ASSIGN_Desc:
	.ASCID	<CR><LF>"*** $ASSIGN (!AS,?,!XB,?) => !XL (!XW) ***"<LF>

CANCEL_Desc:
	.ASCID	<CR><LF>"*** $CANCEL (!XW) => !XL ***"<LF>

CANEXH_Desc:
	.ASCID	<CR><LF>"*** $CANEXH (!XL) => !XL ***"<LF>

CANTIM_Desc:
	.ASCID	<CR><LF>"*** $CANTIM (!XL,!XL) => !XL ***"<LF>

CANWAK_Desc:
	.ASCID	<CR><LF>"*** $CANWAK (!XL,!XL) => !XL ***"<LF>

CHECK_ACCESS_Desc:
	.ASCID	<CR><LF>"*** $CHECK_ACCESS (!SL,!AS,!AS,!XL) => !XL ***"<LF>

CHKPRO_Desc:
	.ASCID	<CR><LF>"*** $CHKPRO (!XL) => !XL ***"<LF>

CRETVA_Desc:
	.ASCID	<CR><LF>"*** $CRETVA ([!XL,!XL],?,!XB) => !XL ***"<LF>

DASSGN_Desc:
	.ASCID	<CR><LF>"*** $DASSGN (!XW) => !XL ***"<LF>

DEQ_Desc:
	.ASCID	<CR><LF>"*** $DEQ (!XL,?,!XB,!XL) => !XL ***"<LF>

ENQ_Desc:
	.ASCID	<CR><LF>"*** $ENQ (?,!XW,!XL,!XL,!AD,?, ?,?,?,!XB,?) => !XL ***"<LF>

ENQW_Desc:
	.ASCID	<CR><LF>"*** $ENQ (?,!XW,!XL,!XL,!AD,?, ?,?,?,!XB,?) => !XL ***"<LF>

GETLKI_Desc:
	.ASCID	<CR><LF>"*** $GETLKI (?,!XL,?,?, ?,?,?) => !XL ***"<LF>

GETLKIW_Desc:
	.ASCID	<CR><LF>"*** $GETLKIW (?,!XL,?,(!XL,!XL), ?,?,?) => !XL ***"<LF>

GRANT_LICENSE_Desc:
	.ASCID	<CR><LF>"*** $GRANT_LICENSE (?...) ==> !XL ***"<LF>

LKWSET_Desc:
	.ASCID	<CR><LF>"*** $LKWSET (?...) ==> !XL ***"<LF>

LOOKUP_LICENSE_Desc:
	.ASCID	<CR><LF>"*** $LOOKUP_LICENSE (?...) ==> !XL ***"<LF>

QIO_Desc:
	.ASCID	<CR><LF>"*** $QIO (?,!XW,!XW!AC,?,?,?,...) ==> !XL ***"<LF>

QIOW_Desc:
	.ASCID	<CR><LF>"*** $QIOW (?,!XW,!XW!AC,?,?,?,...) ==> !XL (!XL,!XL) ***"<LF>

QIO_Param_Desc:
	.ASCID	<CR><LF>"*** QIO Params = [!XL,!XL,!XL,!XL,!XL,!XL] ***"<LF>

QIO_generic_Param_Desc:
	.ASCID	"!XL,!XL,!XL,!XL,!XL,!XL"

QIO_TGV_Param_Desc:
	.ASCID	<CR><LF>"*** INET Params = [!AD] ***"<LF>

QIO_TGV_WRITE_Param_Desc:
	.ASCID	"!XL,!XW(!UW),!XL,!XL,!XW,0"

QIO_TGV_READ_Param_Desc:
	.ASCID	"!XL,!XW(!UW),!XL,!XL,!XW,0"

QIO_UCX_Param_Desc:
	.ASCID	<CR><LF>"*** UCX Params = [!AD] ***"<LF>

QIO_UCX_WRITE_Param_Desc:
	.ASCID	"!XL,!XW(!UW)"

QIO_UCX_ACPCONTROL_Param_Desc:
	.ASCID	"!XL,!AS,!XL,!XL"

QIO_PSI_Param_Desc:
	.ASCID	<CR><LF>"*** PSI Params = [!AD] ***"<LF>

RELEASE_LICENSE_Desc:
	.ASCID	<CR><LF>"*** $RELEASE_LICENSE () ==> !XL ***"<LF>

SETIME_Desc:
	.ASCID	<CR><LF>"*** $SETIME (!XL,!XL) ==> !XL ***"<LF>

SETPRT_Desc:
	.ASCID	<CR><LF>"*** $SETPRT ([!XL,!XL],?,!XB,!AC,(!AC)) ==> !XL ***"<LF>

SETPRV_Desc:
	.ASCID	<CR><LF>"*** $SETPRV (!XL,!XL,!XL,!XL) ==> !XL ***"<LF>

TRNLNM_Desc:
	.ASCID	<CR><LF>"*** $TRNLNM (?,!AS,!AS,?,?) => !XL ***"<LF>


;
;	Miscellaneous strings
;
Null_Str:	.ASCIC "-"

;
;	Page protection names
;

PRT_NA_Str:	.ASCIC "NA"
PRT_RESRV_Str:	.ASCIC "RESRV"
PRT_KW_Str:	.ASCIC "KW"
PRT_KR_Str:	.ASCIC "KR"
PRT_UW_Str:	.ASCIC "UW"
PRT_EW_Str:	.ASCIC "EW"
PRT_ERKW_Str:	.ASCIC "ERKW"
PRT_ER_Str:	.ASCIC "ER"
PRT_SW_Str:	.ASCIC "SW"
PRT_SREW_Str:	.ASCIC "SREW"
PRT_SRKW_Str:	.ASCIC "SRKW"
PRT_SR_Str:	.ASCIC "SR"
PRT_URSW_Str:	.ASCIC "URSW"
PRT_UREW_Str:	.ASCIC "UREW"
PRT_URKW_Str:	.ASCIC "URKW"
PRT_UR_Str:	.ASCIC "UR"

.ALIGN LONG
Prot_Tab:
	.LONG	Prot_Tab - PRT_NA_Str
	.LONG	Prot_Tab - PRT_RESRV_Str
	.LONG	Prot_Tab - PRT_KW_Str
	.LONG	Prot_Tab - PRT_KR_Str
	.LONG	Prot_Tab - PRT_UW_Str
	.LONG	Prot_Tab - PRT_EW_Str
	.LONG	Prot_Tab - PRT_ERKW_Str
	.LONG	Prot_Tab - PRT_ER_Str
	.LONG	Prot_Tab - PRT_SW_Str
	.LONG	Prot_Tab - PRT_SREW_Str
	.LONG	Prot_Tab - PRT_SRKW_Str
	.LONG	Prot_Tab - PRT_SR_Str
	.LONG	Prot_Tab - PRT_URSW_Str
	.LONG	Prot_Tab - PRT_UREW_Str
	.LONG	Prot_Tab - PRT_URKW_Str
	.LONG	Prot_Tab - PRT_UR_Str

;
;	QIO functions
;

QIO_NULL_Str:
	.ASCIC ""
QIO_WRITEVBLK_Str:
	.ASCIC "(WRITEVBLK)"
QIO_READVBLK_Str:
	.ASCIC "(READVBLK)"
QIO_ACPCONTROL_Str:
	.ASCIC "(ACPCONTROL)"
QIO_SETCHAR_Str:
	.ASCIC "(SETCHAR)"
QIO_SETMODE_Str:
	.ASCIC "(SETMODE)"
QIO_SENSECHAR_Str:
	.ASCIC "(SENSECHAR)"
QIO_SENSEMODE_Str:
	.ASCIC "(SENSEMODE)"
QIO_ACCESS_Str:
	.ASCIC "(ACCESS)"
QIO_DEACCESS_Str:
	.ASCIC "(DEACCESS)"

jlen = . - jbase


.PSECT


SS_ASSIGN_Str:	.ASCID "ASSIGN"
SS_CANCEL_Str:	.ASCID "CANCEL"
SS_CANEXH_Str:	.ASCID "CANEXH"
SS_CANTIM_Str:	.ASCID "CANTIM"
SS_CANWAK_Str:	.ASCID "CANWAK"
SS_CHKPRO_Str:	.ASCID "CHKPRO"
SS_CRETVA_Str:	.ASCID "CRETVA"
SS_DASSGN_Str:	.ASCID "DASSGN"
SS_DEQ_Str:	.ASCID "DEQ"
SS_ENQ_Str:	.ASCID "ENQ"
SS_ENQW_Str:	.ASCID "ENQW"
SS_GETLKI_Str:	.ASCID "GETLKI"
SS_GETLKIW_Str:	.ASCID "GETLKIW"
SS_GRANT_LICENSE_Str:	.ASCID "GRANT_LICENSE"
SS_LKWSET_Str:	.ASCID "LKWSET"
SS_LOOKUP_LICENSE_Str:	.ASCID "LOOKUP_LICENSE"
SS_QIO_Str:	.ASCID "QIO"
SS_QIOW_Str:	.ASCID "QIOW"
SS_RELEASE_LICENSE_Str:	.ASCID "RELEASE_LICENSE"
SS_SETIME_Str:	.ASCID "SETIME"
SS_SETPRT_Str:	.ASCID "SETPRT"
SS_TRNLNM_Str:	.ASCID "TRNLNM"

RMS_CLOSE_Str:	.ASCID "CLOSE"
RMS_CONNECT_Str:.ASCID "CONNECT"
RMS_CREATE_Str:	.ASCID "CREATE"
RMS_DELETE_Str:	.ASCID "DELETE"
RMS_FLUSH_Str:	.ASCID "FLUSH"
RMS_GET_Str:	.ASCID "GET"
RMS_OPEN_Str:	.ASCID "OPEN"
RMS_PUT_Str:	.ASCID "PUT"


Service_Table:
	.LONG	SS_ASSIGN_Str,j_assign,BASE$EXE$K_ASSIGN,0
	.LONG	SS_CANCEL_Str,j_cancel,BASE$EXE$K_CANCEL,0
	.LONG	SS_CANEXH_Str,j_canexh,BASE$EXE$K_CANEXH,0
	.LONG	SS_CANTIM_Str,j_cantim,BASE$EXE$K_CANTIM,0
	.LONG	SS_CANWAK_Str,j_canwak,BASE$EXE$K_CANWAK,0
	.LONG	SS_CHKPRO_Str,j_chkpro,BASE$EXE$K_CHKPRO,0
	.LONG	SS_CRETVA_Str,j_cretva,BASE$EXE$K_CRETVA,0
	.LONG	SS_DASSGN_Str,j_dassgn,BASE$EXE$K_DASSGN,0
	.LONG	SS_DEQ_Str,j_deq,BASE$EXE$K_DEQ,0
	.LONG	SS_ENQ_Str,j_enq,BASE$EXE$K_ENQ,0
	.LONG	SS_ENQW_Str,j_enqw,BASE$EXE$K_ENQW,0
	.LONG	SS_GETLKI_Str,j_getlki,BASE$EXE$K_GETLKI,0
	.LONG	SS_GETLKIW_Str,j_getlkiw,BASE$EXE$K_GETLKIW,0
	.LONG	SS_GRANT_LICENSE_Str,j_grant_license,BASE$EXE$K_GRANT_LICENSE,0
	.LONG	SS_LKWSET_Str,j_lkwset,BASE$EXE$K_LKWSET,0
	.LONG	SS_LOOKUP_LICENSE_Str,j_lookup_license,BASE$EXE$K_LOOKUP_LICENSE,0
	.LONG	SS_QIO_Str,j_qio,BASE$EXE$K_QIO,0
	.LONG	SS_QIOW_Str,j_qiow,BASE$EXE$K_QIOW,0
	.LONG	SS_RELEASE_LICENSE_Str,j_release_license,BASE$EXE$K_RELEASE_LICENSE,0
	.LONG	SS_SETIME_Str,j_setime,BASE$EXE$K_SETIME,0
	.LONG	SS_SETPRT_Str,j_setprt,BASE$EXE$K_SETPRT,0
	.LONG	SS_TRNLNM_Str,j_trnlnm,BASE$EXE$K_TRNLNM,0

	.LONG	RMS_CLOSE_Str,j_rms_close,BASE$RMS$K_CLOSE,0
	.LONG	RMS_CONNECT_Str,j_rms_connect,BASE$RMS$K_CONNECT,0
	.LONG	RMS_CREATE_Str,j_rms_create,BASE$RMS$K_CREATE,0
	.LONG	RMS_DELETE_Str,j_rms_delete,BASE$RMS$K_DELETE,0
	.LONG	RMS_FLUSH_Str,j_rms_flush,BASE$RMS$K_FLUSH,0
	.LONG	RMS_GET_Str,j_rms_get,BASE$RMS$K_GET,0
	.LONG	RMS_OPEN_Str,j_rms_open,BASE$RMS$K_OPEN,0
	.LONG	RMS_PUT_Str,j_rms_put,BASE$RMS$K_PUT,0
	.LONG	0,0,0,0


;++
;
; Input:
;	4(AP) - String descriptor (read)
;	8(AP) - addr of vector offset (write)
;	12(AP) - addr of code offset (write)
;
;--

.entry str2indx,^M<R2,R3>
	; Setup pointer
	MOVAL	Service_Table,R2
10$:		
	; Get string
	CLRL	R0				; Assume failure
	MOVL	(R2),R3				; get string from table
	BEQL	100$				; br if end of table

	PUSHL	4(AP)				; Push user's string
	PUSHL	R3				; Push string from table
	CALLS	#2,G^STR$CASE_BLIND_COMPARE	; Compare strings
	TSTL	R0				; check for a match
	BNEQ	90$				; br if no match
	MOVL	8(R2),@8(AP)			; Store vector offset
	MOVL	4(R2),@12(AP)			; Store code offset
	MOVL	#1,R0				; return 1 for success
	BRB	100$				; Break out of loop
90$:
	ADDL	#4*4,R2				; Point to next entry
	BRB	10$				; Goto top of loop
100$:
	RET


;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	P1 allocation routines
;
;	We allocate an extra page on either side so that we can
;	modify the protection and not affect other areas.
;---------------------------------------------------------------------

; Note: R1-R3 destroyed for both routines.

Get_P1_Pages:
	; # of pages is in R1.  Add two pages and convert to byte length.
	ADDL	#2,R1
	ASHL	#9,R1,R1
	JSB	G^EXE$ALOP1PROC			; Attempt allocation
	ADDL	#512,R2				; indent one page
	BLBC	R0,10$				; If failed exit error	

	; Align on page boundary
;	ADDL	#511,R2
;	BIC	#511,R2

	; Page start in R2; Status in R0.
10$:	RSB

Free_P1_Pages:
	; Backup one page length
	SUBL	#512,R0
	; # of pages is in R1.  Add two pages and convert to byte length.
	ADDL	#2,R1
	ASHL	#9,R1,R1
	JSB	G^EXE$DEAP1			; Attempt deallocation
10$:	RSB

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Loader routine
;---------------------------------------------------------------------

.entry	JASMON_Exec_Load,^m<r2,r3,r4,r5,r7>
	MOVL	#jlen,R1			; Control block size
	jsb	g^exe$alop1proc			; Attempt allocation
	blbs	r0,5$				; If failed
	BRW	100$				;    exit error
5$:	movl	r2,r7				; Save pointer to it
	MOVL	r7,@4(AP)			; return it to the caller
	movc3	#jlen,jbase,(r7)		; Put code in allocated region
	MOVL	#jlen,j_data_size(R7)		; store size
	CLRL	j_data_orig(R7)			; zero the pointer
	CLRL	j_data_chan(R7)			; zero the pointer

	MOVL	#Stat_Pages,R1
	JSB	Get_P1_Pages
	MOVL	R2,j_data_stats(R7)
	CLRL	(R2)				; Zero call counter

	; Fixup the page protection (make 'em look real)
	MOVL	R2,OldVA
	ADDL3	#Stat_Length-1,R2,OldVA+4
	PUSHL	#0
	PUSHL	#PRT$C_UW		; User read, user write
	PUSHL	#PSL$C_KERNEL		; map kmode pages
	PUSHL	#NewVA			;  ...
	PUSHL	#OldVA			; onto P1 sys vectors
	CALLS	#5,g^SYS$SETPRT

20$:	; Assign a channel
	PUSHL	#0				; mbxnam
	PUSHL	#PSL$C_USER			; acmode
	MOVAL	j_data_chan(R7),-(SP)		; chan ptr
	PUSHL	#OutDesc			; devnam
	CALLS	#4,G^SYS$ASSIGN			; Assign a channel
	BLBC	R0,100$				; If failed exit error
	
	MOVL	j_data_chan(R7),R0
        JSB     G^IOC$VerifyChan                ;Verify the I/O Channel
	BLBC	R0,100$				; If failed exit error

	MOVB	#PSL$C_EXEC+1,CCB$B_AMOD(R1)	; Set acmode to EXEC.

100$:	ret					; Return to main code

;++
;	Unloader routine
;
; Input:
;	4(AP) - database address
;
; Output:
;	R0 - Status
;--

.entry	JASMON_Exec_Unload,^m<r2,r3,r4,r5,r7>
	MOVL	4(AP),R7		; Get database address

	; Get statistics pages from the database
	MOVL	j_data_stats(R7),R0	; Get pointer to stats
	BEQL	20$			; No stats
	MOVL	#Stat_Pages,R1
	JSB	Free_P1_Pages

	; Make channel accessable
	MOVZWL	j_data_chan(R7),R5		; get channel
	MNEGL	R5,R1				; get negative offset
	MOVL	G^CTL$GL_CCBBASE,R2		; get CCB vector high address
	MOVAB	(R2)[R1],R3			; get CCB
	MOVB	#PSL$C_USER+1,CCB$B_AMOD(R3)	; Set acmode to USER.

	; Deassign the channel
	PUSHL	R5				; chan
	CALLS	#1,@#BASE$EXE$K_DASSGN+^x80000000

20$:	MOVL	R7,R0
	MOVL	j_data_size(R7),R1		; Control block size
	JSB	G^EXE$DEAP1			; Attempt deallocation

100$:
	MOVL	#SS$_NORMAL,R0
	RET					; Return to main code

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Replace the P1 system service vector
;---------------------------------------------------------------------

.entry	JASMON_replace_P1_vector,^m<R2,R3,R4,R5,R6,R7>

	; Allocate new pages in P1 space to hold old vector
	MOVL	4(AP),R0			; Get database address
	MOVL	#SSV_Length+1024,R1	; Space for old vect + 512 on sides
	jsb	g^exe$alop1proc		; Attempt allocation
	blbs	r0,10$			; If failed exit error
	BRW	110$			;
10$:	ADDL3	#512,R2,R6		; Start of data area
	MOVL	4(AP),R2		; Get database address
	MOVL	R6,j_data_orig(R2)	; Save pointer to saved vector
	MOVL	R6,OldVA		; set starting VA
	ADDL3	#SSV_Length-1,R6,OldVA+4; set starting VA

	; Lock the new pages.
	PUSHL	#PSL$C_KERNEL		; map kmode pages
	PUSHL	#NewVA			;  ...
	PUSHL	#OldVA			; onto P1 sys vectors
	CALLS	#3,G^SYS$LKWSET		; do it
	blbs	r0,30$			; If failed exit error
	BRW	100$			;

30$:	; Fixup the page protection (make 'em look real)
	PUSHL	#0
	PUSHL	#PRT$C_URKW		; User read, kernel write
	PUSHL	#PSL$C_KERNEL		; map kmode pages
	PUSHL	#NewVA			;  ...
	PUSHL	#OldVA			; onto P1 sys vectors
	CALLS	#5,G^SYS$SETPRT
	blbs	r0,40$			; If failed exit error
	BRW	100$			;

	; Synch
40$:	DSBINT	IPL=#IPL$_ASTDEL, DST=R7, ENVIRON=UNIPROCESSOR

	; Copy original SS vectors to storage buffer
	MOVL	#P1SYSVECTORS,R2
	MOVC3	#SSV_Length,(R2),(r6)		; Copy (kills R1-R5)

	; Set up pointers bounding the P1 syssrv vectors
	MOVL	#P1SYSVECTORS,OldVA		; starting address
	ADDL3	#SSV_Length-1,OldVA,OldVA+4	; ending address

	; Re-Map the p1sysvectors so we don't share w/ everyone else.
	; We want to do a CRETVA (Create Virtual Address) but it would
	; screw with the vector table and will fail on return.  So we
	; simply vector through the S0 table.
	PUSHL	#PSL$C_KERNEL			; map kmode pages
	PUSHL	#NewVA				;  ...
	PUSHL	#OldVA				; onto P1 sys vectors
	CALLS	#3,@#BASE$EXE$K_CRETVA+^x80000000
	blbc	r0,100$				; If failed exit error

	; Lock in the new pages.
	PUSHL	#PSL$C_KERNEL			; map kmode pages
	PUSHL	#NewVA				;  ...
	PUSHL	#OldVA				; onto P1 sys vectors
	CALLS	#3,@#BASE$EXE$K_LKWSET+^x80000000
	; If we fail here, there's not much we can do...

	; Fixup the page protection (make 'em look real)
	PUSHL	#0
	PUSHL	#PRT$C_URKW			; User read, kernel write
	PUSHL	#PSL$C_KERNEL			; map kmode pages
	PUSHL	#NewVA				;  ...
	PUSHL	#OldVA				; onto P1 sys vectors
	CALLS	#5,@#BASE$EXE$K_SETPRT+^x80000000
	; If we fail here, there's not much we can do...

	; Copy original SS vector into our spiffy new pages
;	MOVL	#P1SYSVECTORS,R2
	MOVC3	#SSV_Length,(R6),P1SYSVECTORS	; Copy (kills R1-R5)

	; Patch the $RUNDWN system service (so we clean our asses up)
; HACK - How should we synchronize this?
	MOVL	#P1SYSVECTORS+BASE$EXE$K_RUNDWN+2,R0	; Find current vector
	MOVW	#^X9f17,(R0)+		; JMP opcode and abs. addr mode.
	MOVL	4(AP),(R0)		; JMP destination
	ADDL	#j_rundown,(R0)		;   is the replacement code

	MOVL	#SS$_NORMAL,R0

	; Unlock (enable kmode ASTs)
100$:	ENBINT  SRC=R7
110$:	RET

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Restore the P1 system service vector
;---------------------------------------------------------------------

.entry	JASMON_restore_P1_vector,^m<R2,R3,R4,R5,R6,R7>

	; Synch
10$:	DSBINT	IPL=#IPL$_ASTDEL, DST=R7, ENVIRON=UNIPROCESSOR

	; Get saved P1 vector from the database
	MOVL	4(AP),R0		; Get database address
	MOVL	j_data_orig(R0),R6	; Get pointer to saved vector
	BNEQ	20$
	MOVL	#SS$_ACCVIO,R0
	BRW	100$

20$:	; Copy original SS vector back into our replacement pages
	MOVL	#P1SYSVECTORS,R2
	MOVC3	#SSV_Length,(R6),(R2)		; Copy (kills R1-R5)

	MOVL	#SSV_Length+1024,R1	; Space for old vect + 512 on sides
	SUBL3	#512,R6,R0		; Start of data area
	JSB	G^EXE$DEAP1		; Attempt deallocation

	MOVL	#SS$_NORMAL,R0		; EXE$DEAP1 returns nothing...
	; Unlock (enable kmode ASTs)
100$:	ENBINT  SRC=R7
	RET



;++
;	Get_Database - Return database address
;
; Note:  We prevent JASMON from being loaded twice by defining a logical.
;   We also use the local to store the address of the JASMON database (code).
;   This is ugly.  I mean, really ugly.  We're talking butt ugly.  And
;   to make matters worse, I don't think we're even doing that right.
;
; Input:
;	4(AP) - address of longword in which to place database address
;
; Output:
;	R0 - Status
;	@4(AP) - Address of database
;--

Load_transient_str:	.ASCID  /Loading database at !XL/
Load_success_str:	.ASCID  /Loaded database/
Load_error_str:		.ASCID  /Error loading database: !XL/

Unload_transient_str:	.ASCID  /Unloading database from !XL/
Unload_success_str:	.ASCID  /Unloaded database/
Unload_error_str:	.ASCID  /Error unloading database: !XL/


.entry	JASMON_Load,^m<R2,R3,R4,R5>
	CLRL	-(SP)				; space for address
	PUSHL	SP				; ptr to database addr
	PUSHL	#1				; arglist size
	PUSHL	SP				; Push ptr to arglist
	PUSHAB	JASMON_Exec_Load		; Get routine to call
	CALLS	#2,G^SYS$CMKRNL			; Call it in kernel mode
	BLBC	R0,100$				; br on error
	POPQ	R0				; Get rid of Arglist

	; Print informational message
	PUSHL	(SP)
	PUSHAB	Load_transient_str
	CALLS	#2,Print_String

	PUSHL	#1				; make new arglist
	PUSHL	SP				; push its address
	PUSHAB	JASMON_replace_P1_vector	; Get routine to call
	CALLS	#2,G^SYS$CMKRNL			; Call it in kernel mode
	BLBC	R0,100$				; br on error
; HACK - Shouldn't we unload the database if replace_P1_vector fails?
	MOVL	4(SP),(SP)			; duplicate database addr
	CALLS	#1,Set_Database			; Set logical name
	POPL	@4(AP)				; set return value

	; Print success message
	PUSHAB	Load_success_str
	CALLS	#1,Print_String

100$:	RET

110$:	PUSHL	R0
	PUSHAB	Load_error_str
	CALLS	#2,Print_String
	BRB	100$
	
.entry	JASMON_Unload,^m<R2,R3,R4,R5>
	; Find database
	CLRL	-(SP)
	PUSHL	SP
	CALLS	#1,Get_Database
	BLBC	R0,110$

	; Print informational message
	PUSHL	(SP)
	PUSHAB	Unload_transient_str
	CALLS	#2,Print_String

	; Attempt to unload JASMON
	PUSHL	#1				; arglist size
	PUSHL	SP				; Push ptr to arglist
	PUSHAB	JASMON_restore_P1_vector	; Get routine to call
	CALLS	#2,G^SYS$CMKRNL			; Call it in kernel mode
	BLBC	R0,110$				; br on error
; HACK - Shouldn't we unload the database if replace_P1_vector fails?
	POPL	R0				; Get rid of Arglist count

	; Print informational message
	PUSHL	(SP)
	PUSHAB	Unload_transient_str
	CALLS	#2,Print_String

	PUSHL	#1				; make new arglist
	PUSHL	SP				; push its address
	PUSHAB	JASMON_Exec_Unload		; Get routine to call
	CALLS	#2,G^SYS$CMKRNL			; Call it in kernel mode
	BLBC	R0,110$				; br on error
	POPQ	R0				; clean off stack

	; Print success message
	PUSHAB	Unload_success_str
	CALLS	#1,Print_String

	; Clear database logical name
	CLRL	-(SP)
	CALLS	#1,Set_Database
	BLBC	R0,110$
100$:	RET

110$:
	PUSHL	R0
	PUSHAB	Unload_error_str
	CALLS	#2,Print_String
	BRB	100$


;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Restore a system service dispatcher
;---------------------------------------------------------------------

.entry Unset_Vector,^M<R7>
	;	4(AP) = database address
	;	8(AP) = vector offset
	;
	; Synch
	DSBINT	IPL=#IPL$_ASTDEL, DST=R7, ENVIRON=UNIPROCESSOR

	ADDL3	#P1SYSVECTORS,8(AP),R0	; Find current vector

	MOVL	4(AP),R1		; Get database address
	MOVL	j_data_orig(R1),R1	; Save pointer to saved vector
	BEQL	100$			; check, just in case...
	ADDL	8(AP),R1		; Add vector offset
	MOVQ	(R1)+,(R0)+		; restore vector

100$:	; Unlock (enable kmode ASTs)
	ENBINT  SRC=R7
	RET

;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;	Replace a system service dispatcher
;---------------------------------------------------------------------

.entry Set_Vector,^M<R7>
	;	4(AP) = database address
	;	8(AP) = vector offset
	;	12(AP) = new routine (offset from start of database)
	;
	; Synch
	DSBINT	IPL=#IPL$_ASTDEL, DST=R7, ENVIRON=UNIPROCESSOR

	ADDL3	#P1SYSVECTORS,8(AP),R0	; Find current vector

	ADDL	#2,R0			; skip entry mask
	MOVW	#^X9f17,(R0)+		; JMP opcode and abs. addr mode.
	MOVL	4(AP),(R0)		; JMP destination is database addr
	ADDL	12(AP),(R0)		;   plus the replacement code offset

	; Unlock (enable kmode ASTs)
	ENBINT  SRC=R7
	RET


;++
;	Start intercepting the specified system service.
;
; Input:
;	4(AP) - address of string descriptor holding system service name
;	8(AP) - starting VA of JASMON database
;
; Output:
;	R0 - Status
;	R1 - destroyed
;--
.entry	JASMON_Exec_Watch,^m<R2,R3,R4,R5>
	; Patch a system service
	CLRQ	-(SP)			; Store vector_offset and routine here
	PUSHAL	4(SP)			; push their addresses
	PUSHAL	4(SP)			;   onto the stack
	PUSHL	4(AP)			; push service string descriptor
	CALLS	#3,str2indx		; get vector and new routine
	BLBC	R0,100$			; br on failure

	PUSHL	8(AP)			; pushl database
	PUSHL	#3			; and setup arglist w/ count

	PUSHL	SP			; push the arglist
	PUSHAB	Set_Vector		; get ready to call Set_Vector
	CALLS	#2,G^SYS$CMKRNL		;   and do it in kernel mode.
	MOVL	#SS$_NORMAL,R0
100$:	RET

.entry	JASMON_Watch,^m<R2,R3,R4,R5>

	; Find database
	CLRL	-(SP)				; space for database addr
	PUSHL	SP				; ptr to database addr
	CALLS	#1,Get_Database			; fetch database addr
	MOVL	(SP),R5
	BLBS	R0,60$				; br on error

	; Attempt to load JASMON
	PUSHL	SP				; ptr to database addr
	CALLS	#1,JASMON_Load			; Get database addr
	BLBC	R0,100$
	MOVL	(SP),R5
	
60$:	PUSHL	4(AP)
	CALLS	#2,JASMON_Exec_Watch
	MOVL	R5,@8(AP)
100$:	RET

;++
;	Stop intercepting a particular system service.
;
; Input:
;	4(AP) - address of string descriptor holding system service name
;	8(AP) - starting VA of JASMON database
;
; Output:
;	R0 - Status
;	R1 - destroyed
;--
.entry	JASMON_Exec_UnWatch,^m<>
	; Unpatch a system service
	CLRQ	-(SP)			; Store vector_offset and routine here
	PUSHAL	4(SP)			; push their addresses
	PUSHAL	4(SP)			;   onto the stack
	PUSHL	4(AP)			; push service string descriptor
	CALLS	#3,str2indx		; get vector and new routine
	TSTL	R0			; success?
	BEQL	100$			; br if not

	PUSHL	8(AP)			; pushl database
	PUSHL	#2			; and setup arglist w/ count

	PUSHL	SP			; push the arglist
	PUSHAL	Unset_Vector		; get ready to call Set_Vector
	CALLS	#2,G^SYS$CMKRNL		;   and do it in kernel mode.
100$:	RET

.entry	JASMON_UnWatch,^m<R2,R3,R4,R5>

	; Find database
	CLRL	-(SP)
	PUSHL	SP
	CALLS	#1,Get_Database
	BLBC	R0,100$

	PUSHL	4(AP)
	CALLS	#2,JASMON_Exec_UnWatch
100$:	RET



.entry Set_QIO_Params,^m<>
	MOVL	12(AP),R0			; get database
	MOVL	8(AP),j_param_qio(R0)		; set the DDB filter
	MOVL	4(AP),j_param_qio_style(R0)	; set the $QIO display style
	RET

;++
;	str2ddb	- Find the Device Database Block for given device
;
; Context:
;	CALL from kernel mode.
;
; Input:
;	4(AP) - address of descriptor of ASCII string for device name
;	8(AP) - address of longword to store DDB in
;
; Output:
;	R0 - Status
;	@8(AP) - DDB
;--
.entry str2ddb^m<>
; HACK - Lock these pages down?
	MOVL	G^CTL$GL_PCB,R4			; get my PCB address
	JSB	G^SCH$IOLOCKR			; lock & return
	MOVL	4(AP),R1			; Pass device descriptor
	JSB	G^IOC$SearchDev			; Search for device info
	PUSHL	R0				;   and R0
	JSB	G^SCH$IOUNLOCK			; unlock I/O database
	ENBINT	SRC=#0				; Set IPL to 0
	POPL	R0				; Restore R0
	MOVL	R2,@8(AP)			; return DDB
	RET

;++
;	watch $QIOW system service calls
;
; Input:
;	4(AP) - address of string descriptor holding system service name
;
; Output:
;	R0 - Status
;	R1 - destroyed
;--
.entry	JASMON_Watch_QIO,^m<R2,R3,R4,R5>
	; Patch the $QIO[W] system service
	CLRL	-(SP)
	PUSHL	SP
	PUSHL	4(AP)
	CALLS	#2,JASMON_Watch			; Leaves database in R1
	BLBC	R0,100$

	; Lock the I/O database and get the DDB for this device
	CLRL	-(SP)
	PUSHL	SP
	PUSHL	8(AP)
	PUSHL	#2
	PUSHL	SP
	PUSHAB	str2ddb
	CALLS	#2,G^SYS$CMKRNL			; Leaves DDB in R1
	BLBC	R0,100$
	ADDL	#12,SP

	; Set the special parameters
	PUSHL	12(AP)				; Push style
	PUSHL	#3
	PUSHL	SP
	MOVAB	Set_QIO_params,-(SP)
	CALLS	#2,G^SYS$CMKRNL
;	BLBC	R0,100$
	MOVL	#SS$_NORMAL,R0
100$:	RET				; return

.end
