Is there a way to retrive the allocated memory size by a pointer in RPGLE?
Memory is allocated with %ALLOC() bif.
I would take the following approach. Build a dynamic array service program that contains the necessary sub-procedures to process a dynamic array. Functions like:
The caller would know the size of the elements, but you can use varchar and options(*varying) to allow the sub-procedure to determine the length of the element being loaded, or if you would be loading data structures, you could use opdesc. Specifying `opdesc' is entirely transparent to the caller, it would be specified in the prototype, so the caller doesn't even have to know about it. The sub-procedure can then use a system API to interrogate the operational descriptor. I believe it is a CEE API, you can look that up. To hold the array, you can use a user space. The nice thing about them is you don't have to reallocate when you space is full, it expands automatically up to 16Mb.
Or you could use a pointerr to the user space to back the based array. Ted Holt has examples of doing what you are looking for here. http://www.itjungle.com/fhg/fhg051006-story02.html
Here is my sub-procedure to create an auto-extending user space and return a pointer to it.
// Standard Error Code Format
dcl-ds ErrorCdType1_t Qualified Template Inz;
BytesProv Int(10) Inz(%size(ErrorCdType1_t));
BytesAvail Int(10);
MsgId Char(7);
Data Char(1024) Pos(17);
end-ds;
// Qualified Name
dcl-s Name_t Char(10) Template Inz('');
dcl-ds QualName_t Qualified Template Inz;
Name Like(Name_t) Inz('');
Lib Like(Name_t) Inz('*LIBL');
end-ds;
// =====================================================================
// User Space APIs
// =====================================================================
// Create User Space
dcl-pr CreateUs;
UserSpace LikeDs(QualName_t) Const;
Description Char(50) Const;
ReturnPtr Pointer;
ErrorCd LikeDs(ErrorCdType1_t)
Options(*NoPass);
end-pr;
dcl-pr quscrtus ExtPgm('QUSCRTUS');
UserSpace LikeDs(QualName_t) Const;
ExtAttribute Char(10) Const;
InitialSize Int(10) Const;
InitialValue Char(1) Const;
PublicAuthority Char(10) Const;
TextDescription Char(50) Const;
Replace Char(10) Const Options(*NoPass);
ErrorCd LikeDs(ErrorCdType1_t)
Options(*NoPass);
Domain Char(10) Const Options(*NoPass);
XferSizeReq Int(10) Const Options(*NoPass);
OptimumSpaceAlign Char(1) Const Options(*NoPass);
end-pr;
// Return Pointer to User Space
dcl-pr qusptrus ExtPgm('QUSPTRUS');
UserSpace LikeDs(QualName_t) Const;
ReturnPtr Pointer;
ErrorCd LikeDs(ErrorCdType1_t)
Options(*NoPass);
end-pr;
// Change User Space Attributes
dcl-pr quscusat ExtPgm('QUSCUSAT');
ReturnedLib Char(10);
UserSpace LikeDs(QualName_t) Const;
Attribs LikeDs(us_Attributes_t) Const;
Error LikeDs(ErrorCdType1_t);
end-pr;
// ----- Data Structures -------
dcl-ds us_VariableLengthRec_t Qualified Template Inz;
key Int(10) Inz(0);
datalen Int(10) Inz(0);
data Int(10);
charData Char(1) Overlay(data);
end-ds;
dcl-ds us_Attributes_t Qualified Template Inz;
numRec Int(10) Inz(0);
vlRecs LikeDs(us_VariableLengthRec_t) Dim(5)
Inz(*LikeDs);
end-ds;
// ----- Constants -------------
// Variable Length Record Key
dcl-c USATR_AUTO_EXTEND 3; // data Char(1) *On or *Off
// -----------------------------
// Create an automatically extendable user space
// -----------------------------
dcl-proc CreateUs Export;
dcl-pi *n;
UserSpace LikeDs(QualName_t) Const;
Description Char(50) Const;
ReturnPtr Pointer;
ErrorCd LikeDs(ErrorCdType1_t)
Options(*NoPass);
end-pi;
dcl-ds ercd LikeDs(ErrorCdType1_t) Inz(*LikeDs);
dcl-ds usatr LikeDs(us_Attributes_t) Inz(*LikeDs);
dcl-ds MsgFile LikeDs(QualName_t) Inz(*LikeDs);
dcl-s Lib Char(10) Inz('');
if %parms() >= %parmnum(ErrorCd);
ercd = ErrorCd;
endif;
// Create User Space
quscrtus(UserSpace: '': 8192: x'00': '*EXCLUDE': Description:
'*NO': ercd);
if ercd.msgid <> '';
exsr CheckErcd;
return;
endif;
// Retrieve a pointer to the space
qusptrus(UserSpace: ReturnPtr: ercd);
if ercd.msgid <> '';
exsr CheckErcd;
return;
endif;
// Make Space automatically extendable
usatr.numrec = 1;
usatr.vlrecs(1).key = USATR_AUTO_EXTEND;
usatr.vlrecs(1).datalen = 1;
usatr.vlrecs(1).chardata = *On;
quscusat(Lib: UserSpace: usatr: ercd);
if ercd.msgid <> '';
exsr CheckErcd;
return;
endif;
// ===========================
begsr CheckErcd;
if %parms() >= %parmnum(ErrorCd);
ErrorCd = ercd;
return;
else;
// Send an escape message if you want to here
endif;
endsr;
end-proc;
I did not include the code to send the escape message on error here, but you should be able to fill in those blanks. It is simply be a call to QMHSNDPM.
You call CreateUS something like this.
dcl-s pHandle Pointer Inz(*null);
dcl-ds ercd LikeDs(ErrorCdType1_t) Inz(*LikeDs);
CreateUS('TMPARRAY QTEMP': 'Temporary Dynamic Array':
pHandle: errcd);
You can use the user space like this:
dcl-ds dynArray Qualified Dim(32767) Based(pArray);
dsField1 Char(10);
dsField2 Char(10);
...
end-ds;
dcl-s pArray Pointer Inz(*null);
// Create the user space
pArray = pHandle;
Now you can add elements to your hearts content up to 32767 elements. You can define the dimensions of the array as larger if you want. Using this technique, your array isn't really dynamic, it actually has 32767 elements. But the storage isn't on your program heap, it is in a permanent user space object in QTEMP. To make it truly dynamic you would have to write the service program described above. It's not a huge task, but it isn't trivial either. Maybe this is an open source project waiting to happen.