From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 25-MAR-1989 20:26
To:	MRGATE::"ARISIA::EVERHART"
Subj:	SHOW DEFAULT/ID=pid (a program!)


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Sat, 25 MAR 89 17:02:55 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Sat, 25 Mar 89 16:48:08 PST
Received: by ucbvax.Berkeley.EDU (5.61/1.36)
	id AA13855; Sat, 25 Mar 89 16:35:13 -0800
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 26 Mar 89 00:28:11 GMT
From: mailrus!sharkey!atanasoff!hascall@tut.cis.ohio-state.edu  (John Hascall)
Organization: Iowa State Univ. Computation Center
Subject: SHOW DEFAULT/ID=pid (a program!)
Message-Id: <906@atanasoff.cs.iastate.edu>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


  Ok, you can stop asking!!!  :-)

  I was bored today, so....

  Here is a program to find the default directory specification
  for any process (i.e., SHOW DEFAULT/ID=pid).

  It is more-or-less complete, feel free to complete it :-)

  John Hascall

--------------------- fold, spindle and mutilate here --------------------------
	.title	SHODEF	Show default for another process
	.sbttl	Copyright notice
	.ident	'V1.00'
NOTICE:	.ascii	'Copyright ) 1989 John Hascall, All Rights Reserved'
;
; Author:	John Hascall, Iowa State University Computation Center
; Written:	25 March 1989
; Updates:	(none)
; Restrictions:	This program or any part thereof may be used for any
;		non-commercial use provided this notice is included.
;		Commercial use is not allowed.  No warranty is expressed
;		or implied.


	.page
	.sbttl	Description
;
; SHODEF:	Shows the default directory specification for any process.
;
; How it works:
;
;	1)  A buffer (UMB) is allocated in the address space of the
;	    original process.
;	2)  We prompt for the PID of the process whose default directory
;	    specification we wish to obtain (the target process).
;	3)  We clear an event flag (so we can wait for it to be set later).
;	4)  We use SYS$CMKRNL to execute a routine (LOCAL_KERNEL_CODE) in
;	    kernel mode.  In this routine we:
;		a)  Convert the target processes external PID to its
;		    internal PID.
;		b)  Disable Interrupts
;		c)  Allocate a buffer (KMB) in system space.  This buffer
;		    includes an ACB, room for the default, and room for
;		    a routine (THEIR_KAST) which we copy into it.
;		d)  Using the ACB in the KMB we queue a special kernel mode
;		    AST (KAST) to the target process.
;		e)  We re-enable interrupts and return.
;	5)  We wait for the event flag to be set.
;
;		T1) The KAST (THEIR_KAST) executes in the context of the target
;		    process (IPL is 2).
;		T?) To be complete, we should translate the executive mode
;		    logical name SYS$DISK in LNM$PROCESS_TABLE.  This is left
;		    as an exercise for the reader.
;		T2) We copy the default from location PIO$GT_DDSTRING in the
;		    target processes P1 space to the KMB.
;		T3) We re-use the ACB (at the head of the KMB) to queue a KAST
;		    back to the original process, and return.
;
;		O1) The KAST (OUR_KAST) executes in the context of the original
;		    process (IPL is 2).
;		O2) The default specification is copied from the KMB to the
;		    UMB, and the KMB is deallocated.
;		O3) We set the event flag, and return.
;
;	6)  Now that the event flag is set, we continue.  We display the
;	    default directory specification, and return
;


	.page
	.sbttl	Libraries

	.library	'SYS$LIBRARY:LIB.MLB'
	.link		'SYS$SYSTEM:RMS.STB'/selective_search
	.link		'SYS$SYSTEM:SYS.STB'/selective_search


	.page
	.sbttl	Definitions - System

	$ACBDEF				; AST Control Block
	$DSCDEF				; Descriptors
	$DYNDEF				; Dynamic Data Structures
	$IPLDEF				; Interrupt Priority Level
	$PCBDEF				; Process Control Block
	$SSDEF				; System Service Return Codes


	.page
	.sbttl	Definitions - Local Constants

KAST_BLOCK	= <<ACB$M_KAST@8>!<DYN$C_ACB>>
DYNAMIC_STRING	= <<DSC$K_CLASS_D@24>!<DSC$K_DTYPE_T@16>>
STATIC_STRING	= <<DSC$K_CLASS_S@24>!<DSC$K_DTYPE_T@16>>


	.page
	.sbttl	Definitions - Local Control Blocks
;
; Kernel Mode Buffer
;
	$DEFINI	KMB,,ACB$K_LENGTH
