22
Mon, Apr
1 New Articles

The API Corner: Trying to Allocate an Object?

APIs
Typography
  • Smaller Small Medium Big Bigger
  • Default Helvetica Segoe Georgia Times

Use APIs to determine and resolve current lock holders.

 

Last month, in "Problems Allocating an Object?," we looked at the program AllocObj. With AllocObj, we used the List Object Locks (QWCLOBJL) API to get a list of all jobs holding a lock on a given object and then displayed the name of the first job (that wasn't the current job) in that list. This month's "API Corner" will expand the capabilities of AllocObj. The updated AllocObj will, if run in an interactive job, build a subfile listing those jobs with locks on the object. From this list, the user can decide to contact someone about one or more of these jobs, end one of more of these jobs, and/or cancel the current running of AllocObj. If the current job is not interactive, then (at least for this month) AllocObj will run as it did in last month's article. Next month, we'll look at some of the batch opportunities for enhancements to AllocObj.

Below is the source that we will use for display file AllocObjFM. Assuming this source is stored in member ALLOCOBJFM of source file QDDSSRC, you can create the *DSPF using the command CRTDSPF.

A                                      CA03(03 'Exit')                
A**************************************************************       
A          R RSFL01                    SFL                            
A            H1JOBNAME     28A  H                                     
A            S1OPT          1A  B 13  3VALUES(' ' 'E' 'F')            
A            S1JOBNAME     28A  O 13  6                               
A            S1JOBSTS      20A  O 13 40                               
A**************************************************************       
A          R RCTL01                    SFLCTL(RSFL01)                 
A                                      CF05(05 'Refresh')             
A                                      CF08(08 'End all controlled')  
A                                      CF09(09 'End all immediate')   
A                                      OVERLAY                        
A  32                                  SFLDSP                         
A  33                                  SFLDSPCTL                      
A  30                                  SFLCLR                         
A  32                                  SFLEND(*MORE)                
A                                      SFLSIZ(0009)                 
A                                      SFLPAG(0008)                 
A                                  1  3'ALLOCOBJ '                  
A                                      COLOR(BLU)                   
A                                  1 72DATE                         
A                                      EDTCDE(Y)                    
A                                      COLOR(BLU)                   
A*                                                                  
A                                  2 29'Work with Object Locks'     
A                                      COLOR(WHT)                   
A                                  2 72TIME                         
A                                      COLOR(BLU)                   
A*                                                                  
A                                  4  2'The following jobs +        
A                                      currently hold locks on'     
A            OBJID         32A     4 45                             
A*                                                                    
A                                  5  2'The current job cannot +      
A                                      continue until these +         
A                                      locks are released.'           
A*                                                                    
A                                  6  2'NOTE: Exiting with F3 will +  
A                                      most likely cause the current +
A                                      job to FAIL'                   
A*                                                                    
A                                  8  2'Type options, press +         
A                                      Enter.'                        
A                                      COLOR(BLU)                     
A*                                                                    
A                                 10  2'E=End job controlled'         
A                                      COLOR(BLU)                     
A                                 10 25'F=End job immediate'          
A                                      COLOR(BLU)                     
A*                                                                    
A                                 12  2'Opt'                          
A                                      COLOR(WHT)                     
A                                      DSPATR(UL)                     
A                                 12  6'Job name                    ' 
A                                      COLOR(WHT)                     
A                                      DSPATR(UL)                     
A                                 12 40'Status             '          
A                                      COLOR(WHT)                     
A                                      DSPATR(UL)                     
A****************************************************************     
A          R RCTL01F                                                  
A                                 22  2'F3=Exit'                      
A                                      COLOR(BLU)                     
A                                 22 30'F5=Refresh'                   
A                                      COLOR(BLU)                     
A*                                                                    
A                                 23  2'F8=End unmarked controlled'   
A                                      COLOR(BLU)                     
A                                 23 30'F9=End unmarked immediate'    
A                                      COLOR(BLU)   
                 

For each unique job holding a lock on the object AllocObj is trying to allocate, the user will be presented the name of the job and the status of the job. Currently, the only status shown (other than blanks) is that the job is in the process of ending. For each job in the list, the user can elect to cancel the job in a controlled fashion (option 'E') or immediately (option 'F'). In addition, the user can use:

  • F3 to end the AllocObj program without allocating the object
  • F5 to get a refreshed list of the jobs holding locks on the object
  • F8 to end all jobs in the list (that are not selected with option 'F') using OPTION(*CNTRLD) of the End Job (ENDJOB) command
  • F9 to end all jobs in the list (that are not selected with option 'E') using OPTION(*IMMED) of the End Job (ENDJOB) command

To support this subfile, the updated source for AllocObj is shown below. To compile AllocObj, you can use the command CRTBNDRPG PGM(ALLOCOBJ).


h DftActGrp(*no)                                               
                                                               
fAllocObjFMcf   e             workstn usropn                   
f                                     sfile(RSFL01 :SRRN01)    
                                                               
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 EndCntrld       pr                                           
d  JobName                      28a   const                    
                                                               
d EndImmed        pr                                           
d  JobName                      28a   const                    
                                                               
d EnterKey        pr                                           
                                                               
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 MassEnd         pr                                          
                                                              
d PrcLcksB        pr                                          
                                                              
d PrcLcksI        pr                                          
                                                              
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 SRRN01          s              5s 0                                
                                                                     
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                                                
                                                                    
 /free                                                              
                                                                    
  // Get list of jobs holding locks                                 
                                                            
  LstObjLcks(LckSpcName :'OBJL0100'                         
            :(Obj_In + Lib_In) :ObjTyp_In :'*NONE' :QUSEC); 
                                                            
  if QUSJT02 = 'I';                                         
     // Interactive, use subfile                            
                                                            
     PrcLcksI();                                            
  else;                                                     
     // Batch, use messages (next month)                    
                                                            
     PrcLcksB();                                            
  endif;                                                    
                                                            
 /end-free                                                  
                                                            
p GetLckHldrs     e                                         
                                                                    
 *******************************************************************
                                                                    
p PrcLcksI        b                                                 
d PrcLcksI        pi                                                
                                                                    
d Jobs            s             26    dim(9999)                     
d NbrJobs         s              5i 0                               
                                                                    
 /free                                                              
                                                                    
  SRRN01 = 0;                                                       
  NbrJobs = 0;                                                      
  S1Opt = *blanks;                                                  
                                                                    
  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) and             
             (JobEnt.QWCJUN = QUSUN01) and              
             (JobEnt.QWCJNbr = QUSJNbr01));             
            // Do not count current job                 
                                                        
            iter;                                       
         endif;                                         
                                                        
         if NbrJobs = 0;                                
            NbrJobs = 1;                                
            Jobs(NbrJobs) = (JobEnt.QWCJN01 +           
                             JobEnt.QWCJUN +          
                             JobEnt.QWCJNbr);         
                                                      
            if (not %open(AllocObjFM));               
               open AllocObjFM;                       
                                                      
               ObjID = %trimr(ObjTyp_In) + ' ' +      
                       %trimr(Lib_In) + '/' +         
                       Obj_In;                        
            endif;                                    
                                                      
            *in30 = *on;                              
            write RCtl01;                             
            *in30 = *off;                             
                                                      
            exsr UpdSFL;                              
         else;                                        
            // As one job can have multiple locks,         
            // have we already seen this job?              
                                                           
            if %lookup((JobEnt.QWCJN01 + JobEnt.QWCJUN +   
                        JobEnt.QWCJNbr)                    
                       :Jobs :1 :NbrJobs) = 0;             
                                                           
               NbrJobs += 1;                               
               Jobs(NbrJobs) = (JobEnt.QWCJN01 +           
                                JobEnt.QWCJUN +            
                                JobEnt.QWCJNbr);           
                                                           
               exsr UpdSFL;                                
            else;                                          
               // Previously processed                     
                                                           
               iter;                                       
            endif;                         
         endif;                            
     endfor;                               
                                           
     if SRRN01 > 0;                        
        // Jobs with locks found           
                                           
        *in32 = *on;                       
        *in33 = *on;                       
                                           
        write RCtl01F;                     
        exfmt RCtl01;                      
                                           
        select;                            
           when *in03;                     
                Exit  = *on;               
                                           
           when *in05;                            
                                                  
           when *in08;                            
                MassEnd();                        
                                                  
           when *in09;                            
                MassEnd();                        
                                                  
           other;                                 
                EnterKey();                       
        endsl;                                    
     endif;                                       
                                                  
     if NbrJobs = 0;                              
        // No one found so check if DDMF          
                                                  
        if ObjTyp_In = '*FILE';                   
           ChkForDDM();                                             
        endif;                                                      
     endif;                                                         
  endif;                                                            
                                                                    
  return;                                                           
                                                                    
  // ***************************************************************
                                                                    
  begsr UpdSFL;                                                     
                                                                       
    RtvJobI(QUSI0600 :%size(QUSI0600) :'JOBI0600'                 
            :(JobEnt.QWCJN01 + JobEnt.QWCJUN + JobEnt.QWCJNbr)    
            :' ' :ErrCde);                                        
                                                                  
    select;                                                       
       when ErrCde.Hdr.QUSBAvl > 0;                               
            if ErrCde.Hdr.QUSEI = 'CPF1321';                      
               // Job is gone                                     
                                                                  
               leavesr;                                           
            else;                                                 
               S1JobSts = 'Error ' + ErrCde.Hdr.QUSEI;            
            endif;                                                
                                                                  
       when QUSJS14 = '*OUTQ';                                    
            // Job is effectively gone                            
                                                  
            leavesr;                              
                                                  
       when QUSES00 = '1';                        
            S1JobSts = 'In process of ending';    
                                                  
       other;                                     
            S1JobSts = *blanks;                   
    endsl;                                        
                                                  
    S1JobName = %trimr(JobEnt.QWCJN01) + '/' +                      
                %trimr(JobEnt.QWCJUN) + '/' +                       
                JobEnt.QWCJNbr;                                     
    H1JobName = JobEnt.QWCJNbr + '/' +                              
                %trimr(JobEnt.QWCJUN) + '/' +                       
                %trimr(JobEnt.QWCJN01);                             
                                                                  

    SRRN01 += 1;                                  
    write RSFL01;                                 
                                                  
  endsr;                                          
                                                  
 /end-free                                        
                                                  
