paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 07:06:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Free the Tree in SysDoneKeyboard to avoid a lot of messages if heaptrace is enabled

Browse Source
This commit is contained in:
armin 2003-03-26 12:35:23 +00:00
parent 7a2f4e9e26
commit b99d1fd23a
1 changed files with 28 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
rtl/unix/keyboard.pp
View File

@ -401,6 +401,25 @@ type
var var
RootTree : Array[0..255] of PTreeElement; RootTree : Array[0..255] of PTreeElement;
procedure FreeElement (PT:PTreeElement);
var next : PTreeElement;
begin
while PT <> nil do
begin
FreeElement(PT^.Child);
next := PT^.Next;
dispose(PT);
PT := next;
end;
end;
procedure FreeTree;
var i : integer;
begin
for i := low(RootTree) to high(RootTree) do
FreeElement(RootTree[i]);
end;
function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement; function NewPTree(ch : byte;Pa : PTreeElement) : PTreeElement;
var PT : PTreeElement; var PT : PTreeElement;
begin begin
@ -1267,6 +1286,11 @@ procedure SysDoneKeyboard;
begin begin
unpatchkeyboard; unpatchkeyboard;
SetRawMode(false); SetRawMode(false);
{$ifndef NotUseTree}
FreeTree;
{$endif not NotUseTree}
{$ifdef logging} {$ifdef logging}
close(f); close(f);
{$endif logging} {$endif logging}
@ -1505,7 +1529,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.11 2002-09-07 16:01:27 peter Revision 1.12 2003-03-26 12:35:23 armin
* Free the Tree in SysDoneKeyboard to avoid a lot of messages if heaptrace is enabled
Revision 1.11 2002/09/07 16:01:27 peter
* old logs removed and tabs fixed * old logs removed and tabs fixed
Revision 1.10 2002/03/03 13:23:51 peter Revision 1.10 2002/03/03 13:23:51 peter