Утечки памяти 2

SAASAA
отредактировано 01:45 Раздел: FastScript
Навеяло этим: http://www.fast-report.com/ru/forum/index.php?showtopic=2775

Еще пара мест, замеченных мной.
Первое.

Есть такой конструктор:
constructor TfsScript.Create(AOwner: TComponent);
begin
  inherited;
  FItems := TStringList.Create;
  FItems.Sorted := True;
...
по-умолчанию свойство Duplicates получается dupIgnore

и есть такие места в fs_iiparser.pas:
...
    StringVar := TfsStringVariable.Create('', fvtString, '');
      StringVar.Value := xi[1].Prop['text'];
      Prog.Add(StringVar);
...
конкретно это место используется при присвоении обработчиков процедурным типам в скрипте (... Button1.OnClick:=@MyButton1OnClick; ....)

Так вот, в связи с тем, что имя у StringVar пустое, то после второго такого Prog.Add(
объект не записывается в список и висит в памяти до выхода из программы

Предложу такое решение:
Во-первых поставить
FItems.Duplicates := dupError;
в конструкторе

Во-вторых переписать TfsScript.Add так:
procedure TfsScript.Add(const Name: String; Item: TObject);
begin
  if Name = '' then 
  begin
    inc(FNoNameCount);
    FItems.AddObject('___NoName'+inttostr(FNoNameCount), Item);
  else
    FItems.AddObject(Name, Item);
  if Item is TfsCustomVariable then
    TfsCustomVariable(Item).AddedBy := FAddedBy;
end;
FNoNameCount - это integer в Private класса TfsScript

Однако тут кроется одна неприятность. Два метода AddEnum и AddEnumSet
могут нарваться на дубликаты в случае добавления, например такого:

в Delphi 
TFontStyle = (fsBold, fsItalic, fsUnderline, fsStrikeOut);
TFontStyles = set of TFontStyle;
в FS: 
AddEnum('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeOut')
AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeOut')
в общем понятно - список не даст два раза добавить fsBold и т.п.
Кстати это, если не ошибаюсь, тоже приводит к утечкам памяти если не стоит
FItems.Duplicates := dupError;
или
FItems.Duplicates := dupAccept;(в варианте dupAccept вообще непонятно что будет найдено)

тут нужны более глубокие доработки...


Второе.

Есть такой код в fs_iinterpreter.pas:
function TfsClassVariable.GetValue: Variant;
begin
  if Params[0].Value = Null then
    Result := Integer(FClassRef.NewInstance) else        { constructor call }
    Result := Params[0].Value;                           { typecast }
  Params[0].Value := Null;
end;
Если я не ошибаюсь, то тот указатель, который вернет FClassRef.NewInstance
никто нигде не освобождает. Я кстати вообще не понял зачем вызывать здесь
NewInstance. Попробовал закомментарить и возвращать 0 - вроде все работает.
Но опасаюсь - может он все-таки нужен?

Если вдруг что-то из этого уже исправлено в новых версиях - pls скажите.
У меня версия 1.5 с доработками. Кстати: меняю ;) ответы на мои вопросы на
технологию повышения скорости выполнения скрипта, например такого:
procedure Button1OnClick(Sender:TObject);
var
  i, j: Integer;
  l: TList;
  tc:variant;
begin
  label1.caption:='Running...';
  processmessages;
  tc:=GetTickCount;
  l := TList.Create;
  for i := 0 to 400000 do
  begin
    l.Add(nil);
    l.Delete(0);
  end;
  l.free;
  tc:=GetTickCount-tc;
  label1.caption:=floattostr(tc)+' ms';
end;

с 6259 ms до 921 ms ;)

В Delphi, кстати он выполняется за ~10ms (если переменные Variant - для справедливости) то есть всего лишь в 92 раза быстрее, а не в 623 ;)

