Вопрос про освобождение памяти при перегрузке операторов

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение Лекс Айрин » 29.12.2016 18:57:56

runewalsh, обидно, но, в принципе, понятно.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение sts » 29.12.2016 22:29:16

runewalsh писал(а):И в простом выражении типа A := A + 1 это будет значить создание (1) временного объекта для суммы и (2) создание нового A из временного. Мой вариант лучше =). Для полного счастья ещё можно интерфейсную ссылку на временный объект хранить как сырой pointer, чтобы не дёргалась почём зря в длинных выражениях, но это уже такое.


в PassedXYPair.Make создается объект?
sts
постоялец
 
Сообщения: 406
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение zub » 29.12.2016 22:31:18

Зачем из паскаля cpp делать? cpp уже есть
zub
долгожитель
 
Сообщения: 2884
Зарегистрирован: 14.11.2005 23:51:26

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение runewalsh » 29.12.2016 23:03:51

sts писал(а):создается объект

Ну, идеологически — да, в терминологии обжектпаскаля — нет. Если хранить интерфейсную ссылку как указатель, это будет вообще POD-структура (я проверил и даже бенчнул — с постоянно дёргаемым интерфейсом всего вдвое медленнее, чем с указателем, который преобразуется из/в интерфейс только на преобразованиях из/во временный объект, так что пофиг. Странно, что у меня это «вдвое» даже от числа потоков слабо зависит, я-то начитался страшилок, что атомики, которыми разруливаются счётчики ссылок, не масштабируются).
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение скалогрыз » 29.12.2016 23:30:54

zub писал(а):Зачем из паскаля cpp делать? cpp уже есть

как минимум - делфи совместимость.
А вот зачем из Делфи делать cpp, это другой вопрос.
скалогрыз
долгожитель
 
Сообщения: 1803
Зарегистрирован: 03.09.2008 02:36:48

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение sts » 29.12.2016 23:48:46

runewalsh писал(а):Ну, идеологически — да, в терминологии обжектпаскаля — нет.

память выделяется? значит создается
на том-же примере

Код: Выделить всё
      A := 1;
      B := 4;
      C := (A + B) + (A + B) + (A + B);
      D := C + C;
      E := C - (B - A);

с классами:
FullMyClassCount = 5
FullMyClassTmpCount = 6

с классическими объектами
XYPairCount = 7
MakePassedXYPairCount = 19
sts
постоялец
 
Сообщения: 406
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение runewalsh » 30.12.2016 01:26:32

sts писал(а):память выделяется?

Нет, точнее, на стеке. Можно ещё вот так.
Код: Выделить всё
{$mode objfpc} {$h+} {$apptype console} {$modeswitch duplicatelocals} {$typedaddress on}
{-$define UseHeaptrc}
{$define StoreInterfaceAsPointer}
uses
{$ifdef UseHeaptrc} heaptrc, {$endif} Windows;

   function QPC: double;
   var
      c, f: int64;
   begin
      QueryPerformanceCounter((@c)^);
      QueryPerformanceFrequency((@f)^);
      result := c/f;
   end;

   function IntToStr(x: integer): string;
   begin
      str(x, result);
   end;

