I am trying to come up with a fairly general code that swaps 2 objects.

Both objects will be the same class at the time I call this procedure,
but they can be any descendant of TObject.

The following doesn't work.


Procedure Exchange2Objects(var AObject: TObject; var BObject: TObject);
var
  Object1: TObject;
begin
  Object1 := AObject;
  AObject := BObject;
  BObject := Object1;
end;

Is there one that does?

Yes, it will work as you wrote it.

But don't forget that you just swap pointers, not the actual values of the objects.

So don't expect any other object or component using these objects to know about the swap: you just swap the addresses of the supplied parameters, not the object content.

> {quote:title=Arnaud BOUCHEZ wrote:}{quote}
> So don't expect any other object or component using these objects to know about the swap: you just swap the addresses of the supplied parameters, not the object content.

In you are not in a multithreaded app, you can try this code, which MAY copy the object content. Not fully tested, just a try....

{code}
procedure SwapObjects(var O1,O2: TObject);
var tmp: pointer;
    Len: integer;
begin
  if (O1=O2) or (O1=nil) or (O2=nil) then
    exit; // don't swap same objects or null objects
  Len := O1.InstanceSize;
  if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
    exit; // need same exact classes
  Getmem(tmp,Len);
  try
    Move(pointer(O1)^,tmp^,Len);
    Move(pointer(O2)^,pointer(O1)^,Len);
    Move(tmp^,pointer(O2)^,Len);
  finally
    Freemem(tmp);
  end;
end;
{code}

Code above won't work as expected, because InstanceSize contains the vmt table...

This one could work better:
{code}

procedure SwapObjects(var O1,O2: TObject);
var tmp,P1,P2: pointer;
    Len: integer;
const
    ovtVmtPtrOffs = -4;
begin
  if (O1=O2) or (O1=nil) or (O2=nil) then
    exit; // don't swap same objects or null objects
  Len := O1.InstanceSize;
  if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
    exit; // need same exact classes
  Getmem(tmp,Len);
  try
    P1 := pointer(integer(@O1)+ovtVmtPtrOffs); // Point to VMT
    P2 := pointer(integer(@O2)+ovtVmtPtrOffs); // Point to VMT
    Move(P1^,tmp^,Len);
    Move(P2^,P1^,Len);
    Move(tmp^,P2^,Len);
  finally
    Freemem(tmp);
  end;
end;
{code}

> In you are not in a multithreaded app, you can try this code, which MAY copy the object content. Not fully tested, just a try....
>
> {code}
> procedure SwapObjects(var O1,O2: TObject);
> var tmp: pointer;
>      Len: integer;
> begin
>    if (O1=O2) or (O1=nil) or (O2=nil) then
>      exit; // don't swap same objects or null objects
>    Len := O1.InstanceSize;
>    if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
>      exit; // need same exact classes
>    Getmem(tmp,Len);
>    try
>      Move(pointer(O1)^,tmp^,Len);
>      Move(pointer(O2)^,pointer(O1)^,Len);
>      Move(tmp^,pointer(O2)^,Len);
>    finally
>      Freemem(tmp);
>    end;
> end;
> {code}

This is just as good as changing the pointer addresses but takes much 
longer.

kind regards
   Mike

> This is just as good as changing the pointer addresses but takes much 
> longer.
> 
> kind regards
>    Mike

No it's not the same, as I said in my first post, if some external components or objects use these two objects, swaping the pointers won't be reflected, but swaping the content of the objects will work.

> No it's not the same, as I said in my first post, if some external
> components or objects use these two objects, swaping the pointers
> won't be reflected, but swaping the content of the objects will work.

When I try do something like below

var
  Panel1: TPanel;
  Panel2: TPanel;
begin
  SwapObjects(Panel1, Panel2);
end;

I get this error:

[DCC Error] E2033 Types of actual and formal var parameters must be
identical

Any idea how to get past that?

Adem Meda wrote:

