Use the List Object Locks API to determine lock holders.

Here's an issue that seems to come up with some regularity: an application program needs to exclusively allocate an object using the Allocate Object (ALCOBJ) command, and the allocate fails due to some other job (or jobs) holding conflicting locks on the object. Quite often, the application program is not monitoring for this condition (CPF1002 – Cannot allocate object) and blows up. Then the question becomes "What job(s) could be holding the lock(s) and preventing the ALCOBJ command from succeeding?"

Using a command such as Work with Object Locks (WRKOBJLCK), after the ALCOBJ failure was encountered, may or may not help answer this question as the other job(s) may have already released the lock(s)—that is, it was a timing problem. And if the desire is to automate the determination of who was holding the lock(s), the WRKOBJLCK command isn't helpful because it only supports output of display or print. And who wants to build an application program dependency on the layout of a spooled report when trying to automate either recovery or problem determination?

In this article, we'll look at how we can write a program that performs the ALCOBJ function and, in the case of conflicting locks with other jobs, automatically gathers a list of these "other jobs." The program we will look at today uses the List Object Locks (QWCLOBJL) API to accomplish this task and display, using the RPG DSPLY operation code, the first job found that prevented the ALCOBJ request from succeeding. Next month, we will extend this initial program to help automate recovery and/or problem determination when the ALCOBJ request fails.

First, the program we'll be reviewing this month.

h DftActGrp(*no)                                       

d AllocObj        pr                                                   

d  Obj_In                       10a   const                  

d  Lib_In                       10a   const                    

d  ObjTyp_In                    10a   const                     

d  GotAlc_In                      n                        

d AllocObj        pi                              

d  Obj_In                       10a   const             

d  Lib_In                       10a   const                 

d  ObjTyp_In                    10a   const                    

d  GotAlc_In                      n                 

 *********************************************************

d Allocate        pr              n               

d ChkForDDM       pr                             

d CrtUsrSpc       pr                  extpgm('QUSCRTUS')     

d  QualUsrSpcN                  20a   const             

d  XAttr                        10a   const               

d  IntSize                      10i 0 const                

d  IntValue                      1a   const             

d  PubAut                       10a   const                   

d  TxtDesc                      50a   const          

d  ReplaceOpt                   10a   const options(*nopass)   

d  ErrCde                             likeds(QUSEC) options(*nopass)

d  Domain                       10a   const options(*nopass)     

d  TfrSize                      10i 0 const options(*nopass)      

d  OptSpcAlgn                    1a   const options(*nopass)      

d GetLckHldrs     pr                         

d LstObjLcks      pr                  extpgm('QWCLOBJL') 

d  QualSpcName                  20a   const                  

d  Format                        8a   const                  

d  QualObjName                  20a   const         

d  ObjType                      10a   const                

d  MbrName                      10a   const                  

d  ErrCde                             likeds(QUSEC)         

d  Path                          1a   const options(*nopass) 

d  LenPath                      10i 0 const options(*nopass) 

d  ASP                          10a   const options(*nopass)   

d RtvJobI         pr                  extpgm('QUSRJOBI')  

d  RcvVar                        1a   options(*varsize)         

d  LenRcvVar                    10i 0 const                

d  Format                        8a   const             

d  QualJobName                  26a   const                 

d  IntJobID                     16a   const                 

d  ErrCde                             likeds(QUSEC) options(*nopass) 

d  ResetPfrDta                   1a   const options(*nopass) 

d RtvUsrSpcPtr    pr                  extpgm('QUSPTRUS') 

d  QualUsrSpcN                  20a   const              

d  UsrSpcPtr                      *               

d  ErrCde                             likeds(QUSEC) options(*nopass) 

d RunCmd          pr                  extpgm('QCAPCMD')  

d  SrcCmdStr                  4096a   const options(*varsize)    

d  LenSrcStr                    10i 0 const               

d  OptCtlBlk                  4096a   const options(*varsize)    

d  LenCtlBlk                    10i 0 const                   

d  Format                        8a   const                  

d  ChgCmdStr                     1a   options(*varsize)  

d  LenChgStr                    10i 0 const              

d  LenRtnChgStr                 10i 0                      

d  ErrCde                             likeds(QUSEC)        

 *******************************************************************   

d LckSpcPtr       s               *                                     

d LckHdr          ds                  likeds(QUSH0100)                 

d                                     based(LckSpcPtr)                 

d APIHdrPtr       s               *                                    

d APIHdr          ds                  likeds(QWCOBJLH)                 

d                                     based(APIHdrPtr)                  

