!STROBE.BAS -- Cause a blocking AST to be delivered on
	!	       LATCHed (or other) locks.
	!
	%TITLE "STROBE"
	%IDENT "V 2.10"
	! 2.10	13-JAN 91 Cleaned up and commented for publication
	! 2.00  25-MAY-89 Added CLI interface.
	!
	! 1.21	05-SEP-85 Moved call to SYS$ASCTIM to just before strobe
	!		  instead of just before prompt.
	! 1.20	22-AUG-85 Added ability to supress automatic prefixing of user
	!		  supplied lock resource name.
	! 1.10	11-JUN-85 Added $GETLKI for CSID and lock count.
	!
	PRINT "	STROBE V 2.10"
	%PAGE
	%SBTTL "RECORD declarations"
	!
	!Lock Status Block (lksb) RECORD definition
	!
	RECORD	LKSB
		WORD	L_STATUS
		WORD	FILL
		LONG	LOCK_ID
		BYTE	LVB(15)		!May need redefinition for any
					! given application. Always
					! 16 bytes.
	END RECORD

	!
	!Item list (itmlst) entry data type definition
	!
	RECORD ITMLST
		WORD	BUFF_LEN		!Target BUFFer LENgth
		WORD	ITEM_CODE		!Requested ITEM CODE
		LONG	BUFF_ADDR		!Target BUFFer ADDRess
		LONG	RET_LEN_ADDR		!RETurn actual LENgth 
						! into this ADDRess 
	END RECORD

	!
	!Create an IOSB data type
	!
	RECORD IOSB	!Special for $GETLKI
		LONG	GETLKI_STATUS
		LONG	XX_UNUSED_XX
	END RECORD
	%PAGE
	%SBTTL "Function declarations"
	!Local
	!	-none-
	!External
	EXTERNAL LONG	FUNCTION	SYS$ASCTIM,		&
					SYS$DEQ,		&
					SYS$ENQW,		&
					SYS$GETLKIW,		&
					LIB$SYS_FAO,		&
					CLI$PRESENT,		&
					CLI$GET_VALUE
	%PAGE
	%SBTTL "Constant declarations"
	!Local
	DECLARE LONG	CONSTANT	TRUE = -1,		&
					FALSE = 0

	!External
	EXTERNAL LONG	CONSTANT	SS$_NORMAL,		&
					LCK$K_CRMODE,		&
					LCK$K_EXMODE,		&
					LCK$M_CONVERT,		&
					LKI$_LCKCOUNT,		&
					LKI$_SYSTEM,		&
					CLI$_PRESENT,		&
					CLI$_ABSENT,		&
					CLI$_NEGATED,		&
					CLI$_DEFAULTED

	%PAGE
	%SBTTL "MAP/COMMON definitions"
	!
	!Item list and returned info buffer for $GETLKI
	!
	MAP	(LOCK_STUFF)				&
		ITMLST	LKCSID_IL,		!Entry 1 - CSID	&
		ITMLST	LKCOUNT_IL,		!Entry 2 - Lock Count	&
		LONG	END_OF_ITEM_LIST,	!End of list	&
		LONG	LKCSID,			!Returned CSID	&
		LONG	LKCOUNT                 !Returned Lock Count

	%PAGE
	%SBTTL "Variable declarations"
	!Local
	DECLARE	LONG	EV_FL,		!Event flag number	&
			I,		!Utillity variables	&
			SHOW_FLAG,	!/SHOW qualifier present	&
			NOW_FLAG,	!/NOW qualifier present	&
			RET_STAT,	!Return status		&
			RET_STAT2,	!Return status, the sequel&
			LCK_FLAGS,	!OR of lock flags	&
			EXIT_STATUS,	!Returned to DCL,	&
		STRING	LCK_FAO_CTRL,	!FAO control string	&
			TIME_STRING,				&
			RESOURCE,	!Resource name		&
			PREFIX,		!Resource name prefix	&
			ANS,		!User's answer		&
			TMP_STR,	!Temporary string	&
		LKSB	SBLK,		!Lock Status Block	&
		IOSB	GL_IOSB         !Status block for $GETLKI
	!External
	! -none-

	%PAGE
	%SBTTL "Initilization"

	ON ERROR GOTO CONDITION_HANDLER
	!Errors generated or trapped by VAX BASIC that is

	EV_FL = 4%	!Pick a flag, any flag -- event flag that is.
			!In a more complex program we would have to
			!exercise more care.

	EXIT_STATUS = 1%	!Assume everything will go well.  Problems
				!will change this value so that DCL can
				!do the right thing when we exit.

	!
	!Initialize the item list
	!
		!
		!  Item 1 -- Master system CSID 
	LKCSID_IL::BUFF_LEN = 4%	   !4 bytes = 1 longword
 	LKCSID_IL::ITEM_CODE = LKI$_SYSTEM !System mastering lock
	LKCSID_IL::BUFF_ADDR = LOC(LKCSID) !Address of LKCSID
	LKCSID_IL::RET_LEN_ADDR = 0%	   !Don't care about return length
		!
		!  Item 2 -- Count of locks granted
	LKCOUNT_IL::BUFF_LEN = 4%	      !4 bytes = 1 longword
	LKCOUNT_IL::ITEM_CODE = LKI$_LCKCOUNT !Count of locks granted for
					      ! for this resource
	LKCOUNT_IL::BUFF_ADDR = LOC(LKCOUNT)  !Address of LKCOUNT
	LKCOUNT_IL::RET_LEN_ADDR = 0%	      !Don't care about return length
		!
		!  Item 3 -- End of list
	END_OF_ITEM_LIST = 0%

	!
	!Various strings
	!
	TIME_STRING = SPACE$(23%)	!Buffer for time stamp
	LCK_FAO_CTRL = "Lock ID = !8XL    CSID = !8XL     Holder count = !SL"
					!FAO format for pertinent info
	%PAGE
	%SBTTL "Get information from command line."

	!Definitions for the CLI call backs.
	!**************  Resource Name
	RET_STAT = CLI$GET_VALUE("RESOURCE", RESOURCE)
	SELECT RET_STAT
	    CASE CLI$_PRESENT, SS$_NORMAL
		!PRINT " Resource name is '";RESOURCE;"'"     
	    CASE ELSE
		PRINT " Unexpected P1 status =";RET_STAT
	END SELECT

	!************** /PREFIX=[string]

	RET_STAT = CLI$PRESENT("Q1")
	SELECT RET_STAT
	    CASE CLI$_ABSENT
		!Prefix character unspecified, therefore...
		PREFIX = "LATCH_WAIT_FOR_"
	    CASE CLI$_NEGATED
		!No prefix is to be used, therefore...
		PREFIX = ""
	    CASE CLI$_PRESENT
		!A prefix was specified.  Go get it.
		RET_STAT2 = CLI$GET_VALUE("Q1", TMP_STR)
		SELECT RET_STAT2
		    CASE CLI$_PRESENT, SS$_NORMAL
			PREFIX = TMP_STR
		    CASE ELSE
			PRINT " Unexpected /PREFIX value. Status =";RET_STAT2
		END SELECT !RET_STAT2
	    CASE ELSE
		PRINT " Unexpected Q1 status =";RET_STAT
	END SELECT !RET_STAT

	RESOURCE = PREFIX + RESOURCE
		! ** Needs a check for 
		! ** resource name length not more than 32.]
	PRINT 'Lock resource name is "';RESOURCE;'"'

	%PAGE

	!************** /SHOW

	RET_STAT = CLI$PRESENT("Q2")
	SELECT RET_STAT
	    CASE CLI$_ABSENT, CLI$_NEGATED
		!SHOW mode has not been requested
		SHOW_FLAG = FALSE
	    CASE CLI$_PRESENT
		!GETLKI info will be shown
		SHOW_FLAG = TRUE
	    CASE ELSE
		PRINT " Unexpected /SHOW status =";RET_STAT
	END SELECT !RET_STAT

	!************** /NOW

	RET_STAT = CLI$PRESENT("Q3")
	SELECT RET_STAT
	    CASE CLI$_ABSENT, CLI$_NEGATED
		!Ask user whether to strobe
		NOW_FLAG = FALSE
	    CASE CLI$_PRESENT, CLI$_DEFAULTED
		!STROBE will be done without asking
		NOW_FLAG = TRUE
	    CASE ELSE
		PRINT " Unexpected /NOW status =";RET_STAT
	END SELECT !RET_STAT

	%PAGE
	%SBTTL "Get NL mode lock"
	!
	!SYS$ENQ system service to get compatible lock.
	!
	LCK_FLAGS = 0%	!No flags for this call
	RET_STAT = SYS$ENQW(					&
				EV_FL BY VALUE,		![efn]		&
				LCK$K_CRMODE BY VALUE,	!lkmode		&
				SBLK::L_STATUS,		!lksb		&
				LCK_FLAGS BY VALUE,	![flags]	&
				RESOURCE,		![resnam]	&
				,			![parid]	&
				,			![astpar]	&
				,			![astprm]	&
				,			![blkast]	&
				,			![acmode]	&
							!nullarg	&
				)
	! Did the call succeed?
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%STROBE --    CR MODE lock SYS$ENQ failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	! Did the request succeed
	IF SBLK::L_STATUS <> SS$_NORMAL THEN
		PRINT "%STROBE --    CR MODE lock aquisition failure"
		PRINT "%STROBE --    LKSB status =";SBLK::L_STATUS
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF

	%PAGE
	%SBTTL "Call $GETLKI system service"

 GET_INFO:
	!
	!SYS$GETLKIW system service to get master CSID and lock count
	!
	RET_STAT = SYS$GETLKIW(				&
				EV_FL BY VALUE,	![efn]		&
				SBLK::LOCK_ID,	!lkidadr	&
				LKCSID_IL,	!itmlst		&
				GL_IOSB,	![iosb]		&
				,		![astadr]	&
				,		![astprm]	&
						!nullarg	&
				)
	! Did the call succeed?
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%STROBE --    $GETLKI failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	! Did the $GETLKI service succeed?
	IF GL_IOSB::GETLKI_STATUS <> SS$_NORMAL THEN
		PRINT "%STROBE --    $GETLKI failure"
		PRINT "%STROBE --    IOSB status =";GL_IOSB::GETLKI_STATUS
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF

	!USER NOTE:
	!Holder count will always be at least one because this program
	!holds a null lock on the resource.  Would it lessen the confusion
	!display LKCOUNT-1 and call it "Other holders"?
	!
	%PAGE
	%SBTTL "Show what's happenin'"
	! Let SYS$FAO format the info.  Use LIB$ jacket because LIB$
	! knows how to handle dynamic strings.
	RET_STAT =  LIB$SYS_FAO(				&
				LCK_FAO_CTRL,		&
				,			&
				ANS,			&
				SBLK::LOCK_ID BY VALUE,	&
				LKCSID BY VALUE,	&
				LKCOUNT BY VALUE	&
				)

	IF (RET_STAT AND 1%) <> 1%
	THEN
		PRINT "%STROBE --    LIB$SYS_FAO failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 0%	!WARNING 
	END IF

	PRINT		!blank line
	PRINT ANS
	GOTO ALL_DONE IF SHOW_FLAG = TRUE	!Only lock info was wanted
	GOTO DO_STROBE IF NOW_FLAG = TRUE	!Don't ask, just do it.
	%PAGE
	%SBTTL "User input"

 PROMPT:
	!User knows the score now.  Ask what to do.
	INPUT " Continue [(Y),N,E]";TMP_STR
	TMP_STR = "Y" IF TMP_STR = ""		!Default is "Y"
	TMP_STR = EDIT$(TMP_STR,34%)		!Make it uppercase
	I = ASCII(TMP_STR)			!Look only at first letter
	SELECT I
		CASE 89%	!Answer was "Y".
			GOTO DO_STROBE
		CASE 78%	!Answer was "N".
			GOTO GET_INFO
		CASE 69%	!Answer was "E".
			GOTO ALL_DONE
		CASE ELSE	!Answer was not "Y","N" or "E".
				! so give a little help.
			PRINT "Invalid response. Choices are:"
			PRINT "	Y  Strobe resource name and exit program."
			PRINT "	N  Do not strobe, print holder info again."
			PRINT "	E  Do not strobe, exit program."
			PRINT
			GOTO PROMPT	!Ask again
	END SELECT

 DO_STROBE:
	RET_STAT = SYS$ASCTIM(,TIME_STRING,,)	!Get current time
	IF (RET_STAT AND 1%) <> 1%
	THEN
		PRINT "%STROBE --    SYS$ASCTIM failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		PRINT "% Progam continuing.  Time values will be meaningless."
		EXIT_STATUS = 0%	!WARNING
	END IF



	PRINT "%STROBE --   Strobing ";RESOURCE;".   ";TIME_STRING
				!Announce what we're doing and when.
	%PAGE
	%SBTTL "Get incompatible LATCH lock"
	!
	!SYS$ENQ system service to get EX mode lock
	!
	LCK_FLAGS = LCK$M_CONVERT	!Set flag for conversion
	RET_STAT = SYS$ENQW(					&
				EV_FL BY VALUE,		![efn]		&
				LCK$K_EXMODE BY VALUE,	!lkmode		&
				SBLK::L_STATUS,		!lksb		&
				LCK_FLAGS BY VALUE,	![flags]	&
				,			![resnam]	&
				,			![parid]	&
				,			![astpar]	&
				,			![astprm]	&
				,			![blkast]	&
				,			![acmode]	&
							!nullarg	&
				)
	!Did call succeed?
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%STROBE --    EX MODE lock aquisition failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	!Did request succeed?
	IF SBLK::L_STATUS <> SS$_NORMAL THEN
		PRINT "%STROBE --    EX MODE lock aquisition failure"
		PRINT "%STROBE --    LKSB status =";SBLK::L_STATUS
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	RET_STAT = SYS$ASCTIM(,TIME_STRING,,)	!Get current time
	IF (RET_STAT AND 1%) <> 1%
	THEN
		PRINT " %Error getting current time."
		PRINT " %Status ="; RET_STAT
		PRINT " % Progam continuing.  Time values will be meaningless."
		EXIT_STATUS = 0%	!WARNING
	END IF

	!When we get here we have acquired an EX mode lock.  This implies that
	!all LATCH programs have released their CR mode locks and exited.

	PRINT "%STROBE --   ";RESOURCE;" strobes delivered.  ";TIME_STRING
				!Announce what was done and when.
	%PAGE
	%SBTTL "Cancel the lock"
	!
	! SYS$DEQ system service to explicitly dequeue the lock
	! using value in the lock status block of the $ENQ
	!
	RET_STAT = SYS$DEQ(SBLK::LOCK_ID BY VALUE,,,)
				!Explicitly try to dequeue the lock
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%STROBE --    $DEQ failure"
		PRINT "%STROBE --    RETURN STATUS =";RET_STAT
		!Exiting the image will
		! release the (user mode) lock.
		EXIT_STATUS = 0%	!WARNING
	END IF

	GOTO ALL_DONE

	%PAGE
	%SBTTL "Condition handler."
 CONDITION_HANDLER:
	SELECT ERR
	   CASE 11	!In case user answers with ^Z
		PRINT "%STROBE --   EOF signaled"
		RESUME ALL_DONE
	   CASE ELSE	!All others, complain and bail out.
		PRINT "**ERR =";ERR
		PRINT "**";ERT$(ERR)
		PRINT "**From ";ERN$
		EXIT_STATUS = 4%	!FATAL error
		RESUME ALL_DONE
	END SELECT
 ALL_DONE:
	EXIT PROGRAM EXIT_STATUS	!Tell DCL what happened
	END PROGRAM




	!STROBE.CLD - Command Language Definition for STROBE

