Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2013.03.22;
Скачать: CL | DM;

Вниз

Локализация утечки памяти   Найти похожие ветки 

 
>|<   (2012-08-27 14:31) [0]

Уважаемые мастера! Возник сабж.
У кого есть опыт в борьбе с подобным явлением, подскажите алгоритм действий. Возможно, есть автоматизированные средства, которые указывают место, в котором это происходит.
В диспетчере задач размер памяти самого процесса не растет, но со временем вылетает Out of system resources.
Суть программы такова: есть сканы школьных бланков, которые парсятся, распознаются и удаляются. Первых 30-40 штук  обрабатывается нормально, потом вылтает Out of system resources .
По коду, везде использую try .. finally ...end и освобождаю все ресурсы.
try except тоже используется. Так же используется общий для всех обработчик исключений Application.OnException := ExceptionHandler;

Из-за этого винегрета где-то напартачил с освобождением.
Если кому нужен код и кого-то есть желание бегло глянуть, могу привести.

Заранее благодарен за любую помощь.


 
Rouse_ ©   (2012-08-27 14:45) [1]

Не обезательно что утечка.
Вот тебе классический код вызывающий EOutOfResources

var
 B: TBitmap;
begin
 B := TBitmap.Create;
 B.PixelFormat := pf32bit;
 B.SetSize(-1, 1);


 
Пит   (2012-08-27 14:53) [2]

а насчет утечек:

http://goo.gl/DVHmu


 
Pavia ©   (2012-08-27 15:12) [3]

Да было дело. Опыт имеется.
Out of system resources. - происходит при фрагментации памяти.
Если смотреть в корень, то фрагментация мжет и из-за утечки быть. У меня так и было поряда 40 раз по бату.

Ссылку тебе дали. Продублирую.
www.gunsmoker.ru/2009/05/blog-post_24.html
Главное, правильно читать отчёт.


 
DVM ©   (2012-08-27 15:24) [4]


> >|<   (27.08.12 14:31) 


> Возможно, есть автоматизированные средства, которые указывают
> место, в котором это происходит.

memproof


 
>|<   (2012-08-27 16:09) [5]

Да, очень похоже на большую фрагментацию памяти.
Дело в том, что каждый бланк разрезается на сотню маленьких битмапов, каждый из которых содержит изображение отметки, которое потом распознается нейронной сетью. И вот на этапе очередного разрезания происходит Out of system resources

Покажу код, может кто-то разу укажет на его недостатки...
TNamedBitmap = record
   Bitmap: TBitmap;
   SectionName: string;
   ScanType: TScanType;
   ValueType: TValueType;
   IdColumn: integer;
   IdRow: integer;
   RotateBitmap: boolean;
 end;

TBlank = class(TObject)
 private
   FBlankType: TBlankType;
   FSections: TStringList;
   FBitMap: TBitMap;
   FColorBitmap: TBitMap;
   TempBitmap: TBitmap;
   FBitMaps: array of TNamedBitmap;
  ...
 public
   constructor Create(AFilename: string; ADataSet: TClientDataSet;
     AUseThread: boolean = False; AThread: TThread = nil; ABlankType: TBlankType = btUnknown);
   destructor Destroy; override;
   function AddSection(const AName: string; AValue: TRect): integer;
   function AddBitmap(const AName: string; ARect: TRect; AScanType: TScanType;
     AValueType: TValueType;
     AIdColumn: integer;
     AIdRow: integer; ARotateBitmap: boolean = false): integer;
   procedure DoWork;
   procedure Vizualize;
   property BlankType: TBlankType read FBlankType;
   property Section[const AName: string]: TRect read GetSection; default;
   property Bitmaps[const AName: string]: TBitMap read GetBitmap;
   property Bitmap: TBitMap read FBitMap;
   property BlankID: integer read FBlankID;
   property Filename: string read FFilename;
 end;
....
implementation
...
procedure TfrmParseImages.ScanTimerTimer(Sender: TObject);
var
 AFiles: TStringList;
 AFilename: string;
 i: integer;