p PrcLcksI        e                                                 
                                                                    
 *******************************************************************
                                                                    
p MassEnd         b                                                 
d MassEnd         pi                                                
                                                                    
 /free                                                              
                                                                    
  X = SRRN01;                                                       
                                                                    
  for SRRN01 = 1 to X;                                              
      chain SRRN01 RSFL01;                                          
                                                                    
      select;                                                       
         when S1Opt = *blanks;                                      
              select;                                               
                 when *in08;                      
                      EndCntrld(H1JobName);       
                 when *in09;                      
                      EndImmed(H1JobName);        
              endsl;                              
                                                  
         when S1Opt = 'E';                        
              EndCntrld(H1JobName);               
                                                  
         when S1Opt = 'F';                        
              EndImmed(H1JobName);                
      endsl;                                      
  endfor;                                         
                                                  
 /end-free                                        
                                                  
p MassEnd         e                               
                                                                    
 *******************************************************************
                                                                    
p EnterKey        b                                                 
d EnterKey        pi                                                
                                                                    
 /free                                                              
                                                                    
  readc RSFL01;                                                     
                                                                    
  dow (not %eof(AllocObjFM));                                       
      select;                                                       
         when S1Opt = *blanks;                                      
              // Null entry                                         
                                                                    
         when S1Opt = 'E';                                          
              EndCntrld(H1JobName);                                 
                                                                    
         when S1Opt = 'F';                                          
              EndImmed(H1JobName);                                  
      endsl;                                                        
                                                                    
      readc RSFL01;                                                 
  enddo;                                                            
                                                                    
 /end-free                                                          
                                                                    
