觅关于内存的分配与回收的原码，高分相送！！！这次分不够，下次再给

[boyfling]

[e-mail]

[jimsuker]

我要

[leojay]

关于内存的分配与回收的原码?
分配不就是new吗？回收不就是delete吗？你要什么源码？

[eastsun]

class _huge_memory
{
HGLOBAL m_hglb;
long m_nTotalMemorySize;
long m_nRealUsedMemorySize;
public:
_huge_memory( );
~_huge_memory( );
LPBYTE lpbytePointer;
BOOL InitMemoryBySize( long nMemorySize );
void ZeroInitMemory( );
long GetUsedMemorySize( );
};

_huge_memory::_huge_memory( )
{
m_hglb = NULL;
lpbytePointer = NULL;
m_nRealUsedMemorySize = 0;
m_nTotalMemorySize = 0;
}

_huge_memory::~_huge_memory( )
{
ZeroInitMemory( );
}
BOOL _huge_memory::InitMemoryBySize( long nMemorySize )
{
ASSERT( nMemorySize >= 0 );
ASSERT( m_hglb == NULL && lpbytePointer == NULL );
m_hglb = ::GlobalAlloc( GHND, nMemorySize + 20 );

if( m_hglb == NULL )
{
::MessageBox( NULL, "no enough memory to alloc.", "alloc memory failure", MB_OK );
return FALSE;
}
this -> lpbytePointer = (LPBYTE)::GlobalLock( m_hglb );
this -> m_nRealUsedMemorySize = nMemorySize;
this -> m_nTotalMemorySize = nMemorySize + 20;

return TRUE;
}
void _huge_memory::ZeroInitMemory( )
{
if( this -> m_hglb != NULL )
{
::GlobalUnlock( m_hglb );
::GlobalFree( m_hglb );
this -> lpbytePointer = NULL;
this -> m_hglb = NULL;
this -> m_nRealUsedMemorySize = 0;
this -> m_nTotalMemorySize = 0;
}
}

long _huge_memory::GetUsedMemorySize( )
{
return m_nRealUsedMemorySize;
}

[boyfling]

我打错了，是模拟内存的分配与回收

[BlueDog]

VC自已就带有原程序

[Arter]

我给你a Sample:
{***************************************************
* Alloction and Collection *
* E-mail : [e-mail] *
* 2001/05/07 by Arter *
***************************************************}

program AlloctionAndCollection;
uses Crt,Dos,Graph;
const
LowAddress = 0;
HighAddress = 200;
MaxBlockNum = 100;
MinBlockSize= 4;
QTime = 4;

type
TStatus=(free,occupy);
TBlock=Record
Time : integer;
Status : TStatus;
Size : integer;
USize : integer;
Address : integer;
End;
PBlock=^Block;
Block=Record
Time : integer;
Status : TStatus;
Size : integer;
USize : integer;
Address : integer;
Prev : PBlock;
Next : PBlock;
End;
THead=Record
Num : integer;
Next : PBlock;
Curr : PBlock;
End;
var
LastBlockAddress:integer;
RequestCount,FailedCount,SuccessCount:integer;
M,U:THead;
a:array[1..MaxBlockNum+1] of TBlock;
request:TBlock;
IsRelocation:boolean;
procedure ListToArray(head:THead);
var p:PBlock;
i:integer;
begin
p:=head.next;
for i:=1 to head.num do
begin
a[i].time := p^.time;
a[i].status := p^.status;
a[i].size := p^.size;
a[i].address := p^.address;
a[i].usize := p^.usize;
p := p^.next;
end;
end;

procedure ArrayToList(var head:THead);
var p:PBlock;
i:integer;
currAddress:integer;
begin
if head.num>0
then begin
currAddress:=head.curr^.address;
p := head.next;
for i:=1 to head.num do
begin
p^.time := a[i].time;
p^.status := a[i].status;
p^.size := a[i].size;
p^.address := a[i].address;
p^.usize := a[i].usize;
if a[i].address=currAddress then head.curr:=p;
p := p^.next;

end;
end
else begin
end;
end;

