type
TMem = Record
 Addr : Pointer;
 Size : PtrUInt;
End;

var
 continue : Pointer;
 lastMM : TMemoryManager;
 MM : TMemoryManager;
 list: array of TMem;
 listSize : Integer = 0;

procedure exitHandler;
var
 i : Integer;
begin
 for i:=0 to listSize-1 do
 begin
  lastMM.FreeMemSize(list[i].Addr, list[i].Size);
 end;

 SetMemoryManager(lastMM);
 SetLength(list, 0);

 asm
  jmp continue
 end;
end;

function myGetmem(Size: PtrUInt):Pointer;
begin
 SetMemoryManager(lastMM);
 SetLength(list, listSize+1);
 SetMemoryManager(MM);

 list[listSize].Size := Size;
 list[listSize].Addr := lastMM.Getmem(Size);

 myGetmem := list[listSize].Addr;

 inc(listSize);
end;

procedure sethandler(sp:integer);
begin
 continue := Pointer(PPtrUInt(@sp)[8]);
 Pointer(PPtrUInt(@sp)[8]) := @exitHandler;
end;

Procedure MyProc;
Var Data: PByte;
    I   : uint16;
Begin
 sethandler(0);
 GetMemoryManager(lastMM);
 MM := lastMM;
 MM.Getmem := @myGetmem;
 SetMemoryManager(MM);

 Data := AllocMem(10);

 For I := 0 To 9 Do
  Data[I] := Random(High(Byte));

 For I := 0 To 9 Do
  Write(Data[I], ' ');

 Writeln;
End;

Begin
 MyProc;

 Writeln('-- end --');
 Readln;
End.