;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	Program:	BECOME
;	Author:		Billy Bitsenbites (Bruce Ellis)
;	Function:	become pretty much like the
;			specified user name.
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	.library	/sys$library:lib.mlb/
	.link		/sys$system:sys.stb/
	.macro	check	?l
	blbs	r0,l
	$exit_s	r0
l:
	.endm	check
	$jibdef		;Job Information Block definitions
	$phddef		;Process Header definitions
	$pcbdef		;Process Control Block definitions
	$prvdef		;Define privilege bits
in_user:
	.long	jib$s_username
	.address	user
user:	.blkb	jib$s_username
in_acct:
	.long	jib$s_account
	.address	account
account:
	.blkb	jib$s_account
user_pmt:
	.ascid	/New username>/
acct_pmt:
	.ascid	/New account>/
	.entry	change_acct,^m<>
	pushal	in_user		;Issue a read with
	pushal	user_pmt	; prompt to obtain the new
	pushal	in_user		; User name
	calls	#3,g^lib$get_input
	check
	pushal	in_acct		;Issue a read with prompt
	pushal	acct_pmt	; to obtain the new 
	pushal	in_acct		; account name
	calls	#3,g^lib$get_input
	check
	$cmexec_s	routin=get_id		;Convert usser name to UIC
	check	
	$cmkrnl_s	routin=blast_it		;Write accounting record
	check					; and become new user
	$cmexec_s	routin=set_rights	;Acquire new rights
	check	
	ret					;Beat it

;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	Routine:	Get_ID
;	Function:	Converts username to UIC
;	Implied inputs:	the location in_user is the
;			address of a descriptor for new user name
;	Implied outputs: UIC contains the binary UIC
;			 corresponding to the new user name.
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;Data area
uic:	.blkl	1
	.long	0

	.entry	get_id,^m<>
	$ASCTOID_S	name=in_user,id=uic
	ret
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	Routine blast_it
;	Function:	Writes an accounting record,
;			clears accounting data cells,
;			changes UIC, user name, account name
;			the logical LNM$GROUP
;	Implied inputs:	in_user -> descriptor for new user name
;			in_acc -> descriptor for new account name
;			uic -> new uic
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

	$LNMDEF			;Logical name defintions
	$PSLDEF			;Processor status longword bit settings
grp_fmt:	.ascid	/!6OW/
group_desc:
	.long	6
	.address	group_num
group_val:
	.long	16
	.address	group_str
group_str:
	.ascii	/LNM$GROUP_/
group_num:
	.blkb	6
proc_table:	
	.ascid	/LNM$PROCESS_DIRECTORY/
group:	.ascid	/LNM$GROUP/
log_items:
	.word	16,LNM$_STRING
	.address	group_str
	.long	0,0
err_out_krnl:
	movl	#ss$_nooper,r0			;exit if no oper privilege
	ret
	.entry	blast_it,^m<r2>
	ifnpriv	OPER,err_out_krnl
	movl	#ss$_normal,g^ctl$gl_finalsts	;Set success status
	clrl	r5				;not a special kast
	jsb	g^exe$prcpurmsg			;write an accounting record
	movl	#ss$_normal,g^ctl$gl_finalsts	;reset status
	movq	g^exe$gq_systime,g^ctl$gq_login	;reset connect time
	clrl	g^ctl$gl_volumes		;reset count of mounted volumes
	clrl	g^ctl$gl_wspeak			;reset peak working set size
	movl	g^ctl$gl_phd,r2			;Get P1 window to process header
	clrl	g^ctl$gl_virtpeak		;reset peak virtual addr. space 
	clrl	phd$l_cputim(r2)		;reset cpu time
	clrl	phd$l_pageflts(r2)		;reset total faults
	clrl	phd$l_pgfltio(r2)		;reset total hard faults
	clrl	phd$l_biocnt(r2)		;reset buffered I/O count
	clrl	phd$l_diocnt(r2)		;reset direct I/O count
	clrl	phd$l_imgcnt(r2)		;reset number/image activations
;^^^^^^^^^^^^^^^^^^^^^^^^
;Format equivalence for LNM$GROUP
;^^^^^^^^^^^^^^^^^^^^^^^^
	$fao_s	ctrstr=grp_fmt,outbuf=group_desc,p1=<<uic+2>>
	blbs	r0,30$
	ret
