From:	CSBVAX::MRGATE!@KL.SRI.Com,@wiscvm.wisc.edu:ZRGC002@DTUPEV5A.BITNET@SMTP  8-JUL-1987 09:38
To:	EVERHART
Subj:	Read somebody's recall buffer

Received: from wiscvm.wisc.edu by KL.SRI.COM with TCP; Tue 7 Jul 87 19:05:36-PDT
Received: from DTUPEV5A.BITNET by wiscvm.wisc.edu ; Tue, 07 Jul 87 21:03:41 CDT
Date:      Wed,  8-JUL-1987 02:22:29.78 GMT+1
From:      <zrgc002%DTUPEV5A.BITNET@wiscvm.wisc.edu> (Christoph D. Gatzka)
Subject:   Read somebody's recall buffer
To:        <info-vax@sri-kl.arpa>

   With my last request to info-vax I causes some misundestanding, it was
   totally my fault. But thanks to many who have pointed into the right
   direction, here comes the program:


   This program will read somebody else's recall buffer as far as possible,
   that means not only 20 lines, but the whole 1024. This way you may well
   jeopardize the last rest of privacy, thus its use is discouraged.

   Christoph Gatzka   zrgc002@dtupev5a.bitnet

$ create readme.doc

   ALWAYS REMEMBER THAT THERE ARE SYSTEM POSITION DEPENDENCIES IN THIS
   CODE. SEE BELOW ! THIS WILL RUN ON VMS 4.3 ONLY !

   I am very interested in obtaining the correct addresses for the
   other system versions, would you send mail to zrgc002@dtupev5a.bitnet ?

$ type readme.doc
$ create ussgetrec.mar
        .title  USSGETDD        Get Default Directory String
        .ident  "V01"

;
;****************************************************************************
;*                                                                          *
;*  COPYRIGHT (c) 1980                                                      *
;*  BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.                        *
;*                                                                          *
;*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED  *
;*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE  *
;*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER  *
;*  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY  *
;*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY  *
;*  TRANSFERRED.                                                            *
;*                                                                          *
;*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE  *
;*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT  *
;*  CORPORATION.                                                            *
;*                                                                          *
;*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS  *
;*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.                 *
;*                                                                          *
;****************************************************************************

;
; This sample program has been modified by zrgc002@dtupev5a.bitnet (Christoph
; D. Gatzka) to print a copy of another user's recall buffer. The problem
; is that there are version dependant offsets used in ctl$ag_clidata.
;
; They can be obtained using analyze/system. Do an 'examine ctl$ag_clidata;700'
; you will find somewhere your recall buffer. Now go some bytes back and you
; will find a pointer into the recall buffer as an absolute address. This
; address should point to a longword of value '0'. Now you have found both
; base_index and base_data. Fill your recall buffer with some large commands
; now. It should fill up the next HeX400 bytes. This is length_data.

           base_index = ^x2af     ; this is the pointer to the last command
                                  ; saved
           base_data  = ^x2b3     ; this is the start of recall buffer data
           length_data= ^x401     ; this is the length of the recall buffer

;++
;
;  Facility:
;
;       This is an exqmple of a user written system service that obtains
;       the default directory string from any process.
;
;  Environment:
;
;       The procedure executes in kernel mode to queue the special AST
;       to the specified process. A special AST is also used to return the
;       information to the requesting process.
;
;  Author:
;
;       Larry Kenah
;
;  Creation Date:
;
;       15 July 1980
;
;  Revisions:
;
;       Nothing Yet
;
;--
        .page
        .subtitle       Declarations

        .LIBRARY        /SYS$LIBRARY:LIB.MLB/
;
;  Include files:
;

        $ACBDEF                         ;AST Control Block definitions
        $DYNDEF                         ;Data structure type codes
        $IPLDEF                         ;Synchronization IPL values
        $PCBDEF                         ;Software PCB fields
        $PHDDEF                         ;Process Header fields
        $PRIDEF                         ;Priority boost class
        $PSLDEF                         ;Fields in PSL

