[fpc-pascal] Gecko / Firefox / XPCOM

[Henrik Genssen]

so how can this unit be converted to FPC,
as the Memorymanager of FPC seems to differ from delphi...


unit nsMemory;

{$MODE Delphi}

interface

uses
  nsXPCOM;

const
  NS_MEMORY_CONTRACTID = '@mozilla.org/xpcom/memory-service;1';
  NS_MEMORY_CLASSNAME = 'Global Memory Service';
  NS_MEMORY_CID: TGUID = '{30a04e40-38e7-11d4-8cf5-0060b0fc14a3}';

function Alloc(size: Integer): Pointer;
function Realloc(ptr: Pointer; size: Integer): Pointer;
function Free(ptr: Pointer): Integer;
function HeapMinimize(aImmediate: Boolean): Longword;
function Clone(Ptr: Pointer; size: Longword): Pointer;
function GetGlobalMemoryService: nsIMemory;

function GlueStartupMemory: Longword;
procedure GlueShutdownMemory;

procedure SetToMemoryManager;

implementation

uses
  nsError, nsInit;

var
  gMemory: nsIMemory;

procedure FreeGlobalMemory;
begin
  gMemory := nil;
end;

function SetupGlobalMemory: nsIMemory;
begin
  if Assigned(gMemory) then Exit;
  nsInit.NS_GetMemoryManager(gMemory);
  if not Assigned(gMemory) then Exit;
  Result := gMemory;
end;

function GlueStartupMemory: Longword;
begin
  Result := NS_ERROR_FAILURE;
  if Assigned(gMemory) then Exit;
  nsInit.NS_GetMemoryManager(gMemory);
  if not Assigned(gMemory) then Exit;
  Result := NS_OK;
end;

procedure GlueShutdownMemory;
begin
  gMemory := nil;
end;

function ENSURE_ALLOCATOR: Boolean;
begin
  Result := True;
  if not Assigned(gMemory) and not Assigned(SetupGlobalMemory()) then
    Result := False;
end;

function Alloc(size: Integer): Pointer;
begin
  Result := nil;
  if ENSURE_ALLOCATOR then
    Result := gMemory.Alloc(size);
end;

function Realloc(ptr: Pointer; size: Integer): Pointer;
begin
  Result := nil;
  if ENSURE_ALLOCATOR then
    Result := gMemory.Realloc(ptr, size);
end;

function Free(ptr: Pointer): Integer;
begin
  Result := NS_OK;
  if ENSURE_ALLOCATOR then gMemory.Free(ptr)
  else
    Result := Integer(NS_ERROR_UNEXPECTED);
end;

function HeapMinimize(aImmediate: Boolean): Longword;
begin
  Result := NS_ERROR_FAILURE;
  if ENSURE_ALLOCATOR then
  try
    Result := NS_OK;
    gMemory.HeapMinimize(aImmediate);
  except
    Result := NS_ERROR_FAILURE;
  end;
end;

function Clone(ptr: Pointer; size: Longword): Pointer;
begin
  Result := nil;
  if ENSURE_ALLOCATOR then
    Result := Clone(Ptr, size);
end;

function GetGlobalMemoryService: nsIMemory;
begin
  Result := nil;
  if not ENSURE_ALLOCATOR then Exit;
  Result := gMemory;
end;

const
  memmgr: TMemoryManager = (
    GetMem: Alloc;
    FreeMem: Free;
    ReallocMem: Realloc;
  );
procedure SetToMemoryManager;
begin
  SetMemoryManager(memmgr);
end;

end.



>reply to message:
>date: 24.05.2009 18:28:19
>from: "Flávio Etrusco" <flavio.etrusco at gmail.com>
>to: "FPC-Pascal users discussions" <fpc-pascal at lists.freepascal.org>
>subject: Re: [fpc-pascal] Gecko / Firefox / XPCOM
>
>On Sun, May 24, 2009 at 9:30 AM, Jonas Maebe <jonas.maebe at elis.ugent.be> wrote:
>>
>> On 21 May 2009, at 22:34, Henrik Genssen wrote:
>>
>>> nsMemory.pas(157,17) Error: Incompatible types: got "Realloc(Pointer,
>>> LongInt):^untyped" expected "<procedure variable type of function(var
>>> Pointer, LongInt):^untyped;Register>"
>>
>> As the error message says: the compiler expects the first parameter of
>> realloc to be a "var" parameter, while the declaration of realloc apparently
>> uses a value parameter.
>>
>>
>> Jonas
>
>
>Oops. I guess I assumed the code was the other way around: that the
>gecko runtime accepted an application-provided mem-allocation
>routines, and barely read the message :-$
>BTW, regarding the remaining Warnings from the OP: is there any
>optional member in TMemoryManager or do all of them need to be setup?
>
>-Flávio
>_______________________________________________
>fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
>http://lists.freepascal.org/mailman/listinfo/fpc-pascal
>