type
   IMyClass = interface
      function GetValue: Integer;
      procedure SetValue(Value: Integer);
      property Value: Integer read GetValue write SetValue;
   end;

   TMyClass = class(TInterfacedObject, IMyClass)
   protected
      FValue: Integer;
      function GetValue: Integer;
      procedure SetValue(Value: Integer);
   public
      constructor Create;
      destructor Destroy; override;
   end;

   TMyClassTmp = class(TObject)
   protected
      Value: Integer;
   public
      constructor Create;
      destructor Destroy; override;
   end;

   operator +(A:IMyClass;B:Integer)R:TMyClassTmp;
   begin
      R:=TMyClassTmp.Create;
      R.Value:= A.Value + B;
   end;

   operator +(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
   begin
      R:=A;
      R.Value:= A.Value + B;
   end;

   operator +(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
   begin
      R:=A;
      R.Value:= A.Value + B.Value;
      B.Free;
   end;

   operator -(A:IMyClass;B:Integer)R:TMyClassTmp;
   begin
      R:=TMyClassTmp.Create;
      R.Value:= A.Value - B;
   end;

   operator -(A:TMyClassTmp;B:Integer)R:TMyClassTmp;
   begin
      R:=A;
      R.Value:= A.Value - B;
   end;

   operator -(A:TMyClassTmp;B:TMyClassTmp)R:TMyClassTmp;
   begin
      R:=A;
      R.Value:= A.Value - B.Value;
      B.Free;
   end;

   operator :=(A:IMyClass)R:Integer;
   begin
      R:= A.Value;
   end;

   operator :=(A:Integer)R:IMyClass;
   begin
      R:= TMyClass.Create;
      R.Value:= A;
   end;

   operator :=(A:TMyClassTmp)R:IMyClass;
   begin
      R:= TMyClass.Create;
      R.Value:= A.Value;
      A.Free;
   end;

   operator :=(A:TMyClassTmp)R:Integer;
   begin
      R:= A.Value;
      A.Free;
   end;

   operator :=(A:IMyClass)R:String;
   begin
      R:= IntToStr(A.Value);
   end;

   constructor TMyClass.Create;
   begin
      inherited Create;
      FValue:= 0;
   end;

   destructor TMyClass.Destroy;
   begin
      inherited Destroy;
   end;

   function TMyClass.GetValue: Integer;
   begin
      result:= FValue;
   end;

   procedure TMyClass.SetValue(Value: Integer);
   begin
      FValue:= Value;
   end;

   constructor TMyClassTmp.Create;
   begin
      inherited Create;
      Value:= 0;
   end;

   destructor TMyClassTmp.Destroy;
   begin
      inherited Destroy;
   end;

type
   IXYPair = interface
      function GetX: integer; procedure SetX(x: integer);
      function GetY: integer; procedure SetY(y: integer);
      property X: integer read GetX write SetX;
      property Y: integer read GetY write SetY;
      function ToString: string;
   end;

   XYPair = class(TInterfacedObject, IXYPair)
      x, y: integer;
      constructor Create(x, y: integer);
      destructor Destroy; override;
      function GetX: integer; procedure SetX(x: integer);
      function GetY: integer; procedure SetY(y: integer);
      function ToString: string; override;
   end;

   constructor XYPair.Create(x, y: integer);
   begin
      inherited Create;
      self.x := x;
      self.y := y;
   end;

   destructor XYPair.Destroy;
   begin
      inherited Destroy;
   end;

   function XYPair.GetX: integer; begin result := x; end;
   procedure XYPair.SetX(x: integer); begin self.x := x; end;
   function XYPair.GetY: integer; begin result := y; end;
   procedure XYPair.SetY(y: integer); begin self.y := y; end;

   function XYPair.ToString: string;
   begin
      result := '(' + IntToStr(x) + ', ' + IntToStr(y) + ')';
   end;

type
   PassedXYPair = object
      ref: {$ifdef StoreInterfaceAsPointer} pointer {$else} IXYPair {$endif};
      temp: boolean;
      function Make(const ref: IXYPair; temp: boolean): PassedXYPair; static;
      function ForceTemp: PassedXYPair;
   {$ifdef StoreInterfaceAsPointer} procedure ReleaseOperands(var a, b: PassedXYPair); static; {$endif}
   end;

   function PassedXYPair.Make(const ref: IXYPair; temp: boolean): PassedXYPair;
   begin
   {$ifdef StoreInterfaceAsPointer} result.ref := nil; {$endif}
      IXYPair(result.ref) := ref;
      result.temp := temp;
   end;

   function PassedXYPair.ForceTemp: PassedXYPair;
   var
      r: IXYPair absolute ref;
   begin
      if temp then result := self else result := Make(XYPair.Create(r.X, r.Y), true);
   end;

{$ifdef StoreInterfaceAsPointer}
   procedure PassedXYPair.ReleaseOperands(var a, b: PassedXYPair);
   begin
      if not a.temp then IXYPair(a.ref) := nil;
      IXYPair(b.ref) := nil;
   end;
{$endif}

   operator :=(const ref: IXYPair): PassedXYPair;
   begin
      result := PassedXYPair.Make(ref, {temp =} false);
   end;

   operator :=(const pair: PassedXYPair): IXYPair;
   begin
   {$ifdef StoreInterfaceAsPointer}
      result := nil; // если результатом является автотип, в FPC он может быть не занулён, а содержать некое валидное старое значение.
      pointer(result) := pair.ref; // ссылка уже держалась
   {$else}
      result := pair.ref;
   {$endif}
   end;

   operator +(a, b: PassedXYPair): PassedXYPair;
   var
      br: IXYPair absolute b.ref;
      rr: IXYPair absolute result.ref;
   begin
      if b.temp and not a.temp then
         result := b + a
      else
      begin
         result := a.ForceTemp;
         rr.x := rr.x + br.x;
         rr.y := rr.y + br.y;
      {$ifdef StoreInterfaceAsPointer} PassedXYPair.ReleaseOperands(a, b); {$endif}
      end;
   end;

   operator -(a, b: PassedXYPair): PassedXYPair;
   var
      br: IXYPair absolute b.ref;
      rr: IXYPair absolute result.ref;
   begin
      if b.temp and not a.temp then
      begin
         result := b - a;
         rr.x := -rr.x;
         rr.y := -rr.y;
      end else
      begin
         result := a.ForceTemp;
         rr.x := rr.x - br.x;
         rr.y := rr.y - br.y;
      {$ifdef StoreInterfaceAsPointer} PassedXYPair.ReleaseOperands(a, b); {$endif}
      end;
   end;

const
   FailCorrect: array[boolean] of string = (' (FAIL)', ' (correct)');

   procedure Check1;
   var
      A, B, C, D, E: IMyClass;
   begin
      A := 1;
      B := 4;
      C := (A + B) + (A + B) + (A + B);
      D := C + C;
      E := C - (B - A);
      writeln('A = ', A.Value, ' - expected 1', FailCorrect[A.Value = 1]);
      writeln('B = ', B.Value, ' - expected 4', FailCorrect[B.Value = 4]);
      writeln('C = ', C.Value, ' - expected 3 x (A+B) = 3 x 5 = 15', FailCorrect[C.Value = 15]);
      writeln('D = ', D.Value, ' - expected 30', FailCorrect[D.Value = 30]);
      writeln('E = ', E.Value, ' - expected 15 - (4 - 1) = 12', FailCorrect[E.Value = 12]);
      writeln('---');
   end;

   procedure Check2;
   var
      A, B, C, D, E: IXYPair;
   begin
      A := XYPair.Create(1, 2);
      B := XYPair.Create(3, 4);
      C := (A + B) + (A + B) + (A + B);
      D := C + C;
      E := C - (B - A);
      writeln('A = ', A.ToString, ' - expected (1, 2)', FailCorrect[(A.X = 1) and (A.Y = 2)]);
      writeln('B = ', B.ToString, ' - expected (3, 4)', FailCorrect[(B.X = 3) and (B.Y = 4)]);
      writeln('C = ', C.ToString, ' - expected 3 x (A+B) = 3 x (4, 6) = (12, 18)', FailCorrect[(C.X = 12) and (C.Y = 18)]);
      writeln('D = ', D.ToString, ' - expected (24, 36)', FailCorrect[(D.X = 24) and (D.Y = 36)]);
      writeln('E = ', E.ToString, ' - expected (12, 18) - ((3, 4) - (1, 2)) = (10, 16)', FailCorrect[(E.X = 10) and (E.Y = 16)]);
      writeln('---');
   end;

const
   Iterations = 1000000;

   procedure Bench1;
   var
      A, B, C, D, E, R: IMyClass;
      i: integer;
      ok: boolean;
      t: double;
   begin
      write('Bench 1... ');
      R := 0;

      t := QPC;
      for i := 0 to Iterations - 1 do
      begin
         A := 1;
         B := 4;
         C := (A + B) + (A + B) + (A + B);
         D := C + C;
         E := C - (B - A);
         R := R + D + E;
      end;
      t := (QPC - t) / Iterations;

      ok := R.Value = (30 + 12) * Iterations;
      write('R = ', R.Value, FailCorrect[ok]);
      if ok then write(', iteration time: ', 1e6*t:0:2, ' mcs');
      writeln;
   end;

   procedure Bench2;
   var
      A, B, C, D, E, R, expected: IXYPair;
      i: integer;
      ok: boolean;
      t: double;
   begin
      write('Bench 2... ');
      R := XYPair.Create(0, 0);

      t := QPC;
      for i := 0 to Iterations - 1 do
      begin
         A := XYPair.Create(1, 2);
         B := XYPair.Create(3, 4);
         C := (A + B) + (A + B) + (A + B);
         D := C + C;
         E := C - (B - A);
         R := R + D + E;
      end;
      t := (QPC - t) / Iterations;

      expected := XYPair.Create((24 + 10) * Iterations, (36 + 16) * Iterations);
      ok := (R.X = expected.X) and (R.Y = expected.Y);
      write('R = ', R.ToString, ' - expected ', expected.ToString, FailCorrect[ok]);
      if ok then write(', iteration time: ', 1e6*t:0:2, ' mcs');
      writeln;
   end;

   procedure Run;
   begin
      Check1;
      Check2;
      Bench1;
      Bench2;
   end;

begin
   Run;
{$ifdef UseHeaptrc} DumpHeap; {$endif}
   readln;
end.

Хм, я думал, лишние экземпляры классов намного медленнее, но в действительности без heaptrc (заставляющего тормозить аллокации) -И- трюка с интерфейсом-в-указателе (у тебя, с Tmp, не являющимся интерфейсом и освобождающимся вручную, по сути сделано то же самое) мой вариант проигрывает.
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение sts » 30.12.2016 02:40:27

Объединил логику TMyClass и TMyClassTmp
Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;

type
  IMyClass = interface
    function GetValue: Integer;
    procedure SetValue(Value: Integer);
    function GetRefCount : longint;
    function ToString : string;

    property Value: Integer read GetValue write SetValue;
  end;

  { TMyClass }

  TMyClass = class(TInterfacedObject, IMyClass)
  protected
    FValue: Integer;
    FText: String;

    function GetValue: Integer;
    procedure SetValue(Value: Integer);

    function GetRefCount : longint;

  public
    constructor Create;
    destructor Destroy; override;
    function ToString : string; override;
    property Value: integer read FValue write FValue;
    property Text: String read FText write FText;
  end;

  operator +(A:IMyClass;B:Integer)R:TMyClass;
  operator +(A:TMyClass;B:Integer)R:TMyClass;
  operator +(A:TMyClass;B:TMyClass)R:TMyClass;
  operator +(A:IMyClass;B:IMyClass)R:TMyClass;

  operator -(A:IMyClass;B:Integer)R:TMyClass;
  operator -(A:TMyClass;B:Integer)R:TMyClass;
  operator -(A:TMyClass;B:TMyClass)R:TMyClass;

  operator :=(A:IMyClass)R:Integer;
  operator :=(A:Integer)R:IMyClass;
  operator :=(A:TMyClass)R:Integer;

  operator +(A:String; B:IMyClass)R:String;

  operator :=(A:IMyClass)R:String;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;
  MyClassCount: integer = 0;
  FullMyClassCount: integer = 0;
  MaxMyClassCount: integer = 0;

implementation

{$R *.lfm}

procedure AddLog(Text: string);
begin
  if Assigned(Form1) then Form1.Memo1.Lines.Add(Text);
end;

operator +(A:IMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator1 +(A:IMyClass;B:Integer)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + IntToStr(B));
  R:=TMyClass.Create;
  R.Text:='(' + A.ToString + '+' + IntToStr(B) +')';
  R.Value:= A.Value + B;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));