;
;  Define Extended AST Control Block
;

        $DEFINI ACB

        . = ACB$L_KAST + 4

        $DEF    ACB_L_GET_AST           ;Address of GET AST in nonpaged pool
                .BLKL   1
        $DEF    ACB_L_PUT_AST           ;Address of PUT AST in nonpaged pool
                .BLKL   1
        $DEF    ACB_L_DDDESC            ;Store address of data descriptor
                .BLKL   1
        $DEF    ACB_L_EFN               ;Save event flag number
                .BLKL   1
        $DEF    ACB_L_IOSB              ;Save address of status block
                .BLKL   1
        $DEF    ACB_L_OLD_PID           ;Save PID of requester
                .BLKL   1
        $DEF    ACB_L_IMGCNT            ;Store image count for synchronization
                .BLKL   1
        $DEF    ACB_L_REC_INDEX         ;This will store the index into REC_DATA
                .BLKL   1
        $DEF    ACB_T_REC_DATA          ;This is the recall buffer data from
                .BLKB   LENGTH_DATA     ;the target process
        $DEF    ACB_K_NEW_LEN           ;Symbol for extended length

        ACB_K_STR_LEN = ACB_K_NEW_LEN - <ACB_L_REC_INDEX + 1>

        $DEFEND ACB

;
;  Arguement List Definition (patterned after $GETJPI)
;

        EFN     =  4                    ;Event flag number
        PIDADR  =  8                    ;Address of process ID
        PRCNAM  = 12                    ;Address of process name descriptor
        DDDESC  = 16                    ;Address of three longword descriptor
                                        ; that describes destination of data
        IOSB    = 20                    ;Address of longword that receives
                                        ; final status
        ASTADR  = 24                    ;AST address for notification
        ASTPRM  = 28                    ;AST parameter

;
;  Define special type field codes for blocks containing AST code
;

        dyn_k_get_ast = ^x80 - 2
        dyn_k_put_ast = ^x80 - 3

        .page
        .subtitle       USS_GETDD       Get Default Directory String Procedure

;++
;
;  Functional Description:
;
;       This procedure obtains the default directory string for any process
;       in the system. The method used parallels the $GETJPI system service.
;       A special kernal AST is delivered to the target process, where the
;       default directory string is copied from its P1 space location to
;       the extended AST control block. That block is then used to deliver
;       another AST back to the requesting process.
;
;  Input Parameters:
;
;       EFN(AP)         Number of event flag to set when the requested
;                       information is available.
;
;       PIDADR(AP)      Address of longword containing the process ID of the
;                       process for which the information is being requested.
;
;       PRCNAM(AP)      Address of the string descriptor for the process name
;                       of the process for which the information is being
;                       requested.
;
;       DDDESC(AP)      Address of three longword descriptor that describes
;                       where information will be stored.
;
;                       +-------------------------------+
;                       |     spare     | Buffer Length |
;                       +-------------------------------+
;                       |        Buffer Address         |
;                       +-------------------------------+
;                       |   Address to Return Length    |
;                       +-------------------------------+
;
;       IOSB(AP)        Used by the kernel AST to report errors back to
;                       the original caller that cannot be detected in
;                       the initial procedure. One such error might be
;                       a protection change in the user's buffer.
;
;       ASTADR(AP)      Address of an AST that will be called when all of
;                       the requested data has been supplied.
;
;       ASTPRM(AP)      Parameter that will be passed to the AST
;
;  Implicit Input:
;
;       R4      Address of PCB of caller (current process)
;
;  Output Parameters:
;
;       The default string (and optionally its length) are passed
;       back to the caller.
;
;  Return Status:
;
;       SS$_NORMAL      AST has been successfully queued to the target process
;
;       SS$_ACCVIO      One of the input parameters cannot be successfully read
;                       or the output string buffer or length buffer cannot
;                       be written.
;
;       SS$_EXQUOTA     Not enough AST quota to deliver notification AST
;
;       SS$_INVLOGNAM   Invalid process name string was supplied
;
;       SS$_NONEXPR     Either an invalid process ID was supplied or the
;                       process no longer exists.
;
;       SS$_NOPRIV      Caller does not have the privilege to request
;                       information from the target process.
;
;--

        .PSECT  USS_CODE                PIC,SHR,NOWRT

        .ENTRY  ANALYZE_REC_BUF,^M<r2,R3,R4,R5>
        SUBL    #256,SP
        PUSHAL  (SP)
        MOVL    @4(AP),R4
        MOVL    R4,R3
        ADDL    #3,R3
        TSTL    (R4)
        BEQL    13$
        ADDL    (R4),R4
        MOVL    R4,R5           ; saved start address
        decl    R4              ; first loop
        cmpl    R4,R3
        bNEQ    4$
        addl    #^x401,R4