DEFINE VERB STROBE

IMAGE "VPRO:STROBE"

	PARAMETER P1, LABEL=RESOURCE, VALUE(REQUIRED),
		  PROMPT="Resource name to strobe? "

	QUALIFIER PREFIX, LABEL = Q1, PLACEMENT=GLOBAL, VALUE
	!Default value will be supplied by program.  Could have been done here

	QUALIFIER SHOW,   LABEL = Q2, PLACEMENT=GLOBAL

	QUALIFIER NOW,    LABEL = Q3, PLACEMENT=GLOBAL, BATCH
	!Note that this qualifier is on by default in BATCH




	!LATCH.BAS -- LATCH on to a lock.  Release when blocking.
	!
	%TITLE "LATCH"
	%IDENT "V 2.10"
	! 2.10	13-JAN-91	Cleaned up and commented for publication
	! 2.00	30-MAY-89	Replace LIB$GET_FOREIGN with CLI$ interface
	! 1.10	11-JUN-85	Added explicit $DEQ
	!
	PRINT "	LATCH V2.10"
	%PAGE
	%SBTTL "RECORD definition"
	!
	!Lock Status Block (lksb) RECORD definition
	!
	RECORD	LKSB
		WORD	L_STATUS
		WORD	FILL
		LONG	LOCK_ID
		BYTE	LVB(15)		!May need redefinition for any
					! given application. Always
					! 16 bytes.
	END RECORD

	%PAGE
	%SBTTL "Constant definitions"
	!Local
	! -none-
	!External

	EXTERNAL LONG CONSTANT		SS$_NORMAL,		&
					LCK$K_CRMODE,		&
					CLI$_PRESENT,		&
					CLI$_ABSENT,		&
					CLI$_NEGATED,		&
					BLK_AST_H	!Address of blocking
							!AST in a module
							!to be LINKed
							!with this program.
	%PAGE
	%SBTTL "Function definitions"
	!Local
	! -none-
	!External
	EXTERNAL LONG	FUNCTION	SYS$ASCTIM,		&
					SYS$DEQ,		&
					SYS$ENQW,		&
					SYS$HIBER,		&
					LIB$SYS_FAO,		&
					CLI$PRESENT,		&
					CLI$GET_VALUE

	%PAGE
	%SBTTL "MAP/COMMON definitions"

	MAP (AST_COMMON)		&
		LONG	EXIT_STATUS

	!This is in a MAP so that it can be shared with the AST routine.
	!Standard (unMAPped) VAX BASIC variables are allocated on the
	!stack and are unavailable to AST routines.

	%PAGE
	%SBTTL "Variable definitions"
	!Local
	DECLARE	LONG						&
			RET_STAT,	!Return status from system services&
			RET_STAT2,	!Return status, the sequel	&
			EV_FL,		!Event flag			&
		STRING	FAO_OUT,	!Output from $FAO		&
			LCK_FAO_CTRL,	!FAO control string		&
			TIME_STRING,				&
			RESOURCE,	!Resource name		&
			PREFIX,		!Prefix from command line	&
					! or default value		&
			TMP_STR,	!Utility string			&
		LKSB	SBLK		!Status block

	!External
	! -none-
	%PAGE
	%SBTTL "Initialization"

	ON ERROR GOTO CONDITION_HANDLER
	!VAX BASIC detected errors, that is

	EV_FL = 4%	!Pick an event flag.  A more complex program would
			!require more care in selecting a value.


	EXIT_STATUS = 1%	!Assume everything will go well.  Problems
				!will change this value so that DCL can
				!do the right thing when we exit.

	TIME_STRING = SPACE$(23%)	!Pre-extend the string
	LCK_FAO_CTRL = "Lock ID = !8XL"
	%PAGE
	%SBTTL "Get information from command line."

	!**************  Resource Name
	RET_STAT = CLI$GET_VALUE("RESOURCE", RESOURCE)
	SELECT RET_STAT
	    CASE CLI$_PRESENT, SS$_NORMAL
		!PRINT " Resource name is '";RESOURCE;"'"     
	    CASE ELSE
		PRINT " Unexpected P1 status =";RET_STAT
	END SELECT

	!************** /[NO]PREFIX=[string]

	RET_STAT = CLI$PRESENT("Q1")
	SELECT RET_STAT
	    CASE CLI$_ABSENT
		!PRINT " Prefix character unspecified."
		PREFIX = "LATCH_WAIT_FOR_"
	    CASE CLI$_NEGATED
		!PRINT " No prefix will be used."
		PREFIX = ""
	    CASE CLI$_PRESENT
		RET_STAT2 = CLI$GET_VALUE("Q1", TMP_STR)
		SELECT RET_STAT2
		    CASE CLI$_PRESENT, SS$_NORMAL
			!PRINT " Prefix will be '";TMP_STR;"'"
			PREFIX = TMP_STR
		    CASE ELSE
			!PRINT " Unexpected Q1 VALUE status =";RET_STAT2
		END SELECT !RET_STAT2
	    CASE ELSE
		PRINT " Unexpected Q1 status =";RET_STAT
	END SELECT !RET_STAT

		!** Needs a check for
		!** resource name length not more than 32.
	RESOURCE = PREFIX + RESOURCE
	PRINT 'LATCH resource name is "';RESOURCE;'"'
	PRINT	!Blank line
	%PAGE
	%SBTTL "Get LATCH lock"
	!
	!SYS$ENQ system service to get CR mode lock
	!	...with a blocking AST declared
	!
	RET_STAT = SYS$ENQW(					&
				EV_FL BY VALUE,		![efn]		&
				LCK$K_CRMODE BY VALUE,	!lkmode		&
				SBLK::L_STATUS,		!lksb		&
				,			![flags]	&
				RESOURCE,		![resnam]	&
				,			![parid]	&
				,			![astpar]	&
				,			![astprm]	&
				BLK_AST_H BY VALUE,	![blkast]	&
				,			![acmode]	&
							!nullarg	&
				)
	! Did the call succeed?                         
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%LATCH --    Lock aquisition CALL failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	! Did the $ENQ succeed
	IF SBLK::L_STATUS <> SS$_NORMAL THEN
		PRINT "%LATCH --    Lock aquisition SERVICE failure"
		PRINT "%LATCH --    LKSB status =";SBLK::L_STATUS
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF

	RET_STAT = SYS$ASCTIM(,TIME_STRING,,)	!Get current time
	IF RET_STAT <> SS$_NORMAL
	THEN
		PRINT "%LATCH --    Pre hibernation $ASCTIM failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		PRINT "%LATCH --    Program continuing.  Time values will be meaningless."
		EXIT_STATUS = 0%	!WARNING
	END IF

	PRINT	!blank line
	!Announce who, what and when.
	PRINT "%LATCH --   Waiting for ";RESOURCE;" to be strobed."
	PRINT HT + TIME_STRING

	RET_STAT = LIB$SYS_FAO(LCK_FAO_CTRL, ,FAO_OUT,SBLK::LOCK_ID BY VALUE)
		!Convert lock ID to hex string
	IF RET_STAT <> SS$_NORMAL
	THEN
		PRINT "%LATCH --    $FAO failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		PRINT "%LATCH --    Program continuing." +	&
		      "No lock ID information will be displayed."
		EXIT_STATUS = 0%	!WARNING
	ELSE
		PRINT FAO_OUT	!Formated information
	END IF

	!
	!Now hibernate ...
	!	Blocking AST will wake us up.
	!
	RET_STAT = SYS$HIBER
	IF RET_STAT <> SS$_NORMAL
	THEN
		PRINT "%LATCH --    $HIBER failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		EXIT_STATUS = 4%	!FATAL error
		GOTO ALL_DONE
	END IF
	!
	!...blocking AST has been delivered.  Release the lock and exit.
	!

	RET_STAT = SYS$ASCTIM(,TIME_STRING,,)	!Get current time
	IF RET_STAT <> SS$_NORMAL
	THEN
		PRINT "%LATCH --    Post lock $ASCTIM failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		PRINT "%LATCH --    Program continuing.  Time values will be meaningless."
		EXIT_STATUS = 0%	!WARNING
	END IF
	!
	!Announce lock release
	!
	PRINT "%LATCH --   ";RESOURCE;" strobed."
	PRINT HT + TIME_STRING
	PRINT
	!
	! SYS$DEQ system service to explicitly dequeue the lock
	! using value in the lock status block of the $ENQ
	!
	RET_STAT = SYS$DEQ(SBLK::LOCK_ID BY VALUE,,,)
				!Explicitly try to dequeue the lock
	IF RET_STAT <> SS$_NORMAL THEN
		PRINT "%LATCH --    $DEQ failure"
		PRINT "%LATCH --    RETURN STATUS =";RET_STAT
		!Exiting the image will
		! release the (user mode) lock.
		EXIT_STATUS = 0%	!WARNING
	END IF
	GOTO ALL_DONE
	%PAGE
	%SBTTL "Condition handler."

 CONDITION_HANDLER:
		!No handleable errors are expected, ergo, complain and exit
		PRINT "**ERR =";ERR
		PRINT "**";ERT$(ERR)
		PRINT "**From ";ERN$
		EXIT_STATUS = 4%	!FATAL
		RESUME ALL_DONE

 ALL_DONE:
	EXIT PROGRAM EXIT_STATUS	!Tell DCL what happened
	END PROGRAM



	!LATCH.CLD - Command Language Definition for LATCH

