Avatar of lloydie-t
lloydie-t
Ā asked on

Freepascal memory leak Pt2

I had a memory leak in an app I wrote which I thought I had resolved. Ā unfortunately I have completely resolved the problem. I manage to reoslve the bigger leaks but I have one remaining, which I think I have tracked down but not sure how to solve it.

It seems as though old threads are not being destroyed, so that everytime a new connection is made memory increases.

code follows
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  cmem,cthreads,Classes, SysUtils, passqlite, BlckSock, synsock, oxounit, BaseUnix;
  Function CallConv (S1: String): String;
 
 var
  LiteDB1 : Tlitedb;
  RegExpStr1,RegExpEnd1,PhoneSysID1,dtimeout1,SysPort1,SysBind1,SiteID1, SysType1 :String;
  Sock:TTCPBlockSocket;
  ClientSock:TSocket;
  par,LCMD,PortNo:String;
  Baud,databits,stopbits:integer;
  parity:char;
  active,hardwarefl,softwarefl:boolean;
  pid  : pid_t;
  secs : longint;
 
  type
  TTCPEchoThrd = class(TThread)
  private
    Sock:TTCPBlockSocket;
    CSock: TSocket;
    S:String;
  public
    Constructor Create (hsock:tSocket);
    procedure Execute; override;
  end;
 
 tmyconverterfunc=function(AData:String):String;
 
implementation
 
var
  myconverterfunc:tmyconverterfunc;
 
 
 Constructor TTCPEchoThrd.Create(Hsock:TSocket);
begin
  Csock := Hsock;
  FreeOnTerminate:=False;
  inherited create(false);
end;
 
 
procedure TTCPEchoThrd.Execute;
begin
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate := True;
  try
    Sock.socket:=CSock;
    sock.GetSins;
    with sock do
      begin
        repeat
          if terminated then break;
          S := RecvString(strToInt(dtimeout1));
          if lastError<>0 then break;
             myconverterfunc:=@CallConv;
             myconverterfunc(S);
          if lastError<>0 then break;
        until false;
      end;
  finally
    Sock.Free;
  end;
end;
 
Function CallConv (S1: String): String;
begin
 oxoparse1.PbxGet(RegExpStr1,S1,SiteID1);
end;
 
 
 
  begin
    { daemonize }
   pid := fpFork;
   Case pid of
      0 : Begin { we are in the child }
         Close(input);  { close standard in }
         Close(output); { close standard out }
         Assign(output,'/dev/null');
         ReWrite(output);
         Close(stderr); { close standard error }
         Assign(stderr,'/dev/null');
         ReWrite(stderr);
      End;
       -1 : secs := 0;     { forking error, so run as non-daemon }
      Else Halt;          { successful fork, so parent dies }
   End;
  LiteDB1 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
  LiteDB1.Query('SELECT * from sys_col where col_active = 1');
  sysType1 := LiteDB1.Results[0][1];
  SiteID1 := LiteDB1.Results[0][3];
  SysPort1 := LiteDB1.Results[0][4];
  SysBind1 := LiteDB1.Results[0][5];
  dtimeout1 := LiteDB1.Results[0][11];
  LiteDB1.Query('SELECT * from sys_par where sys_id = '+sysType1);
  PhoneSysID1 := LiteDB1.Results[0][0];
  RegExpStr1 := LiteDB1.Results[0][2];
  RegExpEnd1 := LiteDB1.Results[0][3];
  LiteDB1.Close;
 
  Sock:=TTCPBlockSocket.create;
  with sock do
    begin
      CreateSocket;
      setLinger(true,10);
      bind(SysBind1,SysPort1);
      listen;
      repeat
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
 
 
//  end;
end.

Open in new window

PascalDelphi

Avatar of undefined
Last Comment
2266180

8/22/2022 - Mon
Geert G

there is
LiteDB1 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
Ā 
but no
FreeAndNil(LiteDbl);


also
Sock:=TTCPBlockSocket.create;
Ā 
but no
FreeAndNil(Sock);

2266180

OMG, you are using global variables and threads and no synchronization? you are so doomed.
Geert G

ciuly
maybe you should teach lloydie-t everything about threads and synchronization Ā 

Codegear wrote a decent article too (or was it Borland ?)
http://dn.codegear.com/article/22411


Experts Exchange has (a) saved my job multiple times, (b) saved me hours, days, and even weeks of work, and often (c) makes me look like a superhero! This place is MAGIC!
Walt Forbes
2266180

