× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  1.  Home
  2. RPG400-L
  3. January 2005

Re: Procedures and end-of-job

Hi Martin,

Below is a snip of the relevant code.

In this program I register a subprocedure to always be called when an activation group ends - I then copy any data left in my QTEMP file to error files - so I don't lose any temporary data of a job ends abnormaly. I've got EXPORT on my subproc - you don't need it as it's called via a procedure pointer (but I didn't know that then). Note - it's not the complete program, but it should have everything you need. I have this running in production - and it works really well. You can even find out how the actgrp ends, and you can trap errors or escalate them up a level. You can also register more than one subproc - they are called in reverse order (I think). Really, really nice APIs.

HTH.

Larry Ducie

* Prototype for Activation Group Exit Procedure registration...
D rg_AGEP         pr                  Extproc('CEE4RAGE')
D   procedure                     *   procptr const
D   rc                          12a   options(*omit)

* Prototype for decompose of Condition Token...
D decompCond      pr                  Extproc('CEEDCOD')
D  ufcInp                       12a   const
D  umsgSev                      10i 0
D  umsgNo                       10i 0
D  ucase                        10i 0
D  useverity                    10i 0
D  ucontrol                      2a
D  ufacilityID                   3a
D  uisInfo                       4a
D  ufcOut                       12a   options(*omit)

* Prototype for Activation Group Exit Procedure...
D proc_AGEP       pr
D   uAgMark                     10U 0 options(*nopass)
D   uReason                     10U 0 options(*nopass)
D   uResult                     10U 0 options(*nopass)
D   uUserRC                     10U 0 options(*nopass)

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

* Data-structure ove std CEE-type API feedback condition token...
D FeedBack        ds            12
D  sev                           5u 0
D  msgnbr                        5u 0
D  flags                         1a
D  facid                         3a
D  isi                          10u 0

* Program variables...
D msgSev          s             10i 0
D msgNo           s             10i 0
D case            s             10i 0
D severity        s             10i 0
D control         s              2a
D facilityID      s              3a
D isInfo          s              4a
*****************************************************************
* Register Activation Group Exit Procedure...
C                   Callp     rg_AGEP(%paddr(proc_AGEP):feedback)

* Decompose condition token (informational - for use in debug)...
C                   Callp     decompCond(feedback:
C                                        msgSev:
C                                        msgNo:
C                                        case:
C                                        severity:
C                                        control:
C                                        facilityID:
C                                        isInfo:
C                                        *omit)

*****************************************************************
* proc_AGEP(): This is called automatically when the activation
* group ends.
*****************************************************************
*
* parms for this procedure call:
*
* uAgMark - The AG group mark that uniquely identifies the AG.
*
* uReason - The reason for the activation group being ended.
* Bits 0 Reserved
* Bits 1 Call stack entry is cancelled because an exception message was sent.
* Bits 2-15 Reserved.
* Bit 16 End type: 0 - normal end 1 - abnormal end.
* Bit 17 Activation Group is ending.
* Bit 18 Initiated by the Reclaim Activation Group (RCLACTGRP) command.
* Bit 19 Initiated as a result of the job ending.
* Bit 20 Initiated by an exit verb, for example exit() in C, or t
* Bit 21 Initiated by an unhandled function check.
* Bit 22 Call stack entry cancelled because of an out-of-scope
* jump, for example longjmp() in C.
* Bits 23-31 Reserved (0).
*
* uResult - Action to be taken - specified by prev AGEP.
* 00 = No Action: No action to be taken.
* 10 = Recover: Prev AGEP recovered from 20 or 21.
* 20 = Failure: Send CEE9901 to caller and call nxt AGE
* 21 = Failure Send CEE9901 to caller and stop.
*
* uUserRC - This is the user_rc output from prev AGEP.
*
*****************************************************************
P proc_AGEP B export
D proc_AGEP PI
D uAgMark 10U 0 options(*nopass)
D uReason 10U 0 options(*nopass)
D uResult 10U 0 options(*nopass)
D uUserRC 10U 0 options(*nopass)
*****************************************************************
D QCMDEXC PR ExtPgm('QCMDEXC')
D cmd 200A const
D length 15P 5 const
*****************************************************************
* Copy data from temporary files to error files...
C monitor

* OUTPKTHDR...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/PKTHDR)
C                                        'TOFILE(*LIBL/OUTPKTHDRE)
C                                        'MBROPT(*ADD)': 200)

* OUTPKTDTL...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/PKTDTL)
C                                        'TOFILE(*LIBL/OUTPKTDTLE)
C                                        'MBROPT(*ADD)': 200)

* OUTCTNHDR...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/CTNHDR)
C                                        'TOFILE(*LIBL/OUTCTNHDRE)
* OUTCTNDTL...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/CTNDTL)
C                                        'TOFILE(*LIBL/OUTCTNDTLE)
C                                        'MBROPT(*ADD)': 200)

* OUTCTNSRL...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/CTNSRL)
C                                        'TOFILE(*LIBL/OUTCTNSRLE)
C                                        'MBROPT(*ADD)': 200)

* OUTCTNTRK...
C                   callp     QCMDEXC('CPYF FROMFILE(QTEMP/CTNTRK)
C                                        'TOFILE(*LIBL/OUTCTNTRKE)
C                                        'MBROPT(*ADD)': 200)

C                   on-error
C                   endmon

* Allow the activation group to end normally...
C                   Eval      uResult = 0

*****************************************************************
P                 E
*****************************************************************



As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.