;^^^^^^^^^^^^^^^^^^^^^^^^
;Reset logical for LNM$GROUP
;^^^^^^^^^^^^^^^^^^^^^^^^
30$:	$crelnm_s	tabnam=proc_table,-
			lognam=group,-
			acmode=#psl$c_super,-
			itmlst=log_items
	blbs	r0,20$
	ret
20$:	movl	pcb$l_uic(r4),old_uic	;Save old UIC
	movl	uic,pcb$l_uic(r4)	;Set to new UIC
	movl	pcb$l_jib(r4),r6	;Get address of Job Info Blk
;^^^^^^^^^^^^^^^^^^^^^^^
;Reset user and account names
;^^^^^^^^^^^^^^^^^^^^^^^
	pushr	#^m<r0,r1,r2,r3,r4,r5>
	movc5	in_user,user,#^a/ /,#jib$s_username,jib$t_username(r6)
	movc5	in_user,user,#^a/ /,#jib$s_username,g^ctl$t_username
	movc5	in_acct,account,#^a/ /,#jib$s_account,jib$t_account(r6)
	movc5	in_acct,account,#^a/ /,#jib$s_account,g^ctl$t_account
	popr	#^m<r0,r1,r2,r3,r4,r5>
	ret
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	Routine:	SET_RIGHTS
;	Function:	revokes old user specific rights
;			and adds new corresponding to new UIC
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
old_uic:	
	.blkl	1
	.long	0
ident:	.blkl	1
ctx:	.long	0
	.entry	set_rights,^m<>
	clrl	ctx		;Clear context for rights db access
next_old:
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; Determine all identifiers held by old user name and revoke them
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
	$find_held_s	holder=old_uic,id=ident,-
			contxt=ctx
	cmpl	#ss$_nosuchid,r0
	beql	done_old
	blbs	r0,10$
	ret
10$:	$revokid_s	id=ident
	blbs	r0,next_old
	ret
done_old:
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; Determine all identifiers held by new user name and grant them
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
next_new:
	$find_held_s	holder=uic,id=ident,-
			contxt=ctx
	cmpl	#ss$_nosuchid,r0
	beql	done_new
	blbs	r0,10$
	ret
10$:	$grantid_s	id=ident
	blbs	r0,next_new
	ret
done_new:
	movl	#ss$_normal,r0	
	ret				;Beat it
	.end	change_acct	



;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	User written system service dispatcher for the 
;	become routines
;
;	Author:	Billy Bitsenbites (Bruce Ellis)
;	Function:	These services will receive a user name and
;	account name and cwrite an accounting record, clear
;	the accounting data cells, change the user name, account
;	name, the UIC, redirect LNM$GROUP to the new group #,
;	and add any rights associated with the new UIC.
;	Note:  This code is a modification of the Digital supplied
;	User-written system service dipatcher.  In the interest of 
;	brevity and saving a few trees, several comments were removed
;	from the original.  The reader is directed to the file
;	SYS$EXAMPLES:USSDISP.MAR for a completely documented version
;	of the system service dispatcher.
;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

;

	.LIBRARY "SYS$LIBRARY:LIB.MLB"	; Macro library for system structure
					;  definitions