DEFINE VERB LATCH

IMAGE "VPRO:LATCH"

	PARAMETER P1, LABEL=RESOURCE, VALUE(REQUIRED),
		  PROMPT="Resource name to latch? "

	QUALIFIER PREFIX, LABEL = Q1, PLACEMENT=GLOBAL, VALUE
	!Default is supplied by the program.  Could have been done here.




	!LCK_BAST_HIB.BAS -- LoCK Blocking AST handler.
	!		     It will WAKE a hibernating process
	!		      process.
	!Written as a VAX BASIC subroutine.
	SUB BLK_AST_H (LONG PARAM,PC,PSL,R0,R1)
			!Standard parameter list passed to any AST.
			!PC,PSL,R0 and R1 are not used here.
			!PARAM is used only in case of error.
	%TITLE "Lock blocking AST handler to wake main routine."
	%IDENT "V 1.10"

	EXTERNAL LONG	FUNCTION	SYS$WAKE

	MAP (AST_COMMON)  LONG EXIT_STATUS	!To communicate to the main
						!routine if somethng goes
						!wrong.

	DECLARE	LONG	RET_STAT

	RET_STAT = SYS$WAKE(,)		!Null arguments mean wake
					!this process.
	IF (RET_STAT AND 1%) <> 1% THEN
		PRINT "BAST***WAKE failure."
		PRINT "STATUS =";RET_STAT
		PRINT "AST parameter =";PARAM
		EXIT_STATUS = 4%	!FATAL
	END IF
	!As soon as this AST is dismissed, the main program will resume
	!at the next instruction after the $HIBER call.
	END SUB




	.TITLE LKIDEF
	.IDENT /V1.00/
	;Assembling this code will create an object file with the definitions
	;for the $GETLKI system service.  The object file can then be linked
	;with programs needing these definitions.

	$LKIDEF GLOBAL	;Make them global symbols

	.END



	.TITLE LCKDEF
	.IDENT /V1.00/
	;Assembling this code will create an object file with the definitions
	;for the $ENQ system service.  The object file can then be linked
	;with programs needing these definitions.

	$LCKDEF GLOBAL	;Make them global symbols

	.END



