From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CUNYVM.CUNY.EDU::MILILM%VTCC1.BITNET"  7-AUG-1989 21:16
To:	MRGATE::"ARISIA::EVERHART"
Subj:	No Subject

Message-Id:  <8908080102.AA18026@crdgw1.ge.com>
Received: from VTCC1.BITNET by VTVM1.CC.VT.EDU (IBM VM SMTP R1.2.1MX) with BSMTP id 2654; Mon, 07 Aug 89 20:59:55 EDT
Received: by VTCC1 (Jnet BSMTP V0.07) id 1540; Mon,  7 Aug 89 20:48 EDT
Date:     Mon,  7 Aug 89 20:48 EDT
From: Raj Viruru / L.M. Mili <MILILM%VTCC1.BITNET@VTVM1.CC.VT.EDU>
Subject: 
To: EVERHART@ARISIA.decnet
Original_To:   COM%"EVERHART%ARISIA.decnet@CRDGW1.GE.COM"

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
X`009.ENTRY SET_ACCOUNT `094M<R2,R3,R4,R5,R6>`009; Procedure entry point
X`009$CMKRNL_S ROUTIN=10$, -`009`009; Kick into kernel mode
X`009`009  ARGLST=(AP)`009`009; & pass along the argument list
X`009RET`009`009`009`009; back to the Pascal mainline
X10$:`009.WORD`0090`009`009`009; Kernel entry point
X`009MOVAL`009HANDLER, (FP)`009`009; Establish condition handler
X`009MOVL`009PCB$L_JIB(R4), R0`009; Get JIB address
X`009MOVC3`009#JIB$S_ACCOUNT,@4(AP), -; Copy the account name
X`009`009JIB$T_ACCOUNT(R0)`009; into it's JIB location
X`009MOVC3`009#JIB$S_ACCOUNT,@4(AP),-`009; Copy the account name
X`009`009G`094CTL$T_ACCOUNT`009`009; into it's P1 location
X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Set success
X`009RET`009`009`009`009; from kernel
X
X;---------------------------------------------------------------------------
V----
X;+
X; This routine is used to set the current process privs.  Note that
X; it doesn't touch the authorized priv mask in the PHD.  This allows
X; us to "become" ourselves again.
X;-
X`009.ENTRY SET_PRIVS `094M<>`009`009; Routine entry point
X`009$CMKRNL_S ROUTIN=10$,-`009`009; Kick into kernel
X`009`009  ARGLST=(AP)`009`009; & pass the argument pointer
X`009RET`009`009`009`009; back to the Pascal mainline
X10$:`009.WORD`0090`009`009`009; Kernel entry point
X`009MOVAL`009HANDLER, (FP)`009`009; Establish condition handler
X`009MOVQ`009@4(AP), G`094CTL$GQ_PROCPRIV ; Set permanent process privs
X`009MOVQ`009@4(AP), PCB$Q_PRIV(R4)`009; Set current privs
X`009MOVL`009PCB$L_PHD(R4), R0`009; Get pointer to process header
X`009MOVQ`009@4(AP), PHD$Q_PRIVMSK(R0); Set the other copy of current privs
X`009MOVZBL`009#SS$_NORMAL, R0`009`009; Return success
X`009RET`009`009`009`009; from kernel
X
X;---------------------------------------------------------------------------
V----
X;+
X; This routine sets the owner of job logical name table to the
X; new uic of the user. The owner is in the objects rights block
X; which is pointed to from the logical name table structure.
X;-
X`009.ENTRY SET_TABLE_PROT `094M<R2,R3,R4,R5> ; Routine entry point
X`009$CMKRNL_S ROUTIN = 10$, -`009; Kick intor kernel
X`009`009  ARGLST=(AP)`009`009; & pass the argument list
X`009BLBS`009R0, 5$`009`009`009; Branch if success
X`009PUSHL`009R0`009`009`009; Push the bad status
X`009CALLS`009#1, G`094LIB$STOP`009`009; Crash on errors
X5$:`009RET`009`009`009`009; back to the Pascal mainline
X10$:`009.WORD`0090`009`009`009; Kernel entry point
X`009MOVAB`009HANDLER, (FP)`009`009; Establish condition handler
X;+
X; Raise IPL to AST delivery level so that there are no interruptions while t
Vhe
X; translation of the logical name is being carried out, lock the logical nam
Ve
X; mutex for reading, and then search for the specified logical name.
X;-
X`009SETIPL`009S`094#IPL$_ASTDEL`009`009; Raise IPL to AST delivery level
X`009JSB`009G`094LNM$LOCKR`009`009; Lock tables for reading
X`009SUBL`009#RT_K_SIZE, SP`009`009; Allocate a recursion control block
X`009MOVL`009SP, R5`009`009`009; Set the address in the proper reg
X`009MOVB`009#PSL$C_EXEC, RT_B_ACMODE(R5) ; Set the proper access mode
X`009CLRB`009RT_B_FLAGS(R5)`009`009; Initialize the flags field
X`009BBSS`009#RT_V_CASE,RT_B_FLAGS(R5),11$ ; Set the proper flag bit
X11$:`009MOVQ`009LNM_JOB, R2`009`009; Get table name descriptor
X`009MOVZWL`009R2, R2`009`009`009; Clear the high order word
X;+
X; Call to LNM$SETUP expects the following registers to be set up:
X;
X;`009R2 - Length of table name string
X;`009R3 - Address of logical name string
X;`009R5 - Address of recursion table search control block
X; Returns:
X;
X;`009R0 low bit clear indicates search failure.
X;`009`009R0 - SS$_NOLOGNAM -No logical name match found.
X;`009`009R1 - Address of logical name block on which search failed
X;
X;`009R0 low bit set indictes success with:
X;`009`009R1 - Address of logical name table block that contains match
X;
X;`009All other registers are preserved
X;-
X`009JSB`009G`094LNM$SETUP`009`009; Search for the logical name block
X`009PUSHL`009R0`009`009`009; Save the search status
X`009BLBC`009R0, 20$`009`009`009; Branch if no name found
X`009MOVL`009LNMTH$L_ORB(R1), R1`009; Get address of object rights block
X`009MOVL`009@4(AP), ORB$L_OWNER(R1)`009; Set the new owner of the table
X20$:`009JSB`009G`094LNM$UNLOCK`009`009; Release lock on logical name mutex
X`009SETIPL`009#0`009`009`009; Drop our IPL to zero
X`009POPL`009R0`009`009`009; Get status
X`009RET`009`009`009`009; Return from kernel mode
X;---------------------------------------------------------------------------
V----
X`009.PSECT COND_HANDLER RD,NOWRT,PIC,EXE,LONG
X`009.ENTRY`009HANDLER `094M<>
X;
X; First get the mutex count out of our PCB to see if we should
X; release the I/O sub-system before exiting
X;
X`009MOVL`009G`094CTL$GL_PCB, R4`009; Get our current PCB
X`009TSTW`009PCB$W_MTXCNT(R4)`009; Any mutex's held ?
X`009BEQL`00910$`009`009`009; Branch if nope...
X`009JSB`009G`094LNM$UNLOCK`009`009; Release our mutex
X`009SETIPL`009#0`009`009`009; Drop our IPL to zero
X10$:`009$EXIT_S`009`009`009`009; Cause process to exit
X`009.END
$ CALL UNPACK BECOMESUB.MAR;1 422610745
$ create/nolog 'f'
X`009subroutine comfiles
X`009integer`009lib$do_command
X`009call lib$do_command('@dua0:`091phaniraj.utilities`093become.com')
X`009end
$ CALL UNPACK COMFILE.FOR;1 1415842867
$ v=f$verify(v)
$ EXIT
