[fpc-devel] Using case statement instead of VTable

Hairy Pixels genericptr at gmail.com
Tue Apr 11 12:11:01 CEST 2023



> On Apr 11, 2023, at 4:02 PM, Marco van de Voort via fpc-devel <fpc-devel at lists.freepascal.org> wrote:
> 
> That's what I thought, yes. But the whole analysis stays the same:
> 
> - you don't have a list of all possible polymorphic types in the application when you compile the average dispatch point, that is in the realm of whole-program optimization.   (I saw your later mail that you understood this, but I already composed this message when it arrived)

Yeah I think that’s kind of kills the idea.

Btw, I was curious because I haven’t done this in so many years but is this basically how a VTable looks in procedural code?

The idea is that the record adds all function pointers from all the descendants and fills them out with local implementation as pseudo-overriding.

============================================

{$mode objfpc}

program procedural_oop;
uses
	UDog, UAnimal;

var
	dog: PDog;
begin
	dog := TDog_Init;
	dog^.walk_proc(PAnimal(dog));
	dog^.bark_proc(dog);
end.

============================================

{$mode objfpc}

unit UDog;
interface
uses
  UAnimal;

type
  PDog = ^TDog;
  TDog = record
    // TAnimal methods
    walk_proc: procedure(self: PAnimal);
    // TDog methods
    bark_proc: procedure(self: PDog);
    // instance members
    sound: string;
  end;

function TDog_Init: PDog;
procedure TDog_Bark(self: PDog);

implementation

procedure TDog_Bark(self: PDog);
begin
  writeln('dog goes ', self^.sound);
end;

function TDog_Init: PDog;
begin
  result := PDog(GetMem(sizeof(TDog)));

  // setup methods
  result^.walk_proc := @TAnimal_Walk;   // use parent implementation
  result^.bark_proc := @TDog_Bark;      // override with current implementation

  // init members
  result^.sound := 'woof!'
end;

end.

============================================

{$mode objfpc}

unit UAnimal;
interface

type
  PAnimal = ^TAnimal;
  TAnimal = record
    walk_proc: procedure(self: PAnimal);
  end;

function TAnimal_Init: PAnimal;
procedure TAnimal_Walk(self: PAnimal); 

implementation

procedure TAnimal_Walk(self: PAnimal); 
begin
  writeln('animal walks');
end;

function TAnimal_Init: PAnimal;
begin
  result := PAnimal(GetMem(sizeof(TAnimal)));

  // setup methods
  result^.walk_proc := @TAnimal_Walk;
end;

end.

Regards,
Ryan Joseph



More information about the fpc-devel mailing list