$	!STROBE_LATCH_BUILD.COM - Procedure to build STROBE and LATCH
$	!
$	!
$	WRITE SYS$OUTPUT "Assembling symbol definition files..."
$	MACRO LCKDEF	!Symbols used by $ENQ.  Needed for STROBE and LATCH
$	MACRO LKIDEF	!Symbols for $GETLKI.  Needed by STROBE
$	!
$	WRITE SYS$OUTPUT "Building STROBE..."
$	BASIC/LIST STROBE	!Compile main program
$	LINK/MAP  STROBE,LKIDEF,LCKDEF
$				!Link with symbol definitions
$	!
$	WRITE SYS$OUTPUT "Building LATCH..."
$	BASIC/LIST LCK_BAST_HIB
$				!Compile blocking AST routine
$	BASIC/LIST LATCH	!Compile main program
$	LINK/MAP  LATCH,LCK_BAST_HIB,LCKDEF
$				!Link with AST routine and symbol definitions
$	WRITE SYS$OUTPUT "STROBE and LATCH built..."
$	EXIT



                        STROBE and LATCH "User Guide"
		       ===============================

1.0 INTRODUCTION
    ------------

This document is a supplement to the article titled "LATCH and STROBE: Using
the VAX Distributed Lock Manager to Synchronize Processing Across a VAXcluster
System", published in VAX Professional (February 1991).

