Article 5003 of vmsnet.internals:
When reading this post, please see my introductory note in the previous
post.

--------------------  CUT HERE  --------------------

;
;  Alpha privileged shareable image base file
;
.title	shr
.ident "AXP V04.00"
.library "sys$library:lib"

.psect	plv, quad, rd, nowrt, noexe, shr, pic, vec
.psect	kernel_list, quad, rd, nowrt, noexe, shr, pic
.psect	exec_list, quad, rd, nowrt, noexe, shr, pic
.psect	user_list, quad, rd, nowrt, noexe, shr, pic

$plvdef

.macro	define, name, mode

.if	blank name
.error	; Missing routine name - correct and retry
.mexit
.endc

.if	blank mode
.error	; Missing access mode - correct and retry
.mexit
.endc

.if	dif mode, kernel
.if	dif mode, exec
.if	dif mode, user
.error	; Unknown access mode - correct and retry
.mexit
.endc
.endc
.endc

.if	idn mode, kernel
num_kroutines = num_kroutines + 1
.psect	kernel_list
.address name
.endc

.if	idn mode, exec
num_eroutines = num_eroutines + 1
.psect	exec_list
.address name
.endc

.if	idn mode, user
num_uroutines = num_uroutines + 1
.psect	user_list
.address name
.endc

.endm	define

;
;  Below are the tables for the various access modes
;
.sbttl	Tables

.psect	kernel_list
kernel_list_head:

.psect	exec_list
exec_list_head:

.psect	user_list
user_list_head:

.sbttl	Routine Definitions

num_kroutines = 0
num_eroutines = 0
num_uroutines = 0

;
;		===========================================
;		D E F I N I T I O N S   S T A R T   H E R E
;		===========================================
;

define	shrrtn1, kernel							; # 1
define	shrrtn2, exec							; # 2
define	shrrtn3, user							; # 3

;
;		======================================
;		D E F I N I T I O N S   E N D  H E R E
;		======================================
;


































.sbttl	PLV and lists of routines

;
;  Below is the privileged library vector (PLV)
;
.psect	plv

.long	plv$c_typ_cmod				; Indicates a change mode vector
.long	0					; Reserved
.long	num_kroutines				; # of kernel routines
.long	num_eroutines				; # of exec routines
.long	kernel_list_head			; Kernel routine list
.long	exec_list_head				; Exec routine list
.long	0					; No kernel rundown service
.long	0					; No exec rundown service
.long	0					; No RMS dispatcher
.long	0					; Kernel routine flags
.long	0					; Exec routine flags

.end

-------------------------   CUT HERE  -----------------------

$!
$! LINK.COM
$!
$	link sys$input/options -
		/nodebug -
		/notraceback -
		/nouserlibrary -
		/share=shr.exe -
		/map=shr.map -
		/full -
		/cross -
		/protect
gsmatch=lequal,1,0400
identification="AXP V04.00"

psect_attr=plv, quad, rd, nowrt, noexe, shr, pic, vec
psect_attr=kernel_list, quad, rd, nowrt, noexe, shr, pic
psect_attr=exec_list, quad, rd, nowrt, noexe, shr, pic
psect_attr=user_list, quad, rd, nowrt, noexe, shr, pic
cluster=plv_etc,,,sys$disk:[]shr.obj
collect=plv_etc, plv, kernel_list, exec_list, user_list

psect_attr=code, quad, rd, nowrt, exe, shr, pic, gbl
cluster=code
collect=code,code

psect_attr=data_ro, quad, rd, nowrt, noexe, shr, pic, gbl
cluster=data_ro
collect=data_ro,data_ro

psect_attr=data_rw, quad, rd, wrt, noexe, noshr, pic, gbl
cluster=data_rw
collect=data_rw,data_rw

sys$disk:[]shrrtn.obj

!
!		===========================================
!		D E F I N I T I O N S   S T A R T   H E R E
!		===========================================
!
symbol_vector = (-
	shrrtn1 = procedure,-
	shrrtn2 = procedure,-
	shrrtn3 = procedure)
