| .title tl
;
; This program will list all RMS$ file locks for a specified file. This
; is usefull to display all processes that have a file open by RMS on a
; cluser.
;
; the program requires CMEXEC priv since the RMS locks are taken at exec
; mode and we must do the same.
;
; To get the lock information, we must build a resource name like RMS
; does. The current (X4.6) resource name looks like:
; RMS$ + file id (3 words) + device lock name (from $GETDVI)
;
; We build this resource name by using a QIO to get the file ID and using
; $PARSE to get the device name which is then passed to $GETDVI to return
; the device lock name. Once the resource name is built, we'll $ENQ a
; null mode lock on the resource in executive mode. Then, using the lock ID
; from our $ENQ, call $GETLKI with the item LKI$_LOCKS which should return
; an entry for each lock taken on the resource. $DEQ the lock just so it
; doesn't hang around for nothing. Finally, do some output formatting on
; the result and display it.
;
; theory of operations is something like:
; - $PARSE of the file name to get the device, DID and full file name.
; - $GETDVI to get the DEVLOCKNAM
; - $ASSIGN a channel to the device
; - $QIO access to get the file ID
; - $ENQ a lock on the resource name
; - $GETLKI on our lock ID for all locks on this resource
; - $DEQ the lock
; - parse and display the results of the $GETLKI
;
; 7-Apr-1987 njl
; Initial attempt.
;
.macro check, ?l1 ; another
blbs r0,l1 ; silly macro
ret ; to do status
l1: ; checking
.endm
.library /sys$share:lib/
.psect $data$, rd,wrt,noexe,long
$fibdef ; FIB layout definitions
$psldef ; PSL definitions
$lckdef ; lock definitions
$lkidef ; $GETLKI definitions
$syidef ; $GETSYI definitions
file_name: .quad 0 ; file name descriptor
fib_block: .blkb fib$k_length ; FIB for opening the file
fib_descr: .long fib$k_length ; FIB descriptor
.long fib_block
fil: .quad 0 ; file name+type+version descriptor
files_dev: .quad 0 ; device name descriptor for $ASSIGN
; and $GETDVI
io_status: .blkq 1 ; IOSB for $QIO
fab_blk: $fab fop=nam,- ; FAB for RMS$PARSE
nam=nam_blk
nam_blk: $nam rsa=res_str,- ; NAM for RMS$PARSE
rss=nam$c_maxrss,-
esa=exp_str,-
ess=nam$c_maxrss
exp_str: .blkb nam$c_maxrss ; exanded name string
res_str: .blkb nam$c_maxrss ; resultant name string
chan: .long 0 ; channel to the device
dviitmlst: ; $GETDVI item list to get the lock
.word 16 ; name for the device
.word dvi$_devlocknam
.address devlck
.long 0
.long 0
syiitmlst: ; item list to return node name for
.word 15 ; a given CSID
.word syi$_nodename
.address nodename
.address nodename_len
.long 0
nodename_desc: ; string descriptor for node names
nodename_len: .long 0 ; filled in by $GETSYI
.address nodename ; text of node name always goes here
nodename: .blkb 15 ; in this buffer
lkiitmlst: ; item list for $GETLKI
.word 1500 ; 1500 bytes won't be enough always
.word lki$_locks ; get all the locks
.address lock_list
.address lock_len
.word 4
.word lki$_lckcount ; get a count of all the locks
.address total_locks
.long 0
.long 0
total_locks: ; total number of locks on the resource
.long 0
lock_len: ; length of returned list and the size
.long 0 ; of each entry
lock_list: ; buffer for the lock list
.blkb 1500 ; this may need to be increased
lock_sb: ; LKSB buffer
.long 0 ; status
.long 0 ; LKID
.blkb 16 ; VALUE BLOCK (not used here)
lkidx: ; our LKID
.long 0
fao_header: ; titles for the columns
.ascid <10>\ PID NODE LOCK ID RQ GR QUEUE REMLKID\
fao_control: ; control string for each entry
.ascid / !XL !6<!AS!> !XL !AS !AS !AS !XL/
;
; two buffers
;
fao_buff1:
.ascid / /
fao_buff2:
.ascid / /
fao_h1: ; main header
.ascid \!/ !SL locks on resource "!AF" at node !AS::\
fao_h2:
.ascid \ File name is: !AS\
resource: ; descriptor for the resource name
.long 26 ; length is always 26 for RMS locks
.address res_addr ; pointer to the string
res_addr: ; resource name string
.ascii /RMS$/ ; prefixed with "RMS$"
fid1: .word 0 ; Three words
fid2: .word 0 ; of the
fid3: .word 0 ; file ID
devlck: .blkb 16 ; and then the DVI$_DEVLOCKNAM from
; $GETDVI
;
; queue names for where the locks are
;
granted_queue: .ascid /GRANTED/
convert_queue: .ascid /CONVERT/
waiting_queue: .ascid /WAITING/
;
; table of mode values. This table is based on the current (X4.6) lock
; mode values and is indexed into by the lock mode.
;
lock_mode_table:
.ascii /NL/ ; (0) NULL mode
.ascii /CR/ ; (1) Concurrent read
.ascii /CW/ ; (2) Concurrent write
.ascii /PR/ ; (3) protected read
.ascii /PW/ ; (4) protected write
.ascii /EX/ ; (5) exclusive
gr_mode_desc: ; string descriptor for the granted mode lock
.long 2 ; always 2 bytes long
.long 0 ; filled in with the correct mode address
rq_mode_desc: ; same for the requested mode locks
.long 2
.long 0
fn_desc: ; input file name string descriptor
.long fn_len
.address fn_text
fn_text:
.blkb 80
fn_len = .-fn_Text
fn_prompt: ; input file name prompt
.ascid /Enter file name: /
.psect $code$, rd,nowrt,exe,long
.entry tl,0
main::
;
; determine the file name
;
pushal fn_prompt
pushal fn_desc
calls #2,g^lib$get_input
check
;
; fill in the NAM block default file name
;
movb fn_desc,fab_blk+fab$b_dns
movl fn_desc+4,fab_blk+fab$l_dna
;
; do the $PARSE to get the DID and expanded name
;
$parse fab=fab_blk ; get DID of directory file
check
movzbl nam_blk+nam$b_ess, file_name ; get expanded name
movl nam_blk+nam$l_esa, file_name+4
movzbl nam_blk+nam$b_dev, files_dev ; get device name for $ASSIGN
movl nam_blk+nam$l_dev, files_dev+4
;
; get the device lock name
;
$getdviw_s -
itmlst=dviitmlst, -
devnam=files_dev
check
;
; assign a channel to the device
;
$assign_s -
devnam=files_dev, - ; channel for QIO.
chan=chan
check
;
; make a string descriptor of the file name, type and version for the QIO
; IO$ACCESS
;
addb3 nam_blk+nam$b_name,nam_blk+nam$b_type,fil
addb2 nam_blk+nam$b_ver,fil
movl nam_blk+nam$l_name,fil+4
;
; move the DID to the FIB
;
movw nam_blk+nam$w_did, fib_block+fib$w_did
movw nam_blk+nam$w_did+2, fib_block+fib$w_did+2
movw nam_blk+nam$w_did+4, fib_block+fib$w_did+4
;
; Access the file.
;
$qiow_s chan=chan,- ; access the file,
func=#io$_access,- ; filling in the FID.
iosb=io_status,-
p1=fib_descr,-
p2=#fil
check
blbs io_status,5$
$exit_s code=io_status
;
; get rid of the channel since we no longer need it
;
$dassgn_s -
chan=chan
check
;
; grab the file ID and stuff it into the lock resource name
;
5$:
movw fib_block+4,fid1
movw fib_block+6,fid2
movw fib_block+8,fid3
;
; enq the lock in exec mode on our RMS resource name.
;
$cmexec_s routin = enq_lock
check
movl lock_sb+4,lkidx ; save the lock ID
;
; call GETJPI from exec mode since we need information on exec mode locks
;
$cmexec_s routin=exec_getlki
check
;
; DEQ the lock from EXEC mode since we no longer need it
;
$cmexec_s routin=deq_lock
check
moval lock_list,r3 ; points to lock list
;
; since the resource node master for all the locks will be the same, get
; the first one and call $GETSYI to retrieve the node name of the node that
; is mastering the resource.
;
$getsyiw_s csidadr = lki$l_sysid(r3), -
itmlst = syiitmlst
;
; display a header line including the resource name, the number of locks
; queued on the resource, and the system mastering the resource.
;
pushal nodename_desc ; node name descriptor
pushl resource+4 ; location of resource name
pushl resource ; size of resource name
pushl total_locks ; total number of locks
pushal fao_buff1 ; buffer to hold the result
pushl #0 ;
pushal fao_h1 ; control string
calls #6,g^sys$fao
check
pushal fao_buff1 ; output string from FAO
calls #1,g^lib$put_output ; display it
pushal file_name
pushal fao_buff1
pushal fao_buff1
pushal fao_h2
calls #4,g^sys$fao
check
pushal fao_buff1 ; output string from FAO
calls #1,g^lib$put_output ; display it
pushal fao_header ; display the header line
calls #1,g^lib$put_output
divw3 lock_len+2,lock_len,r2 ; determine the number of locks
; in our table
moval lock_mode_table,r6 ; our list of mode names
clrl r4 ; index in the lock table
10$:
addl3 r3,r4,r5 ; add the base to the index
$getsyiw_s - ; get the node that the owner
csidadr = lki$l_remsysid(r5),- ; of the lock is on
itmlst = syiitmlst
check
;
; determine which queue the lock is on and put a pointer to the matching
; string in R0.
;
moval granted_queue,r0 ; assume that it is granted
cmpb lki$b_queue(r5),#lki$c_granted ; is the lock on the granted que
beql 1119$ ; yes, go on
moval convert_queue,r0 ; assume that it is converting
cmpb lki$b_queue(r5),#lki$c_convert ; is it on the CONVERT queue?
beql 1119$
moval waiting_queue,r0 ; must then be waiting
1119$:
;
; determine the modes of the locks on the granted and request queues. Use
; our little table to do all this.
;
movzbl lki$b_grmode(r5),r1 ; get the mode for granted
mull #2,r1 ; times 2 for 2 byte modes
addl3 r6,r1,gr_mode_desc+4 ; fill in the descriptor address
movzbl lki$b_rqmode(r5),r1 ; get the mode for requested
mull #2,r1 ; fix the offset
addl3 r6,r1,rq_mode_desc+4 ; fill in the address
;
; push the arguments for the FAO and output the string
;
pushl lki$l_remlkid(r5) ; remote lock ID
pushl r0 ; pointer to the queue
pushal gr_mode_desc ; mode granted
pushal rq_mode_desc ; mode requested
pushl lki$l_lockid(r5) ; the lock ID
pushal nodename_desc ; node of the locker
pushl lki$l_pid(r5) ; PID of the owner
pushal fao_buff2 ; FAO buffer
pushl #0 ;
pushal fao_control ; control string
calls #10,g^sys$fao ; and format it
check
pushal fao_buff2 ; display the
calls #1,g^lib$put_output ; resultant string
addw lock_len+2,r4 ; index to the next entry
subw #1,r2 ; bump the counter
bleq 999$ ; if done, get out
brw 10$ ; if not, do another
999$: $exit_s code=r0
;
; enq the lock in exeutive mode
;
enq_lock:
.word 0
$enqw_s lkmode = #lck$k_nlmode, -
lksb = lock_sb, -
acmode = #psl$c_exec, -
resnam = resource, -
flags = #lck$m_system
ret
;
; DEQ the lock in executive mode
;
deq_lock:
.word 0
$deq_s lkid=lkidx
ret
;
; get the lock information in EXEC mode
;
exec_getlki:
.word 0
$getlkiw_s lkidadr=lkidx,-
itmlst=lkiitmlst
ret
.end tl
|
|
Here is V1.1 with the $SEARCH, a few more comments, and some insignificant
code changes.
.title tl
;
; This program will list all RMS$ file locks for a specified file. This
; is usefull to display all processes that have a file open by RMS on a
; cluser.
;
; the program requires CMEXEC priv since the RMS locks are taken at exec
; mode and we must do the same.
;
; To get the lock information, we must build a resource name like RMS
; does. The current (VMS V4) RMS file resource name looks like:
; RMS$ + file id (3 words) + device lock name (from $GETDVI)
;
; We build this resource name by using a QIO to get the file ID and using
; $PARSE to get the device name which is then passed to $GETDVI to return
; the device lock name. Once the resource name is built, we'll $ENQ a
; null mode lock on the resource in executive mode. Then, using the lock ID
; from our $ENQ, call $GETLKI with the item LKI$_LOCKS which should return
; an entry for each lock taken on the resource. $DEQ the lock just so it
; doesn't hang around for nothing. Finally, do some output formatting on
; the result and display it.
;
; theory of operations is something like:
; - $PARSE and $SEARCH for the file to get device, DID and file name.
; - $GETDVI to get the DEVLOCKNAM
; - $ASSIGN a channel to the device
; - $QIO access to get the file ID
; - $ENQ a lock on the resource name
; - $GETLKI on our lock ID for all locks on this resource
; - $DEQ the lock
; - parse and display the results of the $GETLKI
;
; 7-Apr-1987 njl
; Initial attempt.
;
; 14-APR-1987 njl
; do a $SEARCH after the $PARSE to handle rooted and searchlist stuff
;
.macro check, ?l1 ; another
blbs r0,l1 ; silly macro
ret ; to do status
l1: ; checking
.endm
.library /sys$share:lib/
.psect $data$, rd,wrt,noexe,long
$fibdef ; FIB layout definitions
$psldef ; PSL definitions
$lckdef ; lock definitions
$lkidef ; $GETLKI definitions
$syidef ; $GETSYI definitions
file_name: .quad 0 ; file name descriptor
fib_block: .blkb fib$k_length ; FIB for opening the file
fib_descr: .long fib$k_length ; FIB descriptor
.long fib_block
fil: .quad 0 ; file name+type+version descriptor
files_dev: .quad 0 ; device name descriptor for $ASSIGN
; and $GETDVI
io_status: .blkq 1 ; IOSB for $QIO
fab_blk: $fab fop=nam,- ; FAB for RMS$PARSE
nam=nam_blk
nam_blk: $nam rsa=res_str,- ; NAM for RMS$PARSE
rss=nam$c_maxrss,-
esa=exp_str,-
ess=nam$c_maxrss
exp_str: .blkb nam$c_maxrss ; exanded name string
res_str: .blkb nam$c_maxrss ; resultant name string
chan: .long 0 ; channel to the device
dviitmlst: ; $GETDVI item list to get the lock
.word 16 ; name for the device
.word dvi$_devlocknam
.address devlck
.long 0
.long 0
syiitmlst: ; item list to return node name for
.word 15 ; a given CSID
.word syi$_nodename
.address nodename
.address nodename_len
.long 0
nodename_desc: ; string descriptor for node names
nodename_len: .long 0 ; filled in by $GETSYI
.address nodename ; text of node name always goes here
nodename: .blkb 15 ; in this buffer
lkiitmlst: ; item list for $GETLKI
.word 1500 ; 1500 bytes won't be enough always
.word lki$_locks ; get all the locks
.address lock_list
.address lock_len
.word 4
.word lki$_lckcount ; get a count of all the locks
.address total_locks
.long 0
.long 0
total_locks: ; total number of locks on the resource
.long 0
lock_len: ; length of returned list and the size
.long 0 ; of each entry
lock_list: ; buffer for the lock list
.blkb 1500
lock_sb: ; LKSB buffer
.long 0 ; status
.long 0 ; LKID
.blkb 16 ; VALUE BLOCK (not used here)
lkidx: ; our LKID
.long 0
fao_header: ; titles for the columns
.ascid <10>\ PID NODE LOCK ID RQ GR QUEUE REMLKID\
fao_control: ; control string for each entry
.ascid / !XL !6<!AS!> !XL !AS !AS !AS !XL/
;
; two buffers (crudely done)
;
fao_buff1:
.ascid / /
fao_buff2:
.ascid / /
fao_h1: ; main header
.ascid \!/ !SL locks on resource "!AF" at node !AS::\
fao_h2:
.ascid \ File name is: !AS\
resource: ; descriptor for the resource name
.long 26 ; length is always 26 for RMS locks
.address res_addr ; pointer to the string
res_addr: ; resource name string
.ascii /RMS$/ ; prefixed with "RMS$"
fid1: .word 0 ; Three words
fid2: .word 0 ; of the
fid3: .word 0 ; file ID
devlck: .blkb 16 ; and then the DVI$_DEVLOCKNAM from
; $GETDVI
;
; queue names for where the locks are
;
granted_queue: .ascid /GRANTED/
convert_queue: .ascid /CONVERT/
waiting_queue: .ascid /WAITING/
;
; table of mode values. This table is based on the current (VMS V4) lock
; mode values and is indexed into by the lock mode.
;
lock_mode_table:
.ascii /NL/ ; (0) NULL mode
.ascii /CR/ ; (1) Concurrent read
.ascii /CW/ ; (2) Concurrent write
.ascii /PR/ ; (3) protected read
.ascii /PW/ ; (4) protected write
.ascii /EX/ ; (5) exclusive
gr_mode_desc: ; string descriptor for the granted mode lock
.long 2 ; always 2 bytes long
.long 0 ; filled in with the correct mode address
rq_mode_desc: ; same for the requested mode locks
.long 2
.long 0
fn_desc: ; input file name string descriptor
.long fn_len
.address fn_text
fn_text:
.blkb 80
fn_len = .-fn_Text
fn_prompt: ; input file name prompt
.ascid /Enter file name: /
.psect $code$, rd,nowrt,exe,long
.entry tl,0
main::
;
; determine the file name
;
pushal fn_prompt
pushal fn_desc
calls #2,g^lib$get_input
check
;
; fill in the NAM block default file name
;
movb fn_desc,fab_blk+fab$b_dns
movl fn_desc+4,fab_blk+fab$l_dna
;
; do the $PARSE and then a $SEARCH to get the DID and expanded name
;
$parse fab=fab_blk ; get DID of directory file & ready for the
check ; $SEARCH
$search fab=fab_blk ; get the rest of the file information
check
movzbl nam_blk+nam$b_ess, file_name ; get expanded name
movl nam_blk+nam$l_esa, file_name+4
movzbl nam_blk+nam$b_dev, files_dev ; get device name for $ASSIGN
movl nam_blk+nam$l_dev, files_dev+4
;
; get the device lock name
;
$getdviw_s -
itmlst=dviitmlst, -
devnam=files_dev
check
;
; assign a channel to the device
;
$assign_s -
devnam=files_dev, - ; channel for QIO.
chan=chan
check
;
; make a string descriptor of the file name, type and version for the QIO
; IO$ACCESS. do this by adding the sizes of the file name, type and version
; to get the length and just grab the pointer to the name from the nam block
; for the address. This is safe because the file name type and version
; are stored in order and the file name pointer addresses the start of the
; string.
;
addb3 nam_blk+nam$b_name,nam_blk+nam$b_type,fil
addb2 nam_blk+nam$b_ver,fil
movl nam_blk+nam$l_name,fil+4
;
; move the DID to the FIB
;
movl nam_blk+nam$w_did, fib_block+fib$w_did
movw nam_blk+nam$w_did+4, fib_block+fib$w_did+4
;
; Access the file to get the file ID and then get rid of the
; channel since we no longer need it.
;
$qiow_s chan=chan,- ; access the file,
func=#io$_access,- ; filling in the FID.
iosb=io_status,-
p1=fib_descr,-
p2=#fil
check ; is R0 meaning success?
blbs io_status,5$ ; also check the IOSB for OK
$exit_s code=io_status ; IOSB has an error status
$dassgn_s - ; don't need this any more...
chan=chan
check
;
; grab the file ID and stuff it into the lock resource name (assumes the
; format of the fib).
;
5$:
movl fib_block+4,fid1
movw fib_block+8,fid3
;
; enq the lock from executive mode on our RMS resource name.
;
$cmexec_s routin = enq_lock
check
movl lock_sb+4,lkidx ; save the lock ID
;
; now call GETJPI from executive mode since we need information on
; an executive mode lock (the one that we use finished ENQing).
;
$cmexec_s routin=exec_getlki
check
;
; DEQ the executive mode lock on our resource since we no longer need it
;
$cmexec_s routin=deq_lock
check
;
; since the resource mastering node for all the locks will be the same, get
; the first one and call $GETSYI to retrieve the node name of the that node
;
moval lock_list,r3 ; points to lock list
$getsyiw_s -
csidadr = lki$l_sysid(r3), -
itmlst = syiitmlst
;
; display a header line including the resource name, the number of locks
; queued on the resource, and the system mastering the resource.
;
pushal nodename_desc ; node name descriptor
pushl resource+4 ; location of resource name
pushl resource ; size of resource name
pushl total_locks ; total number of locks
pushal fao_buff1 ; buffer to hold the result
pushl #0 ;
pushal fao_h1 ; control string
calls #6,g^sys$fao
check
pushal fao_buff1 ; output string from FAO
calls #1,g^lib$put_output ; display it
pushal file_name ; file name descriptor
pushal fao_buff1
pushal fao_buff1
pushal fao_h2
calls #4,g^sys$fao ; create the second line
check
pushal fao_buff1 ; line with the file name
calls #1,g^lib$put_output ; display it
pushal fao_header ; display the header line
calls #1,g^lib$put_output
divw3 lock_len+2,lock_len,r2 ; determine the number of locks
; in our table
moval lock_mode_table,r6 ; our list of mode names
clrl r4 ; index in the lock table
;
; loop to skip down the list of locks and display information about each
;
10$:
addl3 r3,r4,r5 ; add the base to the index
$getsyiw_s - ; get the node that the owner
csidadr = lki$l_remsysid(r5),- ; of the lock is on
itmlst = syiitmlst
check
;
; determine which queue (granted, convert or waiting) the lock is in
; and put a pointer to the matching string descriptor in R0.
;
moval granted_queue,r0 ; assume that it is granted
cmpb lki$b_queue(r5),#lki$c_granted ; is the lock on the granted que
beql 1119$ ; yes, go on
moval convert_queue,r0 ; assume that it is converting
cmpb lki$b_queue(r5),#lki$c_convert ; is it on the CONVERT queue?
beql 1119$
moval waiting_queue,r0 ; must then be waiting
1119$:
;
; determine the modes of the locks on the granted and request queues. Use
; our little table to do all this.
;
movzbl lki$b_grmode(r5),r1 ; get the mode for granted
mull #2,r1 ; times 2 for 2 byte modes
addl3 r6,r1,gr_mode_desc+4 ; fill in the descriptor address
movzbl lki$b_rqmode(r5),r1 ; get the mode for requested
mull #2,r1 ; fix the offset
addl3 r6,r1,rq_mode_desc+4 ; fill in the address
;
; push the arguments for the FAO and output the string
;
pushl lki$l_remlkid(r5) ; remote lock ID
pushl r0 ; pointer to the queue
pushal gr_mode_desc ; mode granted
pushal rq_mode_desc ; mode requested
pushl lki$l_lockid(r5) ; the lock ID
pushal nodename_desc ; node of the locker
pushl lki$l_pid(r5) ; PID of the owner
pushal fao_buff2 ; FAO buffer
pushl #0 ;
pushal fao_control ; control string
calls #10,g^sys$fao ; and format it
check
pushal fao_buff2 ; display the
calls #1,g^lib$put_output ; resultant string
addw lock_len+2,r4 ; index to the next entry
subw #1,r2 ; bump the counter
bleq 999$ ; if done, get out
brw 10$ ; if not, do another
999$: $exit_s code=r0
;
; call these next 3 routines with a CHEXEC...
;
;
; enq a lock in exeutive mode
;
enq_lock:
.word 0
$enqw_s lkmode = #lck$k_nlmode, -
lksb = lock_sb, -
acmode = #psl$c_exec, -
resnam = resource, -
flags = #lck$m_system
ret
;
; DEQ the lock in executive mode
;
deq_lock:
.word 0
$deq_s lkid=lkidx
ret
;
; get the lock information in executive mode
;
exec_getlki:
.word 0
$getlkiw_s lkidadr=lkidx,-
itmlst=lkiitmlst
ret
.end tl
|
|
Ok you asked for it......
Source for What follows
; Program to display all locks for a given process and convert
; locks of the form RMS$ to a full file spec
;
;
;
; To get the lock values for a given process I follow the list
; of LKB blocks pointed to by PCB$L_LOCKQFL this gives me
; such things as lock request mode,granted mode,access mode etc
; to get the resource name I use the back pointer LKB$L_RSB to get
; to the resource block.
;
; To convert an RMS$ lock to a file spec I build a table
; containing the full name of all disk class devices seen (start
; with SCS$GQ_CONFIG , follow this down to the DDB list head, check for
; disk class device etc) so when I get a lock of the form RMS$.... I can
; match the Device Lock name from the resource with the Device lock
; name obtained from each disk class device with a GETDVI, then
; assign a channel and use QIO to translate the 3 Fid words from the
; resource name to a full file spec.
;
.link /sys$system:sys.stb/
.library /sys$library:lib/
$iodef
$atrdef
$sbkdef
$fibdef
$dcdef
$sbdef
$ddbdef
$ucbdef
$rsbdef
$lkbdef
$lckdef
$rsbdef
$pcbdef
ac_tbl: .byte 6 ; array of counted ascii strings
.ascii /Kernel / ; of access modes for locks
.byte 4
.ascii /Exec /
.byte 5
.ascii /Super /
.byte 4
.ascii /User /
dviitmlst: ; $getdvi item list to get the lock
.word 16 ; name for the device
.word dvi$_devlocknam
.address devlck
.long 0
.long 0
devlck: .blkb 30 ; device lock name
out: .long 200 ; output string descriptor for use
.long out+8 ; by fao
.blkb 200
rmode: .blkw 1 ; lock requested mode
gmode: .blkw 1 ; lock granted mode
nmode: .ascii /??/ ; default lock type
modes: .ascii /NL/ ; array of lock types
.ASCII /CR/
.ASCII /CW/
.ASCII /PR/
.ASCII /PW/
.ASCII /EX/
pmt: .ascid /whats the pid ? > / ; user prompt to get the pid
jpi_item: .word 20 ; item list for getjpi
.word jpi$_prcnam ; get process name
.long process_name
.long process_name_len
;
.word 4
.word jpi$_pid ; get process pid
.long epid
.long 0
;
.word 20
.word jpi$_username ; get username
.long username
.long 0
;
.word 100
.word jpi$_imagname ; get current image name
.long image
.long image_len
;
.long 0
image: .blkb 100 ; image name
image_len: .blkl 1 ; image length
process_name: .blkb 20 ; process name
process_name_len: .blkl 1 ; process name length
username: .blkb 20 ; username string
epid: .blkl 1 ; target process extended pid
ipid: .blkl 1 ; target process internal pid
len: .blkw 1 ; length of user input
iosb: .blkl 2 ; io status block for use by qio
; very silly macro to check return status
.macro check ar0,aerror,?l3
blbs ar0,l3
brw aerror
l3: nop
.endm check
.entry start,0 ; main program starts here
; get the pid
pushaw len ; length of user input
pushaq pmt ; prompt string if no input supplied
pushaq out ; store input in the 'out' descriptor
calls #3,g^lib$get_foreign ; get foreign command line
check r0,error ; did we get an error ?
; convert input length to long
cvtwl len,out
; convert hex text to a longword
pushl #4 ; we want 4 bytes (longword) out
pushal epid ; store result in epid
pushaq out ; input (from user) descriptor
calls #3,g^ots$cvt_tz_l ; convert hex text to a longword
check r0,error ; did we get an error ?
; now use getjpi to (1) check this process exists & (2) get some usefull
; data about it (process nam,full pid, image name )
$getjpiw_s pidadr=epid,- ; get data for the process user gave
itmlst=jpi_item,- ; jpi item list address
iosb=iosb ; io status block
check r0,error ; did we get an error ?
movw iosb,r0 ; check the status in the iosb
check r0,error ; did we get an error ?
; convert the epid to an ipid
movl epid,r0 ;
jsb g^exe$epid_to_ipid ; converting from epid to ipid
bneq 10$ ; did we get an error ?
movl #0,r0
ret
10$: nop
movl r0,ipid ; shuffle ipid for later
; report the data obtained from getjpi
movl #200,out ; ensure string length set to 200 bytes
$fao_s ctrstr=ctr1,outbuf=out,outlen=out,-
p1=epid,- ; extended pid
p2=#15,- ; 15 bytes of
p3=#username,- ; userename
p4=process_name_len,- ; process name length
p5=#process_name ; process name
pushaq out ; output descriptor from fao
calls #1,g^lib$put_output ; tell the world
; report the processes current image name
movl #200,out ; ensure string length set to 200 bytes
$fao_s ctrstr=ctr3,outbuf=out,outlen=out,-
p1=image_len,- ; image name
p2=#image
pushaq out ; output descriptor from fao
calls #1,g^lib$put_output ; tell the world
; now enter the main loop of the program, each call to get_lkb
; will return data about one lock held by the target process
; signals ss$_nomorelock when there are no more locks
loop: $cmexec_s routin=get_lkb
check r0,error ; did we get an error ?
; set lock requested/granted modes default (in case of corrupt data)
movw nmode,gmode
movw nmode,rmode
; now store the ascii string for the granted mode
movzbl granted_mode,r0 ; get granted mode
movw modes[r0],gmode
; now store the ascii string for the requested mode
movzbl request_mode,r0
movw modes[r0],rmode
; store the counted ascii string (8 bytes) for the lock access mode
movl ac_mode,r0
movq ac_tbl[r0],ac_mode
; store the ascii queue name on which the lock resides
tstl state
blss 600$
bgtr 610$
movab c_str,a_state ; lock converting
brw 620$
600$: nop
movab w_str,a_state ; lock waiting
brw 620$
610$: nop
movab g_str,a_state ; lock granted
620$: nop
; report data about the lock (lockid,access mode,resource name etc)
movl #200,out ; set descriptor length to 200
$fao_s ctrstr=ctr2,outbuf=out,outlen=out,-
p1=#10,- ; queue name length
p2=a_state,- ; queue name
p3=#ac_mode,- ; lock access mode
p4=lkid,- ; lock id
p5=#2,- ; lock requested string
p6=#rmode,-
p7=#2,- ; lock granted string
p8=#gmode,-
p9=resnam_length,- ; lock resource name
p10=#resnam
pushaq out
calls #1,g^lib$put_output ; tell the world
; if this lock is of the form RMS$.... then branch to the translate
; routine to return us the full file spec for this lock
cmpl #^a/RMS$/,resnam
bneq 300$
bsbw translate
300$: nop
brw loop
error: ret ; general error exit
; translate subroutine, this (should) give us the file spec
; for a lock of the form RMS$....
;
; the first time we enter this routine we build a table containing
; (dev_list format device length (long) device string etc)
; the device names of all disk class devices , then
; we try to match the device lock name from the lock resource
; with the lock name given by a getdvi for each device
; when we get a match we assign a channel to this device
; and use qio to return the full file spec
translate: nop ; entry point
tstl dev_list ; have we built the device table ?
bneq 100$ ; skip build
$cmexec_s routin=get_dev ; build table in exec mode
check r0,error ; error ?
100$: nop ; table built
movab dev_list,dev_point ; set starting point
; for device search at
; start of table
; build a descriptor (descr) for the curerent device
150$: movl @dev_point,descr ; put the device length in descr
bneq 450$ ; if length = 0 then exit routine
brw 400$ ; end of device table
450$: nop ; ok continue
addl2 #4,dev_point ; point no to the device string
movl dev_point,descr+4 ; fill in the descriptor
addl2 descr,dev_point ; and skip the device string
; on the next pass
;
; get the device lock name
;
$getdviw_s -
itmlst=dviitmlst, -
devnam=descr
check r0,error ; test for error
cmpc3 #12,devlck+1,resnam+11 ; does the device lock name
beql 200$ ; from getdvi match that
brw 150$ ; in the resource ?
200$: nop ; ok we got a match
; assign a channel to this device, using the descriptor formed
; above
$assign_s devnam=descr,-
chan=chan
check r0,error
; set fib block control function
movl #fib$m_noread!fib$m_nowrite!fib$m_nolock!fib$m_norecord,-
fib+fib$l_acctl
; say we want the full file spec returned
movw #atr$s_file_spec,atr+atr$w_size
movw #atr$c_file_spec,atr+atr$w_type
movab file,atr+atr$l_addr
; put fid (from the resource name) into fib block
movc3 #6,resnam+4,fib+fib$w_fid_num
; zero down the returned file spec string
movc5 #0,(sp),#0,#100,file
; access file to get the full file spec
$qiow_s chan=chan,-
func=#io$_access,-
iosb=iosb,-
p1=fib_d,- ; fib block descriptor
p5=#atr ; attribute block
check r0,error
movw iosb,r0 ; check for errors from qio
check r0,error
movzwl file,descr ; put the returned file spec
movab file+2,descr+4 ; length/address in descr
; report the file name and 3 fid words
movl #200,out
$fao_s ctrstr=ctr7,outbuf=out,outlen=out,-
p1=#descr,- ; full file spec descriptor
p2=resnam+4,- ; 3 fid words from the resource
p3=resnam+6,- ; name
p4=resnam+8
pushaq out
calls #1,g^lib$put_output
; get rid of the channel to the device
$dassgn_s chan=chan
check r0,error
; exit translate subroutine
400$: rsb
; routine run in exec mode that returns data about one lock
; held by the target process per call, signals ss$_nomorelock
; when no more locks to return
.entry get_lkb,0
; test the stored pointer lkb_fl, if it is zero we need to get the
; pcb for the target process to enable us to get the lock
; queue forward link, we only need to get this on the first
; call only - all other calls to get_lkb will have the lock queue
; pointer set up
tstl lkb_fl ; if not zero we do not need to get the pcb
bneq 234$
movzwl ipid,r6 ; get the pcb address by offseting from the
movl g^sch$gl_pcbvec,r2 ; pcb vector list
movl (r2)[r6],r2 ; pcb address now in r2
; store the lock queue forward link & the address of same
; (so we can check for a pointer back to the queue start = no more locks)
movl pcb$l_lockqfl(r2),lkb_fl
moval pcb$l_lockqfl(r2),lkb_bl
234$: nop
; common code now for all calls to get_lkb
; test for pointer back to the queue start (no more locks)
cmpl lkb_fl,lkb_bl
bneq 235$
movl #ss$_nomorelock,r0 ; return end of queue status
ret
235$: nop
; lkb_fl points into the body of the lock block (at lbk$l_ownqfl)
; so we must adjust for the start of the lock block
subl2 #lkb$l_ownqfl,lkb_fl ; adjust for start of lkb
movl lkb_fl,r3
; store the new pointer for next time we call get_lkb
movl lkb$l_ownqfl(r3),lkb_fl
; sanity test, make sure the owner uic in the lock block
; is the requested one, return an error if the match fails
cmpl lkb$l_pid(r3),ipid
beql 236$
movl #ss$_abort,r0
ret
236$: nop
; save the lock state (granted,waiting,converting)
cvtbl lkb$b_state(r3),state
; save the lock id
movl lkb$l_lkid(r3),lkid
; save the lock request/granted modes (nl,cw,cr etc)
movb lkb$b_grmode(r3),granted_mode
movb lkb$b_rqmode(r3),request_mode
; get the resource block address)
movl lkb$l_rsb(r3),r0
; save the resource access mode (user,super,exec etc)
movzbl rsb$b_rmod(r0),ac_mode
; save the resource name / length
cvtbl rsb$b_rsnlen(r0),r1
movzbl rsb$b_rsnlen(r0),resnam_length
movc5 r1,rsb$t_resnam(r0),#^a/ /,#100,resnam
movl #1,r0 ; indicate success
ret ; return to main loop
lkb_fl: .blkl 1 ; pointer to the next lock block to report on
lkb_bl: .blkl 1 ; address of queue list head (pcb$l_lockqfl)
lkid: .blkl 1 ; lock id
granted_mode: .blkb 1 ; lock granted mode
request_mode: .blkb 1 ; lock requested mode
resnam: .blkb 200 ; lock resource name (200 bytes = more than enuf)
; fao control string
ctr1: .ascid /Locks taken out by !XL !AF !AF /
resnam_length: .blkl 1 ; resource name length
; fao control string
ctr2: .ascid +!AF (!AC) Lockid !XL (!AF/!AF) Resource !AF +
; routine called in exec mode to build in dev_list a list
; of all disk devices we can see
;
; the flow is to start with scs$gq_config which has a block
; for each node of a vaxcluster, then step down into the ddb
; list then step down into the first ucb to test if its a disk device
; and store the device name as node$device unit
.entry get_dev,0
; store pointer to dev_list
movab dev_list,dev_point
; store pointer to the vaxcluster block
movl g^scs$gq_config,r7
10$: nop
; crude method of appending a $ to the node name (if it has one)
; pad the node name with all $'s
movc5 #0,(sp),#^a/$/,#16,node
; save the node name
movzbl sb$t_nodename(r7),node_length
movc3 node_length,sb$t_nodename+1(r7),node
; if the node name is not zero (ie its a vaxcluster member)
; then add 1 to the node name length, thus appending a $
tstl node_length
beql 700$
incl node_length
700$: nop
; test if the ddb pointer is zero (no devices on this node ?)
tstl sb$l_ddb(r7)
bneq 160$
brw 40$
160$: nop
; save the ddb list head
movl sb$l_ddb(r7),r6
; now get the first ucb off the ddb
60$: movl ddb$l_ucb(r6),r8
bneq 31$
brw 30$
31$: nop
; is it a disk ucb ?
cmpb ucb$b_devclass(r8),#dc$_disk
beql 32$
brw 30$
32$: nop
; save the device name & length
movzbl ddb$b_name_len(r6),device_length
movc3 device_length,ddb$t_name+1(r6),device
; use fao to generate a device name of the form node$device unit
100$: movl #100,out
$fao_s ctrstr=dctr,outbuf=out,outlen=out,-
p1=node_length,-
p2=#node,-
p3=device_length,-
p4=#device,-
p5=ucb$w_unit(r8)
; pushaq out ; we dont want to see the list
; calls #1,g^lib$put_output ; on sys$output !
; save the device name in dev_list as length (long) device string
movl out,@dev_point
addl2 #4,dev_point
movc3 out,out+8,@dev_point
addl2 out,dev_point
; go do the next ucb off this ddb , if pointer zero then no more devices
movl ucb$l_link(r8),r8
beql 30$
brw 100$
30$: nop
; we are here either because we ran out of ucb's or the ddb did not
; point to a disk class device
; if the pointer to the next ddb is zero then there are no more ddb's
; on this node
movl ddb$l_link(r6),r6
beql 40$
brw 60$
; get the next sb block (for the next node to do)
; if the flink for this = scs$gq_config then we have completed
; this unguided trip tho system data structures
40$: movl sb$l_flink(r7),r7
cmpl sb$l_flink(r7),g^scs$gq_config
beql ext
brw 10$
ext: nop
movl #1,r0 ; indicate success
ret
device: .blkb 20 ; device name (ie dua)
device_length: .blkl 1 ; device name length
node: .blkb 16 ; node name (=scsnode)
dctr: .ascid /!AF!AF!UW/ ; fao control string to generate full device name
node_length: .blkl 1 ; node name length
dev_list: .blkb 100*100 ; enuf room for 1,000 bytes of device names !!
dev_point: .blkl 1 ; pointer into dev_list
descr: .blkl 2 ; common or garden descriptor
; fao control string to tell us the
; full file spec & 3 fid words)
ctr7: .ascid +!AS (!UW, !UW, !UW)!/ +
state: .blkl 1 ; lock state (granted etc)
c_str: .ascii /Converting/ ; ascii strings for lock state
w_str: .ascii /Waiting /
g_str: .ascii /Granted /
a_state: .blkl 1 ; pointer to above ascii string
chan: .blkw 1 ; channel to device found in dev_list
fib_d: .long fib$c_length ; fib descriptor block for qio
.long fib
fib: .blkb fib$c_length ; fib block
atr: .blkb 100 ; attribute block
; fao control to tell us the current image of the target process
ctr3: .ascid + (Current image is !AF) !/+
file: .blkb 1000 ; string for the full file spec
ac_mode: .blkl 2 ; resource access mode
.end start
; please ! no comments about the yuck code, i know
; it looks as if this was written late at night on a dial up terminal
; under the influence of too much beer .... it was !
|