[Pascal + objekty] = HELP!

[Rainbow]

Unit na zretazenu volnu pamat - mali sme to spravit na programovacie techniky.

{$DEFINE DEBUG}
unit ZVP;

{ZVP je ulozena v poli bytov. Alokuje sa v blokoch. Kazdy blok ma ako prvy
 byte svoje ID. Dalsie 2 byty su jeho velkost. ID=0 znamena nealokovany blok,
 ID=$FF je oznacenie nealokovatelneho useku najviac dvoch po sebe iducich
 bytov

 ,----,----,----,----,----,----,----,----,----,----,----,----,----,----
 | ID | velkost |       data        | 00 | volnych |    volna pamat...
 `----`----`----`----`----`----`----`----`----`----`----`----`----`----
}

interface
const MaxSize=32768;

type TZVP=object
 {$IFDEF DEBUG}
 Data:array[1..MaxSize] of Byte;
 {$ENDIF}

 procedure Empty;
 function  isEmpty:Boolean;
 function  New(Size:Word):Byte;
 procedure Dispose(ID:Byte);
 procedure ReadData(ID:Byte;Size:Word;var Buffer:array of Byte);
 procedure WriteData(ID:Byte;Size:Word;const Buffer:array of Byte);
 procedure Connect;
 procedure Collect;
private
 {$IFNDEF DEBUG}
 Data:array[1..MaxSize] of Byte;
 {$ENDIF}
 UsedIDs:array[1..254] of Boolean;

 function FindBlock(ID:Byte):Word;
end;

implementation

{Inicializuje ZVP}
procedure TZVP.Empty;
begin
  {$IFDEF DEBUG}
  FillChar(Data,SizeOf(Data),0);       { Vynuluje celu pamat }
  {$ELSE}
  Data[1]:=0;                          { Vytvori nealokovany blok }
  {$ENDIF}
  Data[2]:=Hi(MaxSize-3);              { velkosti celej ZVP }
  Data[3]:=Lo(MaxSize-3);
  FillChar(UsedIDs,SizeOf(UsedIDs),0); { Vynuluje tabulku pouzitych ID }
end;

{Vrati TRUE ak ZVP obsahuje aspon jeden blok, inak FALSE}
function TZVP.isEmpty:Boolean;
var A:Byte;
begin
  isEmpty:=True;
  { Hlada nejake obsadene ID }
  for A:=1 to 254 do if UsedIDs[A] then
   begin
     isEmpty:=False; { Ak je nejake ID obsadene, ZVP nie je prazdna }
     Break;
   end;
end;

{Alokuje blok velkosti Size a vrati jednoznacne ID tohto bloku}
{Ak sa blok neda alokovat, vrati 0}
function TZVP.New(Size:Word):Byte;
var A,FreeSpace:Word;
    ID:Byte;
begin
  { Najde prve volne ID }
  for ID:=1 to 254 do if not UsedIDs[ID] then Break;
  if UsedIDs[ID] then { Nie je volne ziadne ID }
   begin
     New:=0;
     Exit;
   end;
  A:=1;
  { Najde volnu pamat velku aspon Size }
  while &#40;A<=MaxSize&#41; and &#40;&#40;Data&#91;A&#93;=$FF&#41; or &#40;Data&#91;A&#93;<>0&#41; or
   &#40;&#40;Data&#91;A&#93;=0&#41; and &#40;Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;<Size&#41;&#41;&#41;
    do if Data&#91;A&#93;=$FF then Inc&#40;A&#41; else A&#58;=A+Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;+3;
  if A>MaxSize then &#123;Nie je dost pamati&#125;
   begin
     New&#58;=0;
     Exit;
   end;
  FreeSpace&#58;=Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;;
  Data&#91;A&#93;&#58;=ID;              &#123; Zapise ID &#125;
  Data&#91;A+1&#93;&#58;=Hi&#40;Size&#41;;      &#123; Zapise alokovanu velkost &#125;
  Data&#91;A+2&#93;&#58;=Lo&#40;Size&#41;;
  if &#40;FreeSpace-Size<3&#41; and &#40;FreeSpace-Size>0&#41; then
   begin                    &#123; Ak ostalo menej volneho miesta ako 3 byty &#125;
     Data&#91;A+Size+3&#93;&#58;=$FF;   &#123; Oznaci ich ako $FF = nealokovatelne &#125;
     if FreeSpace-Size>1 then Data&#91;A+Size+4&#93;&#58;=$FF;
   end
  else if FreeSpace-Size<>0 then
   begin                    &#123; Inak vyrobi nealokovany blok &#125;
     Data&#91;A+Size+3&#93;&#58;=0;
     Data&#91;A+Size+4&#93;&#58;=Hi&#40;FreeSpace-Size-3&#41;;
     Data&#91;A+Size+5&#93;&#58;=Lo&#40;FreeSpace-Size-3&#41;;
   end;
  New&#58;=ID;
  UsedIDs&#91;ID&#93;&#58;=True;        &#123; Oznaci nove ID ako obsadene &#125;