> I am trying to come up with a fairly general code that swaps 2
> objects.
> 
> Both objects will be the same class at the time I call this procedure,
> but they can be any descendant of TObject.
> 
> The following doesn't work.
> 
> 
> Procedure Exchange2Objects(var AObject: TObject; var BObject:
> TObject); var
>   Object1: TObject;
> begin
>   Object1 := AObject;
>   AObject := BObject;
>   BObject := Object1;
> end;
> 

It does work, you just have to call it with typecasts to keep the
compiler happy:

  Exchange2Objects(TObject(Obj1), TObject(obj2));

Here is a more generic method:

Procedure SwapAnything( Var a, b; datasize: Integer );
Var
  pBuf: PByte;
Begin
  GetMem( pBuf, datasize );
  try
    Move( a, pBuf^, datasize );
    Move( b, a, datasize );
    Move( pBuf^, b, datasize );
  finally
    FreeMem( pBuf );
  end;
End;

SwapAnything( a, b, Sizeof(a));

will work regardless of the types of a and b, as long as both are of
identical types (or at least have the same size, swapping a longint and
a single would work, with somewhat dubious result). It may not always
work intuitively, especially with types which are really pointer types
in disguise, like AnsiString or objects.

Like any routine using untyped Var parameters it is inherently dangerous
and can cost you a lot of hair when used incorrectly.

If you are using Delphi 2009 and above you can also use real generics. 

type
  TSwapper<T> = class
  public
     class procedure Swap(Var A, B: T);
  end;
class procedure TSwapper<T>.Swap(Var A, B: T);
var
  Temp: T;
begin
  Temp:= A;
  A:= B;
  B:= Temp;
end;

  TSwapper<TMyClass>.Swap(obj1, obj2);

where both objects are of class TMyClass.


-- 
Peter Below (TeamB)  
Don't be a vampire (http://slash7.com/pages/vampires), 
use the newsgroup archives :
http://codenewsfast.com
http://groups.google.com

> [DCC Error] E2033 Types of actual and formal var parameters must be
> identical
> 
> Any idea how to get past that?

Simply remove the "var":

procedure SwapObjects(O1,O2: TObject);


-- 
Jens Gruschel
http://www.pegtop.net

>   if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
>     exit; // need same exact classes

If the classtype is the same, the instance size cannot be different :-)


-- 
Jens Gruschel
http://www.pegtop.net

Jens Gruschel wrote:

> > [DCC Error] E2033 Types of actual and formal var parameters must be
> > identical
> > 
> > Any idea how to get past that?
> 
> Simply remove the "var":
> 
> procedure SwapObjects(O1,O2: TObject);

Then, this error message:

"Demo.exe faulted with message 'priviledged istruction at 0x0018f8e0'."

It's pretty fatal.

Peter,

> Here is a more generic method:

This works, but having to remember to the class types and add sizeof()
is kind of drag.

If I forego type checking, would the following be gauaranteed to work
for all TObject descendants --I kinda think it would but would like to
hear it from you :)

Procedure Swap2Objects(Var a, b);
const
  DataSize = SizeOf(TObject);
Var
  pBuf: PByte;
Begin
  Getmem(pBuf, DataSize);
  try
    Move(a, pBuf^, DataSize);
    Move(b, a, DataSize);
    Move(pBuf^, b, DataSize);
  finally
    Freemem(pBuf);
  end;
End;

> If you are using Delphi 2009 and above you can also use real
> generics.

Thanks, but D7 is still good enough for me.

Cheers,

Adem

Adem Meda <adem.meda@gmail.com> wrote:
> I am trying to come up with a fairly general code that swaps 2
> objects.
> 
> Both objects will be the same class at the time I call this procedure,
> but they can be any descendant of TObject.
> 
> The following doesn't work.
> 
> 
> Procedure Exchange2Objects(var AObject: TObject; var BObject:
> TObject);
> var
>   Object1: TObject;
> begin
>   Object1 := AObject;
>   AObject := BObject;
>   BObject := Object1;
> end;
> 
> Is there one that does?

