[fpc-pascal]method pointers, design patterns, OP idioms etc.

[V.Krishnakumar]

On Wednesday 27 November 2002 16:30, you wrote:
> From: memsom at interalpha.co.uk
> > 3. I wrote a memory manager interface to the Boehm GC library. It
> > compiled fine but crashed during the 'mark' phase of the collection. I
> > think I can fix the problem by explicitly adding the root pointers for
> > the collector for which I need to find the absolute addresses of the data
> > and bss segments. Anybody knows how to get this ? (the binutils generate
> > labels __data_start and __bss_start for C programs. But code generated by
> > FPC only has __bss_start.)
>
> Without seeing your code it is impossible to comment with any authority. It
> sounds like you're making things overly compilcated though. If it works in
> C without this information then you probably don't need it. Otherwise, you
> could try writing a small routine to return the correct information to
> Pascal and add it to the library.
>

I've attached the code for the unit and a small test program. The unit works 
on Win32 with the gc compiled as a DLL. However it does'nt work when used 
with the libgc.so shared library on linux. Is this a FPC-shared lib issue ?

Does FPC generate proper PIC code ?


> Hope that helps,
>
Yes that did help. thanks.

cheers,
-Krish
-------------- next part --------------
{
  gctest.pas
  A simple program to test the BoehmGC unit.
}

program gctest;
{$mode objfpc}

uses BoehmGC;

var
    i : longint;
    p : pointer;

begin

    Writeln('Initial heap size: ', GCHeapSize);
    Writeln('Mem available: ', GCMemAvail);
    for i := 1 to 100 do
    begin
    	p := GetMem(1024);
    end;

    Writeln('Heap size: ', GCHeapSize);
    Writeln('Free mem : ', GCMemAvail);
    Writeln('Collecting...');
    GC;
    Writeln('Heap size: ', GCHeapSize);
    Writeln('Free mem : ', GCMemAvail);

end.
-------------- next part --------------
{
 BoehmGC.pas

 A custom memory manager for FreePascal based on the Boehm-Demers-Weiser
 conservative garbage collection library.

 This unit should be "used" before any other unit.

 Notes: This unit currently works under Win32 with the gc library as a DLL
 without problems. However there are problems when used under Linux with
 the gc library as a shared library. Should be ok when linked with the
 static version of the gc library.

 27-Nov-2002,
 V.Krishnakumar <vkrish at vkrish.cjb.net>
}

unit BoehmGC;

{$mode objfpc}

interface

{ explicitly add root pointers for scanning }
procedure GCAddRoots (low, high : pointer);cdecl;
	external 'gc' name 'GC_add_roots';

function GCMalloc (size : longint) : pointer ; cdecl ;
	external 'gc' name 'GC_malloc';

procedure GCFree (ptr : pointer) ; cdecl ; external 'gc' name 'GC_free' ;

procedure GCFreeMem (ptr : pointer); cdecl; external 'gc' name 'GC_free' ;

function GCReAlloc (ptr : pointer; size : longint): pointer; cdecl;
	external 'gc' name 'GC_realloc';

function GCHeapSize:longint; cdecl; external 'gc' name 'GC_get_heap_size';

function GCMemAvail:longint; cdecl; external 'gc' name 'GC_get_free_bytes';

{ force a "world-stop" collection }
procedure GC;cdecl;external 'gc' name 'GC_gcollect';

	
implementation 

{ the following are "pascalized" versions of the above }

function GCGetMemP (Size : Longint) : Pointer;
begin 
	result:=GCMalloc(Size);
end; 

function GCFreeMemP ({$ifdef VER1_0} var {$endif} P : pointer) : Longint;
begin 
	GCFree(P); { not necessary }
	Result:=0; 
end; 

function GCFreeMemSizeP({$ifdef VER1_0} var {$endif} p:pointer;Size:Longint):Longint;
begin 
	Result:=GCFreeMemP(P);
end; 

function GCAllocMemP(Size : Longint) : Pointer;
begin 
	{ the BDW GC library guarentees that memory allocated
        will be cleared.}
	Result:=GCMalloc(Size);
end; 

function GCReAllocMemP (var p:pointer;Size:longint):Pointer;
begin 
	Result:=GCReAlloc(p,size);
end; 

function GCMemSizeP (p:pointer): Longint;
begin 
	Result:=0; 
end; 

function GCMemAvailP : Longint;
begin 
	Result:=GCMemAvail;
end; 

function GCMaxAvailP: Longint;
begin 
	Result:=0; 
end; 

function GCHeapSizeP : Longint;
begin 
	Result:=GCHeapSize;
end; 

const GCMemoryManager : TMemoryManager = (
{$ifndef VER1_0}
	NeedLock : false;
{$endif}
	GetMem : {$ifdef fpc} @ {$endif}GCGetMemP;
	FreeMem : {$ifdef fpc} @ {$endif}GCFreeMemP;
	FreememSize : {$ifdef fpc} @ {$endif}GCFreememSizeP;
	AllocMem : {$ifdef fpc} @ {$endif}GCAllocMemP;
	ReallocMem : {$ifdef fpc} @ {$endif}GCReAllocMemP;
	MemSize : {$ifdef fpc} @ {$endif}GCMemSizeP;
	MemAvail :{$ifdef fpc} @ {$endif} GCMemAvailP;
	MaxAvail : {$ifdef fpc} @ {$endif}GCMaxAvailP;
	HeapSize : {$ifdef fpc} @ {$endif}GCHeapSizeP;
	); 
var
	OldMemoryManager : TMemoryManager;

initialization
      
	GetMemoryManager (OldMemoryManager); 
	SetMemoryManager (GCMemoryManager);

finalization
	
	SetMemoryManager (OldMemoryManager); 
	
end.