!
!		======================================
!		D E F I N I T I O N S   E N D  H E R E
!		======================================
!
$
$	exit

-------------------  CUT HERE  --------------------------

;
;  VAX privileged shareable image base file.
;  This works and has been in use for many years.
;

.title	UTL_SHARE
.ident	"V01.00"

.library	"sys$library:lib"		; System structure definitions

$pcbdef						; Process Control Block symbols
$plvdef						; Change mode vector symbols
$prvdef						; Privilege symbols
$psldef						; Processor Status Longword
$ssdef						; System service symbols

.sbttl	PSECT definitions
;
;  PSECT definitions
;

.psect	$a_transfer_vectors,	page,pic,con,rel,lcl,shr,exe,rd,nowrt,novec
.psect	$b_kernel_dispatcher,	quad,pic,con,rel,lcl,shr,exe,rd,nowrt,novec
.psect	$c_exec_dispatcher,	quad,pic,con,rel,lcl,shr,exe,rd,nowrt,novec
.psect	$d_support_code,	quad,pic,con,rel,lcl,shr,exe,rd,nowrt,novec

.psect	change_mode_vector,	page,pic,con,rel,lcl,shr,noexe,rd,nowrt,vec

.psect	$a_kernel_rcb,		byte,pic,con,rel,lcl,shr,noexe,rd,nowrt,novec
.psect	$b_exec_rcb,		byte,pic,con,rel,lcl,shr,noexe,rd,nowrt,novec

.psect	data_rw_prot,		byte,pic,con,rel,gbl,noshr,noexe,rd,wrt,novec


.sbttl	RCB definitions
;
;  Symbol definitions to define the Routine Control Block (RCB) structure.
;  The RCB is a 16 byte structure for each service routine that describes
;  various things about it, eg. the privileges it needs, the mode it is to
;  run in, the number of arguments it requires, etc.
;
rcb_l_offset	= 0				; Offset from RCB to code
rcb_q_priv	= 4				; Privileges routine requires
rcb_b_numargs	= 12				; Number of required args
rcb_b_mode	= 13				; Access mode to run in
rcb_b_boost	= 14				; Priority boost for routine
rcb_b_spare	= 15				; Spare byte
rcb_k_size	= 16				; Size of this structure

.sbttl	Macro definitions
;
;  Define a macro to create the necessary entry point and code for each
;  callable routine this shareable image provides
;

.macro	define, name, mode, num_args=0, priv=0, boost=0, visibility=global
						; Name of macro and arguments
;
;  Check if the passed name is blank (not specified)
;
.if	blank name				; If name is missing
.error	; Missing routine_name - correct and retry
.mexit						; stop
.endc						; END IF

;
;  Check if the passed mode is blank (not specified)
;
.if	blank mode				; If mode is missing
.error	; Missing access_mode value - correct and retry
.mexit						; stop
.endc						; END IF

;
;  Check the mode is valid
;
.if	dif mode, kernel			; If mode <> KERNEL
.if	dif mode, exec				; and mode <> EXEC
.if	dif mode, super				; and mode <> SUPER
.if	dif mode, user				; and mode <> USER
.error	; Unknown access_mode - correct and retry
.mexit						;   and stop
.endc						; END IF
.endc						; END IF
.endc						; END IF
.endc						; END IF

;
;  Check the visibility is valid
;
.if	dif visibility, global			; If visibility <> GLOBAL
.if	dif visibility, local			; If visibility <> LOCAL
.error	; Unknown visibility_definition - correct and retry
.mexit						;   and stop
.endc						; END IF
.endc						; END IF

;
;  Everything seems OK - now define the entry point
;
.psect	$a_transfer_vectors			; Put following into this PSECT
.align	quad					; Align on quadword boundary
.if	idn visibility, global			; If allowed to be seen
.transfer name					;   Define entry point
.iff						; ELSE
lcl_'name'::					;   Define local symbol
.endc						; End if
.mask	name, ^m<r11>				; A routine's entry mask

;
;  If it was KERNEL
;
.if	idn mode, kernel			; If mode = KERNEL then :
	chmk	#<kcode_base+num_kroutines>	; Call VMS dispatcher
	ret					; Return to caller
