Using Queue Objects on i5/OS

Version:: 0.1

Date:: 2009-06-20

Author:: Junlei Li

Queue object is a native IPC method on i5/OS. Among all IPC methods available on i5/OS, queue object is the most often used, easy to use, and flexible one. Here we make an introduction to the most important attributes of queue objects and various operations on queue objects. Also, several interesting and useful demo applications are provided here:

Joblog Saver Program
A batch program which saves newly generated spooled files on output queue QEZJOBLOG to a physical file, and then deletes the spooled file. See 6.2. Data Queue Support on Output Queues 及 Appendix 5 A Joblog Saver Program.
6.3. Implement Priority-based IPC by Keyed Queue Objects
ISQL/RUNSQL
CL commands to run SQL statements interatively or in a CL program or a REXX script. Command RUNSQL returns the SQL code of the SQL statement being executed, by which a CL program or a REXX script can determine the following proram logic such as commit or rollback. See 6.4. Simulate Synchronous Calls by i5/OS Queue Objects.
ISQL2/RUNSQL2
An enhanced version of ISQL/RUNSQL, which eliminates the limitation on the length of the SQL statement. See 6.5. Pass Variable Length Data through i5/OS Queue Objects.
Java version ISQL
Demonstates how to communicate with host language programs by user queue objects in java. See 6.6. Java and i5/OS Queue objects.

Contents

1. Terms and Abbreviations

Terms used in this article

MI
Known also as TIMI(Technology Indepent Machine Interface), instroduced in S/38, the ancestor of i5/OS. MI is a logical interface between application programs and the SLIC(a software layer which dependent on the real hardwares). In another opinion, MI is an interface to the virtual machine implemented at the OS level on i5/OS. For details about MI, please refer to "Fortress Rochester: The Inside Story of the IBM ISeries", by Frank G. Soltis, ISBN 1583040838, 9781583040836.
Queue Object Types
- FIFO, queue entries are received in a first-in first-out sequence.
- LIFO, queue entries are received in a last-in first-out sequence.
- Keyed, queue entries are received by key. A key is a prefix added to an entry by its sender.

Abbreviations used in this article

DTAQ, Data Queue
USRQ, User Queue
OUTQ, Output Queue

2. An Introduction to Queue Objects on i5/OS

A queue is an MI object(with object type hex 0A) that can be used for storage and retrieval of data. Any jobs with authority to the queue can store and retrieve data from that queue. This makes a queue convenient for communications between programs. A process can test for data on a queue and either wait or continue execution if the data are not available. Data can be inserted on and removed from a queue based on a key value, or they can be processed based on order of arrival, either first-in-first-out (FIFO) or last-in-first-out (LIFO).

On i5/OS, queue objects that can be operate through CL commands and APIs are:

External Object Type MI Object Type/Subtype

Data Queue *DTAQ hex 0A01

User Queue *USRQ hex 0A02

Additionally, each i5/OS job uses a queue object named QMIRQ(Machine Interface Response Queue) to receive the I/O completion notification of each I/O request sent by the job. The MI object type of a QMIRQ is hex 0AEF.

Main attributes of a queue object

Maximum number of messages
Message text length (must be less than 64 KB)
Whether the queue is of fixed size or is extendable
Eextension value(number of messages per extension)
Initial number of messages when a queue object is creaeted
Whether storage reclaim will be attempted when the number of currently enqueued messages in the user queue reaches zero
Ordering sequence to use for messages: last-in-first-out (LIFO), first-in-first-out (FIFO), or keyed
Key length, if a key is present
Whether message data taken off the queue can contain pointers

Each queue message consists two parts, a message prefix and message text. For a keyed queue object, the key data resides in the message prefix. Both the message prefix and the message text are of fixed length. When enqueuing a message into a queue object, the length of the message text could be shorter than the Message text length, but the actual storage allocated on the queue object is the same to the Message text length attribute. For this reason, it is a bad idea to create a queue object for transferring different data formats which are different greatly in data length. That way will be a great waste in storage, and at the same time make damages to the efficiency of enqueue/dequeue operations.

When a message is to be enqueued, the job requesting the enqueue must supply a message prefix and message text. The supplied message text may contains pointers; if it does, they are preserved by queueing. If the queue object is full, then one of the following actions occurs:

If the queue is not extendable, or if the maximum number of extends specified by the user at queue creation has been reached, then the queue full(hex 2602, MCH3802) exception is signaled. The message is not enqueued.
If the queue is extendable, the queue is implicitly extended by the extension value attribute. The message is enqueued. No exception is signaled.

When using the QSNDDTAQ API to a enqueue data queue object, if the data queue object is full, QSNDDTAQ will raise exception CPF950A.

When dequeuing a queue object, what happens to any pointers in the text depends on the Whether message data taken off the queue can contain pointers attribute. If pointers are allowed in message text, instructions to manipulate tagged pointers are used. Otherwise, the tags are not preserved and the pointers can no longer be used. If keys are used, pointers can be used as key values, but again the tags within the key are not preserved when the message is dequeued.

When the queue is empty, or, if the messages are keyed and the requested key is not found, the job the dequeue can either wait or can exit. If the job waits, it can wait indefinitely or for a specified time period. When the time period expires, a dequeue time-out (hex 3A01, MCH5801) exception is signaled. When dequeue a data queue object with a specified time-out value, the Receive Data Queue (QRCVDTAQ) API will eat the dequeue time-out exception when a dequeue operation is timed-out. So it's the programmer's responsibility to distinguish whether a queue message is dequeued or the dequeue operatoin is timed-out when the QRCVDTAQ API returns by checking QRCVDTAQ's parameter 3 length of dequeued data. Parameter length of dequeued data of value 0, means that the dequeue operation is timed-out.

To dequeue a data queue object with no wait, the QRCVDTAQ's parameter 5 Wait time should be set to 0. To dequeue a user queue object with no wait, the branch or indicator form of the DEQ instruction should be specified.

You can save or restore a queue object; however, you can save or restore its definition only. You cannot save or restore the messages in it. For the same reason a queue object restored is always empty. You cannot restore a queue object if a queue object with the same name already exists in the library.

3. Difference between DTAQ and USRQ

Both DTAQ and USRQ are MI queue objects sharing all the attributes of a MI queue object, just with different external object type, *DTAQ and *USRQ. So what's the difference between them. We will discuss this problem considering the following aspects:

3.1. Object Domain

The only interface to create a DTAQ that IBM provided to programmers is the CL command CRTDTAQ. DTAQ objects created by this commad are always system domain object. Since user state processes cannot directly access system domain objects, we must access a DTAQ object through CL commands and APIs.

To create a USRQ object, we must use the Create User Queue (QUSCRTUQ) API. This API allows a USRQ object to be created either as a system domain object or a user domain object. See 5.1.2. USRQ's Domain Attribute for details. But a system doamin USRQ can only be accessed by queue operation MI instructions under security level 40.

3.2. Whether the Queue can be Journaled

We can journal a DTAQ object, but not a USRQ object. Jounraling a DTAQ makes the IPC progress between jobs and threads transparent to the developers. Detail information about operations such as enqueue, dequeue, renaming, deletion on a DTAQ could be logged to journal entries once a DTAQ object is journaled. For all possible journal entry type for DTAQ operations, see Appendix 4 Possible Journal Entry Type for Journal Code Q(Data queue operation)

Remember that although a DTAQ object can be journaled, but the journal entries could neither be used to apply changes to a DTAQ object nor remove changes from a DTAQ object. The reason is that queue objects are designed for IPC tasks, users should not be permitted to change the data contents of a queue object by methods other than enqueue and dequeue. For the same reason, although a queue object can be saved or restored, but the data content of the queue object is NOT saved. Thus a newly restored queue object is always empty.

Here we have an example, by which we can examine what will be logged into journal entries during enqueue, dequeue operations on a DTAQ object.

Create DTAQ Q13 of type FIFO, entry length = 64
```
CRTDTAQ DTAQ(LSBIN/Q13) MAXLEN(64)
```

Journal DTAQ Q13

STRJRNOBJ OBJ(LSBIN/Q13) OBJTYPE(*DTAQ) JRN(JRN01) IMAGES(*AFTER)

Enqueue Q13 twice
```
CALL PGM(QSNDDTAQ) PARM('Q13' 'LSBIN' X'00010F' 'AAAAAAAAAA')
CALL PGM(QSNDDTAQ) PARM('Q13' 'LSBIN' X'00020F' 'BBBBBBB CCCCCCC')
```
Use CL command DSPQMSG provided by i5/OS Programmer's Toolkit,
```
DSPQMSG Q13 *DTAQ
```
Messages currently on DTAQ Q13 are:

Number Time enqueued Message Text

1 2009-05-18-11.27.58.619412 'AAAAAAAAAA'

2 2009-05-18-11.28.23.033237 'BBBBBBB CCCCCCC'

Dequeue DTAQ Q13

CALL PGM(QRCVDTAQ) PARM('Q13' 'LSBIN' X'00020F' '' X'00001D')

Check journal entries

DSPJRN JRN(LSBIN/JRN01) JRNCDE((Q))

Output of command DSPJRN

         11075   Q     QS   Q13         LSBIN       REDLIGHT    11:27:58
         11076   Q     QS   Q13         LSBIN       REDLIGHT    11:28:23
         11077   Q     QR   Q13         LSBIN       REDLIGHT    12:25:22

Check journal entries of enqueue operation(journal entry type为'QS')

journal entries contains enqueued messages

                            Display Journal Entry                      
                                                                       
Object . . . . . . . :   Q13             Library  . . . . . . :   LSBIN
Member . . . . . . . :                                                 
Incomplete data  . . :   No              Minimized entry data :   No   
Sequence . . . . . . :   11075                                         
Code . . . . . . . . :   Q  - Data queue operation                     
Type . . . . . . . . :   QS - Send data queue entry, no key            
                                                                       
            Entry specific data                                        
Column      *...+....1....+....2....+....3....+....4....+....5         
00001      ' K   1.                           N             AA'        
00051      'AAAAAAAA'

                            Display Journal Entry                      
                                                                       
Object . . . . . . . :   Q13             Library  . . . . . . :   LSBIN
Member . . . . . . . :                                                 
Incomplete data  . . :   No              Minimized entry data :   No   
Sequence . . . . . . :   11076                                         
Code . . . . . . . . :   Q  - Data queue operation                     
Type . . . . . . . . :   QS - Send data queue entry, no key            
                                                                       
            Entry specific data                                        
Column      *...+....1....+....2....+....3....+....4....+....5         
00001      ' K E! !                           N             BB'        
00051      'BBBBB CCCCCCC     '

Use function key F10 to check information about the program and the job when and who enqueued the DTAQ

                         Display Journal Entry Details                       
                                                                             
 Journal  . . . . . . :   JRN01           Library  . . . . . . :   LSBIN     
                                                                             
 Sequence . . . . . . :   11075                                              
 Code . . . . . . . . :   Q  - Data queue operation                          
 Type . . . . . . . . :   QS - Send data queue entry, no key                 
                                                                             
 Object . . . . . . . :   Q13             Library  . . . . . . :   LSBIN     
 Member . . . . . . . :                   Flag . . . . . . . . :   0         
 Date . . . . . . . . :   09/05/18        Time . . . . . . . . :   11:27:58  
                                          Ref Constraint . . . :   No        
 Count/RRN  . . . . . :   0                                                  
 Job  . . . . . . . . :   254281/LJL/REDLIGHT                                
 Commit cycle ID  . . :   0                                                  
 User profile . . . . :   LJL             Program  . . . . . . :   QCMD      
 Ignore APY/RMV . . . :   No                Library  . . . . . :     *OMITTED
 Trigger  . . . . . . :   No                ASP device . . . . :     *OMITTED

Check journal entries of the dequeue operation(journal entry type为'QR').

Used function key F10 to check information about the program and the job when and who dequeued the DTAQ

                         Display Journal Entry Details                       
                                                                             
 Journal  . . . . . . :   JRN01           Library  . . . . . . :   LSBIN     
                                                                             
 Sequence . . . . . . :   11077                                              
 Code . . . . . . . . :   Q  - Data queue operation                          
 Type . . . . . . . . :   QR - Rcv data queue entry, no key                  
                                                                             
 Object . . . . . . . :   Q13             Library  . . . . . . :   LSBIN     
 Member . . . . . . . :                   Flag . . . . . . . . :   0         
 Date . . . . . . . . :   09/05/18        Time . . . . . . . . :   12:25:22  
                                          Ref Constraint . . . :   No        
 Count/RRN  . . . . . :   0                                                  
 Job  . . . . . . . . :   254281/LJL/REDLIGHT                                
 Commit cycle ID  . . :   0                                                  
 User profile . . . . :   LJL             Program  . . . . . . :   QCMD      
 Ignore APY/RMV . . . :   No                Library  . . . . . :     *OMITTED
 Trigger  . . . . . . :   No                ASP device . . . . :     *OMITTED

3.3. Operation Interfaces

i5/OS provides operation interfaces to DTAQ objects and USRQ objects from 3 different levels, CL commands, APIs, and MI instructions.

"Operation Interfaces to i5/OS queue objects"
Operation	Data Queue	User Queue
Create	CL - CRTDTAQ	API - QUSCRTUQ
Delete	CL - DLTDTAQ	CL - DLTUSRQ; API - QUSDLTUQ
Enqueue	API - QSNDDTAQ	MI - ENQ
Dequeue	API - QRCVDTAQ	MI - DEQ
Clear	API - QCLRDTAQ	~
Retrieve queue attributes	API - QMHQRDQD	MI - MATQAT
Retrieved queue messages (without removing messages from the queue)	API - QMHRDQM	MI - MATQMSG

3.4. Operation Efficiency

It is hard to find detail discussion on DTAQ or USRQ's operation efficiency in IBM's official documents such as the iSeries Information center,

Here we make a comparison between enqueue operatoins on a DTAQ and a USRQ. The purpose of this comparison is to demonstrate that the difference of operation efficiency between data queues and user queues do exits but not to provide accurate statistics on all queue operations. Before we start, one thing must be mentioned first. That is for an extensible queue object, the extensions will take quite an amount of time. In IPC applications that may cache a huge amount of data on a queue object, the impact to enqueue operations due to queue extensions must be taken into consideration.

In the following statistics, we use queue objects whose initial number of messages are set to a number big enough to avoid queue extensions.

Here we make time statistics of 1000 times of enqueue operation in 3 different conditions. The result time values are in microseconds.

case 1: Enqueue a FIFO USRQ, with entry length 64
case 2: Enqueue a FIFO DTAQ, with entry length 64. The DTAQ is not journaled.
case 3: Enqueue a FIFO DTAQ, with entry length 64. The DTAQ is journaled.

"Statistics of 1000 times of enqueue operation"
Case Time used(us,micro-seconds) Details

case 1 4000 Appendix 1. Enqueue USRQ Q11 for 1000 times

case 2 15100 Appendix 2. Enqueue DTAQ Q12(not journaled) for 1000 times

case 3 40599000 Appendix 3. Enqueue DTAQ Q12(journaled) for 1000 times

"Statistics of 1000 times of enqueue operation"
Case	Time used(us,micro-seconds)	Details
case 1	4000	Appendix 1. Enqueue USRQ Q11 for 1000 times
case 2	15100	Appendix 2. Enqueue DTAQ Q12(not journaled) for 1000 times
case 3	40599000	Appendix 3. Enqueue DTAQ Q12(journaled) for 1000 times

Although the statistics data are only concerned about enqueue operations, we can see that there's large difference in weights of two types of queue objects, DTAQ and USRQ. Additionally, we can see that journaling a DTAQ will make the enqueue operations to the DTAQ much more slower.

Remarks:: A DTAQ created with parameter FORCE(*YES)(Force to auxiliary storage) will also make enqueue/dequeue operations slower.

3.5. DTAQ Messages can Include Sender's Information

Data queues have the ability to attach a sender ID to each message being placed on the queue. The sender ID, an attribute of the data queue which is established when the queue is created, contains the qualified job name and current user profile. This functionality is not a feature provided by the ENQ MI instruction. To achieve the same functionality on a USRQ, the program who enqueue the USRQ is responsible for adding it's job ID and current user profile name preceding the content of each message to enqueue. But doing this is not as meaningful as the sender ID support on DTAQs. Since the sender IDs in DTAQ messages are added by the system while the sender IDs in USRQ messages are added by the enqueue programs and then are NOT trustable.

To include the sender ID in a DTAQ's messages, one should create the DTAQ with parameter SENDERID set to *YES. e.g.

