zrgc002@DTUPEV5A.BITNET.UUCP (07/10/87)
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