Здравствуйте. Если вдруг Вы знаете как решить следующую проблему, прошу - отпишитесь. Проблема: ----- Нужно организовать собственный менеджер памяти на языке ObjectPascal. Это я организовал. Мне требуется в своём проекте работать с этим менеджером. А именно, я хочу работать с динамическим списком структур. Ниже код менеджера: | Код |
unit [HIDE];
interface
uses
SysUtils, Graphics, ExtCtrls, StdCtrls;
type
pRingList = ^TRingList;
TRingList = record //Структура, хранящая данные о свободном блоке
Next:pRingList; // Указатель на следующий элемент списка
StartData:Pointer; // Указатель на начало свободного блока
Size:Integer; // Размер незанятого блока
end;
TMemManager = class(TObject)
PUBLIC
constructor Create(BlockSize:Integer);
destructor Destroy();
procedure _GetMem(var P:Pointer ; BlockSize:Integer);
function _FreeMem(DataPointer:Pointer; BlockSize:Integer):boolean;
PRIVATE
Head : pRingList; //Голова списка
Tail : pRingList; //Хвост списка
HeapStartPos : Pointer; //Указатель на начало кучи
HeapEndPos :Pointer; //Указатель на конец кучи
HeapSize: Integer;
IsEmpty : boolean; //Если TRUE, то куча пуста
function TakeMem(ListElem:pRingList; BlockSize:Integer):Pointer;
procedure FreeListElem(ListElem:pRingList);
function IsInHeap(DataPointer:Pointer):boolean;
function DoesItFree(DataPointer:Pointer):boolean;
procedure ShowList(Memo:TMemo);
procedure ShowToImage(var Im:TPaintBox);
end;
implementation
procedure TMemManager.ShowToImage(var Im:TPaintBox);
[HIDE]
end;
destructor TMemManager.Destroy();
begin
FreeMem(HeapStartPos,HeapSize);
end;
procedure TMemManager.ShowList(Memo:TMemo);
[HIDE]
end;
constructor TMemManager.Create(BlockSize:Integer);
begin
IsEmpty:=True;
HeapStartPos:=SysGetMem(BlockSize);
HeapSize:=BlockSize;
New(Head);
Head.StartData:=HeapStartPos;
HeapEndPos:=pointer(integer(HeapStartPos)+BlockSize);
Head.Size:=BlockSize;
Tail:=Head;
Head.Next:=Tail;
Tail.Next:=Head;
end;
procedure TMemManager.FreeListElem(ListElem:pRingList);
var Cur:pRingList;
begin
if not ((ListElem=Head) and (ListElem=Tail)) then
begin
Cur:=Head;
while Cur.Next<>ListElem do
Cur:=Cur.Next;
Cur.Next:=ListElem.Next;
FreeMem(ListElem,SizeOf(ListElem));
end;
end;
function TMemManager.TakeMem(ListElem:pRingList; BlockSize:Integer):Pointer;
begin
Result:=ListElem.StartData;
Dec(ListElem.Size,BlockSize);
if ListElem.Size=0 then FreeListElem(ListElem) else
ListElem.StartData:=Pointer(Integer(ListElem.StartData)+BlockSize);
end;
procedure TMemManager._GetMem(var P:Pointer ; BlockSize:Integer);
var Cur:pRingList;
begin
if not (BlockSize>HeapSize) then
begin
if IsEmpty then
begin
P:=Head.StartData;
Dec(head.Size,BlockSize);
Head.StartData:=Pointer(Integer(Head.StartData)+Integer(BlockSize));
IsEmpty:=False;
end else
begin
Cur:=Head;
repeat
if Cur.Size>=BlockSize then break;
Cur:=Cur.Next;
until Cur=Head;
if Cur.Size>=BlockSize then P:=TakeMem(Cur,BlockSize) else P:=NIL;
end;
end else P:=NIL;
end;
function TMemManager.IsInHeap(DataPointer:Pointer):boolean;
begin
Result:=False;
if ((Integer(DataPointer)>=Integer(HeapStartPos)) and (Integer(DataPointer)<=Integer(HeapEndPos))) then
Result:=True;
end;
function TMemManager.DoesItFree(DataPointer:Pointer):boolean;
var Cur:pRingList;
begin
Result:=False; //Участок ранее не освобождался
Cur:=Head;
repeat
if ((Integer(DataPointer)>=Integer(Cur.StartData)) and (Integer(DataPointer)<Integer(Cur.StartData)+Integer(Cur.Size)))
then begin
Result:=True; //участок памяти ранее уже освобождался. Его не трогаем
exit;
end;
cur:=cur.Next;
until cur=head;
end;
function TMemManager._FreeMem(DataPointer:Pointer; BlockSize:Integer):boolean;
var Cur:pRingList;
begin
Result:=True;
cur:=head;
if not IsInHeap(DataPointer) then Result:=False else
if not DoesItFree(DataPointer) then
begin
New(Cur);
Cur.StartData:=DataPointer;
Cur.Size:=BlockSize;
Tail.Next:=Cur;
Tail:=Cur;
Tail.Next:=Head;
end;
end;
end.
|
Дальше. В этом модуле я работаю со своей "кучей". При срабатывании конструктора необходимо динамически создать две структуры класса TSnakeElem. И главное, что б они располагались в моей куче. Тут начинается самое веселоё )) При исполнении | Код | MemManager._GetMem(pointer(SHead), Size); |
SHead все таки начинает ссылаться туда куда надо, а вот записи этой структуры (X,Y,Next) вообще залазят на методы MemManager. Например: TSnake.SHead.X и TMemManager.Head ссылаються на один и тот же адрес. TSnake.STail.X и MemManager.Tail тоже имеют одинаковые адреса. В чем проблема? Почему адреса X-а и Y-ка не идут после SHead? | Код |
unit My_Snake;
interface
uses [MANAGER_MODULE], ExtCtrls, Dialogs, SysUtils;
type
pSnakeElem = ^TSnakeElem;
TSnakeElem = class (TObject)
X : Integer; // координата по х (верхняя левая точка квадратика)
Y : Integer; // координата по у (верхняя левая точка квадратика)
Next : pSnakeElem; { указатель на следующий элемент змейки.
Если NIL , то обрабатываемый элемент - хвост змеи }
end;
TSnake = class (TObject)
SHead : pSnakeElem;
STail : pSnakeElem;
constructor Create();
end;
var MemManager : TMemManager;
implementation
constructor TSnake.Create();
var buf:pSnakeElem;
size:Integer;
begin
Size:=TSnakeElem.InstanceSize;
MemManager:=TMemManager.Create(1024);
MemManager._GetMem(pointer(SHead), Size);
SHead.X:=20;
SHead.Y:=20;
MemManager._GetMem(pointer(Buf), Size);
Buf^.X:=40;
Buf^.Y:=20;
SHead^.Next:=Buf;
Buf.Next:=NIL;
end;
end.
|
Приложил весь проект. Очень нужна помощь
Присоединённый файл ( Кол-во скачиваний: 2 )
Game.rar 10,72 Kb |
Проблема с памятью, "Собственная" куча 
Загрузка ...
