在 RPGLE 中通过指针分配内存大小

Question

有没有办法在 RPGLE 中通过指针检索分配的内存大小？
内存分配 %ALLOC() bif.

Answer 1

我会采取以下方法。构建一个动态数组服务程序，其中包含处理动态数组所需的子过程。函数如：

CreateArray() - 创建一个动态数组并return它的句柄（可以是一个指针）
ArrayPush(handle: element) - 添加一个元素到数组的末尾
ArrayPop(handle) - 删除并return数组中的最后一个元素
ArraySize(handle) - return数组中元素的当前数量
等等

调用者会知道元素的大小，但您可以使用 varchar 和 options(*varying) 来允许子过程确定正在加载的元素的长度，或者如果您愿意正在加载数据结构，您可以使用 opdesc。指定 opdesc 对调用者来说是完全透明的，它会在原型中指定，所以调用者甚至不必知道它。然后子过程可以使用系统 API 来查询操作描述符。我相信它是 CEE API，你可以查一下。要保存数组，您可以使用用户 space。它们的优点是当 space 已满时您不必重新分配，它会自动扩展到 16Mb。

或者您可以使用指向用户 space 的指针来支持基础数组。泰德·霍尔特 (Ted Holt) 在此处提供了您正在寻找的示例。 http://www.itjungle.com/fhg/fhg051006-story02.html

这是我创建自动扩展用户 space 和 return 指向它的指针的子程序。

   // 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;

我没有在此处包含发送错误消息的代码，但您应该能够填写这些空白。它只是对 QMHSNDPM 的调用。

你这样称呼 CreateUS。

dcl-s pHandle       Pointer Inz(*null);
dcl-ds ercd         LikeDs(ErrorCdType1_t) Inz(*LikeDs);
CreateUS('TMPARRAY  QTEMP': 'Temporary Dynamic Array':
    pHandle: errcd);

您可以像这样使用用户 space：

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;

现在您最多可以添加 32767 个元素。如果需要，您可以将数组的维度定义得更大。使用这种技术，您的数组并不是真正动态的，它实际上有 32767 个元素。但是存储不在您的程序堆上，它在 QTEMP 中的永久用户 space 对象中。要使其真正动态化，您必须编写上述服务程序。这不是一项艰巨的任务，但也不是微不足道的。也许这是一个等待发生的开源项目。

在 RPGLE 中通过指针分配内存大小

Allocated memory size by pointer in RPGLE

pointers

memory-management

rpgle

ibm-midrange