d JobEntPtr       s               *                                     

d JobEnt          ds                  likeds(QWC0100L)                  

d                                     based(JobEntPtr)                   

d ErrCde          ds                  qualified                         

d  Hdr                                likeds(QUSEC)                     

d  MsgDta                      256a                                     

 *******************************************************************    

d Answer          s              1a                                     

d Cmd             s           4096a   varying                           

d Exit            s               n                                     

d LckSpcName      s             20a   inz('ALLOCOBJ  QTEMP')            

d LenRtnCmd       s             10i 0                                   

d RtnCmd          s              1a                                     

d X               s             10i 0                                   

 ******************************************************************* 

 /copy qsysinc/qrpglesrc,qcapcmd                                     

 /copy qsysinc/qrpglesrc,qusec                                       

 /copy qsysinc/qrpglesrc,qusgen                                      

 /copy qsysinc/qrpglesrc,qusrjobi                                    

 /copy qsysinc/qrpglesrc,qwclobjl                                    

 ******************************************************************* 

 /free                                                               

  // Loop until we get the object allocation                         

  dow (not Allocate());                                              

      if Exit;                                                       

         leave;                                                      

      endif;                                                         

      GetLckHldrs();                                                   

      if Exit;                                                         

         leave;                                                        

      endif;                                                           

  enddo;                                                               

  *inlr = *on;                                                         

  return;                                                              

  // ***************************************************************   

  begsr *inzsr;                                                        

    // Set API QUSEC parameter to send exceptions                      

    QUSBPrv = 0;                                                       

    // Set API ErrCde parameter to not send exceptions                 

    ErrCde.Hdr.QUSBPrv = %size(ErrCde);                                

    // Set QCAPCMD Options Control Block for running CL commands   

    QCAP0100 = *Allx'00';                                           

    QCACmdPT = 0;                                                  

    QCABCSDH = '0';                                                

    QCAPA = '0';                                                   

    QCACmdSS = '0';                                                 

    QCAMK = *blanks;                                               

    QCASIDCS = 0;                                                  

    // Get access to user space for object lock info               

    RtvUsrSpcPtr(LckSpcName :LckSpcPtr :ErrCde);                   

    select;                                                        

       when ErrCde.Hdr.QUSBAvl = 0;                                

            // All is OK                                           

       when ErrCde.Hdr.QUSEI = 'CPF9801';                          

            // UsrSpc not found, so create it                            

            CrtUsrSpc(LckSpcName :'OBJ_LOCKS' :4096                      

                      :x'00' :'*ALL' :'List of lock holders'             

                      :'*YES' :QUSEC :'*DEFAULT' :0 :'1');               

            // Get accessibility to user space                           

            RtvUsrSpcPtr(LckSpcName :LckSpcPtr :QUSEC);                  

       other;                                                            

            // Something seriously wrong, return in same                  

            // manner as with MsgD problem                               

            return;                                                      

    endsl;                                                                

    // Get job information                                               

    RtvJobI(QUSI010000 :%size(QUSI010000) :'JOBI0100' :'*' :' ' :QUSEC); 

    // Set GotAlc_In parameter to lock not obtained                    

    GotAlc_In = *off;                                                  

  endsr;                                                               

 /end-free                                                             

 *******************************************************************   

p Allocate        b                                                    

d Allocate        pi              n                                    

 /free                                                                 

  Cmd = 'AlcObj Obj((' +                                               

        %trimr(Lib_In) + '/' + %trimr(Obj_In) +  ' ' +                 

        %trimr(ObjTyp_In) + ' *EXCL)) Conflict(*RqsRls)';              

  RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)                 

         :'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);               

  select;                                                          

     when ErrCde.Hdr.QUSBAvl = 0;                                  

          // We got the lock so no need to worry about             

          // other jobs having a lock.                             

          GotAlc_In = *on;                                         

          return *on;                                              

     when ErrCde.Hdr.QUSEI = 'CPF1002';                            

          // Return letting caller know that someone has a lock    

          return *off;                                             

     other;                                                         

          // Return letting caller know that we have a problem     

          // beyond being unable to allocate the object.           

          Exit = *on;                                                     

          return *off;                                                     

  endsl;                                                                  

 /end-free                                                                

p Allocate        e                                                       

 *******************************************************************      

p GetLckHldrs     b                                                       

d GetLckHldrs     pi                                                       