well, if we're at teaching, then the first thing is basics: try/finally block to protect resources (since we're about memory leaks)

create resource (file, socket, memory, etc)
try
Ā  work with resource
finally
Ā  free resource (close file/handle, fre ememory, etc)
end;

then, even though global variables are not bad themselves, in most of the cases people use them wrong. so another rule is to not use global variables unless really needed and not because you don't know how else to do it, but because you know you needed it global (for example a log level).

aaaand finally, keep in mind that when it comes to OOP,
var o :some object
begin
Ā  o:=other object

all it does is copy the address of "other object" to "o". NOT the entire object. objects are not variables, they are mearly pointers. if you do showmessage(inttostr(sizeof(o))) you wil see that it's 4 bytes every time (or 8 if you're on a 64bit environment). no matter what data you place in that object, it will still be 4/8 bytes. because a pointer is that big (small).

so,
var a,b,c:TObject;
begin
Ā  a:=TObject.Create;
Ā  b:=a;
Ā  c:=TObject.Create;
Ā  if a=b then
Ā  Ā  showmessage('a is b');
Ā  if a<>c then
Ā  Ā  showmessage('a is not c');
Ā  c:=a;// memory leak, because the reference to Ā the 2nd object is lost !!!
Ā  if a=c then
Ā  Ā  showmessage('now a is b and c');
Ā  c.free;
Ā  a.free;// ERROR, because the first object is already destroyed because c was referring it and not the second object
end;

lloydie-t: even if you know all the above, do learn OOP correctly because you are having some serious gaps.
Geert G

after i looked at it a little closer:

is this done inside the thread ?
LiteDB1 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
LiteDB1.Query('SELECT * from sys_col where col_active = 1');

if you query a database from a query then you must :
if you use ADO : call CoInitialize at the beginning of the thread (and off course CoUnitialize at the end)
create a unique database session for that thread
attach the query to that session

otherwise
a querie is called with the session from the main thread
unless you only query in 1 thread

next to that
you don't really have any classes

maybe if you describe what you want to do we can get you on the correct path to accomplish it
lloydie-t

ASKER
is this done inside the thread ?
LiteDB1 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
LiteDB1.Query('SELECT * from sys_col where col_active = 1');


The above should not be in a thread and the resulting vars should be global and only be called when the program starts.
I think my main problem is
Sock:=TTCPBlockSocket.create;

but no
FreeAndNil(Sock);

But I am not sure how to fix it. I suppose 'try finally' might do the job.
Ā 
⚔ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
lloydie-t

ASKER
I should mention the following. Iy may help. This app should Ā receive strings from an rs232 device which has been converted to send via TCP. Once the LF or CR is received the string is processed with 'myconverterfunc(S);'.
I suspect what is happening I lose my Ā connection and when a new one is created the previous threads are not destroyed. I think

            program datacollex;
 
{$mode objfpc}{$H+}
 
uses
  cthreads,
  Classes
  { add your units here },SysUtils, main;
 
begin
end.

Open in new window

lloydie-t

ASKER
OK I tried Ā the following but no difference
   LiteDB1 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3'); 
 try
  with LiteDB1 do begin
  LiteDB1.Query('SELECT * from sys_col where col_active = 1');
  sysType1 := LiteDB1.Results[0][1];
  SiteID1 := LiteDB1.Results[0][3];
  SysPort1 := LiteDB1.Results[0][4];
  SysBind1 := LiteDB1.Results[0][5];
  dtimeout1 := LiteDB1.Results[0][11];
  LiteDB1.Query('SELECT * from sys_par where sys_id = '+sysType1);
  PhoneSysID1 := LiteDB1.Results[0][0];
  RegExpStr1 := LiteDB1.Results[0][2];
  RegExpEnd1 := LiteDB1.Results[0][3];
  LiteDB1.Close;
  end; 
 finally
  LiteDB1.free;
end; 
 
Sock:=TTCPBlockSocket.create;
try
  with sock do
    begin
      CreateSocket;
      setLinger(true,10);
      bind(SysBind1,SysPort1);
      listen;
      repeat
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
finally
  sock.free;
end;

Open in new window

2266180