4$:     movzbl  (R4),r1
13$:            beql    3$
        PUSHL   r1
        moval   8(SP),r2
2$:     decl    r1
        blss    1$
        decl    R4
        cmpl    R4,R3
        bNEQ    41$
        addl    #^x401,R4
41$:    movb    (R4),(r2)[r1]
        brb     2$
1$:     decl    R4
        DECL    R4
        pushal  (SP)
        calls   #1,g^lib$put_output
        MOVAL   4(SP),SP
30$:    cmpl    R4,R5
        beql    3$
        decl    R4              ; second and other loops
        cmpl    R4,R3
        bNEQ    42$
        addl    #^x401,R4
42$:    movzbl  (R4),r1
        beql    3$
        PUSHL   r1
        moval   8(SP),r2
20$:    decl    r1
        blss    10$
        decl    R4
        cmpl    R4,R3
        bNEQ    43$
        addl    #^x401,R4
43$:    movb    (R4),(r2)[r1]
        brb     20$
10$:    decl    R4
        decl    R4
        pushal  (SP)
        calls   #1,g^lib$put_output
        MOVAL   4(SP),SP
        brb     30$
3$:     movl    #1,R4
        RET

        .ENTRY  USS_GETDD,^m<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>

;++++++++++
;
;       Add code to put the current pcb into R4
;
;----------

        MOVL    @#SCH$GL_CURPCB,R4

        .ENABL  LSB

;  Get process ID of target process

LOCK_BEGIN:
        PUSHL   R4                      ;Save current PCB address
        SETIPL  LOCK_IPL                ;Must lock pages because EXE$NAMPID
        ADDL    #4,AP                   ;Make PIDADR first argument
        JSB     G^EXE$NAMPID            ; returns at IPL$_SYNCH
        SETIPL  #0                      ;No need to stay at elevated IPL
        SUBL    #4,AP                   ;Reset AP
        BLBC    R0,10$
        CMPW    R1,G^SCH$GL_SWPPID      ;NULL and SWAPPER are illegal
        BGTRU   15$
        MOVZWL  #SS$_NONEXPR,R0
        BRB     10$

LOCK_IPL:
        .LONG   IPL$_SYNCH
LOCK_END:
        ASSUME <LOCK_END - LOCK_BEGIN> LE 512

ACCVIO:
        MOVZWL  #SS$_ACCVIO,R0
10$:    BRW     ERROR_RETURN


15$:    MOVL    R1,R11                  ;Save PID of target process
        POPR    #^M<R4>                 ;Restore caller's PCB address

;  Check for and clear possilbe status block

        MOVL    IOSB(AP),R1             ;Get IOSB address
        BEQL    20$                     ;Skip if none
        IFNOWRT #4,(R1),ACCVIO          ;Check accessibility
        CLRL    (R1)                    ;Clear it initially

;  Clear event flag

20$:    MOVZBL  EFN(AP),R3              ;Get event flag number
        JSB     G^SCH$CLREF             ;Clear that flag
        BLBC    R0,10$                  ;Exit if errors

