From:	SMTP%"everhart@star.zko.dec.com" 16-JUL-1996 19:26:34.82
To:	EVERHART
CC:	
Subj:	set event flag in proc

Date: Tue, 16 Jul 1996 17:34:09 -0400
Message-Id: <96071617340914@star.zko.dec.com>
From: everhart@star.zko.dec.com (Glenn C. Everhart 603 881 1497)
To: everhart@gce.com
Subject: set event flag in proc
X-VMS-To: SMTP%"everhart@gce.com"

          <<< NOTED::DISK$NOTES7:[NOTES$LIBRARY_7OF4]HACKERS.NOTE;1 >>>
                               -< ** Hackers ** >-
================================================================================
Note 1639.0      program to set an event flag in another process      No replies
AZTECH::LASTOVICA "straight but not narrow minded"  182 lines  30-DEC-1993 01:33
--------------------------------------------------------------------------------
    
; the other day I had a problem where NETACP was stuck waiting for a 'lost'
; call to $getjpiw.  rather than reboot, I came up with this little program
; that set event flag 0 (the one that it was waiting for).  This program 
; will probably come in handy in the future as well.  
;
; requires change mode to kernel priv.  use with caution, etc.
;
; support: 'no promises, no demands'
;
;	macro	setef
;    	link	setef
    
.title	setef set and event flag for someone else's process

.ident	"X2.0"

	.link		'sys$system:sys.stb' /selective_search
	.library	/sys$library:lib.mlb/

	$acbdef
	$dyndef
	$ipldef
	$irpdef
	$jpidef
	$pcbdef
	$pridef
	$prvdef

.macro	_check ?l1
	blbs	r0, l1
	pushl	r0
	calls	#1, g^lib$stop
l1:
.endm

.macro  psect  NAME, ATTR
	.psect	'NAME', 'ATTR'
psect_'NAME'_begin::			;Descr for $lkwset
	.address psect_'NAME'_begin,psect_'NAME'_end
.endm

psect	RW_DATA	<noEXE,RD,WRT,LONG>	;psect macro sets up desc for $lkwset

; Following items are in PCB and JIB, so don't require inswap
;
result:		.ascid	\        \	; 8 bytes max for a pid in hex
prompt:		.ascid	\Enter PID: \	; prompt string for lib$get_command
PID::		.long	0

PSECT_RW_DATA_END::			;End of locked down data psect

psect	CODE	<EXE,noWRT,LONG>	;psect macro sets up desc for $lkwset

.entry	FREEMEM,^M<IV,R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>

;Lock pages down, some code runs at IPL$_SYNCH
;
	$lkwset_s inadr=PSECT_RW_DATA_BEGIN
	_check
	$lkwset_s inadr=PSECT_CODE_BEGIN
	_check

10$:	;
	; determine the target PID
	; 
	pushal	result
	pushal	prompt
	pushal	result
	calls	#3, g^lib$get_command
	_check

	;
	; convert it from hex to integer
	; 
	pushal	pid
	pushal	result
	calls	#2, g^ots$cvt_tz_l
	_check

100$:	movl	PID, R0			;Get extended pid to R0
	jsb	g^EXE$EPID_TO_IPID	;Convert to internal pid

	$cmkrnl_s QUEUE_ASTs		;Time to restrict a little activity
	blbc	R0, RETURN_R0		;If error, return with the error

;Return with status in R0
;
RETURN_R0::
	ret

;Kernel mode routines
;
QUEUE_ASTs:: .word ^m<R10,R11>
	movzbl	#<ACB$K_LENGTH+4+ASTROUT_LENGTH+^XF>&<^C<^XF>>, -
		R10			;Length of needed packet

;Get the next pid in the list and convert extended pid to PCB address
;
10$:	movl	pid, R0				;R0 is the pid, R11 ready for next
20$:	jsb	g^EXE$EPID_TO_PCB	;Convert PID to PCB address in R0
	beql	10$			;PCB address zero means it is gone
	movl	R0, R4			;PCB addresses are fond of R4

;Allocate and fill an AST routine (ACB with code following)
;
	movl	R10, R1			;Length of needed packedt
	jsb	g^EXE$ALONONPAGED	;Allocate it
	blbs	R0, 30$			;Skip if ok
	movzwl	#SS$_INSFMEM,R0		;Set insufficient dyn mem
	brb	40$			;Lower IPL and exit
30$:	movl	R2, R5			;Copy to R5 for QAST call
	assume	ACB$K_LENGTH EQ 28	;Assume ACB header is 28 bytes
	clrq	(R2)+			;Clear first 8 bytes of ACB
	clrq	(R2)+			;Now to 16
	clrq	(R2)+			;Now to 24	(Note: this sets mode -
	clrl	(R2)			;Now to 28	  ACB$B_RMOD to kernel)
	movb	#DYN$C_QVAST,-		;Set the structure type to
		IRP$B_TYPE(R5)		; QVSS ast
	movw	R10, IRP$W_SIZE(R5)	;Store packet size
	movl	PCB$L_PID(R4),-		;Set the target IPID
		ACB$L_PID(R5)		;
	movl	R5,ACB$K_LENGTH(R5)	;Store the pkt address in the pkt
	movab	ACB$K_LENGTH+4(R5),-	;Point the ast address cell at the
		ACB$L_AST(R5)		; rest of the pkt
	bbss	#ACB$V_NODELETE,-	;Set the nodelete bit in the ACB
		ACB$B_RMOD(R5),35$	; so that the routine can delete it
35$:	pushr	#^M<R0,R1,R2,R3,R4,R5>	;Protect from the MOVC
	movc3	#ASTROUT_LENGTH,-	;Copy the actual code for the purge
		ASTROUT_START,-		; routine into this pkt
		ACB$K_LENGTH+4(R5)	;Move code into rest of pkt
	popr	#^M<R0,R1,R2,R3,R4,R5>	;Restore after the MOVC

;Queue the ast to the target process
;
	movl	#PRI$_TICOM, R2		;Set priority increment (large boost)
	jsb	g^SCH$QAST		;Queue the ast to the target

40$:	ret

;routine executed in context of target process, first part executed out
;of the pkt.  set an event flag and return.
;
.align	long
PKTADR:	.long	0			;Dummy, let's us do an easy PIC reference
					; to the pkt address stored in the pkt
.entry	ASTROUT_START, ^M<R2,R3,R4,R5>
	pushl	#0			; evnet flag 0
	movl	sp,r0
	$setef_s efn    = (r0)

10$:	subl2	s^#STKROUT_LENGTH,SP	;Make room on the stack
	movc3	s^#STKROUT_LENGTH,-	;Copy the code for the deallocate
		b^STKROUT_START,(SP)	; routine onto the stack (PIC)
	movpsl	-(SP)			;Setup for dummy REI
	bsbb	20$			;Dummy REI
	movl	b^PKTADR,R0		;Get address of start of packet (PIC)
	jmp	(SP)			;Now execute on the stack, so that
					; the pkt can be deallocated

20$:	rei				;The VAX architecture says that you should
					; do an REI before using freshly written
					; code.
;
;The following routine is moved to the kernel stack, so that it can deallocate
;the pkt.
;
.align	long

STKROUT_START:
	jsb	g^EXE$DEANONPAGED	;Deallocate the packet
	ret				;Leave the AST routine

.align	long

STKROUT_LENGTH==.-STKROUT_START
ASTROUT_LENGTH==.-ASTROUT_START
	
PSECT_CODE_END::			;End of locked down CODE psect

.end FREEMEM
    
