fork download
copy 
  1. {$MODE OBJFPC}
  2. Uses HeapTrc;
  3.  
  4. Type IFree =
  5.      Interface['{6BB75B15-18A7-424C-89D2-FFA98C913789}']
  6.       Function Allocate(const Size: uint32): Pointer;
  7.      End;
  8.  
  9. Type TFree =
  10.      Class(TInterfacedObject, IFree)
  11.       Private
  12.        RefList: Array of Pointer;
  13.  
  14.       Public
  15.        Function Allocate(const Size: uint32): Pointer;
  16.        Destructor Destroy; override;
  17.       End;
  18.  
  19. (* TFree.Allocate *)
  20. Function TFree.Allocate(const Size: uint32): Pointer;
  21. Begin
  22.  Result := AllocMem(Size);
  23.  
  24.  SetLength(RefList, Length(RefList)+1);
  25.  RefList[High(RefList)] := Result;
  26.  WriteLn('Zaalokowalem: ', Length(RefList), ' blokow');
  27. End;
  28.  
  29. (* TFree.Destroy *)
  30. Destructor TFree.Destroy;
  31. Var P: Pointer;
  32. Begin
  33.  For P in RefList Do
  34.   FreeMem(P);
  35.  
  36.  WriteLn('Zwolnilem: ', Length(RefList), ' blokow');
  37.  inherited Destroy;
  38. End;
  39.  
  40. {$MACRO ON}
  41. {$DEFINE AllocMem:=(TFree.Create as IFree).Allocate}
  42.  
  43. (* MyProc *)
  44. Procedure MyProc;
  45. Var Data: PByte;
  46.     I   : uint16;
  47.     Data2: PByte;
  48. Begin
  49.  Data := AllocMem(10);
  50.  
  51.  Data2 := AllocMem(20);
  52.  
  53.  For I := 0 To 9 Do
  54.   Data[I] := Random(High(Byte));
  55.  
  56.  For I := 0 To 9 Do
  57.   Write(Data[I], ' ');
  58.  
  59.  Writeln;
  60.  
  61.  
  62. End;
  63.  
  64. Begin
  65.  MyProc;
  66.  
  67.  Writeln('-- end --');
  68.  Readln;
  69. End.
  70.  
stdin
copy 
Standard input is empty
stdout
copy 
Zaalokowalem: 1 blokow
Zwolnilem: 1 blokow
Zaalokowalem: 1 blokow
139 151 182 215 153 218 138 216 108 159 
Zwolnilem: -661988710 blokow
-- end --
stderr
copy 
Heap dump by heaptrc unit
6 memory blocks allocated : 94/120
4 memory blocks freed     : 62/80
2 unfreed memory blocks : 32
True heap size : 32768
True free heap : 32576
Should be : 32600
Call trace for block $B78B00C0 size 12
  $080480E2
  $080483AC
  $08048493
  $08066A53
Call trace for block $B78B0120 size 20
  $080483AC
  $08048493
  $08066A53
  $08066A53
https://ideone.com/vF9zy3
language:
Pascal (fpc 3.0.4)
created:
10 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!