$DEF	KMB$L_OURPID	.blkl	1
$DEF	KMB$T_DEFAULT	.blkb	256
$DEF	KMB$K_LENGTH
$DEF	KMB$Z_CODE			; kernel code goes here
	$DEFEND	KMB
;
; User mode buffer
;
	$DEFINI	UMB
$DEF	UMB$L_PID	.blkl	1	; whose default we want
			.blkl	1
$DEF	UMB$Q_INPUT	.blkq	1	; string descr for input
$DEF	UMB$Q_OUTPUT	.blkq	1	; string descr for output
$DEF	UMB$T_DEFAULT	.blkb	256
$DEF	UMB$T_OUTPUT	.blkb	256+32	; output string from fao
$DEF	UMB$K_LENGTH
	$DEFEND	UMB


	.page
	.sbttl	Definitions - Macro

	.macro	IF_ERR	GOTO,?OK
	BLBS	R0,OK
	BRW	GOTO
OK:
	.endm


	.page
	.sbttl	Readonlys

WHO:	.ascid	\Show DEFAULT for (PID) : \

FAO:	.ascid	\Default for !XL is !AC.\


	.page
	.sbttl	Code
	.psect	Code,Rd,NoWrt,Exe
	.entry	SHODEF,^M<R11>
;
; allocate user-mode buffer
;
	PUSHAL	-(SP)
	PUSHAL	#UMB$K_LENGTH
	CALLS	#2,g^LIB$GET_VM
	MOVL	(SP)+,R11
	IF_ERR	99$
;
; get pid of process whose default we want to get
;
	MOVL	#DYNAMIC_STRING,UMB$Q_INPUT(R11)
	CLRL	UMB$Q_INPUT+4(R11)
	CLRQ	-(SP)			; no force-prompt or return-length
	PUSHAQ	WHO
	PUSHAQ	UMB$Q_INPUT(R11)
	CALLS	#4,g^LIB$GET_FOREIGN
	IF_ERR	99$
;
; convert PID from a (hex) text string to a longword value
;
	PUSHL	#1			; ignore blanks
	PUSHL	#4			; we want a longword
	PUSHAL	UMB$L_PID(R11)
	PUSHAQ	UMB$Q_INPUT(R11)
	CALLS	#4,g^OTS$CVT_TZ_L
	IF_ERR	99$
;
; clear event flag
;
	PUSHL	#17
	CALLS	#1,g^SYS$CLREF
	IF_ERR	99$
;
; get into kernel mode
;
	PUSHAL	(R11)			; build argument list on stack
	PUSHL	#1
	PUSHAL	(SP)
	PUSHAB	LOCAL_KERNEL_CODE
	CALLS	#2,g^SYS$CMKRNL
	MOVAB	8(SP),SP		; clean stack
	IF_ERR	99$
;
; wait
;
	PUSHL	#17
	CALLS	#1,g^SYS$WAITFR
	IF_ERR	99$
;
; show answer
;
	MOVL	#<STATIC_STRING+256+32>,UMB$Q_OUTPUT(R11)
	MOVAB	UMB$T_OUTPUT(R11),UMB$Q_OUTPUT+4(R11)
	PUSHAB	UMB$T_DEFAULT(R11)
	PUSHL	UMB$L_PID(R11)
	PUSHAQ	UMB$Q_OUTPUT(R11)
	PUSHL	#0
	PUSHAQ	FAO
	CALLS	#5,g^SYS$FAO
	IF_ERR	99$
	PUSHAQ	UMB$Q_OUTPUT(R11)
	CALLS	#1,g^LIB$PUT_OUTPUT
;
; exit
;
99$:	RET



	.page
	.sbttl	LOCAL_KERNEL_CODE
;
; Inputs:	4(AP)	- Address of UMB
; Outputs:		- KMB allocated
;			- KAST queued to target process
;
	.entry	LOCAL_KERNEL_CODE,^M<R2,R3,R4,R5,R6,R7,R8,R11>
	MOVL	4(AP),R11		; R11 -> UMB
;
; convert from external to internal PID
;
	MOVL	UMB$L_PID(R11),R0
	JSB	g^EXE$EPID_TO_IPID
	MOVL	R0,R8			; save R0 (internal Pid)
	BNEQ	10$
	MOVL	#SS$_NONEXPR,R0
	RET