end;

operator +(A:TMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator2 +(A:TMyClass;B:Integer)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('B = ' + IntToStr(B));
  R:=A;
  R.Text:='(' + A.ToString + '+' + IntToStr(B) +')';
  R.Value:= A.Value + B;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator +(A:TMyClass;B:TMyClass)R:TMyClass;
begin
  AddLog('operator3 +(A:TMyClass;B:TMyClass)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
  R:=A;
  R.Text:='(' + A.ToString + '+' + B.ToString +')';
  R.Value:= A.Value + B.Value;
  B.Free;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator +(A:IMyClass;B:IMyClass)R:TMyClass;
begin
  AddLog('operator4 +(A:IMyClass;B:IMyClass)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
  R:=TMyClass.Create;
  R.Text:='(' + A.ToString + '+' + B.ToString +')';
  R.Value:= A.Value + B.Value;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator -(A:IMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator5 -(A:IMyClass;B:Integer)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + IntToStr(B));
  R:=TMyClass.Create;
  R.Text:='(' + A.ToString + '-' + IntToStr(B) +')';
  R.Value:= A.Value - B;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator -(A:TMyClass;B:Integer)R:TMyClass;
begin
  AddLog('operator6 -(A:TMyClass;B:Integer)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + IntToStr(B));
  R:=A;
  R.Text:='(' + A.ToString + '-' + IntToStr(B) +')';
  R.Value:= A.Value - B;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator -(A:TMyClass;B:TMyClass)R:TMyClass;
begin
  AddLog('operator7 -(A:TMyClass;B:TMyClass)R:TMyClass');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  AddLog('        B:' + B.ToString + ', Value = ' + IntToStr(B.Value) + ', RefCount = ' + IntToStr(B.GetRefCount));
  R:=A;
  R.Text:='(' + A.ToString + '-' + B.ToString +')';
  R.Value:= A.Value - B.Value;
  B.Free;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator :=(A:IMyClass)R:Integer;
begin
  AddLog('operator8 :=(A:IMyClass)R:Integer');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  R:= A.Value;
  AddLog('        R:' + IntToStr(R));
end;

operator :=(A:Integer)R:IMyClass;
begin
  AddLog('operator9 :=(A:Integer)R:IMyClass');
  AddLog('        A:' + IntToStr(A));
  R:= TMyClass.Create;
  R.Value:= A;
  AddLog('        R:' + R.ToString + ', Value = ' + IntToStr(R.Value) + ', RefCount = ' + IntToStr(R.GetRefCount));
end;

operator :=(A:TMyClass)R:Integer;
begin
  AddLog('operator10 :=(A:TMyClass)R:Integer');
  AddLog('        A:' + A.ToString + ', Value = ' + IntToStr(A.Value) + ', RefCount = ' + IntToStr(A.GetRefCount));
  R:= A.Value;
  A.Free;
  AddLog('        R:' + IntToStr(R));
end;

operator +(A:String; B:IMyClass)R:String;
begin
  R:= A + IntToStr(B.Value);
end;

operator :=(A:IMyClass)R:String;
begin
  R:= IntToStr(A.Value);
end;

{ TMyClass }

constructor TMyClass.Create;
begin
  Inc(MyClassCount);
  Inc(FullMyClassCount);
  if MaxMyClassCount < MyClassCount then MaxMyClassCount:= MyClassCount;
  inherited Create;
  AddLog('TMyClass.Create, MyClassCount = ' + IntToStr(MyClassCount));
  FValue:= 0;
end;

destructor TMyClass.Destroy;
begin
  AddLog('TMyClass.Destroy, ' + ToString + ', Value = ' + IntToStr(FValue) + ', MyClassCount = ' + IntToStr(MyClassCount));
  inherited Destroy;
  Dec(MyClassCount);
  if MyClassCount = 0 then AddLog('MyClassCount = ' + IntToStr(MyClassCount) + ', MaxMyClassCount = ' + IntToStr(MaxMyClassCount));
end;

function TMyClass.ToString: string;
begin
  if FText = '' then
    result:= IntToStr(FValue)
  else
    result:= FText;
end;

function TMyClass.GetValue: Integer;
begin
  result:= FValue;
end;

procedure TMyClass.SetValue(Value: Integer);
begin
  FValue:= Value;
end;

function TMyClass.GetRefCount : longint;
begin
  result:= RefCount;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  A,B,C,D,E: IMyClass;
begin
  try
    //A:= 10;
    //C:= ((A+2)+3)+4;
    //Memo1.Lines.Add('C = ' + IntToStr(C));

    //A := 10;
    //A := A + (A + 1) + (A + 1);
    //C := A + 1 + A;
    //Memo1.Lines.Add('C = ' + C);
    //Memo1.Lines.Add('(C + 10) = ' + (C + 10));

  //  A := 10;

//    A := A + (A + 1);
//    A := (A + 1) + (A + 1);
//    A := A + (A + 1) + (A + 1);
//    Memo1.Lines.Add('A = ' + A);

    //A := 1;
    //A := A + 1;
    //Memo1.Lines.Add('A = ' + A);

    A := 1;
    B := 4;
    C := (A + B) + (A + B) + (A + B);
    D := C + C;
    E := C - (B - A);
    Memo1.Lines.Add('A = ' + A);
    Memo1.Lines.Add('B = ' + B);
    Memo1.Lines.Add('C = ' + C);
    Memo1.Lines.Add('D = ' + D);
    Memo1.Lines.Add('E = ' + E);
  finally
    Memo1.Lines.Add('FullMyClassCount = ' + IntToStr(FullMyClassCount));
  end;
end;

end.

вместо:
FullMyClassCount = 5
FullMyClassTmpCount = 6
стало:
FullMyClassCount = 8
а в A := A + 1 стало 2 экземпляра вместо 3.
sts
постоялец
 
Сообщения: 406
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение runewalsh » 30.12.2016 02:53:03

Хитро́, даже не подумал, что так можно.
И скорость в точности как у меня стала лол (только Text убрал, чтобы замерить).
Без имени-1.png
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение popoveo » 01.01.2017 13:10:30

Здравствуйте, уважаемые форумчане и с Новым Годом Вас!
Вижу, что тема вызвала много откликов, а значит интересна. Почерпнул много необычных, нестандартных приемов, за что отдельное огромное спасибо участникам. Но начинал я эту тему не для того, чтобы понять, как обойти ограничения языка - от создания временных объектов я легко могу отказаться в своем коде, как и любой другой. Просто мне бы хотелось, чтобы разработчики обратили внимание на этот досадный момент, поскольку эта ошибка архитектурная. Попытаюсь объяснить, почему:
1) Программист в данной ситуации не может контролировать работу с памятью, в то время как синтаксис и семантика языка позволяют написать некорректные выражения. В своем коде, конечно, знаешь ограничения и ошибок не сделаешь. А если пишешь код для сторонних лиц?
2) Почему в таком же временном выражении при создании перечислителя у последнего вызывается деструктор после отработки цикла, а при использовании операторов - нет? Где здесь логика? Подобные вещи должны обрабатываться однотипно.
3) Для классов используются алгоритмы обработки, отличные от работы с объектами. Так почему этого нет при использовании перегрузки операторов для классов? Опять логическая нестыковка...

P.s. Lazarus и FreePascal мне очень нравятся. Язык давно достиг своей зрелости и легко используется в коммерческих проектах, особенно когда нужна переносимость. Мне бы не хотелось, чтобы разработчики расценили мой пост как нападки или недовольство языком. Это просто попытка указать на недостатки и сделать любимый язык лучше, ведь мы все этого хотим.

P.p.s. По поводу алгоритмов, когда мы считаем переданный аргумент созданным и уменьшаем количество ссылок: это не пройдет, если в середину выражения передается экземпляр класса, который уже есть в группе (группах) и на него уже созданы ссылки. Ограничение логическое, его не обойдешь без допущений вне зависимости от метода.
popoveo
незнакомец
 
Сообщения: 4
Зарегистрирован: 21.12.2016 19:48:19

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение Лекс Айрин » 01.01.2017 14:22:59

popoveo писал(а):Программист в данной ситуации не может контролировать работу с памятью, в то время как синтаксис и семантика языка позволяют написать некорректные выражения. В своем коде, конечно, знаешь ограничения и ошибок не сделаешь. А если пишешь код для сторонних лиц?


Работа с памятью это вообще-то низкоуровневые операции, поэтому они изначально опасны и никуда от этого не деться. Конечно, можно создать слой абстракции делающий ее безопасной, но ошибка в самом этом слое столь же фатальна. Поэтому, в случае ошибок памяти, по крайней мере на текущем уровне развития языка, проще выдать исключение, а если оно не обработано, то уронить программу.

popoveo писал(а):Так почему этого нет при использовании перегрузки операторов для классов? Опять логическая нестыковка...

Потому что это не единый механизм, а несколько несвязанных. Надо полностью переписать язык и библиотеки поддержки, но тогда прощай совместимость с дельфи. Кстати, наличие временных объектов не всегда обязательно.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение runewalsh » 02.01.2017 02:11:27

popoveo писал(а):Почему в таком же временном выражении при создании перечислителя у последнего вызывается деструктор после отработки цикла, а при использовании операторов - нет? Где здесь логика? Подобные вещи должны обрабатываться однотипно.

Операторы могут быть не только для классов, поэтому как раз правило «если операнд — экземпляр класса, он автоматически уничтожается» было бы странным. Тогда как энумераторы (или, скажем, исключения, тоже управляемые автоматически) — всегда экземпляры классов.

Хотя я бы сам не отказался от такого правила, наряду с чем-нибудь типа «в отсутствие модификатора структурам и автотипам в списке параметров автоматически приписывается const» — тоже на первый взгляд НЕПОСЛЕДОВАТЕЛЬНО, но если подумать...

popoveo писал(а):По поводу алгоритмов, когда мы считаем переданный аргумент созданным и уменьшаем количество ссылок: это не пройдет, если в середину выражения передается экземпляр класса, который уже есть в группе (группах) и на него уже созданы ссылки.

Ты не понял. Не созданным, а «захваченным» (инкрементнутым). При передачё счётчик увеличивается , внутри оператора — уменьшается. Раз ссылки держались где-то ещё, счётчик останется >0 и объект не уничтожится. И наоборот, если объект создан на месте, у него будет счётчик = 1, внутри оператора он декрементируется до 0 и уничтожится. С интерфейсными ссылками всё это происходит автоматически.
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение popoveo » 03.01.2017 14:06:31

popoveo писал(а):Почему в таком же временном выражении при создании перечислителя у последнего вызывается деструктор после отработки цикла, а при использовании операторов - нет? Где здесь логика? Подобные вещи должны обрабатываться однотипно.

runewalsh писал(а):Операторы могут быть не только для классов, поэтому как раз правило «если операнд — экземпляр класса, он автоматически уничтожается» было бы странным. Тогда как энумераторы (или, скажем, исключения, тоже управляемые автоматически) — всегда экземпляры классов.


Совершенно верно. Поэтому я и написал: "3) Для классов используются алгоритмы обработки, отличные от работы с объектами. Так почему этого нет при использовании перегрузки операторов для классов? Опять логическая нестыковка..."

runewalsh писал(а):Хотя я бы сам не отказался от такого правила, наряду с чем-нибудь типа «в отсутствие модификатора структурам и автотипам в списке параметров автоматически приписывается const» — тоже на первый взгляд НЕПОСЛЕДОВАТЕЛЬНО, но если подумать...


Неплохая, кстати, идея :!:

popoveo писал(а):По поводу алгоритмов, когда мы считаем переданный аргумент созданным и уменьшаем количество ссылок: это не пройдет, если в середину выражения передается экземпляр класса, который уже есть в группе (группах) и на него уже созданы ссылки.

runewalsh писал(а):Ты не понял. Не созданным, а «захваченным» (инкрементнутым). При передачё счётчик увеличивается , внутри оператора — уменьшается. Раз ссылки держались где-то ещё, счётчик останется >0 и объект не уничтожится. И наоборот, если объект создан на месте, у него будет счётчик = 1, внутри оператора он декрементируется до 0 и уничтожится. С интерфейсными ссылками всё это происходит автоматически.


Да нет, все я понял... "A" входит в пару групп, количество ссылок, например, 2. Просто вот так: B:=(A+A)+(A+A); Здесь логическая нестыковка - как не пытайся, но не сможешь отследить временное это выражение или нет. Тоже об этом писал, нет способов общего решения на текущий момент, можно обработать только частные случаи.

P.s. Это обращение к разработчикам.
Я понимаю, что паскаль это не си, и автовызов деструкторов просто сломает саму концепцию языка.
НО: По сути, каждый блок кода в ОО-языке - это неименованный класс со своими переменными и кодом. Так дайте возможность вызова для блока конструктора и деструктора! Куча проблем и нестыковок сразу уйдут в прошлое и ничего при этом не сломается. Давайте ориентироваться на неименованные (лямбда) функции и идти еще дальше!
popoveo
незнакомец
 
Сообщения: 4
Зарегистрирован: 21.12.2016 19:48:19

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение vitaly_l » 03.01.2017 14:44:49

popoveo писал(а):как не пытайся, но не сможешь отследить временное это выражение или нет. Тоже об этом писал, нет способов решения на текущий момент, можно обработать только частные случаи.

А разве нельзя создать все классы ну или возможно сами операторы - динамически в какой-нить array of TSomeClass или array of TSomeOperator ? :arrow: И потом просто чистить этот массив и удалять классы и операторы вместе с элементами массива ?
Так нельзя? :roll:

.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3333
Зарегистрирован: 31.01.2012 16:41:41

Re: Вопрос про освобождение памяти при перегрузке операторов

Сообщение runewalsh » 04.01.2017 02:31:36

popoveo писал(а):"A" входит в пару групп, количество ссылок, например, 2. Просто вот так: B:=(A+A)+(A+A); Здесь логическая нестыковка - как не пытайся, но не сможешь отследить временное это выражение или нет.

Чёт моя очередь не понимать. Что ты вообще имеешь в виду? Что значит временное? В наших вариантах временные объекты существуют только внутри выражений как результаты операторов, A в любом случае не считается временным, как раз чтобы работали такие выражения.
Аватара пользователя
runewalsh
энтузиаст
 
Сообщения: 578
Зарегистрирован: 27.04.2010 00:15:25

Пред.След.

Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: Google Adsense [Bot] и гости: 3

Рейтинг@Mail.ru