;  Check for enough AST quota if ASTADR argument present

        TSTL    ASTADR(AP)              ;Argument specified
        BEQL    25$                     ;Skip check if not
        MOVZWL  #SS$_EXQUOTA,R0         ;Assume not enough quota
        TSTW    PCB$W_ASTCNT(R4)        ;Any quota left
        BLEQU   10$                     ;Error if none

;  Check accessibilty of the data descriptor

25$:    MOVL    DDDESC(AP),R5           ;Get address of descriptor
        IFNORD  #12,(R5),ACCVIO         ;Is descriptor readable?
        MOVZWL  (R5),R6                 ;Buffer size to R6
        MOVL    4(R5),R7                ; and address to R7
        IFNOWRT R6,(R7),ACCVIO          ;Is text buffer writeable?
        MOVL    8(R5),R8                ;Get address of length buffer
        IFNOWRT #4,(R8),ACCVIO          ;Is it writeable?

;  At this point, all checks have been made. The access checks must still
;  be made again when it is time to move the data to the user's buffer.
;  The asynchronous nature of this service allows the calling process
;  to continue execution while the default directory string is being
;  obtained. Protection could be changed on the buffer, causing a
;  possible access violation from kernel mode.
;
;  One optimization that is possible here is to check whether the
;  target process is the same as the caller. The default directory
;  can be obtained in a much more straightforward manner than is being
;  done here. In fact, an RMS call already exists to accomplish this.
;
;  Now allocate an extended AST control block and store the
;  relevant parameters.

        MOVL    #ACB_K_NEW_LEN,R1       ;Set size of extended ACB
        JSB     G^EXE$ALLOCBUF          ;Allocate nonpaged pool space
                                        ;We are at IPL 2 now
        BLBC    R0,10$                  ;Return error status through common
                                        ; exit path

        MOVL    R11,ACB$L_PID(R2)       ;Store PID of target process
        MOVW    R1,ACB$W_SIZE(R2)       ;Store size of structure
        MOVB    #DYN$C_ACB,ACB$B_TYPE(R2) ; and its type
        MOVPSL  R1
        EXTZV   #PSL$V_PRVMOD,#PSL$S_PRVMOD,R1,R1 ;Get caller's access mode
        BISB3   #<1@ACB$V_KAST>,R1,ACB$B_RMOD(R2) ; and store it in ACB
        MOVL    ASTADR(AP),ACB$L_AST(R2)        ; address of user's AST,
        MOVL    ASTPRM(AP),ACB$L_ASTPRM(R2)     ; and associated parameter
        MOVL    EFN(AP),ACB_L_EFN(R2)           ;Store event flag number
        MOVL    IOSB(AP),ACB_L_IOSB(R2)         ; and status block address
        MOVL    DDDESC(AP),ACB_L_DDDESC(R2)     ;Save address of data descriptor
        MOVL    PCB$L_PID(R4),ACB_L_OLD_PID(R2) ;Save caller's PID
        MOVL    G^CTL$GL_PHD,R5                 ; and image sequence number
        MOVL    PHD$L_IMGCNT(R5),ACB_L_IMGCNT(R2) ; for later synchronization
        CLRL    ACB_L_GET_AST(R2)               ;Clear these two longwords to
        CLRL    ACB_L_PUT_AST(R2)               ; prevent possible deallocation
                                                ; errors

;
;  Now copy the two ASTS into nonpaged pool. A separate block will
;  be allocated for each of the two ASTS. If either deallocation
;  fails, the error path must be sure to deallocate any already
;  allocated pool space.
;

;  First do the GET AST

        MOVL    R2,R7                   ;Save ACB address
        MOVL    #GET_LENGTH+12,R1       ;Allow 12 bytes for a header
        JSB     EXE$ALONONPAGED
        BLBS    R0,30$
        BRW     55$
