OpenVMS Notes: DLM (Distributed Lock Manager)
A not-so-secret weapon built into OpenVMS
Spin Locking (on a file)
I was recently working on an OpenVMS system comprised of a number of processes (5 detached; 0 - 5 user) which "occasionally" needed to obtain exclusive access to a resource on a remote Solaris system. The OpenVMS system had run well for about 5 years with the work load steadily increasing but users were now starting to complain about "long delays" and occasional "timeouts".
The author of the application had decided to control access to the Solaris box by requiring each processes to gain exclusive "write access" to an empty file sitting in a common directory.
- if the exclusive access was granted
then the requesting process would connect to the remote system
- if the exclusive access was not granted
then the requesting process would sleep for one second and then try again (a process was not allowed to loop like this for more than 60 seconds).
If you think about it, there could be "many" other processes looping (spinning) on this file waiting for access. The next process to get access would be determined by random chance rather than order. In a way it is like throwing a single piece of meat to a pack of wild dogs; total anarchy.
File Spin Locking Example Stub (limited use)
lock_filename$ = "my$dir:yada_lock.lck" wait_for_lock% = 0% wait_loop: ! ! Create/Access a file for exclusive access (to lock out other processes) ! when error in open lock_filename$ as file #6 & ,access modify & ,allow none & ,organization sequential error_handler% = 0 ! all is well use ! error_handler% = err ! oops end when ! ! select error_handler% ! case 0 ! lock acquired case 138 ! file lock wait_for_lock% = wait_for_lock% + 1% ! print "-i-Waited for "+ str$(wait_for_lock%) + " loops" ! if wait_for_lock% > 30 then ! print "-w-Unable to set lock. Please try later. Press Enter to Exit "; input junk$ ! goto rc_exit ! end if ! print "-i-Waiting 2 secs for Lock file to be unlocked" ! sleep 2 ! goto wait_loop ! case 160, 228 ! File Attrib, Rec Attrib wait_for_lock% = wait_for_lock% + 1% ! print "-i-Waited for "+ str$(wait_for_lock%) + " loops" ! if wait_for_lock% > 30 then ! print "-w-Unable to set lock. Please try later. Press Enter to Exit "; input junk$ ! goto rc_exit ! end if ! print "-i-Waiting 2 secs for Lock file to be unlocked" ! sleep 2 ! when error in ! kill lock_filename$ ! use ! end when ! goto wait_loop ! case else ! print "-e-Status: "+ str$(error_handler%) +" while opening file: "+ lock_filename$ print "-w-Unable to set lock. Please try later. Press Enter to Exit "; input junk$ ! goto rc_exit ! end select ! print "-i-Lock acquired" !
Queuing via DLM
Most I/O operations in OpenVMS are queued and the DLM (Distributed Lock Manager) is no exception. Rather than just trying to grab control of a resource willy-nilly as described above, a requesting process must now register it's "intention to access the shared resource" by placing a request in a FIFO managed by the DLM. This is operation is called ENQueing and here are just a few examples:
- if the exclusive request succeeded immediately:
- the requesting process would access the shared resource knowing no one else would interfere
- next the requesting process would remove the exclusive lock by doing one of the following:
- delete it's interest in the shared resource from the DLM. (this is called DEQueing)
- convert the exclusive lock into something else including a null lock
- if the exclusive (synchronous) request did not succeed immediately:
- the requesting process would wait forever until exclusive access was granted
- the requesting process would wait forever until exclusive access was granted
- if the exclusive (asynchronous) request did not succeed immediately
- then the requesting process now has several options:
- sleep for one second and then query the DLM to see if exclusive access has been granted (a process should not be allowed to loop forever)
- arm a timer for a predetermined period of time (like 60 seconds) then hibernate until one of two event flags (timer or queue) is raised.
- give up
- then the requesting process now has several options:
Since the DLM will grant access on a "first come - first served" basis, we have now moved from the uncivilized pack-of-dogs concept to a civilized grocery store checkout concept.
Queuing via DLM Demo (2 of 3)
1000 %title "DEMO_LOCK_DLM_xxx.BAS"
%ident "version_103.2" !
declare string constant k_version = "103.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)
! 102 NSR 051006 1. modified for use with event flags (see lexical: %method)
! NSR 051008 2. minor tweak in lexical logic
! 103 NSR 051114 1. added support for a system-wide lock (user will require VMS priv: SYSLCK) bf_103.1
! 2. added code to view OpenVMS error text bf_103.2
!========================================================================================================================
! 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
declare string constant k_program = "DEMO_LOCK_DLM"
!
%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$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
!
external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR
external string function wcsm_dt_stamp ! returns time in this format: ccyymmddhhmmss
!
map (ErrorMsg) string vms_error_msg_buf = 256 ! for VMS error text
declare word vms_error_msg_len
!
declare long rc% ,! &
debug% ,! &
loop_counter% ,! &
dlm_event_flag% ,! dlm event flag &
timer_event_flag% ,! timer event flag &
dlm_ef_state% ,! &
timer_ef_state% ,! &
mask% ,! &
junk% ,! &
basic$quadword deltaQuad ,! &
string junk$ !
!
! 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
!
%let %method=1% ! 1=event flag method, 0=poll method
%if %method=0% %then ! poll method -------------------------------------
!
! 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
%end %if ! -------------------------------------------------
!
!========================================================================================================================
! main
!========================================================================================================================
main:
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) ! what will the opimtizer do with this?
debug% = 1 ! this should be set by logical name translation
%if %method=0% %then ! poll method -------------------------------------
print "-i-method = POLL"
%else
print "-i-method = EVENT FLAG"
%end %if
!
! allocate some event flags if not already done
! (this logic makes more sense in a loop or subroutine)
!
if dlm_event_flag% = 0 then ! if flag not yet allocated
rc% = lib$get_EF( dlm_event_flag% ) ! get an event flag
print "-e- lib$get-EF-dlm rc: "+str$(rc%) if ((rc% and 7%) <> 1)
end if
!
if timer_event_flag% = 0 then ! if flag not yet allocated
rc% = lib$get_EF( timer_event_flag% ) ! get an event flag
print "-e- lib$get-EF-timer rc: "+str$(rc%) if ((rc% and 7%) <> 1)
end if
!
! <<< request an exclusive lock on a named resource >>>
!
! SYS$ENQ [efn] ,lkmode ,lksb ,[flags] ,[resnam] ,[parid] ,[astadr] ,[astprm] ,[blkast] ,[acmode] ,[rsdm_id]
!
print "-i-enq ex"
rc% = sys$enq( dlm_event_flag% ,! efn: &
lck$k_exmode ,! lkmode: exclusive &
lock_block ,! lksb: &
lck$m_system ,! flags : system-wide lock bf_103.1 &
"NEIL_DEMO_9876" ,! resname: name of the protected resource &
,,,,,,, )
!
if (rc% and 7%) <> 1% then ! if not success
print "-e-enq ex rc: "+ str$(rc%) !
junk% = sys$getmsg(rc%, vms_error_msg_len, vms_error_msg_buf, 15%,) ! bf_103.2
if ((junk% and 7%) = 1) then !
print left$(vms_error_msg_buf, vms_error_msg_len) ! display possible priv problem
end if !
goto cleanup !
end if !
!
!
%if %method=0% %then ! poll method -------------------------------------
!
! <<< 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 7%) <> 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
%else ! event flag method -------------------------------
!
! <<< wait here until we get exclusive access via DLM (or we time out)
!
! <<< arm a timer to expire 1 minute from now >>>
!
declare string constant k_delay1000 = "0 00:01:00" ! delay time 1 minute from now
rc% = sys$bintim(k_delay1000, DeltaQuad ) ! init delta time ('x' time from now)
print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 7%) <> 1%) !
!
rc% = sys$setimr(timer_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up
print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 7%) <> 1%) !
!
! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
! The first parameter (on of the flags) is only used to determine which event flag cluster to test.
! The second parameter (mask) contains bits representing event flags within that cluster
!
mask% = get_timer_bit_vector( dlm_event_flag%) ! insert vector 1 into mask
mask% = mask% or get_timer_bit_vector(timer_event_flag%) ! insert vector 2 into mask
!
! <<< wait for either the 'DLM event flag' or the 'TIMER event flag' to change state >>>
!
print "-i-waiting for flag ";dlm_event_flag%;" or flag ";timer_event_flag%
junk$ = wcsm_dt_stamp ! get snap shot of current time
print "-i-sleep begin: ";left$(junk$,8)+"."+right$(junk$,9) !
rc% = sys$wflor( dlm_event_flag%, mask%) ! wait for a response from one of the event flags
print "-e- sys$waitfr rc: "+ str$(rc%) if ((rc% and 7%) <> 1%) !
junk$ = wcsm_dt_stamp ! get snap shot of current time
print "-i-sleep end: ";left$(junk$,8)+"."+right$(junk$,9) !
!
! <<< cancel all timer requests (if any) >>>
!
print "-i-Calling $CanTim" !
rc% = sys$cantim(,) ! cancel all timer requests
print "-e- sys$cantim rc: "+ str$(rc%) if ((rc% and 7%) <> 1%) !
!
! which event flag is set? DLM or TIMER?
!
rc% = sys$readEF(dlm_event_flag%, junk%) ! test DLM event flag
select rc%
case SS$_WASCLR
dlm_ef_state% = 0
case SS$_WASSET
dlm_ef_state% = 1
case else
print "-e- sys$readef-dlm rc: "+ str$(rc%)
end select
print "-i-DLM-EF-State:";str$(dlm_ef_state%) if debug% >= 1% !
!
rc% = sys$readEF(timer_event_flag%, junk%) ! test TIMER event flag
select rc%
case SS$_WASCLR
timer_ef_state% = 0
case SS$_WASSET
timer_ef_state% = 1
case else
print "-e- sys$readef-timer rc: "+ str$(rc%)
end select
print "-i-Timer-EF-State:";str$(timer_ef_state%) if debug% >= 1% !
!
! at this point either the DLM-EF is set
! or the TIMER-EF is set
! or BOTH are set
!
if ( dlm_ef_state% = 0) ! if the DLM-EF didn't get set
then ! oops
print "-e- Error, an exclusive lock on the resource was not received within 60 seconds"
goto dequeue !
end if
%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 7%) <> 1%
!
!========================================================================================================================
! cleanup
! since we might want to pass rc% back to the END statement, don't use rc% here
!========================================================================================================================
cleanup:
if dlm_event_flag% <> 0 then ! if dlm EF is allocated...
junk% = lib$free_EF( dlm_event_flag% ) ! then free it
print "-e- lib$free-EF-dlm rc: "+str$(junk%) if ((junk% and 7%) <> 1)
end if !
if timer_event_flag% <> 0 then ! if timer EF is allocated...
junk% = lib$free_EF( timer_event_flag% ) ! then free it
print "-e- lib$free-EF-timer rc: "+str$(junk%) if ((junk% and 7%) <> 1)
end if !
!
! that's all folks
!
30000 print "adios..."
!~~~ end rc% x pass rc% back to DCL
end ! <<<---***
!########################################################################################################################
!
! external functions
!
!========================================================================================================================
! get timer bit vector
! (see OpenVMS system systevices documentation for "sys$wflor")
!
! notes: cluster event flags
! 0 00- 31
! 1 32- 63
! 2 64- 95
! 3 96-127
!========================================================================================================================
32010 function long get_timer_bit_vector(long event_flag)
option type = explicit
declare long temp
!
select event_flag
case <= 31
temp = event_flag
case <= 63
temp = event_flag - 32
case <= 95
temp = event_flag - 64
case else
temp = event_flag -96
end select
!
select temp ! this code will avoid an integer overflow
case 31 ! need to set bit #31
! 33222222222211111111110000000000
! 10987654321098765432109876543210
get_timer_bit_vector = B"10000000000000000000000000000000"L ! so return this
case else !
get_timer_bit_vector = (2% ^ temp) ! else return this
end select
!
end function ! get_timer_bit_vector
!
!========================================================================================================================
!
32020 function string Wcsm_DT_Stamp
!===================================================================================================================
! Title : Wcsm_DT_Stamp.inc
! Author : Neil S. Rieck
! Purpose: an external function to return a y2k compliant system time in the form ccyymmddhhmmss (14 chars)
! Notes : all our programs call this function so optimizations here will speed up the whole system
! History: deleted
!===================================================================================================================
option type=explicit ! cuz tricks are for kids...
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
!
declare long sys_status
!
! this map is required for the call to sys$asctim (format: 19-JUN-1998 23:59:59.1)
!
map (WcsmDTStamp0) string Sys_buf_22 = 22
map (WcsmDTStamp0) string Sys_day = 2, ! &
Sys_dash1 = 1, !- &
Sys_month = 3, ! &
Sys_dash2 = 1, !- &
Sys_year = 4, ! &
Sys_space = 1, ! &
Sys_Hour = 2, ! &
Sys_colon1 = 1, !: &
Sys_Minute = 2, ! &
Sys_colon2 = 1, !: &
Sys_Second = 2, ! &
Sys_period = 1, !. &
Sys_Tenth = 1 !
!
! map for Wcsm date (output)
!
map (WcsmDTStamp1) string Wcsm_buf_14 = 14 !
map (WcsmDTStamp1) string Wcsm_year = 4, ! &
Wcsm_month = 2, ! &
Wcsm_day = 2, ! &
Wcsm_Hour = 2, ! &
Wcsm_Minute = 2, ! &
Wcsm_Second = 2
map (WcsmDTStamp1) string Wcsm_year = 4, ! &
Wcsm_month_tens = 1, ! &
Wcsm_month_ones = 1, ! &
Wcsm_day_tens = 1, ! &
Wcsm_day_ones = 1, ! &
Wcsm_Hour = 2, ! &
Wcsm_Minute = 2, ! &
Wcsm_Second = 2
!
! string constants
! 00000000011111111112222222222333333333
! 12345678901234567890123456789012345678
declare string constant k_month_names$ = "XXJANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"
! ||
! ++-- so I don't have to provide an offset in pos()
declare string constant my_space = '32'C
!
! <<< function 'code' starts here >>>
!
when error in
!
sys_status = sys$asctim(,Sys_buf_22,,) ! get ASCII time into sys_buf_22
!~~~ if (sys_status and 7%) <> 1% then cause error 11 x not required - call will never fail
!
! transfer data from one map to the other
!
Wcsm_year = Sys_year !
!~~~ rset Wcsm_month = str$( pos(k_month_names$,Sys_Month,1%) / 3%) x bf_100f
Wcsm_day = Sys_day !
Wcsm_hour = Sys_hour !
Wcsm_minute = Sys_minute !
Wcsm_second = Sys_second !
!
declare long temp% ! bf_100f
temp% = pos(k_month_names$,Sys_Month,1%) / 3% ! compute month number bf_100f
if temp% < 10% then ! if less than 10... bf_100f
Wcsm_month_ones = str$(temp%) ! ...then this goes into ONES bf_100f
Wcsm_month_tens = "0" ! ...and this goes into TENS bf_100f
else ! else >= 10 bf_100f
Wcsm_month = str$(temp%) ! bf_100f
end if
!
! make sure there are no spaces in the TENS area of our mapped variables (pad with '0' if necessary)
!
!~~~ Wcsm_month_tens = "0" if Wcsm_month_tens = my_space x disabled - see above code bf_100f
Wcsm_day_tens = "0" if Wcsm_day_tens = my_space !
!
! now pass result back to caller
!
Wcsm_DT_Stamp = Wcsm_Buf_14 ! this is it folks
use
Wcsm_DT_Stamp = "" ! error so return blank
end when
!
END Function
! !
Miscellaneous Information
- The DISTRIBUTED part of the DLM name comes from the fact that the DLM can be made to work across an OpenVMS cluster.
- Whenever an OpenVMS processes is terminated for any reason, a built in system task called "Run Down" is invoked to flush buffers, close files, and release allocated devices including memory. It will also DEQueue any lock entries in the DLM so other processes aren't forever blocked from these resources.
- Many OpenVMS layered products use DLM including RMS (Record Management Services)
- Even if you are not using your OpenVMS system in a cluster, the "$MON CLU" command can be used to view a graphical representation of the DLM in action. The "LOCK" display is on the lower right.
- Use the "$MON LOCK" command to view more lock statistics
Links
- download a zip file containing four lock-manager demo programs written in HP BASIC for OpenVMS (totally free)
- download other OpenVMS demo programs (totally free)
- HP OpenVMS systems documentation
- HP OpenVMS System Services Reference Manual (then search for one of: "SYS$ENQ", "SYS$DEQ", "SYS$GETLKI")
- OpenVMS Programming Concepts Manual (then go to chapter 7)
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.