class operator OnesComplement ? o.O

[Stevie]

Nur mal kurz zusammengeschludert:

Delphi-Quellcode:

program RecordFinalizer;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Generics.Collections,
  SysUtils,
  TypInfo,
  DDetours;

type
  TFinalizer = procedure (Self: Pointer);
  TCopyOperator = procedure (Dest, Source: Pointer);

var
  Finalizers: TDictionary<PTypeInfo,TFinalizer>;
  CopyOperators: TDictionary<PTypeInfo,TCopyOperator>;

type
  TMyRecord = record
  private
    s: string;
  public
    procedure Destroy;
    class procedure Copy(var dest, source: TMyRecord); static;
  end;

{ TMyRecord }

class procedure TMyRecord.Copy(var dest, source: TMyRecord);
begin
  dest.s := 'Copy: ' + source.s;
end;

procedure TMyRecord.Destroy;
begin
  Writeln(s);
  Writeln('TMyRecord.Destroy');
end;

procedure Main;
var
  r, r2: TMyRecord;
begin
  r.s := 'Hello World';
  r2 := r;
end;


function GetFinalizeRecord: Pointer;
asm
  mov @Result, offset System.@FinalizeRecord
end;

function GetCopyRecord: Pointer;
asm
  mov @Result, offset System.@CopyRecord
end;

var
  FinalizeRecord: function(p: Pointer; typeInfo: Pointer): Pointer;
  CopyRecord: procedure (Dest, Source, TypeInfo: Pointer);

function FinalizeRecordHook(p: Pointer; typeInfo: Pointer): Pointer;
var
  finalizer: TFinalizer;
begin
  if Finalizers.TryGetValue(typeInfo, finalizer) then
    finalizer(p);
  if Assigned(FinalizeRecord) then
    Result := FinalizeRecord(p, typeInfo);
end;

procedure CopyRecordHook(Dest, Source, TypeInfo: Pointer);
var
  copyOperator: TCopyOperator;
begin
  if CopyOperators.TryGetValue(TypeInfo, copyOperator) then
    copyOperator(Dest, Source)
  else
    CopyRecord(Dest, Source, TypeInfo);
end;

begin
  Finalizers := TDictionary<PTypeInfo,TFinalizer>.Create;
  Finalizers.Add(TypeInfo(TMyRecord), @TMyRecord.Destroy);

  CopyOperators := TDictionary<PTypeInfo,TCopyOperator>.Create;
  CopyOperators.Add(TypeInfo(TMyRecord), @TMyRecord.Copy);

  FinalizeRecord := InterceptCreate(GetFinalizeRecord, @FinalizeRecordHook);
  CopyRecord := InterceptCreate(GetCopyRecord, @CopyRecordHook);

  try
    Main;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
  ReportMemoryLeaksOnShutdown := True;

  InterceptRemove(@FinalizeRecord);
  InterceptRemove(@CopyRecord);
  Finalizers.Free;
  CopyOperators.Free;
end.

[Mavarik]

Zitat von Stevie:

Nur mal kurz zusammengeschludert:

Hi Stevie!

Immer wenn ich "Deinen" Sourcecode lese, habe ich das Gefühl ich habe keine Ahnung von Delphi...

Bedeutet das ich kann doch den RecordCopy "überladen"?

Problem ist:

Delphi-Quellcode:

type
  TFoo = record
           A : Array of String;
         end;

Var
  Foo : TFoo;

Procedure MachNixMitFoo;
var
  Merk : TFoo;
begin
  Merk := Foo;
  Foo[3] := 'Soll nicht geändert werden';
  Machwas(Foo);
  Foo := Merk;
end;

Leider ist Foo[3] danach mit 'Soll nicht geändert werden' belegt, da "nur" die Referenzen Kopiert werden.

Bietet "Deine" Routine da einen Lösung?

Mavarik

[himitsu]

Das ist das eines der Probleme, die ich damit lösen wollte.

Für dynamische Arrays gibt es kein CopyOnWrite, wenn man schreibend auf ein Feld des dynamischen Arrays zugreift.
Bei Strings (die intern auch nur aufgemotzte dynamische Arrays sind) wird vor jedem Schreibzugriff auf ein Char (da ja array[1..length] of char ) sichergestellt, daß RefCount auch 1 ist.
(durch Aufruf von UniqueString)

[Stevie]

Zitat von Mavarik:

Bedeutet das ich kann doch den RecordCopy "überladen"?

Naja, als Überladen würd ich das nicht bezeichnen. Da werden System Funktionen gehooked.
D.h. bei allen vom Compiler generierten CopyRecord aufrufen in deiner gesamten Anwendung läuft der extra Dictionary Lookup.

Ich bin ja schon recht großzügig, Code nicht als Hack sondern als "geschickte Ausnutzung der Mechanik" zu bezeichnen, aber das ist definitiv ein Hack - und zwar ein gewaltiger - da muss man schon wissen, was man damit anstellt

Zitat von Mavarik:

Bietet "Deine" Routine da einen Lösung?

Vermutlich denkst du an sowas?

