OpenVMS Source Code Demos

demo_lock_dlm_101.bas

1000	%title	"DEMO_LOCK_DLM_101.BAS"
	%ident	"version_101.2"
	!========================================================================================================================
	! Title  : DEMO_LOCK_DLM_xxx.BAS
	! Author : Neil Rieck	(https://neilrieck.net)
	! Created: 00.04.03
	! Purpose: to demonstrate the use of the DISTRIBUTED LOCK MANAGER method to control access to a shared resource
	! Notes  : to see this program in action, run it three or more sessions each one started 2 seconds later in time
	!
	! Ver Who When   What
	! --- --- ------ --------------------------------------------------------------------------------------------------------
	! 100 NSR 000403 1. original work
	!     NSR 050901 2. modified to compile correctly without needing "[.inc]VMS_Externals.inc"
	! 101 NSR 051003 1. changed the $enqw calls to $enq (no wait)
	!		 2. simplified original example but now call $getlki to test the lock status (polling loop)
	!========================================================================================================================
	! calls:	$enq		enqueue		(async)
	!		$enqw		enqueue wait	(sync)
	!		$deq		dequeue
	!		$getlki		get lock info
	!
	! lock modes:	lck$m_nlmode	null
	!		lck$m_crmode	concurrent read		allows shared reading
	!		lck$m_cwmode	concurrent write	allows shared writing
	!		lck$m_prmode	protected read		allows shared read but no writers
	!		lck$m_pwmode	protected write		allows shared read but no other writers (other than self)
	!		lck$m_exmode	exclusive		allows no sharing with others
	!========================================================================================================================
	option type=explicit							! no kid stuff
	!
	%include "starlet"	%from %library "sys$library:basic$starlet"	! system services
        %include "$ssdef"	%from %library "sys$library:basic$starlet"	! ss$
        %include "$lckdef"	%from %library "sys$library:basic$starlet"	! lck$
        %include "$lkidef"	%from %library "sys$library:basic$starlet"	! lki$
	!
	declare long	rc%						,	!						&
		long	loop_counter%		 				!
	!
	!	define stuff to be used during $enq and $deq
	!
	record lock_block_rec				! define a new data structure
		word	lock_condition		,	!						&
			reserved		,	!						&
		long	lock_ident		,	! lock id#					&
		byte	lock_value(16)		 	! (only required with flag: lck$m_valblk)
	end record lock_block_rec		 	!
	declare lock_block_rec lock_block	 	! declare a variable
	!
	!	define stuff to be used in a general purpose item list
	!
        record ItemRec
	    variant
		case
		    group one
			word Buf_Len		! buffer size (in bytes)
			word Code		! desired operation
			long Buf_Addr		! buffer address
			long Rtrn_Len_Addr	! addr of bytes returned
		    end group one
		case
		    group two
			long list_term		! mark end-of-list
		    end group two
	    end variant
        end record
	!
	!	define stuff to be used in testing the status of a queue lock
	!
	record LkiRec				! structure of Lki Record
	    ItemRec ItemVar(9)			! 0 -> 9 items
        end record LkiRec			!
	declare LkiRec	LkiVar			! declare a variable
	!
	!	define stuff to be used in testing the status of a queue lock
	!
	record LockStatusRec			! structure of a lock status record
	    byte	byte0			! LKI$B_STATE_RQMODE
	    byte	byte1			! LKI$B_STATE_GRMODE
	    byte	byte2			! LKI$B_STATE_QUEUE
	end record LockStatusRec		!
	declare LockStatusRec	LockStatus	! declare a variable
	!
	!========================================================================================================================
	!	main
	!========================================================================================================================
	main:
	!
	! SYS$ENQ [efn] ,lkmode ,lksb ,[flags] ,[resnam] ,[parid] ,[astadr] ,[astprm] ,[blkast] ,[acmode] ,[rsdm_id]
	!
	!	<<< request an exclusive lock on a named resource >>>
	!
	print "-i-enq ex"
	rc% = sys$enq(				,! efn:							&
			lck$k_exmode		,! lkmode: exclusive					&
			lock_block		,! lksb:						&
						,! flags:						&
			"NEIL_DEMO_9876"	,! resname: name of the protected resource 		&
			,,,,,,,	)
	print "-e-enq ex rc:",str$(rc%)	if (rc% and 1%) <> 1%
	!
	!	<<< now test our lock status (because we might not have exclusive access) >>>
	!
	loop_counter% = 0							! init counter
	get_lock_status:
	LkiVar::ItemVar(0)::Buf_Len		= 3				! buffer size (in bytes)
	LkiVar::ItemVar(0)::Code		= lki$_state			! desired operation
        LkiVar::ItemVar(0)::Buf_Addr		= loc(LockStatus)		! buffer address
        LkiVar::ItemVar(0)::Rtrn_Len_Addr	= 0				!
        LkiVar::ItemVar(1)::list_term		= 0				! terminate the list
	!
	!	SYS$GETLKI [efn] ,lkidadr ,itmlst [,iosb] [,astadr] [,astprm] [,nullarg]
	!
	rc% = sys$getlki(						&
						,! efn:			&
	    lock_block::lock_ident		,! lkiadr:		&
	    LkiVar::ItemVar(0)::Buf_Len		,! itmlst		&
						,! iosb			&
	    ,,)
	print "-e-getlki rc:",str$(rc%)	if (rc% and 1%) <> 1%
	!
	print "-i-Requested: ";LockStatus::byte0				!
	print "-i-Granted  : ";LockStatus::byte1				!
	print "-i-Queue    : ";LockStatus::byte2				!
	if LockStatus::byte0 <> LockStatus::byte1 then
	    loop_counter% = loop_counter% + 1
	    print "-w- waiting for grant. Count: "+ str$(loop_counter%)
	    sleep 1
	    goto get_lock_status
	end if
	!
	print "-i-starting fake work (15 seconds)"
	sleep 15								! do some work
	print "-i-finished fake work"
	!
	!	remove "our interest" in this resource
	!
	!	SYS$DEQ [lkid] ,[valblk] ,[acmode] ,[flags]
	!
	dequeue:
	print "-i-deq"
	rc% = sys$deq(					&
	    lock_block::lock_ident	,! lkid:	&
					,! valblk:	&
					,! acmode:	&
	    LCK$M_DEQALL		 ! flags:	&
					)
	print "-e-deq rc:",str$(rc%)	if (rc% and 1%) <> 1%
	!
	!	that's all folks
	!
	print "adios..."
	end									!

---

Back to Home
Neil Rieck
Waterloo, Ontario, Canada.