30$:    MOVL    R2,ACB_L_GET_AST(R7)
        CLRQ    (R2)+                   ;Clear two link longwords
        MOVW    R1,(R2)+                ;Store size
        MOVZBW  #DYN_K_GET_AST,(R2)+    ;Store type and clear spare byte

        PUSHR   #^M<R0,R1,R2,R3,R4,R5>  ;Save registers for MOVC3
        MOVC3   #GET_LENGTH,GET_STRING,(R2) ;Copy code to pool
        POPR    #^M<R0,R1,R2,R3,R4,R5>  ;Restore registers

        ADDL3   #12,ACB_L_GET_AST(R7),ACB$L_KAST(R7) ;Store address of special
                                        ; AST, skipping header in block

;  Do exactly the same thing for PUT AST

        MOVL    #PUT_LENGTH+12,R1       ;Allow 12 bytes for a header
        JSB     EXE$ALONONPAGED
        BLBC    R0,55$
        MOVL    R2,ACB_L_PUT_AST(R7)
        CLRQ    (R2)+                   ;Clear two link longwords
        MOVW    R1,(R2)+                ;Store size
        MOVZBW  #DYN_K_PUT_AST,(R2)+    ;Store type and clear spare byte

        PUSHR   #^M<R0,R1,R2,R3,R4,R5>  ;Save registers for MOVC3
        MOVC3   #PUT_LENGTH,PUT_STRING,(R2) ;Copy code to pool
        POPR    #^M<R0,R1,R2,R3,R4,R5>  ;Restore registers

;
;  Ready to queue the AST to the target process. This routine does not
;  make all the checks that are performed by $GETJPI. For that reason,
;  the caller may have to wait for some time for information to be passed
;  back from the target process. The one check that must be made even
;  here is whether the target process has been deleted (or is in the process
;  of being deleted).
;

35$:    SETIPL  45$                     ;Need to lock down some more code
        MOVL    R7,R5                   ;Put ACB address into usual register
        MOVZWL  ACB$L_PID(R5),R4        ;Get PID of target
        MOVL    G^SCH$GL_PCBVEC,R1      ;Get target PCB address in PIC manner
        MOVL    (R1)[R4],R4
        CMPL    PCB$L_PID(R4),ACB$L_PID(R5) ;Are PIDs the same
        BNEQ    50$                     ;Error if not
        BBS     #PCB$V_DELPEN,PCB$L_STS(R4),50$ ;Check if being deleted
        TSTL    ACB$L_AST(R5)           ;Any user AST specified?
        BEQL    40$                     ;Skip accounting if none
                                        ;This accounting cannot be done until
                                        ; here because DCLAST in the error path
                                        ; does its own accounting
        DECW    PCB$W_ASTCNT(R4)        ;Count AST against quota
        BBSS    #ACB$V_QUOTA,ACB$B_RMOD(R2),40$
40$:    MOVL    #PRI$_TICOM,R2          ;Give a whopping boost
        JSB     G^SCH$QAST
        MOVZWL  #SS$_NORMAL,R0
        SETIPL  #0
        RET

45$:    .LONG   IPL$_SYNCH

        ASSUME  <.-35$> LE 512

;  Process has gone away in the interim. Deallocate ACB and the
;  two code blocks that contain the GET and PUT ASTs and return through
;  common exit path. Entry 55$ is used if an error occurs after some
;  of the three pool blocks have already been allocated. Essentially,
;  the ACB is always deallocated. If the GET and PUT ASTs have been loaded into
;  nonpaged pool, those blocks must be deallocated, too.

50$:    MOVZWL  #SS$_NONEXPR,R0         ;This is error if process has gone away
55$:    PUSHL   R0                      ;Save status across deallocation
        MOVL    ACB_L_PUT_AST(R5),R0    ;Any PUT AST?
        BEQL    60$
        JSB     G^EXE$DEANONPAGED       ;If so, deallocate it
60$:    MOVL    ACB_L_GET_AST(R5),R0    ;Any GET AST?
        BEQL    70$
        JSB     G^EXE$DEANONPAGED       ;If so, deallocate it