;
;	Macro Definitions
;
;	DEFINE_SERVICE - A macro to make the appropriate entries in several
;			 different PSECTs required to define an EXEC or KERNEL
;			 mode service.  These include the transfer vector,
;			 the case table for dispatching, and a table containing
;			 the number of required arguments.
;
;	DEFINE_SERVICE Name,Number_of_Arguments,Mode
;
	.MACRO	DEFINE_SERVICE,NAME,NARG=0,MODE=KERNEL
	.PSECT	$$$TRANSFER_VECTOR,PAGE,NOWRT,EXE,PIC
	.ALIGN	QUAD			; Align entry points for speed and style
	.TRANSFER	NAME		; Define name as universal sym for ent
	.MASK	NAME			; Use entry mask defined in main routine
	.IF	IDN MODE,KERNEL
	CHMK	#<KCODE_BASE+KERNEL_COUNTER> ; Change to kernel mode and execute
	RET				; Return
	KERNEL_COUNTER=KERNEL_COUNTER+1	; Advance counter

	.PSECT	KERNEL_NARG,BYTE,NOWRT,EXE,PIC
	.BYTE	NARG			; Define number of required arguments

	.PSECT	USER_KERNEL_DISP1,BYTE,NOWRT,EXE,PIC
	.SIGNED_WORD	2+NAME-KCASE_BASE	; Make entry in krnl mode CASE
						; table

	.IFF
	CHME	#<ECODE_BASE+EXEC_COUNTER> ; Change to executive mode
	RET				; Return
	EXEC_COUNTER=EXEC_COUNTER+1	; Advance counter

	.PSECT	EXEC_NARG,BYTE,NOWRT,EXE,PIC
	.BYTE	NARG			; Define number of required arguments

	.PSECT	USER_EXEC_DISP1,BYTE,NOWRT,EXE,PIC
	.SIGNED_WORD	2+NAME-ECASE_BASE	; Make entry in exec mode CASE
						; table
	.ENDC				;
	.ENDM	DEFINE_SERVICE		;
;
;	Equated Symbols
;

	$prvdef				; privilege symbols
	$pcbdef				; process control block offsets
	$jibdef				; job information block offsets
	$lnmdef				; logical name symbols
	$psldef				; Processor status longword symbols
	$PHDDEF				; Define process header offsets
	$PLVDEF				; Define PLV offsets and values
	$SSDEF				; Define system status codes
;
;	Initialize counters for change mode dispatching codes
;
KERNEL_COUNTER=0			; Kernel code counter
EXEC_COUNTER=0				; Exec code counter

;
;	Own Storage
;
	.PSECT	KERNEL_NARG,BYTE,NOWRT,EXE,PIC
KERNEL_NARG:				; Base of byte table containing the
					;  number of required arguments.
	.PSECT	EXEC_NARG,BYTE,NOWRT,EXE,PIC
EXEC_NARG:				; Base of byte table containing the
					;  number of required arguments.
	.PAGE
	.SBTTL	Transfer Vector and Service Definitions
;Note: this a kluge to allow us to be able
;to access the local transfer vector for our
;kernel mode service, as internally we would go directly
;to the routine in exec mode.
	.PSECT	$$$TRANSFER_VECTOR,PAGE,NOWRT,EXE,PIC
become_blast_it_vec:
	DEFINE_SERVICE	become_blast_it,4,KERNEL  ; Service to write acc record
						;  and reset user and acct name
						;  UIC and LNM$GROUP
	DEFINE_SERVICE	become,2,EXEC	; Exec mode shell which gets UIC
					; from user name, calls become_blast_it
					; and revokes old idents and adds 
					;idents for the new UIC.

;
KCODE_BASE= -1024		; Base CHMK code value for these services
ECODE_BASE= -1024		; Base CHME code value for these services
	.PAGE
	.SBTTL	Change Mode Dispatcher Vector Block
;
;
;
	.PSECT	USER_SERVICES,PAGE,VEC,PIC,NOWRT,EXE

	.LONG	PLV$C_TYP_CMOD		; Set type of vec to change mode disp
	.LONG	0			; Reserved
	.LONG	KERNEL_DISPATCH-.	; Offset to kernel mode dispatcher
	.LONG	EXEC_DISPATCH-.		; Offset to executive mode dispatcher
	.LONG	0			; No user rundown service
	.LONG	0			; Reserved.
	.LONG	0			; No RMS dispatcher
	.LONG	0			; Address check - PIC image
	.PAGE
	.SBTTL	Kernel Mode Dispatcher
;++
; Input Parameters:
;
;	(SP) - Return address if bad change mode value
;
;	 R0  - Change mode argument value.
;                                                 
;	 R4  - Current PCB Address. (Therefore R4 must be specified in all
;		 register save masks for kernel routines.)
;
;	 AP  - Argument pointer existing when the change
;	       mode instruction was executed.
;
;	 FP  - Address of minimal call frame to exit
;	       the change mode dispatcher and return to
;	       the original mode.
;--
	.PSECT	USER_KERNEL_DISP0,BYTE,NOWRT,EXE,PIC
KACCVIO:				; Kernel access violation
	MOVZWL	#SS$_ACCVIO,R0		; Set access violation status code
	RET				;  and return