begin
 AFiles := TStringList.Create;
 try
   Poisk(edFolder.Text, AFiles);
   frmParseImages.mmLog.Lines.Add(DateTimeToStr(Now) + " " + IntToStr(AFiles.Count) + " file(s) found.");
   if AFiles.Count > 0 then
   begin
     i := 0;
     while i < AFiles.Count do
     begin
       FBlank := TBlank.Create(AFiles[i], frmParseImages.cdsThread, True);
       TBlank.AddLog("--------------------------Blank created---------------------------------------");
       try
         try
           Fblank.DoWork;
           if FileExists(AFiles[i]) then
             if DeleteFile(AFiles[i]) then
               TBlank.AddLog("A file " + AFiles[i] + " deleted!");

           // FBlank.Vizualize;
         except
           on E: Exception do
           begin
             TBlank.AddLog("Error while processing file " + AFiles[i] + " : " + E.Message);
            { if FileExists(AFiles[i]) then
               if DeleteFile(AFiles[i]) then
                 TBlank.AddLog("A file " + AFiles[i] + " deleted!");}
           end;
         end;
       finally
         try
           FBlank.Free;
           TBlank.AddLog("--------------------------Blank destroyed.---------------------------------------");
         except
           on E: Exception do
             FBlank.AddLog("Blank free Error:" + E.Message);
         end;
       end;
       inc(i);
     end;
   end;
 finally
   Afiles.free;
   Processing := False;
 end;

end;

function TBlank.AddBitmap(const AName: string; ARect: TRect; AScanType: TScanType;
 AValueType: TValueType;
 AIdColumn: integer;
 AIdRow: integer; ARotateBitmap: boolean = false): integer;
var
 ACanvas: TCanvas;
 Dest: pRGB;
 x, y: integer;
 BlackCount: integer;
begin
 try
   TempBitmap := TBitmap.Create;
   TempBitmap.PixelFormat := pf24bit;
   // TempBitmap.Monochrome := True;
   if AScanType = stMessage then
     ACanvas := FColorBitmap.Canvas
   else
     ACanvas := FBitmap.Canvas;
   try
     TempBitmap.Width := ABS(ARect.Right - ARect.Left);
     TempBitMap.Height := ABS(ARect.Bottom - ARect.Top);
     TempBitmap.Canvas.CopyRect(Types.Rect(0, 0, ABS(ARect.Right - ARect.Left), ABS(ARect.Bottom - ARect.Top)), ACanvas, ARect);
   
     if ARotateBitmap then
       RotateBitmap(TempBitmap, 270, clWhite);

     SetLength(FBitMaps, Length(FBitMaps) + 1);
     with FBitMaps[Length(FBitMaps) - 1] do
     begin
       SectionName := AName;
       ScanType := AScanType;
       ValueType := AValueType;
       IdColumn := AIdColumn;
       IdRow := AIdRow;
       BitMap := TBitMap.Create;
       BitMap.PixelFormat := pf24bit;
       BitMap.Assign(TempBitmap);
     end;
   finally
     TempBitmap.Free;
   end;
   Result := Length(FBitMaps) + 1;
 except
   on E: Exception do
     AddLog("AddBitmap error:" + E.Message);
 end;
end;
constructor TBlank.Create(AFilename: string; ADataSet: TClientDataSet;
 AUseThread: boolean = False; AThread: TThread = nil; ABlankType: TBlankType = btUnknown);

begin
 if not FileExists(AFilename) then
   Exit;

 inherited Create;
 FUseThread := AUseThread;
 if ADataSet <> nil then
   FDataSet := ADataSet
 else
 begin
   FDataSet := frmParseImages.cdsThread;
 end;

 FSections := TStringList.Create;

 FBitMap := TBitMap.Create;

 FColorBitmap := TBitMap.Create;
 try
   JPEGtoBMP(AFilename, FBitMap);
   FBitMap.PixelFormat := pf24bit;
   JPEGtoBMP(AFilename, FColorBitmap);
   AddLog("A blank instance created by filename:" + AFilename);
 except
   on E: Exception do
   begin
     AddLog("Error while picture loading. Error message:" + E.Message);
     Exit;
   end;
 end;

 FBlankType := ABlankType;

 FFilename := AFilename;
 FErrorCount := 0;
end;

destructor TBlank.Destroy;
var
 i: integer;
begin
 FBitMap.Free;
 FColorBitmap.Free;
 for i := Length(FBitMaps) - 1 downto 0 do
 begin
   FBitMaps[i].Bitmap.Free;
 end;
 FBitMaps := nil;
 FSections.Free;
 FDataset.EmptyDataSet;

 inherited;
end;


Пока копировал код, посетила идея, может везде вместо метода Free вызывать FreeAndNil, чтобы обнулять все указатели?


 
Пит   (2012-08-27 16:14) [6]

может воспользоваться указанными средствами и наверняка понять есть утечка или нет.


 
DVM ©   (2012-08-27 16:29) [7]


> >|<   (27.08.12 16:09) [5]
> Да, очень похоже на большую фрагментацию памяти.
> Дело в том, что каждый бланк разрезается на сотню маленьких
> битмапов, каждый из которых содержит изображение отметки,
>  которое потом распознается нейронной сетью. И вот на этапе
> очередного разрезания происходит Out of system resources

Не похоже. Причем тут фрагментация? Если менеджер памяти не найдет подходящего размера свободного блока, то он выдаст EOutOfMemory. А у тебя вероятно исчерпывается лимит на ресурсы GDI какие то. Запусти свою программу под MemProof и погляди какие ресурсы текут. Если его должным образом настроить то он даже строку в коде покажет (но надо чтобы в проект была включена отладочная инфа по максимуму и исходные коды ему сделать доступными). Memproof довольно старая программа и вроде не развивается больше, но вроде бы работает. Из более новых можно попробовать AQtime  продукты вроде там есть что-то подобное.


 
Rouse_ ©   (2012-08-27 16:44) [8]


> И вот на этапе очередного разрезания происходит Out of system
> resources

Тогда все понятно, ты создал слишком много битмапов. Отсюда и ошибка.

Вот такой код:

var
 B: TBitmap;
 I: cardinal;
begin
 try
   try
     for I := 0 to 20000 do
     begin
       B := TBitmap.Create;
       B.SetSize(1, 1);
     end;
   except
     writeln(I);
     raise;
   end;
 except
   on E: Exception do
     Writeln(E.ClassName, ": ", E.Message);
 end;
 writeln("done");
 readln;
end.


выдает такую результат:
9977
EOutOfResources: Out of system resources

т.е. я смог создать только 9977 однопиксельмых битмапов, по памяти копейки, а вот GDI ресурсов уже не осталось.


 
Rouse_ ©   (2012-08-27 16:48) [9]

ЗЫ: во время ошибки посмотри менеджер процессов, там в одной из колонок будет GDI Objects. Дельфя их ест в районе 3к, эксплорер в районе 2к, у остальных приложений по копейке. Посмотри сколько у тебя отьелось на момент поднятия исключения.


 
>|<   (2012-08-27 16:53) [10]


> Тогда все понятно, ты создал слишком много битмапов.

Смотрю поведение своей программы под Process Explorer и вижу такую картину:
Первых 20 бланков колонка Private Bytes и Working Set держится на уровне 100 мегабайт, даже видно как эти значения уменьшаются при каждом вызове Blank.Destroy. То есть накопительной утечки с каждого бланка нет. Потом после 20-ти бланков происходит резкий скачек и поле Private Bytes растет до 450 мегабайт, а  Working Set до 130 и дальше растет Private Bytes уже на 40-м бланке зашкаливает за 500 мегабайт...

То есть битмапы создаются и освобождаются для каждого бланка и это порядок 100-200 штук, но никак не 9977...
Значит проблема все таки не здесь зарыта...


 
Rouse_ ©   (2012-08-27 16:56) [11]


> То есть битмапы создаются и освобождаются для каждого бланка
> и это порядок 100-200 штук, но никак не 9977...

Ты не память смотри, а GDI хэндлы, их количество ограничено на систему.
Количество 9977 - это не значит что на своей машине ты сможешь столько создать, может как раз в районе 300-400 упрешся...


 
DVM ©   (2012-08-27 17:01) [12]


> >|<   (27.08.12 16:53) [10]


> Значит проблема все таки не здесь зарыта...

Чукча не читатель


 
>|<   (2012-08-27 17:14) [13]


> DVM ©   (27.08.12 17:01) [12]

Уже установил MemProof и смотрю под ним. Скомпилировал программу согласно инструкции:
В настройках компилятора рекомендуется отключить оптимизацию (Optimization), включить использование Stack frames, включить генерацию отладочной информации (Debug information) и использование отладочных библиотек (Use Debug DCUs). В настройках линковщика рекомендуется включить Include TD32 debug info.

Указал пути к исходникам программы и VCL.
Программа написана на Delphi 7.
Пока еще не разобрался, где смотреть утечку памяти и как она будет найдена в коде...
Читаю паралельно ссылку GunSmoker"a...


 
>|<   (2012-08-27 17:16) [14]


> Rouse_ ©   (27.08.12 16:44) [8]

Кстати, согласно MemProof, выделено 1306 bitmap, peak 1530.


 
Rouse_ ©   (2012-08-27 17:29) [15]


> Кстати, согласно MemProof, выделено 1306 bitmap, peak 1530.

Это много.


 
DVM ©   (2012-08-27 17:41) [16]


> >|<   (27.08.12 17:14) [13]



> Пока еще не разобрался, где смотреть утечку памяти и как
> она будет найдена в коде...

После того как выйдешь из программы MemProof покажет утечки, ткни в нужную , по идее он укажет внизу в окне кусок кода. Я не уверен, что Memproof будет работать в новых Delphi, но раньше было так.


 
RWolf ©   (2012-08-27 17:50) [17]

думается мне, что данные для нейронной сети вовсе не обязательно подготавливать в виде битмапов; вполне сойдёт и промежуточное удобное для обработки представление, и хэндлы тратить не потребуется.


 
DVM ©   (2012-08-27 17:51) [18]


> >|<   (27.08.12 16:09) [5]


> Дело в том, что каждый бланк разрезается на сотню маленьких
> битмапов, каждый из которых содержит изображение отметки,
>  которое потом распознается нейронной сетью.

А этой нейронной сети нужны все куски сразу или по одному? Если по одному так может отрезать по одному и отдавать? Вообще одним битмапом обойтись можно.


 
DVM ©   (2012-08-27 17:52) [19]


> RWolf ©   (27.08.12 17:50) [17]

Я бы вообще взял просто буфер, ширину и высоту и возможно формат пикселей еще (ну это уже необязательно если зафиксировать)


 
Eraser ©   (2012-08-27 17:56) [20]


> >|<   (27.08.12 14:31) 

много поточность с TBitmap используется?


 
>|<   (2012-08-27 18:13) [21]


> много поточность с TBitmap используется?

Пока не использую.

> А этой нейронной сети нужны все куски сразу или по одному?
>  

По одному. Но для начала формирую датасет, который содержит все нарезанные картинки, чтобы отобразить все в виде таблицы. Заодно увидеть сводный реультат, как нарезалось, как отработала нейронка, с какими вероятностями распозналось, какой процент ошибок и т.д..


> После того как выйдешь из программы MemProof покажет утечки,
>  ткни в нужную , по идее он укажет внизу в окне кусок кода.
>  Я не уверен, что Memproof будет работать в новых Delphi,
>  но раньше было так.

Дело в том, что после выхода в Resource Details все три пустых окна.
http://it4business.ru/img/lib/memproof/2.gif
у меня это окно пустое.
Скачал версию MemProof для Delphi 7, может это из-за седьмой винды...
Показывает только сводную таблицу, сколько чего использовано.
Видно, что убегают указатели. Но где именно в коде, пока не видно...


 
Pavia ©   (2012-08-27 19:39) [22]

У memproof дурацкий способ запуска. Ищи инструкцию в интернете и внимательно по ней действуй.

На первый взгляд утечек не вижу.

FBitMap := TBitMap.Create;

 FColorBitmap := TBitMap.Create;
 try
   JPEGtoBMP(AFilename, FBitMap);
   FBitMap.PixelFormat := pf24bit;
   JPEGtoBMP(AFilename, FColorBitmap);


Вот этот код странный.
JPEGtoBMP покажи.


 
>|<   (2012-08-28 11:51) [23]


> JPEGtoBMP покажи.
>


procedure JPEGtoBMP(const FileName: TFileName; bmp: TBitmap);
var
 jpeg: TJPEGImage;
 Dest: pRGB;
 x, y: integer;
begin
 jpeg := TJPEGImage.Create;
 try
   jpeg.CompressionQuality := 100; {Default Value}
   jpeg.LoadFromFile(FileName);
   if not Assigned(bmp) then
     bmp := TBitmap.Create;
   try
     bmp.Assign(jpeg);
     bmp.PixelFormat := pf24bit;
     for y := 0 to 10 do
     begin
       Dest := bmp.ScanLine[y];
       for x := 0 to bmp.Width - 1 do
       begin
         Dest^.R := 255;
         Dest^.G := 255;
         Dest^.B := 255;
         Inc(Dest);
       end;
     end;
     for y := bmp.Height - 20 to bmp.Height - 1 do
     begin
       Dest := bmp.ScanLine[y];
       for x := 0 to bmp.Width - 1 do
       begin
         Dest^.R := 255;
         Dest^.G := 255;
         Dest^.B := 255;
         Inc(Dest);
       end;
     end;
   finally
     //
   end;
 finally

   FreeAndNil(jpeg);
 end;
end;


 
>|<   (2012-08-28 11:52) [24]

Такой вопрос: возможно ли как-то программно освободить не освобожденные ресурсы, которые уже никем не используются, дескрипторы, которые уже ни на что не указывают?


 
Inovet ©   (2012-08-28 11:58) [25]

> [24] >|<   (28.08.12 11:52)

Как узнать используются или нет?


 
>|<   (2012-08-28 12:44) [26]


> Как узнать используются или нет?

MemProof же как-то узнает...


 
han_malign   (2012-08-28 12:46) [27]


> возможно ли как-то программно освободить не освобожденные ресурсы

- завершить приложение...

> Но для начала формирую датасет, который содержит все нарезанные картинки, чтобы отобразить все в виде таблицы.

- TDrawGrid и CopyRect... На самый запущенный случай  - TImageList...


 
Inovet ©   (2012-08-28 13:02) [28]

> [26] >|<   (28.08.12 12:44)
> MemProof же как-то узнает...

Так и c# узнаёт, и програвммист знает, только забывает.


 
DVM ©   (2012-08-28 13:08) [29]


> >|<   (28.08.12 12:44) [26]
>
> > Как узнать используются или нет?
>
> MemProof же как-то узнает...
>
>

там счетчики есть


 
>|<   (2012-08-28 17:42) [30]

Коллеги!
Рад сообщить, что утечка найдена и исправлена!)
Решил вдумчиво проинспектировать весь код и таки нашел место, откуда утекают битмапы:

...
function Obrezka(Source: TBitmap): TBitmap;
   var
   Min_y, Min_x, Max_y, Max_x: integer;
 begin
    Result := TBitmap.Create; <- нигде больше не освобождается
   MaxMinPict(Source, Min_y, Min_x, Max_y, Max_x);
    Result.Height := Max_y - Min_y;
   Result.Width := Max_x - Min_x;
   Result.Canvas.CopyRect(Types.Rect(0, 0, Max_x - Min_x, Max_y - Min_y), Source.Canvas, Types.Rect(Min_x, Min_y, Max_x, Max_y));
 end;

 // Переменные.....................................

var
 viborka: string;
 TmpBmp2, TmpBmp3: TBitmap;
 ARect: TRect;
 x, y: integer;
begin
 TmpBmp2 := TBitmap.Create;
 TmpBmp3 := TBitmap.Create;
 TmpBmp2.PixelFormat := pf24Bit;
 try
   TmpBmp3.Assign(ABitMap);
   if (TmpBmp3.Height <> 41) or (TmpBmp3.Width <> 34) then
     //  Если символ не 34х41, то масштабируем до этого размера
   begin

     TmpBmp2.Width := 34;
     TmpBmp2.Height := 41;
     ARect := Types.Rect(0, 0, 34, 41);
     TmpBmp2.Canvas.StretchDraw(ARect, TmpBmp3);
     TmpBmp3.FreeImage;
     TmpBmp3.Height := 41;
     TmpBmp3.Width := 34;
     TmpBmp3.Canvas.CopyRect(Types.Rect(0, 0, TmpBmp2.Width, TmpBmp2.Height), TmpBmp2.Canvas, Types.Rect(0, 0, TmpBmp2.Width, TmpBmp2.Height));
     TmpBmp2.FreeImage;
   end;
   RemoveRamk(TmpBmp3);
   // Центрируем изображение
   TmpBmp2:=Obrezka(TmpBmp3);


этот код скопировал из чужого проекта, не проверив его на прочность. От того и названия функций такие...

Всем спасибо за помощь!


 
Pavia ©   (2012-08-28 21:28) [31]

function Obrezka(Source: TBitmap): TBitmap;

Такое лучше выкинуть, заменив
function Obrezka(Result:TBitmap; Source: TBitmap):Boolean;
В качестве Result в функцию передавать уже созданный TBitmap.

1) Надёжнее.
2) Во вторых каждый раз не будете выделять память. Что и быстрее получится.
3) Фрагментации точно не будет.


 
>|<   (2012-08-29 10:53) [32]


> Такое лучше выкинуть, заменив
> function Obrezka(Result:TBitmap; Source: TBitmap):Boolean;
>
> В качестве Result в функцию передавать уже созданный TBitmap.
>

я заменил на
procedure Obrezka(Source:TBitmap; Dest: TBitmap);
var
  Min_y, Min_x, Max_y, Max_x: integer;
begin
  MaxMinPict(Source, Min_y, Min_x, Max_y, Max_x);
  Dest.Height := Max_y - Min_y;
  Dest.Width := Max_x - Min_x;
  Dest.Canvas.CopyRect(Types.Rect(0, 0, Max_x - Min_x, Max_y - Min_y),    Source.Canvas, Types.Rect(Min_x, Min_y, Max_x, Max_y));
end;


 
Rouse_ ©   (2012-08-29 15:42) [33]


> и таки нашел место, откуда утекают битмапы:

Я ж говорил в битмапах засада :)


 
>|<   (2012-08-29 17:15) [34]

Остался вопрос о фрагментации памяти. Неужели такая проблема существует?
Что мешает разбить память под выделяемый объект на части и хранить адреса, по которым он находится? Кто знает - просветите темноту:-)


 
Inovet ©   (2012-08-29 17:24) [35]

> [34] >|<   (29.08.12 17:15)
> Что мешает разбить память под выделяемый объект на части
> и хранить адреса, по которым он находится?

Ага, особенно для массивов хорошо будет.


 
DVM ©   (2012-08-29 17:43) [36]


> Остался вопрос о фрагментации памяти. Неужели такая проблема
> существует?

Существует, но чтобы с ней столкнуться надо очень и очень постараться. Нужно много и долго выделять память кусочками разного размера. Очень разного. И освобождать ее выборочно. Тогда может получиться что вся память будет представлять собой чередующиеся занятые и свободные области и может получиться так, что при попытке выделить участок памяти нужного размера он не впишется ни в один из свободных кусков - получим Out Of Memory.

Менеджер памяти в новых версиях Delphi (FastMem который) адресное пространство из которого выделяет память делит на 3 части: маленькие блоки, средние и большие. В зависимости от того в какую часть вписывается запрашиваемый блок памяти там она и выделяется. Это значительно снижает если не фрагментацию, то хотя бы вероятность столкнуться с ситуацией описанной выше.

В твоем случае битмапов немного и они я так понимаю одинакового размера, так что врядли фрагментация тебя заденет. Обычно это проявляется на длительно работающих приложениях серверах всяких  и т.д. И то редко.


 
>|<   (2012-08-29 19:34) [37]


> DVM ©   (29.08.12 17:43) [36]

Спасибо за развернутый ответ. Задумался перекомпилировать под новыми версиями или включить модуль FastMM в проект под Delphi 7...



Страницы: 1 вся ветка

Текущий архив: 2013.03.22;
Скачать: CL | DM;

Наверх




Память: 0.6 MB
Время: 0.058 c
15-1331466940
Jeer
2012-03-11 15:55
2013.03.22
А вдруг ?


15-1352709195
Аббат Пиккола
2012-11-12 12:33
2013.03.22
За демократию


2-1331179586
Eeuwige Rouw
2012-03-08 08:06
2013.03.22
Совместимость приложения!


15-1331287470
Александар
2012-03-09 14:04
2013.03.22
Подмена(дублированя) пакетов между клиентом и определёном ip


15-1335682929
Валера
2012-04-29 11:02
2013.03.22
Почему не работает TTrackBar.OnExit?