Pardon my ignorance but in what cases would you want to do this?

Just try like this:
{code}
procedure SwapObjects(O1,O2: TObject);
var tmp,P1,P2: pointer;
    Len: integer;
const
    ovtVmtPtrOffs = -4;
begin
  if (O1=O2) or (O1=nil) or (O2=nil) then
    exit; // don't swap same objects or null objects
  Len := O1.InstanceSize;
  if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
    exit; // need same exact classes
  Getmem(tmp,Len);
  try
    P1 := pointer(integer(O1)+ovtVmtPtrOffs); // Point to VMT
    P2 := pointer(integer(O2)+ovtVmtPtrOffs); // Point to VMT
    Move(P1^,tmp^,Len);
    Move(P2^,P1^,Len);
    Move(tmp^,P2^,Len);
  finally
    Freemem(tmp);
  end;
end;
{code}
Notes:
1. The @O1 and @O2 were faulty.
2. The var in parameters was not necessary, indeed.
3. The "generic" Delphi 2009 function is not necessary: just use a pointer to TObject.
4. The version of Adem Meda  will copy only two pointers, because DataSize = SizeOf(TObject) will always be executed as DataSize := 4 since a TObject is a pointer. My version use the true instance size of the object.
5. I agree with Jens Gruschel that if the classtype is the same, the instance size should be the same: this check was just "pedagogical" ;)

> {quote:title=Jens Gruschel wrote:}{quote}
> >   if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
> >     exit; // need same exact classes
> 
> If the classtype is the same, the instance size cannot be different :-)

Indeed - my check was "pedagogical" ;)

This will copy only two pointers, because DataSize = SizeOf(TObject) will always be executed as DataSize := 4 since a TObject is a pointer. My version use the true instance size of the object.

See https://forums.embarcadero.com/thread.jspa?messageID=256166&#256166

Thomas Hahn wrote:

> Pardon my ignorance but in what cases would you want to do this?

As it stands, it does seem like a silly thing to do; doesn't it? :)

It does.

But, I am using this as part of a larger code --in a polymorphic
tree/graph structure.

In that class, everything (including the root node) are all identical,
or descendants from a base class.

There are times when you wish to swap a node somewhere in that
tree/graph thing with something else within the same tree/graph or some
entirely different tree/graph.

After the swap operation, I wanted to keep referring to the same
variable names --as opposed to keeping dummy local copies. It's more
convenient this way.

It will be a class procedure.

Having read what I wrote, I am not sure if it still makes sense; but,
that's the best I could explain it.

Arnaud BOUCHEZ wrote:

> Just try like this:

It works. Thanks.

Now, a couple more questions:

1) Is this Delphi specific? I mean, would it also work in FPC?
2) Is there anything 32-bit specific in it; would it work in 64-bit FPC?

> 1) Is this Delphi specific? I mean, would it also work in FPC?
I checked the objpash.inc file of the FPC 2.4 source code.
I suspect it would work with
{code}
const
    ovtVmtPtrOffs = vmtInstanceSize;
{code}
There is a comment which states that all vmt were negative value's, but are now positive, because some OS expect that.
I don't know on which FPC version these values started. Using vmtInstanceSize instead of 0 should work always... but it was not tested...

> 2) Is there anything 32-bit specific in it; would it work in 64-bit FPC?

You will have to change the integer to the PtrInt FPC 64 bits compatible type. But you'll have to define type PtrInt = integer; under Delphi.
{code}
    P1 := pointer(PtrInt(O1)+ovtVmtPtrOffs); // Point to VMT
    P2 := pointer(PtrInt(O2)+ovtVmtPtrOffs); // Point to VMT
{code}

So for a true cross-platform procedure, you may try:
{code}
procedure SwapObjects(O1,O2: TObject);
var tmp,P1,P2: pointer;
    Len: integer;
const
{$ifdef FPC}
    ovtVmtPtrOffs = vmtInstanceSize;
{$else}
    ovtVmtPtrOffs = -4;
