{$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.