The VMS SharkOpenVMS Notes: DLM (Distributed Lock Manager)
(a not-so-secret weapon built into OpenVMS)

Document Scope: an application programmer's view of DLM

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 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:

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   (http://www3.sympatico.ca/n.rieck)
        ! 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

  1. The DISTRIBUTED part of the DLM name comes from the fact that the DLM can be made to work across an OpenVMS cluster.
  2. 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.
  3. Many OpenVMS layered products use DLM including RMS (Record Management Services)
  4. 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.
  5. Use the "$MON LOCK" command to view more lock statistics
  6. The original problem described could have been solved several other ways including these two:
    1. create my own queued lock manager with built in cleanup routines etc.
      but why do it when a built in facility (DLM) is already available for every one to use?
    2. create a server process on my system which responds to queued requests from other processes; this server process would be the only one connecting to the remote system
      dropping in a new routine to replace the old one was actually simpler for me. Besides the various programs each had their own command/response logic which would have to be moved into a common server process.

Links


Back to OpenVMS
Back to Home
Neil Rieck
Kitchener - Waterloo - Cambridge, Ontario, Canada.