type
  PtrInt = integer;
{$endif}
begin
  if (O1=O2) or (O1=nil) or (O2=nil) then
    exit; // don't swap same objects or null objects
  Len := O1.InstanceSize;
  if (O1.ClassType<>O2.ClassType) or (Len<>O2.InstanceSize) then
    exit; // need same exact classes
  Getmem(tmp,Len);
  try
    P1 := pointer(PtrInt(O1)+ovtVmtPtrOffs); // Point to VMT
    P2 := pointer(PtrInt(O2)+ovtVmtPtrOffs); // Point to VMT
    Move(P1^,tmp^,Len);
    Move(P2^,P1^,Len);
    Move(tmp^,P2^,Len);
  finally
    Freemem(tmp);
  end;
end;
{code}

Adem Meda <adem.meda@gmail.com> wrote:
> Thomas Hahn wrote:
> 
>> Pardon my ignorance but in what cases would you want to do this?
> 
> As it stands, it does seem like a silly thing to do; doesn't it? :)
> 
> It does.
> 
> But, I am using this as part of a larger code --in a polymorphic
> tree/graph structure.
> 
> In that class, everything (including the root node) are all identical,
> or descendants from a base class.
> 
> There are times when you wish to swap a node somewhere in that
> tree/graph thing with something else within the same tree/graph or
> some
> entirely different tree/graph.
> 
> After the swap operation, I wanted to keep referring to the same
> variable names --as opposed to keeping dummy local copies. It's more
> convenient this way.
> 
> It will be a class procedure.
> 
> Having read what I wrote, I am not sure if it still makes sense; but,
> that's the best I could explain it

I understand generally what you are saying; thank you for answering.

"Peter Below" wrote
> Here is a more generic method:
> Procedure SwapAnything( Var a, b; datasize: Integer );
> Var
>  pBuf: PByte;
> Begin
>  GetMem( pBuf, datasize );
>  try
>    Move( a, pBuf^, datasize );
>    Move( b, a, datasize );
>    Move( pBuf^, b, datasize );
>  finally
>    FreeMem( pBuf );
>  end;
> End;
> ...
> Like any routine using untyped Var parameters it is inherently
> dangerous and can cost you a lot of hair when used incorrectly.

Peter, Adem, et. al,

Of you like a little more checking for programmer errors,
you might consider:

Procedure Exchange2Objects(var A, B);
var Object1: TObject;
begin
  Assert(TObject(A) is TObject(B).ClassType);
  Assert(TObject(B) is TObject(A).ClassType);
  Object1 := TObject(A);
  TObject(A)  := TObject(B);
  TObject(B)  := Object1;
end;

Rgds, JohnH

PS: Thx for example of using generics.

Instead of 
  Assert(TObject(A) is TObject(B).ClassType);
  Assert(TObject(B) is TObject(A).ClassType);
I should have coded
  Assert(TObject(A).ClassType = TObject(B).ClassType,
      'Class types are not the same.');

--JohnH

Instead of 
  Assert(TObject(A) is TObject(B).ClassType);
  Assert(TObject(B) is TObject(A).ClassType);
maybe I should have coded
  Assert(Assigned(TObject(A)),'A is not assigned.');
  Assert(Assigned(TObject(B)),'B is not assigned.');
  Assert(TObject(A).ClassType = TObject(B).ClassType,
      'Class types are not the same.');

--JohnH

Arnaud,

Thank you.

It all works to my heart's content now :)

Cheers,

Adem

Adem Meda wrote:

> I am trying to come up with a fairly general code that swaps 2
> objects.
> 
> Both objects will be the same class at the time I call this procedure,
> but they can be any descendant of TObject.
> 
> The following doesn't work.

It should.

But what exactly do you mean with "swap objects"? Swap the contents or
swap the references? Your code merely swaps references.
-- 
Rudy Velthuis (TeamB)        http://www.teamb.com

"I hear Glenn Hoddle has found God. That must have been one hell
 of a pass." -- Bob Davies.

