10 ! ----- SHOW_LOCK.BAS ----- ! ! ----- External Function Called by FINDLOCK.BAS to locate all ----- ! ----- PIDs of User(s) who are causing another User PID to be ----- ! ----- stalled ----- ! ! ----- Restrictions: ----- ! ----- 1) Calling program must execute this routine in EXEC mode ----- ! ----- 2) WORLD privilege required ----- ! ! ----- Note that any "%BASIC-I-LANFEAINH" errors must be treated ----- ! ----- as fatal compiler errors, since this function is compiled ----- ! ----- with the OPTION INACTIVE = SETUP statement ----- ! ! ----------- Passed: (via BLKMAP common) ----------- ! ! ----- SEARCH_PID_VALUE (LONGWORD) PID Value to search for (or ! ----- -1 to search for all PIDs) ! ! ---------- Returned: (via BLKMAP common) ---------- ! ! ----- EXIT_STATUS (LONGWORD) System Service Exit Status ! ----- (SS$_NORMAL if successful) ! ! ----- BLOCKING_COUNTER (LONGWORD) Count of Blocking Locks that ! ----- are returned in the ! ----- BLOCKING_LOCKS() array ! ----- (0 if no blocking locks) ! ! ----- BLOCKING_LOCKS() (STRING 251) All Locks that are Blocking ! ----- the passed PID ! ! ----- THE_BLOCKING_LENGTH() (LONG) BLOCKING_LENGTH of each returned ! ----- lock ! ! ------------------------------------------------- ! ----- Last Change 03/23/90 by Brian Lomasky ----- ! ------------------------------------------------- ! FUNCTION LONG SHOW_LOCK %LET %DEBUG = 0% ! 1 IF DEBUG ENABLED, 0 IF NOT OPTION INACTIVE = SETUP OPTION TYPE = EXPLICIT %INCLUDE "$LCKDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "$LKIDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" ! ----- SYSTEM SERVICE ERROR CODES AND FUNCTION VALUES ----- EXTERNAL LONG CONSTANT SS$_NOMORELOCK ! NO MORE LOCKS RETURN STATUS EXTERNAL LONG CONSTANT SS$_NORMAL ! NORMAL SUCCESS STATUS RECORD LKIBUF ! $GETLKIW 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 WORD BUFFER_LENGTH3 WORD ITEM_CODE3 LONG BUFFER_ADDRESS3 LONG RETURN_LENGTH_ADDRESS3 WORD BUFFER_LENGTH4 WORD ITEM_CODE4 LONG BUFFER_ADDRESS4 LONG RETURN_LENGTH_ADDRESS4 WORD BUFFER_LENGTH5 WORD ITEM_CODE5 LONG BUFFER_ADDRESS5 LONG RETURN_LENGTH_ADDRESS5 LONG LIST_TERMINATOR END RECORD LKIBUF ! ----- LOCAL VARIABLE DECLARATIONS ----- DIM LONG IOSB(1%) ! I/O STATUS BLOCK DECLARE LKIBUF LKIITEM ! EQUATE $GETLKIW RECORD DECLARE LONG LOCK_ID_LENGTH ! LENGTH OF LOCK_ID DECLARE LONG LOCK_STATE_LENGTH ! LENGTH OF LOCK_STATE DECLARE LONG PID_LENGTH ! LENGTH OF PID DECLARE LONG RESNAM_LENGTH ! LENGTH OF RESNAM DECLARE LONG SEARCH_LOCK_ID ! LOCK ID TO SEARCH FOR DECLARE LONG SYS_STATUS ! SYSTEM SERVICE STATUS ! ----- 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 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 ! ----- 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 ! ----- EXTERNAL SYSTEM SERVICE FUNCTIONS ----- EXTERNAL LONG FUNCTION SYS$GETLKIW ! GET LOCK INFORMATION AND WAIT BLOCKING_COUNTER = 0% LKIITEM::BUFFER_LENGTH1 = 4% ! STORE DATA FOR $GETLKI LKIITEM::ITEM_CODE1 = LKI$_PID LKIITEM::BUFFER_ADDRESS1 = LOC(PID) LKIITEM::RETURN_LENGTH_ADDRESS1 = LOC(PID_LENGTH) LKIITEM::BUFFER_LENGTH2 = 4% LKIITEM::ITEM_CODE2 = LKI$_LOCKID LKIITEM::BUFFER_ADDRESS2 = LOC(LOCK_ID) LKIITEM::RETURN_LENGTH_ADDRESS2 = LOC(LOCK_ID_LENGTH) LKIITEM::BUFFER_LENGTH3 = LKI$S_STATEF ! LENGTH OF LOCK_STATE LKIITEM::ITEM_CODE3 = LKI$_STATE LKIITEM::BUFFER_ADDRESS3 = LOC(LOCK_STATE) LKIITEM::RETURN_LENGTH_ADDRESS3 = LOC(LOCK_STATE_LENGTH) LKIITEM::BUFFER_LENGTH4 = LKI$K_LENGTH * 10% LKIITEM::ITEM_CODE4 = LKI$_BLOCKING LKIITEM::BUFFER_ADDRESS4 = LOC(BLOCKING(0%)) LKIITEM::RETURN_LENGTH_ADDRESS4 = LOC(BLOCKING_LENGTH) LKIITEM::BUFFER_LENGTH5 = 31% LKIITEM::ITEM_CODE5 = LKI$_RESNAM LKIITEM::BUFFER_ADDRESS5 = LOC(RESNAM) LKIITEM::RETURN_LENGTH_ADDRESS5 = LOC(RESNAM_LENGTH) LKIITEM::LIST_TERMINATOR = 0% ! ----- GET ALL LOCKS THAT THIS PID HAS ----- SEARCH_LOCK_ID = -1% ! SET FOR WILDCARDED LOCK ID SYS_STATUS = SS$_NORMAL ! SO LOOP WILL EXECUTE WHILE SYS_STATUS = SS$_NORMAL ! UNITL WE'RE DONE: ! ----- GET NEXT LOCK ID INFO ----- SYS_STATUS = SYS$GETLKIW(, ! EFN & SEARCH_LOCK_ID, ! LOCK ID TO SEARCH FOR & LKIITEM BY REF, ! ITEM LIST TO RETURN & IOSB(0%) BY REF, ! I/O STATUS BLOCK & , ! AST ADDRESS & , ! AST PARAMETER & ) ! NULL IF SYS_STATUS <> SS$_NORMAL THEN %IF %DEBUG <> 0% %THEN PRINT "SYS_STATUS="; SYS_STATUS %END %IF ITERATE END IF IF IOSB(0%) <> SS$_NORMAL THEN %IF %DEBUG <> 0% %THEN PRINT "IOSB(0%)="; IOSB(0%) %END %IF SYS_STATUS = IOSB(0%) ITERATE END IF ! ----- SKIP IF THIS LOCK IS NOT OWNED BY THIS PID ----- ITERATE IF PID <> SEARCH_PID_VALUE AND SEARCH_PID_VALUE <> -1% %IF %DEBUG <> 0% %THEN PRINT ">>>> Found PID="; PID; ", Lock ID "; LOCK_ID PRINT " BLOCKING_LEN="; BLOCKING_LEN PRINT " TOTAL_BLOCKING_LEN="; TOTAL_BLOCKING_LEN %END %IF ! ----- SKIP THIS LOCK IF IT IS NOT BLOCKED BY ANY OTHER ----- ! ----- LOCK ---- IF TOTAL_BLOCKING_LEN <= 0% THEN %IF %DEBUG <> 0% %THEN PRINT "Skip since lock is not blocked" %END %IF ITERATE END IF ! ----- SKIP IF MEMORY ARRAY IS FILLED ----- IF BLOCKING_COUNTER >= 300% THEN %IF %DEBUG <> 0% %THEN PRINT "Skip since memory array is filled" %END %IF ITERATE END IF ! ----- STORE ALL LOCK DATA WHICH WILL BE RETURNED TO ----- ! ----- CALLER ----- %IF %DEBUG <> 0% %THEN PRINT "Store Lock Data in array element: "; & BLOCKING_COUNTER %END %IF BLOCKING_COUNTER = BLOCKING_COUNTER + 1% BLOCKING_LOCKS(BLOCKING_COUNTER) = GETLKI_WHOLE_REC THE_BLOCKING_LENGTH(BLOCKING_COUNTER) = BLOCKING_LENGTH NEXT %IF %DEBUG <> 0% %THEN PRINT "Exit Loop - SYS_STATUS="; SYS_STATUS %END %IF IF SYS_STATUS <> SS$_NOMORELOCK THEN EXIT_STATUS = SYS_STATUS ! RETURN VMS ERROR STATUS SHOW_LOCK = SYS_STATUS ! RETURN VMS ERROR STATUS ELSE EXIT_STATUS = SS$_NORMAL ! RETURN VMS SUCCESS STATUS SHOW_LOCK = SS$_NORMAL ! RETURN VMS SUCCESS STATUS END IF END FUNCTION