$ 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"

;
; 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."
$ write sys$output "Type @build to build this"