Arnaud BOUCHEZ wrote:

> This will copy only two pointers, because DataSize = SizeOf(TObject)
> will always be executed as DataSize := 4 since a TObject is a
> pointer. My version use the true instance size of the object.
> 
> See
> https://forums.embarcadero.com/thread.jspa?messageID=256166&#256166

The OP has never specified whether he wants to exchange the content of
the two variables (= pointers) or the content of the objects they point
to, as far as I see...

-- 
Peter Below (TeamB)  
Don't be a vampire (http://slash7.com/pages/vampires), 
use the newsgroup archives :
http://codenewsfast.com
http://groups.google.com

Adem Meda wrote:

> Peter,
> 
> > Here is a more generic method:
> 
> This works, but having to remember to the class types and add sizeof()
> is kind of drag.
> 
> If I forego type checking, would the following be gauaranteed to work
> for all TObject descendants --I kinda think it would but would like to
> hear it from you :)

Oh, it will work for all pointer types, including objects, but since
nothing prevents you from passing any other type to this procedure your
hair is indeed in grave danger here.

In my opinion you have your priorities wrong. You focus on reducing
typing but forget the nightmares that can result later when you go
hunting for obscure errors caused by things you did wrong and which the
compiler could not catch due to your "optimizations". You should focus
on writing safe and clear code, it may take a bit longer to create
(more typing) but that will pack back dividends later when you have to
maintain and extend the code.


-- 
Peter Below (TeamB)  
Don't be a vampire (http://slash7.com/pages/vampires), 
use the newsgroup archives :
http://codenewsfast.com
http://groups.google.com

Peter Below wrote:

> Adem Meda wrote:
> > This works, but having to remember to the class types and add
> > sizeof() is kind of drag.
> > 
> > If I forego type checking, would the following be gauaranteed to
> > work for all TObject descendants --I kinda think it would but would
> > like to hear it from you :)
> 
> Oh, it will work for all pointer types, including objects, but since
> nothing prevents you from passing any other type to this procedure
> your hair is indeed in grave danger here.
> 
> In my opinion you have your priorities wrong. You focus on reducing
> typing but forget the nightmares that can result later when you go
> hunting for obscure errors caused by things you did wrong and which
> the compiler could not catch due to your "optimizations". You should
> focus on writing safe and clear code, it may take a bit longer to
> create (more typing) but that will pack back dividends later when you
> have to maintain and extend the code.

The actual resultant code after taking into account
suggestions/contributions is the following.

As you can see, swapping variable names will be optional --default
being false.

While I am aware that such code is dangerous, it can also be quite
useful when I need it.

Thank you all for taking the time to helping me solve it.

Cheers,