.psect	$a_kernel_rcb				; Put following into this PSECT
tmp=.						; Store current location
.long	name+2-.				; Offset from here to code
.quad	<priv>					; Privileges required
.byte	num_args				; Number of required arguments
.byte	psl$c_'mode'				; Access mode to run at
.byte	boost					; Priority boost
.byte	0					; Spare
assume	.-rcb_k_size eq tmp			; Check length is correct
num_kroutines = num_kroutines + 1		; Increment number of routines
.endc						; END IF

;
;  If it was EXEC
;
.if	idn mode, exec				; If mode = EXEC then :
	chme	#<ecode_base+num_eroutines>	; Call VMS dispatcher
	ret					; Return to caller
.psect	$b_exec_rcb				; Put following into this PSECT
tmp=.						; Store current location
.long	name+2-.				; Offset from here to code
.quad	<priv>					; Privileges required

.byte	psl$c_'mode'				; Access mode to run at
.byte	boost					; Priority boost
.byte	0					; Spare
assume	.-rcb_k_size eq tmp			; Check length is correct
num_eroutines = num_eroutines + 1		; Increment number of routines
.endc						; END IF

;
;  If it was SUPER
;
.if	idn mode, super				; If mode = SUPER then :
	chme	#<ecode_base+num_eroutines>	; Call VMS dispatcher
	ret					; Return to caller
.psect	$b_exec_rcb				; Put following into this PSECT
tmp=.						; Store current location
.long	name+2-.				; Offset from here to code
.quad	<priv>					; Privileges required
.byte	num_args				; Number of required arguments
.byte	psl$c_'mode'				; Access mode to run at
.byte	boost					; Priority boost
.byte	0					; Spare
assume	.-rcb_k_size eq tmp			; Check length is correct
num_eroutines = num_eroutines + 1		; Increment number of routines
.endc						; END IF

;
;  If it was USER
;
.if	idn mode, user				; If mode = USER then :
.if	dif priv, 0				; If has privs
.error	; USER_mode routine cannot have privileges
.endc						; END IF
	jmp	l^name+2			; Go to routine
.endc						; END IF

.psect	$a_transfer_vectors			; Return to this PSECT
.endm	define					; End of macro definition


;
;  This macro is used to replace an entry point that has been retired.
;  When a routine is to be removed from the shareable image, use the OLD
;  macro to replace its transfer vector so that the others after it do not
;  shift.
;
.macro	old
.psect	$a_transfer_vectors			; Put following into this PSECT
.align	quad					; Align on quadword boundary
.mask	old_routine				; Define entry mask
	jmp	l^old_routine+2			; Jump to routine
.endm	old


;
;  The following macro is used to define the method that supervisor mode
;  routines can return to executive mode to tidy up before exiting.  It defines
;  the structures necessary to call a particular routine after the valid
;  CHME instruction has been issued
;
.macro	define_return_to_exec

return_to_exec_vec = ecode_base + num_eroutines	; Define a value for CHME
num_eroutines = num_eroutines + 1		; Increment number of routines
.psect	$b_exec_rcb				; Put following into this PSECT
tmp=.						; Store curent location
.long	return_to_exec-.			; Offset from here to code
.quad	0					; Privileges required
.byte	0					; Number of required arguments
.byte	psl$c_exec				; Access mode to run at
.byte	0					; Priority boost
.byte	0					; Spare
assume	.-rcb_k_size eq tmp			; Check length is correct
.psect	$a_transfer_vectors			; Return to this PSECT

.endm	define_return_to_exec


num_kroutines = 0				; Initialise number of routines
num_eroutines = 0				; Ditto for exec mode ones
kcode_base = -1024				; Base CHMK code value
ecode_base = -1024				; Base CHME code value


.sbttl	Routine Control Blocks (RCBs)
;
;  Below are the PSECTs in which are stored the routine control blocks (RCBs).
;  These contain various information about each routine including what
;  privileges they require, the minimum number of arguments required, etc.
.psect	$a_kernel_rcb
kernel_rcb:

.psect	$b_exec_rcb
exec_rcb:


