Please pomožte mi někdo se semestrálkou, potřebuju v Packalu udělat nějekej objekt a nevím jak. Na přednáškách to vysvětlovala nějak divně a na cvikách jsme to nebrali :( a ve skriptech to není :(
A na netu to nemůžu najít :(
thx
Printable View
Please pomožte mi někdo se semestrálkou, potřebuju v Packalu udělat nějekej objekt a nevím jak. Na přednáškách to vysvětlovala nějak divně a na cvikách jsme to nebrali :( a ve skriptech to není :(
A na netu to nemůžu najít :(
thx
jestli chceš, tak ti můžu poslat 75MB vzorovejch příkladů v Pascalu...ale prakticky to už vysvětlit neumim... :oops:
Unit na zretazenu volnu pamat - mali sme to spravit na programovacie techniky.
Kód:{$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 (A<=MaxSize) and ((Data[A]=$FF) or (Data[A]<>0) or
((Data[A]=0) and (Word(Data[A+1]) shl 8+Data[A+2]<Size)))
do if Data[A]=$FF then Inc(A) else A:=A+Word(Data[A+1]) shl 8+Data[A+2]+3;
if A>MaxSize then {Nie je dost pamati}
begin
New:=0;
Exit;
end;
FreeSpace:=Word(Data[A+1]) shl 8+Data[A+2];
Data[A]:=ID; { Zapise ID }
Data[A+1]:=Hi(Size); { Zapise alokovanu velkost }
Data[A+2]:=Lo(Size);
if (FreeSpace-Size<3) and (FreeSpace-Size>0) then
begin { Ak ostalo menej volneho miesta ako 3 byty }
Data[A+Size+3]:=$FF; { Oznaci ich ako $FF = nealokovatelne }
if FreeSpace-Size>1 then Data[A+Size+4]:=$FF;
end
else if FreeSpace-Size<>0 then
begin { Inak vyrobi nealokovany blok }
Data[A+Size+3]:=0;
Data[A+Size+4]:=Hi(FreeSpace-Size-3);
Data[A+Size+5]:=Lo(FreeSpace-Size-3);
end;
New:=ID;
UsedIDs[ID]:=True; { Oznaci nove ID ako obsadene }
end;
{Najde blok podla jeho ID a vrati adresu - len pre interne pouzitie}
function TZVP.FindBlock(ID:Byte):Word;
var A:Word;
begin
FindBlock:=$FFFF;
if not UsedIDs[ID] then Exit; { ID je volne => blok neexistuje }
A:=1;
{ Najde blok s oznacenim ID }
while (A<=MaxSize) and ((Data[A]<>ID) or (Data[A]=$FF))
do if Data[A]=$FF then Inc(A) else A:=A+Word(Data[A+1]) shl 8+Data[A+2]+3;
if Data[A]=ID then FindBlock:=A;
end;
{Uvolni blok podla ID}
procedure TZVP.Dispose(ID:Byte);
var A:Word;
begin
if (ID=0) or (ID=$FF) then Exit;
A:=FindBlock(ID); { Najde blok podla ID }
if A=$FFFF then Exit;
Data[A]:=0; { Nastavi jeho ID na 0 }
UsedIDs[ID]:=False; { Oznaci ID ako volne }
end;
{Cita data z bloku ID velkosti Size do Bufferu}
procedure TZVP.ReadData(ID:Byte;Size:Word;var Buffer:array of Byte);
var A:Word;
begin
if (ID=0) or (ID=$FF) then Exit;
A:=FindBlock(ID);
if A=$FFFF then Exit;
{ Pri poziadavke citat viac ako je velkost bloku citame cely blok }
if Size>Word(Data[A+1]) shl 8+Data[A+2] then Size:=Word(Data[A+1]) shl 8+Data[A+2];
Move(Data[A+3],Buffer,Size);
end;
{Zapisuje data do bloku ID velkosti Size z Buffera}
procedure TZVP.WriteData(ID:Byte;Size:Word;const Buffer:array of Byte);
var A:Word;
begin
if (ID=0) or (ID=$FF) then Exit;
A:=FindBlock(ID);
if A=$FFFF then Exit;
{ Pri poziadavke zapisat viac ako je velkost bloku zapiseme cely blok }
if Size>Word(Data[A+1]) shl 8+Data[A+2] then Size:=Word(Data[A+1]) shl 8+Data[A+2];
Move(Buffer,Data[A+3],Size);
end;
{Spoji po sebe nasledujuce volne bloky do jedneho}
procedure TZVP.Connect;
var A,Start:Word;
begin
A:=1;
Start:=0;
while (A<=MaxSize) do { Prechadza celu pamat }
begin
if (Data[A]=0) or (Data[A]=$FF) then { Ak nasiel volny blok }
begin
if Start=0 then Start:=A; { Ulozi zaciatok volneho miesta }
end
else { Ak nasiel obsadeny blok }
if (Start<>0) and (Start<MaxSize-1) then { Ak je ulozeny zaciatok }
begin
Data[Start]:=0; { Od zaciatku volneho miesta }
Data[Start+1]:=Hi(A-Start-3); { vytvori volny blok s velkostou }
Data[Start+2]:=Lo(A-Start-3); { celeho suvisleho volneho miesta }
Start:=0;
end;
if Data[A]=$FF then Inc(A) else A:=A+Word(Data[A+1]) shl 8+Data[A+2]+3;
end;
if (Start<>0) and (Start<MaxSize-1) then { Ak je ulozeny zaciatok }
begin
Data[Start]:=0; { Od zaciatku volneho miesta }
Data[Start+1]:=Hi(A-Start-3); { vytvori volny blok s velkostou }
Data[Start+2]:=Lo(A-Start-3); { celeho suvisleho volneho miesta }
Start:=0;
end;
end;
{Defragmentacia ZVP}
procedure TZVP.Collect;
var A,FreePos,Size:Word;
begin
A:=1;
FreePos:=0;
while (A<=MaxSize) do { Prechadza celu pamat }
begin
if Data[A]<>$FF then Size:=Word(Data[A+1]) shl 8+Data[A+2];
if (Data[A]=0) or (Data[A]=$FF) then { Ak nasiel volny blok }
begin
if FreePos=0 then FreePos:=A; { Ulozi zaciatok volneho miesta }
end
else { Ak nasiel obsadeny blok }
if FreePos<>0 then { Ak je ulozeny zaciatok }
begin
Move(Data[A],Data[FreePos],Size+3); { Presunie blok do volneho miesta }
FreePos:=FreePos+Size+3; { Posunie zaciatok volneho miesta }
end;
if Data[A]=$FF then Inc(A) else A:=A+Size+3;
end;
if FreePos=0 then Exit;
if MaxSize-FreePos+1<3 then { Ak ostali menej ako 3 volne byty }
begin
Data[FreePos]:=$FF; { Oznaci ich ako nealokovatelne }
if MaxSize-FreePos>1 then Data[FreePos+1]:=$FF;
end
else
begin
Data[FreePos]:=0; { Inak vytvori volny blok }
Data[FreePos+1]:=Hi(MaxSize-FreePos-2); { Az po koniec pamate }
Data[FreePos+2]:=Lo(MaxSize-FreePos-2);
end;
end;
end.
Rainbow: dík dík dík, přesně něco takovýho jsem potřeboval. Fachčí to normálně v TP 7.0?
Ano, to je pre DOSovsky pascal. V Delphi sa objekty robia trochu inak.