you ae still creating threads and not destroying them.
you do TTCPEchoThrd.create(ClientSock); but you never destroy them. considering your wat of doing things (even though it's wrong) I recommend setting freeonterminate to true in the socnrtuctor of TTCPEchoThrd.
Your help has saved me hundreds of hours of internet surfing.
fblack61
Geert G

repeat
Ā  if canread(1000) then
Ā  begin
Ā  Ā  ClientSock:=accept;
Ā  Ā  if lastError=0 then TTCPEchoThrd.create(ClientSock);
Ā  end;
Ā  Ā  Ā  until false;

this means if i can read something on a socket, create a EchoThread
and keep repeating this without bothering to check for anything
lloydie-t

ASKER
Tried setting Ā FreeOnTerminate:= True; but no joy. I am not sure how to destroy the thread once the there is no connection. TTCPEchoThrd.create is definitely creating the memory Leak. Even the following generates the same memory leak every time I make a new connection.

Ā if terminated then break; Ā  Ā  Ā  Ā  Ā S := RecvString(strToInt(dtimeout1)); Ā  Ā  Ā  Ā  Ā if lastError<>0 then break; Ā  Ā  Ā  Ā  Ā  Ā  WriteLn(S); Ā  Ā  Ā  Ā  Ā if lastError<>0 then break; Ā  Ā  Ā  Ā until false;

2266180

what does RecvString do? I mean literally, the code.
⚔ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
lloydie-t

ASKER
From the wrapper

Method waits until data string is received. This string is terminated by
Ā  Ā  Ā Terminator string. The resulting string is returned without this
Ā  Ā  Ā termination. If no data is received within TIMEOUT (in milliseconds)
Ā  Ā  Ā period, @link(LastError) is set to WSAETIMEDOUT. You may also specify
Ā  Ā  Ā maximum length of reading data by @link(MaxLineLength) property.}

function TBlockSocket.RecvString(Timeout: Integer): AnsiString;
var
Ā  s: AnsiString;
begin
Ā  Result := '';
Ā  s := RecvTerminated(Timeout, CRLF);
Ā  if FLastError = 0 then
Ā  Ā  Result := s;
end;
lloydie-t

ASKER
RecvString(1000);
2266180