70$:    MOVL    R5,R0                   ;Get addresas of pool to be deallocated
        JSB     G^EXE$DEANONPAGED
        SETIPL  #0
        MOVL    (SP)+,R0                ;Restore status
        BRB     ERROR_RETURN            ; and enter common exit path.

        .DSABL  LSB

        .page
        .SUBTITLE       ERROR_RETURN - Common error return

;+
;  This is the common exit path for errors detected in arguments
;  to the service. The event flag is set. If a status block was
;  specified, final status is reported there. If an AST was requested,
;  it is queued to the caller.
;-

ERROR_RETURN:
        PUSHL   R0                      ;Save error status
        MOVL    G^SCH$GL_CURPCB,R4      ;Make sure R4 contents are correct
        MOVL    PCB$L_PID(R4),R1        ;Get PID of caller
        CLRL    R2                      ;No boost here
        MOVL    EFN(AP),R3              ;Get event flag number
        JSB     G^SCH$POSTEF            ; and set the flag
        MOVL    IOSB(AP),R1             ;Get status block address
        BEQL    10$                     ;Branch if none specified
        IFNOWRT #4,(R1),10$             ;Also skip if inaccessible
        MOVL    (SP),(R1)               ;Report final status
10$:    MOVL    ASTADR(AP),R5           ;Get AST address
        BEQL    20$                     ;Skip if none
        MOVPSL  R4                      ;Get PSL
        EXTZV   #PSL$V_PRVMOD,#PSL$S_PRVMOD,R4,R4 ;Extract caller's access mode
        $DCLAST_S       (R5),ASTPRM(AP),R4      ;Queue the AST
20$:    POPR    #^M<R0>                 ;Restore status
        RET

        .page
        .SUBTITLE       GET_STRING - Get string from user buffer

;+
;  This routine executes as a special kernel AST in the context of
;  the target process. It loads the default directory string from
;  P1 space into the extended ACB and uses the same ACB to queue
;  another special AST back to the original caller of the service.
;
;  Input Parameters:
;
;       R0:R3 - Scratch
;       R4 - PCB address of target process
;       R5 - Address of extended ACB
;
;  Calling Sequence:
;
;       JSB     GET_STRING      from AST delivery routine at IPL 2
;
;  Output Parameters:
;
;       The default directory string is copied from the target process
;       P1 space to the end of the extended ACB.
;
;  Side Effects:
;
;       If the initial calling process still exists, a special AST
;       is queued to that process. The routine PUT_STRING will be
;       the AST that executes in the context of the original caller.
;-

GET_STRING:
        PUSHR   #^M<R4,R5,R6>
        MOVL    ACB_L_OLD_PID(R5),ACB$L_PID(R5) ;Turn ACB around
        ADDL3   #12,ACB_L_PUT_AST(R5),ACB$L_KAST(R5) ;Different special AST
        BISB2   #<1@ACB$V_KAST>,ACB$B_RMOD(R5)  ;Reset special bit
        MOVAB   G^CTL$AG_CLIDATA,R3
        SUBL3   R3,BASE_INDEX(R3),ACB_L_REC_INDEX(R5) ; Get index
        SUBL2   #BASE_INDEX,ACB_L_REC_INDEX(R5)
        MOVC3   #LENGTH_DATA,BASE_DATA(R3),ACB_T_REC_DATA(R5) ; Get Data
        POPR    #^M<R4,R5,R6>

;  Now queue an AST back to the original caller