p EnterKey        e                                                 
                                                                    
 *******************************************************************
                                                                    
p EndCntrld       b                                                 
d EndCntrld       pi                                                
d  JobName                      28a   const                         
                                                                    
 /free                                                              
                                                                    
  Cmd = 'EndJob Job(' + %trimr(JobName) +                           
        ') Option(*Cntrld)';                                        
                                                                    
  RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)                  
         :'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);                
                                                                    
 /end-free                                                          
                                                                    
p EndCntrld       e                                                 
                                                                    
 *******************************************************************
                                                                    
p EndImmed        b                                                 
d EndImmed        pi                                                
d  JobName                      28a   const                          
                                                                     
 /free                                                               
                                                                     
  Cmd = 'EndJob Job(' + %trimr(JobName) +                            
        ') Option(*Immed)';                                          
                                                                     
  RunCmd(Cmd :%len(Cmd) :QCAP0100 :%size(QCAP0100)                   
         :'CPOP0100' :RtnCmd :0 :LenRtnCmd :ErrCde);                 
                                                                     
 /end-free                                                           
                                                                     
p EndImmed        e                                                  
                                                                     
 ******************************************************************* 
                                                                     
p PrcLcksB        b                                                  
d PrcLcksB        pi                                   
                                                       
d FoundOne        s               n                    
                                                       
 /free                                                 
                                                       
  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 PrcLcksB        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                             

