On Sun, 13 Apr 2014, Ludo Brands wrote:

On 04/12/2014 02:24 PM, Michael Van Canneyt wrote:


Attached is an implementation that allows you to specify:


A few comments:
- allocmem already zeros the memory. No need to do it a second time

Indeed, copy&paste from getmem. Removed the zeroing.

- Getmem and Allocmem can return nil (dependent on mem manager,
sometimes on ReturnNilIfGrowHeapfails). A test in ZeroMem and RandomMem
on nil would be "Safe".

Indeed :) Good point, I have added this check :)

- SafeReAllocMem doesn't clear/scramble the memory in case a realloc
moves the memory block to a different place.

You are right. A logic error. ReallocMem is the more tricky one.
Revised.

That's why I post such quick code; for peer review.

Thanks for pointing these out, revised version attached.
Again, comments/reviews welcome.

Michael.
{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team

    "Safe" Heap manager interface section

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
unit safemmgr;

interface

Type
  TMemAction = (
    maZero,   // Zero out the memory
    maRandom, // Fill with Random data
    maNone    // Do nothing
  );
  
Var
  // Can be set at any time.
  GetAction : TMemAction = maZero;
  FreeAction : TMemAction = maZero;

// You can set/unset the memory manager at any time, but it is set during 
intialization.
Procedure InitSafeMemManager;
Procedure DoneSafeMemManager;

Implementation

Var
  M : TMemoryManager;

Procedure ZeroMem(Mem : PByte; ASize : ptruint);

begin
  if (Mem=Nil) or (Asize=0) then exit;
  FillWord(Mem^,ASize div 2,0);
  if (ASize mod 2)=1 then
    Mem[ASize-1]:=0;
end;

Procedure RandomMem(Mem : PByte; ASize : ptruint);

Var
  I : ptruint;
  PW : PWord;

begin
  if (Mem=Nil) or (Asize=0) then exit;
  PW:=PWord(Mem);
  For I:=0 to (ASize div 2) do
    PW[I]:=Random($FFFF);
  if (ASize mod 2)=1 then
    Mem[ASize-1]:=Random($FF);
end;

Function SafeGetmem (Size:ptruint):Pointer;

begin
  Result:=M.Getmem(Size);
  Case GetAction of
    maZero : ZeroMem(Result,Size);
    maRandom : RandomMem(Result,Size);
  end;
end;

Function SafeFreeMemSize(p:pointer;Size:ptruint):ptruint;

begin
  Case FreeAction of
    maZero : ZeroMem(P,Size);
    maRandom : RandomMem(P,Size);
  end;
  Result:=M.FreeMemSize(P,Size);
end;

Function SafeFreeMem (p:pointer):ptruint;

begin
  Result:=SafeFreeMemSize(P,M.MemSize(P));
end;


Function SafeAllocMem (Size:ptruint):Pointer;

begin
  Result:=M.AllocMem(Size);
  Case GetAction of
    maRandom : RandomMem(Result,Size);
  end;
end;

Function SafeReAllocMem(var p:pointer;Size:ptruint):Pointer;

Var
  OP : PByte;
  GOS,FOS : ptruint;

begin
  OP:=P;
  FOS:=M.MemSize(P);
  GOS:=FOS;
  Result:=M.ReAllocMem(P,Size);
  If (P=OP) then
    if (FOS>Size) then
      begin
      Inc(OP,FOS);
      Dec(FOS,Size);
      end
    else
      OP:=Nil;  
  if (OP<>Nil) and (FOS>0) then
    Case FreeAction of
      maZero : ZeroMem(OP,FOS);
      maRandom : RandomMem(OP,FOS);
    end;
  if (P<>OP) or (GOS<Size) then
    begin
    OP:=Result;
    Inc(OP,GOS);
    Dec(GOS,Size);
    Case GetAction of
      maZero : ZeroMem(OP,GOS);
      maRandom : RandomMem(OP,GOS);
    end;
    end;
end;

Function SafeMMinstalled : Boolean;

Var
  CM : TMemoryManager;

begin
  FillChar(CM,SizeOf(TMemoryManager),#0);
  GetMemoryManager(CM);
  Result:=Pointer(CM.AllocMem)=Pointer(@SafeAllocMem);
end;

Procedure InitSafeMemManager;

Var
  NM : TMemoryManager;

begin
  If SafeMMInstalled then
     exit;
  GetMemoryManager(M);
  NM:=M;
  NM.FreeMem:=@SafeFreeMem;
  NM.FreeMemSize:=@SafeFreeMemSize;
  NM.GetMem:=@SafeGetMem;
  NM.AllocMem:=@SafeAllocMem;
  NM.ReAllocMem:=@SafeReAllocMem;
  SetMemoryManager(NM);
end;

Procedure DoneSafeMemManager;


begin
  If Not SafeMMInstalled then
     exit;
  SetMemoryManager(M);
end;

initialization
  InitSafeMemManager;
finalization
  DoneSafeMemManager;
end.
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal

Reply via email to