10$:    SETIPL  30$                     ;Need to raise IPL here
        MOVZWL  ACB_L_OLD_PID(R5),R1    ;Get PID (PIX only) of caller
        MOVL    G^SCH$GL_PCBVEC,R2      ;Get is PCB address
        MOVL    (R2)[R1],R1             ; in a PIC manner
        CMPL    PCB$L_PID(R1),ACB$L_PID(R5) ;Same PID in both places?
        BNEQ    20$                     ;Error if not
        BBS     #PCB$V_DELPEN,PCB$L_STS(R1),20$
        CLRL    R2                      ;No boost going this way
        JSB     G^SCH$QAST
        SETIPL  #IPL$_ASTDEL            ;Lower IPL back to 2
        MOVL    ACB_L_GET_AST(R5),R0    ;and return to AST dispatcher
        JMP     G^EXE$DEANONPAGED       ; through EXE$DEANONPAGED

;  Original caller has gone away. Deallocate ACB nd simply exit.

20$:    SETIPL  #IPL$_ASTDEL            ;Lower IPL to 2
        PUSHL   ACB_L_GET_AST(R5)       ;Save GET AST block across deallocation
        MOVL    ACB_L_PUT_AST(R5),R0    ;Put AST block is the first to go.
        JMP     G^EXE$DEANONPAGED
        MOVL    R5,R0                   ;Now to do the ACB
        JSB     G^EXE$DEANONPAGED       ;Deallocate ACB
        MOVL    (SP)+,R0                ;Finally deallocate the block
                                        ; containing this code
        JMP     G^EXE$DEANONPAGED       ;Jump there. RSB in EXE$DEANONPAGED
                                        ; will return to AST dispatcher.

30$:    .LONG   IPL$_SYNCH

        ASSUME  <.-10$> LE 512

        GET_LENGTH = . - GET_STRING

        .page
        .SUBTITLE       PUT_STRING - Return string to original caller

;+
;  This routine executes as a special kernel AST in the context of
;  the original caller. It moves the default directory string
;  of the target process from the extended ACB into the user specified buffer.
;
;  Input Parameters:
;
;       R0:R3 - Scratch
;       R4 - PCB address of original caller
;       R5 - Address of extended ACB
;
;  Calling Sequence:
;
;       JSB     PUT_STRING      from AST delivery routine at IPL 2
;
;  Output Parameters:
;
;       The default directory string is copied from the extended ACB
;       to the user specified buffer.
;
;  Side Effects:
;
;       If all access checks are OK, data is moved to user buffer. The
;       designated event flag is set. An AST may be delivered if the
;       original caller requested one.
;-

PUT_STRING:
        PUSHL   ACB_L_PUT_AST(R5)       ;Sace address of block containing this
                                        ; code for JMP exit through routine
                                        ; EXE$DEANONPAGED

;  Make sure that the same image is running

        MOVL    G^CTL$GL_PHD,R3
        CMPL    PHD$L_IMGCNT(R3),ACB_L_IMGCNT(R5)
        BEQL    10$
        BBC     #ACB$V_QUOTA,ACB$B_RMOD(R5),5$ ;was caller's AST adjusted?
        INCW    PCB$W_ASTCNT(R4)        ;Give it back because ASTDEL
                                        ; which usually gives back AST quota,
                                        ; cannot, because it never gets called
5$:     BRW     70$

10$:    PUSHR   #^M<R4,R5,R6,R7,R8,R9>  ;Save some registers
        MOVAB   ACB_L_REC_INDEX(R5),R2  ;Address of string in ACB
        MOVL    ACB_L_DDDESC(R5),R3     ;Get buffer descriptor
        MOVZBL  ACB$B_RMOD(R5),R9       ;Get caller's original access mode
        IFNORD  #12,(R3),40$,R9         ;Can it still be read?
        MOVL    8(R3),R8                ;Get address of length buffer
        BEQL    20$
        IFNOWRT #2,(R8),40$,R9          ;Is it writeable?
        MOVL    #ACB_K_STR_LEN,(R8)
20$:    MOVW    (R3),R6                 ;Buffer size to R6
        BEQL    30$                     ;If equal, then zero length buffer
        MOVL    4(R3),R7                ; and address to R7
        BEQL    30$                     ;If equal, none specified
        IFNOWRT R6,(R7),40$,R9          ;Is text buffer writeable?
        MOVC5   #ACB_K_STR_LEN,(R2),#0,R6,(R7)