2.0 INSTALLATION
    ------------

Copy the files to a directory of your choice.  Edit the *.CLD files to reflect
the device and directory where the *.EXE files are located.

Execute BUILD.COM

You must use the SET COMMAND command before you can use LATCH or STROBE.

3.0 COMMAND DESCRIPTIONS
    --------------------

  STROBE

	This command causes an exclusive mode lock to be requested on
	the resource named in the command.  By default, the resource name
	will be modified by the program.  (See /PREFIX, below.)

	The command will display some information including the count of
	holders of locks on the resource.  This count includes the null
	mode lock held by STROBE at the time the command executes.

	After the information is displayed, you are asked about what STROBE
	should do next.  You have three choices:
		Y - Request the EX mode lock
		N - Display the holder count again
		E - Exit the program without requesting the EX mode lock.
	The prompt can be suppressed by the /NOW or the /SHOW qualifier.

	This command is designed to be used in conjunction with the LATCH
	program.

	Command syntax:

	STROBE resource_name

	Qualifiers:

	/NOW

	This qualifier causes the EX mode lock to be requested as soon as
	the holder information has been displayed.

	This qualifier is in effect by default in batch.

	/PREFIX

	STROBE normally appends the string "LATCH_WAIT_FOR_" to the beginning
	of the resource name.  Using /NOPREFIX will cause the resource name
	specified on the command line to be used unmodified.

	To specify a different prefix use /PREFIX=your_choice

	Keep in mind that the total resource name cannot exceed 32
	characters.  (STROBE does not currently check the length.)

	/SHOW

	This qualifier causes the program to exit after displaying the
	holder count.  There will be no prompt.  The /SHOW qualifier
	overrides the /NOW qualifier.


  LATCH

	This command causes a concurrent mode lock to be requested on
	the resource named in the command.  By default, the resource name
	will be modified by the program.  (See /PREFIX, below.)

	The program then hibernates until an incompatible lock is requested
	for the concurrent read mode lock it holds.

	This command is designed to be used in conjunction with the STROBE
	program.

	Command syntax:

	LATCH resource_name

	Qualifiers:

	/PREFIX

	LATCH normally appends the string "LATCH_WAIT_FOR_" to the beginning
	of the resource name.  Using /NOPREFIX will cause the resource name
	specified on the command line to be used unmodified.

	To specify a different prefix use /PREFIX=your_choice

	Keep in mind that the total resource name cannot exceed 32
	characters.  (LATCH does not currently check the length.)