end;

&#123;Najde blok podla jeho ID a vrati adresu - len pre interne pouzitie&#125;
function TZVP.FindBlock&#40;ID&#58;Byte&#41;&#58;Word;
var A&#58;Word;
begin
  FindBlock&#58;=$FFFF;
  if not UsedIDs&#91;ID&#93; then Exit;     &#123; ID je volne => blok neexistuje &#125;
  A&#58;=1;
  &#123; Najde blok s oznacenim ID &#125;
  while &#40;A<=MaxSize&#41; and &#40;&#40;Data&#91;A&#93;<>ID&#41; or &#40;Data&#91;A&#93;=$FF&#41;&#41;
   do if Data&#91;A&#93;=$FF then Inc&#40;A&#41; else A&#58;=A+Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;+3;
  if Data&#91;A&#93;=ID then FindBlock&#58;=A;
end;

&#123;Uvolni blok podla ID&#125;
procedure TZVP.Dispose&#40;ID&#58;Byte&#41;;
var A&#58;Word;
begin
  if &#40;ID=0&#41; or &#40;ID=$FF&#41; then Exit;
  A&#58;=FindBlock&#40;ID&#41;;                           &#123; Najde blok podla ID &#125;
  if A=$FFFF then Exit;
  Data&#91;A&#93;&#58;=0;                                 &#123; Nastavi jeho ID na 0 &#125;
  UsedIDs&#91;ID&#93;&#58;=False;                         &#123; Oznaci ID ako volne &#125;
end;

&#123;Cita data z bloku ID velkosti Size do Bufferu&#125;
procedure TZVP.ReadData&#40;ID&#58;Byte;Size&#58;Word;var Buffer&#58;array of Byte&#41;;
var A&#58;Word;
begin
  if &#40;ID=0&#41; or &#40;ID=$FF&#41; then Exit;
  A&#58;=FindBlock&#40;ID&#41;;
  if A=$FFFF then Exit;
  &#123; Pri poziadavke citat viac ako je velkost bloku citame cely blok &#125;
  if Size>Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93; then Size&#58;=Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;;
  Move&#40;Data&#91;A+3&#93;,Buffer,Size&#41;;
end;

&#123;Zapisuje data do bloku ID velkosti Size z Buffera&#125;
procedure TZVP.WriteData&#40;ID&#58;Byte;Size&#58;Word;const Buffer&#58;array of Byte&#41;;
var A&#58;Word;
begin
  if &#40;ID=0&#41; or &#40;ID=$FF&#41; then Exit;
  A&#58;=FindBlock&#40;ID&#41;;
  if A=$FFFF then Exit;
  &#123; Pri poziadavke zapisat viac ako je velkost bloku zapiseme cely blok &#125;
  if Size>Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93; then Size&#58;=Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;;
  Move&#40;Buffer,Data&#91;A+3&#93;,Size&#41;;
end;