Adem

  class procedure TMyNode.SwapNodes(ANode:: TMyNode; BNode: TMyNode;
ASwapAlsoVariableNameReferences: boolean = False);
  { SwapNodes() exchanges the position of two nodes from the
same/different tree.
    If ASwapAlsoVariableNameReferences is True, then returned ANode
will refer to old BNode (and similarly, returned BNode will refer to
old ANode).
    While powerful, usage of 'ASwapAlsoVariableNameReferences := True'
is also somewhat dangereous; you need to understand what it does.
    When working in different platforms/OSes, you might also have to
modify the code that pertains to 'ASwapAlsoVariableNameReferences :=
True' cases. }
    
    Procedure SwapReferrers(ANode: TMyNode; BNode: TMyNode);
    begin
      { Nodes referring ANode are now going to refer to BNode }
      if Assigned(ANode.FPrevSibling) then begin
        ANode.FPrevSibling.FNextSibling := BNode;
      end;

      if Assigned(ANode.FNextSibling) then begin
        ANode.FNextSibling.FPrevSibling := BNode;
      end;

      if Assigned(ANode.FParent) then begin
        if ANode.FParent.FFirstChild = ANode then begin
          ANode.FParent.FFirstChild := BNode;
        end;
        if ANode.FParent.FLastChild = ANode then begin
          ANode.FParent.FLastChild := BNode;
        end;
      end;

      { Nodes referring BNode are now going to refer to ANode }
      if Assigned(BNode.FPrevSibling) then begin
        BNode.FPrevSibling.FNextSibling := ANode;
      end;

      if Assigned(BNode.FNextSibling) then begin
        BNode.FNextSibling.FPrevSibling := ANode;
      end;

      if Assigned(BNode.FParent) then begin
        if BNode.FParent.FFirstChild = BNode then begin
          BNode.FParent.FFirstChild := ANode;
        end;
        if BNode.FParent.FLastChild = BNode then begin
          BNode.FParent.FLastChild := ANode;
        end;
      end;
    end;

  var
    Parent1: TMyNode;
    Parent2: TMyNode;
    NextSibling1: TMyNode;
    PrevSibling1: TMyNode;

    NextSibling2: TMyNode;
    PrevSibling2: TMyNode;

    PNode1: Pointer;
    PANode1: Pointer;
    PBNode1: Pointer;
    Size1: integer;
    Size2: integer;

  const
    // ovtVmtPtrOffs = vmtInstanceSize; {for FPC}
    ovtVmtPtrOffs = -4; { Delphi 32-bit }
  begin
    if (ANode = BNode) then begin
      raise Exception.Create('Nodes are the same');
    end;

    if (ANode = nil) or (BNode = nil) then begin
      raise Exception.Create('Nodes cannot be nil');
    end;

    if ASwapAlsoVariableNameReferences then begin
      Size1 := ANode.InstanceSize;
      Size2 := BNode.InstanceSize;
      if (Size1 <> Size2) then begin
        raise Exception.Create('InstanceSize of both nodes must be the
same');
      end;
    end;

    Parent1 := ANode.FParent;
    Parent2 := BNode.FParent;

    NextSibling1 := ANode.FNextSibling;
    PrevSibling1 := ANode.FPrevSibling;

    NextSibling2 := BNode.FNextSibling;
    PrevSibling2 := BNode.FPrevSibling;

    { Adjusting nodes that refer to the these two nodes }
    SwapReferrers(ANode, BNode);

    { Adjusting nodes that ANode refers to }
    ANode.FNextSibling := NextSibling2;
    ANode.FPrevSibling := PrevSibling2;

    { Adjusting nodes that BNode refers to }
    BNode.FNextSibling := NextSibling1;
    BNode.FPrevSibling := PrevSibling1;

    { Finally, swap parents of ANode with BNode }
    ANode.FParent := Parent2;
    BNode.FParent := Parent1;

    if ASwapAlsoVariableNameReferences then begin
      GetMem(PNode1, Size1);
      try
        // PANode1 := Pointer(PtrInt(ANode) + ovtVmtPtrOffs); { Point
to VMT - FPC 64bit}
        // PBNode1 := Pointer(PtrInt(BNode) + ovtVmtPtrOffs); { Point
to VMT - FPC 64bit}
        PANode1 := Pointer(integer(ANode) + ovtVmtPtrOffs); { Point to
VMT }
        PBNode1 := Pointer(integer(BNode) + ovtVmtPtrOffs); { Point to
VMT }
        Move(PANode1^, PNode1^, Size1);
        Move(PBNode1^, PANode1^, Size1);
        Move(PNode1^, PBNode1^, Size1);
      finally
        Freemem(PNode1);
      end;
    end;
  end;

Rudy Velthuis (TeamB) wrote:

> Adem Meda wrote:
> 
> > I am trying to come up with a fairly general code that swaps 2
> > objects.
> > 
> > Both objects will be the same class at the time I call this
> > procedure, but they can be any descendant of TObject.
> > 
> > The following doesn't work.
> 
> It should.
> 
> But what exactly do you mean with "swap objects"? Swap the contents or
> swap the references? Your code merely swaps references.

[See the code I posted under Peter's post.]

Swapping contents don't make much sense in my case: While both objects
are descendants from the same class, their contents can be too
incompatible.