Комментарии

  • SAASAA
    отредактировано 01:45
    Насчет закомментаривания
    ...
    Result := Integer(FClassRef.NewInstance)
    ...
    немного поторопился.
    Некоторые классы без этого не создаются. Будем разбираться...
  • AlexTZAlexTZ
    отредактировано 01:45
    1) в последней версии конструктор выглядит так:

    constructor TfsScript.Create(AOwner: TComponent);
    begin
    inherited;
    FItems := TStringList.Create;
    FItems.Sorted := True;
    FItems.Duplicates := dupAccept;

    2) Чтобы создать экземпляр произвольного класса, надо сделать:
    var
    cl: TClass;
    result: TObject;
    cl := TButton;
    result := cl.NewInstance;
    result.Create(nil);

    то же самое делается в FR.
    ps. жду технологию ;)
  • SAASAA
    отредактировано 01:45
    написал:
    1) в последней версии конструктор выглядит так:

    constructor TfsScript.Create(AOwner: TComponent);
    begin
    inherited;
    FItems := TStringList.Create;
    FItems.Sorted := True;
    FItems.Duplicates := dupAccept;

    да, а как бороться с перечислениями?
    AddEnum('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeOut')
    AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeOut')

    по одной версии fsItalic это 1 а по другой 2 и обе константы в списке под одним именем
    написал:
    2) Чтобы создать экземпляр произвольного класса, надо сделать:
    var
    cl: TClass;
    result: TObject;
    cl := TButton;
    result := cl.NewInstance;
    result.Create(nil);
    Это понятно, проблема в другом: часть объектов определенных классов, зарегистрированных в скрипте почему-то вызывают утечки памяти, которые отлавливаются MemCheck - ом примерно так: 
    Блок памяти был выделен и не освобожден. Размер: 852

Трассировка стека при выделении блока (вхождения):
402B07 [System][@GetMem]
40425B [System][TObject.NewInstance]
56107D [fs_iinterpreter.pas][fs_iinterpreter][TfsClassVariable.GetValue][1462]
561843 [fs_iinterpreter.pas][fs_iinterpreter][TfsDesignator.DoCalc][1635]
561A0C [fs_iinterpreter.pas][fs_iinterpreter][TfsDesignator.GetValue][1674]
556486 [fs_iexpression.pas][fs_iexpression][TfsDesignatorNode.GetValue][509]
556642 [fs_iexpression.pas][fs_iexpression][TfsExpression.GetValue][551]
56178A [fs_iinterpreter.pas][fs_iinterpreter][TfsDesignator.DoCalc][1617]
561A0C [fs_iinterpreter.pas][fs_iinterpreter][TfsDesignator.GetValue][1674]

Блок в настоящее время используется для объекта класса: TCDS

    при этом объект точно должен был "от-Free-тся" так как создавался с Owner -ом который точно уничножился.
    Но механизм ошибки я еще не понял. Буду разбираться - может вообще проблема в самих классах.


    Насчет скорости.
    1. Переписаны классы ....rtti...
    Вместо структуры: 
     TFunctions = class(TObject)
  private
    function CallMethod(Instance: TObject; ClassType: TClass;
      const MethodName: String; var Params: Variant): Variant;
  ...
  end;
    используется
     TFunctions = class(TObject)
  private
    function FS_IntToStr(Instance:TObject;ClassType:TClass;const MethodName:String;var Params:Variant):Variant;
    function FS_FloatToStr(Instance:TObject;ClassType:TClass;const MethodName:String;var Params:Variant):Variant;
    function FS_DateToStr(Instance:TObject;ClassType:TClass;const MethodName:String;var Params:Variant):Variant;
    function FS_TimeToStr(Instance:TObject;ClassType:TClass;const MethodName:String;var Params:Variant):Variant;
...

    В общем убираются все if по имени в верхнем регистре на прямые ссылки на функцию

    ускорение в моем примере с 6259ms до 4887ms 12%

    2.1 Вводится параметр "количество параметров" в метод 
    procedure TfsScript.AddMethod(const Syntax: string; CallEvent: TfsCallMethodEvent;
  const Category: String = ''; const Description: String = ''; DirectPCount:word = 0);

    2.2 Добавляются два свойства 
     TfsMethodHelper = class(TfsCustomHelper)
  private
...
    FSyntax: String;
    FDirectParamCount:word;//Added
    FUpperCaseName:string;//Added
  protected
