.title	MemTrim - Trim process physical memory
;
;	Author:		A. Grant
;
;	Trim the process with PID passed as a parameter to approx.
;	half its current size.
;
;	Based on (stolen from) a program by Bruce Ellis (WSblaster).
;
; 28-May-1991 A. Grant
;	Modified to approx. halve working set each time.
;	Modifications suggested by chuck@mitlns.mit.edu
;
	.library	/sys$library:lib.mlb/
	.link		/sys$system:sys.stb/
	.ident		/V2.00-00/

	$pcbdef		; Process Control Block
	$dyndef		; Dynamic Memory Types
	$ipldef		; Interrupt Priority Levels
	$acbdef		; AST Control Block
	$pridef		; Priority Classes

	.sbttl	Data
	.page
	.psect	RW_Data, wrt, noexe
                                                               
Pid:	.blkl	1	; Extended PID

Pid_Arg:
	.long	1	; Argument Block for Kernal Mode Code
	.address -
		Pid
	.long	0


	.sbttl	MemTrim	- User mode entry point
	.page
	.psect	Code, nowrt, exe

	.entry	MemTrim, ^M<R6>

	movl	4(ap), Pid
	$cmkrnl_s -
		routin	= AKG_TrimPID, -
		arglst	= Pid_Arg
	ret


	.sbttl	AKG_TrimPID - Trim process given PID
	.page
	.entry	AKG_TrimPID, ^M<R2, R3, R4, R5>

	setipl	#ipl$_astdel		; Make sure we are not deleted yet.
	movl	#MemTrimAst_sz, r1	; Allocate pool for the ACB and code.
	jsb	g^exe$alononpaged
	blbc	r0, 900$		; Return on error
	pushr	#^M<R0,R1,R2,R3,R4,R5>	; Copy the code into pool
	movc3	#MemTrimAst_sz, Trim_KAST, (r2)
	popr	#^M<R0,R1,R2,R3,R4,R5>	; 
;
;	Build ACB
;
	clrq	acb$l_astqfl(r2)
	movw	r1, acb$w_size(r2)	; Set ACB Size
	movb	#dyn$c_acb, acb$b_type(r2)	; Set ACB Type
	clrb	acb$b_rmod(r2)
	bisb	#acb$m_kast, acb$b_rmod(r2)	; Set ACB for Special KAST
	pushr	#^M<R1,R2,R3,R4,R5>	; Get Internal PID
	movl	@4(ap), r0		; r0 = External PID
	jsb	g^exe$epid_to_ipid	; Convert to Internal PID
	popr	#^M<R1,R2,R3,R4,R5>	; 
	movl	r0, acb$l_pid(r2)	; Set ACB Internal PID
	beql	ErrExit			; If r0=0 then failed
	movab	<Trim_Code-Trim_KAST>(r2), acb$l_kast(r2)
					; Set ACB KAST Address
;
;	Queue AST
;
	movl	r2, r5			; r5 = ACB Address
	movl	#pri$_ticom, r2		; r2 = Priority Increment Class
	jsb	g^sch$qast		; Queue AST

900$:	
	setipl	#0			; Restore IPL
	ret

ErrExit:
	movl	r2, r0			; Deallocate Pool
	jsb	g^exe$deanonpaged
	setipl	#0
	clrl	r0
	ret



;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;	ACB with the code following
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
Trim_KAST:
acb:	.blkb	acb$k_length		;Allocate space for a baseline ACB
old_ws:	.blkl	1			;saved working set size
Trim_Code:
	$adjwsl_s	wsetlm=old_ws	;get current wworking set size
	blbc	r0,escape		;if error get out
	pushl	r3			;Save r3
	subl3	#200,old_ws,r3		;compute the difference between
					;the current working set size and
					;the minimum size of 200 pages 
	blss	escape			;if he is already under then get out
;
;	Comment out this line if you want to reduce to 200 pages each time
;
	ashl	#-1, r3, r3		;divide by 2
;
	mnegl	r3,r3			;negate the difference
	$adjwsl_s	pagcnt=r3	;Adjust down to 200 pages
escape:	movl	r5,r0			;set up for deallocation
	popl	r3			;restore r3
	jmp	g^exe$deanonpaged	;get out of here
MemTrimAst_sz	= . - Trim_KAST

	.end