As we've added a subfile capability to AllocObj, using the display file ALLOCOBJFM, one change in the source code is the addition of an F-spec. The F-spec for AllocObjFM indicates that it's an externally described workstation file, that the file is USROPN (as AllocObj might not be running interactively), and that there is one subfile that will be used: RSFL01.

Other changes, prior to getting to the procedures of AllocObj, are the definition of several new procedures. These procedures are:

  • EndCntrld to implement ENDJOB with Option(*Cntrld)
  • EndImmed to implement ENDJOB Option(*Immed)
  • EnterKey to implement subfile option processing when the Enter key is used
  • MassEnd to implement F8 and F9 subfile processing
  • PrcLcksB to implement lock processing when AllocObj is running in batch
  • PrcLcksI to implement lock processing when AllocObj is running interactively

The first procedural change is found in GetLckHldrs(). That is, the *INZSR and mainline of AllocObj have not changed since last month. While GetLckHldrs() continues to generate the list of lock holders, the remainder of last month's processing (determining the first job that has a lock on the object) has now moved to PrcLcksB(), as AllocObj for this month will continue to handle running in batch the same way it did last month.

The update to GetLckHldrs() follows the generation of the list of lock holders. GetLckHldrs() now determines if AllocObj is running in an interactive job or not and, if so, runs the PrcLcksI procedure. You may recall from last month that we used the Retrieve Job Information (QUSRJOBI) API and format JOBI0100 within the *INZSR subroutine to access the qualified name of the current job. At that time, it was mentioned that the API was being used, rather than accessing the qualified job name from the PSDS, as we would have a later need for job-related information that was not available in the PSDS. That time is now. In addition to the job name information used last month, format JOBI0100 also returns the Job Type. Job type can be one of several values, with the value we're interested in being 'I' for interactive. As we're using the IBM-provided QSYSINC definitions for the API format, job type corresponds to variable QUSJT02, so GetLckHldrs() calls procedure PrcLcksI if the job type is interactive; otherwise, PrcLcksB is called. As mentioned earlier, PrcLcksB() is essentially the processing logic we reviewed last month and will not be discussed any further today.

After some initial setup, PrcLcksI() enters a For loop to process all list entries returned by the List Object Locks API. Within this For loop, two initial checks are made. The first is to bypass any entry identifying the current job. The second is to check for multiple entries identifying the same job. Just as the Work with Object Locks (WRKOBJLCK) command will return multiple locks being held by a job as separate entries, so too will the List Object Locks API. As the user of AllocObj really only cares about jobs that hold a lock, not how many locks the job holds, AllocObj uses the Jobs array to detect when a job has been previously processed. The Jobs array is defined with dim(9999) to correspond to the maximum number of entries that can be written to a subfile. If an entry returned by QWCLOBJL passes these two checks, then it is passed to the subroutine UpdSFL.

UpdSFL, prior to writing the entry to the subfile, performs some additional checking and then formats the job name. This additional checking is conducted by calling the Retrieve Job Information (QUSRJOBI) API for the job holding the lock, requesting format JOBI0600. The checks, in this order, are:

  • Has the job left the system (ended with no spooled output) since the List Object Locks API generated the list? If so, then there is no need to include the job in the subfile.
  • Has the job ended with spooled output since the List Object Locks API generated the list? If so, then there is no need to include the job in the subfile.
  • Is the job currently in the process of ending? If so, set the job status to ending so the user can see there's no need to end it again. If not, set the job status to blanks.

