10	! ----- FINDLOCK.BAS -----
	!
	! ----- Displays PIDs of User(s) who are causing another User PID -----
	! ----- to be stalled -----
	!
	! ----- Restrictions: -----
	! -----		1) CMEXEC and WORLD privileges required -----
	! -----		2) SYS$NODE must be defined -----
	!
	! ----- If the PID is not specified as a foreign command line -----
	! ----- argument, this program will prompt for one. -----
	!
	! ----- Last Change 03/23/90 by Brian Lomasky -----
	!
	OPTION TYPE = EXPLICIT

	ON ERROR GOTO ERROR_ROUTINE		! TRAP ALL ERRORS

	%LET %DEBUG = 0%			! 1 IF DEBUG ENABLED, 0 IF NOT

	%INCLUDE "$LCKDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$LKIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$LNMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "$PRVDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"

	! ----- SYSTEM SERVICE ERROR CODES AND FUNCTION VALUES -----
	EXTERNAL LONG CONSTANT JPI$_CURPRIV	! CURRENT PRIVILEGES
	EXTERNAL LONG CONSTANT SYI$_NODE_CSID	! CLUSTER SYSTEM ID
	EXTERNAL LONG CONSTANT SYI$_NODENAME	! CLUSTER NODE NAME
	EXTERNAL LONG CONSTANT SS$_NOLOGNAM	! NO LOGICAL NAME TRANS
	EXTERNAL LONG CONSTANT SS$_NOMORENODE	! NO MORE NODES RETURN STATUS
	EXTERNAL LONG CONSTANT SS$_NONEXPR	! NON-EXISTANT PROCESS
	EXTERNAL LONG CONSTANT SS$_NORMAL	! NORMAL SUCCESS STATUS

	RECORD JPIBUF				! $GETJPIW RECORD
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		LONG LIST_TERMINATOR
	END RECORD JPIBUF

	RECORD SYIBUF				! $GETSYIW RECORD
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		WORD BUFFER_LENGTH2
		WORD ITEM_CODE2
		LONG BUFFER_ADDRESS2
		LONG RETURN_LENGTH_ADDRESS2
		LONG LIST_TERMINATOR
	END RECORD SYIBUF

	RECORD TRNBUF				! $TRNLNM RECORD
		WORD BUFFER_LENGTH1
		WORD ITEM_CODE1
		LONG BUFFER_ADDRESS1
		LONG RETURN_LENGTH_ADDRESS1
		LONG LIST_TERMINATOR
	END RECORD TRNBUF

	! ----- COMMON CONSTANTS -----
	DECLARE WORD CONSTANT TRUE = (1% = 1%)
	DECLARE WORD CONSTANT FALSE = NOT TRUE

	! ----- DEFINE VALUE TO PASS TO SYS$EXIT SO AS TO EXIT THE PROGRAM -----
	! ----- WITH AN ERROR STATUS WITHOUT DISPLAYING ANY SCREEN MESSAGE -----
	DECLARE LONG CONSTANT ERROR_WITH_NO_PUTMSG = X"10000002"L

	! ----- BASIC ERROR CODE VALUES -----
	DECLARE WORD CONSTANT END_OF_FILE = 11%
	DECLARE WORD CONSTANT INTEGER_OVERFLOW = 51%

	! ----- LOCAL VARIABLE DECLARATIONS -----
	DIM LONG CLUSTER_CSID(35%)		! CSIDS OF EACH CLUSTER NODE
	DIM STRING CLUSTER_NODENAME(35%)	! NODE NAME OF EACH CLUSTER NODE
	DECLARE WORD CMEXEC_ON			! TRUE IF CMEXEC PRIV IS ON
	DECLARE STRING COMMAND_STRING		! FOREIGN DCL COMMAND STRING
	DECLARE WORD COMMAND_STRING_LENGTH	! LENGTH OF FOREIGN DCL CMD
	DECLARE LONG CSID			! CSID TO SEARCH FOR
	DECLARE LONG CSID_OF_THIS_NODE		! CSID OF THIS NODE
	DECLARE WORD CURPRIV_LENGTH		! LENGTH OF CURRENT PRIVS
	DECLARE WORD DISPLAY_RESOURCE		! TRUE TO DISPLAY RESOURCE NAME
	DECLARE WORD ERROR_FLAG			! OVERFLOW ERROR TRAP FLAG
	DECLARE STRING ERROR_LINE		! ERROR LINE DESCRIPTION
	DIM LONG IOSB(1%)			! I/O STATUS BLOCK
	DECLARE JPIBUF JPIITEM			! EQUATE $GETJPIW RECORD
	DECLARE LONG LAST_CHAR			! LAST NON-NULL CHAR IN RESNAM
	DECLARE WORD LOCK_WAS_FOUND		! TRUE IF BLOCKING LOCK FOUND
	DECLARE WORD LOG_LENGTH			! LENGTH OF LOGICAL NAME
	DECLARE STRING NAME_TO_TRANS		! NAME TO BE TRANSLATED
	DECLARE LONG NODE_COUNTER		! COUNT OF CLUSTER NODES
	DECLARE WORD NODE_CSID_LENGTH		! LENGTH OF CLUSTER SYSTEM ID
	DECLARE LONG NODE_INDEX			! TEMP CLUSTER NODE ARRAY INDEX
	DECLARE STRING NODE_NAME		! LOCAL NODE NAME
	DECLARE LONG NUMBER_OF_RECS		! NUMBER OF BLOCKING RECORDS
	DECLARE WORD OUT_LENGTH			! OUTPUT LENGTH FOR SYS$FAO
	DECLARE LONG R				! RECORD INDEX COUNTER
	DECLARE LONG SEARCH_LOCK_ID		! LOCK ID TO SEARCH FOR
	DECLARE STRING SEARCH_PID		! PID STRING TO SEARCH FOR
	DECLARE LONG SEARCH_POS			! SUBSTRING SEARCH POSITION
	DECLARE SYIBUF SYIITEM			! EQUATE $GETSYIW RECORD
	DECLARE WORD SYI_NODE_NAME_LENGTH	! LENGTH OF SYI_NODE_NAME
	DECLARE LONG SYS_STATUS			! SYSTEM SERVICE STATUS
	DECLARE LONG TEMP			! TEMPORARY LONGWORD VARIABLE
	DECLARE STRING TEMP_STRING		! TEMPORARY STRING VARIABLE
	DECLARE TRNBUF TRNITEM			! EQUATE $TRNLNM RECORD
	DECLARE WORD WORLD_ON			! TRUE IF WORLD PRIV IS ON

	! ----- DEFINE COMMON INTER-MODULE DATA COMMON -----
	MAP (BLKMAP)	LONG BLOCKING_COUNTER,				&
			LONG EXIT_STATUS,				&
			LONG SEARCH_PID_VALUE,				&
			LONG THE_BLOCKING_LENGTH(300%),			&
			STRING BLOCKING_LOCKS(300%) = 282%

	! ----- DEFINE DATA ITEM TO BE RETURNED BY $FAO -----
	MAP (FAOBUF)	STRING FAO_OUTPUT = 255%! OUTPUT BUFFER FOR SYS$FAO

	! ----- DEFINE DATA ITEM TO BE RETURNED BY $GETJPI -----
	MAP (GETJPI)	LONG	CURPRIV(1%)	! CURRENT PRIVILEGES

	! ----- DEFINE DATA ITEMS TO BE RETURNED BY $GETLKI -----
	MAP (GETLKI)	STRING 	GETLKI_WHOLE_REC = 282%
	MAP (GETLKI)	LONG	PID,		! PID			&
			LONG	LOCK_ID,	! LOCK ID		&
			STATEF	LOCK_STATE,	! LOCK STATE		&
			LKIDEF	BLOCKING(9%),	! LOCKS BLOCKING LOCK	&
			STRING	RESNAM = 31%	! RESOURCE NAME
	! ----- REMAP THE RESOURCE NAME SO THAT ITS BYTES CAN BE CHECKED -----
	MAP (GETLKI)	STRING 	FILL = 251%,				&
			BYTE	RESNAM_BYTES(30%)
	! ----- REMAP THE RESOURCE NAME IF THIS IS A AREA OR RECORD LOCK -----
	MAP (GETLKI)	STRING 	FILL = 252%,				&
			WORD	LINE_NUMBER,				&
			LONG	PAGE_NUMBER
	! ----- REMAP THE RESOURCE NAME IF THIS IS A PAGE LOCK -----
	MAP (GETLKI)	STRING 	FILL = 252%,				&
			LONG	PAGE_LOCK_PAGE_NUMBER

	! ----- DEFINE DATA ITEMS TO BE RETURNED BY $GETSYIW -----
	MAP (GETSYI)	LONG	NODE_CSID,	! CLUSTER SYSTEM ID	&
			STRING	SYI_NODE_NAME = 15% ! NODE NAME

	! ----- RE-MAP LONGWORD INTO 2 WORDS -----
	MAP (LENMAP)	LONG BLOCKING_LENGTH	! LENGTH OF BLOCKING
	MAP (LENMAP)	WORD TOTAL_BLOCKING_LEN,! TOT LENGTH ALL LOCKS	&
			WORD BLOCKING_LEN	! LENGTH OF EACH BLOCKING LOCK

	! ----- MAPPED VARIABLE FOR $TRNLNM SYSTEM SERVICE -----
	MAP (TRNDSC)	STRING LOG_NAME = 255%	! EQUIVALENCE NAME

	! ----- EXTERNAL SYSTEM SERVICE FUNCTIONS -----
	EXTERNAL LONG FUNCTION LIB$GET_FOREIGN	! GET FOREIGN DCL COMMAND
	EXTERNAL SUB LIB$STOP			! ABORT WITH ERROR STATUS
	EXTERNAL LONG SHOW_LOCK			! EXECUTIVE-MODE $GETLKI FUNCT
	EXTERNAL LONG FUNCTION SYS$CMEXEC	! CHANGE MODE TO EXECUTIVE
	EXTERNAL SUB SYS$EXIT			! EXIT WITH ERROR STATUS
	EXTERNAL LONG FUNCTION SYS$FAO		! FORMATTED ASCII OUTPUT
	EXTERNAL LONG FUNCTION SYS$GETJPIW	! GET JOB/PROCESS INFO AND WAIT
	EXTERNAL LONG FUNCTION SYS$GETSYIW	! GET SYSTEM INFO AND WAIT
	EXTERNAL LONG FUNCTION SYS$TRNLNM	! TRANSLATE LOGICAL NAME

	! ----- CONVERTS A LONGWORD TO AN 8-CHAR HEX STRING -----
	DEF STRING TOHEX(LONG LONG_INPUT)
		SYS_STATUS = SYS$FAO("!XL", OUT_LENGTH, FAO_OUTPUT,	&
			LONG_INPUT BY VALUE)
		TOHEX = LEFT(FAO_OUTPUT, OUT_LENGTH)
	END DEF

	! ----- CONVERTS A BYTE MODE INTO A 2-CHAR STRING DESCRIPTION -----
	DEF STRING TO_MODE(BYTE MODE_VALUE)
		SELECT MODE_VALUE
		CASE LCK$K_NLMODE
			TO_MODE = "NL"
		CASE LCK$K_CRMODE
			TO_MODE = "CR"
		CASE LCK$K_CWMODE
			TO_MODE = "CW"
		CASE LCK$K_PRMODE
			TO_MODE = "PR"
		CASE LCK$K_PWMODE
			TO_MODE = "PW"
		CASE LCK$K_EXMODE
			TO_MODE = "EX"
		CASE ELSE
			IF MODE_VALUE < 10% THEN
				TO_MODE = " " + NUM1$(MODE_VALUE)
			ELSE
				TO_MODE = NUM1$(MODE_VALUE)
			END IF
		END SELECT
	END DEF

	! ----- CONVERTS A BYTE MODE INTO A VARIABLE STRING DESCRIPTION -----
	DEF STRING TO_MODE_LOCK(BYTE MODE_VALUE)
		SELECT MODE_VALUE
		CASE LCK$K_NLMODE
			TO_MODE_LOCK = " an NL"
		CASE LCK$K_CRMODE
			TO_MODE_LOCK = " a CR"
		CASE LCK$K_CWMODE
			TO_MODE_LOCK = " a CW"
		CASE LCK$K_PRMODE
			TO_MODE_LOCK = " a PR"
		CASE LCK$K_PWMODE
			TO_MODE_LOCK = " a PW"
		CASE LCK$K_EXMODE
			TO_MODE_LOCK = " an EX"
		CASE ELSE
			TO_MODE_LOCK = " " + NUM1$(MODE_VALUE)
		END SELECT
	END DEF

	! ----- CONVERTS A BYTE QUEUE INTO A VARIABLE STRING DESCRIPTION -----
	DEF STRING TO_QUEUE_STATE(BYTE QUEUE_VALUE)
		SELECT QUEUE_VALUE
		CASE LKI$C_GRANTED
			TO_QUEUE_STATE = " granted at "
		CASE LKI$C_CONVERT
			TO_QUEUE_STATE = " converting to "
		CASE LKI$C_WAITING
			TO_QUEUE_STATE = " waiting for "
		CASE ELSE
			TO_QUEUE_STATE = " in " + NUM1$(QUEUE_VALUE) + "-Queue "
		END SELECT
	END DEF

	! ----- CONVERTS A LONGWORD SYSTEM ID INTO A STRING DESCRIPTION -----
	DEF STRING TO_SYSID(LONG SYSID)
		NODE_INDEX = 0%
		WHILE NODE_INDEX < NODE_COUNTER	! FOR EACH CLUSTER NODE:
			NODE_INDEX = NODE_INDEX + 1%
			! ----- SEE IF CSID MATCHES -----
			IF SYSID = CLUSTER_CSID(NODE_INDEX) THEN
				! ----- RETURN NODE NAME -----
				TO_SYSID = CLUSTER_NODENAME(NODE_INDEX)
				EXIT DEF
			END IF
		NEXT
		! ----- SEE IF LOCAL CSID VALUE MATCHES -----
		IF CSID_OF_THIS_NODE = 0% OR CSID_OF_THIS_NODE = SYSID THEN
			TO_SYSID = NODE_NAME
		ELSE
			TO_SYSID = TOHEX(SYSID)	! RETURN HEX SYSTEM ID VALUE
		END IF
	END DEF

	ERROR_LINE = "INIT"			! INIT ERROR DESCRIPTION
	ERROR_FLAG = 0%				! INIT OVERFLOW ERROR TRAP FLAG

	JPIITEM::BUFFER_LENGTH1		= 8%	! STORE DATA FOR $GETJPIW
	JPIITEM::ITEM_CODE1		= JPI$_CURPRIV
	JPIITEM::BUFFER_ADDRESS1	= LOC(CURPRIV(0%))
	JPIITEM::RETURN_LENGTH_ADDRESS1	= LOC(CURPRIV_LENGTH)
	JPIITEM::LIST_TERMINATOR	= 0%

	SYIITEM::BUFFER_LENGTH1		= 4%	! STORE DATA FOR $GETSYIW
	SYIITEM::ITEM_CODE1		= SYI$_NODE_CSID
	SYIITEM::BUFFER_ADDRESS1	= LOC(NODE_CSID)
	SYIITEM::RETURN_LENGTH_ADDRESS1	= LOC(NODE_CSID_LENGTH)
	SYIITEM::BUFFER_LENGTH2		= 15%
	SYIITEM::ITEM_CODE2		= SYI$_NODENAME
	SYIITEM::BUFFER_ADDRESS2	= LOC(SYI_NODE_NAME)
	SYIITEM::RETURN_LENGTH_ADDRESS2	= LOC(SYI_NODE_NAME_LENGTH)
	SYIITEM::LIST_TERMINATOR	= 0%

	TRNITEM::BUFFER_LENGTH1		= 255%	! STORE DATA FOR $TRNLNM
	TRNITEM::ITEM_CODE1		= LNM$_STRING
	TRNITEM::BUFFER_ADDRESS1	= LOC(LOG_NAME)
	TRNITEM::RETURN_LENGTH_ADDRESS1	= LOC(LOG_LENGTH)
	TRNITEM::LIST_TERMINATOR	= 0%

	! ----- TRY TO TRANSLATE SYS$NODE LOGICAL NAME -----
	SYS_STATUS = SYS$TRNLNM(, "LNM$DCL_LOGICAL", "SYS$NODE", , TRNITEM)
	SELECT SYS_STATUS
	CASE SS$_NORMAL
		TEMP_STRING = LEFT(LOG_NAME, LOG_LENGTH)
		! ----- EXTRACT LOGICAL NAME (LESS ANY ::) -----
		IF RIGHT(TEMP_STRING, LOG_LENGTH - 1%) = "::" THEN
			NODE_NAME = LEFT(LOG_NAME, LOG_LENGTH - 2%)
		ELSE
			NODE_NAME = TRM$(TEMP_STRING)
		END IF
	CASE ELSE
		CALL LIB$STOP(SYS_STATUS BY VALUE)
	END SELECT

	! ----- GET THE INFO ON ALL NODES IN THE CLUSTER -----
	SYS_STATUS = SS$_NORMAL			! SET SO LOOP WILL EXECUTE
	CSID = -1%				! SET FOR WILDCARD OPERATION
	NODE_COUNTER = 0%			! INIT COUNT OF CLUSTER NODES
	CSID_OF_THIS_NODE = 0%			! INIT LOCAL CSID VALUE
	WHILE SYS_STATUS = SS$_NORMAL
		! ----- GET THE NEXT CLUSTER NODE -----
		SYS_STATUS = SYS$GETSYIW(, CSID , , SYIITEM, , , )
		ITERATE IF SYS_STATUS <> SS$_NORMAL

		NODE_COUNTER = NODE_COUNTER + 1%
		CLUSTER_CSID(NODE_COUNTER) = NODE_CSID
		CLUSTER_NODENAME(NODE_COUNTER) = LEFT(SYI_NODE_NAME,	&
			SYI_NODE_NAME_LENGTH)
		! ----- SEE IF LOCAL NODE WAS FOUND -----
		IF NODE_NAME = CLUSTER_NODENAME(NODE_COUNTER) THEN
			! ----- STORE CSID OF THIS NODE -----
			CSID_OF_THIS_NODE = NODE_CSID
		END IF
	NEXT
	! ----- NO ERROR IF DONE WITH NODE LIST -----
	SYS_STATUS = SS$_NORMAL IF SYS_STATUS = SS$_NOMORENODE
	CALL LIB$STOP(SYS_STATUS BY VALUE) IF SYS_STATUS <> SS$_NORMAL

	! ----- GET THE INFO ON THIS PROCESS -----
	SYS_STATUS = SYS$GETJPIW(, , , JPIITEM, , , )
	CALL LIB$STOP(SYS_STATUS BY VALUE) IF SYS_STATUS <> SS$_NORMAL

	! ----- CHECK STATUS OF USER'S CMEXEC AND WORLD PRIVS -----
	IF (CURPRIV(0%) AND PRV$M_CMEXEC) > 0% THEN
		CMEXEC_ON = TRUE		! USER HOLDS CMEXEC PRIVILEGE
	ELSE
		CMEXEC_ON = FALSE		! USER DOES NOT HOLD CMEXEC PRIV
	END IF
	IF (CURPRIV(0%) AND PRV$M_WORLD) > 0% THEN
		WORLD_ON = TRUE			! USER HOLDS WORLD PRIVILEGE
	ELSE
		WORLD_ON = FALSE		! USER DOES NOT HOLD WORLD PRIV
	END IF

	! ----- ENSURE CMEXEC AND WORLD PRIVILEGES ARE TURNED ON -----
	IF NOT (CMEXEC_ON AND WORLD_ON) THEN	! IF CMEXEC AND WORLD NOT ON:
		PRINT
		PRINT "You must have CMEXEC and WORLD privileges to" +	&
			" run this program." + BEL
		CALL SYS$EXIT(ERROR_WITH_NO_PUTMSG BY VALUE)
	END IF

	! ----- GET ANY FOREIGN DCL COMMAND STRING -----
	SYS_STATUS = LIB$GET_FOREIGN(COMMAND_STRING,, COMMAND_STRING_LENGTH)
	CALL LIB$STOP(SYS_STATUS BY VALUE) IF SYS_STATUS <> SS$_NORMAL
	IF COMMAND_STRING_LENGTH = 0% THEN
		COMMAND_STRING = ""
	ELSE
		COMMAND_STRING = LEFT(COMMAND_STRING, COMMAND_STRING_LENGTH)
	END IF

 GET_PID:

	ERROR_LINE = "GET PID TO SEARCH FOR"
	IF COMMAND_STRING = "" THEN
		SEARCH_PID = ""
	ELSE
		SEARCH_PID = COMMAND_STRING
	END IF
	WHILE LEN(SEARCH_PID) <> 8% OR COMMAND_STRING <> ""
		COMMAND_STRING = ""		! INIT SO LOOP WILL EXIT
		IF SEARCH_PID = "" THEN
			LINPUT "Enter 8-char PID to search for: "; SEARCH_PID
		END IF
		SEARCH_PID = EDIT$(SEARCH_PID, 38%)

		IF LEN(SEARCH_PID) <> 8% THEN
			PRINT
			PRINT "ERROR - Invalid PID - Try again" + BEL
			PRINT
			SEARCH_PID = ""		! CLEAR TO RE-EXECUTE LOOP
		END IF

		! ----- CONVERT THE 8-CHAR HEX STRING TO A LONGWORD -----
		SEARCH_PID_VALUE = 0%
		TEMP = 8%
		WHILE TEMP > 0%
			TEMP = TEMP - 1%
			SEARCH_POS = POS("0123456789ABCDEF",		&
				MID(SEARCH_PID, 8% - TEMP, 1%), 1%) - 1%
			IF SEARCH_POS < 0% THEN
				PRINT
				PRINT "ERROR - Invalid PID - Try again" + BEL
				PRINT
				TEMP = 0%	! SET TO EXIT INNER LOOP
				SEARCH_PID = ""	! CLEAR TO RE-EXECUTE OUTER LOOP
				ITERATE
			END IF
			ERROR_FLAG = 1%		! SET TO TRAP OVERFLOW ERROR
			SEARCH_PID_VALUE = SEARCH_PID_VALUE +		&
				16% ^ TEMP * SEARCH_POS
			ERROR_FLAG = 0%		! CLEAR OVERFLOW ERROR TRAP FLAG
		NEXT
		ITERATE IF SEARCH_PID = ""	! SEE IF OUTER LOOP TO RE-EXEC

		! ----- ENSURE THAT THIS PROCESS EXISTS -----
		SYS_STATUS = SYS$GETJPIW(, SEARCH_PID_VALUE, , JPIITEM, , , )
		SELECT SYS_STATUS
		CASE SS$_NORMAL			! PROCESS EXISTS
		CASE SS$_NONEXPR		! PROCESS DOES NOT EXIST
			PRINT
			PRINT "ERROR - Non-existant process - Try again" + BEL
			PRINT
			SEARCH_PID = ""		! CLEAR TO RE-EXECUTE LOOP
		CASE ELSE			! UNEXPECTED $GETJPI ERROR
			CALL LIB$STOP(SYS_STATUS BY VALUE)
		END SELECT
	NEXT

	! ----- GET ALL LOCKS THAT THIS PID HAS -----
	PRINT "FINDLOCK Executing - Please Stand By (This may take a minute)..."
	SYS_STATUS = SYS$CMEXEC(SHOW_LOCK,)
	CALL LIB$STOP(SYS_STATUS BY VALUE) IF SYS_STATUS <> SS$_NORMAL

	CALL LIB$STOP(EXIT_STATUS BY VALUE) IF EXIT_STATUS <> SS$_NORMAL

	%IF %DEBUG <> 0% %THEN
		PRINT "BLOCKING_COUNTER=" + NUM1$(BLOCKING_COUNTER)
	%END %IF

	ERROR_LINE = "DISPLAY LOCKS"
	LOCK_WAS_FOUND = FALSE			! ASSUME NO BLOCKING LOCK FOUND
	WHILE BLOCKING_COUNTER > 0%
		! ----- MOVE INTER-MODULE COMMON ELEMENTS TO MY MAP -----
		GETLKI_WHOLE_REC = BLOCKING_LOCKS(BLOCKING_COUNTER)
		BLOCKING_LENGTH = THE_BLOCKING_LENGTH(BLOCKING_COUNTER)

		BLOCKING_COUNTER = BLOCKING_COUNTER - 1%

		! ----- SKIP IF LOCK IS HELD BY THE DBMS MONITOR -----
		ITERATE IF LEFT(RESNAM, 1%) = "I"

		%IF %DEBUG <> 0% %THEN
			PRINT "------------------------------------"
			PRINT "Found PID=" + TOHEX(PID)
			PRINT "BLOCKING_LEN=" + NUM1$(BLOCKING_LEN)
			PRINT "TOTAL_BLOCKING_LEN=" + NUM1$(TOTAL_BLOCKING_LEN)
		%END %IF

		! ----- SKIP THIS LOCK IF IT IS NOT BLOCKED BY ANY OTHER -----
		! ----- LOCK ----
		ITERATE IF TOTAL_BLOCKING_LEN <= 0%

		! ----- MASK OUT BIT 15 OF THE SECOND WORD VALUE -----
		BLOCKING_LEN = BLOCKING_LEN AND 32767%

		! ----- CALCULATE NUMBER OF BLOCKING RECORDS RETURNED -----
		IF BLOCKING_LEN = 0% THEN
			NUMBER_OF_RECS = 0%
		ELSE
			NUMBER_OF_RECS = TOTAL_BLOCKING_LEN / BLOCKING_LEN
			LOCK_WAS_FOUND = TRUE	! A BLOCKING LOCK WAS FOUND
		END IF

		%IF %DEBUG <> 0% %THEN
			PRINT "NUMBER_OF_RECS=" + NUM1$(NUMBER_OF_RECS)
		%END %IF

		PRINT
		PRINT "Stalled Lock Id " + TOHEX(LOCK_ID) +		&
			" is granted at " +				&
			TO_MODE(LOCK_STATE::LKI$B_STATE_GRMODE) +	&
			" and is" +					&
			TO_QUEUE_STATE(LOCK_STATE::LKI$B_STATE_QUEUE) +	&
			TO_MODE(LOCK_STATE::LKI$B_STATE_RQMODE)

		! ----- LOCATE LAST NON-NULL CHARACTER IN THE RESOURCE -----
		! ----- NAME -----
		TEMP = 31%			! INIT LOOP COUNTER
		LAST_CHAR = 31%			! INIT TO LAST CHAR OF RESOURCE
		WHILE TEMP > 0%
			TEMP = TEMP - 1%
			IF RESNAM_BYTES(TEMP) <> 0% THEN
				LAST_CHAR = TEMP + 1%
				TEMP = -1%	! SET TO EXIT LOOP
			END IF
		NEXT

		PRINT "The type of lock is: ";
		SELECT LEFT(RESNAM, 1%)
		CASE "A"
			PRINT "AIJ Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "B"
			PRINT "Background Storage Area Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "C"
			PRINT "Snap Area Cursor Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "D"
			PRINT "Database Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "E"
			PRINT "FILID Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "F"
			PRINT "Database Freeze Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "G"
			PRINT "TSNBLK Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "H"
			PRINT "RTUPB clist Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "J"
			PRINT "BCKAIJ Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "K"
			PRINT "Database Key Scope Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "L"
			PRINT "Record Lock on Page " +			&
				NUM1$(PAGE_NUMBER) + ", Line " +	&
				NUM1$(LINE_NUMBER)
			DISPLAY_RESOURCE = FALSE
		CASE "M"
			PRINT "Monitor Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "N"
			PRINT "ACTIVE Bitmap Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "P"
			PRINT "Page Lock on Page " +			&
				NUM1$(PAGE_LOCK_PAGE_NUMBER)
			DISPLAY_RESOURCE = FALSE
		CASE "Q"
			PRINT "Quiet Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "R"
			PRINT "Database Read/Write Root Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "S"
			PRINT "Storage Area Lock on Area " +		&
				NUM1$(LINE_NUMBER)
			DISPLAY_RESOURCE = FALSE
		CASE "T"
			PRINT "Stream Termination Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "U"
			PRINT "Client Specific Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "V"
			PRINT "MEMBIT Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "W"
			PRINT "ACCESS - Database Access Lock"
			DISPLAY_RESOURCE = TRUE
		CASE "Z"
			PRINT "Bugcheck Lock"
			DISPLAY_RESOURCE = TRUE
		CASE ELSE
			PRINT "Unknown Lock"
			DISPLAY_RESOURCE = TRUE
		END SELECT

		IF DISPLAY_RESOURCE THEN
			PRINT "  Resource Name is *";
			FOR R = 1% TO LAST_CHAR
				TEMP = ASCII(MID(RESNAM, R, 1%))
				SELECT TEMP
				CASE 0%
					PRINT ".";
				CASE 32% TO 45%, 47% TO 126%
					PRINT CHR$(TEMP);
				CASE 46%
					PRINT "<.>";
				CASE ELSE
					PRINT "<" + NUM1$(TEMP) + ">";
				END SELECT
			NEXT R
			PRINT "*"
		END IF

		R = -1%
		WHILE R < NUMBER_OF_RECS - 1%
			R = R + 1%

			ERROR_LINE = "PROCESS SUB-RECORD #" + NUM1$(R)

			! ----- SKIP IF NO BLOCKING PID -----
			ITERATE IF BLOCKING(R)::LKI$L_PID = 0%

			PRINT "PID " + TOHEX(BLOCKING(R)::LKI$L_PID) +	&
				" on node " +				&
				TO_SYSID(BLOCKING(R)::LKI$L_CSID) +	&
				" is holding" +				&
				TO_MODE_LOCK(BLOCKING(R)::LKI$B_GRMODE)	&
				+ " mode lock"

			! ----- SEE IF THE CSID OF THE REQUESTING NODE -----
			! ----- IS DIFFERENT FROM THE CSID MAINTAINING -----
			! ----- THE RESOURCE -----
			IF BLOCKING(R)::LKI$L_CSID <> BLOCKING(R)::LKI$L_MSTCSID
			THEN
				PRINT "Note:  The resource for" +	&
					" this lock is maintained on" +	&
					" a different node: " +		&
					TO_SYSID(BLOCKING(R)::LKI$L_MSTCSID)
				PRINT "       The lock ID for" +	&
					" this resource on the" +	&
					" different node is: " +	&
					TOHEX(BLOCKING(R)::LKI$L_MSTLKID)
			END IF
		NEXT
	NEXT

	IF NOT LOCK_WAS_FOUND THEN
		PRINT "This process currently has no blocked locks."
	END IF

	PRINT BEL				! BEEP WHEN DONE
	ERROR_LINE = "END PROGRAM"
	GOTO END_PROGRAM

 ERROR_ROUTINE:

	IF ERR = INTEGER_OVERFLOW AND ERROR_FLAG = 1% THEN
		ERROR_FLAG = 0%			! CLEAR OVERFLOW ERROR TRAP FLAG
		PRINT
		PRINT "ERROR - Invalid PID - Try again" + BEL
		PRINT
		RESUME GET_PID
	END IF
	IF ERR <> END_OF_FILE THEN		! ERROR IF OTHER THEN EOF
		PRINT "Unexpected error " + NUM1$(ERR) + " in FINDLOCK" + BEL
		PRINT "After Error Line: " + ERROR_LINE
		PRINT ERT$(ERR)
	END IF
	RESUME END_PROGRAM

 END_PROGRAM:

	END