fork(1) 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. End;
  27.  
  28. (* TFree.Destroy *)
  29. Destructor TFree.Destroy;
  30. Var P: Pointer;
  31. Begin
  32.  For P in RefList Do
  33.   FreeMem(P);
  34.  
  35.  inherited Destroy;
  36. End;
  37.  
  38. {$MACRO ON}
  39. {$DEFINE AllocMem:=(TFree.Create as IFree).Allocate}
  40.  
  41. (* MyProc *)
  42. Procedure MyProc;
  43. Var Data: PByte;
  44.     I   : uint16;
  45. Begin
  46.  Data := AllocMem(10);
  47.  
  48.  For I := 0 To 9 Do
  49.   Data[I] := Random(High(Byte));
  50.  
  51.  For I := 0 To 9 Do
  52.   Write(Data[I], ' ');
  53.  
  54.  Writeln;
  55. End;
  56.  
  57. Begin
  58.  MyProc;
  59.  
  60.  Writeln('-- end --');
  61.  Readln;
  62. End.
  63.  
stdin
copy 
Standard input is empty
stdout
copy 
139 151 182 215 153 218 138 216 108 159 
-- end --
stderr
copy 
Heap dump by heaptrc unit
3 memory blocks allocated : 42/56
3 memory blocks freed     : 42/56
0 unfreed memory blocks : 0
True heap size : 32768
True free heap : 32768
https://ideone.com/rtiqP6
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!