get fastmm from sourceforge (http://sourceforge.net/projects/fastmm/), read the readme/help/whatever it has explaining usage), set it up for memory leak reporting and then run the project from the IDE. when you close it, it will report the memory leaks. either fix them by yourself if you understand the report, or place the report here.

and for petes sake, if you want a nice, correct code, write a nice correct code. loose all those global variable because it makes things VERY complicated. I already explained this once, I won't do it again. If you keep wanting to have that ugly code there, expect it to behave incorrectlky and to have memory leakjs and whatever other problems as well.
your project does not require global variable so rewrite it without any. there are rules for writing software for good reasons. just because you can do it doesn't mean you should. you can kill somebody it doesn't mean that the next guy pisisng you off will get his head blown up with a 45. just because your car can ride with 200 mph doens't mean you should go that fast in town. etc.
so just because you can have global variables doens't eman you should use them. and for sure it doesn't mean that you must have over 20 (TWENTY) of them. geez.

you expect us to fix garbage. try to understand, that code you gave us is GARBAGE. it's totally wrong.nothing personal, but you need to evolve. and that means learnig how to become better. first step is to radically change your coding. memory leaks are the least of your problems. I can think os situations in which your code will have at one given time more than one thread reading from the same socket in the same time. that is totally wrong. plus a ton of other problems. you need to rewrite that code.

I will not help you on this matter until you change everything according to our suggestions. you don't have time? too bad. you can wait until somebody else willing to waste their time will come along.

cheers

PS: this is ment as constructive criticism. take it like that.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
lloydie-t

ASKER
ciuly,
Ā  Ā  Ā  Ā  I should have posted may latest code Ā before your last reply. I did note your recommendations and I have already applied them to most of the code for this project. I have tried removing the global vars but a few remain as I need to access a few vars which needed to be accessed by seperate threads. Any advice to get round this welcome.
I would like to use FastMM but I suspect that it will not work with freepascal and the LInux app I am writing.

unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  cmem,cthreads,Classes, SysUtils, passqlite, BlckSock, synsock, oxounit, BaseUnix;
  Function CallConv (S1: String): String;
 
 
 var
  RegExpStr1,RegExpEnd1,dtimeout1,SysPort1SiteID1;
 
 
type
  TTCPEchoDaemon = class(TThread)
  private
    Sock:TTCPBlockSocket;
  public
    Constructor Create;
    Destructor Destroy; override;
    procedure Execute; override;
  end;
 
 
  type
  TTCPEchoThrd = class(TThread)
  private
    Sock:TTCPBlockSocket;
    CSock: TSocket;
  public
    Constructor Create (hsock:tSocket);
    procedure Execute; override;
  end;
 
 tmyconverterfunc=function(AData:String):String;
 
implementation
 
var
  myconverterfunc:tmyconverterfunc;
 
Constructor TTCPEchoDaemon.Create;
begin
  inherited create(false);
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate:=true;
end;
 
Destructor TTCPEchoDaemon.Destroy;
begin
  Sock.free;
end;
 
 
 Constructor TTCPEchoThrd.Create(Hsock:TSocket);
begin
  Csock := Hsock;
  FreeOnTerminate:=True;
  inherited create(false);
end;
 
 
procedure TTCPEchoThrd.Execute;
begin
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate := True;
  try
    Sock.socket:=CSock;
    sock.GetSins;
    with sock do
      begin
        repeat
          if terminated then break;
          S := RecvString(strToInt(dtimeout1));
          if lastError<>0 then break;
             myconverterfunc:=@CallConv;
             myconverterfunc(RegExpStr1,S,SiteID1);
          if lastError<>0 then break;
        until false;
      end;
  finally
    Sock.Free;
  end;
end;
 
Function CallConv (RegExpStr,S1,SiteID: String): String;
begin
 oxoparse1.PbxGet(RegExpStr,S1,SiteID);
end;
 
 
procedure TTCPEchoDaemon.Execute;
var
  LiteDB2 : Tlitedb;
  ClientSock:TSocket;
  PhoneSysID1,SysPort1,SysBind1,SysType1 :String;
  pid  : pid_t;
  secs : longint;
begin
 
    { daemonize }
   pid := fpFork;
   Case pid of
      0 : Begin { we are in the child }
         Close(input);  { close standard in }
         Close(output); { close standard out }
         Assign(output,'/dev/null');
         ReWrite(output);
         Close(stderr); { close standard error }
         Assign(stderr,'/dev/null');
         ReWrite(stderr);
      End;
       -1 : secs := 0;     { forking error, so run as non-daemon }
      Else Halt;          { successful fork, so parent dies }
   End;
 
{****************************
Get DB Settings
******************************}
LiteDB2 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
  try
  with LiteDB2 do
    begin
    LiteDB2.Query('SELECT * from sys_col where col_active = 1');
    sysType1 := LiteDB1.Results[0][1];
    SiteID1 := LiteDB1.Results[0][3]; //global var
    SysPort1 := LiteDB1.Results[0][4];
    SysBind1 := LiteDB1.Results[0][5];
    dtimeout1 := LiteDB1.Results[0][11]; // global var
    LiteDB2.Query('SELECT * from sys_par where sys_id = '+sysType1);
    PhoneSysID1 := LiteDB1.Results[0][0];
    RegExpStr1 := LiteDB1.Results[0][2]; //glocal var
    RegExpEnd1 := LiteDB1.Results[0][3]; //global var
    LiteDB1.Close;
    end;
  finally
    LiteDB2.Destroy;
    end;
 
  with sock do
    begin
      CreateSocket;
      setLinger(true,10);
      bind(SysBind1,SysPort1);
      listen;
      repeat
        if terminated then break;
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
end;
 
end.

Open in new window

lloydie-t

ASKER
Please ignore previous. Posted wrong version.
unit main;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  cmem,cthreads,Classes, SysUtils, passqlite, BlckSock, synsock, oxounit, BaseUnix;
  Function CallConv (S1: String): String;
 
 
 var
  RegExpStr1,RegExpEnd1,dtimeout1,SysPort1, SiteID1 : String;
 
 
type
  TTCPEchoDaemon = class(TThread)
  private
    Sock:TTCPBlockSocket;
  public
    Constructor Create;
    Destructor Destroy; override;
    procedure Execute; override;
  end;
 
 
  type
  TTCPEchoThrd = class(TThread)
  private
    Sock:TTCPBlockSocket;
    CSock: TSocket;
    S:String;
  public
    Constructor Create (hsock:tSocket);
    procedure Execute; override;
  end;
 
 tmyconverterfunc=function(AData:String):String;
 
implementation
 
var
  myconverterfunc:tmyconverterfunc;
 
Constructor TTCPEchoDaemon.Create;
begin
  inherited create(false);
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate:=true;
end;
 
Destructor TTCPEchoDaemon.Destroy;
begin
  Sock.free;
end;
 
 
 Constructor TTCPEchoThrd.Create(Hsock:TSocket);
begin
  Csock := Hsock;
  FreeOnTerminate:=True;
  inherited create(false);
end;
 
 
procedure TTCPEchoThrd.Execute;
begin
  sock:=TTCPBlockSocket.create;
  FreeOnTerminate := True;
  try
    Sock.socket:=CSock;
    sock.GetSins;
    with sock do
      begin
        repeat
          if terminated then break;
          S := RecvString(strToInt(dtimeout1));
          if lastError<>0 then break;
             myconverterfunc:=@CallConv;
             myconverterfunc(S);
          if lastError<>0 then break;
        until false;
      end;
  finally
    Sock.Free;
  end;
end;
 
Function CallConv (S1: String): String;
begin
 oxoparse1.PbxGet(RegExpStr1,S1,SiteID1);
end;
 
 
procedure TTCPEchoDaemon.Execute;
var
  LiteDB2 : Tlitedb;
  ClientSock:TSocket;
  PhoneSysID1,SysPort1,SysBind1,SysType1 :String;
  pid  : pid_t;
  secs : longint;
begin
 
    { daemonize }
   pid := fpFork;
   Case pid of
      0 : Begin { we are in the child }
         Close(input);  { close standard in }
         Close(output); { close standard out }
         Assign(output,'/dev/null');
         ReWrite(output);
         Close(stderr); { close standard error }
         Assign(stderr,'/dev/null');
         ReWrite(stderr);
      End;
       -1 : secs := 0;     { forking error, so run as non-daemon }
      Else Halt;          { successful fork, so parent dies }
   End;
 
{****************************
Get DB Settings
******************************}
LiteDB2 := TliteDB.Create(nil, '/var/lib/vtlogger/collex.sdb3');
  try
  with LiteDB2 do
    begin
    LiteDB2.Query('SELECT * from sys_col where col_active = 1');
    sysType1 := LiteDB2.Results[0][1];
    SiteID1 := LiteDB2.Results[0][3]; //global var for
    SysPort1 := LiteDB2.Results[0][4];
    SysBind1 := LiteDB2.Results[0][5];
    dtimeout1 := LiteDB2.Results[0][11]; // global var
    LiteDB2.Query('SELECT * from sys_par where sys_id = '+sysType1);
    PhoneSysID1 := LiteDB2.Results[0][0];
    RegExpStr1 := LiteDB2.Results[0][2]; //glocal var
    RegExpEnd1 := LiteDB2.Results[0][3]; //global var
    LiteDB2.Close;
    end;
  finally
    LiteDB2.Destroy;
    end;
 
  with sock do
    begin
      CreateSocket;
      setLinger(true,10);
      bind(SysBind1,SysPort1);
      listen;
      repeat
        if terminated then break;
        if canread(1000) then
          begin
            ClientSock:=accept;
            if lastError=0 then TTCPEchoThrd.create(ClientSock);
          end;
      until false;
    end;
end;
 
end.

Open in new window

2266180

>> I would like to use FastMM but I suspect that it will not work with freepascal and the LInux app I am writing.

right. sorry, forgot it's about fpc here. I'm doing about 5 things concurrently.

>>Ā Any advice to get round this welcome.

use data holding classes or singletons. depends on the lifetime of your variables and how you use them.

but you still use the same socket conneciton over multiple threads. why don't you create one thread and let that one read up the data and print it? it's really much easier that way. and logical.
⚔ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
2266180

with the new code, the main problem of multiple trheads still remain.

for memory leak deteciton in fpc, see this: http://www2.toki.or.id/fpcdoc/user/userse50.html#x70-15700010.5
lloydie-t

ASKER
>>but you still use the same socket conneciton over multiple threads. why don't you create one thread and let that one read up the data and print it? it's really much easier that way. and logical.

I have tried this approach and could not get it to work for me, but that is probably because I was doing all wrong. The only example provided by the maintainer of synapse uses multiple threads which is what this is based on
ASKER CERTIFIED SOLUTION
2266180

THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
lloydie-t

ASKER
ciuly,
Ā  Ā  Ā  Ā Sorry to inform you but I gave up with synapse. Although it worked fine for me in windows, I could not solve the problem with when running my app or the example with out getting memory leaks.
I did manage to reduce the leak even further than what it was, but I would imagine after a month of running it would have failed.
I appreciate your time spent with helping me tidy up my code and have benefited for your guidance.

I have however managed to achieve a better result with the lnet package although it was a little harder to code the equivilent of 'RecvString'.
Ā 
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
2266180

and all that deserves a B grade. because it's my fault you were not able to fix the leaks which maybe were a bug in synapse, although I have told you how to track the leaks in fpc.
well, you're 39th on my blacklist. the list of users I no longer help.

enjoy

and no need to reply, I've unsubscribed from this question.