KINSFARG:				; Kernel insufficient arguments.
	MOVZWL	#SS$_INSFARG,R0		; Set status code and
	RET				;  return
KNOTME:	RSB				; RSB to forward request

KERNEL_DISPATCH::			; Entry to dispatcher
	MOVAB	W^-KCODE_BASE(R0),R1	; Normalize dispatch code value
	BLSS	KNOTME			; Branch if code value too low
	CMPW	R1,#KERNEL_COUNTER	; Check high limit
	BGEQU	KNOTME			; Branch if out of range
;
; The dispatch code has now been verified as being handled by this dispatcher,
; now the argument list will be probed and the required number of arguments
; verified.
;
	MOVZBL	W^KERNEL_NARG[R1],R1	; Get required argument count
	MOVAL	@#4[R1],R1		; Compute byte count including arg count
	IFNORD	R1,(AP),KACCVIO		; Branch if arglist not readable
	CMPB	(AP),W^<KERNEL_NARG-KCODE_BASE>[R0] ; Check for required number
	BLSSU	KINSFARG		;  of arguments
	MOVL	FP,SP			; Reset stack for service routine
	CASEW	R0,-			; Case on change mode
		-			; argument value
		#KCODE_BASE,-		; Base value
		#<KERNEL_COUNTER-1>	; Limit value (number of entries)
KCASE_BASE:				; Case table base address for 
					; DEFINE_SERVICE
;
;	Case table entries are made in the PSECT USER_KERNEL_DISP1 by
;	invocations of the DEFINE_SERVICE macro.  The three PSECTS, 
;	USER_KERNEL_DISP0,1,2 will be abutted in lexical order at link-time.
;
	.PSECT	USER_KERNEL_DISP2,BYTE,NOWRT,EXE,PIC
	BUG_CHECK IVSSRVRQST,FATAL	; Since the change mode code is valid
					; above, we should never get here
	.PAGE
	.SBTTL	Executive Mode Dispatcher
;++
; Input Parameters:
;
;	(SP) - Return address if bad change mode value
;
;	 R0  - Change mode argument value.
;
;	 AP  - Argument pointer existing when the change
;	       mode instruction was executed.
;
;	 FP  - Address of minimal call frame to exit
;	       the change mode dispatcher and return to
;	       the original mode.
;--
	.PSECT	USER_EXEC_DISP0,BYTE,NOWRT,EXE,PIC
EACCVIO:				; Exec access violation
	MOVZWL	#SS$_ACCVIO,R0		; Set access violation status code
	RET				;  and return
EINSFARG:				; Exec insufficient arguments.
	MOVZWL	#SS$_INSFARG,R0		; Set status code and
	RET				;  return
ENOTME:	RSB				; RSB to forward request

EXEC_DISPATCH::				; Entry to dispatcher
	MOVAB	W^-ECODE_BASE(R0),R1	; Normalize dispatch code value
	BLSS	ENOTME			; Branch if code value too low
	CMPW	R1,#EXEC_COUNTER	; Check high limit
	BGEQU	ENOTME			; Branch if out of range
;
; The dispatch code has now been verified as being handled by this dispatcher,
; now the argument list will be probed and the required number of arguments
; verified.
;
	MOVZBL	W^EXEC_NARG[R1],R1	; Get required argument count
	MOVAL	@#4[R1],R1		; Compute byte count including arg count
	IFNORD	R1,(AP),EACCVIO		; Branch if arglist not readable
	CMPB	(AP),W^<EXEC_NARG-ECODE_BASE>[R0] ; Check for required number
	BLSSU	EINSFARG		;  of arguments
	MOVL	FP,SP			; Reset stack for service routine
	CASEW	R0,-			; Case on change mode
		-			; argument value
		#ECODE_BASE,-		; Base value
		#<EXEC_COUNTER-1>	; Limit value (number of entries)
ECASE_BASE:				; Case table base address for 
					; DEFINE_SERVICE
