.title  LCKQUE
; Comment out the following line to compile for 7.1-2 and previous versions
; Uncomment the following line to compile for 7.2 and following versions
;;V72_OR_LATER = 1			; KP 5/25/2000
; Comment out the following line to disable debug code
;;DEBUG = 1
;;
;; List all the resources whose trees are mastered on this node and which
;; have non-zero-length conversion or wait queues.  Print the resource name
;; (and the resource names of all the parent locks, up the tree to the root),
;; along with the lengths of the conversion and wait queues.
;;
;;						K.Parris 12/99 & 01/2000
;; Modification history:
;;
;;  Fix bug which missed lock queues of length 1 by assuming that if head
;;  and tail pointers were the same, the queue was empty.    KP 02/24/00
;;
;;  Write something at successful completion, so we know the process didn't
;;  die with an EXEC mode bugcheck (due to our not locking things down under
;;  the SCS spinlock since we're only reading them).         KP 02/24/00
;;
;;  SCS data structures were moved to S2 space for V7.2.  Added support for
;;  V7.2 and later versions.                                 KP 05/25/00
;;
;; Author: Keith Parris  parris@encompasserve.org or keithparris@yahoo.com
;; http://www.geocities.com/keithparris/ or http://encompasserve.org/~parris/

	.library	/sys$library:lib.mlb/
	.library	/sys$library:starlet.mlb/
	$rsbdef		;Include Resource Block definitions

;;
;; Status-check macro
;;
	.MACRO	CHECK_STATUS, LOC=R0, ?NO_ERROR1$
        BLBS	LOC, NO_ERROR1$	;Branch if no error
	.IF DIFFERENT LOC, R0
        MOVZWL	LOC, R0		;Move error into R0
	.ENDC
        $EXIT_S	R0		;Exit with error
NO_ERROR1$:			;Return to program flow
	.ENDM	CHECK_STATUS

;;
;; Dump a value to the screen
;;
	.MACRO	VALUE_DUMP, VALU=R0, CTL=FAO_DUMP_CTL	;, ?FAO_DUMP_CTL, ?VALUE, ?NAME, ?NAME_DESC
	MOVL	VALU,VALUE	; Grab value to be dumped
	MOVZBL  #MAXFAO,FAOLEN
; Dump resource name with conversion and wait counts
	$FAO_S	-
		CTRSTR=CTL,-
		OUTLEN=FAOLEN,-
		OUTBUF=FAODESC,-
		P1=VALUE
	CHECK_STATUS			;Check status in R0
; Output the message to SYS$OUTPUT
	PUSHAL 	FAODESC
	CALLS	#1, G^LIB$PUT_OUTPUT	;Output the message
	CHECK_STATUS			;Check status in R0
	.ENDM	VALUE_DUMP
;;
;; Dump a 64-bit value to the screen
;;
	.MACRO	VALUE_DUMP64, VALU=R0, CTL=FAO_DUMP_CTL64 ;, ?FAO_DUMP_CTL, ?VALUE, ?NAME, ?NAME_DESC

	evax_stq VALU,VALUE64	; Grab value to be dumped
	MOVZBL  #MAXFAO,FAOLEN
	$FAO_S	-
		CTRSTR=CTL,-
		OUTLEN=FAOLEN,-
		OUTBUF=FAODESC,-
		P1=VALUE64_1,-
		P2=VALUE64_2
	CHECK_STATUS			;Check status in R0
; Output the message to SYS$OUTPUT
	PUSHAL 	FAODESC
	CALLS	#1, G^LIB$PUT_OUTPUT	;Output the message
	CHECK_STATUS			;Check status in R0
	.ENDM	VALUE_DUMP64

;------------------------------------------------------------------------------
;;
;; Read-only data area
;;
	.PSECT	RO_DATA	QUAD,RD,noWRT,noEXE

; Output format strings
;               Depth ConvQ WaitQ RSNLen ResNam(hex)
FAOCTL:	.ASCID	/!3UL !10UL !10UL !2UB !8XL!8XL!8XL!8XL!8XL!8XL!8XL!8XL/
;               Depth                       RSNLen ResNam(hex)
;                     1234567890 1234567890
FAOCTL2: .ASCID	/!3UB (Parent Resource:)    !2UB !8XL!8XL!8XL!8XL!8XL!8XL!8XL!8XL/
; Control strings for VALUE_DUMP macro
  .IF DF DEBUG
FAO_DUMP_CTL:	.ASCID	/Dump: !8XL/
FAO_DUMP_CTL64:	.ASCID	/Dump: !8XL.!8XL/
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
FAO_RRSFL:	.ASCID	/Root RSB List Forward Link: !8XL/
FAO_RootRSB:	.ASCID	/Root RSB: !8XL/
FAO_CKQ_ARG:	.ASCID	/Chk_Queues: Arg RSB: !8XL/
FAO_CKT_ARG:	.ASCID	/Chk_Tree: Arg RSB: !8XL/
FAO_Parent:	.ASCID	/Parent RSB: !8XL/
FAO_RSB:	.ASCID	/RSB: !8XL/
FAO_SRS:	.ASCID	/SRS: !8XL/
FAO_INITIAL:	.ASCID	/Initial link: !8XL/
FAO_NEXT:	.ASCID	/Next link: !8XL/
FAO_CVTQFL:	.ASCID	/CvtQFL: !8XL/
FAO_WTQFL:	.ASCID	/WtQFL: !8XL/
    .IFF	; V7.2 or later
FAO_RRSFL:	.ASCID	/RSB Queue Forward Link: !8XL.!8XL/
FAO_CKQ_ARG:	.ASCID	/Chk_Queues: Arg RSB: !8XL.!8XL/
FAO_CKT_ARG:	.ASCID	/Chk_Tree: Arg RSB: !8XL.!8XL/
FAO_RootRSB:	.ASCID	/Root RSB: !8XL.!8XL/
FAO_Parent:	.ASCID	/Parent RSB: !8XL.!8XL/
FAO_RSB:	.ASCID	/RSB: !8XL.!8XL/
FAO_SRS:	.ASCID	/SRS: !8XL.!8XL/
FAO_INITIAL:	.ASCID	/Initial link: !8XL.!8XL/
FAO_NEXT:	.ASCID	/Next link: !8XL.!8XL/
FAO_CVTQFL:	.ASCID	/CvtQFL: !8XL.!8XL/
FAO_WTQFL:	.ASCID	/WtQFL: !8XL.!8XL/
    .ENDC ;NDF V72_OR_LATER
FAO_MstCSID:	.ASCID	/Master CSID: !8XL/
FAO_Depth:	.ASCID	/Depth: !UL/
FAO_RefCnt:	.ASCID	/RefCnt: !UL/	; Reference count (# of sub-resources)
  .ENDC ;DF DEBUG

Done_Msg_Desc:	.ASCID	"LCKQUE done."
;------------------------------------------------------------------------------
;;
;; Read-write data area
;;
	.PSECT	RW_DATA	QUAD,RD,WRT,noEXE

; Data items about each resource with locks waiting
	.ALIGN	LONG
Depth:	.BLKL		; Depth of sub-resource within tree
	.ALIGN	LONG
ConvQ:	.BLKL		; Length of conversion queue
	.ALIGN	LONG
WaitQ:	.BLKL		; Length of wait queue
	.ALIGN	LONG
RSNLen: .BLKL		; Resource name length in bytes
	.ALIGN	LONG
ResNam: .BLKB	32	; Resource name itself

  .IF DF DEBUG
Value:	.BLKL	1	; Register buffer for debug calls
    .IF DF V72_OR_LATER	; V7.2 or later
Value64:		; 64-bit Register buffer for debug calls
Value64_2:	.BLKL	1
Value64_1:	.BLKL	1
    .ENDC ;DF V72_OR_LATER
  .ENDC ;DF DEBUG
;
; Stuff for $FAO calls.
;
MAXFAO = 132			;Maximum $FAO buffer length
	.ALIGN	QUAD
FAODESC:			;$FAO descriptor
FAOLEN:	.BLKL			;$FAO output buffer length
	.ADDRESS	FAOBUF	;address of buffer
FAOBUF:	.BLKB	MAXFAO		;132-character buffer

;------------------------------------------------------------------------------
;;
;;  Executable code area
;;
	.PSECT	CODE	QUAD,RD,noWRT,EXE

;;;;===========================================================================
;;;;
;;;; Main program
;;;;
;;;;===========================================================================
        .ENTRY  START,^M<>


; Lock manager data structures were moved into S2 space for V7.2.  This means
; several field widths had to be changed for 64-bit addressing.
;
; Check to ensure the version of code we're running matches the running system,
; and exit with an error if not:
;        %SYSTEM-F-SYSVERDIF, system version mismatch; please relink
; They need to actually edit this (for the V72_OR_LATER symbol), recompile, and
; relink, but hopefully the error message will be enough of a clue to get the
; job done.
;
; Check for a matching version of lock manager code
	.IIF	NDF,SS$_SYSVERDIF,    $SSDEF
	.IIF	NDF,SYS$K_BASE_IMAGE, $SYSVERSIONDEF
	MOVAL	G^SYS$VERSION_BEGIN,R0
        MOVZBL	#SYS$K_CLUSTERS_LOCKMGR,R1
    .IF NDF 	V72_OR_LATER
	lckmgr_version = ^x00010080	;V7.1-2
    .IFF        ;NDF V72_OR_LATER
	lckmgr_version = ^x00010100	;V7.2
    .ENDC       ;NDF V72_OR_LATER
	CMPL	#lckmgr_version,4(R0)[R1]
        BEQL    1$
        MOVL    #SS$_SYSVERDIF,R0	; Must recompile/relink
	$EXIT_S	R0
1$:	

; Because the RSBs are protected from user-mode access (but are readable from
; Exec mode for 7.1-2 or prior and only from Kernel mode for 7.2 and later),
; gather data from Root RSB chain while in Exec or Kernel mode
    .IF NDF 	V72_OR_LATER
		;V7.1-2
	$CMEXEC_S ROUTIN=WORK	; Call serious-work routine in Exec mode
    .IFF        ;NDF V72_OR_LATER
		;V7.2
	$CMKRNL_S ROUTIN=WORK	; Call serious-work routine in Kernel mode
    .ENDC       ;NDF V72_OR_LATER
	CHECK_STATUS			;Check status in R0

; Indicate we completed successfully.
	PUSHAL 	Done_Msg_Desc
	CALLS	#1, G^LIB$PUT_OUTPUT	;Output the message
;;	CHECK_STATUS			;Check status in R0
;; Status gets checked on image exit anyway...
	$EXIT_S	R0
;
	RET	; So Alpha macro compiler knows this routine has ended
;
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
	.ENTRY	WORK,^M<R2,R3,R4,R5,R6,R7,R8,R9,R10>

; Look through the chain of root RSBs, checking each resource and sub-resource.

; (For simplicity here, we dump them in arbitrary order and use DCL code
; later for the work of identifying files by resource name and so forth.)
;
;
; We can only read the data we need from Kernel mode under V7.2 and later,
; since it's no longer readable from Exec mode.  (We are able to read it
; from Exec mode in 7.1-2 and earlier versions.)
;
; We don't bother to synchronize with spinlocks because we're only reading,
; and don't want to add to MP_Synch time.
; But that implies that we might end up off in the weeds sometime if the data
; structures change underneath us.  While the odds of a root RSB going away
; isn't high, it is still possible, so we put in place an exception handler
; to catch an ACCVIO should this occur sometime, and prevent the system from
; crashing.  This way, worst case, we may blow away our own process.
; Worst case, we'd temporarily be off in our rate calculations by not having
; data for a node in the cluster.  Perhaps we can evem re-try up at the DCL
; level if this process dies (???)@@@@@@
;
; Establish an exception handler to catch inadvertent ACCVIOs and prevent a
; system crash:
    .IF DF V72_OR_LATER		;V7.2 or later
	MOVAB	G^EXE$SIGTORET,(FP)	; Establish exception handler
    .ENDC	;DF V72_OR_LATER

    .IF NDF V72_OR_LATER		;V7.1-2 or earlier
	MOVAL	g^LCK$GL_RRSFL,R7	; Address of Root RSB listhead
  .IF DF DEBUG
    VALUE_DUMP	R7,FAO_RRSFL
  .ENDC ; DF DEBUG
	MOVL	R7,R8			; Make a note of listhead address
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_INITIAL
  .ENDC ; DF DEBUG
    .IFF	;NDF V72_OR_LATER	;V7.2 or later
	evax_ldaq R7,g^LCK$GQ_RRSFL	; Address of Root RSB listhead
  .IF DF DEBUG
    VALUE_DUMP64	R7,FAO_RRSFL
  .ENDC ; DF DEBUG
	evax_or	R31,R7,R8		; Make a note of listhead address
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_INITIAL
  .ENDC ; DF DEBUG
    .ENDC	;NDF V72_OR_LATER

10$:
    .IF NDF V72_OR_LATER		;V7.1-2 or earlier
	MOVL	(R7),R7			; Next RSB in Root RSB list
  .IF DF DEBUG
    VALUE_DUMP	R7,FAO_NEXT
    moval	<-RSB$L_RRSFL>(r7),r0
    VALUE_DUMP	R7,FAO_RootRSB
  .ENDC ;DF DEBUG
	CMPL	R7,R8			; Back to starting point? (circular queue)
	.branch_unlikely
	BEQL	20$			; Yes --> done
	MOVAB	<-RSB$L_RRSFL>(R7),R9	; Address of base of RSB
  .IF DF DEBUG
    VALUE_DUMP	R9,FAO_RootRSB
  .ENDC ;DF DEBUG
    .IFF	;NDF V72_OR_LATER	;V7.2 or later
	evax_or  R31,(R7),R7		; Next RSB in Root RSB list
  .IF DF DEBUG
    VALUE_DUMP64	R7,FAO_NEXT
    evax_ldaq	R0,<-RSB$Q_RRSFL>(R7)
    VALUE_DUMP64	R0,FAO_RootRSB
  .ENDC ;DF DEBUG
	evax_cmpeq	R7,R8,R2	; Back to starting point? (circular queue)
					; Sets R2 to 1 if R7=R8; to 0 if R7<>R8
  .IF DF DEBUG
    VALUE_DUMP64	R2
  .ENDC ;DF DEBUG
	.branch_unlikely
	blbs	R2,20$		; R2 set to 1?  Yes --> done
	evax_ldaq  R9,<-rsb$q_rrsfl>(R7); Address of base of RSB
  .IF DF DEBUG
    VALUE_DUMP64	R9,FAO_RootRSB
  .ENDC ;DF DEBUG
    .ENDC	;NDF V72_OR_LATER

  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
;    moval	(r9),r0
    movl	r9,r0
    VALUE_DUMP	R0,FAO_RootRSB
    .IFF	; V7.2 or later
;    evax_ldaq	r0,(r9)
    evax_or	r31,r9,r0
    VALUE_DUMP64	R0,FAO_RootRSB
    .ENDC ;NDF V72_OR_LATER
    movl	<rsb$l_csid>(r9),r0
    VALUE_DUMP	R0,FAO_MstCSID
  .ENDC ;DF DEBUG

	TSTL	<RSB$L_CSID>(R9)	; Check master node CSID
	BNEQ	10$			; Non-Zero --> Mastered on another node

  .IF DF DEBUG
    moval	(r9),r0
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    VALUE_DUMP	R0,FAO_RootRSB
    .IFF	; V7.2 or later
    evax_ldaq	r0,(r9)
    VALUE_DUMP64	R0,FAO_RootRSB
    .ENDC ;NDF V72_OR_LATER
  .ENDC ;DF DEBUG


; Resource tree is mastered on this node.  Check all its sub-resources.
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	PUSHAL	(R9)		; RSB address
	CALLS	#1,CHK_TREE
    .IFF	; V7.2 or later
	evax_or	R31,R9,R10	; Put argument into R10 for call
	JSB	CHK_TREE
    .ENDC ;NDF V72_OR_LATER
	BRW	10$		; Get next entry in Root RSB list -->
20$:
	MOVZWL	#SS$_NORMAL,R0	; Return normal status
	RET			; Return to user mode

;
; Check for queues on this Root resource and all its sub-resources
;
; Inputs;
;	R10	RSB address (7.2 or later)
;	4(AP)	RSB address (pre-7.2)
; Outputs:
;	R0	Status
;
; Register usage:
;	R7	Root RSB address
;	R8	Sub-resource list addresses
;	R9	Sub-resource queue head
;

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	.ENTRY	CHK_TREE,^M<R7,R8,R9>
    .IFF	; V7.2 or later
CHK_TREE:
	.JSB_ENTRY	-
		INPUT=<R10>,-
		OUTPUT=<>,-
		SCRATCH=<>,-
		PRESERVE=<R7,R8,R9,R10>
    .ENDC ;NDF V72_OR_LATER
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	4(AP),R7	; Grab RSB address from argument list
  .IF DF DEBUG
    VALUE_DUMP	R7,FAO_CKT_ARG
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_or	R31,R10,R7	; Grab RSB address
  .IF DF DEBUG
    VALUE_DUMP64	R7,FAO_CKT_ARG
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER

;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    VALUE_DUMP	R7,FAO_RSB	;;;
    movzbl	<rsb$b_depth>(r7),r0
    .IFF	; V7.2 or later
    VALUE_DUMP64	R7,FAO_RSB	;;;
    movl	<rsb$l_depth>(r7),r0
    .ENDC ;NDF V72_OR_LATER
    VALUE_DUMP	R0,FAO_Depth
  .ENDC ;DF DEBUG
;^

;;    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
;;    cmpl	<rsb$l_rtrsb>(r7),r7
;;    beql	3$	; This is its own root RSB -->
;;    .IFF	; V7.2 or later
;;    evax_cmpeq	<rsb$q_rtrsb>(r7),r7,r24
;;			; Sets R24 to 1 if R7=R8; to 0 if R7<>R8
;;    blbs	r24,3$	; This is its own root RSB -->
;;    .ENDC ;NDF V72_OR_LATER

;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    movl	<rsb$l_rtrsb>(r7),r0
    VALUE_DUMP	R0,FAO_RootRSB	;;;
    .IFF	; V7.2 or later
    evax_or	R31,<rsb$q_rtrsb>(r7),r0
    VALUE_DUMP64	R0,FAO_RootRSB	;;;
    .ENDC ;NDF V72_OR_LATER
  .ENDC ;DF DEBUG
;^

;;3$:

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	movl	<rsb$l_parent>(r7),r0
;;	beql	4$	; No parent -->

  .IF DF DEBUG
    VALUE_DUMP	R0,FAO_Parent	; Parent RSB address ;;;
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_or	R31,<rsb$q_parent>(r7),r0
;;	evax_beq	r0,4$	; No parent -->
  .IF DF DEBUG
    VALUE_DUMP64	R0,FAO_Parent	; Parent RSB address ;;;
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER

;4$:
; Check for queues on this root resource
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	PUSHL	R7		; Root RSB address
	CALLS	#1,CHK_QUEUES	; Check for queued lock requests
    .IFF	; V7.2 or later
	evax_or	R31,R7,R10	; Root RSB address
	JSB	CHK_QUEUES	; Check for queued lock requests
    .ENDC ;NDF V72_OR_LATER
; Now check any sub-resources
;v
  .IF DF DEBUG
    movl	<RSB$L_REFCNT>(r7),r0
    VALUE_DUMP	R0,FAO_RefCnt	; Number of sub-resources
  .ENDC ;DF DEBUG
;^
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVAL	<RSB$L_SRSFL>(R7),R8	; Check for sub-resources
	MOVL	R8,R9			; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP	R9,FAO_INITIAL	; Initial Queue Forward Link
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_ldaq	R8,<RSB$Q_SRSFL>(R7)	; Check for sub-resources
	evax_or	R31,R8,R9			; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP64	R9,FAO_INITIAL	; Initial Queue Forward Link
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER
;;;   movzwl #ss$_normal,r0
;;;   ret	; for testing
10$:
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	(R8),R8		; Follow forward link
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_NEXT	; Next Link
  .ENDC ;DF DEBUG
	CMPL	R8,R9		; Back to starting point? (circular queue)
	BEQL	99$		; Yes --> done
    .IFF	; V7.2 or later
	evax_or	R31,(R8),R8	; Follow forward link
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_NEXT	; Next Link
  .ENDC ;DF DEBUG
	evax_cmpeq	R8,R9,R24	; Back to starting point? (circular queue)
					; Sets R24 to 1 if R7=R8; to 0 if R7<>R8
	blbs	R24,99$		; Yes --> done
    .ENDC ;NDF V72_OR_LATER
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	moval	<-rsb$l_srsfl>(r8),r0
;;;    VALUE_DUMP	R0,FAO_srs ; Sub-resource address
    .IFF	; V7.2 or later
	evax_ldaq	R0,<-rsb$q_srsfl>(r8)
;;;    VALUE_DUMP64	R0,FAO_srs ; Sub-resource address
    .ENDC ;NDF V72_OR_LATER

; Here we have a sub-resource.  Check it also.
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	PUSHAL	<-RSB$L_SRSFL>(R8)	; RSB address
	CALLS	#1,CHK_QUEUES
    .IFF	; V7.2 or later
	evax_ldaq	R10,<-rsb$q_srsfl>(R8)	; RSB address
	JSB	CHK_QUEUES
    .ENDC ;NDF V72_OR_LATER

;99$: ; for testing
;;   movzwl #ss$_normal,r0 ; for testing
;;   ret	; for testing
	BRB	10$		; Try next resource
99$:
	MOVZWL	#SS$_NORMAL,R0
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	RET
    .IFF	; V7.2 or later
	RSB
    .ENDC ;NDF V72_OR_LATER

;
; Check for queues on this resource.
;
; Inputs;
;	R10	RSB address (7.2 or later)
;	4(AP)	RSB address (pre-7.2)
; Outputs:
;	R0	Status
;
; Register usage:
;	R3	Convert queue length
;	R4	Wait queue length
;	R7	RSB address
;	R8	Conversion or wait queue list address
;	R9	Conversion or wait queue head
;
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	.ENTRY	CHK_QUEUES,^M<R2,R3,R4,R5,R6,R7,R8,R9>
    .IFF	; V7.2 or later
CHK_QUEUES:
	.JSB_ENTRY	-
		INPUT=<R10>,-
		OUTPUT=<>,-
		SCRATCH=<>,-
		PRESERVE=<R3,R4,R7,R8,R9,R10>
    .ENDC ;NDF V72_OR_LATER

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	4(AP),R7	; Grab RSB address from argument list
  .IF DF DEBUG
    VALUE_DUMP	R7,FAO_CKQ_ARG
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_or	R31,R10,R7	; Grab RSB address from argument register
  .IF DF DEBUG
    VALUE_DUMP64	R7,FAO_CKQ_ARG
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER

;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    VALUE_DUMP	R7,FAO_RSB
    movzbl	<rsb$b_depth>(r7),R0
    .IFF	; V7.2 or later
    VALUE_DUMP64	R7,FAO_RSB
    movl	<rsb$l_depth>(r7),R0
    .ENDC ;NDF V72_OR_LATER
    VALUE_DUMP	R0,FAO_Depth
  .ENDC ;DF DEBUG
;^
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	movl	<rsb$l_rtrsb>(r7),r0
;;;v
  .IF DF DEBUG
    VALUE_DUMP	R0,FAO_RootRSB	; Root RSB address
  .ENDC ;DF DEBUG
;;;^
    .IFF	; V7.2 or later
	evax_or	R31,<rsb$q_rtrsb>(r7),r0
;;;v
  .IF DF DEBUG
    VALUE_DUMP64	R0,FAO_RootRSB	; Root RSB address
  .ENDC ;DF DEBUG
;;;^
    .ENDC ;NDF V72_OR_LATER

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    movl	<rsb$l_parent>(r7),r0
    .IFF	; V7.2 or later
    evax_or	R31,<rsb$q_parent>(r7),r0
    .ENDC ;NDF V72_OR_LATER
;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    VALUE_DUMP	R0,FAO_Parent	; Parent RSB address
    .IFF	; V7.2 or later
    VALUE_DUMP64	R0,FAO_Parent	; Parent RSB address
    .ENDC ;NDF V72_OR_LATER
  .ENDC ;DF DEBUG
;^

; Now check any sub-resources

;v
  .IF DF DEBUG
    movl	<RSB$L_REFCNT>(r7),r0
    VALUE_DUMP	R0,FAO_RefCnt	; Number of sub-resources
  .ENDC ;DF DEBUG
;^

;;   movzwl #ss$_normal,r0
;;   ret	; for testing

; Check for non-zero queue lengths for conversion or wait queues
	CLRL	R3		; Count elements in conversion queue
	CLRL	R4		; Count elements in wait queue
; Check conversion queue
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVAL	<RSB$L_CVTQFL>(R7),R8
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_CVTQFL	; Convert Queue Forward Link
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_ldaq	R8,<RSB$Q_CVTQFL>(R7)
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_CVTQFL	; Convert Queue Forward Link
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER

;;; The code below doesn't appear to save much CPU time, so we don't bother
;;    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
;;	CMPL	R8,(R8)		; Head points to self?
;;	.branch_likely		; Queue is likely to be empty
;;	BEQL	120$		; Head points to itself --> Queue is empty
;;    .IFF	; V7.2 or later
;;	evax_cmpeq	R8,(R8),R24		; Head points to self?
;;				; Sets R24 to 1 if R7=R8; to 0 if R7<>R8
;;	.branch_likely		; Queue is likely to be empty
;;	blbs	R24,120$ ; Head points to itself --> Queue is empty
;;    .ENDC ;NDF V72_OR_LATER
;;; The above code doesn't appear to save much CPU time, so we don't bother

; Non-empty conversion queue.  Count the elements (LKBs) in the queue.
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	R8,R9		; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP	R9,FAO_INITIAL	; Initial Queue Forward Link
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_or	R31,R8,R9	; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP64	R9,FAO_INITIAL	; Initial Queue Forward Link
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER
112$:
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	(R8),R8
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_CVTQFL	; Convert Queue Forward Link
  .ENDC ;DF DEBUG
	CMPL	R8,R9		; Back at starting point? (circular queue)
	.branch_likely		; Most queues will be short or empty
	BEQL	118$		; Yes --> Done counting
    .IFF	; V7.2 or later
;	evax_or	R31,(R8),R8
	evax_ldaq	R8,(R8)
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_CVTQFL	; Convert Queue Forward Link
  .ENDC ;DF DEBUG
	evax_cmpeq	R8,R9,R24 ; Back at starting point? (circular queue)
				  ; Sets R2 to 1 if R7=R8; to 0 if R7<>R8
	.branch_likely		; Most queues will be short or empty
	blbs	R24,118$ ; Yes --> Done counting
    .ENDC ;NDF V72_OR_LATER
	INCL	R3		; Count this element
	BRB	112$
118$:

; Check wait queue
120$:
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVAL	<RSB$L_WTQFL>(R7),R8
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_WTQFL	; Wait Queue Forward Link
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_ldaq	R8,<RSB$Q_WTQFL>(R7)
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_WTQFL	; Wait Queue Forward Link
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER
;;; The code below doesn't appear to save much CPU time, so we don't bother
;;@@@	CMPL	R8,(R8)		; Head points to self?
;;	.branch_likely		; Queue is likely to be empty
;;@@@	BEQL	130$		; Head points to itself --> Queue is empty
;;; The above code doesn't appear to save much CPU time, so we don't bother
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	R8,R9		; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP	R9,FAO_INITIAL	; Next Link
  .ENDC ;DF DEBUG
    .IFF	; V7.2 or later
	evax_or	R31,R8,R9	; Remember starting point
  .IF DF DEBUG
    VALUE_DUMP64	R9,FAO_INITIAL	; Next Link
  .ENDC ;DF DEBUG
    .ENDC ;NDF V72_OR_LATER
122$:
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	(R8),R8
  .IF DF DEBUG
    VALUE_DUMP	R8,FAO_WTQFL	; Wait Queue Forward Link
  .ENDC ;DF DEBUG
	CMPL	R8,R9		; Back at starting point? (circular queue)
	.branch_likely		; Most queues will be short or empty
	BEQL	128$		; Yes --> Done counting
    .IFF	; V7.2 or later
	evax_or	R31,(R8),R8
  .IF DF DEBUG
    VALUE_DUMP64	R8,FAO_WTQFL	; Wait Queue Forward Link
  .ENDC ;DF DEBUG
	evax_cmpeq	R8,R9,R24 ; Back at starting point? (circular queue)
				  ; Sets R24 to 1 if R7=R8; to 0 if R7<>R8
	.branch_likely		; Most queues will be short or empty
	blbs	R24,128$ ; Yes --> Done counting
    .ENDC ;NDF V72_OR_LATER
	INCL	R4		; Count this element
	BRB	122$
128$:
; Done counting queues (if any)
130$:
	ADDL3	R3,R4,R0	; Any locks in queues?
	.branch_likely		; Most locks will not have queues
	BEQL	200$		; No --> done
;
; R7 still points to RSB
;
; If this is not a root resource, first dump the names of all its parent
; resources in the resource hierarchy.
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	<RSB$L_PARENT>(R7),R8
	BEQL	160$	; Root resource --> No parent locks
	PUSHL	R8	; Push parent resource block address
	CALLS	#1,DISPLAY_RESOURCES
    .IFF	; V7.2 or later
	evax_or	R31,<RSB$Q_PARENT>(R7),R8
	evax_beq	R8,160$	; Root resource --> No parent locks
	evax_or	R31,R8,R10	; Pass parent resource block address
	JSB	DISPLAY_RESOURCES
    .ENDC ;NDF V72_OR_LATER
160$:
;
; Output the info about this resource
;
; Common setup for $FAO
	MOVL	R3,ConvQ
	MOVL	R4,WaitQ
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVZBL	<RSB$B_DEPTH>(R7),Depth	; Resource's depth in tree
    .IFF	; V7.2 or later
	MOVL	<RSB$L_DEPTH>(R7),Depth	; Resource's depth in tree
    .ENDC ;NDF V72_OR_LATER
	MOVZBL	<RSB$B_RSNLEN>(R7),R9	; Resource name length
	MOVL	R9,RSNLen		; Resource name length
	MOVC3	R9,<RSB$T_RESNAM>(R7),ResNam ; Resource name text
; Note: R0-R6 are clobbered by MOVC3
	MOVZBL  #MAXFAO,FAOLEN
; Dump resource name with depth plus conversion and wait counts
	$FAO_S	-
		CTRSTR=FAOCTL,-
		OUTLEN=FAOLEN,-
		OUTBUF=FAODESC,-
		P1=Depth,-
		P2=ConvQ,-
		P3=WaitQ,-
		P4=RSNLen,-
		P5=ResNam+28,-
		P6=ResNam+24,-
		P7=ResNam+20,-
		P8=ResNam+16,-
		P9=ResNam+12,-
		P10=ResNam+8,-
		P11=ResNam+4,-
		P12=ResNam
	CHECK_STATUS			;Check status in R0
; Output the message to SYS$OUTPUT
	PUSHAL 	FAODESC
	CALLS	#1, G^LIB$PUT_OUTPUT	;Output the message
	CHECK_STATUS			;Check status in R0

200$:
	MOVZWL	#SS$_NORMAL,R0
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	RET
    .IFF	; V7.2 or later
	RSB
    .ENDC ;NDF V72_OR_LATER

;
; Display resource tree of all parent resources up from this RSB
;
; Inputs;
;	R10	RSB address (7.2 or later)
;	4(AP)	RSB address (pre-7.2)
; Outputs:
;	R0	Status
;
; Register usage:
;	R7	RSB address
;	R9	Resource name length
;
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	.ENTRY	DISPLAY_RESOURCES,^M<R2,R3,R4,R5,R6,R7,R8,R9>
	MOVL	4(AP),R7	; Grab RSB address from argument list
    .IFF	; V7.2 or later
DISPLAY_RESOURCES:
	.JSB_ENTRY	-
		INPUT=<R10>,-
		OUTPUT=<>,-
		SCRATCH=<>,-
		PRESERVE=<R2,R3,R4,R5,R6,R7,R9,R10>
	evax_or	R31,R10,R7	; Grab RSB address from argument register
    .ENDC ;NDF V72_OR_LATER

;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    VALUE_DUMP	R7,FAO_RSB
    movzbl	<rsb$b_depth>(r7),r0
    .IFF	; V7.2 or later
    VALUE_DUMP64	R7,FAO_RSB
    movl	<rsb$l_depth>(r7),r0
    .ENDC ;NDF V72_OR_LATER
    VALUE_DUMP	R0,FAO_Depth
  .ENDC ;DF DEBUG
;^

; If this resource itself is not a root resource, dump the names of all its
; parent resources first (so we end up with the root resource name dumped 1st).
;v
  .IF DF DEBUG
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
    movl	<rsb$l_parent>(r7),r0
    VALUE_DUMP	R0,FAO_Parent	; Parent RSB address
    .IFF	; V7.2 or later
    evax_or	R31,<rsb$q_parent>(r7),r0
    VALUE_DUMP64	R0,FAO_Parent	; Parent RSB address
    .ENDC ;NDF V72_OR_LATER
  .ENDC ;DF DEBUG
;^

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVL	<RSB$L_PARENT>(R7),R8
	BEQL	300$	; No parent lock --> Root resource
	PUSHL	R8	; Push parent resource block address
	CALLS	#1,DISPLAY_RESOURCES	; Call ourselves recursivly
    .IFF	; V7.2 or later
	evax_or	R31,<RSB$Q_PARENT>(R7),R8
	evax_beq	R8,300$	; No parent lock --> Root resource
	evax_or	R31,R8,R10	; Push parent resource block address
	JSB	DISPLAY_RESOURCES	; Call ourselves recursivly
    .ENDC ;NDF V72_OR_LATER
300$:

    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	MOVZBL	<RSB$B_DEPTH>(R7),Depth	; Resource's depth in tree
    .IFF	; V7.2 or later
	MOVL	<RSB$L_DEPTH>(R7),Depth	; Resource's depth in tree
    .ENDC ;NDF V72_OR_LATER
	MOVZBL	<RSB$B_RSNLEN>(R7),R9	; Resource name length
	MOVL	R9,RSNLen		; Resource name length
	MOVC3	R9,<RSB$T_RESNAM>(R7),ResNam ; Resource name text
; Note: R0-R6 are clobbered by MOVC3
	MOVZBL  #MAXFAO,FAOLEN
; Dump resource name with depth plus conversion and wait counts
	$FAO_S	-
		CTRSTR=FAOCTL2,-
		OUTLEN=FAOLEN,-
		OUTBUF=FAODESC,-
		P1=Depth,-
		P2=RSNLen,-
		P3=ResNam+28,-
		P4=ResNam+24,-
		P5=ResNam+20,-
		P6=ResNam+16,-
		P7=ResNam+12,-
		P8=ResNam+8,-
		P9=ResNam+4,-
		P10=ResNam
	CHECK_STATUS			;Check status in R0
; Output the message to SYS$OUTPUT
	PUSHAL 	FAODESC
	CALLS	#1, G^LIB$PUT_OUTPUT	;Output the message
	CHECK_STATUS			;Check status in R0

	MOVZWL	#SS$_NORMAL,R0
    .IF NDF V72_OR_LATER	; V7.1-2 or earlier
	RET
    .IFF	; V7.2 or later
	RSB
    .ENDC ;NDF V72_OR_LATER

        .end start