|
midrange.com
This is long and a bit rambling, but please stick with me on this...
I guess my decision on just reclaiming the activation group started as a
holdover OPM behavior... turning-on or not turning-on *INLR upon RETURN to save
or clear-out the variables from the prior program CALL.
On doing a clear and reload of the XRefCache instead of the RCLACTGRP... it is
a bit more involved for me. In addition to loading my values into a multi-occur
DS, about 10% of the entries contain pointers to large strings I've ALLOCated.
Therefore, to start clean, I believe I'd have to DEALLOCate the storage.
(My rationaliztion is that the reclaim AG ensures I dont have a memory leak --
I'm certain to have given it all back; although, deep down, its arguabley
lazyness.)
Anyway, to be certain my MCH error is not sloppy pointer work in my XRefCache
service program, I've created a service program and testing program that do not
play with pointers. The code is at the end of this email.
Service program JJSPX - ITMX AG
Unit Testing progam JJSPXUT - QILE AG
Hopfully, my email program will not mangle the code formatting.
Below is the copy/paste output from running the JJSPXUT test...
call jjspxut
DSPLY Added by AddItmX:
DSPLY ... Index: 1
DSPLY ItmKey: TWO
DSPLY ItmVal: 2
DSPLY ItmText: Text for TWO value 2
DSPLY Added by AddItmX:
DSPLY ... Index: 2
DSPLY ItmKey: FOUR
DSPLY ItmVal: 4
DSPLY ItmText: Text for FOUR value 4
DSPLY Added by AddItmX:
DSPLY ... Index: 3
DSPLY ItmKey: SIX
DSPLY ItmVal: 6
DSPLY ItmText: Text for SIX value 6
DSPLY Added by AddItmX:
DSPLY ... Index: 4
DSPLY ItmKey: EIGHT
DSPLY ItmVal: 8
DSPLY ItmText: Text for EIGHT value 8
DSPLY ...gItmXDS now contains:
DSPLY ... Index: 1
DSPLY ItmKey: TWO
DSPLY ItmVal: 2
DSPLY ItmText: Text for TWO value 2
DSPLY ... Index: 2
DSPLY ItmKey: FOUR
DSPLY ItmVal: 4
DSPLY ItmText: Text for FOUR value 4
DSPLY ... Index: 3
DSPLY ItmKey: SIX
DSPLY ItmVal: 6
DSPLY ItmText: Text for SIX value 6
DSPLY ... Index: 4
DSPLY ItmKey: EIGHT
DSPLY ItmVal: 8
DSPLY ItmText: Text for EIGHT value 8
DSPLY * Reclaiming ITMX AG now *
Tried to refer to all or part of an object that no longer exists.
The call to ADDITMX ended in error (C G D F).
IF THIS SOURCE DOES GET MANGLED, SEND ME AN EMAIL DIRECTLY AND I SEND THE
SOURCE AS A NOTEPAD ATTACHMENT.
***BEGIN SOURCE MEMBER JJSPX***
*********************************************************
* jerryjewel@email.com
* Better living through fine code and hot coffee!
*
* JJSPX service program - ITMX AG
*
* To Create:
* CRTRPGMOD MODULE(lib/JJSPX)
* SRCFILE(QRPGLESRC)
* DBGVIEW(*LIST)
* CRTSRVPGM SRVPGM(lib/JJSPX)
* EXPORT(*ALL)
* TEXT('JJSPX service program - ITMX AG')
* ACTGRP(ITMX)
*********************************************************
H NOMAIN
H OPTION(*SRCSTMT)
H INDENT('| ')
* GLOBAL CONSTANTS
D MAX_ITM_X C 50
* OTHER GLOBAL VARIABLES
D gCurItmIndex S 9P 0
D gItmCount S 9P 0
D gMsg S 52A
D gItmXDS DS OCCURS(MAX_ITM_X) INZ
D gItmKey 10A
D gItmVal 9S 0
D gItmText 30A
* EXPORTED PROCEDURE PROTOTYPES
D AddItmX PR
D iItmKey 10A CONST
D iItmVal 9S 0 CONST
D DspAllItmX PR
D RclItmXActGrp PR
* LOCAL PROCEDURE PROTOTYPES
D DspCurItmX PR
* EXPORTED PROCEDURES
* ----------------
P AddItmX B EXPORT
D AddItmX PI
D iItmKey 10A CONST
D iItmVal 9S 0 CONST
C IF gItmCount >= MAX_ITM_X
C EVAL gMsg = 'Full! Cannot add any more!'
C gMsg DSPLY
C RETURN
C ENDIF
C EVAL gItmCount = gItmCount + 1
C EVAL gCurItmIndex = gItmCount
C gCurItmIndex OCCUR gItmXDS
C EVAL gItmKey = iItmKey
C EVAL gItmVal = iItmVal
C EVAL gItmText = 'Text for '
C + %TRIM(iItmKey)
C + ' value '
C + %CHAR(iItmVal)
C EVAL gMsg = 'Added by AddItmX:'
C gMsg DSPLY
C CALLP DspCurItmX()
P AddItmX E
* ----------------
* ----------------
P DspAllItmX B EXPORT
D DspAllItmX PI
C IF gItmCount < 1
C EVAL gMsg = 'Empty! Nothing to display!'
C gMsg DSPLY
C RETURN
C ENDIF
C EVAL gMsg = '...gItmXDS now contains:'
C gMsg DSPLY
C FOR gCurItmIndex = 1 BY 1 TO gItmCount
C gCurItmIndex OCCUR gItmXDS
C CALLP DspCurItmX
C ENDFOR
P DspAllItmX E
* ----------------
* ----------------
P RclItmXActGrp B EXPORT
D RclItmXActGrp PI
C EVAL gMsg = '* Reclaiming ITMX AG now *'
C gMsg DSPLY
C CALLB 'CEETREC'
C PARM *OMIT
C PARM *OMIT
C RETURN
P RclItmXActGrp E
* ----------------
* LOCAL PROCEDURES
* ----------------
P DspCurItmX B
D DspCurItmX PI
C EVAL gMsg = '... Index: '
C + %CHAR(gCurItmIndex)
C gMsg DSPLY
C EVAL gMsg = ' ItmKey: ' + gItmKey
C gMsg DSPLY
C EVAL gMsg = ' ItmVal: ' + %CHAR(gItmVal)
C gMsg DSPLY
C EVAL gMsg = ' ItmText: ' + gItmText
C gMsg DSPLY
P DspCurItmX E
* ----------------
***END SOURCE MEMBER JJSPX***
***BEGIN SOURCE MEMBER JJSPXUT***
*********************************************************
* jerryjewel@email.com
* Better living through fine code and hot coffee!
*
* JJSPXUT - JJSPX *SRVPGM Unit Testing - AG QILE
*
* To Create:
* CRTRPGMOD MODULE(lib/JJSPXUT)
* SRCFILE(QRPGLESRC)
* DBGVIEW(*LIST)
* CRTPGM PGM(lib/JJSPXUT)
* TEXT('JJSPX *SRVPGM Unit Testing - AG QILE')
* BNDSRVPGM(JJSPX)
* ACTGRP(QILE)
*********************************************************
H OPTION(*SRCSTMT)
H INDENT('| ')
* PROCEDURE PROTOTYPES FOR EXTERNAL PROCEDURES
D AddItmX PR
D iItmKey 10A CONST
D iItmVal 9S 0 CONST
D DspAllItmX PR
D RclItmXActGrp PR
C CALLP AddItmX('TWO':2)
C CALLP AddItmX('FOUR':4)
C CALLP AddItmX('SIX':6)
C CALLP AddItmX('EIGHT':8)
C CALLP DspAllItmX()
C CALLP RclItmXActGrp()
C CALLP AddItmX('ONE':1)
C CALLP AddItmX('TWO':2)
C CALLP AddItmX('THREE':3)
C CALLP AddItmX('FOUR':4)
C CALLP DspAllItmX()
C EVAL *INLR = *ON
***END SOURCE MEMBER JJSPXUT***
--
__________________________________________________________
Sign-up for your own FREE Personalized E-mail at Mail.com
http://www.mail.com/?sr=signup
"Free price comparison tool gives you the best prices and cash back!"
http://www.bestbuyfinder.com/download.htm
As an Amazon Associate we earn from qualifying purchases.
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.