...

    Соответственно в AddMethod они заполняются

    2.3 Переписывается function TfsMethodHelper.GetValue: Variant;
    с целью:
    1) убрать вызов VarArrayCreate когда нет параметров или параметр один
    2) убрать AnsiUpperCase

    Когда параметр один он передается непосредственно через переменную v в FOnCall(Instance, FClassRef, s, v)

    На самом деле лучше сделать передачу параметров без вариантного массива и при количестве параметров 2 и более, но это требует более кардинальных изменений - я пока это не сделал, времени не было. В принципе большинство функций и методов, особенно часто вызываемых в каких-нибудь циклах как раз имеют до двух параметров (обычно это преобразования, получение поле датасетов и т.п)

    Дальше в 
    function TfsPropertyHelper.GetValue: Variant; 
procedure TfsPropertyHelper.SetValue(const Value: Variant);
procedure TfsMethodHelper.SetValue(const Value: Variant);
    также убирается
    AnsiUpperCase

    Ускорение в том же примере с 4887ms до 921 ms
    Я еще замерял время с AnsiUpperCase, но без VarArrayCreate: 1312ms

    Собственно вот. Разумеется, какая-нибудь математика в скриптах от всего этого не ускоряется. Но у меня в проекте использование этой оптимизации подходит очень хорошо (работа в основном с зарегистрированными в скриптах объектами датасеты, TField, TList ... , часть собственных )

    Небольшое замечание по оформлению "оберток" над классами. Почему-то при увеличении количества методов в каждом TFunctions начинает потихоньку падать скорость. Видимо это связано с внутренним поиском адреса в таблице методов класса. Лучше делать так: один класс - одна обертка.

    Да, еще остались if ...GET else ....SET в обработчиках для свойств - их наверное тоже можно как-нибудь избавить от if
  • AlexTZAlexTZ
    отредактировано 01:45
    С перечислениями бороться бесполезно. FS не позволяет добавлять одно и то же в качестве AddEnum и AddEnumSet. Над оптимизацией подумаю, но не так глобально (делать свой CallMethod на каждую ф-ю не буду).
  • SAASAA
    отредактировано 01:45
    написал:
    С перечислениями бороться бесполезно.
    Я все-таки хотел бы как-нибудь ... будем думать...
    написал:
    Над оптимизацией подумаю, но не так глобально (делать свой CallMethod на каждую ф-ю не буду).
    Да, выгоднее сделать параметры без VarArrayCreate.
    Убрать AnsiUpperCase - вообще халява. Кстати можно ли не вводить отдельное поле, а использовать Name ? Я побоялся.

    На самом деле у меня сейчас переписаны только fs_isysrtti.pas,fs_idbrtti.pas, часть fs_iclassesrtti и юниты, регистрирующие мои классы. То есть можно выборочно.
  • SAASAA
    отредактировано 01:45
    Посмотрел версию 1.9. Понравилось решение со вторым процедурным типом.
    Спасибо. Бум переходить со своей самодельщины.
    С мелкой утечкой памяти про которую писал разобрался - дело в синтаксисе регистрации конструктора моего класса в скрипте - сам виноват.

    Тут еще утечек наловил ;)
    При ошибках компиляции скрипта остается много "мусора" в памяти.
    К примеру если один раз откомпилить такой код (fs1.9): 
    // Objects speed test
// access to properties


var
  i, j: Integer;
  c: TButton;  //<- специально для ошибки
begin
  c := TComponent.Create(nil);
  for i := 0 to 500000 do
    if c.Tag = 0 then
    begin
      c.Tag := 0;
      c.Name := 'c';
    end;
end.
    то получится такое при выходе из программы (подключен FastMM4): 
    В этом приложении происходят утечки памяти. Утечки блоков маленького размера (исключая ожидаемые утечки зарегистрированные по указателю):

5 - 12 байт: Unknown x 3
13 - 20 байт: TfsDesignatorItem x 4, TList x 13, String x 9, Unknown x 5
29 - 36 байт: String x 1
69 - 84 байт: TfsOperandNode x 1, TfsDesignatorNode x 2, TfsDesignator x 1, TfsVariableDesignator x 2, TfsExpression x 3

    Насколько я понял все это от такого кода, в ассортименте встречающегося в fs_iiparser.pas: 
    function TfsILParser.DoExpression(xi: TfsXMLItem; Prog: TfsScript): TfsExpression;