The formatting done by UpdSFL is to format:

  • a hidden subfile field, H1JobName, in the manner system commands such as ENDJOB and DSPJOB expect to receive a qualified job name
  • a displayed subfile field, S1JobName, in the manner I personally prefer to see qualified job names

After the For loop has processed all the entries returned by the List Object Locks API, a check is made to see if any entries were actually written to the subfile. If there were (SRRN01 > 0), then the subfile is displayed. If no jobs were found holding locks, then there's no need to display the subfile, and, like last month, a check is made to determine if this might be a DDM file (in which case the absence of locks can be deceiving).

The actual processing of the subfile is straightforward and, when the subfile processing has completed, control returns to the mainline DOW loop, where AllocObj will again call Allocate() to determine if we can now get an exclusive lock on the object (assuming the user did not use F3). Assuming the user has taken options such as ending the jobs currently holding locks, Allocate() may well succeed this time as the Allocate Object (ALCOBJ) command will, by default, wait for the amount of time specified in the active class description (usually a minimum of 30 seconds) while the various ENDJOB commands should complete in 30 seconds or less. If Allocate() is successful, the program ends; otherwise, we try again by calling GetLckHldrs().

Next month, we'll look at some of the options available to us when AllocObj is running in batch.  

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

Bruce Vining

Bruce Vining is president and co-founder of Bruce Vining Services, LLC, a firm providing contract programming and consulting services to the System i community. He began his career in 1979 as an IBM Systems Engineer in St. Louis, Missouri, and then transferred to Rochester, Minnesota, in 1985, where he continues to reside. From 1992 until leaving IBM in 2007, Bruce was a member of the System Design Control Group responsible for OS/400 and i5/OS areas such as System APIs, Globalization, and Software Serviceability. He is also the designer of Control Language for Files (CLF).A frequent speaker and writer, Bruce can be reached at This email address is being protected from spambots. You need JavaScript enabled to view it.. 


MC Press books written by Bruce Vining available now on the MC Press Bookstore.

IBM System i APIs at Work IBM System i APIs at Work
Leverage the power of APIs with this definitive resource.
List Price $89.95

Now On Sale

BLOG COMMENTS POWERED BY DISQUS

LATEST COMMENTS

Support MC Press Online

$0.00 Raised:
$

Book Reviews

