66 lines
1.4 KiB
Plaintext
66 lines
1.4 KiB
Plaintext
{$IFDEF FPC}
|
|
{$MODE DELPHI}
|
|
{$OPTIMIZATION ON,Regvar,ASMCSE,CSE,PEEPHOLE}
|
|
{$ELSE}
|
|
{$APPTYPE CONSOLE}
|
|
{$ENDIF}
|
|
uses
|
|
sysutils; //only for timing
|
|
|
|
function IntToBinStrNew(AInt : LongWord):string;
|
|
const
|
|
IO : array[0..1] of char = ('.','X');
|
|
var
|
|
idx,m : LongWord;
|
|
pC : pChar;
|
|
begin
|
|
IF AInt = 0 then Begin
|
|
result := IO[0];EXIT;end;
|
|
// search for the first set bit
|
|
idx:= 32;m := 1 shl (idx-1);
|
|
While ORD((AInt AND m) = 0)+ORD(m>0) = 2 do begin
|
|
dec(idx);m := m shr 1;end;
|
|
|
|
//set right length and insert one by one
|
|
setlength(result,idx);
|
|
pC := @result[1];
|
|
repeat
|
|
pC^ := IO[ORD((AInt and m) <> 0)];
|
|
m := m shr 1;
|
|
inc(pC);
|
|
until m=0;
|
|
end;
|
|
|
|
function IntToBinStr(AInt : LongWord) : string;
|
|
begin
|
|
Result := '';
|
|
repeat
|
|
Result := Chr(Ord('0')+(AInt and 1))+Result;
|
|
AInt := AInt div 2;
|
|
until (AInt = 0);
|
|
end;
|
|
|
|
procedure Binary_Digits;
|
|
begin
|
|
writeln(' 5: ',IntToBinStr(5));
|
|
writeln(' 5: ',IntToBinStrNew(5));
|
|
writeln(' 50: ',IntToBinStr(50));
|
|
writeln(' 50: ',IntToBinStrNew(50));
|
|
writeln('9000: '+IntToBinStr(9000));
|
|
writeln('9000: '+IntToBinStrNew(9000));
|
|
end;
|
|
|
|
var
|
|
i: LongInt;
|
|
t :TDateTime;
|
|
Begin
|
|
Binary_Digits;
|
|
//speed test
|
|
t := time;
|
|
For i := 1 to 10*1000*1000 do
|
|
IntToBinStrNew(i);t := time-t; Writeln(' New ',t*86400.0:6:3);
|
|
t := time;
|
|
For i := 1 to 10*1000*1000 do
|
|
IntToBinStr(i);t := time-t; Writeln(' Old ',t*86400.0:6:3);
|
|
end.
|