.sbttl	Routine definitions
;
;  Below is an entry for each routine this shareable image contains.  Once
;  a routine has been released to the users, do NOT alter it's position or
;  order in the following sequence.  Use the OLD statement to decommission
;  a routine.  If a line is too long to fit, end a section of it with a
;  comma and a hyphen and continue on the next line.
;
;  Examples:
;	define	callable_1, mode=kernel, num_args=1,-
;		priv=<prv$m_sysprv!prv$m_cmkrnl!prv$m_oper>
;	define	callable_2, mode=super, priv=prv$m_world
;	define	callable_3, mode=user, num_args=3
;
;  CALLABLE_1 runs in kernel mode, requires 1 argument passed to it
;  by each caller and uses SYSPRV, CMKRNL and OPER privileges.
;
;  CALLABLE_2 runs in supervisor mode, requires no arguments, and uses
;  WORLD privilege.
;
;  CALLABLE_3 runs in user mode and requires 3 arguments passed to it.
;
;
;		===========================================
;		D E F I N I T I O N S   S T A R T   H E R E
;		===========================================
;

	define	utl_register_user, mode=super, num_args=1,-		; #1
		priv=prv$m_sysprv
	define	utl_deregister_user, mode=super, num_args=1,-		; #2
		priv=prv$m_sysprv
	define	utl_grant_class, mode=super, num_args=2,-		; #3
		priv=prv$m_sysprv
	define	utl_revoke_class, mode=super, num_args=2,-		; #4
		priv=prv$m_sysprv
	define	utl_create_class, mode=super, num_args=1,-		; #5
		priv=prv$m_sysprv
	define	utl_delete_class, mode=super, num_args=1,-		; #6
		priv=prv$m_sysprv

;		=======================================
;		D E F I N I T I O N S   E N D   H E R E
;		=======================================

;
;  Movable routines.  Below are any routines that can be moved from
;  release to release and follow the permanent entries above.
;
	define_return_to_exec			; Allows return from SUPER


.sbttl	Change Mode Dispatcher Vector Block
;
;  The following data structure 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 so that the image will be position
;  independant (PIC)
;
.psect	change_mode_vector

.long	plv$c_typ_cmod				; Indicates a change mode vector
.long	0					; Reserved
.long	kernel_dispatch - .			; Offset to kernel dispatcher
.long	exec_dispatch - .			; Offset to exec dispatcher
.long	0					; No rundown service
.long	0					; Reserved
.long	0					; No RMS dispatcher
.long	0					; 0 = PIC code


.sbttl	Kernel Mode Dispatcher
;
;  The following code is executed when each kernel mode routine is called.
;  Entry is at the KERNEL_DISPATCH symbol.  The following parameters are
;  passed to us by VMS :
;
;	(SP)	: Return address if bad change mode value (hence RSB)
;	R0	: Change mode instruction argument value (is negative)
;	R4	: Current PCB address
;	AP	: AP at time change mode instruction was executed
;	FP	: Address of a minimal call frame to exit the change mode
;		  dispatcher and return to the original mode
;
.psect	$b_kernel_dispatcher
kaccvio:
	movl	s^#ss$_accvio, r0		; Signal access violation
	ret					; Return
kinsfarg:
	movzwl	#ss$_insfarg, r0		; Signal not enough arguments
	ret					; Return
knotme:
	rsb					; Not handled by us
kwrongmode:
	movl	#utl_wrongmode, r0		; Signal sanity check fail
	ret					; Return

kernel_dispatch:				; Control comes here
	movab	exception_handler, (fp)		; Setup exception handler
;
;  First check if it's one of our system services or someone else's !
;
	movab	w^-kcode_base(r0), r1		; Normalise CHMK argument
	blss	knotme				; Not one of ours if < 0
	cmpw	r1, #num_kroutines		; Check upper limit
	bgequ	knotme				; Not one of ours if >= limit