Resource Center

  • SB Profound WC 5536 Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application. You can find Part 1 here. In Part 2 of our free Node.js Webinar Series, Brian May teaches you the different tooling options available for writing code, debugging, and using Git for version control. Brian will briefly discuss the different tools available, and demonstrate his preferred setup for Node development on IBM i or any platform. Attend this webinar to learn:

  • SB Profound WP 5539More than ever, there is a demand for IT to deliver innovation. Your IBM i has been an essential part of your business operations for years. However, your organization may struggle to maintain the current system and implement new projects. The thousands of customers we've worked with and surveyed state that expectations regarding the digital footprint and vision of the company are not aligned with the current IT environment.

  • SB HelpSystems ROBOT Generic IBM announced the E1080 servers using the latest Power10 processor in September 2021. The most powerful processor from IBM to date, Power10 is designed to handle the demands of doing business in today’s high-tech atmosphere, including running cloud applications, supporting big data, and managing AI workloads. But what does Power10 mean for your data center? In this recorded webinar, IBMers Dan Sundt and Dylan Boday join IBM Power Champion Tom Huntington for a discussion on why Power10 technology is the right strategic investment if you run IBM i, AIX, or Linux. In this action-packed hour, Tom will share trends from the IBM i and AIX user communities while Dan and Dylan dive into the tech specs for key hardware, including:

  • Magic MarkTRY the one package that solves all your document design and printing challenges on all your platforms. Produce bar code labels, electronic forms, ad hoc reports, and RFID tags – without programming! MarkMagic is the only document design and print solution that combines report writing, WYSIWYG label and forms design, and conditional printing in one integrated product. Make sure your data survives when catastrophe hits. Request your trial now!  Request Now.

  • SB HelpSystems ROBOT GenericForms of ransomware has been around for over 30 years, and with more and more organizations suffering attacks each year, it continues to endure. What has made ransomware such a durable threat and what is the best way to combat it? In order to prevent ransomware, organizations must first understand how it works.

  • SB HelpSystems ROBOT GenericIT security is a top priority for businesses around the world, but most IBM i pros don’t know where to begin—and most cybersecurity experts don’t know IBM i. In this session, Robin Tatam explores the business impact of lax IBM i security, the top vulnerabilities putting IBM i at risk, and the steps you can take to protect your organization. If you’re looking to avoid unexpected downtime or corrupted data, you don’t want to miss this session.

  • SB HelpSystems ROBOT GenericCan you trust all of your users all of the time? A typical end user receives 16 malicious emails each month, but only 17 percent of these phishing campaigns are reported to IT. Once an attack is underway, most organizations won’t discover the breach until six months later. A staggering amount of damage can occur in that time. Despite these risks, 93 percent of organizations are leaving their IBM i systems vulnerable to cybercrime. In this on-demand webinar, IBM i security experts Robin Tatam and Sandi Moore will reveal:

  • FORTRA Disaster protection is vital to every business. Yet, it often consists of patched together procedures that are prone to error. From automatic backups to data encryption to media management, Robot automates the routine (yet often complex) tasks of iSeries backup and recovery, saving you time and money and making the process safer and more reliable. Automate your backups with the Robot Backup and Recovery Solution. Key features include:

  • FORTRAManaging messages on your IBM i can be more than a full-time job if you have to do it manually. Messages need a response and resources must be monitored—often over multiple systems and across platforms. How can you be sure you won’t miss important system events? Automate your message center with the Robot Message Management Solution. Key features include:

  • FORTRAThe thought of printing, distributing, and storing iSeries reports manually may reduce you to tears. Paper and labor costs associated with report generation can spiral out of control. Mountains of paper threaten to swamp your files. Robot automates report bursting, distribution, bundling, and archiving, and offers secure, selective online report viewing. Manage your reports with the Robot Report Management Solution. Key features include:

  • FORTRAFor over 30 years, Robot has been a leader in systems management for IBM i. With batch job creation and scheduling at its core, the Robot Job Scheduling Solution reduces the opportunity for human error and helps you maintain service levels, automating even the biggest, most complex runbooks. Manage your job schedule with the Robot Job Scheduling Solution. Key features include:

  • LANSA Business users want new applications now. Market and regulatory pressures require faster application updates and delivery into production. Your IBM i developers may be approaching retirement, and you see no sure way to fill their positions with experienced developers. In addition, you may be caught between maintaining your existing applications and the uncertainty of moving to something new.

  • LANSAWhen it comes to creating your business applications, there are hundreds of coding platforms and programming languages to choose from. These options range from very complex traditional programming languages to Low-Code platforms where sometimes no traditional coding experience is needed. Download our whitepaper, The Power of Writing Code in a Low-Code Solution, and:

  • LANSASupply Chain is becoming increasingly complex and unpredictable. From raw materials for manufacturing to food supply chains, the journey from source to production to delivery to consumers is marred with inefficiencies, manual processes, shortages, recalls, counterfeits, and scandals. In this webinar, we discuss how:

  • The MC Resource Centers bring you the widest selection of white papers, trial software, and on-demand webcasts for you to choose from. >> Review the list of White Papers, Trial Software or On-Demand Webcast at the MC Press Resource Center. >> Add the items to yru Cart and complet he checkout process and submit

  • Profound Logic Have you been wondering about Node.js? Our free Node.js Webinar Series takes you from total beginner to creating a fully-functional IBM i Node.js business application.

  • SB Profound WC 5536Join us for this hour-long webcast that will explore:

  • Fortra IT managers hoping to find new IBM i talent are discovering that the pool of experienced RPG programmers and operators or administrators with intimate knowledge of the operating system and the applications that run on it is small. This begs the question: How will you manage the platform that supports such a big part of your business? This guide offers strategies and software suggestions to help you plan IT staffing and resources and smooth the transition after your AS/400 talent retires. Read on to learn: