Локализация утечки памяти

← →
>|< (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...

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

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

> >|< (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);

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

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

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;

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

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

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

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

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

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

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

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

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

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

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

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

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

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