Pascal nie posiada wydajnej funkcji rotacji bitów na zasadzie zapętlenia bajtu czy słowa.
Napisałem dwie proste funkcje RLA i RRA zapętlające przesuwane bity jednak szukam wydajniejszej
formy tych funkcji.Chodzi mi o to aby ich kod napisany był w klasycznym paskalu a nie jako wstawka assemblerowa....
a szybkość realizacji przynajmniej o 30% większa od mojego kodu.
Zamieszczam przykładowy program testujący te funkcje.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
BajtTestowy: byte = $0F;
implementation
{$R *.dfm}
//Funkcja rotacji BAJTU w lewo
function RLA(Bajt: byte): byte;
var
Wynik: word;
begin
Wynik:=0;
Wynik:=(Bajt shl 1);
if (Bajt and 128) > 0 then
begin
Wynik:=Wynik+1;
end;
Result:=Wynik;
end;
//Funkcja rotacji BAJTU w prawo
function RRA(Bajt: byte): byte;
var
Wynik: word;
begin
Wynik:=0;
Wynik:=(Bajt shr 1);
if (Bajt and 1) > 0 then
begin
Wynik:=Wynik+128;
end;
Result:=Wynik;
end;
////////////////////////////////////////////////////////////////////////////////
{Konwertuje (maksymalnie 64 bity) liczbę dziesiętną na binarną w zapisie ASCII}
//WEJSCIE: Value = Liczba do przekonwerterowania na ciag binarny ASCII
// Size = jak z danej liczby do przekonwerterowania chcemy uzyskac
// tylko pewien zakres mlodszych bitow to podajemy tu ilosc
// bitow widocznych po konwersji np 7 = 8 bitow widocznych.
// Jesli jako parametr Size podamy -1 to uzyskamy tylko tyle
// bitów ile mamy do najstarszego nie zerowego bitu tej liczby.
//WYJSCIE: = binarny zapis liczby w formacie ASCII.
//TESTY OK!
function IntToBin(Value: int64;Size: Integer = -1): String;
var
i: Integer;
begin
Result:='';
if Size < 0 then
i:=31
else
i:=Size;
for i:=i downto 0 do
begin
if Value and (1 shl i) <> 0 then
Result:=Result+'1'
else
Result:=Result+'0';
end;
//Teraz usuwamy z ciagu binarnego wszystkie poprzedzające go zera
if Size < 0 then Delete(Result,1,Pos('1',Result) - 1);
end;
////////////////////////////////////////////////////////////////////////////////
procedure TForm1.Button1Click(Sender: TObject);
begin
BajtTestowy:=RLA(BajtTestowy);
(Sender as TButton).Caption:=IntToBin(BajtTestowy,7);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
BajtTestowy:=RRA(BajtTestowy);
(Sender as TButton).Caption:=IntToBin(BajtTestowy,7);
end;
end.