&#123;Spoji po sebe nasledujuce volne bloky do jedneho&#125;
procedure TZVP.Connect;
var A,Start&#58;Word;
begin
  A&#58;=1;
  Start&#58;=0;
  while &#40;A<=MaxSize&#41; do                   &#123; Prechadza celu pamat &#125;
   begin
     if &#40;Data&#91;A&#93;=0&#41; or &#40;Data&#91;A&#93;=$FF&#41; then &#123; Ak nasiel volny blok &#125;
      begin
        if Start=0 then Start&#58;=A;          &#123; Ulozi zaciatok volneho miesta &#125;
      end
     else                                 &#123; Ak nasiel obsadeny blok &#125;
      if &#40;Start<>0&#41; and &#40;Start<MaxSize-1&#41; then &#123; Ak je ulozeny zaciatok &#125;
       begin
         Data&#91;Start&#93;&#58;=0;                   &#123; Od zaciatku volneho miesta &#125;
         Data&#91;Start+1&#93;&#58;=Hi&#40;A-Start-3&#41;;     &#123; vytvori volny blok s velkostou &#125;
         Data&#91;Start+2&#93;&#58;=Lo&#40;A-Start-3&#41;;     &#123; celeho suvisleho volneho miesta &#125;
         Start&#58;=0;
       end;
     if Data&#91;A&#93;=$FF then Inc&#40;A&#41; else A&#58;=A+Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;+3;
   end;
  if &#40;Start<>0&#41; and &#40;Start<MaxSize-1&#41; then &#123; Ak je ulozeny zaciatok &#125;
   begin
     Data&#91;Start&#93;&#58;=0;                   &#123; Od zaciatku volneho miesta &#125;
     Data&#91;Start+1&#93;&#58;=Hi&#40;A-Start-3&#41;;     &#123; vytvori volny blok s velkostou &#125;
     Data&#91;Start+2&#93;&#58;=Lo&#40;A-Start-3&#41;;     &#123; celeho suvisleho volneho miesta &#125;
     Start&#58;=0;
   end;
end;

&#123;Defragmentacia ZVP&#125;
procedure TZVP.Collect;
var A,FreePos,Size&#58;Word;
begin
  A&#58;=1;
  FreePos&#58;=0;
  while &#40;A<=MaxSize&#41; do                   &#123; Prechadza celu pamat &#125;
   begin
     if Data&#91;A&#93;<>$FF then Size&#58;=Word&#40;Data&#91;A+1&#93;&#41; shl 8+Data&#91;A+2&#93;;
     if &#40;Data&#91;A&#93;=0&#41; or &#40;Data&#91;A&#93;=$FF&#41; then &#123; Ak nasiel volny blok &#125;
      begin
        if FreePos=0 then FreePos&#58;=A;     &#123; Ulozi zaciatok volneho miesta &#125;
      end
     else                                 &#123; Ak nasiel obsadeny blok &#125;
      if FreePos<>0 then                  &#123; Ak je ulozeny zaciatok &#125;
       begin
         Move&#40;Data&#91;A&#93;,Data&#91;FreePos&#93;,Size+3&#41;; &#123; Presunie blok do volneho miesta &#125;
         FreePos&#58;=FreePos+Size+3;         &#123; Posunie zaciatok volneho miesta &#125;
       end;
     if Data&#91;A&#93;=$FF then Inc&#40;A&#41; else A&#58;=A+Size+3;
   end;
  if FreePos=0 then Exit;
  if MaxSize-FreePos+1<3 then             &#123; Ak ostali menej ako 3 volne byty &#125;
   begin
     Data&#91;FreePos&#93;&#58;=$FF;                  &#123; Oznaci ich ako nealokovatelne &#125;
     if MaxSize-FreePos>1 then Data&#91;FreePos+1&#93;&#58;=$FF;
   end
  else
   begin
     Data&#91;FreePos&#93;&#58;=0;                       &#123; Inak vytvori volny blok &#125;
     Data&#91;FreePos+1&#93;&#58;=Hi&#40;MaxSize-FreePos-2&#41;; &#123; Az po koniec pamate &#125;
     Data&#91;FreePos+2&#93;&#58;=Lo&#40;MaxSize-FreePos-2&#41;;
   end;
end;

end.