Delphi-Quellcode:

class procedure TFoo.Copy(var dest, source: TFoo);
begin
  dest.a := System.Copy(source.a);
end;

Jo, müsste gehen.

Gibt allerdings noch eine andere Möglichkeit, die genauso funktioniert, wie bei Strings:

Delphi-Quellcode:

type
  TFoo = record
  private
    a: array of string;
    function GetItem(i: Integer): string; inline;
    procedure SetItem(i: Integer; const Value: string); inline;
  public
    property Items[i: Integer]: string read GetItem write SetItem; default;
  end;

function GetArrayRef(A: Pointer): Integer; inline;
type // geliehen aus der System.pas
  PDynArrayRec = ^TDynArrayRec;
  TDynArrayRec = packed record
  {$IFDEF CPUX64}
    _Padding: LongInt; 
  {$ENDIF}
    RefCnt: LongInt;
    Length: NativeInt;
  end;
begin
  Result := NativeInt(A);
  if Result <> 0 then
    Result := PDynArrayRec(PByte(A) - SizeOf(TDynArrayRec))^.RefCnt;
end;

function TFoo.GetItem(i: Integer): string;
begin
  Result := a[i];
end;

procedure TFoo.SetItem(i: Integer; const Value: string);
begin
  if GetArrayRef(a) > 1 then
    a := System.Copy(a);
  a[i] := Value;
end;

[himitsu]

Am schönsten wäre es ja, wenn man auf sowas wie deim GetArrayRef verzichten könnte.
Für Strings hat man das ja inzwischen auch eingebaut. StringRefCount

Copy(arr) ruft System.DynArrayCopy auf, aber du kannst stattdessen, und ohne RefCount vorher zu prüfen, System.DynArrayUnique ausrufen (prüft selbst intern das RefCount)


Aber am "optimalsten" wäre es halt, wenn Emba solche Methoden in der RTTI aufnimmt, also direkt als Flag/Referenz, so wie z.B. beim [Weak]-Status,
und dann in den originalen Funktionen ganz schnell zu schauen, ob es was zum Aufrufen gibt, welches per Class-Operator dort eingetragen wurde.

[Mavarik]

Zitat von Stevie:

Jo, müsste gehen.

Gibt allerdings noch eine andere Möglichkeit, die genauso funktioniert, wie bei Strings:

Delphi-Quellcode:

type
  TFoo = record
  private
    a: array of string;
    function GetItem(i: Integer): string; inline;
    procedure SetItem(i: Integer; const Value: string); inline;
  public
    property Items[i: Integer]: string read GetItem write SetItem; default;
  end;

function GetArrayRef(A: Pointer): Integer; inline;
type // geliehen aus der System.pas
  PDynArrayRec = ^TDynArrayRec;
  TDynArrayRec = packed record
  {$IFDEF CPUX64}
    _Padding: LongInt; 
  {$ENDIF}
    RefCnt: LongInt;
    Length: NativeInt;
  end;
begin
  Result := NativeInt(A);
  if Result <> 0 then
    Result := PDynArrayRec(PByte(A) - SizeOf(TDynArrayRec))^.RefCnt;
end;

function TFoo.GetItem(i: Integer): string;
begin
  Result := a[i];
end;

procedure TFoo.SetItem(i: Integer; const Value: string);
begin
  if GetArrayRef(a) > 1 then
    a := System.Copy(a);
  a[i] := Value;
end;

OK Aber dann muss man "überall" den Zugriff ändern.

Ich suche eher eine Lösung für den Umstiegt von Short auf Long und Array[L..H] nach Array of...

Beispiel:

Delphi-Quellcode:

type
  TFooOld = Record
              Bla : Integer;
              Blub : Array[0..10] of Shortstring;
            end;
  TFooNeu = Record
              Bla : Integer;
              Blub : Array of String; // Oder auch TStringDynArray
            end;

Der "Rest" der Software hat keine Ahnung von der Umstellung... Abgesehen von den entsprechenden SetLength.

So ALLE

Delphi-Quellcode:

var
  A,B : TFooNeu;
begin
  ...
  A := B;
end;

müssen sich genau verhalten wie vorher... Ohne
A := B.Clone aufrufen zu müssen....

Mavarik

[himitsu]

Blub als Array-Property deklarieren und dort im Setter ein UniqueArray.

[Stevie]

Zitat von himitsu:

Blub als Array-Property deklarieren und dort im Setter ein UniqueArray.

Vermutlich müsste er dann alle SetLength auf Blub im Code ändern... - aber die dürften ja über Compilefehler zu finden sein.

Einfach Zähne zusammen beißen, die Record Types vernünftig kapseln und dann is gut.

[Mavarik]

Zitat von himitsu:

UniqueArray.

UniqueArray?

Gab es das schon in D2007?
Momentan mach ich immer ein Copy im Setter...

[himitsu]

k.A.
In XE(1) hab ich es nicht gefunden ... dachte aber das gibt's schon viel länger.
Vielleicht unter einem anderem Name, aber auch da fand ich auf die Schnelle nix.