CRTDTAQ DTAQ(LSBIN/Q14) MAXLEN(64) SENDERID(*YES) TEXT('with sender''s info')

Now let's have a look on the so called sender's ID. Enqueue something on the newly create DTAQ Q14, then use CL command DSPQMSG provided by i5/OS Programmer's Toolkit.

CALL PGM(QSNDDTAQ) PARM('Q14' 'LSBIN' X'00011F' 'ABCDE *^_^*')
DSPQMSG Q(LSBIN/Q14) QTYPE(*DTAQ)

Output of command DSPQMSG

                                Queue Message                            
                                                            System:   810
Queue  . . . . . . . :   Q14             Attribute  . . . . . :          
  Library  . . . . . :     LSBIN         Owner  . . . . . . . :   LJL    
Object ASP number  . :   1               Object Domain  . . . :   System 
Type . . . . . . . . :   *DTAQ           Key length . . . . . :   0      
                                         Key length . . . . . :   100    
                                         Number . . . . . . . :   1      
                                                                         
        -------------------Character data-------------------             
Column   *...+....1....+....2....+....3....+....4....+....5              
000001  'REDLIGHT  LJL       254281LJL       ABCDE *^_^*   '             
000051  '                                                  '

We can see that the sender's ID consists 2 parts:

26 bytes of job ID
- Job name, char(10)
- User profile name, char(10)
- Job number, char(6)
Job's current user profile name, char(10)

4. Data Queue Operation Examples

Contents

4.1. Create a DTAQ

4.1.1. Create a DTAQ of type FIFO or LIFO

CRTDTAQ DTAQ(Q21) MAXLEN(64) SEQ(*FIFO) TEXT('FIFO, entry length=64')
CRTDTAQ DTAQ(Q22) MAXLEN(64) SEQ(*LIFO) TEXT('LIFO, entry length=64')

Enqueue some messages to the LIFO DTAQ Q22, then use the DSPQMSG command on Q22. Pay attention to the order of the messages on Q22.

CALL PGM(QSNDDTAQ) PARM('Q22' 'LSBIN' X'00003F' 'abc')
CALL PGM(QSNDDTAQ) PARM('Q22' 'LSBIN' X'00003F' 'def')
DSPQMSG Q22
/* output of DSPQMSG */
                Time                        Message
Opt     Number  enqueued                    Key    
             1  2009-05-19-16.36.49.641679         
             2  2009-05-19-16.36.40.429570

4.1.2. Create a Keyed DTAQ

CRTDTAQ DTAQ(Q23) MAXLEN(64) SEQ(*KEYED) KEYLEN(8) TEXT('keyed, key length = 8')

Enqueue some messages to the keyed DTAQ Q23, then use the DSPQMSG command on Q23. Pay attention to the order of the messages on Q23.

CALL PGM(QSNDDTAQ) PARM('Q23' 'LSBIN' X'00003F' 'abc' X'008F' '00000005')
CALL PGM(QSNDDTAQ) PARM('Q23' 'LSBIN' X'00003F' 'def' X'008F' '00000002')
CALL PGM(QSNDDTAQ) PARM('Q23' 'LSBIN' X'00003F' 'ghi' X'008F' '00000003')

DSPQMSG Q(Q23)
/* output of DSPQMSG */
                Time                        Message 
Opt     Number  enqueued                    Key     
             1  2009-05-19-16.48.14.771519  00000002
             2  2009-05-19-16.48.38.547735  00000003
             3  2009-05-19-16.48.04.499240  00000005

4.1.3. Create a DTAQ Supports Sender's ID

CRTDTAQ DTAQ(Q24) MAXLEN(64) SENDERID(*YES)

4.1.4. Parameter MAXLEN(Maximum entry length) of CL command CRTDTAQ

MAXLEN(Maximum entry length) specifies the maximum length of the entry that is sent to the data queue. Valid values range from 1 through 64512. As we previously metioned in 2. An Introduction to Queue Objects on i5/OS Although we can specify a length of message text shorter than the MAXLEN parameter, the actual storage occupied by one DTAQ message text is always the same with the MAXLEN parameter. To exchange variable length data on a queue object, please refer to 6.5. Pass Variable Length Data through i5/OS Queue Objects.

4.1.5. Parameter SIZE of CL Command CRTDTAQ

Parameter SIZE consist of 2 elements, the maximum number of entries and the initial number of entries for the data queue.

For the Maximum number of entries element note that:

When we specify a number for element Maximum number of entries, the number means the maxinum number of entries can be put on the DTAQ. The machine may modify the specified number a little. To get the accurate Maximum number of entries attribute of a newly created DTAQ, use the DSPQD command of i5/OS Programmer's Toolkit.
Maximum number of entries has two special values, MAX16MB, and *MAX2GB. These two special values are talk about the storage upper limit of a DTAQ, not the upper limit of DTAQ entries. The real Maximum number of entries will be determined by the machine, considering the DTAQ entry length, key length, includeing sender's ID or not. To get the real Maximum number of entries attribute of a newly created DTAQ, use the DSPQD command of i5/OS Programmer's Toolkit.

The Initial number of entries element specifies the amount of storage that will initially be allocated to the data queue in order to hold the Initial number of entries. Note that:

Specify a proper Initial number of entries will avoid runtime queue extensions and efficiency damages caused by queue extensions.
If a DTAQ is created with parameter AUTORCL (Automatic reclaim) set to *YES, the storage allocated for the data queue is automatically reclaimed when the data queue is empty. When this occurs, the storage occupied by the DTAQ is of the size that only Initial number of entries can be hold on the DTAQ.

4.2. Delete a DTAQ

To delete a DTAQ, use CL command DLTDTAQ, e.g.

DLTDTAQ LSBIN/Q21

4.3. Enqueue Messages to a DTAQ

To enqueue messages to a DTAQ, one need to use the Send to a Data Queue (QSNDDTAQ) API.

4.3.1. Enqueue messages to a FIFO/LIFO DTAQ

call qsnddtaq parm(          
     'Q21'         /* char(10), DTAQ name */  
     'LSBIN'       /* char(10), DTAQ library */
     X'00003F'     /* pkd(5,0), length of message text to enqueue */ 
     'ABC'         /* char(*), message text */          
     )

4.3.2. Enqueue Messages to a Keyed DTAQ

call qsnddtaq parm(      
     'Q23'         /* char(10), DTAQ name */  
     'LSBIN'       /* char(10), DTAQ library */
     X'00003F'     /* pkd(5,0), length of message text to enqueue */
     'abc'         /* char(*), message text */          
     x'008F'       /* pkd(3,0), key length */
     '00000001'    /* char(*), key value */
     )

4.3.3. Enqueue Messages to a Keyed DTAQ (in ILE RPG)