...
begin
  Result := TfsExpression.Create(FProgram);

  DoExpressionItems(xi, Result);
  SourcePos1 := fsPosToPoint(PropPos(xi));
  SourcePos2 := fsPosToPoint(xi.Prop['pos1']);
  Result.Source := GetSource(SourcePos1, SourcePos2);

  ErPos := Result.Finalize;
  if ErPos <> '' then
  begin
    FErrorPos := ErPos;
    raise Exception.Create(SIncompatibleTypes);
  end;
end;
    теряем result
    таких мест много (по крайней мере не одно)

    Конечно, ошибки при компиляции - не "основной режим работы" программы, но все-таки нехорошо. Дело в том что я прикрутил к редактору кода своего рода "Code Completion" принцип которого в двух словах: по Ctrl+Space выполняется попытка откомпилить скрипт во временном TfsScript и вне зависимости от результата выполняется поиск в нем сначала TfsProcVariable - текущей процедуры/функции, потом TfsCustomVariable в ней по имени на котором вызван Ctrl+Space. Потом еще поиск в самом скрипте, если не нашли в процедуре/функции. Ну потом понятно, если нашли TfsCustomVariable, то определяем по ней тип и выводим что нужно.
    Так вот такие утечки при этом лезут во всю.

    И еще, пока не забыл. Было бы, наверное не вредно включить в сл. версию такую доработку:
    Сейчас скрипт позволяет писать такой бред: 
    ...
  c := TComponent.Create(TComponent);
...
    Я предлагаю различать fvtClass и fvtClassReference (ввести такой новый)
    Дальше такие изменения:
    function TfsCustomVariable.GetFullTypeName: String;
begin
  case FTyp of
...
    fvtEnum: Result := FTypeName;
    fvtClassReference: Result := 'Class reference ' + FTypeName    
...


function TfsScript.AddClass(AClass: TClass; const Ancestor: string): 
...
  Result := TfsClassVariable.Create(AClass, Ancestor);
  Result.FTyp := fvtClassReference;
...

function StrToVarType(const TypeName: String): TfsVarType;
var
  v: TfsCustomVariable;
begin
  v := fsGlobalUnit.Find(TypeName);
  if v = nil then
    Result := fvtClass
  else if v.Typ = fvtClassReference then
    Result := fvtClass
  else
    Result := v.Typ;
end;


function TfsILParser.DoDesignator(xi: TfsXMLItem; Prog: TfsScript;
  EmitOp: TfsEmitOp = emNone): TfsDesignator;
...
        end
        else if Typ in [fvtClass,fvtClassReference] then
        begin
          TypeName := PriorItem.Ref.TypeName;
          ClassVar := FindClass(TypeName);
...

procedure TfsILParser.DoAssign(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
...
      if Designator.IsReadOnly then
        raise Exception.Create(SLeftCantAssigned);

      if Expression.Typ = fvtClassReference then
        Expression.Typ := fvtClass; //для приведения типа 

      CheckTypeCompatibility(Designator, Expression);
...

    Вроде ничего не забыл. Теперь при попытке компиляции кода 
    ...
  c := TComponent.Create(TComponent);
...
    получаем: Incompatible types: 'Class TComponent', 'Class reference TComponent'

Оставить комментарий

Многофункциональный текстовый редактор. Чтобы отредактировать стиль параграфа, нажмите TAB, чтобы перейти к меню абзаца. Там вы можете выбрать стиль. По умолчанию не выбран ни один стиль. Когда вы выберете текст, появится встроенное меню форматирования. Нажмите TAB, чтобы войти в него. Некоторые элементы, такие как многофункциональные вставки ссылок, картинок, индикаторов загрузки и сообщений об ошибок могут быть вставлены в редактор. Вы можете перемещаться по ним, используя стрелки внутри редактора и удалять с помощью клавиш delete или backspace.

Начало • FastScriptКомментировать как ...

© Vanilla Keystone Theme 2024