ENQUEUE program =============== 001.00 H COPYRIGHT('iPerformance ApS, Denmark, 2008-2024') 002.00 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 003.00 * Programs ENQUEUE and DEQUEUE shows how to send transactions from one * 004.00 * job via a User Queue for asyncroneous process by another job. * 005.00 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 006.00 * To test programs ENQUEUE and DEQUEUE: Compile both programs into * 007.00 * GIAPALIB and call program ENQUEUE. See result in spool file(s). * 008.00 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 009.00 010.00 HOPTION(*SRCSTMT : *NODEBUGIO) 011.00 H DFTACTGRP( *NO ) DEBUG DATEDIT(*YMD) BndDir( 'QC2LE' ) 012.00 013.00 * This program writes in a loop 300 transactions (called "messages") to a User Queue. 014.00 * At run start the *USRQ QGPL/TEST_USRQ is created, and a job named DEQUEUE, which will 015.00 * read and print the transactions, is submitted. 016.00 * Each transaction contains a time stamp, a sequence number, and a text constant. 017.00 * A wait time of 0.2 second is used after each dequeue to simulate the time a normal 018.00 * transaction takes. Without wait time the transactions are generated so fast 019.00 * that the dequeue program listing the transactions cannot keep up. 020.00 * If a dequeue delay causes more than 5 transactions to be waiting on the queue then 021.00 * an additional dequeue job is submitted. 022.00 * A special end-of-run transaction for each submitted DEQ-job will be sent at run end, 023.00 * causing the receiving DEQUEUE job to terminate. 024.00 * The result of the run can obviously be seen by looking at the generated print output. 025.00 026.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 027.00 * Prototype for for the System() function to run a CL command 028.00 D System PR 10I 0 extProc('system') 029.00 D CmdString * Value Options(*String) 030.00 031.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 032.00 * Prototype for MI-funtion to delay job a number of microseconds 033.00 D Delayjob PR ExtProc('_WAITTIME') 034.00 D 16A Waittime template 035.00 036.00 D DS Def. of template 037.00 D WaitTemplate 16 Inz( 038.00 D X'00000000F42400000000000000000000') = Wait 1 second 039.00 D WaitTempl4_7 10U 0 Overlay(Waittemplate:4) 040.00 * In field WaitTempl4_7 corresponds 1 microsecond to the value 16. Examples: 041.00 * Wait 0.1 second = 100000 microsec. = value must be 1600000 = X'00186A00' 042.00 * Wait 0.2 second = 200000 microsec. = value must be 3200000 = X'0030D400' 043.00 * Wait 1.0 seconds = 1000000 microsec. = value must be 16000000 = X'00F42400' 044.00 * Wait 4.7 seconds = 4700000 microsec. = value must be 75200000 = X'047B7600' 045.00 * Waittime formula for seconds: value in WaitTempl4_7 = seconds * 16.000.000 . 046.00 047.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 048.00 * Prototype for Resolve System Pointer to *USRQ 049.00 D RslvSP PR * ProcPtr ExtProc('rslvsp') Return value is ptr. 050.00 D 2A Value Object Type 051.00 D * Value Options(*String) Object Name 052.00 D * Value Options(*String) Library 053.00 D 2A Value Authority (ignored) 054.00 055.00 D Ptr_UsrQ S * ProcPtr Syst.pointer to UsrQ 056.00 057.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 058.00 * Prototype for Enqueue (Write "message" = record / transaction to user queue) 059.00 D Enqueue PR ExtProc('_ENQ') 060.00 D * ProcPtr SysPtr to UserQueue 061.00 D 10U 0 Const Message prefix 062.00 D 97A Message text 063.00 064.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 065.00 * Definition of the "transaction" = test-records sent to the user queue 066.00 D DS User Queue entry 067.00 D QueueEntry 1 97 068.00 D TimeStamp 1 26Z 069.00 D EnqSeqNbr 27 31S 0 Inz(1) 070.00 D NbrOfDeqJobs 32 36S 0 Inz(1) 071.00 D MsgText1 37 62 Inz('ABCDEFGHIJKLMNOPQRSTUVWXYZ') 072.00 D MsgText2 63 88 Inz('abcdefghijklmnopqrstuvwxyz') 073.00 D MsgText3 89 97 Inz('etc. etc.') 074.00 075.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 076.00 * Prototype for MI-instruction MATQAT (Materialize Queue Attributes) 077.00 D GetUserqAttr PR ExtProc('_MATQAT') 078.00 D 128A Message text 079.00 D * ProcPtr SysPtr to UserQueue 80.00 81.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 82.00 * Definition of (some of) the queue attributes fields received from the MATQAT instruction 83.00 D DS *USRQ attributes 84.00 D QueueAttrib 1 128 85.00 D BytesProvided 1 4I 0 Inz(128) 86.00 D CurrNbrEntr 102 105I 0 Inz(0) Curr nbr of entries 87.00 88.00 * =========================================================================================== 89.00 * Program initialization 90.00 C CallP System('GIAPALIB/GIAPA030 ' + Create User Queue 91.00 C 'USRQ(QGPL/TEST_USRQ) ' + 92.00 C 'MAXLENGTH(97) ' + 93.00 C 'TEXT(''Test of ENQUEUE and ' + 94.00 C 'DEQUEUE RPGLE programs'')') 95.00 96.00 C Eval Ptr_UsrQ = RslvSP ( X'0A02' : Set pointer to UsrQ 97.00 C 'TEST_USRQ ' : 'QGPL ' : X'0000' ) 98.00 99.00 C CallP System('SBMJOB DEQUEUE JOBQ(QCTL) ' + Submit dequeue job 100.00 C 'CMD(CALL GIAPALIB/DEQUEUE)') 101.00 C CallP Delayjob(WaitTemplate) Wait 1 second 102.00 103.00 C Eval WaitTempl4_7 = 3200000 Set wait template 104.00 * to 0.2 second 105.00 106.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 107.00 C MainLoop Tag 108.00 * Get timestamp, send transaction to queue 109.00 C Time TimeStamp 110.00 C CallP Enqueue(Ptr_UsrQ : X'00000061' : X'61'=97 EntryLength 111.00 C QueueEntry) 112.00 C Eval EnqSeqNbr += 1 113.00 114.00 * For the first 9 transactions there is no wait time in between the enqueued transactions. 115.00 * The DEQUEUE job cannot print the transactions equally fast, so they will queue up on 116.00 * the user queue and cause a second DEQUEUE job to be started. 117.00 * From transaction number 10 there is a wait of 0.2 seconds between enqueues, after which 118.00 * no more DEQUEUE jobs need to be started. 119.00 120.00 C EnqSeqNbr IfGT 9 121.00 C CallP Delayjob(WaitTemplate) Wait 0.2 seconds 122.00 C EndIf 123.00 124.00 * Retrieve queue attributes (in order to get number of transaction waiting on the queue) 125.00 C CallP GetUserqAttr(QueueAttrib : Ptr_UsrQ) 126.00 127.00 * If more than 5 transactions are waiting, submit additional dequeue job 128.00 C If CurrNbrEntr > 5 129.00 C CallP System('SBMJOB DEQUEUE JOBQ(QCTL) ' + Submit dequeue job 130.00 C 'CMD(CALL GIAPALIB/DEQUEUE)') 131.00 C Eval NbrOfDeqJobs += 1 132.00 C EndIf 133.00 134.00 * Loop until wanted number of transactions are generated - then enqueue one End-of-run message 135.00 * for each DEQUEUE job started. The End-of-run transactions causes the DEQUEUE jobs to end. 136.00 C EnqSeqNbr CABLT 300 Mainloop 137.00 138.00 C Eval EnqSeqNbr = 99999 139.00 C Eval MsgText1 = 'End-of-run' 140.00 141.00 C SendEndMsg Tag 142.00 C CallP Enqueue(Ptr_UsrQ : X'00000061' : 143.00 C QueueEntry) 144.00 C Eval NbrOfDeqJobs -= 1 145.00 C NbrOfDeqJobs CABGE 1 SendEndMsg 146.00 147.00 * Wait a few seconds to ensure that all transactions were processed by the receiving 148.00 * DEQUEUE job, then delete the user queue and stop run. 149.00 C Eval WaitTempl4_7 = 75200000 Set wait to 4.7 sec. 150.00 C CallP Delayjob(WaitTemplate) Wait 151.00 C CallP System('DLTUSRQ USRQ(QGPL/TEST_USRQ)') Delete User Queue 152.00 153.00 C Eval *INLR = '1' 154.00 C Return ****************************************************************************************************** DEQUEUE Program =============== 001.00 H COPYRIGHT('iPerformance ApS, Denmark, 2008-2024') 002.00 HOPTION(*SRCSTMT : *NODEBUGIO) 003.00 H DFTACTGRP( *NO ) DEBUG DATEDIT(*YMD) BndDir( 'QC2LE' ) 004.00 FQSYSPRT O F 132 PRINTER OFLIND(*INOF) 005.00 006.00 * SEE COMPLETE INSTRUCTIONS FOR TESTING IN SOURCE MEMBER "ENQUEUE". 007.00 008.00 * This program reads and prints transactions (called "messages") from 009.00 * *USRQ QGPL/TEST_USRQ. 010.00 * The program returns when "End-of-run" is received in the message text. 011.00 012.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 013.00 * Prototype for for the System() function to run a CL command 014.00 D System PR 10I 0 extProc('system') 015.00 D CmdString * Value Options(*String) 016.00 017.00 D Ptr_UsrQ S * ProcPtr Syst.pointer to UsrQ 018.00 019.00 D* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 020.00 * Prototype for Resolve System Pointer to *USRQ 021.00 D RslvSP PR * ProcPtr ExtProc('rslvsp') Return value is ptr. 022.00 D 2A Value Object Type 023.00 D * Value Options(*String) Object Name 024.00 D * Value Options(*String) Library 025.00 D 2A Value Authority (ignored) 026.00 027.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 028.00 * Prototype for Dequeue (Read "message" = record / transaction from user queue) 029.00 D Dequeue PR ExtProc('_DEQWAIT') 030.00 D 21A Message prefix 031.00 D 97A Message text 032.00 D * ProcPtr SysPtr to UserQueue 033.00 034.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 035.00 * "Message prefix" --> parameters to the dequeue function 036.00 D DS Prefix 037.00 D MsgPrefix 1 21 038.00 D EnqueueTime 1 8 039.00 D DeqWaitTime 9 16 040.00 D DeqMsgSize 17 20I 0 041.00 D DeqOptions 21 21 Inz(X'10') = Wait indefinitely 042.00 043.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 044.00 D DS User Queue entry 045.00 D QueueEntry 1 97 046.00 D EnqTimeStamp 1 26Z 047.00 D EnqSeqNbr 27 31S 0 Inz(0) 048.00 D NbrOfDeqJobs 32 36S 0 Inz(1) 049.00 D MsgText1 37 62 Inz('ABCDEFGHIJKLMNOPQRSTUVWXYZ') 050.00 D MsgText2 63 88 Inz('abcdefghijklmnopqrstuvwxyz') 051.00 D MsgText3 89 97 Inz('etc. etc.') 052.00 053.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 054.00 D DeqTimeStamp S Z 055.00 056.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 057.00 * Program initialization 058.00 C Eval *InOf = *On 059.00 C Eval Ptr_UsrQ = RslvSP ( X'0A02' : 060.00 C 'TEST_USRQ ' : 'QGPL ' : X'0000' ) 061.00 C CallP System('CHGJOB RUNPTY(17)') 062.00 063.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 064.00 C MainLoop Tag 065.00 * Dequeue transaction from UserQ, print transaction and timestamp for dequeueing. 066.00 C CallP Dequeue(MsgPrefix : QueueEntry : 067.00 C Ptr_UsrQ) 068.00 C Time DeqTimeStamp 069.00 C EXCEPT 070.00 071.00 * Terminate run if end message retrieved fom queue. 072.00 C MsgText1 CABNE 'End-of-run' MainLoop 073.00 074.00 C Eval *INLR = '1' 075.00 C Return 076.00 077.00 * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 078.00 * Print transaction and dequeue time stamp. 079.00 OQSYSPRT H OF 2 1 080.00 O 25 'Timestamp for enqueue' 081.00 O 52 'Timestamp for dequeue' 082.00 O 61 'Trans' 083.00 O 68 'Nbr.of' 084.00 O 95 ' Text constant contents' 085.00 O 126 'Page' 086.00 O PAGE Z 130 087.00 OQSYSPRT H OF 1 088.00 O 27 '--------------------------' 089.00 O 54 '--------------------------' 090.00 O 61 'SeqNo' 091.00 O 69 'DeqJobs' 092.00 OQSYSPRT EF 1 093.00 O EnqTimeStamp 27 094.00 O DeqTimeStamp 54 095.00 O EnqSeqNbr Z 60 096.00 O NbrOfDeqJobs Z 65 097.00 O MsgText1 93 098.00 O MsgText2 119 099.00 O MsgText3 129