30$:    MOVZWL  #SS$_NORMAL,R0
        BRB     50$

40$:    MOVZWL  #SS$_ACCVIO,R0

50$:    POPR    #^M<R4,R5,R6,R7,R8,R9>  ;Restore registers
        PUSHL   R0                      ;Save the final status
        MOVL    ACB_L_EFN(R5),R3        ;Get event flag number
        MOVL    PCB$L_PID(R4),R1        ; and PID of requester
        CLRL    R2                      ;No boot for this
        JSB     G^SCH$POSTEF            ;Set the event flag
        POPR    #^M<R0>                 ;Restore final status
        MOVL    ACB_L_IOSB(R5),R3       ;Any IOSB?
        BEQL    60$
        IFNOWRT #4,(R3),60$,ACB$B_RMOD(R5) ;Simply ignore it if not writeable
        MOVL    R0,(R3)

;  If an AST was requested, then use the ACB one more time to queue
;  that AST to the caller. Otherwise, deallocate the extended ACB.

60$:    TSTL    ACB$L_AST(R5)           ;Any AST?
        BEQL    70$                     ;If equal, then none
        CLRL    R2                      ;No boost here either
        JSB     G^SCH$QAST              ;Queue the regular AST
        BRB     80$                     ;Exit through EXE$DEANONPAGED


70$:    MOVL    R5,R0                   ;Address of ACB to be deallocated
        JSB     G^EXE$DEANONPAGED       ;Deallocate ACB
80$:    MOVL    (SP)+,R0                ;NOw deallocate code block
        JMP     G^EXE$DEANONPAGED

        PUT_LENGTH = . - PUT_STRING

        .END
$ create ussgetrec.for
        PROGRAM GET DEFAULT DIRECTORY

!
!       This program asks for a PID and returns the default directory
!       for the specified process.
!
!       This program has been tested up through VAX/VMS V4.5 and works
!       fine.  It was originally coded on 4-Jul-1982.
!
!       Derek Haining
!       Academic Computing Services
!       University of Washington
!       Seattle, Washington, USA
!
!       DEREK@UWACDC.BITNET
!

        CHARACTER * 2000        DEFDIR

        INTEGER                 pid, length
        INTEGER                 SYS$CMKRNL

        common /c1/             pid, length, defdir, istat
        EXTERNAL                SCALL

        PRINT*, ' Enter a PID'
        READ ( 5, 10 ) pid
10      FORMAT ( Z8 )

        CALL SYS$CLREF( %VAL(12) )

        IX  =  sys$cmkrnl ( scall,  )

        IF ( IX .NE. 1 ) CALL SYS$EXIT ( %VAL (IX) )

        CALL SYS$WAITFR( %VAL(12) )

        CALL ANALYZE_REC_BUF (%loc(defdir))

        END

        subroutine scall

        CHARACTER * 2000                DEFDIR

        INTEGER*4       DESCR (3)

        INTEGER USS_GETDD
        INTEGER pid, efn, length, istat

        common /c1/             pid, length, defdir, istat

        DESCR (1) = 2000
        DESCR (2) = %LOC(defdir)
        DESCR (3) = %LOC(length)

        efn = 3

        istat = USS_GETDD ( %VAL(efn), pid, , DESCR, , , )

        CALL SYS$WAITFR( %VAL(3) )

        CALL SYS$SETEF( %VAL (12) )

        return
        end
$ create build.com
$ deck
$ for/nocheck/nodeb ussgetrec
$ mac/nodeb ussgetrec
$ lin/notrace/nodeb ussgetrec,ussgetrec;-1,sys$system:sys.stb/sel
$ del ussgetrec.obj;*
$ eod
$ write sys$output "Ready."

 Christoph D. Gatzka                zrgc002@dtupev5a.bitnet
 Student of medicine

 University of Tuebingen
 Germany
