| .title FREEMEM Force processes to free memory
.ident "X2.0"
.library "sys$library:lib"
.link "sys$system:sys.stb"/selective_search
$acbdef
$dyndef
$ipldef
$irpdef
$jpidef
$pcbdef
$pridef
$prvdef
.macro check_status ?L1
blbs R0, L1
ret
; 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
;
PCB_LST:: .word 4,JPI$_STS ;Process status flags.
.long STS,0
.word 4,JPI$_PID ;Process id.
.long PID,0
.long 0 ;end of list
WC_PID:: .long -1 ;Wildcard
MY_PID:: .long 0 ;PID of current process
IOSB:: .quad 0
STS:: .long 0
PID:: .long 0
SWAP:: .long 0 ;Purge swapped processes only if set
PID_NEXT:: .long 0
PID_MAX == 400 ;Sixty-four is fine for uVAX
PID_LIST:: .blkl PID_MAX+1 ;The +1 lets us use zero check for end
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_status
$lkwset_s inadr=PSECT_CODE_BEGIN
check_status
;Use $getjpi to get PID of current process
;
$getjpiw_s efn=#1,itmlst=PCB_LST,iosb=IOSB
blbc R0, 40$ ;Blow away if any error
movzwl IOSB,R0 ;Check the IOSB status
cmpw R0,#SS$_NORMAL
bneq 40$
movl PID, MY_PID
;Use $getjpi to wildcard through processes
;
20$: $getjpiw_s efn=#1,pidadr=WC_PID,itmlst=PCB_LST,iosb=IOSB
blbs R0,60$
;? cmpw R0,#SS$_SUSPENDED ;Note - not delivered until suspended
;? beql 20$ ; process is RESUMED
cmpw R0,#SS$_NOMOREPROC ;Are we done?
beql PID_ARRAY_NOW_FILLED
40$: ret
; pushl R0
; calls #1,g^LIB$STOP
60$: movzwl IOSB,R0 ;Check the IOSB status
cmpw R0,#SS$_NORMAL
bneq 40$
cmpl MY_PID, PID ;Is it me?
beql 20$
bbs #PCB$V_RES, STS, 80$ ;Is it swapped out?
blbc SWAP, 20$ ;If we don't want swapped, then next
80$: movl PID_NEXT, R7 ;Get index
cmpl R7, #PID_MAX ;Is it in range?
blss 100$ ;Skip if in range
movl #^X1C, R0 ;Give EXQUOTA error
brb 40$ ;Fatal error and stop
100$: movl PID, R0 ;Get extended pid to R0
jsb g^EXE$EPID_TO_IPID ;Convert to internal pid
cmpw R0, #1 ;Null is pix 0, swapper is pix 1
bleq 120$ ;Skip null and swapper
incl PID_NEXT ;Move index to next
movl PID, PID_LIST[R7] ;Save the PID
120$: brw 20$ ;And now do the next
;PID_NEXT and PID_LIST are set, queue the ASTs and everything else in kernel
;mode
;
PID_ARRAY_NOW_FILLED::
$cmkrnl_s QUEUE_ASTs ;Time to restrict a little activity
blbc R0, RETURN_R0 ;If error, return with the error
;Purge this process
;
pushl #^x7FFFFFFF ;Put high address on stack
clrl -(SP) ;Put low address on stack
movl SP, R0 ;Save -> address range
$purgws_s inadr=(R0) ;Send them off
;Return with status in R0
;
RETURN_R0::
ret
;Kernel mode routines
;
QUEUE_ASTs:: .word ^m<R10,R11>
moval PID_LIST, R11 ;Point to first pid entry
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 (R11)+, R0 ;R0 is the pid, R11 ready for next
bneq 20$ ;Skip down if PID is there
movl #1, R0 ;Return success
15$: ret ;Exit the kernel routines
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 15$ ;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$: brw 10$
;Purge routine executed in context of target process, first part executed out
;of the pkt
;
.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 #^x7FFFFFFF ;Put high address on stack
clrl -(SP) ;Put low address on stack
movl SP, R0 ;Save -> address range
$purgws_s inadr=(R0) ;Send them off
blbs R0, 10$ ;Did it work?
tstl -2 ;Bugcheck if not
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
|