ILE RPG program r101.rpgle

     /*
      * @file r101.rpgle
      * enqueue DTAQ Q23(keyed, key length=8, entry length=64)
      */

     /* prototype of API QSNDDTAQ */
     d qsnddtaq        pr                  extpgm('QSNDDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                       64a   options(*varsize)
     d   key_len                      3p 0
     d   key                          8a   options(*varsize)

     d qname           s             10a   inz('Q23')
     d qlib            s             10a   inz('LSBIN')
     d entry_len       s              5p 0 inz(64)
     d entry           s             64a
     d key_len         s              3p 0 inz(8)
     d key             s              8a

      /free
          entry = 'abc';
          key = '00000002';
          qsnddtaq(qname
                   : qlib
                   : entry_len
                   : entry
                   : key_len
                   : key );

          *inlr = *on;
      /end-free
     /* eof */

4.4. Dequeue Messages from a DTAQ

To dequeue messages from a DTAQ, one should use the Receive Data Queue (QRCVDTAQ) API.

4.4.1. Dequeue Messages from a FIFO/LIFO DTAQ

OPM CL programcl101.clp dequeus FIFO DTAQ Q21, waiting inifinitely.

             /************************************************/
             /* @FILE CL101.CLP                              */
             /* DEQUEUE FIFO DTAQ Q21                        */
             /************************************************/
             PGM
             DCL        VAR(&QNAM) TYPE(*CHAR) LEN(10) VALUE('Q21')
             DCL        VAR(&QLIB) TYPE(*CHAR) LEN(10) VALUE('LSBIN')
             DCL        VAR(&ENTLEN) TYPE(*DEC) LEN(5 0) /* length +
                          of dequeued data */
             DCL        VAR(&ENTRY) TYPE(*CHAR) LEN(64)
             DCL        VAR(&TIMEOUT) TYPE(*DEC) LEN(5 0) VALUE(-1) +
                          /* dequeue infinittely */
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(32) VALUE('entry +
                          dequeued:')

             CALL       PGM(QRCVDTAQ) PARM(&QNAM &QLIB &ENTLEN +
                          &ENTRY &TIMEOUT)
             CHGVAR     VAR(%SST(&MSG 17 16)) VALUE(&ENTRY)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG)

             ENDPGM
             /* EOF - CL101.CLP */

OPM CL programcl105.clp dequeues FIFO DTAQ Q21, with limited time-out value.

             /************************************************/
             /* @FILE CL101.CLP                              */
             /* DEQUEUE FIFO DTAQ Q21 WITH TIMEOUT           */
             /************************************************/
             PGM
             DCL        VAR(&QNAM) TYPE(*CHAR) LEN(10) VALUE('Q21')
             DCL        VAR(&QLIB) TYPE(*CHAR) LEN(10) VALUE('LSBIN')
             DCL        VAR(&ENTLEN) TYPE(*DEC) LEN(5 0) /* length +
                          of dequeued data */
             DCL        VAR(&ENTRY) TYPE(*CHAR) LEN(64)
             DCL        VAR(&TIMEOUT) TYPE(*DEC) LEN(5 0) VALUE(5) +
                          /* time-out value = 5s */
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(32) VALUE('entry +
                          dequeued:')

             CALL       PGM(QRCVDTAQ) PARM(&QNAM &QLIB &ENTLEN +
                          &ENTRY &TIMEOUT)
             IF         COND(&ENTLEN *EQ 0) THEN(DO)
             CHGVAR     VAR(&MSG) VALUE('Dequeue timed-out')
             GOTO       CMDLBL(SENDMSG)
             ENDDO
             CHGVAR     VAR(%SST(&MSG 17 16)) VALUE(&ENTRY)
 SENDMSG:    SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG)

             ENDPGM
             /* EOF - CL101.CLP */

4.4.2. Dequeue Messages from a Keyed DTAQ

Keyed DTAQ Q23 with entry length 64 and key length 8. OPM CL programcl102.clp dequeues one message from Q23 whose key values is greater than '00000001'.

             /************************************************/
             /* @FILE CL102.CLP                              */
             /* DEQUEUE KEYED DTAQ Q23                       */
             /************************************************/
             PGM
             DCL        VAR(&QNAM) TYPE(*CHAR) LEN(10) VALUE('Q23')
             DCL        VAR(&QLIB) TYPE(*CHAR) LEN(10) VALUE('LSBIN')
             DCL        VAR(&ENTLEN) TYPE(*DEC) LEN(5 0)
             DCL        VAR(&ENTRY) TYPE(*CHAR) LEN(64)
             DCL        VAR(&TIMEOUT) TYPE(*DEC) LEN(5 0) VALUE(-1) +
                          /* dequeue infinittely */
             DCL        VAR(&KEYORDER) TYPE(*CHAR) LEN(2) +
                          VALUE('GT') /* dequeue queue entries +
                          whose key value aregreater than variable +
                          &KEY */
             DCL        VAR(&KEYLEN) TYPE(*DEC) LEN(3 0) VALUE(8)
             DCL        VAR(&KEY) TYPE(*CHAR) LEN(8) VALUE('00000001')
             DCL        VAR(&SNDINFOLEN) TYPE(*DEC) LEN(3 0) +
                          VALUE(0) /* no sender info */
             DCL        VAR(&SNDINFO) TYPE(*CHAR) LEN(1)
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(96) +
                          VALUE('key:         ; message text: ')

             CALL       PGM(QRCVDTAQ) PARM(&QNAM &QLIB &ENTLEN +
                          &ENTRY &TIMEOUT &KEYORDER &KEYLEN &KEY +
                          &SNDINFOLEN &SNDINFO)
             CHGVAR     VAR(%SST(&MSG 6 8)) VALUE(&KEY)
             CHGVAR     VAR(%SST(&MSG 30 64)) VALUE(&ENTRY)
             SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA(&MSG)

             ENDPGM
             /* EOF - CL102.CLP */

4.4.3. Dequeue Messages from a Keyed DTAQ without Removal of the Mequeued Messages

Keyed DTAQ Q23 with entry length 64 and key length 8. ILE RPG programrl102.rpgle dequeues one messages on Q23 whose key values is greater than '00000001' without removal of the dequeued messages.

     /*
      * @file r102.rpgle
      *
      * DTAQ Q23，类型为基于键值出列，entry长度64，key长度8，
      * 不含发送作业标识信息。
      *
      * 出列DTAQ Q23中键值大于'00000001'的entry，并保留DTAQ中的entry。
      */

     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /* prototype of API QRCVDTAQ */
     d qrcvdtaq        pr                  extpgm('QRCVDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                       64a   options(*varsize)
     d   timeout                      5p 0
     d   key_order                    2a   options(*nopass)                     /* optional parameter group 1 */
     d   key_len                      3p 0 options(*nopass)
     d   key                          8a   options(*nopass:*varsize)            /* input/output parameter */
     d   sender_info...
     d     _len                       3p 0 options(*nopass)
     d   sender_info                  1a   options(*nopass:*varsize)
     d   remove_msg                  10a   options(*nopass)                     /* optional parameter group 2 */
     d   receiver_len                 5p 0 options(*nopass)
     d   ec                                likeds(qusec_t)
     d                                     options(*nopass)

     d qname           s             10a   inz('Q23')
     d qlib            s             10a   inz('LSBIN')
     d entry_len       s              5p 0
     d entry           s             64a
     d timeout         s              5p 0 inz(-1)                              /* dequeue infinitely */
     d key_order       s              2a   inz('GT')                            /* key order: >= parameter @key */
     d key_len         s              3p 0 inz(8)
     d key             s              8a   inz('00000001')
     d sender_info...
     d   _len          s              3p 0 inz(0)                               /* no sender info */
     d sender_info     s              1a
     d remove_msg      s             10a   inz('*NO')                           /* do NOT remove message from DTAQ */
     d receiver_len    s              5p 0 inz(64)
     d ec              ds                  likeds(qusec_t)
     d msg             s             16a

      /free
          ec.bytes_in = 256;
          qrcvdtaq(  qname
                   : qlib
                   : entry_len
                   : entry
                   : timeout
                   : key_order
                   : key_len
                   : key
                   : sender_info_len
                   : sender_info
                   : remove_msg
                   : receiver_len
                   : ec );

           msg = %subst(entry : 1 : 16);
           dsply key '*EXT' msg;

          *inlr = *on;
      /end-free
     /* eof - r102.rpgle */

Remarks:: QRCVDTAQ's parameter 9, Length of sender information is an input/output parameter. On input, it should contain callers search criterion. On output, it contains the key value of the dequeued message.

4.5. Clear Messages on a DTAQ

To clear a DTAQ, one should use the Clear Data Queue (QCLRDTAQ) API, e.g.

CALL PGM(QCLRDTAQ) PARM('Q21' 'LSBIN')

4.6. Retrieve Attributes of a DTAQ

To retrieve attributes of a DTAQ, one should use the Retrieve Data Queue Description (QMHQRDQD) API. QMHQRDQD supports 2 formats of DTAQ attributes, RDQD0100 and RDQD0200. The former is for a common DTAQ(*STD). The latter is for a DDM DTAQ(*DDM). ILE RPG program r103.rpgle use QMHQRDQD to retrieve attributes of DTAQ Q23.

     /*
      * @file r103.rpgle
      *
      * retrieve attribtutes of a DTAQ
      * Keyed DTAQ Q23 with entry length 64, key length 8,
      * does not include sender's ID
      */
     h dftactgrp(*no)

     /* receiver structure in format RDQD0100 */
     d rdqd0100_t      ds           112    qualified
     d   bytes_...
     d     returned                  10i 0                                      /* length of attribute data returned */
     d   bytes_...
     d     available                 10i 0                                      /* length DTAQ attribute data */
     d   entry_len                   10i 0                                      /* DTAQ entry length */
     d   key_len                     10i 0                                      /* DTAQ key length */
     d   sequence                     1a                                        /* DTAQ type:        */
     d                                                                          /*   - 'F', FIIO     */
     d                                                                          /*   - 'K', Keyed    */
     d                                                                          /*   - 'L', LIFO     */
     d   include_...
     d    sender_info                 1a                                        /* include sender info or not: Y/N */
     d   force_to_stg                 1a                                        /* force to storage: Y/N */
     d   text                        50a                                        /* text description */
     d   ddm_dtaq                     1a                                        /* is q DDM DTAQ:    */
     d                                                                          /*   - '0', no       */
     d                                                                          /*   - '1', yes      */
     d   auto_reclaim                 1a                                        /* automatic reclaim storage */
     d                                                                          /*   - '0', no       */
     d                                                                          /*   - '1', yes      */
     d   reserved                     1a
     d   num_messages                10i 0                                      /* messages currently on the DTAQ */
     d   entries_...
     d     allocated                 10i 0                                      /* entries currently allocated */
     d   qname                       10a
     d   qlib                        10a
     d   max_messages                10i 0                                      /* maximum number of messages */
     d   init_...
     d     messages                  10i 0                                      /* initial number of messages */

     /* prototype of API QMHQRDQD */
     d qmhqrdqd        pr                  extpgm('QMHQRDQD')
     d   dtaq_attr                         likeds(rdqd0100_t)                   /* receiver data */
     d   receiver_len                10i 0                                      /* length of receiver data */
     d   format_name                  8a                                        /* format name               */
     d                                                                          /*   - RDQD0100, normal DTAQ */
     d                                                                          /*   - RDQD0200, DDM DTAQ    */
     d   qname_lib                   20a                                        /* DTAQ name/library, e.g.   */
     d                                                                          /*   'Q23       LSBIN     '  */

     d do_report       pr

     d dtaq_attr       ds                  likeds(rdqd0100_t)
     d len             s             10i 0 inz(112)
     d format          s              8a   inz('RDQD0100')
     d qname_lib       s             20a   inz('Q23       LSBIN')

      /free

          qmhqrdqd(  dtaq_attr
                   : len
                   : format
                   : qname_lib );

          do_report();

          *inlr = *on;
      /end-free
     /* eof - main procedure */

     p do_report       b

     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /* prototype of QMHSNDPM */
     d qmhsndpm        pr                  extpgm('QMHSNDPM')
     d   msgid                        7a
     d   msgf                        20a
     d   msgdata                    128a   options(*varsize)
     d   msgdata_len                 10i 0
     d   msgtype                     10a
     d   callstack_...
     d     entry                     10a
     d   callstack_...
     d     counter                   10i 0
     d   msgkey                       4a
     d   ec                                likeds(qusec_t)

     d msgid           s              7a   inz('CPF9898')
     d msgf            s             20a   inz('QCPFMSG   QSYS')
     d msgdata         s            128a
     d msgdata_len     s             10i 0
     d msgtype         s             10a   inz('*INFO')
     d callstack_...
     d   entry         s             10a   inz('*PGMBDY')
     d callstack_...
     d   counter       s             10i 0 inz(1)
     d msgkey          s              4a
     d ec              ds                  likeds(qusec_t)
     d msg             s            128a

      /free

          ec.bytes_in = 256;

          // report DTAQ entry length
          msgdata = 'Entry length: ' + %char(dtaq_attr.entry_len);
          msgdata_len = %len(%trim(msgdata));
          qmhsndpm(  msgid
                   : msgf
                   : msgdata
                   : msgdata_len
                   : msgtype
                   : callstack_entry
                   : callstack_counter
                   : msgkey
                   : ec );

          // report DTAQ key length
          msgdata = 'Key length: ' + %char(dtaq_attr.key_len);
          msgdata_len = %len(%trim(msgdata));
          qmhsndpm(  msgid
                   : msgf
                   : msgdata
                   : msgdata_len
                   : msgtype
                   : callstack_entry
                   : callstack_counter
                   : msgkey
                   : ec );

          // report more DTAQ attributes
          // ... ...

      /end-free
     p do_report       e

     /* eof - r103.rpgle */

For more examples of using QMHQRDQD, please refer to internal entry points display-ddmq-attr(line 361) and display-dtaq-attr(line 396) in DSPQD 's source code qattr.mi.

4.7. Retrieve Messages from a DTAQ without Removing them

To retrieve messages from a DTAQ without removing them, one need to use the Retrieve Data Queue Message (QMHRDQM) API. Examples of using this API can be found in source code of command DSPQMSG, qmsg.mi

internal entry point mat-keyed-q-msg(line 451), retrieve messages on a keyed DTAQ
internal entry point mat-nonkeyed-q-msg(line 580), retrieve messages on a FIFO/LIFO DTAQ

Remarks:: The QMHRDQM API could not be used on a DDM DTAQ.

5. User Queue Operation Examples

5.1. Create a USRQ

To create a USRQ, one should use the Create User Queue (QUSCRTUQ) API.

Parameters of the QUSCRTUQ API

Required Parameter Group:
- 1 Qualified user queue name, Input, Char(20)
- 2 Extended attribute, Input, Char(10)
- 3 Queue type, Input, Char(1)
- 4 Key length, Input, Binary(4)
- 5 Maximum message size, Input, Binary(4)
- 6 Initial number of messages, Input, Binary(4)
- 7 Additional number of messages, Input, Binary(4)
- 8 Public authority, Input, Char(10)
- 9 Text description, Input, Char(50)
Optional Parameter Group 1:
- 10 Replace, Input, Char(10)
- 11 Error code, I/O, Char(*)
Optional Parameter Group 2:
- 12 Domain, Input, Char(10)
- 13 Pointers, Input, Char(10)

Optional Parameter Group 3:
- 14 Number of queue extensions, Input, Binary(4)
- 15 Reclaim storage, Input, Char(1)

For detailed document of the QUSCRTUQ API, see Create User Queue (QUSCRTUQ) API

5.1.1. Maxinum Number of Messages of a USRQ

The following three parameters of the QUSCRTUQ API determines the maxinum number of messages(MAX_MSGS) could be placed on a USRQ:

Initial number of messages(INIT_MSGS)
Additional number of messages(EXT_MSGS)
Number of queue extensions(NUM_EXTENDS)

The fomula is:

MAX_MSGS = INIT_MSGS + EXT_MSGS * NUM_EXTENDS
/*
e.g:
if
    INIT_MSGS = 1
    EXT_MSGS = 2
    NUM_EXTENDS = 1
then
    MAX_MSGS = 1 + 2 * 1 = 3
   */

Remarks:: The actual Number of queue extensions of a created USRQ may be modified a little by the machine. To get the accurate number, use CL commad DSPQD provided by i5/OS Programmer's Toolkit.

5.1.2. USRQ's Domain Attribute

QUSCRTUQ's parameter 12 Domain and the system value QALWUSRDMN determine a USRQ's domain attribute together.

"USRQ's domain attribute"
QALWUSRDMN System Value	Destination Library	Optional Domain Parameter	Domain of Created Object
*ALL	Any	*DEFAULT	User domain
*ALL	Any	*SYSTEM	System domain
*ALL	Any	*USER	User domain
QTEMP	QTEMP	*DEFAULT	User domain
QTEMP	QTEMP	*SYSTEM	System domain
QTEMP	QTEMP	*USER	User domain
Does not contain library name	Library name	*DEFAULT	System domain
Does not contain library name	Library name	*SYSTEM	System domain
Does not contain library name	Library name	*USER	None; error is returned

5.1.3. QUSCRTUQ's parameter 14, Number of Queue Extensions

QUSCRTUQ's parameter 14, Number of queue extensions specifies the maximum number of extensions allowed for the USRQ. The iSeries information Center (V5R2/V5R4), document for the QUSCRTUQ API said:

Number of queue extensions
    INPUT; BINARY(4)
    The maximum number of extensions allowed for the user queue.
    A value of -1 indicates that the maximum number of extensions
    will be chosen by the machine.
    If this parameter is not specified, 0 is assumed, which
    means the USRQ is not extensible.

But the experimental result on V5R2 is, whether specifying Number of queue extensions as -1 or not specifying Number of queue extensions the created USRQ's Number of queue extensions attribute will be choosed by the machine.

Create USRQ Q34, specifying Number of queue extensions as -1. Then use the DSPQD command to check Q34's Choose maximum number of extends attribute and Maximum number of extends attribute.

       CALL PGM(QUSCRTUQ) PARM(
            'Q34       LSBIN'   /* USRQ name */
            'QQ'                /* extended attribute */
            'K'                 /* queue type */
            X'00000008'         /* key length */
            X'00000040'         /* entry length */
            X'00000001'         /* initial number of messages */
            X'00000002'         /* number of messages per extension */
            '*EXCLUDE'          /* public authority */
            '`Number of queue extensions`parameter  = -1' /* text description */
            '*YES'                                        /* replace */
            X'0000002000000000000000000000000000000000000000000000000000000000' /* error code structure */
            '*USER'             /* object domain */
            '*YES'              /* contains poniter */
            X'FFFFFFFF'         /* number of queue extensions */
            '0')                /* auto-reclaim storage */

       DSPQD Q(Q34) QTYPE(*USRQ)
       /* Output */
       Queue attributes:                                         
         Message content  . . . . . :   Contains scalar data only
         Queue type . . . . . . . . :   Keyed                    
         Queue overflow action  . . :   Extend queue             
         Choose maximum number of                                
           extends  . . . . . . . . :   Machine   /* Determined by the machine */
         Reclaim storage  . . . . . :   0                           
       
       ... ...
       
       Maximum number of extends  . :   87380     /* The result 'Maximum number of extends' */

Create USRQ, without specifying Number of queue extensions

       CALL PGM(QUSCRTUQ) PARM('Q34       LSBIN' 'QQ' 'K'
           X'00000008' X'00000040' X'00000001' X'00000002'
           '*EXCLUDE' 'Do NOT specify `Number of queue extensions` parameter')
    
       DSPQD Q(Q34) QTYPE(*USRQ)
       /* Output */
       Queue attributes:                                         
         Message content  . . . . . :   Contains scalar data only
         Queue type . . . . . . . . :   Keyed                    
         Queue overflow action  . . :   Extend queue             
         Choose maximum number of                                
           extends  . . . . . . . . :   Machine   /* Determined by the machine */
         Reclaim storage  . . . . . :   0                           
       
       ... ...
       
       Maximum number of extends  . :   87380     /* The result 'Maximum number of extends' */

5.2. Delete a USRQ

To delete a USRQ, one should use the CL command DLTUSRQ or the Delete User Queue (QUSDLTUQ) API.

/* Using CL command DLTUSRQ */
DLTUSRQ USRQ(LSBIN/Q31)
/* Using API QUSCLTUQ */
CALL PGM(QUSDLTUQ) PARM('Q34       LSBIN'
    X'0000002000000000000000000000000000000000000000000000000000000000') /* QUSDLTUQ's second parameter, error code */

5.3. Enqueue Messages to a USRQ

To enqueue messages to a USRQ, one need to use the Enqueue (ENQ) MI instruction. Here we provide two examples about using the ENQ instruction respectively in ILE RPG and the MI language.

Remarks:: The third operation code of the ENQ instruction, message text must be aligned to 16 bytes boundary.

ILE RPG program r104.rpgle resolve to the USRQ object Q31 using the MI instruction RSLVSP, then enqueue Q31 by the ENQ instruction.

     /*
      * @file r104.rpgle
      *
      * enqueue USRQ Q31
      */
     h dftactgrp(*no)

     /* my protoype */
     d i_main          pr                  extpgm('R104')
     d   p_key                        8a
     d   p_text                      64a

     d q               s               *
     d option          ds            34    qualified
     d   type                         2a   inz(x'0A02')                         /* USRQ's MI object type: hex 0A02 */
     d   name                        30a   inz('Q31')                           /* USRQ name */
     d   auth                         2a   inz(x'0000')
     /* prototype of MI instruction RSLVSP */
     d rslvsp          pr                  extproc('_RSLVSP2')
     d   syp                           *
     d   option                        *   value
     /* prototype of MI instruction ENQ */
     d enq             pr                  extproc('_ENQ')
     d   q                             *
     d   prefix                        *   value
     d   text                          *   value

     d prefix          ds                  qualified                            /* message prefix */
     d   text_len                    10i 0                                      /* length of message text */
     d   key                          8a   inz('00000001')                      /* key data */
     d text            s             64a   inz('hi, i''m rpg program R104:p')   /* message text */

     d i_main          pi
     d   p_key                        8a
     d   p_text                      64a

      /free

          rslvsp(q : %addr(option));

          prefix.key = p_key;
          text = p_text;
          enq(q : %addr(prefix) : %addr(text));

          *inlr = *on;
      /end-free
     /* eof - r104.rpgle */

MI program enq31.mi implements the same work as r104.rpgle

/*
 * @file enq31.mi
 *
 * enqueue USRQ Q31(keyed, key length = 8, entry lenght=64)
 *
 * usage example: CALL ENQ31 PARM('00000003' 'ABCDE...')
 */

dcl sysptr q auto init("Q34", ctx("LSBIN"), type(q, 02)) ; 
dcl dd message-prefix char(9) auto ;
        dcl dd prefix-msglen bin(4) def(message-prefix) pos(1);
        dcl dd prefix-key char(5) def(message-prefix) pos(5) ; 

dcl spcptr .key parm                ; 
dcl spcptr .text parm                ; 
dcl ol pl-main(.key, .text) parm ext        ; 

dcl dd key char(8) bas(.key)    ; 
dcl dd text char(64) bas(.text) ; 

dcl dd msg char(64) auto bdry(16) ;
dcl spcptr msg-ptr auto init(msg) ; 

entry *(pl-main) ext;

        /* enq */
        cpynv prefix-msglen, 64;
        cpybla prefix-key, key  ;
        cpybla msg, text        ; 
        enq q, message-prefix, msg-ptr ; 

        rtx *;

pend;
/* eof - enq31.mi */

5.4. Dequeue Messages from a USRQ

To dequeue a USRQ, one should use the MI instruction DEQ.

DEQ's operands are:

operand 1, message prefix
operand 2, message text
operand 3, system pointer to the queue object

Format of operand 1 message prefix:

Offset  
Dec   Hex   Field Name                                      Data Type and Length
0   0   Timestamp of enqueue of message     Char(8) ++
8   8   Dequeue wait time-out value                     Char(8) +
          (ignored if branch options specified) 
16  10  Size of message dequeued                  Bin(4) ++
          (The maximum allowable size of a queue message
                is 64 K bytes.)
20  14  Access state modification option indicator  Char(1) +
                and message selection criteria  
20  14  Access state modification option when entering Dequeue wait   Bit 0 +
                0 =   Access state is not modified
                1 =   Access state is modified
20  14  Access state modification option when leaving Dequeue wait  Bit 1 +
                0 =   Access state is not modified
                1 =   Access state is modified
20  14  Multiprogramming level option                             Bit 2 +
                0 =   Leave current MPL set at Dequeue wait
                1 =   Remain in current MPL set at Dequeue wait
20  14  Time-out option                                                 Bit 3 +
                0 =   Wait for specified time, then signal time-out exception
                1 =   Wait indefinitely
20  14  Actual key to input key relationship                            Bits 4-7 +
          (for keyed queue)
                0010 =  Greater than
                0100 =  Less than
                0110 =  Not equal
                1000 =  Equal
                1010 =  Greater than or equal
                1100 =  Less than or equal
21  15  Search key (ignored for FIFO/LIFO queues but  Char(key length) +
                must be present for FIFO/LIFO queues with
                nonzero key length values)  
  *   Message key                                     Char(key length) ++

Remarks:: Fields shown here with one plus sign (+) indicate input to the instruction, and fields shown here with two plus signs (++) are returned by the machine.
For details, please refer to Dequeue (DEQ)

5.4.1. Execute DEQ Instruction without Waiting

DEQ instruction retrieves a queue message based on the queue type (FIFO, LIFO, or keyed) specified during the queue's creation. If the queue was created with the keyed option, messages can be retrieved by any of the following relationships between an enqueued message key and a selection key specified in operand 1 message prefix of the DEQ instruction: =, <>, >, <, <=, and >=. If the queue was created with either the LIFO or FIFO attribute, then only the next message can be retrieved from the queue.

If a message is not found that satisfies the dequeue selection criterion and the branch or indicator options are not specified, the thread waits until a message arrives to satisfy the dequeue or until the dequeue wait time-out expires. When specififying branch or indicator options, the thread is not placed in the dequeue wait state and either the control flow is altered according to the branch options, or indicator values are set based on the presence or absence of a message to be dequeued, e.g.

dcl sysptr q auto init("Q31", ctx("LSBIN"), type(q, 02)) ; 
dcl dd prefix char(37) auto     ;
dcl spcptr prefix-ptr auto init(prefix) ;
dcl spc prefix-t bas(prefix-ptr) ; 
        dcl dd time-enqueued char(8) dir ; /* output */
        dcl dd timeout char(8) dir ;
        dcl dd text-len bin(4) dir ;       /* output */
        dcl dd access-state-option char(1) dir ;
        dcl dd search-key char(8) ;
        dcl dd returned-key char(8) ;      /* output */
dcl dd text char(64) auto bdry(16) ;
dcl spcptr text-ptr auto init(text) ; 

entry * ext                     ; 

brk "DEQB"                      ; 
        /* binary:      11000010 */
        /* dequeue messages whose keys are greater than search-key */
        cpybla access-state-option, x"1202" ;
        cpybla search-key, "00000001" ; 
        deq(b) prefix, text-ptr, q / neq(not-found), eq(found) ; 
        
found:      /* when a queue message dequeued, control flow will be branched here */

not-found:  /* when no queue message dequeued, control flow will be branched here */

brk "DEQI"                        ;
dcl dd ind-found char(1) auto   ; 
dcl dd ind-not-found char(1) auto   ;
        deq(i) prefix, text-ptr, q / neq(ind-not-found), eq(ind-found) ;
        /* when a queue message is dequeued, ind-found = '1', ind-not-found = '0' */
        /* when no queue message is dequeued, ind-found = '0', ind-not-found = '1' */

        rtx *                   ; 
pend                                ;

Remarks:: For more examples, please refer to the source code of i5/OS Programmer's Toolkit's tool program clrusrq.mi, which clears a USRQ without waiting.

5.4.2. Execute DEQ Instruction with Limited Time-out or Infinitely

To wait infinitely for a message satisfies the dequeue selection criterion, bit 3 of operand message prefix's Access state modification option indicator and message selection criteria parameter must be set to 1. e.g.

dcl dd prefix char(37) auto     ;
dcl spcptr prefix-ptr auto init(prefix) ;
dcl spc prefix-t bas(prefix-ptr) ; 
        dcl dd time-enqueued char(8) dir ; /* output */
        dcl dd timeout char(8) dir ;
        dcl dd text-len bin(4) dir ;       /* output */
        dcl dd access-state-option char(1) dir ;

        /* set 'Time-out option' */
        setbts access-state-option, 3;

To specify a limited time-out value, one should set bit 3 of operand message prefix's Access state modification option indicator and message selection criteria parameter to 0, and specify a time-out value in message prefix's Dequeue wait time-out value parameter. The char(8) Dequeue wait time-out value is in the Standard Time Format. A zero Dequeue wait time-out value causes the default wait time-out of the current job is taken as the Dequeue wait time-out value. When the Dequeue wait time-out value expires, a Dequeue Time-Out exception (hex 3A01) is signaled. The following is an example of dequeue with limited time-out value.

dcl dd prefix char(37) auto     ;
dcl spcptr prefix-ptr auto init(prefix) ;
dcl spc prefix-t bas(prefix-ptr) ; 
        dcl dd time-enqueued char(8) dir ; /* output */
        dcl dd timeout char(8) dir ;
        dcl dd text-len bin(4) dir ;       /* output */
        dcl dd access-state-option char(1) dir ;

dcl dd seconds bin(4) auto init(7) ; /* 7 seconds */
        mult(s) seconds, 125000 ; 
        cpybtrls timeout, seconds, 17 ;/* copy seconds to timeout aligning from the left; shift 17 bits to the right */

        /* clear 'Time-out option' */
        clrbts access-state-option, 3;

5.5. Clear a USRQ

There's no CL command or API to clear to a USRQ. To clear a USRQ, we have to materize the attributes of a USRQ, and then dequeue it until it is empty. Here's an example, clrusrq.mi. You may call this program like the following:

CALL CLRUSRQ PARM(usrq_name)

5.6. Retrieve Attributes of a USRQ

To retrieve attributes of a USRQ, one should use the MI instruction MATQAT

For examples of using MATQAT, see i5/OS Programmer's Toolkit's source code qattr.mi.
For detailed documents on MATQAT, please refer to Materialize Queue Attributes (MATQAT)

5.7. Retrieve Messages on a USRQ

To retrieve messages on a USRQ, use the MATQMSG instruction.

For examples of using MATQMSG, see i5/OS Programmer's Toolkit's source code qmsg.mi.
For detailed documents on MATQMSG, please refer to Materialize Queue Messages (MATQMSG)

6. Usage Examples of Queue Objects

Examples here

6.1. IBM's USRQ example: Creating a Batch Machine

In the iSeries Information Center, IBM provides a basic usage demo on USRQs: Creating a Batch Machine. In this example, one or more clients enqueues CL commands to a USRQ from which the server dequeues each commands and run them on behalf of the clients. The USRQ is of type FIFO, and with entry length 100.

6.2. Data Queue Support on Output Queues

Support is available to optionally associate a DTAQ with an output queue using the Create Output Queue (CRTOUTQ) or Change Output Queue (CHGOUTQ) command. Entries are logged in the DTAQ when spooled files are in ready (RDY) status on the output queue. A user program can determine when a spooled file is available on an output queue using the Receive DTAQ API (QRCVDTAQ) to receive information from a DTAQ.

Each time a spooled file on the output queue reaches RDY status an entry is sent to the DTAQ. A spooled file can have several changes in status (for example, ready (RDY) to held (HLD) to release (RLS) to ready (RDY) again) before it is taken off the output queue. These status changes result in entries in the DTAQ for a spooled file each time the spooled file goes to RDY status.

There're two methods to associate a DTAQ with one or more output queues.

Add an evironment variable QIBM_NOTIFY_CRTSPLF with its value set to '*DTAQ' plus a valid DTAQ name and let the job who generates spooled file see it.
Specify the DTAQ parameter as a valid DTAQ name when using command CRTOUTQ or CHGOUTQ.

Here we will make an experimennt to show the data content of the DTAQ entry which is sent to the DTAQ when a spooled file reaches RDY status. Additionally, a Joblog Saver program is introduced in Appendix 5 A Joblog Saver Program.

Create the Notification Receiver DTAQ
First we create a DTAQ to receive notifications from the output queue. Note that:

Type of the DTAQ must be eighter FIFO or LIFO
Length of the DTAQ entry must be greater or equal 128 bytes for notification type '01' or 144 bytes for notification type '02'.

User profile QSPL must has *USE authority to the DTAQ and EXECUTE authority to the library where the DTAQ resides in.

CRTDTAQ DTAQ(LSBIN/SPLF)
        MAXLEN(144)     /* to receive type '02' notifications */
        SEQ(*FIFO)
        SIZE(*MAX2GB)
        TEXT('Notification Queue for Spooled Files')

Add Environment Variable QIBM_NOTIFY_CRTSPLF

ADDENVVAR ENVVAR(QIBM_NOTIFY_CRTSPLF)
          VALUE('*DTAQ LSBIN/SPLF')
          LEVEL(*SYS)     /* take system wide effects */

Check the Notification DTAQ Entry
Try to generate a spooled file in a interactive job such compiling a RPG program. Use CL command DSPQMSG to check the notification DTAQ entry in character format and hexadecimal format.

/* DSPQMSG */
DSPQMSG Q(LSBIN/SPLF)

/* character format */
        -------------------Character data-------------------
Column   *...+....1....+....2....+....3....+....4....+....5 
000001  '*SPOOL    02REDLIGHT  LJL       254395AAA         '
000051  ' QPRINT    QGPL      REDLIGHT  LJL       254395  '
000101  '                   S65FAA4B  1090518164906       '

/* hexadecimal format */
        ------------------Hexadecimal data------------------
Column   * . . . + . . . . 1 . . . . + . . . . 2 . . . . +  
000001  '5CE2D7D6D6D340404040F0F2D9C5C4D3C9C7C8E34040D3D1D3'
000026  '40404040404040F2F5F4F3F9F5C1C1C1404040404040400000'
000051  '0001D8D7D9C9D5E340404040D8C7D7D3404040404040D9C5C4'
000076  'D3C9C7C8E34040D3D1D340404040404040F2F5F4F3F9F54040'
000101  '4040404040404040000000000000000000000003E2F6F5C6C1'
000126  'C1F4C24040F1F0F9F0F5F1F8F1F6F4F9F0F600            '

The format of notification type '02' is:

Format of notification type '02'
Offset Dec	Offset Hex	Field Meaning	Data Type and Length	Value in out example
0	0	char(10)	Function name, always '*SPOOL'	'*SPOOL '
10	A	char(2)	Notification type, '02'	'02'
12	C	char(26)	Job ID. char(10) job name, char(10) user name, char(6) job number	'REDLIGHT LJL 254395'
38	26	char(10)	Spooled file name	'AAA '
48	30	binary(4)	Spooled file number	x'00000001'
52	34	char(20)	Output queue name	'QPRINT QGPL '
72	48	char(26)	Job ID	'REDLIGHT LJL 254395'
98	62	char(10)	User data	' '
108	6C	binary(4)	Reserved	x'00000000'
112	70	char(8)	Thread ID. ID of the thread that created the spooled file	x'0000000000000003'
120	78	char(10)	System name. System on which the spooled file is created	'S65FAA4B '
130	82	char(7)	Spooled file's creation date, in CYYMMDD format	'1090518'
137	89	char(6)	Spooled file's creation time, in HHMMSS format	'164906'
143	8F	char(1)	Reserved	x'00'

If a user application designed to receive notifications from the DTAQ needs to uniquely locate a spooled file by spooled file CL commands (e.g. CPYSPLF) or spooled file APIs (such as QSPOPNSP), commonly by the first three of the following six fields is enough:

Spooled file name
Spooled file number
Job ID
System name
Spooled file's creation date
Spooled file's creation time

6.3. Implement Priority-based IPC by Keyed Queue Objects

Message priority is supported in various communication models. A priority-based communication model permits messages with higher priorities be processed first, so that one can ensure time critical tasks be processed in time by assigning higher priorities to them. On i5/OS, we can implement priority-based IPC by means of keyed queue objects.

In the following example, client programs sent request to the server program by a keyed DTAQ. The key value of the DTAQ message acts as a message's priority whose permitted values are from '00' to '99'. '00' means the highest priority, '99' means the lowest priority. The server program dequeues all messages whose key values are greater than or equal to '00', thus a message with highest priority (smallest key value) will be dequeued first.

Components in our example

Keyed DTAQ Q27, with key length 2 and entry length 16.
The ILE RPG client program r105.rpgle
The ILE RPG server program r106.rpgle

Steps

6.3.1. Create the Keyed DTAQ Q27

CRTDTAQ DTAQ(Q27)
        MAXLEN(16)  /* entry length = 16 */
        SEQ(*KEYED) /* DTAQ type: keyed */
        KEYLEN(2)   /* key length = 2 */
        TEXT('for priority-based IPC')

6.3.2. Write the Client Program R105

Input paramters of ILE RPG program r105.rpgle

priority, char(2), request priority
delay, pkd(2,0), time to delay

msg, char(14), request data

     /*
      * @file r105.rpgle
      *
      * enqueue DTAQ Q27
      *
      */
     h dftactgrp(*no)

     d i_main          pr                  extpgm('R105')
     d   priority                     2a
     d   delay                        2p 0
     d   msg                         14a

     /* prototype of API QSNDDTAQ */
     d qsnddtaq        pr                  extpgm('QSNDDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                       16a   options(*varsize)
     d   key_len                      3p 0 options(*nopass)
     d   key                          2a   options(*nopass:*varsize)

     d qname           s             10a   inz('Q27')
     d qlib            s             10a   inz('LSBIN')
     d entry_len       s              5p 0 inz(16)
     d key_len         s              3p 0 inz(2)

     /* queue entry format, used both by the client and the server */
     d q_format        ds                  qualified
     d   dly_time                     2p 0                                      /* how long to    */
     d   msg                         14a                                        /* greeting words */

     d i_main          pi
     d   priority                     2a
     d   delay                        2p 0
     d   msg                         14a

      /free

          q_format.dly_time = delay;
          q_format.msg      = msg;
          qsnddtaq(  qname
                   : qlib
                   : entry_len
                   : q_format
                   : key_len
                   : priority );

          *inlr = *on;
      /end-free
     /* eof - r105.rpgle */

One should call R105 like the following

/*
Call R105
 - priority: '01'
 - delay: 15, hex 015F
 - msg: 'morning :p'
*/
CALL PGM(R105) PARM('01' X'015F' 'morning :p')

/* Use DSPQMSG command to check what has been enqueued on DTAQ Q27 */
DSPQMSG Q(Q27) QTYPE(*DTAQ)

/* Key data */
        -------------------Character data-------------------
Column   *...+....1....+....2....+....3....+....4....+....5 
000001  '01                                                '

/* hexadecimal format of queue entry's message text  */
        ------------------Hexadecimal data------------------
Column   * . . . + . . . . 1 . . . . + . . . . 2 . . . . +  
000001  '015F94969995899587407A9740404040                  '

6.3.3. Write the Server Program R106

ILE RPG programr106.rpgle dequeues all messages whose key values are greater than or equal to '00' looply. After dequeued a queue entry the server program delays the current job for seconds requested by the client and then display the request data passed by the client.

     /*
      * @file r106.rpgle
      *
      * deq R106
      *
      * queue message format
      *  - delay, pkd(2,0), delay time
      *  - msg, char(14), message from the client
      */
     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /* prototype of API QRCVDTAQ */
     d qrcvdtaq        pr                  extpgm('QRCVDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                       64a   options(*varsize)
     d   timeout                      5p 0
     d   key_order                    2a   options(*nopass)                     /* optional parameter group 1 */
     d   key_len                      3p 0 options(*nopass)
     d   key                          8a   options(*nopass:*varsize)            /* input/output parameter */
     d   sender_info...
     d     _len                       3p 0 options(*nopass)
     d   sender_info                  1a   options(*nopass:*varsize)
     d   remove_msg                  10a   options(*nopass)                     /* optional parameter group 2 */
     d   receiver_len                 5p 0 options(*nopass)
     d   ec                                likeds(qusec_t)
     d                                     options(*nopass)

     /* queue entry format, used both by the client and the server */
     d q_format        ds                  qualified
     d   dly_time                     2p 0                                      /* how long to    */
     d   msg                         14a                                        /* greeting words */

     d qname           s             10a   inz('Q27')
     d qlib            s             10a   inz('LSBIN')
     d entry_len       s              5p 0 inz(16)
     d timeout         s              5p 0 inz(-1)                              /* dequeue infinitely */
     d key_order       s              2a   inz('GE')                            /* key order: >= parameter @key */
     d key_len         s              3p 0 inz(2)
     d key             s              2a   inz('00')
     d sender_info...
     d   _len          s              3p 0 inz(0)                               /* no sender info */
     d sender_info     s              1a
     d priority        s             16a

     d qcmdexc         pr                  extpgm('QCMDEXC')
     d   cmd                         64a   options(*varsize)
     d   cmdlen                      15p 5

     d dlyjob_cmd      s             64a
     d len             s             15p 5

     d QUIT_CMDS       c                   'q Q qu QU quit QUITT'
     d KEY_ARG         c                   '01'

      /free

          dow '1';

              key = KEY_ARG;
              // deq DTAQ Q27
              qrcvdtaq(  qname
                       : qlib
                       : entry_len
                       : q_format
                       : timeout
                       : key_order
                       : key_len
                       : key
                       : sender_info_len
                       : sender_info );

              // should i quit?
              if %scan( %trim(q_format.msg) : QUIT_CMDS ) > 0;
                  priority = 'Priority: 100';
                  q_format.msg = 'see you :)';
                  dsply priority '' q_format.msg;
                  leave;
              endif;

              // delay job
              dlyjob_cmd = 'DLYJOB ' + %char(q_format.dly_time);
              len = %len(%trim(dlyjob_cmd));
              qcmdexc(dlyjob_cmd : len);

              // display message
              priority = 'Priority: ' + key;
              dsply priority '' q_format.msg;

          enddo;

          *inlr = *on;
      /end-free
     /* eof - r106.rpgle */

Now run the server program and the client program

/* submit the server job */
SBMJOB CMD(CALL R106)

/* then call the client program for 4 times */
CALL PGM(R105) PARM('99' X'015F' 'see you')
CALL PGM(R105) PARM('03' X'001F' 'Third')
CALL PGM(R105) PARM('02' X'001F' 'Second')
CALL PGM(R105) PARM('01' X'001F' 'First')

/* check and reply R106's messages in *MSGQ QSYSOPR */
First
  Reply . . :   a
Second
  Reply . . :   a
Third
  Reply . . :   a

6.4. Simulate Synchronous Calls by i5/OS Queue Objects

In IPC progresses based on queue objects instruced previously, programs that enqueue messages to a queue object do not know when a specific message is processed and the result of the processing. As a communication model, sometimes this is not acceptable. For example, in conditions that the processing result of a request message is meaningful for the program who sent the request messages to determine what to do next. Or a program who sends request messages have to wait util a previous request message has been processed to start the next step of its program logic such as sending the next request message.

To solve the problems mentioned above in IPC models based on queue objects, we may simulate synchronous calls using queue objects. IPC models to simulate synchronous calls using queue objects are different in implementation details, but a common feature of them is that the two participants of the IPC progress use one queue object as the request queue, use another queue object as the reply queue. The requester program enqueue a request message to the request queue, then dequeue a reply message from the request processing program from the reply queue.

As an example, here we implement a simple queue-based IPC model to simulate syncrhonous calls and design a SQL client(ISQL) and a SQL server(ISQLSVR) program which communicate with this IPC model.

In the IPC model we discussed here:

The request program (in many situations also the client program) communicate with the request processing program (the server program) on a pair of keyed DTAQs, one of which is a request queue, while the another a reply queue.
When sending a request, the request program enqueue a message to the request queue, with the message's key value set to a unique request ID, e.g. a UUID( 16 bytes Universal Unique ID), and the message's message text is set to the request data.
After sending a request the request program turns to the reply queue waiting for the reply message from the request processing program. The way to get the reply message of the current request is to dequeue a message from the reply queue whose key value is the same to the request ID of the current request.
The request processing program dequeues each available request from the request queue looply. After a request message is dequeued, the request processing program saves the message's key value (the unique request ID), processes the request data in the message's message text, and then enqueue a reply message to the reply queue, with the message's key value set to the request ID, and the message's message text set to the reply data or processing result.
After receiving the reply to a request, the request program checks the reply data, and determine what to do next according to the processing result represented by the reply data.

ISQL and ISQLSVR

The client program ISQL (implemented as a CL command), send SQL statement to the server program ISQLSVR. ISQL and ISQLSVR communicate on a pair of keyed DTAQs of which one works as the a queue and the other works as a reply queue.
When sending a request, ISQL generate a UUID(Universal Unique ID) as a request ID and then enqueue a message to the request queue whose key value is the request ID, and message text is the SQL statement to execute. ISQL then turn to the reply queue to dequeue ISQLSVR's reply message whose key value is equal to the request ID.
ISQLSVR dequeues all available messages from the request queue looply. After a request message is dequeued, ISQLSVR saves the reqeust ID stored in the message key, executes the SQL statement in the message text. Then enqueue a reply message to the reply queue, with the message's key value set to the request ID of current request handled, and the message text set to the SQL code of the SQL statement executed.
After getting a reply message from ISQLSVR, ISQL retrieve the SQL code from the reply message and report the execution result to the user according to value of the returned SQL code.

Components involved in the ISQL example

Request queue: data queue ISQL
Reply queue: data queue ISQLR
CL command ISQL: accepts user input and invokes command processing program ISQLCPP
CL command RUNSQL: accepts user input, invokes command processing program ISQLCPP, and returns the result SQL code. This command can be used in CL programs or REXX scripts.
CL command processing program ISQLCPP
Request processing program ISQLSVR

Steps

6.4.1. Create DTAQ ISQL and ISQLR

DTAQ ISQL

of type keyed
with key length 16 to hold a UUID(Universal Unique ID)
with entry length 256
queue entry format

Offset Parameter Name Data Type Meaning

0 SQL statement char(256) SQL statement string

256 -- end --

DTAQ ISQLR

of type keyed
with key length 16 to hold a UUID(Universal Unique ID)
with entry length 4
queue entry format

Offset Parameter Name Data Type Meaning

0 SQL code bin(4) SQL code

4 -- end --

CL command to create the DTAQs

CRTDTAQ DTAQ(LSBIN/ISQL) MAXLEN(256) SEQ(*KEYED) KEYLEN(16) TEXT('Request Data Queue for ISQL')
CRTDTAQ DTAQ(LSBIN/ISQLR) MAXLEN(4) SEQ(*KEYED) KEYLEN(16) TEXT('Reply Data Queue for ISQL')

6.4.2. Write the CL Command - ISQL

Source code of CL command ISQL, isql.cmd

/* @FILE ISQL.CMD */

             CMD        PROMPT('Run SQL statement')
             PARM       KWD(SQL) TYPE(*CHAR) LEN(256) MIN(1) +
                          INLPMTLEN(50) PROMPT('SQL statement')
/* EOF */

Compile CL command ISQL

CRTCMD CMD(LSBIN/ISQL) PGM(*LIBL/ISQLCPP) SRCFILE(LS2008/DEC)
  SRCMBR(*CMD) TEXT('i can sql')

6.4.3. Write the Command Processing Program - ISQLCPP

Source code of ILE RPG program ISQLCPP, isqlcpp.rpgle

     /*
      * @file isqlcpp.rpgle
      *
      * commmand processing program for CL command ISQL
      */

     h dftactgrp(*no)

     d i_main          pr                  extpgm('ISQLCPP')
     d   sql                        256a
     d   sqlcod                      10i 0 options(*nopass)

     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /* input checking procedure */
     d input_check     pr              n

     /*
      * do_request
      *  - send SQL request to server program ISQLSVR
      *  - receive the SQLCOD returned by ISQLSVR
      *  - report result message to the user
      *
      * @pre sql
      * @return sqlcod
      */
     d do_request      pr            10i 0

     /* send message to interactive user */
     d sendmsg         pr
     d   msg                        256a

     d i_main          pi
     d   sql                        256a
     d   sqlcod                      10i 0 options(*nopass)

     d msg             s            256a
     d rtn             s             10i 0

      /free

          if input_check();
              rtn = do_request();
          endif;

          sendmsg(msg);

          // return SQLCOD to the caller when parameter sqlcod is specified
          if %parms() > 1;
              sqlcod = rtn;
          endif;

          *inlr = *on;
      /end-free
     /* eof - i_main() */

     /* procedure input_check() */
     p input_check     b
     d input_check     pi              n

      /free
          if sql = *blanks;
              msg = 'Empty SQL statement';
              return *off;
          endif;

          return *on;
      /end-free
     p input_check     e

     /* procedure do_request() */
     p do_request      b

     d q_entry         ds                  qualified
     d   sql                        256a
     d   sqlcod                      10i 0
     d   ch_sqlcod                    4a   overlay(sqlcod)

     d uuid_template   ds                  qualified
     d   bytes_in                    10u 0 inz(32)
     d   bytes_out                   10u 0
     d   reserved                     8a   inz(x'0000000000000000')
     d   uuid                        16a

     d genuuid         pr                  extproc('_GENUUID')
     d   template                      *   value

     /* prototype of API QSNDDTAQ */
     d qsnddtaq        pr                  extpgm('QSNDDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                        1a   options(*varsize)
     d   key_len                      3p 0 options(*nopass)
     d   key                          1a   options(*nopass:*varsize)

     /* prototype of API QRCVDTAQ */
     d qrcvdtaq        pr                  extpgm('QRCVDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                        1a   options(*varsize)
     d   timeout                      5p 0
     d   key_order                    2a   options(*nopass)                     /* optional parameter group 1 */
     d   key_len                      3p 0 options(*nopass)
     d   key                          1a   options(*nopass:*varsize)            /* input/output parameter */
     d   sender_info...
     d     _len                       3p 0 options(*nopass)
     d   sender_info                  1a   options(*nopass:*varsize)
     d   remove_msg                  10a   options(*nopass)                     /* optional parameter group 2 */
     d   receiver_len                 5p 0 options(*nopass)
     d   ec                                likeds(qusec_t)
     d                                     options(*nopass)

     d qname           s             10a
     d qlib            s             10a   inz('*LIBL')
     d entry_len       s              5p 0
     d timeout         s              5p 0 inz(-1)                              /* dequeue infinitely */
     d key_order       s              2a   inz('EQ')                            /* key order: >= parameter @key */
     d key_len         s              3p 0 inz(16)
     d key             s             16a
     d sender_info...
     d   _len          s              3p 0 inz(0)                               /* no sender info */
     d sender_info     s              1a
     d ec              ds                  likeds(qusec_t)

     d do_request      pi            10i 0
      /free

          // generate UUID
          genuuid(%addr(uuid_template));

          // enqueue DTAQ ISQL
          entry_len = 256;
          qname = 'ISQL';
          q_entry.sql = sql;
          qsnddtaq(  qname
                   : qlib
                   : entry_len
                   : q_entry.sql
                   : key_len
                   : uuid_template.uuid );

          // dequeue DTAQ ISQL
          clear ec;
          ec.bytes_in = 256;
          qname = 'ISQLR';
          entry_len = 4;
          qrcvdtaq(  qname
                   : qlib
                   : entry_len
                   : q_entry.ch_sqlcod
                   : timeout
                   : key_order
                   : key_len
                   : uuid_template.uuid
                   : sender_info_len
                   : sender_info );
          if ec.bytes_out <> 0;
              msg = 'QRCVDTAQ() failed with exception ID: '
                       + ec.exid;
              return -9999;
          endif;

          // set msg according to returned SQLCOD
          if q_entry.sqlcod < 0;
              msg = 'SQL statement failed with SQLCOD '
                       + %char(q_entry.sqlcod);
          elseif q_entry.sqlcod > 0;
              msg = 'SQL statement succeeded with SQLCOD '
                       + %char(q_entry.sqlcod);
          else;
              msg = 'SQL statement succeeded';
          endif;

          return q_entry.sqlcod;
      /end-free
     p do_request      e

     /* procedure sendmsg() */
     p sendmsg         b

     /* prototype of QMHSNDPM */
     d qmhsndpm        pr                  extpgm('QMHSNDPM')
     d   msgid                        7a
     d   msgf                        20a
     d   msgdata                    512a   options(*varsize)
     d   msgdata_len                 10i 0
     d   msgtype                     10a
     d   callstack_...
     d     entry                     10a
     d   callstack_...
     d     counter                   10i 0
     d   msgkey                       4a
     d   ec                                likeds(qusec_t)

     d sendmsg         pi
     d   msg                        256a

     d msgid           s              7a   inz('CPF9898')
     d msgf            s             20a   inz('QCPFMSG   QSYS')
     d msgdata_len     s             10i 0
     d msgtype         s             10a   inz('*INFO')
     d callstack_...
     d   entry         s             10a   inz('*PGMBDY')
     d callstack_...
     d   counter       s             10i 0 inz(1)
     d msgkey          s              4a
     d ec              ds                  likeds(qusec_t)

     d cmd             s            512a
     d len             s             15p 5

      /free

          ec.bytes_in = 256;

          msgdata_len = %len(%trim(msg));
          qmhsndpm(  msgid
                   : msgf
                   : msg
                   : msgdata_len
                   : msgtype
                   : callstack_entry
                   : callstack_counter
                   : msgkey
                   : ec );

      /end-free
     p sendmsg         e

     /* eof - isqlcpp.rpgle */

6.4.4. Write the Request Porcessing Program - ISQLSVR

Source code of ILE SQLRPG program ISQLSVR, isqlsvr.sqlrpgle

     /*
      * @file isqlsvr.sqlrpgle
      *
      * - dequeue SQL request from DTAQ ISQL
      * - process SQL statement
      * - reply client with SQLCOD
      */
     /* to use activation group scope commitment control */
     h dftactgrp(*no) actgrp('ISQLSVR')

     /*
      * procedure server_client
      *
      * - dequeue SQL request from DTAQ ISQL
      * - process SQL statement
      * - reply client with SQLCOD
      *
      * @return boolean, *off if the main procedure should quit.
      */
     d serve_client    pr              n

     /*
      * procedure run_sql()
      *
      * @return SQLCOD
      */
     d run_sql         pr            10i 0
     d   sql                        256a   options(*varsize)

      /free

          dow serve_client();
          enddo;

          *inlr = *on;
      /end-free
     p serve_client    b

     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /* prototype of API QSNDDTAQ */
     d qsnddtaq        pr                  extpgm('QSNDDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                        1a   options(*varsize)
     d   key_len                      3p 0 options(*nopass)
     d   key                          1a   options(*nopass:*varsize)

     /* prototype of API QRCVDTAQ */
     d qrcvdtaq        pr                  extpgm('QRCVDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   entry_len                    5p 0
     d   entry                        1a   options(*varsize)
     d   timeout                      5p 0
     d   key_order                    2a   options(*nopass)                     /* optional parameter group 1 */
     d   key_len                      3p 0 options(*nopass)
     d   key                          1a   options(*nopass:*varsize)            /* input/output parameter */
     d   sender_info...
     d     _len                       3p 0 options(*nopass)
     d   sender_info                  1a   options(*nopass:*varsize)
     d   remove_msg                  10a   options(*nopass)                     /* optional parameter group 2 */
     d   receiver_len                 5p 0 options(*nopass)
     d   ec                                likeds(qusec_t)
     d                                     options(*nopass)

     d qname           s             10a
     d qlib            s             10a   inz('*LIBL')
     d entry_len       s              5p 0
     d timeout         s              5p 0 inz(-1)                              /* dequeue infinitely */
     d key_order       s              2a   inz('GE')                            /* key order: >= parameter @key */
     d key_len         s              3p 0 inz(16)
     d key             s             16a
     d sender_info...
     d   _len          s              3p 0 inz(0)                               /* no sender info */
     d sender_info     s              1a
     d ec              ds                  likeds(qusec_t)

     d q_entry         ds                  qualified
     d   sql                        256a
     d   sqlcod                      10i 0
     d   ch_sqlcod                    4a   overlay(sqlcod)

     d uuid            s             16a
     d msg             s             26a
     d rtn             s              1a
     d QUIT_CMDS       c                   'q Q qu QU quit QUITT'
     d KEY_ARG         c                   x'00000000000000000000000000000000'

     d serve_client    pi              n
      /free

          rtn = *on;

          // dequeue client request from DTAQ ISQL
          clear ec;
          ec.bytes_in = 256;
          qname = 'ISQL';
          entry_len = 256;
          uuid = KEY_ARG;
          qrcvdtaq(  qname
                   : qlib
                   : entry_len
                   : q_entry.sql
                   : timeout
                   : key_order
                   : key_len
                   : uuid
                   : sender_info_len
                   : sender_info );
          if ec.bytes_out <> 0;
              // error handling
              msg = 'QRCVDTAQ failed: '
                       + ec.exid;
              dsply 'Error' '' msg;
              return *off;
          endif;

          // should i quit?
          if %scan(%trim(q_entry.sql) : QUIT_CMDS) > 0;
              rtn = *off;
          else;
              // run sql statement
              q_entry.sqlcod = run_sql(q_entry.sql);
          endif;

          // enqueue reply to DTAQ ISQLR
          entry_len = 4;
          qname = 'ISQLR';
          qsnddtaq(  qname
                   : qlib
                   : entry_len
                   : q_entry.ch_sqlcod
                   : key_len
                   : uuid );

          return rtn;
      /end-free
     p serve_client    e

     p run_sql         b
     d run_sql         pi            10i 0
     d   sql                        256a   options(*varsize)

     c/exec sql prepare stmt from :sql
     c/end-exec
     c                   if        sqlcod < 0
     c                   return    sqlcod
     c                   endif
     c/exec sql execute stmt
     c/end-exec

     c                   return    sqlcod
     p run_sql         e
     /* eof - isqlsvr.sqlrpgle

Compile ISQLSVR

CRTSQLRPGI OBJ(LSBIN/ISQLSVR) SRCFILE(LS2008/DEC)
           SRCMBR(*OBJ) COMMIT(*CS)

Remarks:: Note that ISQLSVR uses activation group level commit control. Thus, one must set parameter COMMIT to a value other than *NONE.

6.4.5. Run ISQLSVR and ISQL

Submit the ISQL server job

SBMJOB CMD(CALL PGM(ISQLSVR))

Start journaling physical file PF16

STRJRNPF FILE(PF16) JRN(JRN01) IMAGES(*BOTH)

Clear physical file PF16

CLRPFM FILE(PF16)

Use DELETE statement on PF16

ISQL SQL('delete from pf16')
/*
Result:
SQL statement succeeded with SQLCOD 100.
*/

Use INSERT statement of PF16

ISQL SQL('insert into pf16 values(''Field 1'', ''Field 2'', ''Field 3'')')
/*
Result:
SQL statement succeeded.
*/

Use DSPJOB command to heck commitment control information of the server job

DSPJOB JOB(257356/LJL/LJL_DAILY) OPTION(*CMTCTL)
/* Replace the job ID with your server job's job ID. */

Currently the server job has an activiation group level commitment control.

        Commitment                           
Opt     Definition     Text                  
        ISQLSVR        Activation-group-level

And there's one pending record level change under the activation group level commitment control.

Job:   LJL_DAILY      User:   LJL            Number:   257356         
                                                                      
Commitment definition  . . . . . . . . :   ISQLSVR                    
                                                                      
                                    -------------Changes--------------
File        Library     Member          Commit    Rollback     Pending
PF16        LSBIN       PF16                 0           0           0
                        PF16                 0           0           1

Commit changes to PF16

ISQL SQL('commit')
/*
Result:
SQL statement succeeded.
*/

6.4.6. Write CL command RUNSQL

CL command ISQL should not be used in CL programs or REXX scripts, since it does not return the result SQL code. Here is another version of command ISQL, RUNSQL which returns the result SQL code and can only be used in CL programs or REXX scripts. In CL programs or REXX scripts, with the returned SQL code, we can determine what to do next such as to rollback all previous changes to database tables.

Source code of CL command RUNSQL, runsql.cmd

/* @FILE RUNSQL.CMD */

             CMD        PROMPT('Run SQL statement')
             PARM       KWD(SQL) TYPE(*CHAR) LEN(256) MIN(1) +
                          INLPMTLEN(50) PROMPT('SQL statement')
             PARM       KWD(SQLCOD) TYPE(*CHAR) LEN(4) RTNVAL(*YES) +
                          MIN(1) PROMPT('SQLCOD returned')
/* EOF */

Compile CL command RUNSQL

CRTCMD CMD(LSBIN/RUNSQL) PGM(*LIBL/ISQLCPP) SRCFILE(LS2008/DEC)
       ALLOW(*BPGM *IPGM *BREXX *IREXX) /* Do NOT invoke me interactively. */

OPM CL program CL103 invoke CL command RUNSQL like the following.

             /* @FILE CL103.CLP */
PGM
             DCL        VAR(&SQLCOD) TYPE(*CHAR) LEN(4)
 RUN_SQL:    RUNSQL     SQL('delete from pf16') SQLCOD(&SQLCOD) /* +
                          clear PF16 */
             RUNSQL     SQL('insert into PF16 values(''A'', ''B'', +
                          ''C'')') SQLCOD(&SQLCOD) /* insert new +
                          records */
             IF         COND(%BIN(&SQLCOD) *LT 0) THEN(DO)
             SNDPGMMSG  MSG('SQL operations failed.') +
                          TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
             RUNSQL     SQL('rollback') SQLCOD(&SQLCOD) /* rollbak +
                          when insert operation failed */
             GOTO       CMDLBL(END)
             ENDDO

             RUNSQL     SQL('commit') SQLCOD(&SQLCOD) /* commit */

 END:        ENDPGM
/* EOF - CL103.CLP */

6.5. Pass Variable Length Data through i5/OS Queue Objects

In the ISQL example in 6.4. Simulate Synchronous Calls by i5/OS Queue Objects, the length of the request SQL statement is limited to the length of request queue entry. Although we can enlarge the queue entry length, but the longer the queue entry length is the more storage will be wasted when short SQL statement are put on the request queue. Obviously, to solve this problem we need to pass variable length data through i5/OS queue objects.

In section 2. An Introduction to Queue Objects on i5/OS we have metioned an attribute of i5/OS queue objects: whether message data taken off the queue can contain pointers. Pointers we talked here are MI pointers, such as space pointers, data pointers, system pointers, etc. A space pointer is used to describe addressibility of data items. As an MI pointer, a space pointer contains common pointer attributes such as pointer type and tag bits and specific attributes such as the offset portion. One can roughly equate a space pointer with an i5/OS HLL data pointer. To pass variable length data through a queue object, we need to:

create an queue object which can contain pointers in its message data
allocate storage for variable length data in one program, then get the space pointer that addresses to the allocated storage and enqueue the space pointer to the queue object
dequeue the space pointer from the queue object in a program who consume the variable length data, then access the variable length data through the space pointer

Remarks:

Program who enqueue a space pointer to a queue object must ensure the storage that the space pointer points to not be released until the program who consumes the storage does not need it any more.

Structures that contains pointers must align to 16 bytes boundary.

IBM does not provide any interface to create data queue object that can contain pointers. Thus when we need to pass pointers through a queue object, we can only choose a user queue object.

One can pass other type of pointers through a queue object. For example by passing a system pointer to a program object through a queue object, we can let a request processing program run business logics without caring about what program it's running.

Here we make an enhancement for program ISQL introduced in section 6.4. Simulate Synchronous Calls by i5/OS Queue Objects to eliminate the limitation on length of SQL statements. We call the enhanced version ISQL2.

Components of ISQL2

Request queue: user queue ISQL2
Reply queue: user queue ISQLR2
CL command ISQL2: accepts user input and invokes command processing program ISQLCPP2
CL command RUNSQL2: accepts user input, invokes command processing program ISQLCPP2, and returns the result SQL code. This command can be used in CL programs or REXX scripts.
Command processing program ISQLCPP2. ISQLCPP2 enqueues a space pointer of a SQL statement to the request queue, then dequeues returned SQL code from the reply queue.
Request processing program ISQLSVR2. ISQLSVR2 dequeues space pointers of each request SQL statement, retrieves SQL statement data, runs it, and enqueues the result SQL code to the reply queue.

Steps

6.5.1. Create USRQ ISQL2 and ISQLR2

The request USRQ ISQL2

of type keyed
with key length 16 to hold 16 bytes UUID
with entry length 16 to hold a space pointer
queue entry format

Offset Parameter Name Data Type Meaning

0 Pointer to SQL statement SPCPTR Pointer to SQL statement data

16 -- end --

The reply USRQ ISQLR2

of type keyed
with key length 16 to hold 16 bytes UUID
with entry length 4 to hold a SQL code
queue entry format

Offset Parameter Name Data Type Meaning

0 SQL code bin(4) SQL code

4 -- end --

CL command to create the USRQs

/* The request USRQ ISQL2 */
CALL PGM(QUSCRTUQ) PARM(
     'ISQL2     LSBIN'   /* USRQ name */
     'QQ'                /* extended attribute */
     'K'                 /* queue type */
     X'00000010'         /* key length */
     X'00000010'         /* entry length */
     X'00000010'         /* initial number of messages */
     X'00000010'         /* number of messages per extension */
     '*EXCLUDE'          /* public authority */
     'ISQL request queue. key length = 16, entry length = 16' /* text description */
     '*YES'              /* replace */
     X'0000002000000000000000000000000000000000000000000000000000000000' /* error code structure */
     '*USER'             /* object domain */
     '*YES')             /* contains poniter */

/* The reply USRQ ISQLR2 */
CALL PGM(QUSCRTUQ) PARM(
     'ISQLR2    LSBIN'   /* USRQ name */
     'QQ'                /* extended attribute */
     'K'                 /* queue type */
     X'00000010'         /* key length */
     X'00000004'         /* entry length */
     X'00000010'         /* initial number of messages */
     X'00000010'         /* number of messages per extension */
     '*EXCLUDE'          /* public authority */
     'ISQL reply queue. key length = 16, entry length = 4') /* text description */

6.5.2. Write CL command - ISQL2

Source code of CL command ISQL2 isql2.cmd

/* @FILE ISQL.CMD */

             CMD        PROMPT('Run SQL statement')
             PARM       KWD(SQL) TYPE(*CHAR) LEN(256) MIN(1) +
                          INLPMTLEN(50) PROMPT('SQL statement')
/* EOF */

Compile CL command ISQL2

CRTCMD CMD(LSBIN/ISQL2) PGM(*LIBL/ISQLCPP2) SRCFILE(LS2008/DEC)
       SRCMBR(*CMD) TEXT('i can sql too :p')

6.5.3. Write Commnad Processing Program ISQLCPP2

Source code of ILE RPG program isqlcpp2.rpgle

     /*
      * @file isqlcpp2.rpgle
      *
      */
     h dftactgrp(*no)

     d sql_param_t     ds                  qualified
     d   sql_len                     10i 0
     d   sql                      32767a

     d i_main          pr                  extpgm('ISQLCPP2')
     d   sql_parm                          likeds(sql_param_t)
     d   sqlcod                      10i 0 options(*nopass)

     /* structure Qus_EC_t */
     d qusec_t         ds           256    qualified
     d   bytes_in                    10i 0
     d   bytes_out                   10i 0
     d   exid                         7a
     d   reserved                     1a
     d   ex_data                    240a

     /*
      * do_request
      *  - send SQL request to server program ISQLSVR2
      *  - receive the SQLCOD returned by ISQLSVR2
      *  - report result message to the user
      *
      * @pre sql
      * @return sqlcod
      */
     d do_request      pr            10i 0

     /* send message to interactive user */
     d sendmsg         pr
     d   msg                        256a

     /*
      * prototype of procedure resolve_qs
      * @return boolean, *on if both the request USRQ and the reply
      *         USRQ are resolved.
      */
     d resolve_qs      pr              n

     /* request USRQ ISQL2 */
     d request_q       s               *

     /* reply USRQ ISQLR2 */
     d reply_q         s               *

     d msg             s            256a
     d rtn             s             10i 0

     d i_main          pi
     d   sql_parm                          likeds(sql_param_t)
     d   sqlcod                      10i 0 options(*nopass)

      /free

          // resolve request q, reply q
          if resolve_qs();
              rtn = do_request();
          endif;

          sendmsg(msg);

          // return SQLCOD to the caller when parameter sqlcod is specified
          if %parms() > 1;
              sqlcod = rtn;
          endif;

          *inlr = *on;
      /end-free

     /* procedure resolve_qs() */
     p resolve_qs      b
     /* prototype of MI instruction RSLVSP */
     d rslvsp          pr                  extproc('_RSLVSP2')
     d   syp                           *
     d   option                        *   value

     d resolve_option  ds            34    qualified
     d   type                         2a   inz(x'0A02')
     d   name                        30a
     d   auth                         2a   inz(x'0000')

     d rtn             s               n

     d resolve_qs      pi              n
      /free

          rtn = *on;

          // resolve request q, reply q
          monitor;   // monitor MCH3401
              resolve_option.name = 'ISQL2';
              rslvsp(request_q : %addr(resolve_option));
              resolve_option.name = 'ISQLR2';
              rslvsp(reply_q : %addr(resolve_option));
          on-error;
              msg = 'Failed to resolve request user queue' +
                    ' or reply user queue';
              rtn = *off;
          endmon;

          return rtn;
      /end-free
     p resolve_qs      e

     /* procedure do_request() */
     p do_request      b

     d uuid_template   ds                  qualified
     d   bytes_in                    10u 0 inz(32)
     d   bytes_out                   10u 0
     d   reserved                     8a   inz(x'0000000000000000')
     d   uuid                        16a

     d genuuid         pr                  extproc('_GENUUID')
     d   template                      *   value

     /* prototype of MI instruction ENQ */
     d enq             pr                  extproc('_ENQ')
     d   q                             *
     d   prefix                        *   value
     d   text                          *   value

     /* prototype of MI instruction DEQ */
     d deq             pr                  extproc('_DEQWAIT')
     d   prefix                        *   value
     d   text                          *   value
     d   q                             *

     /* enq prefix */
     d enq_prefix      ds            20    qualified
     d   text_len                    10i 0
     d   key                         16a

     /* deq prefix */
     d deq_prefix      ds            53    qualified
     d   enqueue_time                 8a
     d   timeout                      8a
     d   text_len                    10i 0
     d   acc_sts_mod                  1a   inz(x'D8')                           /* deq infinitely */
     d   key_in                      16a
     d   key_out                     16a

     /* request data */
     d request         ds                  qualified
     d   sql_len                     10u 0
     d   reserved                     8a                                        /* align to 16 bytes boundary */
     d   sql_ptr                       *
     d request_ptr     s               *   inz(%addr(request))

     /* reply message from ISQLSVR2 */
     d reply           ds            16    qualified
     d   sqlcod                      10i 0

     d do_request      pi            10i 0

      /free

          // generate UUID
          genuuid(%addr(uuid_template));

          // enqueue SQL statement to USRQ ISQL2
          enq_prefix.text_len = 16;
          enq_prefix.key = uuid_template.uuid;
          request.sql_len = sql_parm.sql_len;
          request.sql_ptr = %addr(sql_parm.sql);
          enq(request_q : %addr(enq_prefix) : %addr(request_ptr));

          // dequeue SQLCOD from USRQ ISQLR2
          deq_prefix.key_in = uuid_template.uuid;
          deq(%addr(deq_prefix) : %addr(reply) : reply_q);

          // set msg according to returned SQLCOD
          if reply.sqlcod < 0;
              msg = 'SQL statement failed with SQLCOD '
                       + %char(reply.sqlcod);
          elseif reply.sqlcod > 0;
              msg = 'SQL statement succeeded with SQLCOD '
                       + %char(reply.sqlcod);
          else;
              msg = 'SQL statement succeeded';
          endif;

          return reply.sqlcod;
      /end-free
     p do_request      e

     /* procedure sendmsg() */
     p sendmsg         b

     /* prototype of QMHSNDPM */
     d qmhsndpm        pr                  extpgm('QMHSNDPM')
     d   msgid                        7a
     d   msgf                        20a
     d   msgdata                    512a   options(*varsize)
     d   msgdata_len                 10i 0
     d   msgtype                     10a
     d   callstack_...
     d     entry                     10a
     d   callstack_...
     d     counter                   10i 0
     d   msgkey                       4a
     d   ec                                likeds(qusec_t)

     d msgid           s              7a   inz('CPF9898')
     d msgf            s             20a   inz('QCPFMSG   QSYS')
     d msgdata_len     s             10i 0
     d msgtype         s             10a   inz('*INFO')
     d callstack_...
     d   entry         s             10a   inz('*PGMBDY')
     d callstack_...
     d   counter       s             10i 0 inz(1)
     d msgkey          s              4a
     d ec              ds                  likeds(qusec_t)

     d cmd             s            512a
     d len             s             15p 5

     d sendmsg         pi
     d   msg                        256a

      /free

          clear ec;
          ec.bytes_in = 256;

          msgdata_len = %len(%trim(msg));
          qmhsndpm(  msgid
                   : msgf
                   : msg
                   : msgdata_len
                   : msgtype
                   : callstack_entry
                   : callstack_counter
                   : msgkey
                   : ec );

      /end-free
     p sendmsg         e

     /* eof - isqlcpp2.rpgle */

6.5.4. Write the Server Program ISQLSVR2

Source code of ILE SQLRPG program isqlsvr2.sqlrpgle

     /*
      * @file isqlsvr.sqlrpgle
      *
      * - dequeue SQL request from USRQ ISQL2
      * - process SQL statement
      * - reply client with SQLCOD
      */
     /* to use activation group scope commitment control */
     h dftactgrp(*no) actgrp('ISQLSVR2')

     /*
      * prototype of procedure resolve_qs
      * @return boolean, *on if both the request USRQ and the reply
      *         USRQ are resolved.
      */
     d resolve_qs      pr              n

     /*
      * procedure server_client
      *
      * - dequeue SQL request from USRQ ISQL2
      * - process SQL statement
      * - reply client with SQLCOD
      *
      * @return boolean, *off if the main procedure should quit.
      */
     d serve_client    pr              n

     /*
      * procedure run_sql()
      *
      * @return SQLCOD
      */
     d run_sql         pr            10i 0
     d   the_sql                   5000a   options(*varsize)

     /* request USRQ ISQL2 */
     d request_q       s               *
     /* reply USRQ ISQLR2 */
     d reply_q         s               *
     d msg             s             26a

      /free

          // resolve request q and reply q
          if not resolve_qs();
              msg = 'Failed to resolve user queues';
              dsply '' '' msg;
              *inlr = *on;
              return;
          endif;

          // serves client
          dow serve_client();
          enddo;

          *inlr = *on;
      /end-free

     /* procedure resolve_qs() */
     p resolve_qs      b
     /* prototype of MI instruction RSLVSP */
     d rslvsp          pr                  extproc('_RSLVSP2')
     d   syp                           *
     d   option                        *   value

     d resolve_option  ds            34    qualified
     d   type                         2a   inz(x'0A02')
     d   name                        30a
     d   auth                         2a   inz(x'0000')

     d rtn             s               n

     d resolve_qs      pi              n
      /free

          rtn = *on;

          // resolve request q, reply q
          monitor;
              resolve_option.name = 'ISQL2';
              rslvsp(request_q : %addr(resolve_option));
              resolve_option.name = 'ISQLR2';
              rslvsp(reply_q : %addr(resolve_option));
          on-error;
              msg = 'Failed to resolve request user queue' +
                    ' or reply user queue';
              rtn = *off;
          endmon;

          return rtn;
      /end-free
     p resolve_qs      e

     p serve_client    b
     /* prototype of MI instruction ENQ */
     d enq             pr                  extproc('_ENQ')
     d   q                             *
     d   prefix                        *   value
     d   text                          *   value

     /* prototype of MI instruction DEQ */
     d deq             pr                  extproc('_DEQWAIT')
     d   prefix                        *   value
     d   text                          *   value
     d   q                             *

     /* enq prefix */
     d enq_prefix      ds            20    qualified
     d   text_len                    10i 0
     d   key                         16a

     /* deq prefix */
     d deq_prefix      ds            53    qualified
     d   enqueue_time                 8a
     d   timeout                      8a
     d   text_len                    10i 0
     d   acc_sts_mod                  1a   inz(x'DA')                           /* deq infinitely, key relation:'GE' */
     d   key_in                      16a
     d   key_out                     16a

     /* request data */
     d request         ds                  qualified
     d                                     based(request_ptr)
     d   sql_len                     10u 0
     d   reserved                     8a                                        /* align to 16 bytes boundary */
     d   sql_ptr                       *
     d request_ptr     s               *
     d sql_str         ds                  based(request.sql_ptr)
     d                                     qualified
     d   string                   32767a

     /* reply message to ISQLCPP2 */
     d reply           ds            16    qualified
     d   sqlcod                      10i 0

     d quit_cmd        s              4a
     d rtn             s               n
     d QUIT_CMDS       c                   'q Q qu QU quit QUITT'
     d MIN_KEY_VALUE   c                   x'00000000000000000000000000000000'  /* 16 bytes */
     d sql             s          32767a

     d serve_client    pi              n

      /free

          rtn = *on;

          // dequeue client's request from USRQ ISQL2
          deq_prefix.text_len = 16;
          deq_prefix.key_in = MIN_KEY_VALUE;
          deq(%addr(deq_prefix) : %addr(request_ptr) : request_q);

          // run sql statement
          sql = %subst(sql_str.string : 1 : request.sql_len);
          quit_cmd = %subst(sql : 1 : 4);
          if %scan(%trim(quit_cmd) : QUIT_CMDS) > 0;
              rtn = *off;
          else;
              reply.sqlcod = run_sql(sql);
          endif;

          // enqueue reply message to USRQ ISQLR2
          enq_prefix.text_len = 4;
          enq_prefix.key = deq_prefix.key_out;
          enq(reply_q : %addr(enq_prefix) : %addr(reply));

          return rtn;
      /end-free
     p serve_client    e

     p run_sql         b
     d run_sql         pi            10i 0
     d   the_sql                   5000a   options(*varsize)

     c/exec sql prepare stmt from :the_sql
     c/end-exec
     c                   if        sqlcod < 0
     c                   return    sqlcod
     c                   endif
     c/exec sql execute stmt
     c/end-exec

     c                   return    sqlcod
     p run_sql         e

     /* eof - isqlsrv2.sqlrpgle */

Compile isqlsvr2.sqlrpgle

CRTSQLRPGI OBJ(LSBIN/ISQLSVR2) SRCFILE(LS2008/DEC)
           SRCMBR(*OBJ) COMMIT(*CS)

Remarks:: Note that ISQLSVR2 uses activation group level commit control. Thus, one must set parameter COMMIT to a value other than *NONE.

6.5.5. Write CL Command RUNSQL2

Source code runsql2.cmd

/* @FILE RUNSQL2.CMD */

             CMD        PROMPT('Run SQL statement')
             PARM       KWD(SQL) TYPE(*CHAR) LEN(5000) MIN(1) +
                          VARY(*YES *INT4) INLPMTLEN(50) +
                          PROMPT('SQL statement')
             PARM       KWD(SQLCOD) TYPE(*CHAR) LEN(4) RTNVAL(*YES) +
                          MIN(1) PROMPT('SQLCOD returned')
/* EOF */

Compile CL command RUNSQL2

CRTCMD CMD(LSBIN/RUNSQL2) PGM(*LIBL/ISQLCPP2) SRCFILE(LS2008/DEC)
       ALLOW(*BPGM *IPGM *BREXX *IREXX) /* allow RUNSQL2 to be invoked
                                           from interactive or batch CL
                                           programs or REXX scripts */

6.5.6. Run ISQLSVR2 and ISQL2

Prepare an OPM CL program who makes use of CL command RUNSQL2, cl104.clp

             /* @FILE CL104.CLP */
PGM
             DCL        VAR(&SQLCOD) TYPE(*CHAR) LEN(4)
 RUN_SQL:    RUNSQL2    SQL('delete from pf16') SQLCOD(&SQLCOD) /* +
                          clear PF16 */
             RUNSQL2    SQL('insert into PF16 values(''A'', ''B'', +
                          ''C'')') SQLCOD(&SQLCOD) /* insert new +
                          records */
             IF         COND(%BIN(&SQLCOD) *LT 0) THEN(DO)
             SNDPGMMSG  MSG('SQL operations failed.') +
                          TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)
             RUNSQL2    SQL('rollback') SQLCOD(&SQLCOD) /* rollbak +
                          when insert operation failed */
             GOTO       CMDLBL(END)
             ENDDO

             RUNSQL2    SQL('commit') SQLCOD(&SQLCOD) /* commit */

 END:        ENDPGM
/* EOF - CL104.CLP */

Compile CL104

CRTCLPGM PGM(LSBIN/CL104) SRCFILE(LS2008/DEC)
         LOG(*YES)  /* enable logging of CL commands being called */

Use CL command ISQL2 and CL program CL104 to operate physical file PF16.

/* Submit the server job */
SBMJOB CMD(CALL PGM(ISQLSVR2))

/* Clear PF16 */
ISQL2 SQL('delete from pf16')
ISQL2 SQL('commit')

/* Run CL104 */
CALL CL104                                                          
   400 - RUNSQL2 SQL('delete from pf16') SQLCOD(&SQLCOD)            
SQL statement succeeded with SQLCOD 100.                            
   600 - RUNSQL2 SQL('insert into PF16 values(''A'', ''B'', ''C'')')
  SQLCOD(&SQLCOD)                                                   
SQL statement succeeded.                                            
  1700 - RUNSQL2 SQL('commit') SQLCOD(&SQLCOD)                      
SQL statement succeeded.                                            
       - RETURN        /* RETURN due to end of CL program */        

/* Notify the server job to quit */
ISQL2 SQL('qu')

Attention:: Make sure that the physical file has been journaled.

6.6. Java and i5/OS Queue objects

Java programs running on i5/OS can take advantage of i5/OS queue objects when they need to communicate with host lanuguage programs or other Java programs. IBM Toolbox for Java provides access methods of DTAQs for Java. With IBM Toolbox for Java's client version jt400.jar or its host version jt400Native.jar a Java program can access a DTAQ object either remotely from a client PC or locally on the host server. Refer to BaseDataQueue and its derived classes for details. IBM does not provide interfaces to access USRQs for Java. To access a USRQ object in Java, one will have to implement native methods which operate on USRQs on behalf of Java programs.

On i5/OS, a Java program can benifit from queue objects, the native IPC method on i5/OS from the following aspects:

Queue objects provide a flexible, easy-to-use, and efficient IPC method for Java.
Comparing with calling a host program directly (e.g. by PCML) or calling a native method, communicating through a queue object seperates the thread model and resource management model of JVM and a job running host language programs. For example, many existing host language programs are insensible of thread-safety. Calling them directly from JVM's multi-threaded environment would lead to expected exceptions.
Comparing with invoking Java methods from a host language program, communicating through a queue object can avoid starting JVM repeatedly.

Here, as an example we implement a Java version of ISQL2 which is introduced in 6.5. Pass Variable Length Data through i5/OS Queue Objects.

Components of the Java version ISQL2

Class isql
Class isql accepts a SQL statement from user input, invokes native method isqlsvr.sendRequest, which enqueues request data to USRQ ISQL2 and waits for returned SQL code on USRQ ISQLR2.
Class isqlsvr declares native method sendRequest；
Service Program(*SRVPGM) ISQLSVR
SRVPGM ISQLSVR implements native method isqlsvr.sendRequest

Steps

6.6.1. Write Java Class isql and isqlsvr

Source code of isql.java

public class isql {

    static {

        System.loadLibrary("ISQLSVR");
    }

    public static final String _usage =
        "usage info: java isql \"SQL statement to run.\"";

    public static void main(String[] args) {

        isql client = new isql();
        client.run(args);

    }

    protected void run(String[] args) {

        if(args.length < 1) {

            System.out.println(_usage);
            return;
        }

        String msg = "";
        try {

            // send request to ISQLSVR
            int sqlcod = isqlsvr.sendRequest(args[0]);

            // compose msg
            if(sqlcod < 0)
                msg = "SQL statement failed with SQLCOD " + sqlcod;
            else
                msg = "SQL statement succeeded with SQLCOD " + sqlcod;

        } catch(Exception e) {

            System.out.println(e.getMessage());
            return;
        }

        // report execuation result
        System.out.println(msg);
    }

}

/* eof - isql.java */

Source code of isqlsvr.java

public class isqlsvr {

    public
        static
        native
        synchronized
            int sendRequest(
                            String sql
                            ) throws Exception;

}

/* eof - isqlsvr.java */

Compile Java classes

/* Upload isql.java, isqlsvr.java to IFS */
/* Start a QShell session */
qsh

/* Include current directory into environment variable CLASSPATH */
export CLASSPATH=.

/* Compile java classes with javac */
javac -encoding utf-8 *java

/* Generate C header for JNI methods */
javah isqlsvr

6.6.2. Write Native Method isqlsvr.sendRequest

To implement Java native method isqlsvr.sendRequest, we write a c file isqlsvr.c which is to be compiled into a module object and then bind the module into *SRVPGM ISQLSVR.

# include <isqlsvr.h>

// libc
# include <stdlib.h>
# include <string.h>
# include <except.h>

// libmi
# include <mih/rslvsp.h>
# include <mih/enq.h>
# include <mih/genuuid.h>

// libiconv
# include <iconv.h>

// apis
# include <qusec.h>
# include <qusrjobi.h>

typedef _Packed struct _deq_prefix {

  char time_enqueued[8];
  char timeout[8];
  int text_len_returned;
  char acc_state_mod[1];
  char key_in[16];
  char key_out[16];
} deq_prefix_t;

// prototype of instruction DEQWAIT
# pragma linkage(_DEQWAIT, builtin)
void _DEQWAIT (
               deq_prefix_t *,
               void*,
               _SYSPTR*
               );

# define REQUEST_Q "ISQL2"
# define REPLY_Q   "ISQLR2"
# define UTF8_CCSID \
  "IBMCCSID012080000000\0\0\0\0\0\0\0\0\0\0\0\0"
# define ECLEN   256
# define TEXTLEN 16
# define KEYLEN  16
# define ENQ_PREFIX_LEN 20
# define DEQ_PREFIX_LEN 53

typedef _Packed struct _request {

  size_t sql_len;
  char reserved[8];
  char *sql;
} request_t;

static request_t _r;

typedef _Packed struct _reply {

  int sqlcod;
  char reserved[12];
} reply_t;

void gen_uuid(char *uuid);

int get_job_ccsid();

void
utf8_2_ebcdic (
               const char *source,
               size_t source_length,
               char *dest
               );

void enq_request(
                 _SYSPTR q,
                 const char *key,
                 const char *sql
                 );

int deq_reply(_SYSPTR q, const char* key);

int resolve_queues(
                   _SYSPTR *request_q,
                   _SYSPTR *reply_q
                   );

/*
 * implements isqlsvr.sendRequest()
 *
 * - resolve request q
 * - resolve reply q
 * - enq SQL
 */
JNIEXPORT
jint
JNICALL
Java_isqlsvr_sendRequest (
                          JNIEnv *env,
                          jclass jthis,
                          jstring jsql
                          ) {

  int r = 0;
  int sqlcod = 0;
  jclass class_exception;
  const char *utf8_sql = NULL;
  char *sql = NULL;
  jboolean is_copy = JNI_FALSE;
  size_t len = 0;
  char uuid[16] = {0};

  _SYSPTR request_q = NULL;
  _SYSPTR reply_q = NULL;

  /* resolve qs */
  if(resolve_queues(&request_q, &reply_q) != 0) {

    // raise exception and return
# pragma convert(819)
    class_exception = (*env)->FindClass(env, "java/lang/Exception");
# pragma convert(0)
    if(class_exception != 0)
      (*env)->ThrowNew(env,
                       class_exception,
                       "Failed to resolve user queues"
                       );
    return;
  }

  // convert sql to ebcdic
  utf8_sql = (*env)->GetStringUTFChars(env, jsql, &is_copy);
  len = (*env)->GetStringUTFLength(env, jsql);
  sql = malloc(len * 2 + 1);
  utf8_2_ebcdic(utf8_sql, len, sql);
  (*env)->ReleaseStringUTFChars(env, jsql, utf8_sql);

  // enq request q
  gen_uuid(uuid);
  enq_request(request_q, uuid, sql);

  // deq reply q
  sqlcod = deq_reply(reply_q, uuid);

  free(sql);
  return sqlcod;
}

void gen_uuid(char *uuid) {

  _UUID_Template_T tmpl;

  memset(&tmpl, 0, 32);
  tmpl.bytesProv = 32;
  _GENUUID(&tmpl);

  memcpy(uuid, tmpl.uuid, 16);
}

int get_job_ccsid() {

  int ccsid = 0;
  Qwc_JOBI0400_t jobi;
  Qus_EC_t *ec = NULL;

  ec = (Qus_EC_t*)malloc(ECLEN);
  memset(ec, 0, ECLEN);
  ec->Bytes_Provided = ECLEN;
  jobi.Bytes_Avail = sizeof(Qwc_JOBI0400_t);
  QUSRJOBI(
           &jobi,
           sizeof(Qwc_JOBI0400_t),
           "JOBI0400",
           "*                         ",
           "                ",
           ec
           );
  if(ec->Bytes_Available != 0)
    ccsid = 37; // ascii ccsid
  else
    ccsid = jobi.Coded_Char_Set_ID;

  free(ec);
  return ccsid;
}

void
utf8_2_ebcdic (
               const char *source,
               size_t source_length,
               char *dest
               ) {

  size_t result_length = source_length * 2;
  char host_ccsid[32 + 1] = {0};
  iconv_t cvt;

  sprintf(host_ccsid,
          "IBMCCSID%05d\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0",
          get_job_ccsid());
  cvt = iconv_open(host_ccsid, UTF8_CCSID);

  iconv(cvt,
        &source,
        &source_length,
        &dest,
        &result_length
        );

  iconv_close(cvt);
}

void enq_request(
                 _SYSPTR q,
                 const char *key,
                 char *sql
                 ) {

  _ENQ_Msg_Prefix_T *prefix;
  request_t *request = &_r;
  char text[16] = {0};

  prefix = (_ENQ_Msg_Prefix_T*)malloc(ENQ_PREFIX_LEN);
  memset(prefix, 0, ENQ_PREFIX_LEN);
  prefix->Msg_Len = TEXTLEN;
  memcpy(prefix->Msg, key, KEYLEN);

  request->sql_len = strlen(sql);
  request->sql = sql;
  memcpy(text, &request, 16);

  _ENQ(&q, prefix, text);

  free(prefix);
}

int deq_reply(_SYSPTR q, const char* key) {

  deq_prefix_t prefix;
  reply_t reply;

  prefix.acc_state_mod[0] = 0xF8; // 1111,1000; key realtion=EQ, deq infinitely
  memcpy(prefix.key_in, key, KEYLEN);

  _DEQWAIT(&prefix, &reply, &q);

  return reply.sqlcod;
}

int resolve_queues(
                   _SYSPTR *request_q,
                   _SYSPTR *reply_q
                   ) {

  int resolved = -1;
  volatile int ca = 0;

# pragma exception_handler(end, ca, _C1_OBJECT_NOT_FOUND, \
                           _C2_ALL, _CTLA_HANDLE)
  *request_q = rslvsp(0x0A02, REQUEST_Q, "", 0x0000);
  *reply_q = rslvsp(0x0A02, REPLY_Q, "", 0x0000);
  resolved = 0;

# pragma disable_handler

 end:
  return resolved;
}

/* eof - isqlsvr.c */

Create *SRVPGM ISQLSVR

/* Compile module ISQLSVR */
CRTCMOD MODULE(LSBIN/ISQLSVR) SRCSTMF(isqlsvr.c) INCDIR('.')

/* Create *SRVPGM ISQLSVR */
CRTSRVPGM LSBIN/ISQLSVR MODULE(*LIBL/ISQLSVR) EXPORT(*ALL)

6.6.3. Run Java Class isql

To run a Java program on i5/OS, one should use CL command JAVA or RUNJVA, or use QShell command java.

/* Clear physical file PF16 */
CLRPFM PF16

/* Submit the server job */
SBMJOB CMD(CALL ISQLSVR2)

/* Chnage current directory to where isql.class and
   isqlsvr.class reside in */
CHGCURDIR '/home/ljl/tmp'

/* Run java class isql */
JAVA CLASS(isql) PARM('delete from pf16')
/*
Result:
SQL statement succeeded with SQLCOD 100
Java program completed
*/

/* Execute an insert statement */
JAVA CLASS(isql) PARM('insert into pf16 values(''20081212'', ''冬天'',''Friday'')')
/*
Result:
SQL statement succeeded with SQLCOD 0
Java program completed
*/

/* Check physical file PF16 */
RUNQRY *N PF16
/*
Result:
Line   ....+....1....+....2....+....3....+.
       RQ        NAME              REMARK  
000001 20081212  冬天              Friday  
 ********  End of report  ********   
*/

Appendice

List of appendice

Appendix 1. Enqueue USRQ Q11 for 1000 times

Create USRQ Q11 of type FIFO, with entry length 64.

CALL PGM(QUSCRTUQ) PARM(
  'Q11       LSBIN'        /* queue name: LSBIN/Q11 */
  'USRQ'                   /* extended attribute    */
  'F'                      /* queue type: keyed     */
  X'00000000'              /* key length: 0         */
  X'00000040'              /* max entry length: 64  */
  X'00010000'              /* initial number of messages: 65536  */
  X'00001000'              /* extend number of messages: 4096    */
  '*EXCLUDE'               /* public authority                   */
  'FIFO USRQ: entry length = 64'  /* text description            */
)

MI program that enqueues USRQ Q11 for 1000 times, enq11.mi

dcl sysptr q auto                ; 
dcl dd message-prefix char(4) auto;
  dcl dd prefix-msglen bin(4) def(message-prefix) pos(1);

dcl dd message char(64) auto init("is usrq more faster?") ;
dcl spcptr .message auto init(message) ; 

entry * ext;

dcl dd index bin(4) auto init(0) ; 

        cpybla rslv-option-obj-type, x"0A02";
        cpyblap rslv-option-obj-name, "Q11", " ";
        rslvsp q, rslv-option-short, *, x'0000';

        /* enq */
        cpynv prefix-msglen, 64;
        cpynv index, 0          ; 
enq-loop:
        addn(s) index, 1        ;
        cmpnv(b) index, 1000 / hi(end-loop) ; 
        enq q, message-prefix, .message;

        b enq-loop              ; 
end-loop:       

        rtx *;

%include ptrres.mi              ; 

pend;

/* eof - enq11.mi */

ILE RPG program renq11.rpgle calls enq11.mi and compute time used on 1000 times of enqueue operation.

     /*
      * @file renq11.rpgle
      *
      * call PGM ENQ11 for 1000 times
      */

     d b               s               z
     d e               s               z
     d ind             s             10i 0
     d dur             s             15p 0

     c                   eval      b = %timestamp()
     c                   call      'ENQ11'
     c                   eval      e = %timestamp()
     c                   eval      dur = %diff(e : b : *ms)

     c     'microseconds'dsply                   dur
     c                   seton                                          lr
     /* eof - renq11.rpgle */

Run RENQ11 for 10 times

DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
DSPLY  microseconds              4000
/*
Result:
The average time of 10 times of execution
is 4000 micro-seconds(0.004s).
*/

Use CL command DSPQD provided by i5/OS Programmer's Toolkit to check USRQ Q11.

DSPQD Q(LSBIN/Q11) QTYPE(*USRQ)

Output of DSPQD

Current maximum number of             
  messages . . . . . . . . . :   65536
Current number of messages            
  enqueued . . . . . . . . . :   10000
Extension value  . . . . . . :   4096 
Key length . . . . . . . . . :   0    
Maximum size of message to be         
  enqueued . . . . . . . . . :   64   
Maximum number of extends  . :   35
Current number of extends  . :   0   
Initial number of messages . :   65536

The output of command DSPQD shows that after running RENQ11 for 10 times there're 10000 messages currently on Q11, and Q11 has never been extended.

Appendix 2. Enqueue DTAQ Q12(not journaled) for 1000 times

Create DTAQ Q12 of type FIFO, with entry length 64.

CRTDTAQ DTAQ(LSBIN/Q12)       /* queue name         */
        MAXLEN(64)            /* entry length: 64   */
        SEQ(*FIFO)            /* queue type: keyed  */
        SIZE(*MAX16MB 65536)  /* initial number of messages: 65536 */
        TEXT('FIFO DTAQ: entry length=64')

ILE RPG program renq12.rpgle enqueues DTAQ Q12 for 1000 times and compute time used on 1000 times of enqueue operation.

     /*
      * @file renq12.rpgle
      *
      * enqueue DTAQ Q12 for 1000 times
      */

     d b               s               z
     d e               s               z
     d ind             s             10i 0
     d dur             s             15p 0

     c                   eval      b = %timestamp()
     c                   for       ind = 1 to 1000  by 1
     c                   call      'QSNDDTAQ'
     c                   parm      'Q12'         qname            10
     c                   parm      'LSBIN'       qlib             10
     c                   parm      64            entlen            5 0
     c                   parm      *all'1'       ent              64
     c                   endfor
     c                   eval      e = %timestamp()
     c                   eval      dur = %diff(e : b : *ms)

     c     'microseconds'dsply                   dur
     c                   seton                                          lr
     /* eof */

Run RENQ12 for 10 times

DSPLY  microseconds             17000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
DSPLY  microseconds             14000
DSPLY  microseconds             15000
DSPLY  microseconds             15000
/*
Result:
The average time of 10 times of execution
is 15100 micro-seconds(0.0151s)
*/

Appendix 3. Enqueue DTAQ Q12(journaled) for 1000 times

Clear DTAQ Q12 with the QCLRDTAQ API

CALL PGM(QCLRDTAQ) PARM('Q12' 'LSBIN')

Start journaling DTAQ Q12

STRJRNOBJ OBJ(LSBIN/Q12) OBJTYPE(*DTAQ) JRN(LSBIN/JRN01)

Run RENQ12 metioned in Appendix 2. Enqueue DTAQ Q12(not journaled) for 1000 times for 10 times

DSPLY  microseconds            4066000
DSPLY  microseconds            4019000
DSPLY  microseconds            4145000
DSPLY  microseconds            4018000
DSPLY  microseconds            4007000
DSPLY  microseconds            4206000
DSPLY  microseconds            4031000
DSPLY  microseconds            4042000
DSPLY  microseconds            4023000
DSPLY  microseconds            4042000
/*
Result:
The average time of 10 times of execution
is 4059900 micro-seconds(4.0599s)
*/

Appendix 4 Possible Journal Entry Type for Journal Code Q(Data queue operation)

QB - Start data queue journaling
QC - Data queue cleared, no key
QD - Data queue deleted
QE - End data queue journaling
QI - Queue in use at abnormal end
QJ - Data queue cleared, has key
QK - Send data queue entry, has key
QL - Receive data queue entry, has key
QM - Data queue moved
QN - Data queue renamed
QR - Receive data queue entry, no key
QS - Send data queue entry, no key
QX - Start of save-while-active for data queue
QY - Data queue saved
QZ - Data queue restored
VE - Internal entry
VQ - Internal entry

Appendix 5 A Joblog Saver Program

As a complementary introduction to section 6.2. Data Queue Support on Output Queues, here we introduce a Joblog Saver program. The Joblog Saver program copies the content of a spooled file on output queue QEZJOBLOG to a physical file each time a spooled file on the output queue reaches RDY status and then delete the spooled file in order to reclaim resources such as jobs in OUTQ status.

Create DTAQ JOBLOGNTF to associated with output queue QEZJOBLOG

CRTDTAQ DTAQ(LSBIN/JOBLOGNTF)
        MAXLEN(128)           /* receive notification of type '01' */
        SIZE(*MAX2GB)
        AUTORCL(*YES)
        TEXT('i watch joblogs')

Create physical file JOBLOG

CRTPF FILE(LSBIN/JOBLOG) RCDLEN(132) IGCDTA(*YES)

Assosiate DTAQ JOBLOGNTF with output queue QEZJOBLOG

CHGOUTQ OUTQ(QEZJOBLOG) DTAQ(LSBIN/JOBLOGNTF)

Write the Joblog Saver Program
Source code of ILE RPG program savjoblog.rpgle

     /*
      * @file savjoblog.rpgle
      *
      * @remark 需要退出时，向DTAQ JOBLOGNTF入列个QUIT
      *          e.g. CALL PGM(QSNDDTAQ) PARM('JOBLOGNTF'
      *                 'LSBIN' X'00010F' 'QUIT')
      *
      */
     h dftactgrp(*no)

     /*
      * dequeue a notification message from DTAQ JOBLOGNTF
      *
      * @return *on if okey, *off if notified to quit.
      */
     d deq_notify      pr              n
     /*
      * copy joblog to PF JOBLOG;
      * delete spooled file.
      */
     d wrk_with_splf   pr

     /* Notification information */
     d notify          ds           128    qualified
     d   func_code                   10a
     d   rec_type                     2a
     d   job_id                      26a
     d   splf_name                   10a
     d   splf_num                    10i 0

      /free

          dow deq_notify();
              wrk_with_splf();
          enddo;

          *inlr = *on;
      /end-free

     /* deq_notify() */
     p deq_notify      b
     /* prototype of API QRCVDTAQ */
     d qrcvdtaq        pr                  extpgm('QRCVDTAQ')
     d   qname                       10a
     d   qlib                        10a
     d   qentrylen                    5p 0
     d   qentry                     128a
     d   timeout                      5p 0

     d qname           s             10a   inz('JOBLOGNTF')
     d qlib            s             10a   inz('LSBIN')
     d qentrylen       s              5p 0 inz(128)
     d timeout         s              5p 0 inz(-1)
     d quit            c                   'QUIT'

     d deq_notify      pi              n

      /free

          qrcvdtaq( qname
                   : qlib
                   : qentrylen
                   : notify
                   : timeout );

          if %subst(notify.func_code : 1 : 4) = quit;
              return *off;
          endif;

          return *on;
      /end-free
     p deq_notify      e

     p wrk_with_splf   b
     /* prototype of API QCMDEXC */
     d qcmdexc         pr                  extpgm('QCMDEXC')
     d   cmdstr                     128    options(*varsize)
     d   cmdlen                      15p 5

     d cmd             s            128a
     d len             s             15p 5
     d jid             s             28a

      /free

          jid = %subst(notify.job_id:21:6)
                + '/'
                + %trim(%subst(notify.job_id:11:10))
                + '/'
                + %trim(%subst(notify.job_id: 1:10));

          monitor;

          // copy spooled file to PF JOBLOG
          cmd = 'CPYSPLF FILE('
                + %trim(notify.splf_name)
                + ') TOFILE(LSBIN/JOBLOG) JOB('
                + %trim(jid)
                + ') SPLNBR('
                + %char(notify.splf_num)
                + ') MBROPT(*ADD)';
          len = %len(%trim(cmd));
          qcmdexc(cmd : len);

          // delete spooled file
          cmd = 'DLTSPLF FILE('
                + %trim(notify.splf_name)
                + ') JOB('
                + %trim(jid)
                + ') SPLNBR('
                + %char(notify.splf_num)
                + ') ';
          len = %len(%trim(cmd));
          qcmdexc(cmd : len);

          on-error;
          endmon;

      /end-free
     p wrk_with_splf   e
     /* eof */

Test the Joblog Saver Program
Submit the Joblog Saver job

SBMJOB CMD(CALL PGM(LSBIN/SAVJOBLOG)) JOB(JOBLOGSVR)

Make a spooled file on output queue QEZJOBLOG.

SBMJOB CMD(DLYJOB DLY(3)) JOB(MAKEJOBLOG) LOG(*JOBD *JOBD *SECLVL)

Check physical file JOBLOG

RUNQRY *N JOBLOG
/* Contents of physical file JOBLOG */
  5722SS1 V5R2M0 020719                           Job Log                             810      09/05/19 14:24:35          Page    1
   Job name . . . . . . . . . . :   MAKEJOBLOG      User  . . . . . . :   LJL          Number . . . . . . . . . . . :   254693
   Job description  . . . . . . :   LJL_DAILY       Library . . . . . :   QGPL
 MSGID      TYPE                    SEV  DATE      TIME             FROM PGM     LIBRARY     INST     TO PGM      LIBRARY     INST
 CPF1124    Information             00   09/05/19  14:24:32.615208  QWTPIIPP     QSYS        05D4     *EXT                    *N
                                      Message . . . . :   Job 254693/LJL/MAKEJOBLOG started on 09/05/19 at 14:24:32
                                        in subsystem QBATCH in QSYS. Job entered system on 09/05/19 at 14:24:32.
 CPI1125    Information             00   09/05/19  14:24:32.619792  QWTPCRJA     QSYS        0108     *EXT                    *N
                                      Message . . . . :   Job 254693/LJL/MAKEJOBLOG submitted.
                                      Cause . . . . . :   Job 254693/LJL/MAKEJOBLOG submitted to job queue QBATCH in
                                        QGPL from job 254687/LJL/GREENTEA. Job 254693/LJL/MAKEJOBLOG was started
                                        using the Submit Job (SBMJOB) command with the following job attributes:
                                        JOBPTY(5) OUTPTY(5) PRTTXT() RTGDTA(QCMDB) SYSLIBL(QSYS       QSYS2
                                        QHLPSYS    QUSRSYS) CURLIB(LSBIN) INLLIBL(QGPL       QTEMP      LSBIN
                                        LJLCP      ATS        XTXRUN     MN         I5TOOLKIT) LOG(4 00 *SECLVL)
/* .... ... */

Notify the Joblog Saver job to quit.

CALL PGM(QSNDDTAQ) PARM('JOBLOGNTF' 'LSBIN' X'00010F' 'QUIT')

Appendix 6 Reference

Object APIs
Machine interface programming
The open source project i5/OS Programmer's Toolkit maintains queue tools such as DSPQD and DSPQMSG. For documents and articles of the project, please refer to the project homepage.

About the Author

Hi, i'm Junlei Li(李君磊) from Tianjin, China. Strictly speaking, i am a new comer to i5/OS or OS/400 with only 3 or 4 years of experience of programming on this platform. I cannot say for sure i like this OS or not, but there is one thing i never doubted that this OS is designed to be so sophisticated and with many design concepts ahead of the times.

In the open source project i5/OS Programmer's Toolkit i maintain, more than a half of the source code is written in MI. I have to appreciate Mr. Leif Svalgaard for his excellent articles about MI programming on midrange.com.

Other useful web sites for me include:

I'm available at junleili-cn@users.sourceforge.net. Any comments and suggestions are always welcome :)

	External Object Type	MI Object Type/Subtype
Data Queue	*DTAQ	hex 0A01
User Queue	*USRQ	hex 0A02

Number	Time enqueued	Message Text
1	2009-05-18-11.27.58.619412	'AAAAAAAAAA'
2	2009-05-18-11.28.23.033237	'BBBBBBB CCCCCCC'

Offset	Parameter Name	Data Type	Meaning
0	SQL statement	char(256)	SQL statement string
256	-- end --