procedure Insert(var head:THead;ins:PBlock);
var p:PBlock;
begin
inc(head.num);
if head.num=1
then begin
head.next := ins;
head.curr := ins;
ins^.next := ins;
ins^.prev := ins;
end
else begin
ins^.next := head.curr;
ins^.prev := head.curr^.prev;
ins^.prev^.next := ins;
head.curr^.prev := ins;
if head.curr=head.next then head.next:=ins;
end;
end;

function Delete(var head:THead;var del:PBlock):boolean;
begin
delete := true;
dec(head.num);
if head.num<0
then begin
delete := false;
head.num := 0;
end
else if (head.num=0)
then begin
del := head.curr;
head.next := nil;
head.curr := nil
end
else begin
del := head.curr;
if (head.curr=head.next) then head.next:= del^.next;
head.curr := head.curr^.next;
head.curr^.prev := del^.prev;
del^.prev^.next := head.curr;
end;
end;

procedure Drop(var head:THead);
var del:PBlock;
b:boolean;
begin
repeat
b:=delete(head,del);
if b then dispose(del);
until (not b);
end;

procedure OrderByAddress(var head:THead);
var anum:integer;
i,j:integer;
begin
anum := head.num;
ListToArray(head);
for i:=1 to anum-1 do
for j:=i+1 to anum do
if a[j].address<a[i].address
then begin
a[MaxBlockNum+1] := a[i];
a[i] := a[j];
a[j] := a[MaxBlockNum+1];
end;
ArrayToList(head);
end;

procedure OrderBySize(var head:THead);
var anum:integer;
i,j:integer;
begin
anum := head.num;
ListToArray(head);
for i:=1 to anum-1 do
for j:=i+1 to anum do
if ((a[j].size<a[i].size) or ((a[j].size=a[i].size)
and (a[j].address<a[i].address)))
then begin
a[MaxBlockNum+1] := a[i];
a[i] := a[j];
a[j] := a[MaxBlockNum+1];
end;
ArrayToList(head);
end;

procedure DelayTime(second:integer);
var i:integer;
begin
for i:=1 to second do delay(10000);
end;

procedure Init;
var i:integer;
begin
RequestCount:=0;
SuccessCount:=0;
FailedCount:=0;
LastBlockAddress:=-1;
m.num := 1;
m.next := new(PBlock);
m.curr := m.next;
m.curr^.address := LowAddress;
m.curr^.size := HighAddress-LowAddress;
m.curr^.next := m.curr;
m.curr^.prev := m.curr;
u.num := 0;
end;

procedure Fract(request:TBlock);
var p:PBlock;
b:boolean;
begin
if ((m.curr^.size-request.size)<=MinBlockSize)
then begin
b := Delete(m,p);
if b then begin
p^.time :=request.time;
LastBlockAddress:=p^.address;
Insert(u,p);
end;
end
else begin
p := new(PBlock);
p^.time := request.time;
p^.status := occupy;
p^.size := request.size;
p^.address := m.curr^.address;
p^.usize := p^.size-2;
m.curr^.address := m.curr^.address+request.size;
m.curr^.size := m.curr^.size-request.size;
m.curr := m.curr^.next;
LastBlockAddress:= p^.address;
Insert(u,p);
end;
end;

function Relocation:boolean;
var i,S:integer;
p:PBlock;
b:boolean;
begin
b:=false;
s:=0;
if (u.num>0) and (m.num>1)
then begin
p:=m.next;
for i:=1 to m.num do
begin
s:=s+p^.size;
p:=p^.next;
end;
if s>=request.size
then begin
b:=true;
p:=u.next;
for i:=1 to u.num do
begin
if i=1 then p^.address :=0
else p^.address :=p^.prev^.address+p^.prev^.size;
p:=p^.next;
end;
p:=p^.prev;
Drop(m);
m.num := 1;
m.next := new(PBlock);
m.next^.next:= m.next;
m.next^.prev:= m.next;
m.curr := m.next;
m.curr^.Address:=p^.address+p^.size;
m.curr^.size:=HighAddress-p^.address-p^.size;
end;
end;
Relocation:=b;
end;

