procedure defragmem(limit : integer; x: proc);
var tab : array [0..1024] of pointer;
i : integer;
p : pointer;
lim : integer;
begin
if bussy then exit;
bussy:=true;
lim:=limit;
if lim>1024 then lim:=1024;
for i:=0 to lim do tab [i]:=nil;
for i:=0 to lim-1 do
begin
p:=VirtualAlloc(nil, 1024*1024, MEM_COMMIT,
PAGE_READWRITE + PAGE_NOCACHE);
tab[i]:=p;
asm
pushad
pushfd
mov edi, p
mov ecx, 1024*1024/4
xor eax, eax
cld
repz stosd
popfd
popad
end;
if assigned(x) then x;
end;
for i:=0 to lim-1 do
begin
VirtualFree(Tab[i], 0, MEM_RELEASE);
if assigned(x) then x;
end;
bussy:=false;
end;