;<TITLE>PURGEWS.MAR   purge the workingset for a given process</TITLE>
;
; Kernel mode code to queue an AST to another process to purge the other
; process working-set. This routine is tested under VMS 5.2. I'm not shure
; if it will work under VMS 4.x.
;
; Input argument:
;        PID of target process, passed by reference.
;
; Return status:
;        SS$_NORMAL or any error messages...
;
; Usage (from fortran):
;
;        external          purge_ws, sys$cmkrnl
;        integer*4         purge_ws, sys$cmkrnl
;        integer*4         arg_list(2), pid
;        .
;        .
;        pid = [pid of target process]
;        arg_list(1) = 1
;        arg_list(2) = %loc(pid)
;        status = sys$cmkrnl (purge_ws,arg_list)
;        if ( status .ne. ss$_normal ) call lib$stop (%val(status))
;
; Written by
;        Joern Yngve Dahl-Stamnes
;        The University of Trondheim
;        The Norwegian Institute of Technology
;        division of Physical Electronics
;
; e-mail:
;        dahl-stamnes@elab-runit.sintef.no
;        PSI%02422530001005::DAHLS
;
; fax:
;        +7 59 14 41
;
         .LIBRARY "SYS$LIBRARY:LIB"
;
; Some symbols are defined in SYS.STB.
; Declear some external symbols.
;
         .LINK    "SYS$SYSTEM:SYS.STB"/SELECTIVE_SEARCH

         .EXTERNAL         EXE$ALONONPAGED
         .EXTERNAL         EXE$DEANONPAGED
         .EXTERNAL         EXE$EPID_TO_IPID
         .EXTERNAL         SCH$QAST
         .EXTERNAL         SYS$PURGWS

         $ACBDEF           ; AST Control Block defs.
         $IPLDEF           ; IPL defs.
         $SSDEF
;
; AP offset value.
;
PID      = 4               ; Passed by reference.

         .PSECT   $CODE, PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
         .ENTRY   PURGE_WS, ^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>

         MOVL     @PID(AP),R6       ; PID value --> R6.
;
; Allocate a block in non-paged pool for holding the AST Control Block
; (ACB) and the kernel mode code, both in the same block.
;
         MOVAB    ACSTART,R8        ; Start adr. to code --> R8.
         MOVAB    ACEND,R9          ; End adr. to code --> R9.
         SUBL2    R8,R9             ; Calc. length of code.
         ADDL3    #ACB$K_LENGTH, -  ; Calc. length of block in non-paged pool
                  R9,R1             ; --> R1.
;
; Raise IPL to ASTDEL to avoid paging (Poor man's lockdown).
;
         SETIPL   $120              ; Raising IPL.
         JSB      G^EXE$ALONONPAGED ; Allocate block in non-paged pool
         BLBC     R0,$130           ; Go home if error...
;
; Fill data in ACB.
;
         MOVL     R2,R10            ; Save ACB/code adr. --> R10.
         MOVZWL   R1,ACB$W_SIZE(R10); Size of block.
         MOVB     #ACB$M_KAST, -    ; Set KAST mode.
                  ACB$B_RMOD(R10)
         MOVAB    ACB$K_LENGTH(R10),-
                  ACB$L_KAST(R10)   ; Adr. to code.
         CLRL     ACB$L_ASTPRM(R10) ; No arguments.
;
; Copy code to non-paged pool.
;
         MOVC3    R9,(R8), -
                  ACB$K_LENGTH(R10)
;
; Convert EPID to IPID.
;
         MOVL     R6,R0             ; R0 = external PID.
         JSB      G^EXE$EPID_TO_IPID
         TSTL     R0                ; Does PID exist?
         BNEQ     $100              ; Yes, go on...
         MOVL     #SS$_NONEXPR,R0   ; No, report error
         BRB      $110              ; and deallocate block.
;
; Queue AST.
;
$100:    MOVL     R0,ACB$L_PID(R10) ; Insert IPID in ACB.
         MOVL     #2,R2             ; Prioritet boost class --> R2.
         MOVL     R10,R5            ; ACB adr. --> R5.
         JSB      G^SCH$QAST
         BLBS     R0,$130
;
; Error queueing AST or process does not exist, deallocate block in
; non-paged pool.
;
$110:    MOVL     R0,R9             ; Save condition code in R9.
         MOVL     R10,R0            ; ACB adr. --> R0.
         JSB      G^EXE$DEANONPAGED ; Deallocate ACB.
         MOVL     R9,R0             ; Restore condition code from R9.
         BRB      $130

$120:    .LONG    IPL$_ASTDEL       ; IPL Level for above code.
;
; Set IPL to 0 and return.
;
$130:    SETIPL   #0
         RET
;
; AST code. This code will be copied into non-paged pool by the above code
; and will be executed in the context of the target process in kernel mode.
; The purpose of this code is to:
;
;        1. Purge the working set to a minimum.
;        2. Deallocate block in non-paged pool.
;
ACSTART:
         DSBINT   #0, -
                  ENVIRON=UNIPROSESSOR

         SUBL2    #8,SP             ; Allocate space on stack.
         MOVL     SP,R0             ; R0 --> scratch space on stack.

         CLRL     (R0)              ; Purge adr. range from 00000000
         MOVL     #^X7FFFFFFF,4(R0) ; to 7FFFFFFF.

         PUSHR    #^M<R0>           ; Save argument adr. on stack.
         CALLS    #1,G^SYS$PURGWS   ; Purger working set.
         ADDL2    #8,SP             ; Restore stack.
;
; Deallocate block from non-paged pool.
; R5 --> ACB.
;
         MOVL     R5,R0             ; Adr. to the block --> R0.
         ENBINT
         JMP      G^EXE$DEANONPAGED
ACEND:
         .END