;
;  OK - it's one of ours.  Get the RCB and use the data in it to check various
;  things, set privileges, etc.
;
	mull2	#rcb_k_size, r1			; Make into offset into RCB list
	movab	kernel_rcb[r1], r11		; Get address of relevant RCB
	movl	r11, rcb_address		; Save RCB address for later
	movpsl	r0				; Get PSL into R0
	extzv	#psl$v_curmod, #psl$s_curmod, r0, r0 ; Convert into access mode
	cmpb	r0, #psl$c_kernel		; Check we're in kernel mode
	bneq	kwrongmode			; B/ if sanity check failed
	cmpb	rcb_b_mode(r11), #psl$c_kernel	; Check we're meant to be !
	bneq	kwrongmode			; B/ if sanity check failed
	movzbl	rcb_b_numargs(r11), r1		; Get number of args from RCB
	moval	@#4[r1], r1			; Compute number of bytes
	ifnord	r1, (ap), kaccvio		; B/ if can't read argument list
	movzbl	rcb_b_numargs(r11), r1		; Get number of args from RCB
	cmpb	(ap), r1			; Compare number of arguments
	blssu	kinsfarg			; B/ if not enough
	movq	rcb_q_priv(r11), r0		; Get required privs
	beql	10$				; B/ if none required
	pushaq	rcb_q_priv(r11)			; Put address on the stack
	calls	#1, turn_privs_on		; Turn on required privs
	blbc	r0, 40$				; B/ if error
10$:
	tstb	rcb_b_boost(r11)		; Check if priority boost
	beql	20$				; B/ if none
	movzbl	rcb_b_boost(r11), -(sp)		; Put it on the stack
	calls	#1, boost_priority		; Boost current priority
	blbc	r0, 40$				; B/ if error
20$:
	callg	(ap), 50$			; Put a frame on the stack

;
;  Control is returned here after the service routine has executed, and has
;  y up and issue another RET to get back to
;  transfer vectors in user mode, where another RET will be executed to return
;  to the user's code
;
	pushr	#^m<r0>				; Save R0
	movl	rcb_address, r11		; Get address of RCB
	movq	rcb_q_priv(r11), r0		; Get privileges
	beql	30$				; B/ if didn't have any
	calls	#0, turn_privs_off		; Turn privs off again
	blbc	r0, 40$				; B/ if error
30$:
	popr	#^m<r0>				; Restore R0
40$:
	ret					; Return

;
;  Control is transferred here immediately before we call the service routine.
;  A CALLG is performed to here simply so that when the service routine issues
;  a RET, control is transferred to the code after the CALLG (instead of back
;  to the user), so that we can tidy up things (like turning privileges off
;  etc. !)
50$:
	.word	0
	movl	fp, sp				; Reset stack for service routn
	movl	rcb_l_offset(r11), r0		; Get offset to code
	jmp	(r0)[r11]			; Jump to the code


.sbttl	Exec Mode Dispatcher
;
;  The following code is executed when each executive mode routine is called.
;  Entry is at the EXEC_DISPATCH symbol.  The following parameters are
;  passed to us by VMS :
;
;	(SP)	: Return address if bad change mode value (hence RSB)
;	R0	: Change mode instruction argument value (is negative)
;	AP	: AP at time change mode instruction was executed
;	FP	: Address of a minimal call frame to exit the change mode
;		  dispatcher and return to the original mode
;
.psect	$c_exec_dispatcher
eaccvio:
	movl	s^#ss$_accvio, r0		; Signal access violation
	ret					; Return
einsfarg:
	movzwl	#ss$_insfarg, r0		; Signal not enough arguments
	ret					; Return
enotme:
	rsb					; Not handled by us
ewrongmode:
	movl	#utl_wrongmode, r0		; Signal sanity check fail
	ret					; Return

exec_dispatch:					; Control comes here
	movab	exception_handler, (fp)		; Setup exception handler
;
;  First check if it's one of our system services or someone else's !
;
	movab	w^-ecode_base(r0), r1		; Normalise CHME argument
	blss	enotme				; Not one of ours if < 0
	cmpw	r1, #num_eroutines		; Check upper limit
	bgequ	enotme				; Not one of ours if >= limit

