.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 ; 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 (r9),r0 VALUE_DUMP R0,FAO_MstCSID .ENDC ;DF DEBUG TSTL (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 .IFF ; V7.2 or later CHK_TREE: .JSB_ENTRY - INPUT=,- OUTPUT=<>,- SCRATCH=<>,- PRESERVE= .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 (r7),r0 .IFF ; V7.2 or later VALUE_DUMP64 R7,FAO_RSB ;;; movl (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 (r7),r7 ;; beql 3$ ; This is its own root RSB --> ;; .IFF ; V7.2 or later ;; evax_cmpeq (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 (r7),r0 VALUE_DUMP R0,FAO_RootRSB ;;; .IFF ; V7.2 or later evax_or R31,(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 (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,(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 (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 (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,(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 .IFF ; V7.2 or later CHK_QUEUES: .JSB_ENTRY - INPUT=,- OUTPUT=<>,- SCRATCH=<>,- PRESERVE= .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 (r7),R0 .IFF ; V7.2 or later VALUE_DUMP64 R7,FAO_RSB movl (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 (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,(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 (r7),r0 .IFF ; V7.2 or later evax_or R31,(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 (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 (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,(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 (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,(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 (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,(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 (R7),Depth ; Resource's depth in tree .IFF ; V7.2 or later MOVL (R7),Depth ; Resource's depth in tree .ENDC ;NDF V72_OR_LATER MOVZBL (R7),R9 ; Resource name length MOVL R9,RSNLen ; Resource name length MOVC3 R9,(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 MOVL 4(AP),R7 ; Grab RSB address from argument list .IFF ; V7.2 or later DISPLAY_RESOURCES: .JSB_ENTRY - INPUT=,- OUTPUT=<>,- SCRATCH=<>,- PRESERVE= 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 (r7),r0 .IFF ; V7.2 or later VALUE_DUMP64 R7,FAO_RSB movl (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 (r7),r0 VALUE_DUMP R0,FAO_Parent ; Parent RSB address .IFF ; V7.2 or later evax_or R31,(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 (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,(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 (R7),Depth ; Resource's depth in tree .IFF ; V7.2 or later MOVL (R7),Depth ; Resource's depth in tree .ENDC ;NDF V72_OR_LATER MOVZBL (R7),R9 ; Resource name length MOVL R9,RSNLen ; Resource name length MOVC3 R9,(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