;
;	Case table entries are made in the PSECT USER_EXEC_DISP1 by
;	invocations of the DEFINE_SERVICE macro.  The three PSECTS, 
;	USER_EXEC_DISP0,1,2 will be abutted in lexical order at link-time.
;
	.PSECT	USER_EXEC_DISP2,BYTE,NOWRT,EXE,PIC
	BUG_CHECK IVSSRVRQST,FATAL	; Since the change mode code is valid
					; above, we should never get here
	.SBTTL	Blast username, acct name, UIC, and LNM$GROUP
;++
; Functional Description:
;	This routine receives the user name, account name, uic
;	and resets them.  It also resets LNM$GROUP to
;	correspond to the new group and returns the old uic.
;
; Input Parameters:
;	4(AP) - Address of descriptor containing user name
;	8(AP) - Address of descriptor containing new account name
;	12(ap) -  Address of uic
;	16(ap) - Address to receive old UIC
;	R4 - Address of current PCB
;
; Output Parameters:
;	16(AP) - gets old UIC.
;	R0 - Completion Status Code
;--
	.psect	zzzkernel_data,byte,wrt,noexe,noshr
grp_fmt:	
	.ascid	/!6OW/
group_desc:
	.long	6
	.address	group_num
group_val:
	.long	16
	.address	group_str
group_str:
	.ascii	/LNM$GROUP_/
group_num:
	.blkb	6
proc_table:
	.ascid	/LNM$PROCESS_DIRECTORY/
group:	.ascid	/LNM$GROUP/
log_items:
	.word	16,LNM$_STRING
	.address	group_str
	.long	0,0
	.psect	user_code,byte,nowrt,exe,pic
kr_accvio:
	movl	#ss$_accvio,r0	;Return access violation
	ret
kr_nopriv:
	movl	#ss$_nooper,r0	;Return no oper privilege
	ret



	.entry	become_blast_it,^m<r2,r4,r6,r7,r8,r9,r10>
	ifnpriv	OPER,kr_nopriv		;No OPER, no can do
	movl	4(ap),r8		;get username descriptor address
	ifnord	#8,(r8),kr_accvio	;if can't touch desc. error out	
	movzwl	(r8),r7			;get size of string (user)
	movl	4(r8),r8		;get address of string (user)
	ifnord	r7,(r8),kr_accvio	;if can't touch string error out
	movl	8(ap),r9		;get acct name descriptor address
	ifnord	#8,(r9),kr_accvio	;if can't touch desc. error out	
	movzwl	(r9),r10		;get size of string (acct)
	movl	4(r9),r9		;get address of string (acct)
	ifnord	r10,(r9),kr_accvio	;if can't touch string error out
	ifnord	#4,@12(ap),kr_accvio	;if can't read UIC error out
	ifnowrt	#4,@16(ap),kr_accvio	;if can't write return UIC error out
	movl	#ss$_normal,g^ctl$gl_finalsts	;set succuss for acct rec.
	clrl	r5			;not a special kast
	jsb	g^exe$prcpurmsg			;write acct record
	movl	#ss$_normal,g^ctl$gl_finalsts	;set new success status
	movq	g^exe$gq_systime,g^ctl$gq_login	;reset connect time
	clrl	g^ctl$gl_volumes	;clear number of volumes mounted
	clrl	g^ctl$gl_wspeak		;clear peak working set size
	movl	g^ctl$gl_phd,r2		;get P1 window to phd
	clrl	g^ctl$gl_virtpeak	;clear peak virtual adddress space size
	clrl	phd$l_cputim(r2)	;clear cputime
	clrl	phd$l_pageflts(r2)	;clear count of page faults
	clrl	phd$l_pgfltio(r2)	;clear count of "hard" faults
	clrl	phd$l_biocnt(r2)	;clear count of buffered I/Os
	clrl	phd$l_diocnt(r2)	;clear count of direct I/Os
	clrl	phd$l_imgcnt(r2)	;clear count of images run
	movq	g^exe$gq_systime,g^ctl$gq_istart  ;reset imgact time
	clrl	g^ctl$gl_ivolumes	;clear image vloume count
	clrl	g^ctl$gl_iwspeak	;clear image working set peak
	clrl	g^ctl$gl_icputim	;clear image cpu time
	clrl	g^ctl$gl_ifaults	;clear image faults
	clrl	g^ctl$gl_ifaultio	;clear image hard faults
	clrl	g^ctl$gl_ibiocnt	;clear image buffered I/Os
	clrl	g^ctl$gl_idiocnt	;clear image direct I/Os
	clrl	g^ctl$gl_ipagefl	;clear image page file usage