10$:	DSBINT	#IPL$_ASTDEL		; don't deliver any ASTs now!
;
; allocate kernel-mode control block + space for KAST routine
;
	MOVAB	THEIR_KAST,R7
	MOVAB	THEIR_KAST_END,R6
	SUBL2	R7,R6			; size of KAST routine
	ADDL3	#KMB$K_LENGTH,R6,R1	;  + size of KMB
	JSB	g^EXE$ALONONPAGED
	BLBS	R0,20$
	MOVL	#SS$_INSFMEM,R0
	BRB	89$
20$:
;
; copy THEIR_KAST into system space
;
	PUSHR	#^M<R1,R2,R3,R4>
	MOVC3	R6,(R7),KMB$Z_CODE(R2)
	POPR	#^M<R1,R2,R3,R4>
;
; fill in the ACB at the head of the KMB
;
	MOVL	R2,R3			; R3 steps through ACB/KMB
	CLRQ	(R3)+			; clear ACB$L_ASTQFL, ACB$L_ASTQBL
	MOVW	R1,(R3)+		; ACB$W_SIZE
	MOVW	#KAST_BLOCK,(R3)+	; ACB$B_TYPE, ACB$B_RMOD
	MOVL	R8,(R3)+		; ACB$L_PID (prev saved internal PID)
	MOVAB	OUR_KAST,(R3)+		; ACB$L_AST
	MOVL	R11,(R3)+		; ACB$L_ASTPRM
	MOVAB	KMB$Z_CODE(R2),(R3)+	; ACB$L_KAST (system copy of THEIR_KAST)
	MOVL	PCB$L_PID(R4),(R3)+	; KMB$L_OURPID (internal)
;
; queue special kernel mope AST to other process
;
	MOVL	R2,R5			; R5 -> ACB
	MOVL	#4,R2			; priority increment class
	JSB	g^SCH$QAST

89$:	ENBINT				; re-enable interrupts
99$:	RET


	.page
	.sbttl	OUR_KAST
;
; Inputs:	R4	- address of our PCB
;		R5	- address of ACB (KMB)
; Outputs:		- default copied to UMB
;			- KMB de-allocated
;			- event flag 17 set
;
OUR_KAST:
;
; copy def-dir-spec from KMB (system space) to UMB (in our P0 space)
;
	PUSHL	R4			; save R4,R5 from MOVC3
	PUSHL	R5
	MOVL	ACB$L_ASTPRM(R5),R0	; R0 -> UMB
	MOVAB	UMB$T_DEFAULT(R0),R3	; R3 -> Umb def-dir-spec area
	MOVAB	KMB$T_DEFAULT(R5),R1	; R1 -> Kmb def-dir-spec
	MOVZBL	(R1),R2			; get length
	MOVB	(R1)+,(R3)+		; copy def-dir-spec length
	MOVC3	R2,(R1),(R3)		; copy def-dir-spec text
	MOVL	(SP)+,R0		; restore R5 as R0
;
; return the KMB to non-paged pool (R0->KMB)
;
	JSB	g^EXE$DEANONPAGED
;
; set event flag for our waiting main thread
;
	MOVL	(SP)+,R4		; restore R4 -> PCB
	MOVL	PCB$L_PID(R4),R1	; our pid
	MOVL	#4,R2			; prio incr class
	MOVL	#17,R3			; efn
	JMP	g^SCH$POSTEF



	.page
	.sbttl	THEIR_KAST
;
; Inputs:	R4	- address of PCB (target process)
;		R5	- address of ACB (KMB)
;	PIO$GT_DDSTRING	- default
; Outputs:		- default copied to KMB
;			- KAST queued to original process
;
THEIR_KAST:				; R5 -> KMB(ACB)
;
; copy default dir spec from per-process P1 space to KMB (in system space)
;
	PUSHL	R5			; save R5 from MOVC3
	MOVAB	KMB$T_DEFAULT(R5),R3	; R3 -> Kmb default-dir-spec area
	MOVAB	@#PIO$GT_DDSTRING,R1	; R1 -> default-dir-spec counted string
	MOVZBL	(R1),R2			; get length
	MOVB	(R1)+,(R3)+		; copy def-dir-spec length
	MOVC3	R2,(R1),(R3)		; copy def-dir-spec text
	MOVL	(SP)+,R5		; restore R5
;
; queue ast back to our (the original) process
;
	BISB2	#ACB$M_KAST,ACB$B_RMOD(R5)	; re-set the KAST flag
	MOVL	KMB$L_OURPID(R5),ACB$L_PID(R5)
	MOVL	ACB$L_AST(R5),ACB$L_KAST(R5)
	MOVL	#4,R2			; priority increment class
	JMP	g^SCH$QAST
THEIR_KAST_END:



	.end	SHODEF

