Return to the RPG Tips
Retrieving Record Lock Information in RPG IV
Q. How can I get information about an I/O error caused when my RPG IV program times out while waiting for a record lock?
A. When an RPG IV I/O operation that requires a record lock can't get
the requested lock within the physical file's WaitRcd time interval,
the I/O operation returns an error. The file status is set to 1218
when the conflicting lock is held by a different job or to 1299 when
the conflicting lock is held by the same job. You can get some basic
information on a record lock by examining the exception data subfield
(bytes 91 to 170) in the Program Status Data Structure (PSDS). For
example, with file status 1218, this subfield contains the first-level
message text for CPF5027:
Record 1 in use by job 029611/QPGMR/QPADEV0004.
You can parse this subfield to get the relative record number (RRN)
and the identification of a job holding a conflicting record lock. To
get more information about the record lock, you can retrieve the
CPF5027 (different job holds lock) or CPF5032 (same job holds lock)
message data using a CL program, such as the one below.
/* Program: RtvLckMsg */
Pgm Parm( &Lib +
&File +
&Mbr +
&Rrn +
&QualJob +
&SameJob +
&Deadlock )
Dcl &Lib *Char ( 10 )
Dcl &File *Char ( 10 ) /* Physical file name */
Dcl &Mbr *Char ( 10 )
Dcl &Rrn *Dec ( 11 0 ) /* 0 ==> No info returned */
Dcl &QualJob *Char ( 28 )
Dcl &SameJob *Char ( 1 ) /* '1' ==> Same Job */
Dcl &Deadlock *Char ( 1 ) /* '1' ==> Deadlock */
Dcl &MsgDtaMinL *Dec ( 3 0 ) Value( 110 )
Dcl &FileBgn *Dec ( 3 0 ) Value( 11 )
Dcl &LibBgn *Dec ( 3 0 ) Value( 21 )
Dcl &MbrBgn *Dec ( 3 0 ) Value( 31 )
Dcl &RrnBgn *Dec ( 3 0 ) Value( 65 )
Dcl &QualJobBgn *Dec ( 3 0 ) Value( 81 )
Dcl &ErrCdeBgn *Dec ( 3 0 ) Value( 109 )
Dcl &LibLen *Dec ( 3 0 ) Value( 10 )
Dcl &FileLen *Dec ( 3 0 ) Value( 10 )
Dcl &MbrLen *Dec ( 3 0 ) Value( 10 )
Dcl &RrnLen *Dec ( 3 0 ) Value( 4 )
Dcl &QualJobLen *Dec ( 3 0 ) Value( 28 )
Dcl &ErrCdeLen *Dec ( 3 0 ) Value( 2 )
Dcl &Blank *Char ( 1 ) Value( ' ' )
Dcl &True *Char ( 1 ) Value( '1' )
Dcl &False *Char ( 1 ) Value( '0' )
Dcl &MsgIdLckOt *Char ( 7 ) Value( 'CPF5027' ) /* Other job */
Dcl &MsgIdLckSm *Char ( 7 ) Value( 'CPF5032' ) /* Same job */
Dcl &ErrCdeDdLk *Dec ( 5 0 ) Value( 1 )
Dcl &MsgId *Char ( 7 )
Dcl &MsgDta *Char ( 110 )
Dcl &MsgDtaLen *Dec ( 5 0 )
Dcl &ErrCdeChr *Char ( 2 )
Dcl &ErrCde *Dec ( 5 0 )
Dcl &RrnChr *Char ( 4 )
Dcl &JobName *Char ( 10 )
Dcl &JobUser *Char ( 10 )
Dcl &JobNbr *Char ( 6 )
MonMsg Cpf9899 Exec( Return )
/* Initialize with values to be returned if no record lock msg */
ChgVar &Lib &Blank
ChgVar &File &Blank
ChgVar &Mbr &Blank
ChgVar &Rrn 0
ChgVar &QualJob &Blank
ChgVar &SameJob &False
ChgVar &Deadlock &False
RcvMsg PgmQ( *Prv ) +
MsgType( *Excp ) +
Rmv( *No ) +
MsgDta( &MsgDta ) +
MsgDtaLen( &MsgDtaLen ) +
MsgId( &MsgId )
If ( &MsgDtaLen < &MsgDtaMinL ) Do
Return
EndDo
If ( ( &MsgId *NE &MsgIdLckOt ) *And +
( &MsgId *NE &MsgIdLckSm ) ) Do
Return
EndDo
ChgVar &Lib %Sst( &MsgDta &LibBgn &LibLen )
ChgVar &File %Sst( &MsgDta &FileBgn &FileLen )
ChgVar &Mbr %Sst( &MsgDta &MbrBgn &MbrLen )
ChgVar &RrnChr %Sst( &MsgDta &RrnBgn &RrnLen )
ChgVar &ErrCdeChr %Sst( &MsgDta &ErrCdeBgn &ErrCdeLen )
ChgVar &Rrn %Bin( &RrnChr )
ChgVar &ErrCde %Bin( &ErrCdeChr )
If ( &MsgId = &MsgIdLckOt ) Do
ChgVar &QualJob %Sst( &MsgDta &QualJobBgn &QualJobLen )
If ( &ErrCde = &ErrCdeDdLk ) Do
ChgVar &Deadlock &True
EndDo
EndDo
If ( &MsgId = &MsgIdLckSm ) Do
RtvJobA Job( &JobName ) +
User( &JobUser ) +
Nbr( &JobNbr )
/* Trailing blanks aren't stripped from Job User */
ChgVar &QualJob ( &JobNbr *Cat '/' *Cat +
&JobUser *Cat '/' *Cat +
&JobName )
ChgVar &SameJob &True
EndDo
Return
EndPgm
This program sets the "deadlock" flag to true ('1') when another job
holds the record lock and is waiting for a lock on a different record
that the current job has locked.
The following RPG IV program shows the essential code to monitor for I/O errors using the %Status BIF. For file status 1218 or 1299, this program calls the RtvLckMsg CL program, which is listed above.
FTable1 UF E K DISK InfDs( T1InfDs )
F UsrOpn
* File information data structure
D T1InfDs DS
D T1FileName *File
D T1Opcode *Opcode
* Mnemonics
D False C Const( '0' )
D FStsOK C Const( 0 )
D FStsNoKey C Const( 12 )
D FStsRcdLckOth C Const( 1218 )
D FStsRcdLckSame C Const( 1299 )
* Program work variables
D SlcColKey S Like( ColPK )
D Msg S 52A
* Arguments passed to RtvLckMsg program
D LckLib S 10A
D LckFile S 10A
D LckMbr S 10A
D LckRrn S 11P 0
D LckQualJob S 28A
D LckSameJob S 1A
D LckDeadlock S 1A
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C Open (E) Table1
C Eval SlcColKey = 1
C SlcColKey Chain (E) Table1
C Select
C When %Status( Table1 ) = FStsOK
C ExSr ProcessRcd
C When %Status( Table1 ) = FStsNoKey
C ExSr NoRcdFnd
C Other
C ExSr IOErr
C EndSl
C Close (E) Table1
C Return
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C ProcessRcd BegSr
C EndSr
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C NoRcdFnd BegSr
C EndSr
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C IOErr BegSr
C Eval Msg = 'I/O error: '
C + %Char( %Status( Table1 ) )
C + ' on '
C + %Trim( T1Opcode )
C + ' for '
C + %Trim( T1FileName )
C + ' file.'
C Msg Dsply (E)
C If %Status( Table1 ) = FStsRcdLckOth Or
C %Status( Table1 ) = FStsRcdLckSame
C ExSr RtvLckMsg
C If LckRrn > 0
C Eval Msg = 'Lock on '
C + %Trim( LckLib )
C + '/'
C + %Trim( LckFile )
C + '('
C + %Trim( LckMbr )
C + '), RRN = '
C + %Char( LckRrn )
C + ','
C Msg Dsply(E)
C If LckSameJob = False
C Eval Msg = 'by '
C + %Trim( LckQualJob )
C + ', Deadlock = '
C + LckDeadlock
C + '.'
C Msg Dsply(E)
C EndIf
C EndIf
C EndIf
C EndSr
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C RtvLckMsg BegSr
C Call 'RTVLCKMSG'
C Parm LckLib
C Parm LckFile
C Parm LckMbr
C Parm LckRrn
C Parm LckQualJob
C Parm LckSameJob
C Parm LckDeadlock
C EndSr
* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Here's an example of the output from this program:
DSPLY I/O error: 1218 on CHAINF for TABLE1 file.
DSPLY Lock on APPDTA/TABLE1(TABLE1), RRN = 1,
DSPLY by 029611/QPGMR/QPADEV0004, Deadlock = 0.
[report a broken link by clicking here]