;
;  OK - it's one of ours.  Get the RCB and use the data in it to check various
;  things, set privileges, etc.
;
	mull2	#rcb_k_size, r1			; Make into offset into RCB list
	movab	exec_rcb[r1], r11		; Get address of relevant RCB

;
;  First check if it's the exec mode return routine.  If so, DON'T save
;  the RCB address in RCB_ADDRESS, as we need it's current value.  Just
;  jump to the code
;
	cmpl	r0, #return_to_exec_vec		; Is it the return routine ?
	beql	40$+2				; B/ if so

;
;  It is a normal routine - handle as appropriate
;
	movl	r11, rcb_address		; Save RCB address for later
	movpsl	r0				; Get PSL
	extzv	#psl$v_curmod, #psl$s_curmod, r0, r0 ; Convert into access mode
	cmpb	r0, #psl$c_exec			; Check we're in exec mode
	bneq	ewrongmode			; B/ if sanity check failed
	cmpb	rcb_b_mode(r11), #psl$c_exec	; Check what we should be in
	blssu	ewrongmode			; B/ if should be in KERNEL mode
	movzbl	rcb_b_numargs(r11), r1		; Get number of args from RCB
	moval	@#4[r1], r1			; Compute number of bytes
	ifnord	r1, (ap), eaccvio		; B/ if can't read argument list
	movzbl	rcb_b_numargs(r11), r1		; Get number of args from RCB
	cmpb	(ap), r1			; Compare number of arguments
	blssu	einsfarg			; B/ if not enough
	movq	rcb_q_priv(r11), r0		; Get required privs
	beql	10$				; B/ if none required
	pushaq	rcb_q_priv(r11)			; Put address on the stack
	calls	#1, turn_privs_on		; Turn on required privs
	blbc	r0, 40$				; B/ if error
10$:
	cmpb	rcb_b_mode(r11), #psl$c_exec	; Check if meant to be in exec
	bneq	super_dispatch			; B/ if meant to be in super
	callg	(ap), 40$			; Put a frame on the stack

;
;  Control is returned here after the service routine has executed, and has
;  issued a RET instruction, so tidy up and issue another RET to get back to
;  transfer vectors in user mode, where another RET will be executed to return
;  to the user's code
;
	pushr	#^m<r0>				; Save R0
	movl	rcb_address, r11		; Get address of RCB
	movq	rcb_q_priv(r11), r0		; Get privileges
	beql	20$				; B/ if didn't have any
	calls	#0, turn_privs_off		; Turn privs off again
	blbc	r0, 30$				; B/ if error
20$:
	popr	#^m<r0>				; Restore R0
30$:
	ret					; Return

;
;  Control is transferred here immediately before we call the service routine.
;  A CALLG is performed to here simply so that when the service routine issues
;  a RET, control is transferred to the code after the CALLG (instead of back
;  to the user), so that we can tidy up things (like turning privileges off
;  etc. !)
40$:
	.word	0
	movl	fp, sp				; Reset stack for service routn
	movl	rcb_l_offset(r11), r0		; Get offset to code
	jmp	(r0)[r11]			; Jump to the code


.sbttl	Supervisor Mode Dispatcher
;
;  This is the code that is called to drop down from executive mode to
;  supervisor mode just before calling the service routine which will then
;  execute in supervisor mode.  Note that the protected memory has to have
;  it's protection altered to allow supervisor mode writing.  This will
;  be re-protected again upon exit from the service routine
;
super_dispatch:
	movab	start_of_data, data_rw_prot_addr
	movab	end_of_data, data_rw_prot_addr+4
	$setprt_s -				; Change protection of memory
		inadr = data_rw_prot_addr, -
		prot = #prt$c_ursw, -
		prvprt = data_rw_prev_prot
	blbs	r0, 20$				; B/ if OK
10$:
	ret					; Return with error
20$:
	movl	fp, saved_fp			; Save this FP for later
	movpsl	-(sp)				; Get PSL onto the stack
	insv	rcb_b_mode(r11), #psl$v_curmod,- ; Change current mode to SUPER
		#psl$s_curmod, (sp)		; (leave previous mode as USER)
	pushab	30$				; Get a PC on the stack
	rei					; Go to supervisor mode

;
;  We are now executing at supervisor mode after the above REI instruction
;  brought us here
;
30$:
	callg	(ap), 40$			; Put a frame on the stack

;
;  Control is transferred here after the service routine has executed, and has
;  issued a RET instruction, so tidy up and issue another RET to get back to
;  transfer vectors in user mode, where another RET will be executed to return
;  to the user's code
;
	movq	r0, saved_r0_r1			; Save R0 and R1
	chme	#return_to_exec_vec		; Return to exec mode
	$exit_s	r0				; Should never get here

;
;  Control is transferred here immediately before we call the service routine.
;  A CALLG is performed to here simply so that when the service routine issues
;  a RET, control is transferred to the code after the CALLG (instead of back
;  to the user), so that we can tidy up things (like turning privileges off
;  etc. !)
40$:
	.word	0
	movab	exception_handler, (fp)		; Setup exception handler
	movl	fp, sp				; Reset stack for service routne
	movl	rcb_address, r11		; Get RCB address
	movl	rcb_l_offset(r11), r0		; Get offset
	jmp	(r0)[r11]			; Call service routine

;
;  Control is transferred here after the service routine has completed,
;  and the code above has issued another CHME instruction to get back to
;  exec mode.  We are now back in exec mode.  Tidy up and exit.
;
return_to_exec:
	movl	saved_fp, fp			; Restore FP
	$setprt_s -				; Re-protect memory
		inadr = data_rw_prot_addr, -
		prot = data_rw_prev_prot
	blbs	r0, 20$				; B/ if OK
10$:
	ret
20$:
	movl	rcb_address, r11		; Get RCB address
	movq	rcb_q_priv(r11), r0		; See if any privs
	beql	30$				; B/ if not
	calls	#0, turn_privs_off		; Turn them off again
	blbc	r0, 10$				; B/ if error
30$:
	movq	saved_r0_r1, r0			; Restore R0 and R1
	ret					; Back to user mode


.sbttl	Support code
.psect	$d_support_code
;
;  The following code is for support routines that perform various functions.
;  It includes the OLD routine which is used when a callable routine has been
;  retired and a placeholder inserted
;

.entry	turn_privs_on, 0
	$setprv_s -				; Turn on privileges
		enbflg = #1,-
		prvadr = @4(ap),-		; Pointer is on the stack
		prvprv = prev_priv		; Save old ones for later
	ret

.entry	turn_privs_off, 0
	mcoml	prev_priv, prev_priv		; Reverse previous priv set
	mcoml	prev_priv+4, prev_priv+4	; Ditto
	$setprv_s -				; Turn off privileges
		prvadr=prev_priv		; Quadword is ones that weren't
						; on before
	ret					; Return

.entry	boost_priority, 0
B address
	movzbl	pcb$b_pri(r1), r0		; Get current priority
	subb2	4(ap), r0			; Subtract priority value
	bgequ	10$				; B/ if still valid
	clrb	r0				; Set to maximum value
10$:
	movb	r0, pcb$b_pri(r1)		; Set new priority
	movl	s^#ss$_normal, r0		; Setup return status
	ret					; Return

.entry	old_routine, 0
	movl	#utl_old, r0			; Setup return status
	ret					; Return

.entry	exception_handler, 0
	movl	#utl_fatalerr, r0		; Setup return status
	ret

;
;  Data storage that is written to on each call, so must be process private.
;  Note that the protection on this page of memory will be altered if the
;  routine is to run in supervisor mode.  The start and end symbols below
;  indicate to the $SETPRT system service the start and the end of the memory.
;
.sbttl	Protected Read/Write Data
.psect	data_rw_prot

start_of_data:

rcb_address:					; Address of RCB in use
	.blkl
prev_priv:					; Previous privileges enabled
	.blkq
data_rw_prot_addr:				; Starting and ending address
	.blkq					; of the protected data
saved_fp:					; Saved FP
	.blkl
saved_r0_r1:					; Saved R0 and R1
	.blkq
data_rw_prev_prot:				; SETPRT only writes a byte
	.long	0				; but reads a longword

end_of_data:


.end