;Format the group number to octal ascii
	$fao_s	ctrstr=grp_fmt,outbuf=group_desc,p1=<<uic+2>>
	blbs	r0,30$
	ret
;Reset LNM$GROUP to correspond to new group #
30$:	$crelnm_s	tabnam=proc_table,-
			lognam=group,-
			acmode=#psl$c_super,-
			itmlst=log_items
	blbs	r0,20$
	ret
20$:	movl	pcb$l_uic(r4),@16(ap)	;Return old UIC
	movl	@12(ap),pcb$l_uic(r4)	;Reset to new UIC
	movl	pcb$l_jib(r4),r6	;Get the JIB
	pushr	#^m<r0,r1,r2,r3,r4,r5>
;Reset the user name
	movc5	r7,(r8),#^a/ /,#jib$s_username,jib$t_username(r6)
	movc5	r7,(r8),#^a/ /,#jib$s_username,g^ctl$t_username
;Reset the account name
	movc5	r10,(r9),#^a/ /,#jib$s_account,jib$t_account(r6)
	movc5	r10,(r9),#^a/ /,#jib$s_account,g^ctl$t_account
	popr	#^m<r0,r1,r2,r3,r4,r5>
	movl	#ss$_normal,r0		;success
	ret

	


	.PAGE
	.SBTTL	become another user
;++
; Functional Description:
;	This routine allows the calling program to operate
;	under the general environment of the passed user
;	name
;
; Input Parameters:
;	04(AP) - address of new user name
;	08(AP) - address of new account name
;
; Output Parameters:
;	R0 - Completion Status code
;	resets username, account name, UIC, LNM$GROUP, identifiers
;	writes accounting record under old username.
;--
	.psect	zzzexec_data,byte,wrt,noexe,noshr

old_uic:	
	.blkl	1		;storage for old uic
	.long	0		;set valid identifier format
uic:	.blkl	1		;storage for new UIC
	.long	0		;set valid identifier format
ident:	.blkl	1
ctx:	.long	0		;context for Rightslist DataBase access
	.psect	user_code,byte,nowrt,exe,pic
er_accvio:
	movl	#ss$_accvio,r0		;return access violation
	ret
	.entry	become,^m<r7,r8>
	movl	4(ap),r8		;get username descriptor address
	ifnord	#8,(r8),er_accvio	;if can't touch desc. error out	
	movzwl	(r8),r7			;get size of string (user)
	movl	4(r8),r8		;get address of string (user)
	ifnord	r7,(r8),er_accvio	;if can't touch string error out
	$asctoid_s	name=@4(ap),-	;convert the username to UIC
			id=uic
	blbs	r0,10$
	ret
10$:	pushal	old_uic			;pass return address for old uic
	pushal	uic			;pass uic
	pushl	8(ap)			;pass account name
	pushl	4(ap)			;pass user name
	calls	#4,g^become_blast_it_vec	;blast the stuff
	blbs	r0,20$
	ret
20$:
	movl	#ss$_normal,r0
	ret
	.END



;*************************************************************
;	Program:	become_test
;	Author:  Billy Bitsenbites (Bruce Ellis)
;	Function: Sample call to the become system service
;
;*************************************************************

	.library	/sys$library:lib.mlb/
	.macro	check	?l
	blbs	r0,l
	$exit_s	r0
l:
	.endm	check
	$jibdef
in_user:
	.long	jib$s_username
	.address	user
user:	.blkb	jib$s_username
in_acct:
	.long	jib$s_account
	.address	account
account:
	.blkb	jib$s_account
user_pmt:
	.ascid	/New username>/
acct_pmt:
	.ascid	/New account>/
	.entry	change_acct,^m<>
	pushal	in_user			;Read in a new user name
	pushal	user_pmt
	pushal	in_user
	calls	#3,g^lib$get_input
	check
	pushal	in_acct			;Read in a new user name
	pushal	acct_pmt
	pushal	in_acct
	calls	#3,g^lib$get_input
	check
	pushal	in_acct			;become that user
	pushal	in_user
	calls	#2,g^become
	ret

	.end	change_acct	