procedure FF(request:TBlock);
var IsAble:boolean;
i:integer;
p:PBlock;
begin
IsAble := false;
i := 0;
p := m.next;
while (not IsAble) and (i<m.num) do
begin
inc(i);
if (p^.size>=request.size)
then begin
IsAble := true;
m.curr := p;
end
else begin
p := p^.next;
end;
end;
inc(RequestCount);
if IsAble
then begin
Fract(request);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
else begin
inc(FailedCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Failed! ');
textcolor(Magenta);
write('FailedCount=');
textcolor(Green);
writeln(FailedCount:3);
if IsRelocation
then begin
if Relocation
then begin
Fract(request);
Dec(FailedCount);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'But Reloction is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
end;
end;
DelayTime(3);
textcolor(Red);
end;

procedure RFF(request:TBlock);
var IsAble :boolean;
i:integer;
p:PBlock;
begin
IsAble := false;
i := 0;
p := m.curr;
while (not IsAble) and (i<m.num) do
begin
inc(i);
if (p^.size>=request.size)
then begin
IsAble := true;
m.curr := p;
end
else begin
p := p^.next;
end;
end;
Inc(RequestCount);
if IsAble
then begin
Fract(request);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
else begin
inc(FailedCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Failed! ');
textcolor(Magenta);
write('FailedCount=');
textcolor(Green);
writeln(FailedCount:3);
if IsRelocation
then begin
if Relocation
then begin
Fract(request);
Dec(FailedCount);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'But Reloction is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
end;
end;
DelayTime(3);
textcolor(Red);
end;

procedure BF(request:TBlock);
var IsAble :boolean;
i:integer;
p:PBlock;
begin
IsAble := false;
i := 0;
p := m.next;
while (i<m.num) do
begin
inc(i);
if (p^.size>=request.size)
then begin
if not IsAble
then begin
IsAble := true;
m.curr := p;
end
else if p^.size<m.curr^.size
then begin
m.curr:=p;
end;
end
else begin
end;
p := p^.next;
end;
Inc(RequestCount);
if IsAble
then begin
Fract(request);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
else begin
inc(FailedCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Failed! ');
textcolor(Magenta);
write('FailedCount=');
textcolor(Green);
writeln(FailedCount:3);
if IsRelocation
then begin
if Relocation
then begin
Fract(request);
Dec(FailedCount);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'But Reloction is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
end;
end;
DelayTime(3);
textcolor(Red);
end;

procedure WF(request:TBlock);
var IsAble :boolean;
i:integer;
p:PBlock;
begin
IsAble := false;
i := 0;
p := m.next;
while (i<m.num) do
begin
inc(i);
if IsAble and (p^.size>m.curr^.size)
then begin
m.curr := p;
end;
if (not IsAble) and (p^.size>=request.size)
then begin
IsAble := true;
m.curr := p;
end;
p := p^.next;
end;
Inc(RequestCount);
if IsAble
then begin
Fract(request);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
else begin
inc(FailedCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'Request(Size=',request.size,' , Time=',request.time,') is ');
textcolor(Yellow+Blink);
write('Failed! ');
textcolor(Magenta);
write('FailedCount=');
textcolor(Green);
writeln(FailedCount:3);
if IsRelocation
then begin
if Relocation
then begin
Fract(request);
Dec(FailedCount);
inc(SuccessCount);
textcolor(Green);
write(RequestCount:12);
textcolor(Magenta);
write('':3,'But Reloction is ');
textcolor(Yellow+Blink);
write('Success! ');
textcolor(Magenta);
write('SuccessCount=');
textcolor(Green);
writeln(SuccessCount:3);
end
end;
end;
DelayTime(3);
textcolor(Red);
end;

procedure Join(p:PBlock);
var i:integer;
b:boolean;
q:PBlock;
begin
q := m.next;
i := 0;
while (i<m.num) and (q^.address<p^.address) do
begin
inc(i);
q := q^.next;
end;
if m.num=0 then
begin
inc(m.num);
q:=new(PBlock);
q^.next:=q;
q^.prev:=q;
q^.address:=p^.address+p^.size;
q^.size:=0;
m.curr:=q;
m.next:=q;
end;
if i=0
then begin
if p^.address+p^.size=q^.address
then begin
q^.address := p^.address;
q^.size := p^.size+q^.size;
end
else begin
Insert(m,p);

end;
end
else if i=m.num
then begin
q := q^.prev;
if p^.address=q^.address+q^.size
then begin
q^.size := p^.size+q^.size;
end
else if (p^.address>q^.address+q^.size)
then begin
Insert(m,p);
end;
end
else begin
if p^.address+p^.size=q^.address
then begin
q^.address := p^.address;
q^.size := p^.size+q^.size;
end
else if p^.address=q^.prev^.address+q^.prev^.size
then begin
q^.prev^.size := p^.size+q^.prev^.size;
end
else begin
Insert(m,p);
end;
if q^.prev^.address+q^.prev^.size=q^.address
then begin
q^.prev^.size := q^.prev^.size+q^.size;
m.curr:=q;
b:=Delete(m,p);
end;
end;
end;

procedure Print;
var i,num:integer;
p,q:PBlock;
begin
OrderByAddress(u);
OrderByAddress(m);
p:=u.next;
q:=m.next;
writeln('':10,'********The Using Block************The Free Block**********');
writeln('':10,'* No. Address Size Time *** No. Address Size *');
num:=u.num;
if num<m.num then num:=m.num;
for i :=1 to num do
begin
DelayTime(1);
if i<=u.num then begin
write('':10,'*');
if p^.address=LastBlockAddress then
begin
LastBlockAddress:=-1;
textcolor(White);
end;
write(i:3,p^.address:8,p^.size:7,p^.time:6,'':4);
textcolor(red);
end
else write('':10,'*','':28);
if i<=m.num then writeln('***':3,i:5,q^.address:8,q^.size:10 ,'*':4)
else writeln('***':3,'*':27);
p:=p^.next;
q:=q^.next;
end;
writeln('':10,'***********************************************************');
DelayTime(1);
end;


procedure Collection;
var p:PBlock;
b,done:boolean;
i,num:integer;
begin
i := 0;
u.curr := u.next;
num := u.num;
done := false;

while (u.num>0) and (i<num) do
begin
if u.curr^.time<=0
then begin
b := delete(u,p);
if b then begin
OrderByAddress(m);
Join(p);
done:=true;
end;
end
else begin
u.curr:=u.curr^.next;
end;
inc(i);
end;
if done then begin
textcolor(Green);
writeln('':15,' After Collection!');
textcolor(Red);
Print;
end;
DelayTime(3);
end;

procedure TimeRuning;
var i:integer;
p:PBlock;
begin
p := u.next;
i := 0;
while (i<u.num) do
begin
inc(i);
dec(p^.time);
p := p^.next;
end;
if u.num>0 then
begin
textcolor(Blue);
writeln('':15,' Time Runing! ');
DelayTime(1);
textcolor(Red);
Print;
end;
end;


procedure Run;
var ch,choice:char;
begin

begin
textcolor(Red);
Clrscr;
write('请选择分配算法[Please choice the Allocation!]: A).FF B).RFF C).BF D).WF ');
textcolor(White);
readln(choice);
choice:=upcase(choice);
textcolor(Red);
write('需要动态重定位吗？[Do you want Relocation?](Y/N)? ');
textcolor(White);
readln(ch);
textcolor(Red);
ch:=upcase(ch);
IsRelocation:=false;
if ch='Y' then IsRelocation:=true;
{randomize;}
print;
repeat
request.size :=random( (HighAddress-LowAddress) div (random(5)+1))+MinBlockSize;
request.time :=(request.size div 10)+random(QTime)+1;
case choice of
'C': BF(request);
'B': RFF(request);
'A': FF(request);
else WF(request);
end;
Print;
DelayTime(10);
TimeRuning;
DelayTime(10);
Collection;
DelayTime(10);
until (RequestCount>=100);
end;
end;

procedure Done;
begin
clrscr;
readln;
end;

{main}
begin
Init;
Run;
Done;
end.

[jacklondon]

重载全局的new和delete，或者重载局部的new 和 delete