d FoundOne        s               n                                       

 /free                                                                     

  // Get list of jobs holding locks                      

  LstObjLcks(LckSpcName :'OBJL0100'                                

            :(Obj_In + Lib_In) :ObjTyp_In :'*NONE' :QUSEC);        

  // Return first lock holder (that is not the current job)                

  if ((LckHdr.QUSIS = 'C') or (LckHdr.QUSIS = 'P'));               

     for X = 1 to LckHdr.QUSNbrLE;                              

         if X = 1;                                               

            JobEntPtr = LckSpcPtr + LckHdr.QUSOLD;              

         else;                                                  

            JobEntPtr += LckHdr.QUSSEE;                         

         endif;                                                 

         if ((JobEnt.QWCJN01 <> QUSJN01) or                     

             (JobEnt.QWCJUN <> QUSUN01) or                       

             (JobEnt.QWCJNbr <> QUSJNbr01));                    

            // Someone other than current job found             

            FoundOne = *on;                                      

            dsply ('Lock held by ' +                            

                   %trimr(JobEnt.QWCJN01) + '/' +               

                   %trimr(JobEnt.QWCJUN) + '/' +                

                   JobEnt.QWCJNbr) ' ' Answer;                  

            Exit = *on;                                          

         endif;                                                 

     endfor;                                                    

     if (not FoundOne);                                         

        // No one found so check if DDMF                        

        if ObjTyp_In = '*FILE';                                  

           ChkForDDM();                                         

        endif;                                                  

     endif;                                                     

  endif;                                                                     

 /end-free                                                                  

p GetLckHldrs     e                                                          

 *******************************************************************         

p ChkForDDM       b                                                          

d ChkForDDM       pi                                                  

 /free                                                                

  // Check API header for extended attribute of the file              

  APIHdrPtr = LckSpcPtr + LckHdr.QUSOHS;                              

  if APIHdr.QWCEObjA = 'DDM';                                         

     Exit = *on;                                                      

  endif;                                                              

 /end-free                                                            

p ChkForDDM       e                                                   

The program is named AllocObj and defines four parameters:

1. Obj_In: A 10-byte alphanumeric parameter specifying the name of the object to lock. This parameter is used as an input to the AllocObj program.
2. Lib_In: A 10-byte alphanumeric parameter specifying the name of the library where the object identified by the Obj_In parameter can be found. The special values *CURLIB and *LIBL can be used. This parameter is used as an input to the AllocObj program.
3. ObjTyp_In: A 10-byte alphanumeric parameter specifying the type of object to be locked. This parameter is used as an input to the AllocObj program.
4. GotAlc_In: A 1-byte indicator parameter specifying whether the allocation of the object identified by Obj_In, Lib_In, and ObjTyp_In was successful. This parameter is used as an output of the AllocObj program, where a value of '1' indicates success, a value of '0' failure. When successful, the allocation is still in effect when AllocObj returns to the application program. The calling application program is responsible for releasing the object allocation, most likely by using the Deallocate Object (DLCOBJ) command, when it's done using the object.

In the *INZSR subroutine of AllocObj the program performs some initial setup. This setup includes the following:

1. Setting the QUSEC instance of the system API error code structure to send escape messages when a called system API encounters a failure. This is used when the program anticipates no problems being encountered in calling the API.
2. Setting the ErrCde instance of the system API error code structure to return failure information (rather than send an escape message) when a called system API encounters a failure. This is used when the program anticipates problems may be encountered in calling the API and AllocObj will attempt to recover from some of these failures.
3. Setting the options control block associated with the Process Commands (QCAPCMD) API to allow the running of CL commands (like ALCOBJ) within the AllocObj program. If you're not familiar with this API, a review of prior "API Corner" articles would be in order.
4. Getting access to the user space ALLOCJOB in QTEMP through the pointer variable LckSpcPtr. If you're not familiar with creating user spaces and establishing addressability through a pointer to a user space. a review of prior "API Corner" articles would be in order.
5. Calling the Retrieve Job Information (QUSRJOBI) API to obtain information related to the job the AllocObj program is currently running in. In the version of AllocObj we're looking at today, we'll be using the current job's qualified name to prevent the displaying of the current job when displaying jobs with locks on the object we're attempting to allocate. This qualified job name information could also be accessed using the RPG program-status data structure (PSDS), but next month we'll be using job information not available in the PSDS, so we'll just get everything we're going to need now by calling the QUSRJOBI API. If you're not familiar with this API, a review of prior "API Corner" articles would be in order.
6. Setting the value of parameter GotAlc_In to *off in order to indicate that the requested allocate has not (yet) been successful

