convert decimal to binary fraction

I am looking for an algorithm to convert very long decimal fractions to binary fractions, preferably starting with the most significant digits and working my way down.

Can anybody help?

In[1]:= d = RandomReal[1000]

Out[1]= 653.551

In[2]:= bits = 60;
Print[BaseForm[d, 2]]; (*to check the result*)
f = Rationalize[d, 10^-3];
While[f >= 1, f = f/2];(*normalize*)
Reap[
  Do[
    f = 2*f;
    If[f >= 1, f = f - 1; Sow[1], Sow[0]](*extract one bit*),
    {bits}
  ]
][[2, 1]]

During evaluation of In[2]:= Subscript[1.0100011011000110101, 2]*2^(9)

Out[6]= {1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, \
0, 1, 0, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 0}

(*Or if you don't need to see how it is done then perhaps this will do as well or even better*)

In[7]:= d = RandomReal[1000]; RealDigits[d, 2, 40]

Out[8]= {{1, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 
  1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 1, 1, 1}, 10}