4.0 PROGRAM DESIGN NOTES
    --------------------

Both STROBE and LATCH print their own error messages.  They should use the
message facility under VMS.  This is left as an exercise for the reader.

Both programs will exit with a warning or fatal error when a problem is
detected.  The severity of the error depends on the problem.  See the source
code for more information.   The DCL symbols $STATUS and $SEVERITY will 
contain this value. The choices were made to make batch operation, for LATCH 
in particular, function properly.  That is, ON...THEN can be used to handle 
errors and cause remedial action to take place instead of blindly moving on to 
the next command.

The /PREFIX behavior suits my purposes.  It can be changed fairly easily in the
program or moved into the .CLD files.

STROBE and LATCH do not take out a system lock (this requires SYSLCK privilege).
This means that they will only be effective within a given UIC group.

For those unfamiliar with VAX BASIC, the RECORD statement describes data
structures.  The RECORD statement does not allocate memory but it provides a
template for subsequent allocation in a DECLARE or MAP statement.

For example,
	RECORD LWW
		LONG VARL1
		WORD VARW1
		WORD VARW2
	END RECORD
does not allocate memory. It is when it is declared that memory is allocated,
as in -

	DECLARE LWW SBLOCK, IBLOCK

In this case each variable is 2 longwords.  RECORD essentially allows you to
design your own data types.


5.0  POSSIBLE VARIATIONS
     -------------------

Have STROBE use LIB$SET_SYMBOL to store the holder count in a DCL symbol.  This
could then be examined later in the command procedure.

Create an /EXPECTED=n qualifier.  STROBE would wait for this many holders
before requesting the exclusive lock.  This should probably be accompanied by an
appropriate timer mechanism to prevent STROBE from waiting too long.

Some applications may find it useful to have LATCH also display the holder
count.  It would be an indication of the sequence in which the locks were 
acquired.

A /SYSLCK qualifier could be created so locks would not be limited to a 
given UIC group.



$	!ST_TEST.COM -	BATCH job to test strobe and latch.  As many of these
$	!		as desired (but that don't exceed JOBLIM) may be
$	!		submitted to batch queues throughout the VAXcluster
$	!		system.
$	!
$	THIS_NODE = F$GETSYI("NODENAME")
$	SHO SYM THIS_NODE
$	TMP = F$GETJPI("","PID")
$	TMP = F$EXTRACT(4,4,TMP)
$	SET PROC/NAME="LATCH ''TMP'"	!Prevents duplicate process names
$	set command vpro:latch
$	latch testing
$	! **This is where something useful would happen.**
$	EXIT