我正在使用 Delphi 10.3.1，并为在 Apache 2.49 下的 Linux Ubuntu 18.04 上运行的 RAD 服务器资源/端点生成了一个示例应用程序。我的应用程序 ProcessArray 只创建了两个动态数组，其中组件是 12 个数字字段的记录。这些动态数组的大小是在调用端点时在运行时定义的。在执行期间，此应用程序按预期分配 RAM 内存，但是当它完成时，它不会释放 RAM！
如果连续调用数组大小为 20 或 3000 万，情况更糟，因为在完成运行后，每次调用仍然分配大约 1GB 的空间，导致使用 SWAP 区域使机器变得非常缓慢和不稳定。
取决于调用次数，它不能再运行并返回“内存不足”错误消息。
部署到在 Windows 上运行的 RAD 服务器时不会出现此问题。
查看我的代码：
unit UntStru;
interface
Uses
System.Threading,
System.Classes;
Type
TRec = record
F1 : Integer;
F2 : String;
F5 : Real;
F9 : Real;
F10 : Real;
// other Integer and Real fields
End;
TArrayRec = array of TRec;
Function Process_array (Var pArray1,pArray2 : TArrayRec; Const pfirst, plast : integer) : iTask;
Function Process_arrayThread (Const pSize, pThreads : integer) : Integer;
implementation
Uses
System.SysUtils,System.Diagnostics;
Function Process_array (Var pArray1,pArray2 : TArrayRec; Const pfirst, plast : integer) : iTask;
var
indx : integer;
larray1, larray2 : TArrayRec;
begin
// assigns var parameter array to local variable array because Ttask does not recognize var parameters
lArray1 := pArray1;
lArray2 := pArray2;
// creates a Task to process arrays positions from pfirst to plast
Result := TTask.Create
(
procedure
var
indx : integer;
begin
// scans array pArray from position pFirst through pLast
for indx := pFirst to pLast do
begin
with lArray1[indx] do
begin
F1 := indx;
F2 := 'Element ' + indx.ToString;
F5 := 2.5 * indx;
F9 := 1.3 * indx;
F10 := pLast;
end;
lArray2[indx] := lArray1[indx];
end;
// Just to assure that memory is being deallocated by the application
// This does not made any difference in deallocatin issue on Linux
{ Setlength(larray1,0);
Setlength(larray2,0);
FreeAndNil(larray1);
FreeAndNil(larray2);
}
end
);
end;
Function Process_arrayThread (Const pSize, pThreads : integer) : Integer;
var
lvettask : array of iTask;
lparray1, lparray2 : TArrayRec;
ind, lsize, lstart, lend : Integer;
begin
Try
// array size in million
lsize := 1000000 * pSize;
// creates larray1 and set array size at once
setlength(lparray1, lSize);
//creates larray2 incrementing one by one
for ind := 0 to lsize-1 do
begin
setlength(lparray2,ind+1);
end;
// creates the array if iTasks according to number of Threads "pThreads"
setlength(lvettask,pThreads);
// creates slice size of array to be processed by each Thread
lsize := lsize div pthreads;
// creates each iTask on the array of iTasks
for ind := 0 to pThreads-1 do
begin
lstart := ind * lsize ;
lend := (ind + 1) * lsize - 1 ;
lvettask[ind] := Process_array(lpArray1, lpArray2,lstart, lend);
end;
// starts each iTaks from array of iTasks
for ind := 0 to pThreads-1 do
lvetTask[ind].Start;
// waits all iTasks been concluded
TTask.WaitForAll(lvettask);
Finally
//
End;
end;
end.
资源/端点代码是：
unit UntProcessArray;
// EMS Resource Module
interface
uses
System.SysUtils, System.Classes, System.JSON,
EMS.Services, EMS.ResourceAPI, EMS.ResourceTypes;
type
[ResourceName('ProcessArray')]
TProcessArrayResource1 = class(TDataModule)
published
[ResourceSuffix('{item}')]
procedure PutItem(const AContext: TEndpointContext; const ARequest: TEndpointRequest; const AResponse: TEndpointResponse);
end;
implementation
{%CLASSGROUP 'System.Classes.TPersistent'} {$R *.dfm}
Uses
UntStru,System.Diagnostics;
procedure TProcessArrayResource1.PutItem(const AContext: TEndpointContext; const ARequest: TEndpointRequest; const AResponse: TEndpointResponse);
var
LItem : string;
Linteger : integer;
begin
TRY
LItem := ARequest.Params.Values['item'];
Linteger := StrToint(Litem);
// calls processing major function creating 4 threads
Process_ArrayThread(Linteger,4);
AResponse.Body.SetValue(TJSONArray.Create('Message :','Concluded sucessfully'),True);
Except
on E:Exception do
begin
AResponse.Body.SetValue(TJSONArray.Create('Mensagem', E.Message), True);
end;
End;
end;
procedure Register;
begin
RegisterResource(TypeInfo(TProcessArrayResource1));
end;
initialization
Register;
end.
用法： http://myLinuxUbuntuServer/ems-server/ProcessArray/30 用于 30 百万数组大小
我仍然怀疑这是否真的与在 Ubuntu Linux/Apache 上运行的 RAD Server 10.3.1 相关，或者我的代码是否存在缺失或错误。
这是否也发生在 Delphi 10.3.2 新版本上？（如果有人安装了这个版本并且可以在我继续升级之前为我测试，我将不胜感激）
这会发生在 Ubuntu 以外的其他 Linux 发行版上吗？
我非常感谢你们的帮助！谢谢。
Edition 1:
Environment info :
IDE : Delphi Tokyo 10.3.1 Update 1 (version 26.0.33219.4899 )
Server : Linux Ubuntu 18.04.2 LTS (64 bits) - 8GB RAM 8GB SWAP
Kernel 4.15.0-1045-aws
Web Server : Apache 2.4.29 RAD
Server bpl application compiled to Linux 64-bits
Linux 服务器 htop 命令的屏幕截图 在第一次执行之前
执行 6次 http://myLinuxUbuntuServer/ems-server/ProcessArray/20后 Linux 服务器 htop 的屏幕截图
请注意，即使在执行完成后，RAM 仍会继续分配 5.30GB。对该端点的进一步调用将从 5.30GB RAM 开始，很快就会达到总 RAM 大小（8GB），产生“内存不足”错误，或者将使用 SWAP 区域，机器将变得不稳定和缓慢！
添加我的 .dproj 文件：Proj_ProcessArray.dproj
package Proj_ProcessArray;
{$R *.res}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE RELEASE}
{$ENDIF IMPLICITBUILDING}
{$RUNONLY}
{$IMPLICITBUILD ON}
requires
rtl,
emsserverapi;
contains
UntStru in 'UntStru.pas',
UntProcessArray in 'UntProcessArray.pas' {ProcessArrayResource1: TDataModule};
end.
为 Linux 64 添加一个控制台应用程序 ProcessArrayConsole，它使用与上面单元 UntStru 发布的相同单元
program ProcessArrayConsole;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
UntStru in 'UntStru.pas';
var
lsize : integer;
lstraux : string;
begin
try
{ TODO -oUser -cConsole Main : Insert code here }
// get size of array in millions
lsize := ParamStr(1).tointeger ;
// call Process_ArrayThread using 4 threads
Process_arrayThread(lsize,4);
lstraux := FloatToStrF(lsize * 1000000,ffnumber,10,0);
Writeln;
Writeln('Concluded to process two arrays of ' + lstraux + ' positions.');
Writeln;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
我在同一个 Linux 服务器上运行了这个控制台应用程序，调用了几次 ./ProcessArrayConsole 30 并且 RAM 在执行后完全释放了！！。
因此，似乎只有当我使用 EMS Apache 模块或 EMSDevServer（独立）时才会出现此释放问题。
唯一的例外发生在我同时运行 3 个 3000 万大小的调用时。在这种情况下，总共消耗了 8GB RAM，并开始使用 SWAP 区域，但 achie 变得非常慢，三个过程需要很长时间才能结束。（12 分钟后仍在运行）。