Returning to the mainline of AllocObj, a DOW is run based on the Allocate procedure not returning *on. A return value of *on indicates that the allocation request was successful. The intent of this DOW is to continue trying to allocate the object until AllocObj is either successful or the user tells us to stop trying to get the allocation.

Note that I admit the constant checking for Exit being on within the mainline DOW is a bit "ugly," but I also know that I personally would spend more time trying to figure out what a functionally equivalent "terse" DOW (as shown below) is doing as opposed to a quick glance at the above DOW and knowing immediately what it is doing.

  dow ((not Exit) and (not Allocate()) and (not Exit));

      GetLckHldrs();

  enddo;                                       

The Allocate procedure attempts to get an exclusive allocation on the object identified by Obj_In, Lib_In, and ObjTyp_In. This is done by constructing an appropriate ALCOBJ command and then running the command using the Process Commands API (referred to as RunCmd in AllocObj). Having run the ALCOBJ command, the ErrCde structure is examined.

If ErrCde.Hdr.QUSBAvl is equal to 0, then the ALCOBJ command was successful. In this situation, Allocate() sets parameter GotAlc_In to *on and returns *on to the mainline logic. Our job is done.

If ErrCde.Hdr.QUSBAvl is not equal to 0, then the ALCOBJ command was not successful. In this situation, Allocate() examines ErrCde.Hdr.QUSEI to determine what error was encountered when running the ALCOBJ command. If the exception is CPF1002, then one or more jobs on the system have locks on the object and Allocate() returns *off to the mainline logic. A return value of *off indicates that the mainline DOW should be run. If the exception is anything other than CPF1002, then an unanticipated problem has been encountered. In this case, Allocate() sets variable Exit to *on and again returns *off to the mainline. This non-CPF1002 condition might be due to the object not being found, an invalid ObjTyp_In value being passed to AllocObj, or a myriad of other problems in the call to AllocObj.

Returning to the mainline logic, if Allocate() returned *off the DOW is run; otherwise, AllocObj ends.

Within the DOW, a check is first made for Exit being *on. If *on, then an error was encountered and the DOW is exited using the LEAVE operation code. In this error condition, AllocObj returns to the calling application with parameter GotAlc_In set to *off due to the initialization of GotAlc_In back in the *INZSR subroutine. If Exit is *off, the procedure GetLckHldrs is run.

The GetLckHldrs procedure first calls the List Object Locks API (referred to as LstObjLcks in AllocObj). This API defines nine parameters, though GetLckHldrs()uses only the first six. The six parameters used are these:

1. The qualified name of the user space where the list is to be returned. This is the name of the user space that pointer variable LckSpcPtr was set to address back in the *INZSR subroutine.
2. The format of the list, OBJL0100.
3. The qualified name of the object for which we want a list of lock holders. This is set to the parameter values Obj_In and Lib_In.
4. The type of object identified by the third parameter passed to the API. This is set to the parameter value ObjTyp_In.
5. When a database file is specified by the third parameter passed to the API, this is the name of the member for which we want a list of lock holders. This is set by GetLckHldrs() to the value *NONE, which, in a production environment, may have some additional considerations (and most likely requires another parameter being passed to AllocObj—the member name).
6. The standard API error code structure.

The optional parameters defined by the List Object Locks API, and not used by AllocObj, are these:

1. An IFS path name
2. The length of the IFS path name
3. The qualified name of the Auxiliary Storage Pool (ASP) device where the library containing the object is located

The OBJL0100 format returns the essential information concerning the jobs currently holding locks on the specified object. This information includes the name, user, and number of the job holding the lock; the lock held (*SHRRD, *EXCL, etc.); the lock scope (job, thread, etc.); the thread identifier if a thread-scoped lock is held; and so on. The information used today will be the job name, job user, and job number.

