Feuilles de root

Logiciels libres, programmation et économie

Accueil » Programmation » Programmation Free Pascal » Implémenter un compteur de références

Implémenter un compteur de références

L'un des points critique de la programmation de jeu vidéo est la gestion de la mémoire.

La solution présentée ici est simplement un port en Free Pascal du code C++ proposé dans cet article.

Dans la clause uses de la section interface de l'unité, il faut inclure l'unité glists (ou directement fgl).

Il faut commencer par une déclaration partielle :

TIMMObject = class;

Ensuite nous spécialisons une liste générique. Ici j'ai utilisé TGlist, mais on pourrait utiliser directement la liste TFPGList disponible dans l'unité fgl.

TIMMObjectList = specialize TGlist<TIMMObject>;
{ TIMMObject }

TIMMObject = class
private
    class var FLiveObjects : TIMMObjectList;
public
    class constructor CreateClass;
    class destructor DestroyClass;
    constructor Create;
end;

Dans la section implementation :

{ TIMMObject }

class constructor TIMMObject.CreateClass;
begin
    FLiveObjects := TIMMObjectList.Create;
end;

class destructor TIMMObject.DestroyClass;
begin
    FLiveObjects.Clear;
    FLiveObjects.Free;
end;

constructor TIMMObject.Create;
begin
    FLiveObjects.Add(Self);
    { update the constructor to initialise refCount to zero }
    FRefCount := 0;
end;
TIMMObject = class
private
    class var FLiveObjects : TIMMObjectList;
    FRefCount : Integer;
public
    class constructor CreateClass;
    class destructor DestroyClass;
    constructor Create;
    procedure AddRef;
    procedure Release;
    class procedure CollectGarbage;
end;
constructor TIMMObject.Create;
begin
    FLiveObjects.Add(Self);
    { update the constructor to initialise refCount to zero }
    FRefCount := 0;
end;

procedure TIMMObject.AddRef;
begin
    Inc(FRefCount);
end;

procedure TIMMObject.Release;
begin
    Dec(FRefCount);
end;

class procedure TIMMObject.CollectGarbage;
var
    i : Integer;
begin
    for i := FLiveObjects.Count - 1 downto 0 do
    begin
        if FLiveObjects[i].FRefCount = 0 then
        begin
            FLiveObjects[i].Free;
            FLiveObjects.Delete(i);
        end;
    end;
end;

Cette construction n'est toutefois pas efficace si le ratio des objets actifs sur les objets à détruire est élevé. Si 5000 objets sont présents dans la liste et qu'il faut en libérer 10, 5000 objets seront vérifier. Ajoutons donc une seconde liste FDeadObjects.

procedure TIMMObject.Release;
begin
    Dec(FRefCount);
    if FRefCount <= 0 then
    begin
        FLiveObjects.Remove(Self);
        FDeadObjects.Add(Self);
    end;
end;

class procedure TIMMObject.CollectGarbage;
var
    i : Integer;
begin
    for i := 0 to FDeadObjects.Count - 1 do
        FDeadObjects[i].Free;
    FDeadObjects.Clear;
end;
class procedure TIMMObject.CollectRemainingObjects(const AEmitWarnings : Boolean
    );
var
    i : Integer;
begin
    for i := 0 to FLiveObjects.Count - 1 do
    begin
        if AEmitWarnings then
            TDebugLogger.Log('Warning');
        FLiveObjects[i].Free;
    end;
    FLiveObjects.Clear;
end;