After the list is generated by the List Object Locks API, GetLckHldrs() processes the list entries looking for the first lock holder that is not the current job. This is the part of AllocObj that will be significantly enhanced next month. For now, if another job is found to be holding a lock, then the program simply sets the variable FoundOne to *on, displays the job that was found using the DSPLY operation code, and sets the variable Exit to *on to prevent the mainline DOW from potentially looping forever (as we're currently not doing anything to free the lock(s) held by the other job(s)). Next month, we'll expand this processing to allow the user to review the jobs that are holding locks on the object and, at the user's discretion, free those locks, thereby allowing the mainline DOW to retry the Allocate procedure and this time succeed (or at least get a potentially different set of lock holders to work with).

There are three possible reasons for GetLckHldrs() to exit the 'for X = 1 to LckHdr.QUSNbrLE;' loop:

1. A lock holder other than the current job was found, in which case FoundOne is set to *on.
2. No lock holders were found (that is, LckHdr.QUSNbrLE = 0).
3. The only lock holder found was the current job.

In the case of reason 1, we, for this month, want to simply exit the AllocObj program. For reasons 2 and 3, it would appear that allowing the mainline DOW to rerun the Allocate procedure should allow AllocObj to now successfully allocate the object (as whatever job previously prevented Allocate() from succeeding appears to have released the lock).

There are, however, situations where the ALCOBJ command will return an error indicating that there are conflicting locks on an object while the List Objects Lock API will indicate that there are no locks on an object. In order to avoid the mainline DOW from looping forever between locks being found by ALCOBJ and no locks being found by QWCLOBJL, AllocObj needs to make a few checks prior to returning to the mainline.

One check (that I have to admit I found the hard way rather than being aware of when initially coding AllocObj) is for Distributed Data Management (DDM) files. A review of the documentation for the ALCOBJ command shows that when allocating a DDM file, the allocation request is to the file on the remote system. The QWCLOBJL API, on the other hand, returns the list of jobs holding locks on the local system DDM file. So if AllocObj is running on system A and the remote file we're trying to allocate on system B happens to be in use by jobs on system B, then the ALCOBJ command will fail while the QWCLOBJL lock holder list may show no locks being held. To check for this condition GetLckHldrs() tests for variable FoundOne being *off and parameter ObjTyp_In being *FILE. If so, then a further check is made to determine if the *FILE object being worked with also happens to be a DDM file. This determination is easily done.

When working with List APIs, all that we're usually interested in are the returned list entries. However, List APIs quite often return other information. Most, for instance, return an Input Parameter section documenting what parameters values were in effect when a given list was generated. This can be quite useful when finding a user space, in say QGPL, that contains a list and is five years old, and you're wondering if you can delete it. In addition to this Input Parameter section, the QWCLOBJL API also returns a Header section that includes, among other items, the extended object attribute of the object used when creating the returned list of lock holders.

To access the Header section, we use the Offset to the Header Section (QUSOHS) found in the Generic header of the List API (LckHdr.QUSOHS). To test the extended attribute, we use the field QWCEObjA. This is demonstrated in the ChkForDDM procedure called by GetLckHldrs(). If it's determined that AllocObj is working with a DDM file, then variable Exit is set to *on in order to prevent possible looping within the mainline DOW. An alternative implementation would be to send a message to the user indicating that we're having difficulty with allocating a DDM file that is in use on the remote system.

That completes our review of the AllocObj program. Assuming that you have stored the source in member ALLOCOBJ of source file QRPGLESRC, then you can compile the program using the following command.

CRTBNDRPG PGM(ALLOCOBJ) 

As the AllocObj program returns with the specified object either allocated or not allocated, the easiest way to test the program is to use a front-end CL program such as shown below. The CL program can then conditionally de-allocate the object.

Pgm        Parm(&Obj &Lib &Type)                    

Dcl        Var(&Obj)    Type(*Char) Len(10)                 

Dcl        Var(&Lib)    Type(*Char) Len(10)                 

Dcl        Var(&Type)   Type(*Char) Len(10)                 

Dcl        Var(&Locked) Type(*Lgl)                          

Call       Pgm(AllocObj) Parm(&Obj &Lib &Type &Locked)      

If         Cond(&Locked) Then(Do)                           

           DlcObj Obj((&Lib/&Obj &Type *Excl))               

           SndMsg Msg('ALCOBJ worked') ToUsr(*Requester)    

           EndDo                                            

Else       SndMsg Msg('ALCOBJ failed') ToUsr(*Requester)    

EndPgm                                                      

Assuming that you have stored the source in member ALLOC of source file QCLSRC, then you can compile the program using the following command.

CRTBNDCL PGM(ALLOC)

To test the program, you could use CALLs such as this:

CALL PGM(ALLOC) PARM(TESTFILE MYLIB *FILE)

In testing AllocObj, you might sometimes lock the file in another job (DSPPFM TESTFILE being one convenient method) while at other times not have the file in use by another job.

In this article, we've looked at how to use the List Object Locks API in order to get a list of jobs holding locks on a given object. Though our initial use of this list is limited to finding the first job holding a conflicting lock and then DSPLYing the job's name, next month we'll look at how to take much greater advantage of this list.

As usual, if you have any API questions, send them to me at This email address is being protected from spambots. You need JavaScript enabled to view it..